aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiles Bader2005-06-15 23:32:15 +0000
committerMiles Bader2005-06-15 23:32:15 +0000
commit2092fd2b3339ac097e1b27643b70211dcb0b4e95 (patch)
tree7f2307bbb82c7f111678885f871d88d44c870d4e
parent8786f9fffda045f818e622bddd9c85249dfb9ff7 (diff)
parenta4bf534f1eb1dcb2048f5deeff783c23059e3924 (diff)
downloademacs-2092fd2b3339ac097e1b27643b70211dcb0b4e95.tar.gz
emacs-2092fd2b3339ac097e1b27643b70211dcb0b4e95.zip
Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-63
Merge from emacs--cvs-trunk--0 Patches applied: * emacs--cvs-trunk--0 (patch 358-423) - Update from CVS - Remove "-face" suffix from widget faces - Remove "-face" suffix from custom faces - Remove "-face" suffix from change-log faces - Remove "-face" suffix from compilation faces - Remove "-face" suffix from diff-mode faces - lisp/longlines.el (longlines-visible-face): Face removed - Remove "-face" suffix from woman faces - Remove "-face" suffix from whitespace-highlight face - Remove "-face" suffix from ruler-mode faces - Remove "-face" suffix from show-paren faces - Remove "-face" suffix from log-view faces - Remove "-face" suffix from smerge faces - Remove "-face" suffix from show-tabs faces - Remove "-face" suffix from highlight-changes faces - Remove "-face" suffix from and downcase info faces - Remove "-face" suffix from pcvs faces - Update uses of renamed pcvs faces - Tweak ChangeLog - Remove "-face" suffix from strokes-char face - Remove "-face" suffix from compare-windows face - Remove "-face" suffix from calendar faces - Remove "-face" suffix from diary-button face - Remove "-face" suffix from testcover faces - Remove "-face" suffix from viper faces - Remove "-face" suffix from org faces - Remove "-face" suffix from sgml-namespace face - Remove "-face" suffix from table-cell face - Remove "-face" suffix from tex-mode faces - Remove "-face" suffix from texinfo-heading face - Remove "-face" suffix from flyspell faces - Remove "-face" suffix from gomoku faces - Remove "-face" suffix from mpuz faces - Merge from gnus--rel--5.10 - Remove "-face" suffix from Buffer-menu-buffer face - Remove "-face" suffix from antlr-mode faces - Remove "-face" suffix from ebrowse faces - Remove "-face" suffix from flymake faces - Remove "-face" suffix from idlwave faces - Remove "-face" suffix from sh-script faces - Remove "-face" suffix from vhdl-mode faces - Remove "-face" suffix from which-func face - Remove "-face" suffix from cperl-mode faces - Remove "-face" suffix from ld-script faces - Fix cperl-mode font-lock problem - Tweak which-func face * gnus--rel--5.10 (patch 80-82) - Merge from emacs--cvs-trunk--0 - Update from CVS
-rw-r--r--admin/ChangeLog5
-rw-r--r--admin/FOR-RELEASE5
-rw-r--r--admin/admin.el3
-rw-r--r--admin/make-tarball.txt8
-rw-r--r--etc/ChangeLog10
-rw-r--r--etc/DEBUG7
-rw-r--r--etc/NEWS11
-rw-r--r--etc/emacs-buffer.gdb10
-rw-r--r--lib-src/ChangeLog10
-rw-r--r--lib-src/makefile.w32-in2
-rw-r--r--lisp/ChangeLog812
-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.el74
-rw-r--r--lisp/ediff-mult.el3
-rw-r--r--lisp/ediff-util.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.el40
-rw-r--r--lisp/emacs-lisp/derived.el10
-rw-r--r--lisp/emacs-lisp/edebug.el43
-rw-r--r--lisp/emacs-lisp/ewoc.el36
-rw-r--r--lisp/emacs-lisp/testcover.el18
-rw-r--r--lisp/emulation/cua-base.el18
-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/eshell/esh-var.el2
-rw-r--r--lisp/faces.el17
-rw-r--r--lisp/files.el6
-rw-r--r--lisp/filesets.el4
-rw-r--r--lisp/forms.el6
-rw-r--r--lisp/frame.el4
-rw-r--r--lisp/generic-x.el16
-rw-r--r--lisp/gnus/ChangeLog21
-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/spam-stat.el4
-rw-r--r--lisp/hexl.el2
-rw-r--r--lisp/hilit-chg.el69
-rw-r--r--lisp/ido.el63
-rw-r--r--lisp/ielm.el4
-rw-r--r--lisp/info.el38
-rw-r--r--lisp/international/mule-cmds.el4
-rw-r--r--lisp/isearchb.el2
-rw-r--r--lisp/iswitchb.el49
-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/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.el364
-rw-r--r--lisp/progmodes/ada-mode.el6
-rw-r--r--lisp/progmodes/antlr-mode.el94
-rw-r--r--lisp/progmodes/compile.el16
-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.el58
-rw-r--r--lisp/progmodes/gud.el12
-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.el66
-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/recentf.el10
-rw-r--r--lisp/ruler-mode.el110
-rw-r--r--lisp/ses.el2
-rw-r--r--lisp/skeleton.el2
-rw-r--r--lisp/smerge-mode.el24
-rw-r--r--lisp/strokes.el8
-rw-r--r--lisp/subr.el55
-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/bibtex.el4
-rw-r--r--lisp/textmodes/fill.el96
-rw-r--r--lisp/textmodes/flyspell.el59
-rw-r--r--lisp/textmodes/ispell.el2
-rw-r--r--lisp/textmodes/org.el939
-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.el15
-rw-r--r--lisp/textmodes/texinfo.el8
-rw-r--r--lisp/thumbs.el24
-rw-r--r--lisp/time.el4
-rw-r--r--lisp/tooltip.el19
-rw-r--r--lisp/tree-widget.el65
-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.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
-rw-r--r--lispref/ChangeLog120
-rw-r--r--lispref/Makefile.in2
-rw-r--r--lispref/anti.texi3
-rw-r--r--lispref/debugging.texi35
-rw-r--r--lispref/edebug.texi99
-rw-r--r--lispref/elisp.texi32
-rw-r--r--lispref/intro.texi6
-rw-r--r--lispref/searching.texi10
-rw-r--r--lispref/syntax.texi38
-rw-r--r--lispref/text.texi84
-rw-r--r--man/ChangeLog14
-rw-r--r--man/anti.texi5
-rw-r--r--man/calc.texi1
-rw-r--r--man/emacs.texi2
-rw-r--r--man/org.texi231
-rw-r--r--nt/ChangeLog32
-rw-r--r--nt/INSTALL42
-rw-r--r--nt/addsection.c31
-rwxr-xr-xnt/configure.bat101
-rw-r--r--nt/gmake.defs2
-rw-r--r--src/ChangeLog155
-rw-r--r--src/eval.c39
-rw-r--r--src/fns.c4
-rw-r--r--src/frame.c18
-rw-r--r--src/image.c82
-rw-r--r--src/keyboard.c2
-rw-r--r--src/lisp.h2
-rw-r--r--src/macfns.c3
-rw-r--r--src/macterm.c314
-rw-r--r--src/makefile.w32-in3
-rw-r--r--src/process.c2
-rw-r--r--src/unexw32.c56
-rw-r--r--src/w32bdf.c2
-rw-r--r--src/w32fns.c82
-rw-r--r--src/w32term.c20
-rw-r--r--src/window.c2
-rw-r--r--src/xdisp.c19
-rw-r--r--src/xfaces.c4
190 files changed, 5316 insertions, 2811 deletions
diff --git a/admin/ChangeLog b/admin/ChangeLog
index 9f5b9462a5f..d833ea77a5e 100644
--- a/admin/ChangeLog
+++ b/admin/ChangeLog
@@ -1,3 +1,8 @@
12005-06-10 Lute Kamstra <lute@gnu.org>
2
3 * admin.el (set-version): Set version in lisp manual too.
4 * make-tarball.txt: Commit lispref/elisp.texi too.
5
12005-06-04 Richard M. Stallman <rms@gnu.org> 62005-06-04 Richard M. Stallman <rms@gnu.org>
2 7
3 * emacs-pretesters: Refer to etc/DEBUG instead of duplicating it. 8 * emacs-pretesters: Refer to etc/DEBUG instead of duplicating it.
diff --git a/admin/FOR-RELEASE b/admin/FOR-RELEASE
index 441c8fe4fa2..c76bc3d4f48 100644
--- a/admin/FOR-RELEASE
+++ b/admin/FOR-RELEASE
@@ -18,7 +18,6 @@ See msg from rms to emacs-devel on 21 Dec.
18 18
19** Enhance scroll-bar to handle tall line (similar to line-move). 19** Enhance scroll-bar to handle tall line (similar to line-move).
20 20
21** Adapt mouse-sel-mode to mouse-1-click-follows-link.
22 21
23 22
24* FATAL ERRORS 23* FATAL ERRORS
@@ -82,6 +81,8 @@ is encountered.
82 81
83** Finish updating the Emacs Lisp manual. 82** Finish updating the Emacs Lisp manual.
84 83
84*** Update lispref/README.
85
85** Update the Emacs manual. 86** Update the Emacs manual.
86 87
87*** Update man/info.texi. 88*** Update man/info.texi.
@@ -187,7 +188,7 @@ lispref/control.texi "Luc Teirlinck" Chong Yidong
187lispref/customize.texi Chong Yidong 188lispref/customize.texi Chong Yidong
188lispref/debugging.texi Joakim Verona <joakim@verona.se> Lute Kamstra 189lispref/debugging.texi Joakim Verona <joakim@verona.se> Lute Kamstra
189lispref/display.texi Chong Yidong 190lispref/display.texi Chong Yidong
190lispref/edebug.texi Chong Yidong 191lispref/edebug.texi Chong Yidong "Luc Teirlinck"
191lispref/elisp.texi "Luc Teirlinck" Lute Kamstra 192lispref/elisp.texi "Luc Teirlinck" Lute Kamstra
192lispref/errors.texi "Luc Teirlinck" 193lispref/errors.texi "Luc Teirlinck"
193lispref/eval.texi "Luc Teirlinck" Chong Yidong 194lispref/eval.texi "Luc Teirlinck" Chong Yidong
diff --git a/admin/admin.el b/admin/admin.el
index 44fbd8ed543..07a2bcb757e 100644
--- a/admin/admin.el
+++ b/admin/admin.el
@@ -84,6 +84,9 @@ Root must be the root of an Emacs source tree."
84 (submatch (1+ (in "0-9.")))))) 84 (submatch (1+ (in "0-9."))))))
85 (set-version-in-file root "man/emacs.texi" version 85 (set-version-in-file root "man/emacs.texi" version
86 (rx (and "EMACSVER" (1+ space) 86 (rx (and "EMACSVER" (1+ space)
87 (submatch (1+ (in "0-9."))))))
88 (set-version-in-file root "lispref/elisp.texi" version
89 (rx (and "EMACSVER" (1+ space)
87 (submatch (1+ (in "0-9."))))))) 90 (submatch (1+ (in "0-9.")))))))
88 91
89;;; arch-tag: 4ea83636-2293-408b-884e-ad64f22a3bf5 92;;; arch-tag: 4ea83636-2293-408b-884e-ad64f22a3bf5
diff --git a/admin/make-tarball.txt b/admin/make-tarball.txt
index 4ca4a21feab..10fca7e84ac 100644
--- a/admin/make-tarball.txt
+++ b/admin/make-tarball.txt
@@ -22,10 +22,10 @@ For each step, check for possible errors.
225. rm configure; make bootstrap 225. rm configure; make bootstrap
23 23
246. Commit configure, README, AUTHORS, lisp/cus-load.el, 246. Commit configure, README, AUTHORS, lisp/cus-load.el,
25 lisp/finder-inf.el, lisp/version.el, man/emacs.texi. 25 lisp/finder-inf.el, lisp/version.el, man/emacs.texi,
26 Copy lisp/loaddefs.el to lisp/ldefs-boot.el and commit 26 lispref/elisp.texi. Copy lisp/loaddefs.el to lisp/ldefs-boot.el
27 lisp/ldefs-boot.el. For a release, also commit the ChangeLog 27 and commit lisp/ldefs-boot.el. For a release, also commit the
28 files in all directories. 28 ChangeLog files in all directories.
29 29
307. make-dist --snapshot. Check the contents of the new tar with 307. make-dist --snapshot. Check the contents of the new tar with
31 admin/diff-tar-files against an older tar file. Some old pretest 31 admin/diff-tar-files against an older tar file. Some old pretest
diff --git a/etc/ChangeLog b/etc/ChangeLog
index 796d2db3190..9fb41788feb 100644
--- a/etc/ChangeLog
+++ b/etc/ChangeLog
@@ -1,3 +1,13 @@
12005-06-11 Eli Zaretskii <eliz@gnu.org>
2
3 * DEBUG: Mention emacs-buffer.gdb.
4
52005-06-10 Noah Friedman <friedman@splode.com>
6
7 * emacs-buffer.gdb (ybuffer-list): Don't use $filename; can't use
8 char as placeholder when buffer has no file name and process is
9 still live. Use different printf cases instead.
10
12005-06-08 Kim F. Storm <storm@cua.dk> 112005-06-08 Kim F. Storm <storm@cua.dk>
2 12
3 * PROBLEMS: Linux kernel 2.6.10 may corrupt process output. 13 * PROBLEMS: Linux kernel 2.6.10 may corrupt process output.
diff --git a/etc/DEBUG b/etc/DEBUG
index fe3bde0c3b8..a29e5fd3e6c 100644
--- a/etc/DEBUG
+++ b/etc/DEBUG
@@ -576,6 +576,13 @@ these data structures on the respective headers to remove the `:N'
576bitfield definitions (which will cause each such field to use a full 576bitfield definitions (which will cause each such field to use a full
577int). 577int).
578 578
579** How to recover buffer contents from an Emacs core dump file
580
581The file etc/emacs-buffer.gdb defines a set of GDB commands for
582recovering the contents of Emacs buffers from a core dump file. You
583might also find those commands useful for displaying the list of
584buffers in human-readable format from within the debugger.
585
579** Some suggestions for debugging on MS Windows: 586** Some suggestions for debugging on MS Windows:
580 587
581 (written by Marc Fleischeuers, Geoff Voelker and Andrew Innes) 588 (written by Marc Fleischeuers, Geoff Voelker and Andrew Innes)
diff --git a/etc/NEWS b/etc/NEWS
index 5a042464e83..f85f7e0ba81 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -3140,6 +3140,10 @@ list instead of at the beginning. This change actually occurred in
3140Emacs 21.1, but was not documented then. 3140Emacs 21.1, but was not documented then.
3141 3141
3142+++ 3142+++
3143*** New function `add-to-ordered-list' is like `add-to-list' but
3144associates a numeric ordering of each element added to the list.
3145
3146+++
3143*** New function `copy-tree' makes a copy of a tree. 3147*** New function `copy-tree' makes a copy of a tree.
3144 3148
3145It recursively copyies through both CARs and CDRs. 3149It recursively copyies through both CARs and CDRs.
@@ -3463,6 +3467,13 @@ clone to the other.
3463--- 3467---
3464*** The function `insert-string' is now obsolete. 3468*** The function `insert-string' is now obsolete.
3465 3469
3470** Filling changes.
3471
3472+++
3473*** In determining an adaptive fill prefix, Emacs now tries the function in
3474`adaptive-fill-function' _before_ matching the buffer line against
3475`adaptive-fill-regexp' rather than _after_ it.
3476
3466+++ 3477+++
3467** Atomic change groups. 3478** Atomic change groups.
3468 3479
diff --git a/etc/emacs-buffer.gdb b/etc/emacs-buffer.gdb
index cd0bf0dd59d..c4f8eef481d 100644
--- a/etc/emacs-buffer.gdb
+++ b/etc/emacs-buffer.gdb
@@ -116,13 +116,13 @@ define ybuffer-list
116 116
117 if $buf->filename != Qnil 117 if $buf->filename != Qnil
118 ygetptr $buf->filename 118 ygetptr $buf->filename
119 set $filename = ((struct Lisp_String *) $ptr)->data 119 printf "%2d %c %9d %-20s %-10s %s\n", \
120 $i, $modp, ($buf->text->z_byte - 1), $name, $mode, \
121 ((struct Lisp_String *) $ptr)->data
120 else 122 else
121 set $filename = ' ' 123 printf "%2d %c %9d %-20s %-10s\n", \
124 $i, $modp, ($buf->text->z_byte - 1), $name, $mode
122 end 125 end
123
124 printf "%2d %c %9d %-20s %-10s %s\n", \
125 $i, $modp, ($buf->text->z_byte - 1), $name, $mode, $filename
126 end 126 end
127 127
128 set $i++ 128 set $i++
diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog
index 196d2fe70dc..ff62d4fc343 100644
--- a/lib-src/ChangeLog
+++ b/lib-src/ChangeLog
@@ -1,3 +1,13 @@
12005-06-13 Eli Zaretskii <eliz@gnu.org>
2
3 * makefile.w32-in ($(DOC)): Fix last change.
4
52005-06-12 Eli Zaretskii <eliz@gnu.org>
6
7 * makefile.w32-in ($(DOC)): Depend on make-docfile.exe,
8 temacs.exe, and the preloaded *.elc files. This avoids
9 unnecessary dumping and DOC rebuilding.
10
12005-06-04 Eli Zaretskii <eliz@gnu.org> 112005-06-04 Eli Zaretskii <eliz@gnu.org>
2 12
3 * ntlib.h (fileno): Don't define if already defined. 13 * ntlib.h (fileno): Don't define if already defined.
diff --git a/lib-src/makefile.w32-in b/lib-src/makefile.w32-in
index 0f806912be5..fbb5559fd80 100644
--- a/lib-src/makefile.w32-in
+++ b/lib-src/makefile.w32-in
@@ -248,7 +248,7 @@ lisp2 = \
248 248
249 249
250DOC = DOC 250DOC = DOC
251$(DOC): make-docfile 251$(DOC): $(BLD) $(BLD)/make-docfile.exe ../src/$(BLD)/temacs.exe $(lisp1) $(lisp2)
252 - $(DEL) $(DOC) 252 - $(DEL) $(DOC)
253 "$(THISDIR)/$(BLD)/make-docfile" -o $(DOC) -d ../src $(obj) 253 "$(THISDIR)/$(BLD)/make-docfile" -o $(DOC) -d ../src $(obj)
254 "$(THISDIR)/$(BLD)/make-docfile" -a $(DOC) -d ../src $(lisp1) 254 "$(THISDIR)/$(BLD)/make-docfile" -a $(DOC) -d ../src $(lisp1)
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 1e4298f970e..bf16d16fde8 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,806 @@
12005-06-15 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * subr.el (add-to-ordered-list): Use a weak hash-table to avoid leaks.
4
52005-06-15 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de>
6
7 * textmodes/bibtex.el (bibtex-Preamble): Enclose BibTeX preamble
8 by field delimiters.
9
102005-06-15 David Ponce <david@dponce.com>
11
12 * tree-widget.el: eval-and-compile inlined functions so they will
13 be available at run-time too.
14 (tree-widget-super-format-handler)
15 (tree-widget-format-handler): Remove.
16 (tree-widget-value-create): Handle the :indent property.
17
182005-06-15 Miles Bader <miles@gnu.org>
19
20 * progmodes/which-func.el (which-func): Only inherit
21 `font-lock-function-name-face' when that makes sense against the
22 default mode-line face, otherwise set the face color explicitly.
23
24 * progmodes/cperl-mode.el (cperl-init-faces): Use literal cperl
25 faces instead of (non-existent) variables.
26
272005-06-14 Miles Bader <miles@gnu.org>
28
29 * progmodes/ld-script.el (ld-script-location-counter):
30 Remove "-face" suffix from face name.
31 (ld-script-location-counter-face):
32 New backward-compatibility alias for renamed face.
33 (ld-script-location-counter-face): Use renamed face.
34
35 * progmodes/cperl-mode.el (cperl-nonoverridable, cperl-array)
36 (cperl-hash): Remove "-face" suffix from face names.
37 (cperl-nonoverridable-face, cperl-array-face, cperl-hash-face):
38 New backward-compatibility aliases for renamed faces.
39 (cperl-find-pods-heres, cperl-init-faces, cperl-ps-print-init)
40 (cperl-ps-print-face-properties): Use renamed cperl-mode faces.
41
42 * progmodes/which-func.el (which-func): Remove "-face" suffix from face
43 name.
44 (which-func-face): New backward-compatibility alias for renamed face.
45 (which-func-format): Use renamed which-func face.
46
47 * progmodes/vhdl-mode.el (vhdl-prompt, vhdl-attribute, vhdl-enumvalue)
48 (vhdl-function, vhdl-directive, vhdl-reserved-word)
49 (vhdl-translate-off): Remove "-face" suffix and "font-lock-" from face
50 names.
51 (vhdl-speedbar-entity, vhdl-speedbar-architecture)
52 (vhdl-speedbar-configuration, vhdl-speedbar-package)
53 (vhdl-speedbar-library, vhdl-speedbar-instantiation)
54 (vhdl-speedbar-subprogram, vhdl-speedbar-entity-selected)
55 (vhdl-speedbar-architecture-selected)
56 (vhdl-speedbar-configuration-selected)
57 (vhdl-speedbar-package-selected)
58 (vhdl-speedbar-instantiation-selected): Remove "-face" suffix from face
59 names.
60 (vhdl-font-lock-keywords-2, vhdl-font-lock-keywords-5):
61 Use renamed faces.
62 (vhdl-prompt-face, vhdl-attribute-face, vhdl-enumvalue-face)
63 (vhdl-function-face, vhdl-directive-face, vhdl-reserved-words-face)
64 (vhdl-translate-off-face): Variables renamed to remove "font-lock-".
65 Use renamed faces.
66 (syntax-alist): Don't use "font-lock-" or "-face" in generated face
67 names.
68 (vhdl-font-lock-init, vhdl-ps-print-settings): Use renamed faces.
69 (vhdl-speedbar-insert-hierarchy, vhdl-speedbar-expand-entity)
70 (vhdl-speedbar-expand-package, vhdl-speedbar-update-current-unit)
71 (vhdl-speedbar-make-inst-line, vhdl-speedbar-make-pack-line)
72 (vhdl-speedbar-make-subpack-line, vhdl-speedbar-make-subprogram-line)
73 (vhdl-speedbar-item-info, vhdl-speedbar-check-unit): Use renamed faces.
74
75 * progmodes/sh-script.el (sh-heredoc): Remove "-face" suffix from
76 face name.
77 (sh-heredoc-face): New backward-compatibility alias for renamed face.
78 (sh-heredoc-face): Use renamed sh-heredoc face.
79
80 * progmodes/idlw-help.el (idlwave-help-link):
81 Remove "-face" suffix from face name.
82 (idlwave-help-link-face):
83 New backward-compatibility alias for renamed face.
84 (idlwave-highlight-linked-completions): Use renamed idlwave-help faces.
85
86 * progmodes/idlw-shell.el (idlwave-shell-bp-face)
87 (idlwave-shell-disabled-bp): Remove "-face" suffix from face names.
88 (idlwave-shell-bp-face, idlwave-shell-disabled-bp):
89 New backward-compatibility aliases for renamed faces.
90 (idlwave-shell-disabled-breakpoint-face)
91 (idlwave-shell-breakpoint-face): Use renamed idlwave-shell faces.
92
93 * progmodes/flymake.el (flymake-errline, flymake-warnline):
94 Remove "-face" suffix from face names.
95 (flymake-errline-face, flymake-warnline-face):
96 New backward-compatibility aliases for renamed faces.
97 (flymake-highlight-line): Use renamed flymake faces.
98
99 * progmodes/ebrowse.el (ebrowse-tree-mark, ebrowse-root-class)
100 (ebrowse-file-name, ebrowse-default, ebrowse-member-attribute)
101 (ebrowse-member-class, ebrowse-progress):
102 Remove "-face" suffix from face names.
103 (ebrowse-tree-mark-face, ebrowse-root-class-face)
104 (ebrowse-file-name-face, ebrowse-default-face)
105 (ebrowse-member-attribute-face, ebrowse-member-class-face)
106 (ebrowse-progress-face):
107 New backward-compatibility aliases for renamed faces.
108 (ebrowse-show-progress, ebrowse-show-file-name-at-point)
109 (ebrowse-set-mark-props, ebrowse-draw-tree-fn)
110 (ebrowse-draw-member-buffer-class-line, ebrowse-draw-member-long-fn)
111 (ebrowse-draw-member-short-fn): Use renamed ebrowse faces.
112
113 * progmodes/antlr-mode.el (antlr-default, antlr-keyword, antlr-syntax)
114 (antlr-ruledef, antlr-tokendef, antlr-ruleref, antlr-tokenref)
115 (antlr-literal): Remove "-face" suffix and "font-lock-" from face names.
116 (antlr-font-lock-default-face, antlr-font-lock-keyword-face)
117 (antlr-font-lock-syntax-face, antlr-font-lock-ruledef-face)
118 (antlr-font-lock-tokendef-face, antlr-font-lock-ruleref-face)
119 (antlr-font-lock-tokenref-face, antlr-font-lock-literal-face):
120 New backward-compatibility aliases for renamed faces.
121 (antlr-default-face, antlr-keyword-face, antlr-syntax-face)
122 (antlr-ruledef-face, antlr-tokendef-face, antlr-ruleref-face)
123 (antlr-tokenref-face, antlr-literal-face): Variables renamed to remove
124 "font-lock-". Use renamed antlr-mode faces.
125 (antlr-font-lock-additional-keywords): Use renamed faces.
126 Replace literal face-names with face variable references.
127
128 * buff-menu.el (Buffer-menu-buffer): Remove "-face" suffix from
129 face name.
130 (Buffer-menu-buffer-face): New backward-compatibility alias for
131 renamed face.
132 (list-buffers-noselect): Use renamed Buffer-menu-buffer face.
133
1342005-06-15 Daniel Pfeiffer <occitan@esperanto.org>
135
136 * progmodes/make-mode.el (makefile-space, makefile-makepp-perl):
137 Eliminate "-face" suffix.
138 (makefile-targets): Inherit from font-lock-function-name-face and
139 eliminate "-face" suffix.
140 (makefile-shell): Remove attributes and eliminate "-face" suffix.
141 (makefile-*-font-lock-keywords): Append makefile-targets in rule
142 actions, instead of prepending, to make it less visible.
143 (makefile-previous-dependency, makefile-match-dependency):
144 Don't match a target on a continuation line.
145
146 * files.el (auto-mode-alist): Put Makefile in gmake mode.
147
1482005-06-15 Nick Roberts <nickrob@snap.net.nz>
149
150 * progmodes/gdb-ui.el (gdb-tooltip-print):
151 Respect tooltip-use-echo-area.
152 (menu): Re-order menu items.
153
154 * progmodes/gud.el (tooltip-use-echo-area): Remove alias.
155 Define in tooltip.el.
156 (gud-tooltip-process-output): Respect tooltip-use-echo-area.
157 (gud-tooltip-tips): Respect tooltip-use-echo-area and
158 gud-tooltip-echo-area.
159
160 * tooltip.el (tooltip-use-echo-area): Restore from gud.el for
161 backward compatibility and make obsolete.
162 (tooltip-help-tips): Use tooltip-use-echo-area.
163 (tooltip-show-help-function): Rename to...
164 (tooltip-show-help): ...this, because it is a function.
165 (tooltip-mode, tooltip-help-message): Call tooltip-show-help.
166
1672005-06-14 Luc Teirlinck <teirllm@auburn.edu>
168
169 * emacs-lisp/edebug.el (edebug-all-defs, edebug-initial-mode)
170 (edebug-print-length, edebug-print-level, edebug-print-circle)
171 (edebug-modify-breakpoint, edebug-eval-last-sexp)
172 (edebug-eval-print-last-sexp): Doc fixes.
173
1742005-06-14 Kim F. Storm <storm@cua.dk>
175
176 * ido.el (ido-mode): Make a new keymap every time we enable ido,
177 as the coverage buffer/file/both may change.
178
1792005-06-14 Lute Kamstra <lute@gnu.org>
180
181 * net/ange-ftp.el (internal-ange-ftp-mode): Use delay-mode-hooks
182 and run-mode-hooks. Simplify.
183
184 * mail/rmailedit.el (rmail-edit-mode):
185 * progmodes/octave-inf.el (inferior-octave-mode):
186 * progmodes/sql.el (sql-interactive-mode): Use delay-mode-hooks.
187
188 * recentf.el (recentf-dialog-mode): Use kill-all-local-variables
189 and run-mode-hooks.
190 (recentf-edit-list, recentf-open-files): Don't call
191 kill-all-local-variables directly.
192
193 * emacs-lisp/debug.el (debug-on-entry): Fix docstring.
194
1952005-06-14 Juanma Barranquero <lekktu@gmail.com>
196
197 * emacs-lisp/byte-run.el (make-obsolete)
198 (define-obsolete-function-alias): Rename arguments FUNCTION and
199 NEW to OBSOLETE-NAME and CURRENT-NAME respectively.
200 (make-obsolete-variable, define-obsolete-variable-alias):
201 Rename arguments VARIABLE and NEW to OBSOLETE-NAME and CURRENT-NAME
202 respectively.
203
204 * isearchb.el (isearchb-activate):
205 * pcvs.el (cvs-mode):
206 * ses.el (ses-load):
207 * vc-arch.el (vc-arch-checkin, vc-arch-diff):
208 * net/tramp.el (tramp-find-file-exists-command)
209 (tramp-find-shell):
210 * progmodes/ada-mode.el (ada-create-case-exception)
211 (ada-create-case-exception-substring, ada-make-subprogram-body):
212 * progmodes/idlw-shell.el (idlwave-shell-move-to-bp):
213 * progmodes/idlwave.el (idlwave-complete-class-structure-tag-help):
214 * progmodes/vhdl-mode.el (vhdl-speedbar-place-component):
215 * textmodes/org.el (org-promote, org-evaluate-time-range)
216 (org-agenda-next-date-line, org-agenda-previous-date-line)
217 (org-agenda-error, org-open-at-point, org-table-move-row)
218 (org-format-table-table-html-using-table-generate-source)
219 (org-shiftcursor-error, org-ctrl-c-ctrl-c):
220 * textmodes/reftex.el (reftex-access-scan-info):
221 * textmodes/reftex-toc.el (reftex-toc-dframe-p)
222 (reftex-toc-promote-prepare): Follow error conventions.
223
224 * diff-mode.el (diff-mode): Fix typo in docstring.
225
226 * forms.el (forms--intuit-from-file): Fix reference to
227 `forms-number-of-fields' in error message.
228 (forms-print): Fix quoting in error message.
229
230 * forms.el (forms-mode):
231 * emulation/vi.el (vi-goto-insert-state):
232 * progmodes/flymake.el (flymake-new-err-info)
233 (flymake-start-syntax-check-for-current-buffer)
234 (flymake-simple-cleanup):
235 * eshell/esh-var.el (eshell/export):
236 * progmodes/gud.el (xdb):
237 * textmodes/flyspell.el (flyspell-incorrect-hook)
238 (flyspell-maybe-correct-transposition)
239 (flyspell-maybe-correct-doubling): Fix quoting in docstring.
240
2412005-06-13 Luc Teirlinck <teirllm@auburn.edu>
242
243 * emacs-lisp/debug.el (cancel-debug-on-entry): Mention default in
244 minibuffer prompt.
245
2462005-06-13 Kim F. Storm <storm@cua.dk>
247
248 * subr.el (add-to-ordered-list): New defun.
249
250 * emulation/cua-base.el (cua-mode): Use add-to-ordered-list to
251 add cua--keymap-alist to emulation-mode-map-alists.
252
2532005-06-13 Stefan Monnier <monnier@iro.umontreal.ca>
254
255 * subr.el (complete-in-turn): New macro.
256 (dynamic-completion-table, lazy-completion-table): Add debug info.
257
258 * faces.el (read-face-name): Use complete-in-turn complete non-aliases
259 in preference to face aliases.
260
261 * textmodes/fill.el (fill-match-adaptive-prefix): New function.
262 (fill-context-prefix): Use it to avoid guessing absurdly long prefixes.
263 Remove unused vars `start' and `firstline'.
264 (fill-nobreak-p): Fix line-move-invisible -> line-move-invisible-p.
265 (justify-current-line, fill-individual-paragraphs): Remove unused vars.
266
2672005-06-13 Eli Zaretskii <eliz@gnu.org>
268
269 * cus-start.el (all): Don't complain about missing GTK-related
270 variables, unless either `gtk' is boundp or this isn't a
271 `windows-nt' build.
272
2732005-06-13 Lute Kamstra <lute@gnu.org>
274
275 * abbrev.el (edit-abbrevs-mode): Use kill-all-local-variables and
276 run-mode-hooks.
277
278 * ediff-mult.el (ediff-meta-mode):
279 * ediff-util.el (ediff-mode): Use run-mode-hooks.
280
281 * ledit.el (ledit-mode): Use delay-mode-hooks.
282
283 * woman.el (woman-mode-line-format): Delete constant.
284 (woman-mode-map): Initialize it properly.
285 (woman-mode): Set mode-class property to special.
286 Use delay-mode-hooks and run-mode-hooks. Use the right keymap.
287 Set major-mode and mode-name. Don't set mode-line-format directly.
288 (Man-getpage-in-background): Don't reference woman-mode-line-format.
289
290 * emacs-lisp/debug.el (cancel-debug-on-entry): Make the empty
291 string argument obsolete.
292
2932005-06-13 Carsten Dominik <dominik@science.uva.nl>
294
295 * textmodes/org.el (org-CUA-compatible): New option.
296 (org-disputed-keys): New variable.
297 (org-key): New function.
298 (orgtbl-make-binding): Add docstring to the created function.
299 (org-mode): Set paragraph start/separate regexps.
300 (orgtbl-mode): Don't start `orgtbl-mode' in `org-mode' buffers.
301 (org-archive-location, org-archive-mark-done)
302 (org-archive-stamp-time): New options.
303 (org-archive-subtree): New command.
304 (org-fill-paragraph): New function.
305 (org-mode): Set `fill-paragraph-function' to `org-fill-paragraph'.
306 (org-fake-empty-table-line): Function removed.
307 (org-format-org-table-html): Do not create empty table lines at
308 separator lines. Improved table header treatment.
309 (org-link-format): New option.
310 (org-make-link): New function.
311 (org-insert-link, org-store-link): Use org-make-link.
312 (org-open-file): Quote file name for shell command, to allow
313 spaces in file names.
314 (org-link-regexp): Fix bug with mailto link.
315 (org-link-maybe-angles-regexp, org-protected-link-regexp):
316 New constants.
317 (org-export-as-html): Deal with the optional angles around a link.
318 Better treatment of file: links.
319 (org-open-at-point): Replace @{ and @} with < and >.
320 (org-run-mode-hooks): Function removed.
321 (org-agenda-mode): No longer use `org-run-mode-hooks'.
322
3232005-06-13 Nick Roberts <nickrob@snap.net.nz>
324
325 * progmodes/gdb-ui.el (gdb-registers-mode): Let gdbmi use
326 MI command -data-list-register-values.
327 (gdb-post-prompt): Indent properly.
328
3292005-06-13 Juanma Barranquero <lekktu@gmail.com>
330
331 * hilit-chg.el (highlight-changes-colors): Rename from
332 `highlight-changes-colours'.
333 (highlight-changes-colours): Keep as obsolete alias.
334 (highlight-changes-face-list): Doc fix.
335 (hilit-chg-make-list): Use `highlight-changes-colors'.
336
3372005-06-12 Mark A. Hershberger <mah@everybody.org>
338
339 * progmodes/cperl-mode.el (cperl-mode): Remove stray paren in
340 defun-prompt-regexp.
341
3422005-06-12 Eli Zaretskii <eliz@gnu.org>
343
344 * loadup.el: Don't say we are dumping under 2 names on windows-nt
345 and cygwin.
346
347 * makefile.w32-in (bootstrap-clean-CMD, bootstrap-clean-SH):
348 Don't use an old loaddefs.el, as in Makefile.in.
349
3502005-06-12 Lute Kamstra <lute@gnu.org>
351
352 * Makefile.in (bootstrap-prepare): Don't use an old loaddefs.el.
353
354 * man.el (Man-mode-map): Initialize it properly.
355 (Man-mode): Set mode-class property to special.
356
357 * calendar/calendar.el (calendar-mode): Use run-mode-hooks.
358
3592005-06-11 Luc Teirlinck <teirllm@auburn.edu>
360
361 * menu-bar.el (menu-bar-make-toggle): Remove stray backslash.
362 A newline is needed in the docstring there.
363
364 * emacs-lisp/debug.el (debug-on-entry, cancel-debug-on-entry):
365 Doc fixes.
366
3672005-06-11 Vinicius Jose Latorre <viniciusjl@ig.com.br>
368
369 * printing.el: Doc fix. The menubar is no more changed when printing
370 is loaded, it only changes when pr-menu-bind or pr-update-menus is
371 called. Now, the menubar changing will work in Emacs 20, 21 and 22.
372 (pr-version): New version number (6.8.4).
373 (pr-menu-bind): New command.
374 (pr-update-menus): Docstring and code fix.
375 (pr-menu-print-item): Now is a global var in Emacs and XEmacs.
376 Docstring fix.
377 (pr-txt-printer-alist, pr-ps-printer-alist, pr-gv-command)
378 (pr-gs-command, pr-gs-switches, pr-ps-utility-alist): Docstring fix.
379
3802005-06-11 Thien-Thi Nguyen <ttn@gnu.org>
381
382 * emacs-lisp/ewoc.el: Doc fixes for public funcs:
383 "Returns" to "return", document useful return values, etc.
384
3852005-06-11 Alan Mackenzie <acm@muc.de>
386
387 * fill.el (fill-context-prefix): Try `adaptive-fill-function'
388 BEFORE `adaptive-fill-regexp' when determining a fill prefix.
389 (adaptive-file-function): Minor amendment to doc-string.
390
3912005-06-11 Frederik Fouvry <fouvry@CoLi.Uni-SB.DE>
392
393 * thumbs.el (thumbs-per-line, thumbs-thumbsdir-max-size)
394 (thumbs-relief, thumbs-margin, thumbs-image-resizing-step):
395 Fix :type--it is `integer', not `string'.
396
397 * faces.el (modeline-highlight): Rename from (the erroneous)
398 `modeline-higilight'.
399
4002005-06-11 Lute Kamstra <lute@gnu.org>
401
402 * emacs-lisp/edebug.el (edebug-eval-mode-map): Don't copy
403 lisp-interaction-mode-map but make it the parent.
404 (edebug-eval-mode): Use define-derived-mode.
405
4062005-06-11 Andreas Schwab <schwab@suse.de>
407
408 * bindings.el: Add binding of `ESC functionkey' for every
409 `M-functionkey'.
410 * hexl.el (hexl-mode-map): Likewise.
411
4122005-06-10 Michael Hotchin <michael@hotchin.net> (tiny change)
413
414 * progmodes/compile.el (compilation-error-regexp-alist-alist)
415 [msft]: update regexp for newer msft compilers.
416
4172005-06-10 Mark A. Hershberger <mah@everybody.org>
418
419 * xml.el (start-chars, xml-parse-dtd): Add the ability to skip
420 ATTLIST portions of included DTDs.
421 (xml-parse-dtd): Eliminate use of inefficient match-data.
422
4232005-06-10 Miles Bader <miles@gnu.org>
424
425 * play/mpuz.el (mpuz-unsolved, mpuz-solved, mpuz-trivial)
426 (mpuz-text): Remove "-face" suffix from face names.
427 (mpuz-unsolved-face, mpuz-solved-face, mpuz-trivial-face)
428 (mpuz-text-face): New backward-compatibility aliases for renamed faces.
429 (mpuz-create-buffer, mpuz-paint-digit): Use renamed mpuz faces.
430
431 * play/gomoku.el (gomoku-O, gomoku-X):
432 Remove "-face" suffix from face names.
433 (gomoku-font-lock-O-face, gomoku-font-lock-X-face):
434 New backward-compatibility aliases for renamed faces.
435 (gomoku-font-lock-keywords): Use renamed gomoku faces.
436
4372005-06-10 Juanma Barranquero <lekktu@gmail.com>
438
439 * thumbs.el: Fixes for changes of 2005-06-09.
440 (thumbs-thumbsdir): Force `thumbs-thumbsdir' to be interpretable
441 as a directory.
442 (thumbs-thumbname): Remove directory separator from format string;
443 `thumbs-thumbsdir' now returns a valid directory name.
444 (thumbs-temp-dir): New defsubst.
445 (thumbs-temp-file, thumbs-resize-image, thumbs-modify-image):
446 Use it.
447
448 * cus-edit.el (minibuffer):
449 * files.el (make-backup-file-name-function):
450 * filesets.el (filesets-external-viewers):
451 * hilit-chg.el (highlight-changes-colours)
452 (highlight-changes-face-list, highlight-changes-rotate-faces):
453 * ielm.el (ielm-dynamic-return, inferior-emacs-lisp-mode):
454 * kmacro.el (kmacro-call-macro):
455 * log-edit.el (log-edit-changelog-full-paragraphs):
456 * mouse.el (mouse-1-click-follows-link):
457 * skeleton.el (skeleton-autowrap):
458 * subr.el (insert-for-yank-1):
459 * tempo.el (tempo-insert-region):
460 * terminal.el (terminal-emulator):
461 * time.el (display-time-mail-face):
462 * vc.el (vc-annotate):
463 * vcursor.el (vcursor-copy-line):
464 * woman.el (woman-bold-headings, woman-ignore)
465 (woman-default-faces, woman-monochrome-faces):
466 * calendar/todo-mode.el (todo-insert-threshold):
467 * emulation/pc-select.el (pc-select-selection-keys-only)
468 (pc-selection-mode):
469 * emulation/vip.el (vip-find-char-forward):
470 * emulation/viper-cmd.el (viper-find-char-forward):
471 * international/mule-cmds.el (select-safe-coding-system-accept-default-p)
472 (input-method-exit-on-invalid-key):
473 * international/mule-diag.el (describe-coding-system):
474 * international/ucs-tables.el (unify-8859-on-encoding-mode):
475 * net/browse-url.el (browse-url-xterm-program):
476 * obsolete/lazy-lock.el (lazy-lock-mode):
477 * progmodes/cperl-mode.el (cperl-info-on-command-no-prompt)
478 (cperl-mode):
479 * progmodes/cpp.el (cpp-face-light-name-list)
480 (cpp-face-dark-name-list):
481 * progmodes/delphi.el (delphi-newline-always-indents):
482 Fix spellings in docstrings.
483
484 * ido.el (ido-mode, ido-file-extensions-order)
485 (ido-default-file-method, ido-default-buffer-method)
486 (ido-max-prospects, ido-slow-ftp-hosts, ido-setup-hook)
487 (ido-decorations, ido-read-file-name-as-directory-commands)
488 (ido-read-file-name-non-ido, ido-work-directory-list)
489 (ido-ignore-item-temp-list, ido-current-directory)
490 (ido-magic-forward-char, ido-enter-find-file)
491 (ido-enter-switch-buffer, ido-visit-buffer, ido-switch-buffer)
492 (ido-find-file, ido-read-buffer): Fix typos in docstrings.
493
4942005-06-10 Lute Kamstra <lute@gnu.org>
495
496 * play/dunnet.el (dun-mode): Use define-derived-mode.
497 (dungeon-mode-map): Rename to dun-mode-map. Keep old name as an
498 obsolete alias.
499
500 * play/doctor.el (doctor-mode-map): Remove defvar.
501 (doctor-mode): Use define-derived-mode.
502
503 * mail/mspools.el (mspools-mode):
504 * net/eudc-hotlist.el (eudc-hotlist-mode):
505 * play/blackbox.el (blackbox-mode): Use run-mode-hooks.
506
5072005-06-10 Miles Bader <miles@gnu.org>
508
509 * textmodes/flyspell.el (flyspell-incorrect, flyspell-duplicate):
510 Remove "-face" suffix from face names.
511 (flyspell-incorrect-face, flyspell-duplicate-face):
512 New backward-compatibility aliases for renamed faces.
513 (flyspell-mode-on, make-flyspell-overlay)
514 (flyspell-highlight-incorrect-region)
515 (flyspell-highlight-duplicate-region)
516 (flyspell-display-next-corrections)
517 (flyspell-auto-correct-previous-word): Use renamed flyspell faces.
518
519 * textmodes/texinfo.el (texinfo-heading): Remove "-face" suffix
520 from face name.
521 (texinfo-heading-face): New backward-compatibility alias for
522 renamed face.
523 (texinfo-heading-face): Use renamed texinfo-heading face.
524
525 * textmodes/tex-mode.el (tex-math, tex-verbatim): Remove "-face"
526 suffix from face names.
527 (tex-math-face, tex-verbatim-face):
528 New backward-compatibility aliases for renamed faces.
529 (tex-math-face, tex-verbatim-face): Use renamed tex-mode faces.
530 (tex-insert-quote): Use `tex-verbatim-face' variable instead of
531 literal face name.
532
533 * textmodes/table.el (table-cell): Remove "-face" suffix from face
534 name.
535 (table-cell-face): New backward-compatibility alias for renamed face.
536 (table--put-cell-face-property, table--update-cell-face):
537 Use renamed table-cell face.
538
539 * textmodes/sgml-mode.el (sgml-namespace): Remove "-face" suffix
540 from face name.
541 (sgml-namespace-face): New backward-compatibility alias for
542 renamed face.
543 (sgml-namespace-face): Use renamed sgml-namespace face.
544
545 * textmodes/org.el (org-level-1, org-level-2, org-level-3)
546 (org-level-4, org-level-5, org-level-6, org-level-7)
547 (org-level-8, org-warning, org-headline-done)
548 (org-deadline-announce, org-scheduled-today)
549 (org-scheduled-previously, org-link, org-done, org-table)
550 (org-time-grid): Remove "-face" suffix from face names.
551 (org-level-1-face, org-level-2-face, org-level-3-face)
552 (org-level-4-face, org-level-5-face, org-level-6-face)
553 (org-level-7-face, org-level-8-face, org-warning-face)
554 (org-headline-done-face, org-deadline-announce-face)
555 (org-scheduled-today-face, org-scheduled-previously-face)
556 (org-link-face, org-done-face, org-table-face)
557 (org-time-grid-face):
558 New backward-compatibility aliases for renamed faces.
559 (org-level-faces, org-set-font-lock-defaults, org-timeline)
560 (org-agenda, org-agenda-get-todos, org-agenda-get-deadlines)
561 (org-agenda-get-timestamps, org-agenda-get-scheduled)
562 (org-agenda-add-time-grid-maybe, org-table-p): Use renamed org faces.
563
564 * emulation/viper-init.el (viper-search, viper-replace-overlay)
565 (viper-minibuffer-emacs, viper-minibuffer-insert)
566 (viper-minibuffer-vi): Remove "-face" suffix from face names.
567 (viper-search-face, viper-replace-overlay-face)
568 (viper-minibuffer-emacs-face, viper-minibuffer-insert-face)
569 (viper-minibuffer-vi-face):
570 New backward-compatibility aliases for renamed faces.
571 (viper-search-face, viper-replace-overlay-face)
572 (viper-minibuffer-emacs-face, viper-minibuffer-insert-face)
573 (viper-minibuffer-vi-face): Use renamed viper faces.
574
575 * emacs-lisp/testcover.el (testcover-nohits, testcover-1value):
576 Remove "-face" suffix from face names.
577 (testcover-nohits-face, testcover-1value-face):
578 New backward-compatibility aliases for renamed faces.
579 (testcover-mark): Use renamed testcover faces.
580
581 * calendar/diary-lib.el (diary-button): Remove "-face" suffix from
582 face name.
583 (diary-button-face): New backward-compatibility alias for renamed face.
584 (diary-entry): Use renamed diary-button face.
585
586 * calendar/calendar.el (diary, calendar-today, holiday)
587 (mark-visible-calendar-date): Remove "-face" suffix from face names.
588 (diary-face, calendar-today-face, holiday-face):
589 New backward-compatibility aliases for renamed faces.
590 (eval-after-load "facemenu", diary-entry-marker)
591 (calendar-today-marker, calendar-holiday-marker, diary-face):
592 Use renamed calendar faces.
593
594 * compare-w.el (compare-windows): Remove "-face" suffix from face name.
595 (compare-windows-face): New backward-compatibility alias for
596 renamed face.
597 (compare-windows-highlight): Use renamed compare-windows face.
598
599 * strokes.el (strokes-char): Remove "-face" suffix from face name.
600 (strokes-char-face): New backward-compatibility alias for renamed face.
601 (strokes-encode-buffer): Use renamed strokes-char face.
602
603 * pcvs-info.el (cvs-header, cvs-filename, cvs-unknown)
604 (cvs-handled, cvs-need-action, cvs-marked, cvs-msg):
605 Remove "-face" suffix from face names.
606 (cvs-header-face, cvs-filename-face, cvs-unknown-face)
607 (cvs-handled-face, cvs-need-action-face, cvs-marked-face)
608 (cvs-msg-face): New backward-compatibility aliases for renamed faces.
609 (cvs-fi-up-to-date-face, cvs-fi-unknown-face, cvs-fileinfo-pp):
610 Use renamed pcvs faces.
611 * pcvs.el (cvs-mode-find-file): Use renamed pcvs faces.
612 * pcvs-defs.el (cvs-mode-map): Likewise.
613 * cvs-status.el (cvs-status-font-lock-keywords): Likewise.
614
615 * info.el (info-title-1, info-title-2, info-title-3)
616 (info-title-4): Remove "-face" suffix from and downcase face names.
617 (Info-title-1-face, Info-title-2-face, Info-title-3-face)
618 (Info-title-4-face):
619 New backward-compatibility aliases for renamed faces.
620 (Info-fontify-node): Use renamed info faces.
621
622 * hilit-chg.el (highlight-changes, highlight-changes-delete):
623 Remove "-face" suffix from face names.
624 (highlight-changes-face, highlight-changes-delete-face):
625 New backward-compatibility aliases for renamed faces.
626 (hilit-chg-cust-fix-changes-face-list, hilit-chg-make-ov)
627 (hilit-chg-make-list): Use renamed highlight-changes faces.
628
629 * generic-x.el (show-tabs-tab, show-tabs-space):
630 Remove "-face" suffix from face names.
631 (show-tabs-tab-face, show-tabs-space-face):
632 New backward-compatibility aliases for renamed faces.
633 (show-tabs-generic-mode-font-lock-defaults-1)
634 (show-tabs-generic-mode-font-lock-defaults-2):
635 Use renamed show-tabs faces.
636
637 * smerge-mode.el (smerge-mine, smerge-other, smerge-base)
638 (smerge-markers): Remove "-face" suffix from face names.
639 (smerge-mine-face, smerge-other-face, smerge-base-face)
640 (smerge-markers-face):
641 New backward-compatibility aliases for renamed faces.
642 (smerge-mine-face, smerge-other-face, smerge-base-face)
643 (smerge-markers-face): Use renamed smerge faces.
644
645 * log-view.el (log-view-file, log-view-message):
646 Remove "-face" suffix from face names.
647 (log-view-file-face, log-view-message-face):
648 New backward-compatibility aliases for renamed faces.
649 (log-view-file-face, log-view-message-face): Use renamed log-view faces.
650
651 * paren.el (show-paren-match, show-paren-mismatch):
652 Remove "-face" suffix from face names.
653 (show-paren-match-face, show-paren-mismatch-face):
654 New backward-compatibility aliases for renamed faces.
655 (show-paren-function): Use renamed show-paren faces.
656
657 * ruler-mode.el (ruler-mode-default, ruler-mode-pad)
658 (ruler-mode-margins, ruler-mode-fringes)
659 (ruler-mode-column-number, ruler-mode-fill-column)
660 (ruler-mode-comment-column, ruler-mode-goal-column)
661 (ruler-mode-tab-stop, ruler-mode-current-column):
662 Remove "-face" suffix from face names.
663 (ruler-mode-default-face, ruler-mode-pad-face)
664 (ruler-mode-margins-face, ruler-mode-fringes-face)
665 (ruler-mode-column-number-face, ruler-mode-fill-column-face)
666 (ruler-mode-comment-column-face, ruler-mode-goal-column-face)
667 (ruler-mode-tab-stop-face, ruler-mode-current-column-face):
668 New backward-compatibility aliases for renamed faces.
669 (ruler-mode-pad, ruler-mode-margins, ruler-mode-fringes)
670 (ruler-mode-column-number, ruler-mode-fill-column)
671 (ruler-mode-comment-column, ruler-mode-goal-column)
672 (ruler-mode-tab-stop, ruler-mode-current-column)
673 (ruler-mode-mouse-grab-any-column, ruler-mode-ruler): Use renamed faces.
674
675 * whitespace.el (whitespace-highlight): Remove "-face" suffix from
676 face name.
677 (whitespace-highlight-the-space): Use renamed face.
678 (whitespace-highlight-face): New backward-compatibility alias for
679 renamed face.
680
681 * woman.el (woman-italic, woman-bold, woman-unknown)
682 (woman-addition, woman-symbol-face):
683 Remove "-face" suffix from face names.
684 (woman-italic-face, woman-bold-face, woman-unknown-face)
685 (woman-addition-face):
686 New backward-compatibility aliases for renamed faces.
687 (woman-default-faces, woman-monochrome-faces, woman-man-buffer)
688 (woman-decode-region, woman-replace-match)
689 (woman-display-extended-fonts, woman-special-characters)
690 (woman-font-alist, woman-change-fonts, woman2-TH, woman2-SH):
691 Use renamed woman faces.
692
693 * longlines.el (longlines-visible-face): Face removed.
694
695 * diff-mode.el (diff-header, diff-file-header, diff-index)
696 (diff-hunk-header, diff-removed, diff-added, diff-changed)
697 (diff-function, diff-context, diff-nonexistent): Remove "-face"
698 suffix from face names.
699 (diff-header-face, diff-file-header-face, diff-index-face)
700 (diff-hunk-header-face, diff-removed-face, diff-added-face)
701 (diff-changed-face, diff-function-face, diff-context-face)
702 (diff-nonexistent-face): New backward-compatibility aliases for
703 renamed faces.
704 (diff-header-face, diff-file-header-face)
705 (diff-index, diff-index-face, diff-hunk-header)
706 (diff-hunk-header-face, diff-removed, diff-removed-face)
707 (diff-added, diff-added-face, diff-changed-face, diff-function)
708 (diff-function-face, diff-context-face, diff-nonexistent)
709 (diff-nonexistent-face): Use renamed diff-mode faces.
710
711 * progmodes/compile.el (compilation-warning-face)
712 (compilation-info-face): Remove "-face" suffix from face names.
713 (compilation-warning-face, compilation-info-face):
714 New backward-compatibility aliases for renamed faces.
715 (compilation-warning-face, compilation-info-face):
716 Use renamed compilation faces.
717
718 * add-log.el (change-log-date, change-log-name)
719 (change-log-email, change-log-file, change-log-list)
720 (change-log-conditionals, change-log-function)
721 (change-log-acknowledgement): Remove "-face" suffix from face names.
722 (change-log-date-face, change-log-name-face)
723 (change-log-email-face, change-log-file-face)
724 (change-log-list-face, change-log-conditionals-face)
725 (change-log-function-face, change-log-acknowledgement-face):
726 New backward-compatibility aliases for renamed faces.
727 (change-log-font-lock-keywords): Use renamed change-log faces.
728
729 * cus-edit.el (custom-invalid, custom-rogue, custom-modified)
730 (custom-set, custom-changed, custom-saved, custom-button)
731 (custom-button-pressed, custom-documentation, custom-state)
732 (custom-comment, custom-comment-tag, custom-variable-tag)
733 (custom-variable-button, custom-face-tag, custom-group-tag-1)
734 (custom-group-tag): Remove "-face" suffix from face names.
735 (custom-magic-alist, custom-magic-value-create)
736 (custom-group-sample-face-get, custom-mode): Use renamed custom faces.
737 (custom-invalid-face, custom-rogue-face, custom-modified-face)
738 (custom-set-face, custom-changed-face, custom-saved-face)
739 (custom-button-face, custom-button-pressed-face)
740 (custom-documentation-face, custom-state-face)
741 (custom-comment-face, custom-comment-tag-face)
742 (custom-variable-tag-face, custom-variable-button-face)
743 (custom-face-tag-face, custom-group-tag-face-1)
744 (custom-group-tag-face):
745 New backward-compatibility aliases for renamed faces.
746
747 * wid-edit.el (widget-documentation, widget-button)
748 (widget-field, widget-single-line-field, widget-inactive)
749 (widget-button-pressed): "-face" suffix removed from face names.
750 (widget-documentation-face, widget-button-face)
751 (widget-field-face, widget-single-line-field-face)
752 (widget-inactive-face, widget-button-pressed-face):
753 New backward-compatibility aliases for renamed faces.
754 (widget-documentation-face, widget-button-face)
755 (widget-button-pressed-face, widget-specify-field)
756 (widget-specify-inactive): Use renamed widget faces.
757
7582005-06-10 Kenichi Handa <handa@m17n.org>
759
760 * term/x-win.el (x-clipboard-yank): Remove condition-case
761 wrapping.
762
7632005-06-11 Kenichi Handa <handa@m17n.org>
764
765 * add-log.el (change-log-font-lock-keywords): Make the regexp for
766 date lines stricter.
767
7682005-06-10 Zhang Wei <id.brep@gmail.com> (tiny change)
769
770 * term/x-win.el (x-clipboard-yank): Use x-selection-value instead
771 of x-get-selection.
772
7732005-06-10 Juanma Barranquero <lekktu@gmail.com>
774
775 * comint.el (comint-mode, comint-snapshot-last-prompt):
776 * frame.el (frame-current-scroll-bars):
777 * term.el (term-mode, term-check-proc, term-input-sender)
778 (term-simple-send, term-extract-string, term-word)
779 (term-match-partial-filename):
780 * window.el (window-current-scroll-bars):
781 * emulation/cua-base.el (cua-normal-cursor-color)
782 (cua-read-only-cursor-color, cua-overwrite-cursor-color)
783 (cua-global-mark-cursor-color):
784 * mail/undigest.el (rmail-forward-separator-regex):
785 Fix typos in docstrings.
786
787 * comint.el (comint-check-proc, make-comint-in-buffer)
788 (comint-source-default): Doc fixes.
789
790 * term.el (term-send-string): Improve argument/docstring
791 consistency.
792
7932005-06-09 Luc Teirlinck <teirllm@auburn.edu>
794
795 * comint.el (comint-send-input): Bind `inhibit-read-only' around
796 call to `delete-region'.
797 (comint-mode-hook): Do not enable Font Lock by default.
798
7992005-06-09 Lute Kamstra <lute@gnu.org>
800
801 * textmodes/ispell.el (ispell-menu-map-needed): flyspell-mode
802 could be void.
803
12005-06-09 Stefan Monnier <monnier@iro.umontreal.ca> 8042005-06-09 Stefan Monnier <monnier@iro.umontreal.ca>
2 805
3 * emacs-lisp/debug.el (debugger-will-be-back): New var. 806 * emacs-lisp/debug.el (debugger-will-be-back): New var.
@@ -9,6 +812,9 @@
9 812
102005-06-09 Juanma Barranquero <lekktu@gmail.com> 8132005-06-09 Juanma Barranquero <lekktu@gmail.com>
11 814
815 * window.el (shrink-window-if-larger-than-buffer)
816 (window-size-fixed): Fix typo in docstring.
817
12 * thumbs.el: Don't set `auto-image-file-mode'. Do not create the 818 * thumbs.el: Don't set `auto-image-file-mode'. Do not create the
13 thumbnails directory on loading. 819 thumbnails directory on loading.
14 (thumbs-conversion-program): Use `eq' to check the system type, 820 (thumbs-conversion-program): Use `eq' to check the system type,
@@ -9719,7 +10525,7 @@
9719 * toolbar/tool-bar.el (tool-bar-setup): Tool bar item dired uses 10525 * toolbar/tool-bar.el (tool-bar-setup): Tool bar item dired uses
9720 icon diropen. New tool bar item find-file-existing uses icon open. 10526 icon diropen. New tool bar item find-file-existing uses icon open.
9721 10527
9722 * dired.el (dired-read-dir-and-switches): Call read-driectory-name 10528 * dired.el (dired-read-dir-and-switches): Call read-directory-name
9723 instead of read-file-name. 10529 instead of read-file-name.
9724 10530
97252004-11-02 Ulf Jasper <ulf.jasper@web.de> 105312004-11-02 Ulf Jasper <ulf.jasper@web.de>
@@ -17838,8 +18644,8 @@
17838 18644
178392004-01-21 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> 186452004-01-21 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
17840 18646
17841 * term/x-win.el: Call menu-bar-enable-clipboard and make Paste 18647 * term/x-win.el (x-clipboard-yank, menu-bar-edit-menu): Call
17842 use clipboard first. 18648 menu-bar-enable-clipboard and make Paste use clipboard first.
17843 18649
178442004-01-20 Stefan Monnier <monnier@iro.umontreal.ca> 186502004-01-20 Stefan Monnier <monnier@iro.umontreal.ca>
17845 18651
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index ed29ddf2dd3..caed94c1404 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -217,21 +217,19 @@ $(lisp)/progmodes/cc-mode.elc: \
217 217
218# Prepare a bootstrap in the lisp subdirectory. 218# Prepare a bootstrap in the lisp subdirectory.
219# 219#
220# Build loaddefs.el, because it's not sure it's up-to-date, and if it's not, 220# Build loaddefs.el to make sure it's up-to-date. If it's not, that
221# that might lead to errors during the bootstrap because something fails to 221# might lead to errors during the bootstrap because something fails to
222# autoload as expected. However, if there is no emacs binary, then we can't 222# autoload as expected. If there is no emacs binary, then we can't
223# build autoloads yet, so just make sure there's some loaddefs.el file, as 223# build autoloads yet. In that case we have to use ldefs-boot.el;
224# it's necessary for generating the binary (because loaddefs.el is an 224# bootstrap should always work with ldefs-boot.el. (Because
225# automatically generated file, we don't want to store it in the source 225# loaddefs.el is an automatically generated file, we don't want to
226# repository). 226# store it in the source repository).
227 227
228bootstrap-prepare: 228bootstrap-prepare:
229 if test -x $(EMACS); then \ 229 if test -x $(EMACS); then \
230 $(MAKE) $(MFLAGS) autoloads; \ 230 $(MAKE) $(MFLAGS) autoloads; \
231 else \ 231 else \
232 if test ! -r $(lisp)/loaddefs.el; then \ 232 cp $(lisp)/ldefs-boot.el $(lisp)/loaddefs.el; \
233 cp $(lisp)/ldefs-boot.el $(lisp)/loaddefs.el; \
234 fi \
235 fi 233 fi
236 234
237maintainer-clean: distclean 235maintainer-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 38572cd5bd1..42cbd79de07 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -745,6 +745,7 @@ language you are using."
745(define-key global-map [home] 'beginning-of-line) 745(define-key global-map [home] 'beginning-of-line)
746(define-key global-map [C-home] 'beginning-of-buffer) 746(define-key global-map [C-home] 'beginning-of-buffer)
747(define-key global-map [M-home] 'beginning-of-buffer-other-window) 747(define-key global-map [M-home] 'beginning-of-buffer-other-window)
748(define-key esc-map [home] 'beginning-of-buffer-other-window)
748(define-key global-map [left] 'backward-char) 749(define-key global-map [left] 'backward-char)
749(define-key global-map [up] 'previous-line) 750(define-key global-map [up] 'previous-line)
750(define-key global-map [right] 'forward-char) 751(define-key global-map [right] 'forward-char)
@@ -757,13 +758,17 @@ language you are using."
757(put 'scroll-left 'disabled t) 758(put 'scroll-left 'disabled t)
758(define-key global-map [C-next] 'scroll-left) 759(define-key global-map [C-next] 'scroll-left)
759(define-key global-map [M-next] 'scroll-other-window) 760(define-key global-map [M-next] 'scroll-other-window)
761(define-key esc-map [next] 'scroll-other-window)
760(define-key global-map [M-prior] 'scroll-other-window-down) 762(define-key global-map [M-prior] 'scroll-other-window-down)
763(define-key esc-map [prior] 'scroll-other-window-down)
761(define-key esc-map [?\C-\S-v] 'scroll-other-window-down) 764(define-key esc-map [?\C-\S-v] 'scroll-other-window-down)
762(define-key global-map [end] 'end-of-line) 765(define-key global-map [end] 'end-of-line)
763(define-key global-map [C-end] 'end-of-buffer) 766(define-key global-map [C-end] 'end-of-buffer)
764(define-key global-map [M-end] 'end-of-buffer-other-window) 767(define-key global-map [M-end] 'end-of-buffer-other-window)
768(define-key esc-map [end] 'end-of-buffer-other-window)
765(define-key global-map [begin] 'beginning-of-buffer) 769(define-key global-map [begin] 'beginning-of-buffer)
766(define-key global-map [M-begin] 'beginning-of-buffer-other-window) 770(define-key global-map [M-begin] 'beginning-of-buffer-other-window)
771(define-key esc-map [begin] 'beginning-of-buffer-other-window)
767;; (define-key global-map [select] 'function-key-error) 772;; (define-key global-map [select] 'function-key-error)
768;; (define-key global-map [print] 'function-key-error) 773;; (define-key global-map [print] 'function-key-error)
769(define-key global-map [execute] 'execute-extended-command) 774(define-key global-map [execute] 'execute-extended-command)
@@ -927,7 +932,9 @@ language you are using."
927(define-key global-map "\C-c" 'mode-specific-command-prefix) 932(define-key global-map "\C-c" 'mode-specific-command-prefix)
928 933
929(global-set-key [M-right] 'forward-word) 934(global-set-key [M-right] 'forward-word)
935(define-key esc-map [right] 'forward-word)
930(global-set-key [M-left] 'backward-word) 936(global-set-key [M-left] 'backward-word)
937(define-key esc-map [left] 'backward-word)
931;; ilya@math.ohio-state.edu says these bindings are standard on PC editors. 938;; ilya@math.ohio-state.edu says these bindings are standard on PC editors.
932(global-set-key [C-right] 'forward-word) 939(global-set-key [C-right] 'forward-word)
933(global-set-key [C-left] 'backward-word) 940(global-set-key [C-left] 'backward-word)
@@ -937,12 +944,18 @@ language you are using."
937;; This is "move to the clipboard", or as close as we come. 944;; This is "move to the clipboard", or as close as we come.
938(global-set-key [S-delete] 'kill-region) 945(global-set-key [S-delete] 'kill-region)
939 946
940(global-set-key [C-M-left] 'backward-sexp) 947(global-set-key [C-M-left] 'backward-sexp)
941(global-set-key [C-M-right] 'forward-sexp) 948(define-key esc-map [C-left] 'backward-sexp)
942(global-set-key [C-M-up] 'backward-up-list) 949(global-set-key [C-M-right] 'forward-sexp)
943(global-set-key [C-M-down] 'down-list) 950(define-key esc-map [C-right] 'forward-sexp)
944(global-set-key [C-M-home] 'beginning-of-defun) 951(global-set-key [C-M-up] 'backward-up-list)
945(global-set-key [C-M-end] 'end-of-defun) 952(define-key esc-map [C-up] 'backward-up-list)
953(global-set-key [C-M-down] 'down-list)
954(define-key esc-map [C-down] 'down-list)
955(global-set-key [C-M-home] 'beginning-of-defun)
956(define-key esc-map [C-home] 'beginning-of-defun)
957(global-set-key [C-M-end] 'end-of-defun)
958(define-key esc-map [C-end] 'end-of-defun)
946 959
947(define-key esc-map "\C-f" 'forward-sexp) 960(define-key esc-map "\C-f" 'forward-sexp)
948(define-key esc-map "\C-b" 'backward-sexp) 961(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 11ca245ffaf..5a486e82577 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -325,6 +325,8 @@ since it could result in memory overflow and make Emacs crash."
325 (eq system-type 'ms-dos)) 325 (eq system-type 'ms-dos))
326 ((string-match "\\`w32-" (symbol-name symbol)) 326 ((string-match "\\`w32-" (symbol-name symbol))
327 (eq system-type 'windows-nt)) 327 (eq system-type 'windows-nt))
328 ((string-match "\\`x-.*gtk" (symbol-name symbol))
329 (or (boundp 'gtk) (not (eq system-type 'windows-nt))))
328 ((string-match "\\`x-" (symbol-name symbol)) 330 ((string-match "\\`x-" (symbol-name symbol))
329 (fboundp 'x-create-frame)) 331 (fboundp 'x-create-frame))
330 (t t)))) 332 (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 5deb7880bdf..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,58 +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 '((t :inherit shadow)) 262 '((t :inherit shadow))
247 "`diff-mode' face used to highlight context and other side-information." 263 "`diff-mode' face used to highlight context and other side-information."
248 :group 'diff-mode) 264 :group 'diff-mode)
249(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)
250 268
251(defface diff-nonexistent-face 269(defface diff-nonexistent
252 '((t :inherit diff-file-header-face)) 270 '((t :inherit diff-file-header))
253 "`diff-mode' face used to highlight nonexistent files in recursive diffs." 271 "`diff-mode' face used to highlight nonexistent files in recursive diffs."
254 :group 'diff-mode) 272 :group 'diff-mode)
255(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)
256 276
257(defconst diff-yank-handler '(diff-yank-function)) 277(defconst diff-yank-handler '(diff-yank-function))
258(defun diff-yank-function (text) 278(defun diff-yank-function (text)
@@ -915,7 +935,7 @@ See `after-change-functions' for the meaning of BEG, END and LEN."
915Supports unified and context diffs as well as (to a lesser extent) 935Supports unified and context diffs as well as (to a lesser extent)
916normal diffs. 936normal diffs.
917When the buffer is read-only, the ESC prefix is not necessary. 937When the buffer is read-only, the ESC prefix is not necessary.
918IF 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
919headers for you on-the-fly. 939headers for you on-the-fly.
920 940
921You 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/ediff-mult.el b/lisp/ediff-mult.el
index 88ab31fe56a..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
diff --git a/lisp/ediff-util.el b/lisp/ediff-util.el
index b952c2fb2bf..b7b39f405e5 100644
--- a/lisp/ediff-util.el
+++ b/lisp/ediff-util.el
@@ -117,7 +117,7 @@ Commands:
117 (kill-all-local-variables) 117 (kill-all-local-variables)
118 (setq major-mode 'ediff-mode) 118 (setq major-mode 'ediff-mode)
119 (setq mode-name "Ediff") 119 (setq mode-name "Ediff")
120 (run-hooks 'ediff-mode-hook)) 120 (run-mode-hooks 'ediff-mode-hook))
121 121
122 122
123 123
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 f1ff37551d7..0ee67355bf4 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -614,7 +614,7 @@ Applies to the frame whose line point is on in the backtrace."
614 (terpri)) 614 (terpri))
615 615
616 (with-current-buffer (get-buffer debugger-record-buffer) 616 (with-current-buffer (get-buffer debugger-record-buffer)
617 (message "%s" 617 (message "%s"
618 (buffer-substring (line-beginning-position 0) 618 (buffer-substring (line-beginning-position 0)
619 (line-end-position 0))))) 619 (line-end-position 0)))))
620 620
@@ -656,22 +656,29 @@ functions to break on entry."
656;;;###autoload 656;;;###autoload
657(defun debug-on-entry (function) 657(defun debug-on-entry (function)
658 "Request FUNCTION to invoke debugger each time it is called. 658 "Request FUNCTION to invoke debugger each time it is called.
659If you tell the debugger to continue, FUNCTION's execution proceeds. 659
660This works by modifying the definition of FUNCTION, 660When called interactively, prompt for FUNCTION in the minibuffer.
661which 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
662Use \\[cancel-debug-on-entry] to cancel the effect of this command. 669Use \\[cancel-debug-on-entry] to cancel the effect of this command.
663Redefining FUNCTION also cancels it." 670Redefining FUNCTION also cancels it."
664 (interactive "aDebug on entry (to function): ") 671 (interactive "aDebug on entry (to function): ")
665 (when (and (subrp (symbol-function function)) 672 (when (and (subrp (symbol-function function))
666 (eq (cdr (subr-arity (symbol-function function))) 'unevalled)) 673 (eq (cdr (subr-arity (symbol-function function))) 'unevalled))
667 (error "Function %s is a special form" function)) 674 (error "Function %s is a special form" function))
668 (if (or (symbolp (symbol-function function)) 675 (if (or (symbolp (symbol-function function))
669 (subrp (symbol-function function))) 676 (subrp (symbol-function function)))
670 ;; The function is built-in or aliased to another function. 677 ;; The function is built-in or aliased to another function.
671 ;; Create a wrapper in which we can add the debug call. 678 ;; Create a wrapper in which we can add the debug call.
672 (fset function `(lambda (&rest debug-on-entry-args) 679 (fset function `(lambda (&rest debug-on-entry-args)
673 ,(interactive-form (symbol-function function)) 680 ,(interactive-form (symbol-function function))
674 (apply ',(symbol-function function) 681 (apply ',(symbol-function function)
675 debug-on-entry-args))) 682 debug-on-entry-args)))
676 (when (eq (car-safe (symbol-function function)) 'autoload) 683 (when (eq (car-safe (symbol-function function)) 'autoload)
677 ;; The function is autoloaded. Load its real definition. 684 ;; The function is autoloaded. Load its real definition.
@@ -692,14 +699,19 @@ Redefining FUNCTION also cancels it."
692;;;###autoload 699;;;###autoload
693(defun cancel-debug-on-entry (&optional function) 700(defun cancel-debug-on-entry (&optional function)
694 "Undo effect of \\[debug-on-entry] on FUNCTION. 701 "Undo effect of \\[debug-on-entry] on FUNCTION.
695If 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."
696 (interactive 705 (interactive
697 (list (let ((name 706 (list (let ((name
698 (completing-read "Cancel debug on entry (to function): " 707 (completing-read
699 (mapcar 'symbol-name debug-function-list) 708 "Cancel debug on entry to function (default: all functions): "
700 nil t nil))) 709 (mapcar 'symbol-name debug-function-list) nil t)))
701 (if name (intern name))))) 710 (when name
702 (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.
703 (progn 715 (progn
704 (let ((defn (debug-on-entry-1 function nil))) 716 (let ((defn (debug-on-entry-1 function nil)))
705 (condition-case nil 717 (condition-case nil
@@ -739,7 +751,7 @@ If argument is nil or an empty string, cancel for all functions."
739(defun debug-on-entry-1 (function flag) 751(defun debug-on-entry-1 (function flag)
740 (let* ((defn (symbol-function function)) 752 (let* ((defn (symbol-function function))
741 (tail defn)) 753 (tail defn))
742 (when (eq (car-safe tail) 'macro) 754 (when (eq (car-safe tail) 'macro)
743 (setq tail (cdr tail))) 755 (setq tail (cdr tail)))
744 (if (not (eq (car-safe tail) 'lambda)) 756 (if (not (eq (car-safe tail) 'lambda))
745 ;; 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/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/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 fe2b0a892a8..c6d479b173f 100644
--- a/lisp/emulation/cua-base.el
+++ b/lisp/emulation/cua-base.el
@@ -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/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/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 8240cceaaef..3fbf675406a 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
@@ -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 "")
@@ -1864,7 +1873,7 @@ created."
1864;; Make `modeline' an alias for `mode-line', for compatibility. 1873;; Make `modeline' an alias for `mode-line', for compatibility.
1865(put 'modeline 'face-alias 'mode-line) 1874(put 'modeline 'face-alias 'mode-line)
1866(put 'modeline-inactive 'face-alias 'mode-line-inactive) 1875(put 'modeline-inactive 'face-alias 'mode-line-inactive)
1867(put 'modeline-higilight 'face-alias 'mode-line-highlight) 1876(put 'modeline-highlight 'face-alias 'mode-line-highlight)
1868 1877
1869(defface header-line 1878(defface header-line
1870 '((default 1879 '((default
@@ -2290,5 +2299,5 @@ If that can't be done, return nil."
2290 2299
2291(provide 'faces) 2300(provide 'faces)
2292 2301
2293;;; arch-tag: 19a4759f-2963-445f-b004-425b9aadd7d6 2302;; arch-tag: 19a4759f-2963-445f-b004-425b9aadd7d6
2294;;; faces.el ends here 2303;;; faces.el ends here
diff --git a/lisp/files.el b/lisp/files.el
index b8ec5bf1cd0..2504dd2d129 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -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
@@ -2854,7 +2854,7 @@ the value is \"\"."
2854 2854
2855(defcustom make-backup-file-name-function nil 2855(defcustom make-backup-file-name-function nil
2856 "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'.
2857A value of nil gives the default `make-backup-file-name' behaviour. 2857A value of nil gives the default `make-backup-file-name' behavior.
2858 2858
2859This could be buffer-local to do something special for specific 2859This could be buffer-local to do something special for specific
2860files. 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/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 3693295e819..6b69dead414 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -969,9 +969,9 @@ one frame, otherwise the name is displayed on the frame's caption bar."
969 969
970(defun frame-current-scroll-bars (&optional frame) 970(defun frame-current-scroll-bars (&optional frame)
971 "Return the current scroll-bar settings in frame FRAME. 971 "Return the current scroll-bar settings in frame FRAME.
972Value is a cons (VERTICAL . HORISONTAL) where VERTICAL specifies the 972Value is a cons (VERTICAL . HORIZ0NTAL) where VERTICAL specifies the
973current location of the vertical scroll-bars (left, right, or nil), 973current location of the vertical scroll-bars (left, right, or nil),
974and HORISONTAL specifies the current location of the horisontal scroll 974and HORIZONTAL specifies the current location of the horizontal scroll
975bars (top, bottom, or nil)." 975bars (top, bottom, or nil)."
976 (let ((vert (frame-parameter frame 'vertical-scroll-bars)) 976 (let ((vert (frame-parameter frame 'vertical-scroll-bars))
977 (hor nil)) 977 (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 3681f2fa750..e210b4def7c 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,22 @@
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
12005-06-04 Luc Teirlinck <teirllm@auburn.edu> 202005-06-04 Luc Teirlinck <teirllm@auburn.edu>
2 21
3 * gnus-art.el (article-update-date-lapsed): Use `save-match-data'. 22 * gnus-art.el (article-update-date-lapsed): Use `save-match-data'.
@@ -71,7 +90,7 @@
71 90
722005-05-31 Kevin Greiner <kgreiner@xpediantsolutions.com> 912005-05-31 Kevin Greiner <kgreiner@xpediantsolutions.com>
73 92
74 * gnus-group.el (): Require gnus-sum and autoload functions to 93 * gnus-group.el: Require gnus-sum and autoload functions to
75 resolve warnings when gnus-group.el compiled alone. 94 resolve warnings when gnus-group.el compiled alone.
76 95
772005-05-30 Reiner Steib <Reiner.Steib@gmx.de> 962005-05-30 Reiner Steib <Reiner.Steib@gmx.de>
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 f178576da4e..b53596a50a1 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/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 4ac9546de64..2d9313bb0ea 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -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)
@@ -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
@@ -2271,7 +2272,7 @@ If no merge has yet taken place, toggle automatic merging option."
2271 2272
2272(defun ido-magic-forward-char () 2273(defun ido-magic-forward-char ()
2273 "Move forward in user input or perform magic action. 2274 "Move forward in user input or perform magic action.
2274If 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:
2275C-x C-b ... C-f switch to ido-find-file. 2276C-x C-b ... C-f switch to ido-find-file.
2276C-x C-f ... C-f fallback to non-ido find-file. 2277C-x C-f ... C-f fallback to non-ido find-file.
2277C-x C-d ... C-f fallback to non-ido brief dired. 2278C-x C-d ... C-f fallback to non-ido brief dired.
@@ -2414,13 +2415,13 @@ If no buffer or file exactly matching the prompt exists, maybe create a new one.
2414 (exit-minibuffer)) 2415 (exit-minibuffer))
2415 2416
2416(defun ido-enter-find-file () 2417(defun ido-enter-find-file ()
2417 "Drop into find-file from buffer switching." 2418 "Drop into `find-file' from buffer switching."
2418 (interactive) 2419 (interactive)
2419 (setq ido-exit 'find-file) 2420 (setq ido-exit 'find-file)
2420 (exit-minibuffer)) 2421 (exit-minibuffer))
2421 2422
2422(defun ido-enter-switch-buffer () 2423(defun ido-enter-switch-buffer ()
2423 "Drop into ido-switch-buffer from file switching." 2424 "Drop into `ido-switch-buffer' from file switching."
2424 (interactive) 2425 (interactive)
2425 (setq ido-exit 'switch-to-buffer) 2426 (setq ido-exit 'switch-to-buffer)
2426 (exit-minibuffer)) 2427 (exit-minibuffer))
@@ -3016,7 +3017,7 @@ for first matching file."
3016(defun ido-make-buffer-list (default) 3017(defun ido-make-buffer-list (default)
3017 ;; Return the current list of buffers. 3018 ;; Return the current list of buffers.
3018 ;; Currently visible buffers are put at the end of the list. 3019 ;; Currently visible buffers are put at the end of the list.
3019 ;; 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
3020 ;; 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
3021 ;; 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,
3022 ;; it is put to the start of the list. 3023 ;; it is put to the start of the list.
@@ -3496,7 +3497,7 @@ for first matching file."
3496;;; VISIT CHOSEN BUFFER 3497;;; VISIT CHOSEN BUFFER
3497(defun ido-visit-buffer (buffer method &optional record) 3498(defun ido-visit-buffer (buffer method &optional record)
3498 "Visit file named FILE according to METHOD. 3499 "Visit file named FILE according to METHOD.
3499Record command in command-history if optional RECORD is non-nil." 3500Record command in `command-history' if optional RECORD is non-nil."
3500 3501
3501 (let (win newframe) 3502 (let (win newframe)
3502 (cond 3503 (cond
@@ -3569,9 +3570,9 @@ in another frame.
3569 3570
3570As 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
3571displayed if substring-matching is used \(default). Look at 3572displayed if substring-matching is used \(default). Look at
3572`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
3573buffer 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
3574normal keybindings, except for the following: \\<ido-mode-map> 3575their normal keybindings, except for the following: \\<ido-mode-map>
3575 3576
3576RET 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
3577list is empty, possibly prompt to create new buffer. 3578list is empty, possibly prompt to create new buffer.
@@ -3654,11 +3655,11 @@ The file is displayed according to `ido-default-file-method' -- the
3654default 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
3655visible in another frame. 3656visible in another frame.
3656 3657
3657The file name is selected interactively by typing a substring. As you type 3658The file name is selected interactively by typing a substring. As you
3658in 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
3659substring-matching is used \(default). Look at `ido-enable-prefix' and 3660if substring-matching is used \(default). Look at `ido-enable-prefix' and
3660`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
3661then be selected. As you type, most keys have their normal keybindings, 3662then be selected. As you type, most keys have their normal keybindings,
3662except for the following: \\<ido-mode-map> 3663except for the following: \\<ido-mode-map>
3663 3664
3664RET 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
@@ -4171,7 +4172,7 @@ For details of keybindings, do `\\[describe-function] ido-find-file'."
4171Return the name of a buffer selected. 4172Return the name of a buffer selected.
4172PROMPT 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
4173buffer 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.
4174If REQUIRE-MATCH is non-nil, an existing-buffer must be selected." 4175If REQUIRE-MATCH is non-nil, an existing buffer must be selected."
4175 (let* ((ido-current-directory nil) 4176 (let* ((ido-current-directory nil)
4176 (ido-directory-nonreadable nil) 4177 (ido-directory-nonreadable nil)
4177 (ido-directory-too-big nil) 4178 (ido-directory-too-big nil)
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 4c6a0ea027d..b34fd013df3 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -3524,29 +3524,37 @@ the variable `Info-file-list-for-emacs'."
3524 (t 3524 (t
3525 (Info-goto-emacs-command-node command))))) 3525 (Info-goto-emacs-command-node command)))))
3526 3526
3527(defface Info-title-1-face 3527(defface info-title-1
3528 '((((type tty pc) (class color)) :foreground "green" :weight bold) 3528 '((((type tty pc) (class color)) :foreground "green" :weight bold)
3529 (t :height 1.2 :inherit Info-title-2-face)) 3529 (t :height 1.2 :inherit info-title-2))
3530 "Face for Info titles at level 1." 3530 "Face for info titles at level 1."
3531 :group 'info) 3531 :group 'info)
3532;; backward-compatibility alias
3533(put 'Info-title-1-face 'face-alias 'info-title-1)
3532 3534
3533(defface Info-title-2-face 3535(defface info-title-2
3534 '((((type tty pc) (class color)) :foreground "lightblue" :weight bold) 3536 '((((type tty pc) (class color)) :foreground "lightblue" :weight bold)
3535 (t :height 1.2 :inherit Info-title-3-face)) 3537 (t :height 1.2 :inherit info-title-3))
3536 "Face for Info titles at level 2." 3538 "Face for info titles at level 2."
3537 :group 'info) 3539 :group 'info)
3540;; backward-compatibility alias
3541(put 'Info-title-2-face 'face-alias 'info-title-2)
3538 3542
3539(defface Info-title-3-face 3543(defface info-title-3
3540 '((((type tty pc) (class color)) :weight bold) 3544 '((((type tty pc) (class color)) :weight bold)
3541 (t :height 1.2 :inherit Info-title-4-face)) 3545 (t :height 1.2 :inherit info-title-4))
3542 "Face for Info titles at level 3." 3546 "Face for info titles at level 3."
3543 :group 'info) 3547 :group 'info)
3548;; backward-compatibility alias
3549(put 'Info-title-3-face 'face-alias 'info-title-3)
3544 3550
3545(defface Info-title-4-face 3551(defface info-title-4
3546 '((((type tty pc) (class color)) :weight bold) 3552 '((((type tty pc) (class color)) :weight bold)
3547 (t :weight bold :inherit variable-pitch)) 3553 (t :weight bold :inherit variable-pitch))
3548 "Face for Info titles at level 4." 3554 "Face for info titles at level 4."
3549 :group 'info) 3555 :group 'info)
3556;; backward-compatibility alias
3557(put 'Info-title-4-face 'face-alias 'info-title-4)
3550 3558
3551(defface info-menu-header 3559(defface info-menu-header
3552 '((((type tty pc)) 3560 '((((type tty pc))
@@ -3686,10 +3694,10 @@ Preserve text properties."
3686 nil t) 3694 nil t)
3687 (let* ((c (preceding-char)) 3695 (let* ((c (preceding-char))
3688 (face 3696 (face
3689 (cond ((= c ?*) 'Info-title-1-face) 3697 (cond ((= c ?*) 'info-title-1)
3690 ((= c ?=) 'Info-title-2-face) 3698 ((= c ?=) 'info-title-2)
3691 ((= c ?-) 'Info-title-3-face) 3699 ((= c ?-) 'info-title-3)
3692 (t 'Info-title-4-face)))) 3700 (t 'info-title-4))))
3693 (put-text-property (match-beginning 1) (match-end 1) 3701 (put-text-property (match-beginning 1) (match-end 1)
3694 'font-lock-face face)) 3702 'font-lock-face face))
3695 ;; 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/mule-cmds.el b/lisp/international/mule-cmds.el
index daab87259a3..4174bcda499 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -607,7 +607,7 @@ then call `write-region', then afterward this variable will be non-nil
607only if the user was explicitly asked and specified a coding system.") 607only if the user was explicitly asked and specified a coding system.")
608 608
609(defvar select-safe-coding-system-accept-default-p nil 609(defvar select-safe-coding-system-accept-default-p nil
610 "If non-nil, a function to control the behaviour of coding system selection. 610 "If non-nil, a function to control the behavior of coding system selection.
611The meaning is the same as the argument ACCEPT-DEFAULT-P of the 611The meaning is the same as the argument ACCEPT-DEFAULT-P of the
612function `select-safe-coding-system' (which see). This variable 612function `select-safe-coding-system' (which see). This variable
613overrides that argument.") 613overrides that argument.")
@@ -1552,7 +1552,7 @@ But, if this flag is non-nil, it displays them in echo area instead."
1552 :group 'mule) 1552 :group 'mule)
1553 1553
1554(defvar input-method-exit-on-invalid-key nil 1554(defvar input-method-exit-on-invalid-key nil
1555 "This flag controls the behaviour of an input method on invalid key input. 1555 "This flag controls the behavior of an input method on invalid key input.
1556Usually, when a user types a key which doesn't start any character 1556Usually, when a user types a key which doesn't start any character
1557handled by the input method, the key is handled by turning off the 1557handled by the input method, the key is handled by turning off the
1558input method temporarily. After that key, the input method is re-enabled. 1558input method temporarily. After that key, the input method is re-enabled.
diff --git a/lisp/isearchb.el b/lisp/isearchb.el
index 5c70bd8fc00..dbcbb1b7af2 100644
--- a/lisp/isearchb.el
+++ b/lisp/isearchb.el
@@ -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 0cb12d391ff..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, 2005 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>
@@ -871,10 +872,8 @@ it is put to the start of the list."
871 872
872(defun iswitchb-to-end (lst) 873(defun iswitchb-to-end (lst)
873 "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'."
874 (mapcar 875 (dolist (elem lst)
875 (lambda (elem) 876 (setq iswitchb-temp-buflist (delq elem iswitchb-temp-buflist)))
876 (setq iswitchb-temp-buflist (delq elem iswitchb-temp-buflist)))
877 lst)
878 (setq iswitchb-temp-buflist (nconc iswitchb-temp-buflist lst))) 877 (setq iswitchb-temp-buflist (nconc iswitchb-temp-buflist lst)))
879 878
880(defun iswitchb-get-buffers-in-frames (&optional current) 879(defun iswitchb-get-buffers-in-frames (&optional current)
@@ -915,33 +914,19 @@ current frame, rather than all frames, regardless of value of
915 "Return buffers matching REGEXP. 914 "Return buffers matching REGEXP.
916If STRING-FORMAT is nil, consider REGEXP as just a string. 915If STRING-FORMAT is nil, consider REGEXP as just a string.
917BUFFER-LIST can be list of buffers or list of strings." 916BUFFER-LIST can be list of buffers or list of strings."
918 (let* ((case-fold-search (iswitchb-case)) 917 (let* ((case-fold-search (iswitchb-case))
919 ;; need reverse since we are building up list backwards 918 name ret)
920 (list (reverse buffer-list)) 919 (if (null string-format) (setq regexp (regexp-quote regexp)))
921 (do-string (stringp (car list)))
922 name
923 ret)
924 (setq iswitchb-invalid-regexp nil) 920 (setq iswitchb-invalid-regexp nil)
925 (catch 'invalid-regexp 921 (condition-case error
926 (mapcar 922 (dolist (x buffer-list (nreverse ret))
927 (lambda (x) 923 (setq name (if (stringp x) x (buffer-name x)))
928 924 (when (and (string-match regexp name)
929 (if do-string 925 (not (iswitchb-ignore-buffername-p name)))
930 (setq name x) ;We already have the name 926 (push name ret)))
931 (setq name (buffer-name x))) 927 (invalid-regexp
932 928 (setq iswitchb-invalid-regexp t)
933 (cond 929 (cdr error)))))
934 ((and (if (not string-format)
935 (string-match (regexp-quote regexp) name)
936 (condition-case error
937 (string-match regexp name)
938 (invalid-regexp
939 (setq iswitchb-invalid-regexp t)
940 (throw 'invalid-regexp (setq ret (cdr error))))))
941 (not (iswitchb-ignore-buffername-p name)))
942 (setq ret (cons name ret)))))
943 list))
944 ret))
945 930
946(defun iswitchb-ignore-buffername-p (bufname) 931(defun iswitchb-ignore-buffername-p (bufname)
947 "Return t if the buffer BUFNAME should be ignored." 932 "Return t if the buffer BUFNAME should be ignored."
@@ -1476,5 +1461,5 @@ This mode enables switching between buffers using substrings. See
1476 1461
1477(provide 'iswitchb) 1462(provide 'iswitchb)
1478 1463
1479;;; arch-tag: d74198ae-753f-44f2-b34f-0c515398d90a 1464;; arch-tag: d74198ae-753f-44f2-b34f-0c515398d90a
1480;;; 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 a830374d0c6..497cdaeae2e 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -313,7 +313,7 @@
313 (setq name (concat (downcase (substring name 0 (match-beginning 0))) 313 (setq name (concat (downcase (substring name 0 (match-beginning 0)))
314 "-" 314 "-"
315 (substring name (match-end 0))))) 315 (substring name (match-end 0)))))
316 (if (eq system-type 'ms-dos) 316 (if (memq system-type '(ms-dos windows-nt cygwin))
317 (message "Dumping under the name emacs") 317 (message "Dumping under the name emacs")
318 (message "Dumping under names emacs and %s" name))) 318 (message "Dumping under names emacs and %s" name)))
319 (condition-case () 319 (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/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 ce2af0d1bfe..a857c2d88bb 100644
--- a/lisp/makefile.w32-in
+++ b/lisp/makefile.w32-in
@@ -289,13 +289,13 @@ recompile: doit
289 289
290# Prepare a bootstrap in the lisp subdirectory. 290# Prepare a bootstrap in the lisp subdirectory.
291# 291#
292# Build loaddefs.el, because it's not sure it's up-to-date, and if it's not, 292# Build loaddefs.el to make sure it's up-to-date. If it's not, that
293# that might lead to errors during the bootstrap because something fails to 293# might lead to errors during the bootstrap because something fails to
294# autoload as expected. However, if there is no emacs binary, then we can't 294# autoload as expected. If there is no emacs binary, then we can't
295# build autoloads yet, so just make sure there's some loaddefs.el file, as 295# build autoloads yet. In that case we have to use ldefs-boot.el;
296# it's necessary for generating the binary (because loaddefs.el is an 296# bootstrap should always work with ldefs-boot.el. (Because
297# automatically generated file, we don't want to store it in the source 297# loaddefs.el is an automatically generated file, we don't want to
298# repository). 298# store it in the source repository).
299# 299#
300# Remove compiled Lisp files so that bootstrap-emacs will be built from 300# Remove compiled Lisp files so that bootstrap-emacs will be built from
301# sources only. 301# sources only.
@@ -305,15 +305,13 @@ bootstrap-clean: bootstrap-clean-$(SHELLTYPE) loaddefs.el
305 305
306bootstrap-clean-CMD: 306bootstrap-clean-CMD:
307# if exist $(EMACS) $(MAKE) $(MFLAGS) autoloads 307# if exist $(EMACS) $(MAKE) $(MFLAGS) autoloads
308 if not exist $(lisp)\loaddefs.el cp $(lisp)/ldefs-boot.el $(lisp)/loaddefs.el 308 cp $(lisp)/ldefs-boot.el $(lisp)/loaddefs.el
309 -for %%f in (. $(WINS)) do for %%g in (%%f\*.elc) do @$(DEL) %%g 309 -for %%f in (. $(WINS)) do for %%g in (%%f\*.elc) do @$(DEL) %%g
310 310
311bootstrap-clean-SH: 311bootstrap-clean-SH:
312# if test -f $(EMACS); then $(MAKE) $(MFLAGS) autoloads; fi 312# if test -f $(EMACS); then $(MAKE) $(MFLAGS) autoloads; fi
313# -rm -f $(lisp)/*.elc $(lisp)/*/*.elc 313# -rm -f $(lisp)/*.elc $(lisp)/*/*.elc
314 if ! test -r $(lisp)/loaddefs.el; then \ 314 cp $(lisp)/ldefs-boot.el $(lisp)/loaddefs.el
315 cp $(lisp)/ldefs-boot.el $(lisp)/loaddefs.el; \
316 fi
317 -for dir in . $(WINS); do rm -f $$dir/*.elc; done 315 -for dir in . $(WINS); do rm -f $$dir/*.elc; done
318 316
319# Generate/update files for the bootstrap process. 317# 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 41ea0238c6b..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,10 +6678,6 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
6434;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 6678;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6435 6679
6436 6680
6437;;; Files are not supposed to change Emacs behavior when you merely load them.
6438;;; (pr-update-menus t)
6439
6440
6441(provide 'printing) 6681(provide 'printing)
6442 6682
6443 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 e0c8ded307a..3f3b385c5ed 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -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
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 7e2022cc11c..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
@@ -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
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index f3a95514c13..7d4fc00cd56 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -1220,7 +1220,7 @@ containing the executable being debugged."
1220The directory containing FILE becomes the initial working directory 1220The directory containing FILE becomes the initial working directory
1221and source-file directory for your debugger. 1221and source-file directory for your debugger.
1222 1222
1223You 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
1224directories if your program contains sources from more than one directory." 1224directories if your program contains sources from more than one directory."
1225 (interactive (list (gud-query-cmdline 'xdb))) 1225 (interactive (list (gud-query-cmdline 'xdb)))
1226 1226
@@ -3139,8 +3139,6 @@ only tooltips in the buffer containing the overlay arrow."
3139 'gud-tooltip-modes "22.1") 3139 'gud-tooltip-modes "22.1")
3140(define-obsolete-variable-alias 'tooltip-gud-display 3140(define-obsolete-variable-alias 'tooltip-gud-display
3141 'gud-tooltip-display "22.1") 3141 'gud-tooltip-display "22.1")
3142(define-obsolete-variable-alias 'tooltip-use-echo-area
3143 'gud-tooltip-echo-area "22.1")
3144 3142
3145;;; Reacting on mouse movements 3143;;; Reacting on mouse movements
3146 3144
@@ -3242,7 +3240,7 @@ This event can be examined by forms in GUD-TOOLTIP-DISPLAY.")
3242 3240
3243; This will only display data that comes in one chunk. 3241; This will only display data that comes in one chunk.
3244; Larger arrays (say 400 elements) are displayed in 3242; Larger arrays (say 400 elements) are displayed in
3245; the tootip incompletely and spill over into the gud buffer. 3243; the tooltip incompletely and spill over into the gud buffer.
3246; Switching the process-filter creates timing problems and 3244; Switching the process-filter creates timing problems and
3247; it may be difficult to do better. Using annotations as in 3245; it may be difficult to do better. Using annotations as in
3248; gdb-ui.el gets round this problem. 3246; gdb-ui.el gets round this problem.
@@ -3250,7 +3248,7 @@ This event can be examined by forms in GUD-TOOLTIP-DISPLAY.")
3250 "Process debugger output and show it in a tooltip window." 3248 "Process debugger output and show it in a tooltip window."
3251 (set-process-filter process gud-tooltip-original-filter) 3249 (set-process-filter process gud-tooltip-original-filter)
3252 (tooltip-show (tooltip-strip-prompt process output) 3250 (tooltip-show (tooltip-strip-prompt process output)
3253 gud-tooltip-echo-area)) 3251 (or gud-tooltip-echo-area tooltip-use-echo-area)))
3254 3252
3255(defun gud-tooltip-print-command (expr) 3253(defun gud-tooltip-print-command (expr)
3256 "Return a suitable command to print the expression EXPR. 3254 "Return a suitable command to print the expression EXPR.
@@ -3295,7 +3293,9 @@ This function must return nil if it doesn't handle EVENT."
3295 (cddr mouse)))) 3293 (cddr mouse))))
3296 (let ((define-elt (assoc expr gdb-define-alist))) 3294 (let ((define-elt (assoc expr gdb-define-alist)))
3297 (unless (null define-elt) 3295 (unless (null define-elt)
3298 (tooltip-show (cdr define-elt)) 3296 (tooltip-show
3297 (cdr define-elt)
3298 (or gud-tooltip-echo-area tooltip-use-echo-area))
3299 expr)))) 3299 expr))))
3300 (let ((cmd (gud-tooltip-print-command expr))) 3300 (let ((cmd (gud-tooltip-print-command expr)))
3301 (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 d2d2dc6263a..e53b08b8c14 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -99,30 +99,32 @@
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(put 'makefile-space-face 'face-alias 'makefile-space)
108 109
109(defface makefile-targets-face 110(defface makefile-targets
110 ;; This needs to go along both with foreground and background colors (i.e. shell) 111 ;; This needs to go along both with foreground and background colors (i.e. shell)
111 '((t (:underline t))) 112 '((t (:inherit font-lock-function-name-face)))
112 "Face to use for additionally highlighting rule targets in Font-Lock mode." 113 "Face to use for additionally highlighting rule targets in Font-Lock mode."
113 :group 'faces 114 :group 'faces
114 :group 'makefile 115 :group 'makefile
115 :version "22.1") 116 :version "22.1")
116 117
117(defface makefile-shell-face 118(defface makefile-shell
118 '((((class color) (min-colors 88) (background light)) (:background "seashell1")) 119 ()
119 (((class color) (min-colors 88) (background dark)) (:background "seashell4"))) 120 ;;'((((class color) (min-colors 88) (background light)) (:background "seashell1"))
121 ;; (((class color) (min-colors 88) (background dark)) (:background "seashell4")))
120 "Face to use for additionally highlighting Shell commands in Font-Lock mode." 122 "Face to use for additionally highlighting Shell commands in Font-Lock mode."
121 :group 'faces 123 :group 'faces
122 :group 'makefile 124 :group 'makefile
123 :version "22.1") 125 :version "22.1")
124 126
125(defface makefile-makepp-perl-face 127(defface makefile-makepp-perl
126 '((((class color) (background light)) (:background "LightBlue1")) ; Camel Book 128 '((((class color) (background light)) (:background "LightBlue1")) ; Camel Book
127 (((class color) (background dark)) (:background "DarkBlue")) 129 (((class color) (background dark)) (:background "DarkBlue"))
128 (t (:reverse-video t))) 130 (t (:reverse-video t)))
@@ -302,8 +304,8 @@ not be enclosed in { } or ( )."
302 "Regex for filenames that will NOT be included in the target list.") 304 "Regex for filenames that will NOT be included in the target list.")
303 305
304(if (fboundp 'facemenu-unlisted-faces) 306(if (fboundp 'facemenu-unlisted-faces)
305 (add-to-list 'facemenu-unlisted-faces 'makefile-space-face)) 307 (add-to-list 'facemenu-unlisted-faces 'makefile-space))
306(defvar makefile-space-face 'makefile-space-face 308(defvar makefile-space 'makefile-space
307 "Face to use for highlighting leading spaces in Font-Lock mode.") 309 "Face to use for highlighting leading spaces in Font-Lock mode.")
308 310
309;; These lists were inspired by the old solution. But they are silly, because 311;; These lists were inspired by the old solution. But they are silly, because
@@ -348,14 +350,14 @@ not be enclosed in { } or ( )."
348 (,makefile-macroassign-regex 350 (,makefile-macroassign-regex
349 (1 font-lock-variable-name-face) 351 (1 font-lock-variable-name-face)
350 ;; This is for after != 352 ;; This is for after !=
351 (2 'makefile-shell-face prepend t) 353 (2 'makefile-shell prepend t)
352 ;; This is for after normal assignment 354 ;; This is for after normal assignment
353 (3 'font-lock-string-face prepend t)) 355 (3 'font-lock-string-face prepend t))
354 356
355 ;; Rule actions. 357 ;; Rule actions.
356 (makefile-match-action 358 (makefile-match-action
357 (1 font-lock-type-face) 359 (1 font-lock-type-face)
358 (2 'makefile-shell-face prepend) 360 (2 'makefile-shell prepend)
359 ;; Only makepp has builtin commands. 361 ;; Only makepp has builtin commands.
360 (3 font-lock-builtin-face prepend t)) 362 (3 font-lock-builtin-face prepend t))
361 363
@@ -367,7 +369,7 @@ not be enclosed in { } or ( )."
367 ("[^$]\\$\\([@%<?^+*_]\\|[a-zA-Z0-9]\\>\\)" 369 ("[^$]\\$\\([@%<?^+*_]\\|[a-zA-Z0-9]\\>\\)"
368 1 font-lock-constant-face prepend) 370 1 font-lock-constant-face prepend)
369 ("[^$]\\(\\$[@%*]\\)" 371 ("[^$]\\(\\$[@%*]\\)"
370 1 'makefile-targets-face prepend) 372 1 'makefile-targets append)
371 373
372 ;; Fontify conditionals and includes. 374 ;; Fontify conditionals and includes.
373 (,(concat "^\\(?: [ \t]*\\)?" 375 (,(concat "^\\(?: [ \t]*\\)?"
@@ -382,22 +384,22 @@ not be enclosed in { } or ( )."
382 ,@(if space 384 ,@(if space
383 '(;; Highlight lines that contain just whitespace. 385 '(;; Highlight lines that contain just whitespace.
384 ;; They can cause trouble, especially if they start with a tab. 386 ;; They can cause trouble, especially if they start with a tab.
385 ("^[ \t]+$" . makefile-space-face) 387 ("^[ \t]+$" . makefile-space)
386 388
387 ;; Highlight shell comments that Make treats as commands, 389 ;; Highlight shell comments that Make treats as commands,
388 ;; since these can fool people. 390 ;; since these can fool people.
389 ("^\t+#" 0 makefile-space-face t) 391 ("^\t+#" 0 makefile-space t)
390 392
391 ;; Highlight spaces that precede tabs. 393 ;; Highlight spaces that precede tabs.
392 ;; They can make a tab fail to be effective. 394 ;; They can make a tab fail to be effective.
393 ("^\\( +\\)\t" 1 makefile-space-face))) 395 ("^\\( +\\)\t" 1 makefile-space)))
394 396
395 ,@font-lock-keywords 397 ,@font-lock-keywords
396 398
397 ;; Do dependencies. 399 ;; Do dependencies.
398 (makefile-match-dependency 400 (makefile-match-dependency
399 (1 'makefile-targets-face prepend) 401 (1 'makefile-targets prepend)
400 (3 'makefile-shell-face prepend t)))) 402 (3 'makefile-shell prepend t))))
401 403
402(defconst makefile-font-lock-keywords 404(defconst makefile-font-lock-keywords
403 (makefile-make-font-lock-keywords 405 (makefile-make-font-lock-keywords
@@ -419,7 +421,7 @@ not be enclosed in { } or ( )."
419 "^\\(?: [ \t]*\\)?if\\(n\\)\\(?:def\\|eq\\)\\>" 421 "^\\(?: [ \t]*\\)?if\\(n\\)\\(?:def\\|eq\\)\\>"
420 422
421 '("[^$]\\(\\$[({][@%*][DF][})]\\)" 423 '("[^$]\\(\\$[({][@%*][DF][})]\\)"
422 1 'makefile-targets-face prepend) 424 1 'makefile-targets append)
423 425
424 ;; $(function ...) ${function ...} 426 ;; $(function ...) ${function ...}
425 '("[^$]\\$[({]\\([-a-zA-Z0-9_.]+\\s \\)" 427 '("[^$]\\$[({]\\([-a-zA-Z0-9_.]+\\s \\)"
@@ -428,7 +430,7 @@ not be enclosed in { } or ( )."
428 ;; $(shell ...) ${shell ...} 430 ;; $(shell ...) ${shell ...}
429 '("[^$]\\$\\([({]\\)shell[ \t]+" 431 '("[^$]\\$\\([({]\\)shell[ \t]+"
430 makefile-match-function-end nil nil 432 makefile-match-function-end nil nil
431 (1 'makefile-shell-face prepend t)))) 433 (1 'makefile-shell prepend t))))
432 434
433(defconst makefile-makepp-font-lock-keywords 435(defconst makefile-makepp-font-lock-keywords
434 (makefile-make-font-lock-keywords 436 (makefile-make-font-lock-keywords
@@ -438,7 +440,7 @@ not be enclosed in { } or ( )."
438 "^\\(?: [ \t]*\\)?\\(?:and[ \t]+\\|else[ \t]+\\|or[ \t]+\\)?if\\(n\\)\\(?:def\\|eq\\|sys\\)\\>" 440 "^\\(?: [ \t]*\\)?\\(?:and[ \t]+\\|else[ \t]+\\|or[ \t]+\\)?if\\(n\\)\\(?:def\\|eq\\|sys\\)\\>"
439 441
440 '("[^$]\\(\\$[({]\\(?:output\\|stem\\|target\\)s?\\_>.*?[})]\\)" 442 '("[^$]\\(\\$[({]\\(?:output\\|stem\\|target\\)s?\\_>.*?[})]\\)"
441 1 'makefile-targets-face prepend) 443 1 'makefile-targets append)
442 444
443 ;; Colon modifier keywords. 445 ;; Colon modifier keywords.
444 '("\\(:\\s *\\)\\(build_c\\(?:ache\\|heck\\)\\|env\\(?:ironment\\)?\\|foreach\\|signature\\|scanner\\|quickscan\\|smartscan\\)\\>\\([^:\n]*\\)" 446 '("\\(:\\s *\\)\\(build_c\\(?:ache\\|heck\\)\\|env\\(?:ironment\\)?\\|foreach\\|signature\\|scanner\\|quickscan\\|smartscan\\)\\>\\([^:\n]*\\)"
@@ -453,32 +455,32 @@ not be enclosed in { } or ( )."
453 ;; $(shell ...) $((shell ...)) ${shell ...} ${{shell ...}} 455 ;; $(shell ...) $((shell ...)) ${shell ...} ${{shell ...}}
454 '("[^$]\\$\\(((?\\|{{?\\)shell\\(?:[-_]\\(?:global[-_]\\)?once\\)?[ \t]+" 456 '("[^$]\\$\\(((?\\|{{?\\)shell\\(?:[-_]\\(?:global[-_]\\)?once\\)?[ \t]+"
455 makefile-match-function-end nil nil 457 makefile-match-function-end nil nil
456 (1 'makefile-shell-face prepend t)) 458 (1 'makefile-shell prepend t))
457 459
458 ;; $(perl ...) $((perl ...)) ${perl ...} ${{perl ...}} 460 ;; $(perl ...) $((perl ...)) ${perl ...} ${{perl ...}}
459 '("[^$]\\$\\(((?\\|{{?\\)makeperl[ \t]+" 461 '("[^$]\\$\\(((?\\|{{?\\)makeperl[ \t]+"
460 makefile-match-function-end nil nil 462 makefile-match-function-end nil nil
461 (1 'makefile-makepp-perl-face prepend t)) 463 (1 'makefile-makepp-perl prepend t))
462 '("[^$]\\$\\(((?\\|{{?\\)perl[ \t]+" 464 '("[^$]\\$\\(((?\\|{{?\\)perl[ \t]+"
463 makefile-match-function-end nil nil 465 makefile-match-function-end nil nil
464 (1 'makefile-makepp-perl-face t t)) 466 (1 'makefile-makepp-perl t t))
465 467
466 ;; Can we unify these with (if (match-end 1) 'prepend t)? 468 ;; Can we unify these with (if (match-end 1) 'prepend t)?
467 '("ifmakeperl\\s +\\(.*\\)" 1 'makefile-makepp-perl-face prepend) 469 '("ifmakeperl\\s +\\(.*\\)" 1 'makefile-makepp-perl prepend)
468 '("ifperl\\s +\\(.*\\)" 1 'makefile-makepp-perl-face t) 470 '("ifperl\\s +\\(.*\\)" 1 'makefile-makepp-perl t)
469 471
470 ;; Perl block single- or multiline, as statement or rule action. 472 ;; Perl block single- or multiline, as statement or rule action.
471 ;; Don't know why the initial newline in 2nd variant of group 2 doesn't get skipped. 473 ;; Don't know why the initial newline in 2nd variant of group 2 doesn't get skipped.
472 '("\\<make\\(?:perl\\|sub\\s +\\S +\\)\\s *\n?\\s *{\\(?:{\\s *\n?\\(\\(?:.*\n\\)+?\\)\\s *}\\|\\s *\\(\\(?:.*?\\|\n?\\(?:.*\n\\)+?\\)\\)\\)}" 474 '("\\<make\\(?:perl\\|sub\\s +\\S +\\)\\s *\n?\\s *{\\(?:{\\s *\n?\\(\\(?:.*\n\\)+?\\)\\s *}\\|\\s *\\(\\(?:.*?\\|\n?\\(?:.*\n\\)+?\\)\\)\\)}"
473 (1 'makefile-makepp-perl-face prepend t) 475 (1 'makefile-makepp-perl prepend t)
474 (2 'makefile-makepp-perl-face prepend t)) 476 (2 'makefile-makepp-perl prepend t))
475 '("\\<\\(?:perl\\|sub\\s +\\S +\\)\\s *\n?\\s *{\\(?:{\\s *\n?\\(\\(?:.*\n\\)+?\\)\\s *}\\|\\s *\\(\\(?:.*?\\|\n?\\(?:.*\n\\)+?\\)\\)\\)}" 477 '("\\<\\(?:perl\\|sub\\s +\\S +\\)\\s *\n?\\s *{\\(?:{\\s *\n?\\(\\(?:.*\n\\)+?\\)\\s *}\\|\\s *\\(\\(?:.*?\\|\n?\\(?:.*\n\\)+?\\)\\)\\)}"
476 (1 'makefile-makepp-perl-face t t) 478 (1 'makefile-makepp-perl t t)
477 (2 'makefile-makepp-perl-face t t)) 479 (2 'makefile-makepp-perl t t))
478 480
479 ;; Statement style perl block. 481 ;; Statement style perl block.
480 '("perl[-_]begin\\s *\\(?:\\s #.*\\)?\n\\(\\(?:.*\n\\)+?\\)\\s *perl[-_]end\\>" 482 '("perl[-_]begin\\s *\\(?:\\s #.*\\)?\n\\(\\(?:.*\n\\)+?\\)\\s *perl[-_]end\\>"
481 1 'makefile-makepp-perl-face t))) 483 1 'makefile-makepp-perl t)))
482 484
483(defconst makefile-bsdmake-font-lock-keywords 485(defconst makefile-bsdmake-font-lock-keywords
484 (makefile-make-font-lock-keywords 486 (makefile-make-font-lock-keywords
@@ -911,6 +913,8 @@ Makefile mode can be configured by modifying the following variables:
911 (backward-char)) 913 (backward-char))
912 (get-text-property (point) 'face) 914 (get-text-property (point) 'face)
913 (beginning-of-line) 915 (beginning-of-line)
916 (if (> (point) (+ (point-min) 2))
917 (eq (char-before (1- (point))) ?\\))
914 (if (looking-at makefile-dependency-regex) 918 (if (looking-at makefile-dependency-regex)
915 (throw 'found t)))) 919 (throw 'found t))))
916 (goto-char pt) 920 (goto-char pt)
@@ -1700,6 +1704,8 @@ matched in a rule action."
1700 (forward-char) 1704 (forward-char)
1701 (or (eq (char-after) ?=) 1705 (or (eq (char-after) ?=)
1702 (get-text-property (1- (point)) 'face) 1706 (get-text-property (1- (point)) 'face)
1707 (if (> (line-beginning-position) (+ (point-min) 2))
1708 (eq (char-before (line-end-position 0)) ?\\))
1703 (when (save-excursion 1709 (when (save-excursion
1704 (beginning-of-line) 1710 (beginning-of-line)
1705 (looking-at makefile-dependency-regex)) 1711 (looking-at makefile-dependency-regex))
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 7dc695f24bf..fa6b25b9a63 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/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/ruler-mode.el b/lisp/ruler-mode.el
index b0f1dcf6e03..b235ca70ad7 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
@@ -204,7 +204,7 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or
204 :group 'ruler-mode 204 :group 'ruler-mode
205 :type 'boolean) 205 :type 'boolean)
206 206
207(defface ruler-mode-default-face 207(defface ruler-mode-default
208 '((((type tty)) 208 '((((type tty))
209 (:inherit default 209 (:inherit default
210 :background "grey64" 210 :background "grey64"
@@ -220,83 +220,103 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or
220 ))) 220 )))
221 "Default face used by the ruler." 221 "Default face used by the ruler."
222 :group 'ruler-mode) 222 :group 'ruler-mode)
223;; backward-compatibility alias
224(put 'ruler-mode-default-face 'face-alias 'ruler-mode-default)
223 225
224(defface ruler-mode-pad-face 226(defface ruler-mode-pad
225 '((((type tty)) 227 '((((type tty))
226 (:inherit ruler-mode-default-face 228 (:inherit ruler-mode-default
227 :background "grey50" 229 :background "grey50"
228 )) 230 ))
229 (t 231 (t
230 (:inherit ruler-mode-default-face 232 (:inherit ruler-mode-default
231 :background "grey64" 233 :background "grey64"
232 ))) 234 )))
233 "Face used to pad inactive ruler areas." 235 "Face used to pad inactive ruler areas."
234 :group 'ruler-mode) 236 :group 'ruler-mode)
237;; backward-compatibility alias
238(put 'ruler-mode-pad-face 'face-alias 'ruler-mode-pad)
235 239
236(defface ruler-mode-margins-face 240(defface ruler-mode-margins
237 '((t 241 '((t
238 (:inherit ruler-mode-default-face 242 (:inherit ruler-mode-default
239 :foreground "white" 243 :foreground "white"
240 ))) 244 )))
241 "Face used to highlight margin areas." 245 "Face used to highlight margin areas."
242 :group 'ruler-mode) 246 :group 'ruler-mode)
247;; backward-compatibility alias
248(put 'ruler-mode-margins-face 'face-alias 'ruler-mode-margins)
243 249
244(defface ruler-mode-fringes-face 250(defface ruler-mode-fringes
245 '((t 251 '((t
246 (:inherit ruler-mode-default-face 252 (:inherit ruler-mode-default
247 :foreground "green" 253 :foreground "green"
248 ))) 254 )))
249 "Face used to highlight fringes areas." 255 "Face used to highlight fringes areas."
250 :group 'ruler-mode) 256 :group 'ruler-mode)
257;; backward-compatibility alias
258(put 'ruler-mode-fringes-face 'face-alias 'ruler-mode-fringes)
251 259
252(defface ruler-mode-column-number-face 260(defface ruler-mode-column-number
253 '((t 261 '((t
254 (:inherit ruler-mode-default-face 262 (:inherit ruler-mode-default
255 :foreground "black" 263 :foreground "black"
256 ))) 264 )))
257 "Face used to highlight number graduations." 265 "Face used to highlight number graduations."
258 :group 'ruler-mode) 266 :group 'ruler-mode)
267;; backward-compatibility alias
268(put 'ruler-mode-column-number-face 'face-alias 'ruler-mode-column-number)
259 269
260(defface ruler-mode-fill-column-face 270(defface ruler-mode-fill-column
261 '((t 271 '((t
262 (:inherit ruler-mode-default-face 272 (:inherit ruler-mode-default
263 :foreground "red" 273 :foreground "red"
264 ))) 274 )))
265 "Face used to highlight the fill column character." 275 "Face used to highlight the fill column character."
266 :group 'ruler-mode) 276 :group 'ruler-mode)
277;; backward-compatibility alias
278(put 'ruler-mode-fill-column-face 'face-alias 'ruler-mode-fill-column)
267 279
268(defface ruler-mode-comment-column-face 280(defface ruler-mode-comment-column
269 '((t 281 '((t
270 (:inherit ruler-mode-default-face 282 (:inherit ruler-mode-default
271 :foreground "red" 283 :foreground "red"
272 ))) 284 )))
273 "Face used to highlight the comment column character." 285 "Face used to highlight the comment column character."
274 :group 'ruler-mode) 286 :group 'ruler-mode)
287;; backward-compatibility alias
288(put 'ruler-mode-comment-column-face 'face-alias 'ruler-mode-comment-column)
275 289
276(defface ruler-mode-goal-column-face 290(defface ruler-mode-goal-column
277 '((t 291 '((t
278 (:inherit ruler-mode-default-face 292 (:inherit ruler-mode-default
279 :foreground "red" 293 :foreground "red"
280 ))) 294 )))
281 "Face used to highlight the goal column character." 295 "Face used to highlight the goal column character."
282 :group 'ruler-mode) 296 :group 'ruler-mode)
297;; backward-compatibility alias
298(put 'ruler-mode-goal-column-face 'face-alias 'ruler-mode-goal-column)
283 299
284(defface ruler-mode-tab-stop-face 300(defface ruler-mode-tab-stop
285 '((t 301 '((t
286 (:inherit ruler-mode-default-face 302 (:inherit ruler-mode-default
287 :foreground "steelblue" 303 :foreground "steelblue"
288 ))) 304 )))
289 "Face used to highlight tab stop characters." 305 "Face used to highlight tab stop characters."
290 :group 'ruler-mode) 306 :group 'ruler-mode)
307;; backward-compatibility alias
308(put 'ruler-mode-tab-stop-face 'face-alias 'ruler-mode-tab-stop)
291 309
292(defface ruler-mode-current-column-face 310(defface ruler-mode-current-column
293 '((t 311 '((t
294 (:inherit ruler-mode-default-face 312 (:inherit ruler-mode-default
295 :weight bold 313 :weight bold
296 :foreground "yellow" 314 :foreground "yellow"
297 ))) 315 )))
298 "Face used to highlight the `current-column' character." 316 "Face used to highlight the `current-column' character."
299 :group 'ruler-mode) 317 :group 'ruler-mode)
318;; backward-compatibility alias
319(put 'ruler-mode-current-column-face 'face-alias 'ruler-mode-current-column)
300 320
301 321
302(defsubst ruler-mode-full-window-width () 322(defsubst ruler-mode-full-window-width ()
@@ -418,7 +438,7 @@ dragging. See also the variable `ruler-mode-dragged-symbol'."
418 (message "Goal column set to %d (click on %s again to unset it)" 438 (message "Goal column set to %d (click on %s again to unset it)"
419 newc 439 newc
420 (propertize (char-to-string ruler-mode-goal-column-char) 440 (propertize (char-to-string ruler-mode-goal-column-char)
421 'face 'ruler-mode-goal-column-face)) 441 'face 'ruler-mode-goal-column))
422 nil) ;; Don't start dragging. 442 nil) ;; Don't start dragging.
423 ) 443 )
424 (if (eq 'click (ruler-mode-mouse-drag-any-column-iteration 444 (if (eq 'click (ruler-mode-mouse-drag-any-column-iteration
@@ -628,34 +648,34 @@ Optional argument PROPS specifies other text properties to apply."
628 ;; Setup the scrollbar, fringes, and margins areas. 648 ;; Setup the scrollbar, fringes, and margins areas.
629 (lf (ruler-mode-space 649 (lf (ruler-mode-space
630 'left-fringe 650 'left-fringe
631 'face 'ruler-mode-fringes-face 651 'face 'ruler-mode-fringes
632 'help-echo (format ruler-mode-fringe-help-echo 652 'help-echo (format ruler-mode-fringe-help-echo
633 "Left" (or (car f) 0)))) 653 "Left" (or (car f) 0))))
634 (rf (ruler-mode-space 654 (rf (ruler-mode-space
635 'right-fringe 655 'right-fringe
636 'face 'ruler-mode-fringes-face 656 'face 'ruler-mode-fringes
637 'help-echo (format ruler-mode-fringe-help-echo 657 'help-echo (format ruler-mode-fringe-help-echo
638 "Right" (or (cadr f) 0)))) 658 "Right" (or (cadr f) 0))))
639 (lm (ruler-mode-space 659 (lm (ruler-mode-space
640 'left-margin 660 'left-margin
641 'face 'ruler-mode-margins-face 661 'face 'ruler-mode-margins
642 'help-echo (format ruler-mode-margin-help-echo 662 'help-echo (format ruler-mode-margin-help-echo
643 "Left" (or (car m) 0)))) 663 "Left" (or (car m) 0))))
644 (rm (ruler-mode-space 664 (rm (ruler-mode-space
645 'right-margin 665 'right-margin
646 'face 'ruler-mode-margins-face 666 'face 'ruler-mode-margins
647 'help-echo (format ruler-mode-margin-help-echo 667 'help-echo (format ruler-mode-margin-help-echo
648 "Right" (or (cdr m) 0)))) 668 "Right" (or (cdr m) 0))))
649 (sb (ruler-mode-space 669 (sb (ruler-mode-space
650 'scroll-bar 670 'scroll-bar
651 'face 'ruler-mode-pad-face)) 671 'face 'ruler-mode-pad))
652 ;; Remember the scrollbar vertical type. 672 ;; Remember the scrollbar vertical type.
653 (sbvt (car (window-current-scroll-bars))) 673 (sbvt (car (window-current-scroll-bars)))
654 ;; Create an "clean" ruler. 674 ;; Create an "clean" ruler.
655 (ruler 675 (ruler
656 (propertize 676 (propertize
657 (make-string w ruler-mode-basic-graduation-char) 677 (make-string w ruler-mode-basic-graduation-char)
658 'face 'ruler-mode-default-face 678 'face 'ruler-mode-default
659 'local-map ruler-mode-map 679 'local-map ruler-mode-map
660 'help-echo (cond 680 'help-echo (cond
661 (ruler-mode-show-tab-stops 681 (ruler-mode-show-tab-stops
@@ -674,7 +694,7 @@ Optional argument PROPS specifies other text properties to apply."
674 m (length c) 694 m (length c)
675 k i) 695 k i)
676 (put-text-property 696 (put-text-property
677 i (1+ i) 'face 'ruler-mode-column-number-face 697 i (1+ i) 'face 'ruler-mode-column-number
678 ruler) 698 ruler)
679 (while (and (> m 0) (>= k 0)) 699 (while (and (> m 0) (>= k 0))
680 (aset ruler k (aref c (setq m (1- m)))) 700 (aset ruler k (aref c (setq m (1- m))))
@@ -688,13 +708,13 @@ Optional argument PROPS specifies other text properties to apply."
688 ((= j (current-column)) 708 ((= j (current-column))
689 (aset ruler i ruler-mode-current-column-char) 709 (aset ruler i ruler-mode-current-column-char)
690 (put-text-property 710 (put-text-property
691 i (1+ i) 'face 'ruler-mode-current-column-face 711 i (1+ i) 'face 'ruler-mode-current-column
692 ruler)) 712 ruler))
693 ;; Show the `goal-column' marker. 713 ;; Show the `goal-column' marker.
694 ((and goal-column (= j goal-column)) 714 ((and goal-column (= j goal-column))
695 (aset ruler i ruler-mode-goal-column-char) 715 (aset ruler i ruler-mode-goal-column-char)
696 (put-text-property 716 (put-text-property
697 i (1+ i) 'face 'ruler-mode-goal-column-face 717 i (1+ i) 'face 'ruler-mode-goal-column
698 ruler) 718 ruler)
699 (put-text-property 719 (put-text-property
700 i (1+ i) 'mouse-face 'mode-line-highlight 720 i (1+ i) 'mouse-face 'mode-line-highlight
@@ -706,7 +726,7 @@ Optional argument PROPS specifies other text properties to apply."
706 ((= j comment-column) 726 ((= j comment-column)
707 (aset ruler i ruler-mode-comment-column-char) 727 (aset ruler i ruler-mode-comment-column-char)
708 (put-text-property 728 (put-text-property
709 i (1+ i) 'face 'ruler-mode-comment-column-face 729 i (1+ i) 'face 'ruler-mode-comment-column
710 ruler) 730 ruler)
711 (put-text-property 731 (put-text-property
712 i (1+ i) 'mouse-face 'mode-line-highlight 732 i (1+ i) 'mouse-face 'mode-line-highlight
@@ -718,7 +738,7 @@ Optional argument PROPS specifies other text properties to apply."
718 ((= j fill-column) 738 ((= j fill-column)
719 (aset ruler i ruler-mode-fill-column-char) 739 (aset ruler i ruler-mode-fill-column-char)
720 (put-text-property 740 (put-text-property
721 i (1+ i) 'face 'ruler-mode-fill-column-face 741 i (1+ i) 'face 'ruler-mode-fill-column
722 ruler) 742 ruler)
723 (put-text-property 743 (put-text-property
724 i (1+ i) 'mouse-face 'mode-line-highlight 744 i (1+ i) 'mouse-face 'mode-line-highlight
@@ -730,7 +750,7 @@ Optional argument PROPS specifies other text properties to apply."
730 ((and ruler-mode-show-tab-stops (member j tab-stop-list)) 750 ((and ruler-mode-show-tab-stops (member j tab-stop-list))
731 (aset ruler i ruler-mode-tab-stop-char) 751 (aset ruler i ruler-mode-tab-stop-char)
732 (put-text-property 752 (put-text-property
733 i (1+ i) 'face 'ruler-mode-tab-stop-face 753 i (1+ i) 'face 'ruler-mode-tab-stop
734 ruler))) 754 ruler)))
735 (setq i (1+ i) 755 (setq i (1+ i)
736 j (1+ j))) 756 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/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 71d20ba350e..2db27332a87 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -957,6 +957,39 @@ 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.
967Elements without a numeric list order are placed at the end of
968the list.
969
970If the third optional argument ORDER is non-nil, set the
971element's list order to the given value.
972
973The list order for each element 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 (unless ordering
979 (put list-var 'list-order
980 (setq ordering (make-hash-table :weakness 'key :test 'eq))))
981 (when order
982 (puthash element order ordering))
983 (add-to-list list-var element)
984 (set list-var (sort (symbol-value list-var)
985 (lambda (a b)
986 (let ((oa (gethash a ordering))
987 (ob (gethash b ordering)))
988 (cond
989 ((not oa) nil)
990 ((not ob) t)
991 (t (< oa ob)))))))))
992
960 993
961;;; Load history 994;;; Load history
962 995
@@ -1561,7 +1594,7 @@ Strip text properties from the inserted text according to
1561`yank-excluded-properties'. Otherwise just like (insert STRING). 1594`yank-excluded-properties'. Otherwise just like (insert STRING).
1562 1595
1563If STRING has a non-nil `yank-handler' property on the first character, 1596If STRING has a non-nil `yank-handler' property on the first character,
1564the normal insert behaviour is modified in various ways. The value of 1597the normal insert behavior is modified in various ways. The value of
1565the yank-handler property must be a list with one to five elements 1598the yank-handler property must be a list with one to five elements
1566with the following format: (FUNCTION PARAM NOEXCLUDE UNDO). 1599with the following format: (FUNCTION PARAM NOEXCLUDE UNDO).
1567When FUNCTION is present and non-nil, it is called instead of `insert' 1600When FUNCTION is present and non-nil, it is called instead of `insert'
@@ -1923,6 +1956,7 @@ entered.
1923The result of the `dynamic-completion-table' form is a function 1956The result of the `dynamic-completion-table' form is a function
1924that can be used as the ALIST argument to `try-completion' and 1957that can be used as the ALIST argument to `try-completion' and
1925`all-completion'. See Info node `(elisp)Programmed Completion'." 1958`all-completion'. See Info node `(elisp)Programmed Completion'."
1959 (declare (debug (lambda-expr)))
1926 (let ((win (make-symbol "window")) 1960 (let ((win (make-symbol "window"))
1927 (string (make-symbol "string")) 1961 (string (make-symbol "string"))
1928 (predicate (make-symbol "predicate")) 1962 (predicate (make-symbol "predicate"))
@@ -1944,12 +1978,29 @@ ARGS. FUN must return the completion table that will be stored in VAR.
1944If completion is requested in the minibuffer, FUN will be called in the buffer 1978If completion is requested in the minibuffer, FUN will be called in the buffer
1945from which the minibuffer was entered. The return value of 1979from which the minibuffer was entered. The return value of
1946`lazy-completion-table' must be used to initialize the value of VAR." 1980`lazy-completion-table' must be used to initialize the value of VAR."
1981 (declare (debug (symbol lambda-expr def-body)))
1947 (let ((str (make-symbol "string"))) 1982 (let ((str (make-symbol "string")))
1948 `(dynamic-completion-table 1983 `(dynamic-completion-table
1949 (lambda (,str) 1984 (lambda (,str)
1950 (unless (listp ,var) 1985 (unless (listp ,var)
1951 (setq ,var (funcall ',fun ,@args))) 1986 (setq ,var (,fun ,@args)))
1952 ,var)))) 1987 ,var))))
1988
1989(defmacro complete-in-turn (a b)
1990 "Create a completion table that first tries completion in A and then in B.
1991A and B should not be costly (or side-effecting) expressions."
1992 (declare (debug (def-form def-form)))
1993 `(lambda (string predicate mode)
1994 (cond
1995 ((eq mode t)
1996 (or (all-completions string ,a predicate)
1997 (all-completions string ,b predicate)))
1998 ((eq mode nil)
1999 (or (try-completion string ,a predicate)
2000 (try-completion string ,b predicate)))
2001 (t
2002 (or (test-completion string ,a predicate)
2003 (test-completion string ,b predicate))))))
1953 2004
1954;;; Matching and substitution 2005;;; Matching and substitution
1955 2006
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 48460b3833d..458ad931aaf 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 (define-key map "\e" esc-map) 894 (define-key map "\e" esc-map)
@@ -939,11 +939,11 @@ is buffer-local.")
939 (make-display-table))) 939 (make-display-table)))
940 i) 940 i)
941 ;; avoid changing the display table for ^J 941 ;; avoid changing the display table for ^J
942 (setq i 0) 942 (setq i 0)
943 (while (< i 10) 943 (while (< i 10)
944 (aset dt i (vector i)) 944 (aset dt i (vector i))
945 (setq i (1+ i))) 945 (setq i (1+ i)))
946 (setq i 11) 946 (setq i 11)
947 (while (< i 32) 947 (while (< i 32)
948 (aset dt i (vector i)) 948 (aset dt i (vector i))
949 (setq i (1+ i))) 949 (setq i (1+ i)))
@@ -981,7 +981,7 @@ and `term-scroll-to-bottom-on-output'.
981If you accidentally suspend your process, use \\[term-continue-subjob] 981If you accidentally suspend your process, use \\[term-continue-subjob]
982to continue it. 982to continue it.
983 983
984This mode can be customised to create specific modes for running 984This mode can be customized to create specific modes for running
985particular subprocesses. This can be done by setting the hooks 985particular subprocesses. This can be done by setting the hooks
986`term-input-filter-functions', `term-input-filter', 986`term-input-filter-functions', `term-input-filter',
987`term-input-sender' and `term-get-old-input' to appropriate functions, 987`term-input-sender' and `term-get-old-input' to appropriate functions,
@@ -1271,7 +1271,7 @@ you type \\[term-send-input] which sends the current line to the inferior."
1271(defun term-check-proc (buffer) 1271(defun term-check-proc (buffer)
1272 "True if there is a process associated w/buffer BUFFER, and 1272 "True if there is a process associated w/buffer BUFFER, and
1273it is alive (status RUN or STOP). BUFFER can be either a buffer or the 1273it is alive (status RUN or STOP). BUFFER can be either a buffer or the
1274name of one" 1274name of one."
1275 (let ((proc (get-buffer-process buffer))) 1275 (let ((proc (get-buffer-process buffer)))
1276 (and proc (memq (process-status proc) '(run stop))))) 1276 (and proc (memq (process-status proc) '(run stop)))))
1277 1277
@@ -2086,7 +2086,7 @@ If this takes us past the end of the current line, don't skip at all."
2086(defun term-simple-send (proc string) 2086(defun term-simple-send (proc string)
2087 "Default function for sending to PROC input STRING. 2087 "Default function for sending to PROC input STRING.
2088This just sends STRING plus a newline. To override this, 2088This just sends STRING plus a newline. To override this,
2089set the hook TERM-INPUT-SENDER." 2089set the hook `term-input-sender'."
2090 (term-send-string proc string) 2090 (term-send-string proc string)
2091 (term-send-string proc "\n")) 2091 (term-send-string proc "\n"))
2092 2092
@@ -2178,7 +2178,7 @@ Security bug: your string can still be temporarily recovered with
2178If your process is choking on big inputs, try lowering the value.") 2178If your process is choking on big inputs, try lowering the value.")
2179 2179
2180(defun term-send-string (proc str) 2180(defun term-send-string (proc str)
2181 "Send PROCESS the contents of STRING as input. 2181 "Send to PROC the contents of STR as input.
2182This is equivalent to process-send-string, except that long input strings 2182This is equivalent to process-send-string, except that long input strings
2183are broken up into chunks of size term-input-chunk-size. Processes 2183are broken up into chunks of size term-input-chunk-size. Processes
2184are given a chance to output between chunks. This can help prevent processes 2184are given a chance to output between chunks. This can help prevent processes
@@ -2193,9 +2193,9 @@ from hanging when you send them long inputs on some OS's."
2193 (setq i next-i))))) 2193 (setq i next-i)))))
2194 2194
2195(defun term-send-region (proc start end) 2195(defun term-send-region (proc start end)
2196 "Sends to PROC the region delimited by START and END. 2196 "Send to PROC the region delimited by START and END.
2197This is a replacement for process-send-region that tries to keep 2197This is a replacement for process-send-region that tries to keep
2198your process from hanging on long inputs. See term-send-string." 2198your process from hanging on long inputs. See `term-send-string'."
2199 (term-send-string proc (buffer-substring start end))) 2199 (term-send-string proc (buffer-substring start end)))
2200 2200
2201 2201
@@ -2425,7 +2425,7 @@ See `term-prompt-regexp'."
2425;;; This is pretty stupid about strings. It decides we're in a string 2425;;; This is pretty stupid about strings. It decides we're in a string
2426;;; if there's a quote on both sides of point on the current line. 2426;;; if there's a quote on both sides of point on the current line.
2427(defun term-extract-string () 2427(defun term-extract-string ()
2428 "Returns string around POINT that starts the current line or nil." 2428 "Return string around `point' that starts the current line or nil."
2429 (save-excursion 2429 (save-excursion
2430 (let* ((point (point)) 2430 (let* ((point (point))
2431 (bol (progn (beginning-of-line) (point))) 2431 (bol (progn (beginning-of-line) (point)))
@@ -2599,7 +2599,7 @@ See `term-prompt-regexp'."
2599 2599
2600(defun term-adjust-current-row-cache (delta) 2600(defun term-adjust-current-row-cache (delta)
2601 (when term-current-row 2601 (when term-current-row
2602 (setq term-current-row 2602 (setq term-current-row
2603 (max 0 (+ term-current-row delta))))) 2603 (max 0 (+ term-current-row delta)))))
2604 2604
2605(defun term-terminal-pos () 2605(defun term-terminal-pos ()
@@ -2779,11 +2779,11 @@ See `term-prompt-regexp'."
2779 ;; In insert if the if the current line 2779 ;; In insert if the if the current line
2780 ;; has become too long it needs to be 2780 ;; has become too long it needs to be
2781 ;; chopped off. 2781 ;; chopped off.
2782 (when term-insert-mode 2782 (when term-insert-mode
2783 (setq pos (point)) 2783 (setq pos (point))
2784 (end-of-line) 2784 (end-of-line)
2785 (when (> (current-column) term-width) 2785 (when (> (current-column) term-width)
2786 (delete-region (- (point) (- (current-column) term-width)) 2786 (delete-region (- (point) (- (current-column) term-width))
2787 (point))) 2787 (point)))
2788 (goto-char pos))) 2788 (goto-char pos)))
2789 (setq term-current-column nil) 2789 (setq term-current-column nil)
@@ -2802,15 +2802,15 @@ See `term-prompt-regexp'."
2802 (setq count (term-current-column)) 2802 (setq count (term-current-column))
2803 ;; The line cannot exceed term-width. TAB at 2803 ;; The line cannot exceed term-width. TAB at
2804 ;; the end of a line should not cause wrapping. 2804 ;; the end of a line should not cause wrapping.
2805 (setq count (min term-width 2805 (setq count (min term-width
2806 (+ count 8 (- (mod count 8))))) 2806 (+ count 8 (- (mod count 8)))))
2807 (if (> term-width count) 2807 (if (> term-width count)
2808 (progn 2808 (progn
2809 (term-move-columns 2809 (term-move-columns
2810 (- count (term-current-column))) 2810 (- count (term-current-column)))
2811 (setq term-current-column count)) 2811 (setq term-current-column count))
2812 (when (> term-width (term-current-column)) 2812 (when (> term-width (term-current-column))
2813 (term-move-columns 2813 (term-move-columns
2814 (1- (- term-width (term-current-column))))) 2814 (1- (- term-width (term-current-column)))))
2815 (when (= term-width (term-current-column)) 2815 (when (= term-width (term-current-column))
2816 (term-move-columns -1)))) 2816 (term-move-columns -1))))
@@ -2901,7 +2901,7 @@ See `term-prompt-regexp'."
2901 (term-goto (car term-saved-cursor) 2901 (term-goto (car term-saved-cursor)
2902 (cdr term-saved-cursor))) 2902 (cdr term-saved-cursor)))
2903 (setq term-terminal-state 0)) 2903 (setq term-terminal-state 0))
2904 ((eq char ?c) ;; \Ec - Reset (terminfo: rs1) 2904 ((eq char ?c) ;; \Ec - Reset (terminfo: rs1)
2905 ;; This is used by the "clear" program. 2905 ;; This is used by the "clear" program.
2906 (setq term-terminal-state 0) 2906 (setq term-terminal-state 0)
2907 (term-reset-terminal)) 2907 (term-reset-terminal))
@@ -3033,7 +3033,7 @@ See `term-prompt-regexp'."
3033 (setq term-current-row (1- term-height)))))) 3033 (setq term-current-row (1- term-height))))))
3034 3034
3035;;; Reset the terminal, delete all the content and set the face to the 3035;;; Reset the terminal, delete all the content and set the face to the
3036;;; default one. 3036;;; default one.
3037(defun term-reset-terminal () 3037(defun term-reset-terminal ()
3038 (erase-buffer) 3038 (erase-buffer)
3039 (setq term-current-row 0) 3039 (setq term-current-row 0)
@@ -3187,7 +3187,7 @@ See `term-prompt-regexp'."
3187 ((or (eq char ?H) ; cursor motion (terminfo: cup) 3187 ((or (eq char ?H) ; cursor motion (terminfo: cup)
3188 ;; (eq char ?f) ; xterm seems to handle this sequence too, not 3188 ;; (eq char ?f) ; xterm seems to handle this sequence too, not
3189 ;; needed for now 3189 ;; needed for now
3190 ) 3190 )
3191 (if (<= term-terminal-parameter 0) 3191 (if (<= term-terminal-parameter 0)
3192 (setq term-terminal-parameter 1)) 3192 (setq term-terminal-parameter 1))
3193 (if (<= term-terminal-previous-parameter 0) 3193 (if (<= term-terminal-previous-parameter 0)
@@ -3208,8 +3208,8 @@ See `term-prompt-regexp'."
3208 (term-down (max 1 term-terminal-parameter) t)) 3208 (term-down (max 1 term-terminal-parameter) t))
3209 ;; \E[C - cursor right (terminfo: cuf) 3209 ;; \E[C - cursor right (terminfo: cuf)
3210 ((eq char ?C) 3210 ((eq char ?C)
3211 (term-move-columns 3211 (term-move-columns
3212 (max 1 3212 (max 1
3213 (if (>= (+ term-terminal-parameter (term-current-column)) term-width) 3213 (if (>= (+ term-terminal-parameter (term-current-column)) term-width)
3214 (- term-width (term-current-column) 1) 3214 (- term-width (term-current-column) 1)
3215 term-terminal-parameter)))) 3215 term-terminal-parameter))))
@@ -3250,7 +3250,7 @@ See `term-prompt-regexp'."
3250 )) 3250 ))
3251 3251
3252;;; Modified to allow ansi coloring -mm 3252;;; Modified to allow ansi coloring -mm
3253 ;; \E[m - Set/reset modes, set bg/fg 3253 ;; \E[m - Set/reset modes, set bg/fg
3254 ;;(terminfo: smso,rmso,smul,rmul,rev,bold,sgr0,invis,op,setab,setaf) 3254 ;;(terminfo: smso,rmso,smul,rmul,rev,bold,sgr0,invis,op,setab,setaf)
3255 ((eq char ?m) 3255 ((eq char ?m)
3256 (when (= term-terminal-more-parameters 1) 3256 (when (= term-terminal-more-parameters 1)
@@ -3295,7 +3295,7 @@ The top-most line is line 0."
3295 (not (and (= term-scroll-start 0) 3295 (not (and (= term-scroll-start 0)
3296 (= term-scroll-end term-height))))) 3296 (= term-scroll-end term-height)))))
3297 (term-move-columns (- (term-current-column))) 3297 (term-move-columns (- (term-current-column)))
3298 (term-goto 3298 (term-goto
3299 term-scroll-start (term-current-column))) 3299 term-scroll-start (term-current-column)))
3300 3300
3301;; (defun term-switch-to-alternate-sub-buffer (set) 3301;; (defun term-switch-to-alternate-sub-buffer (set)
@@ -3844,7 +3844,7 @@ directory tracking functions.")
3844 3844
3845 3845
3846(defun term-word (word-chars) 3846(defun term-word (word-chars)
3847 "Return the word of WORD-CHARS at point, or nil if non is found. 3847 "Return the word of WORD-CHARS at point, or nil if none is found.
3848Word constituents are considered to be those in WORD-CHARS, which is like the 3848Word constituents are considered to be those in WORD-CHARS, which is like the
3849inside of a \"[...]\" (see `skip-chars-forward')." 3849inside of a \"[...]\" (see `skip-chars-forward')."
3850 (save-excursion 3850 (save-excursion
@@ -3861,7 +3861,7 @@ inside of a \"[...]\" (see `skip-chars-forward')."
3861 3861
3862 3862
3863(defun term-match-partial-filename () 3863(defun term-match-partial-filename ()
3864 "Return the filename at point, or nil if non is found. 3864 "Return the filename at point, or nil if none is found.
3865Environment variables are substituted. See `term-word'." 3865Environment variables are substituted. See `term-word'."
3866 (let ((filename (term-word "~/A-Za-z0-9+@:_.$#,={}-"))) 3866 (let ((filename (term-word "~/A-Za-z0-9+@:_.$#,={}-")))
3867 (and filename (substitute-in-file-name filename)))) 3867 (and filename (substitute-in-file-name filename))))
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index 4f440207c96..43c448a72cd 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -2184,6 +2184,11 @@ order until succeed.")
2184 ctext 2184 ctext
2185 utf8))))) 2185 utf8)))))
2186 2186
2187;; Get a selection value of type TYPE by calling x-get-selection with
2188;; an appropiate DATA-TYPE argument decidd by `x-select-request-type'.
2189;; The return value is already decoded. If x-get-selection causes an
2190;; error, this function return nil.
2191
2187(defun x-selection-value (type) 2192(defun x-selection-value (type)
2188 (let (text) 2193 (let (text)
2189 (cond ((null x-select-request-type) 2194 (cond ((null x-select-request-type)
@@ -2444,10 +2449,7 @@ order until succeed.")
2444(defun x-clipboard-yank () 2449(defun x-clipboard-yank ()
2445 "Insert the clipboard contents, or the last stretch of killed text." 2450 "Insert the clipboard contents, or the last stretch of killed text."
2446 (interactive) 2451 (interactive)
2447 (let ((clipboard-text 2452 (let ((clipboard-text (x-selection-value 'CLIPBOARD))
2448 (condition-case nil
2449 (x-get-selection 'CLIPBOARD)
2450 (error nil)))
2451 (x-select-enable-clipboard t)) 2453 (x-select-enable-clipboard t))
2452 (if (and clipboard-text (> (length clipboard-text) 0)) 2454 (if (and clipboard-text (> (length clipboard-text) 0))
2453 (kill-new clipboard-text)) 2455 (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/bibtex.el b/lisp/textmodes/bibtex.el
index ecaaf76639a..5f4a83b07eb 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -4277,9 +4277,11 @@ signaled if point is outside key or BibTeX field."
4277 (bibtex-move-outside-of-entry) 4277 (bibtex-move-outside-of-entry)
4278 (indent-to-column bibtex-entry-offset) 4278 (indent-to-column bibtex-entry-offset)
4279 (insert "@Preamble" 4279 (insert "@Preamble"
4280 (bibtex-entry-left-delimiter)) 4280 (bibtex-entry-left-delimiter)
4281 (bibtex-field-left-delimiter))
4281 (let ((endpos (point))) 4282 (let ((endpos (point)))
4282 (insert (bibtex-entry-right-delimiter) 4283 (insert (bibtex-entry-right-delimiter)
4284 (bibtex-field-right-delimiter)
4283 "\n") 4285 "\n")
4284 (goto-char endpos))) 4286 (goto-char endpos)))
4285 4287
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 0326510f75f..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."
@@ -444,18 +444,22 @@ property of the major mode name.")
444;*---------------------------------------------------------------------*/ 444;*---------------------------------------------------------------------*/
445;* Highlighting */ 445;* Highlighting */
446;*---------------------------------------------------------------------*/ 446;*---------------------------------------------------------------------*/
447(defface flyspell-incorrect-face 447(defface flyspell-incorrect
448 '((((class color)) (:foreground "OrangeRed" :bold t :underline t)) 448 '((((class color)) (:foreground "OrangeRed" :bold t :underline t))
449 (t (:bold t))) 449 (t (:bold t)))
450 "Face used for marking a misspelled word in Flyspell." 450 "Face used for marking a misspelled word in Flyspell."
451 :group 'flyspell) 451 :group 'flyspell)
452;; backward-compatibility alias
453(put 'flyspell-incorrect-face 'face-alias 'flyspell-incorrect)
452 454
453(defface flyspell-duplicate-face 455(defface flyspell-duplicate
454 '((((class color)) (:foreground "Gold3" :bold t :underline t)) 456 '((((class color)) (:foreground "Gold3" :bold t :underline t))
455 (t (:bold t))) 457 (t (:bold t)))
456 "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.
457See also `flyspell-duplicate-distance'." 459See also `flyspell-duplicate-distance'."
458 :group 'flyspell) 460 :group 'flyspell)
461;; backward-compatibility alias
462(put 'flyspell-duplicate-face 'face-alias 'flyspell-duplicate)
459 463
460(defvar flyspell-overlay nil) 464(defvar flyspell-overlay nil)
461 465
@@ -540,7 +544,7 @@ in your .emacs file.
540;*---------------------------------------------------------------------*/ 544;*---------------------------------------------------------------------*/
541(defun flyspell-mode-on () 545(defun flyspell-mode-on ()
542 "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."
543 (setq ispell-highlight-face 'flyspell-incorrect-face) 547 (setq ispell-highlight-face 'flyspell-incorrect)
544 ;; local dictionaries setup 548 ;; local dictionaries setup
545 (or ispell-local-dictionary ispell-dictionary 549 (or ispell-local-dictionary ispell-dictionary
546 (if flyspell-default-dictionary 550 (if flyspell-default-dictionary
@@ -978,7 +982,7 @@ Mostly we check word delimiters."
978 (setq r p) 982 (setq r p)
979 (goto-char p)))) 983 (goto-char p))))
980 r))) 984 r)))
981 985
982;*---------------------------------------------------------------------*/ 986;*---------------------------------------------------------------------*/
983;* flyspell-word-search-forward ... */ 987;* flyspell-word-search-forward ... */
984;*---------------------------------------------------------------------*/ 988;*---------------------------------------------------------------------*/
@@ -992,7 +996,7 @@ Mostly we check word delimiters."
992 (setq r p) 996 (setq r p)
993 (goto-char (1+ p))))) 997 (goto-char (1+ p)))))
994 r))) 998 r)))
995 999
996;*---------------------------------------------------------------------*/ 1000;*---------------------------------------------------------------------*/
997;* flyspell-word ... */ 1001;* flyspell-word ... */
998;*---------------------------------------------------------------------*/ 1002;*---------------------------------------------------------------------*/
@@ -1022,7 +1026,7 @@ Mostly we check word delimiters."
1022 flyspell-mark-duplications-flag 1026 flyspell-mark-duplications-flag
1023 (save-excursion 1027 (save-excursion
1024 (goto-char (1- start)) 1028 (goto-char (1- start))
1025 (let ((p (flyspell-word-search-backward 1029 (let ((p (flyspell-word-search-backward
1026 word 1030 word
1027 (- start (1+ (- end start)))))) 1031 (- start (1+ (- end start))))))
1028 (and p (/= p (1- start)))))) 1032 (and p (/= p (1- start))))))
@@ -1122,7 +1126,7 @@ Mostly we check word delimiters."
1122 (flyspell-notify-misspell start end word poss)) 1126 (flyspell-notify-misspell start end word poss))
1123 nil)))) 1127 nil))))
1124 ;; return to original location 1128 ;; return to original location
1125 (goto-char cursor-location) 1129 (goto-char cursor-location)
1126 (if ispell-quit (setq ispell-quit nil)) 1130 (if ispell-quit (setq ispell-quit nil))
1127 res)))))))) 1131 res))))))))
1128 1132
@@ -1570,7 +1574,7 @@ for the overlay."
1570 (overlay-put flyspell-overlay 1574 (overlay-put flyspell-overlay
1571 flyspell-overlay-keymap-property-name 1575 flyspell-overlay-keymap-property-name
1572 flyspell-mouse-map)) 1576 flyspell-mouse-map))
1573 (when (eq face 'flyspell-incorrect-face) 1577 (when (eq face 'flyspell-incorrect)
1574 (and (stringp flyspell-before-incorrect-word-string) 1578 (and (stringp flyspell-before-incorrect-word-string)
1575 (overlay-put flyspell-overlay 'before-string 1579 (overlay-put flyspell-overlay 'before-string
1576 flyspell-before-incorrect-word-string)) 1580 flyspell-before-incorrect-word-string))
@@ -1610,7 +1614,7 @@ for the overlay."
1610 ;; now we can use a new overlay 1614 ;; now we can use a new overlay
1611 (setq flyspell-overlay 1615 (setq flyspell-overlay
1612 (make-flyspell-overlay 1616 (make-flyspell-overlay
1613 beg end 'flyspell-incorrect-face 'highlight))))))) 1617 beg end 'flyspell-incorrect 'highlight)))))))
1614 1618
1615;*---------------------------------------------------------------------*/ 1619;*---------------------------------------------------------------------*/
1616;* flyspell-highlight-duplicate-region ... */ 1620;* flyspell-highlight-duplicate-region ... */
@@ -1636,7 +1640,7 @@ for the overlay."
1636 ;; now we can use a new overlay 1640 ;; now we can use a new overlay
1637 (setq flyspell-overlay 1641 (setq flyspell-overlay
1638 (make-flyspell-overlay beg end 1642 (make-flyspell-overlay beg end
1639 'flyspell-duplicate-face 1643 'flyspell-duplicate
1640 'highlight))))))) 1644 'highlight)))))))
1641 1645
1642;*---------------------------------------------------------------------*/ 1646;*---------------------------------------------------------------------*/
@@ -1698,8 +1702,7 @@ misspelled words backwards."
1698 (let ((num (car pos))) 1702 (let ((num (car pos)))
1699 (put-text-property num 1703 (put-text-property num
1700 (+ num (length flyspell-auto-correct-word)) 1704 (+ num (length flyspell-auto-correct-word))
1701 'face 1705 'face 'flyspell-incorrect
1702 'flyspell-incorrect-face
1703 string)) 1706 string))
1704 (setq pos (cdr pos))) 1707 (setq pos (cdr pos)))
1705 (if (fboundp 'display-message) 1708 (if (fboundp 'display-message)
@@ -1836,7 +1839,7 @@ This command proposes various successive corrections for the current word."
1836(defun flyspell-auto-correct-previous-hook () 1839(defun flyspell-auto-correct-previous-hook ()
1837 "Hook to track successive calls to `flyspell-auto-correct-previous-word'. 1840 "Hook to track successive calls to `flyspell-auto-correct-previous-word'.
1838Sets `flyspell-auto-correct-previous-pos' to nil" 1841Sets `flyspell-auto-correct-previous-pos' to nil"
1839 (interactive) 1842 (interactive)
1840 (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)
1841 (unless (eq this-command (function flyspell-auto-correct-previous-word)) 1844 (unless (eq this-command (function flyspell-auto-correct-previous-word))
1842 (setq flyspell-auto-correct-previous-pos nil))) 1845 (setq flyspell-auto-correct-previous-pos nil)))
@@ -1844,7 +1847,7 @@ Sets `flyspell-auto-correct-previous-pos' to nil"
1844;*---------------------------------------------------------------------*/ 1847;*---------------------------------------------------------------------*/
1845;* flyspell-auto-correct-previous-word ... */ 1848;* flyspell-auto-correct-previous-word ... */
1846;*---------------------------------------------------------------------*/ 1849;*---------------------------------------------------------------------*/
1847(defun flyspell-auto-correct-previous-word (position) 1850(defun flyspell-auto-correct-previous-word (position)
1848 "*Auto correct the first mispelled word that occurs before point. 1851 "*Auto correct the first mispelled word that occurs before point.
1849But don't look beyond what's visible on the screen." 1852But don't look beyond what's visible on the screen."
1850 (interactive "d") 1853 (interactive "d")
@@ -1860,29 +1863,29 @@ But don't look beyond what's visible on the screen."
1860 (narrow-to-region top bot) 1863 (narrow-to-region top bot)
1861 (overlay-recenter (point)) 1864 (overlay-recenter (point))
1862 1865
1863 (add-hook 'pre-command-hook 1866 (add-hook 'pre-command-hook
1864 (function flyspell-auto-correct-previous-hook) t t) 1867 (function flyspell-auto-correct-previous-hook) t t)
1865 1868
1866 (unless flyspell-auto-correct-previous-pos 1869 (unless flyspell-auto-correct-previous-pos
1867 ;; only reset if a new overlay exists 1870 ;; only reset if a new overlay exists
1868 (setq flyspell-auto-correct-previous-pos nil) 1871 (setq flyspell-auto-correct-previous-pos nil)
1869 1872
1870 (let ((overlay-list (overlays-in (point-min) position)) 1873 (let ((overlay-list (overlays-in (point-min) position))
1871 (new-overlay 'dummy-value)) 1874 (new-overlay 'dummy-value))
1872 1875
1873 ;; search for previous (new) flyspell overlay 1876 ;; search for previous (new) flyspell overlay
1874 (while (and new-overlay 1877 (while (and new-overlay
1875 (or (not (flyspell-overlay-p new-overlay)) 1878 (or (not (flyspell-overlay-p new-overlay))
1876 ;; check if its face has changed 1879 ;; check if its face has changed
1877 (not (eq (get-char-property 1880 (not (eq (get-char-property
1878 (overlay-start new-overlay) 'face) 1881 (overlay-start new-overlay) 'face)
1879 'flyspell-incorrect-face)))) 1882 'flyspell-incorrect))))
1880 (setq new-overlay (car-safe overlay-list)) 1883 (setq new-overlay (car-safe overlay-list))
1881 (setq overlay-list (cdr-safe overlay-list))) 1884 (setq overlay-list (cdr-safe overlay-list)))
1882 1885
1883 ;; if nothing new exits new-overlay should be nil 1886 ;; if nothing new exits new-overlay should be nil
1884 (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
1885 (setq flyspell-auto-correct-previous-pos 1888 (setq flyspell-auto-correct-previous-pos
1886 (overlay-start new-overlay))))) 1889 (overlay-start new-overlay)))))
1887 1890
1888 (when flyspell-auto-correct-previous-pos 1891 (when flyspell-auto-correct-previous-pos
@@ -2131,9 +2134,9 @@ Ispell, after transposing two adjacent characters, correct the text,
2131and return t. 2134and return t.
2132 2135
2133The 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
2134possible corrections as returned by 'ispell-parse-output'. 2137possible corrections as returned by `ispell-parse-output'.
2135 2138
2136This function is meant to be added to 'flyspell-incorrect-hook'." 2139This function is meant to be added to `flyspell-incorrect-hook'."
2137 (when (consp poss) 2140 (when (consp poss)
2138 (catch 'done 2141 (catch 'done
2139 (let ((str (buffer-substring beg end)) 2142 (let ((str (buffer-substring beg end))
@@ -2161,9 +2164,9 @@ Ispell, after removing a pair of doubled characters, correct the text,
2161and return t. 2164and return t.
2162 2165
2163The 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
2164possible corrections as returned by 'ispell-parse-output'. 2167possible corrections as returned by `ispell-parse-output'.
2165 2168
2166This function is meant to be added to 'flyspell-incorrect-hook'." 2169This function is meant to be added to `flyspell-incorrect-hook'."
2167 (when (consp poss) 2170 (when (consp poss)
2168 (catch 'done 2171 (catch 'done
2169 (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 5b0542edaf2..67af240f522 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -942,7 +942,7 @@ The variable `ispell-library-directory' defines the library location."
942 '(menu-item "Automatic spell checking (Flyspell)" 942 '(menu-item "Automatic spell checking (Flyspell)"
943 flyspell-mode 943 flyspell-mode
944 :help "Check spelling while you edit the text" 944 :help "Check spelling while you edit the text"
945 :button (:toggle . flyspell-mode))) 945 :button (:toggle . (bound-and-true-p flyspell-mode))))
946 (define-key ispell-menu-map [ispell-complete-word] 946 (define-key ispell-menu-map [ispell-complete-word]
947 '(menu-item "Complete Word" ispell-complete-word 947 '(menu-item "Complete Word" ispell-complete-word
948 :help "Complete word at cursor using dictionary")) 948 :help "Complete word at cursor using dictionary"))
diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el
index d13a7514c16..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;;
@@ -157,7 +168,7 @@
157 168
158;;; Customization variables 169;;; Customization variables
159 170
160(defvar org-version "3.10" 171(defvar org-version "3.11"
161 "The version number of the file org.el.") 172 "The version number of the file org.el.")
162(defun org-version () 173(defun org-version ()
163 (interactive) 174 (interactive)
@@ -183,6 +194,44 @@
183 :tag "Org Startup" 194 :tag "Org Startup"
184 :group 'org) 195 :group 'org)
185 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
186(defcustom org-startup-folded t 235(defcustom org-startup-folded t
187 "Non-nil means, entering Org-mode will switch to OVERVIEW. 236 "Non-nil means, entering Org-mode will switch to OVERVIEW.
188This 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
@@ -382,26 +431,21 @@ or contain a special line
382If the file does not specify a category, then file's base name 431If the file does not specify a category, then file's base name
383is used instead.") 432is used instead.")
384 433
385(defun org-run-mode-hooks (&rest hooks)
386 "Call `run-mode-hooks' if it is available; otherwise call `run-hooks'."
387 (if (fboundp 'run-mode-hooks)
388 (apply 'run-mode-hooks hooks)
389 (apply 'run-hooks hooks)))
390
391(defun org-set-regexps-and-options () 434(defun org-set-regexps-and-options ()
392 "Precompute regular expressions for current buffer." 435 "Precompute regular expressions for current buffer."
393 (when (eq major-mode 'org-mode) 436 (when (eq major-mode 'org-mode)
394 (let ((re (org-make-options-regexp 437 (let ((re (org-make-options-regexp
395 '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" "STARTUP"))) 438 '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO"
439 "STARTUP" "ARCHIVE")))
396 (splitre "[ \t]+") 440 (splitre "[ \t]+")
397 kwds int key value cat) 441 kwds int key value cat arch)
398 (save-excursion 442 (save-excursion
399 (save-restriction 443 (save-restriction
400 (widen) 444 (widen)
401 (goto-char (point-min)) 445 (goto-char (point-min))
402 (while (re-search-forward re nil t) 446 (while (re-search-forward re nil t)
403 (setq key (match-string 1) value (match-string 2)) 447 (setq key (match-string 1) value (match-string 2))
404 (cond 448 (cond
405 ((equal key "CATEGORY") 449 ((equal key "CATEGORY")
406 (if (string-match "[ \t]+$" value) 450 (if (string-match "[ \t]+$" value)
407 (setq value (replace-match "" t t value))) 451 (setq value (replace-match "" t t value)))
@@ -425,17 +469,23 @@ is used instead.")
425 l var val) 469 l var val)
426 (while (setq l (assoc (pop opts) set)) 470 (while (setq l (assoc (pop opts) set))
427 (setq var (nth 1 l) val (nth 2 l)) 471 (setq var (nth 1 l) val (nth 2 l))
428 (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)))
429 ))) 478 )))
430 (and cat (set (make-local-variable 'org-category) cat)) 479 (and cat (set (make-local-variable 'org-category) cat))
431 (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))
432 (and int (set (make-local-variable 'org-todo-interpretation) int))) 482 (and int (set (make-local-variable 'org-todo-interpretation) int)))
433 ;; Compute the regular expressions and other local variables 483 ;; Compute the regular expressions and other local variables
434 (setq org-todo-kwd-priority-p (equal org-todo-interpretation 'priority) 484 (setq org-todo-kwd-priority-p (equal org-todo-interpretation 'priority)
435 org-todo-kwd-max-priority (1- (length org-todo-keywords)) 485 org-todo-kwd-max-priority (1- (length org-todo-keywords))
436 org-ds-keyword-length (+ 2 (max (length org-deadline-string) 486 org-ds-keyword-length (+ 2 (max (length org-deadline-string)
437 (length org-scheduled-string))) 487 (length org-scheduled-string)))
438 org-done-string 488 org-done-string
439 (nth (1- (length org-todo-keywords)) org-todo-keywords) 489 (nth (1- (length org-todo-keywords)) org-todo-keywords)
440 org-todo-regexp 490 org-todo-regexp
441 (concat "\\<\\(" (mapconcat 'regexp-quote org-todo-keywords 491 (concat "\\<\\(" (mapconcat 'regexp-quote org-todo-keywords
@@ -469,6 +519,11 @@ is used instead.")
469 :tag "Org Time" 519 :tag "Org Time"
470 :group 'org) 520 :group 'org)
471 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
472(defcustom org-deadline-warning-days 30 527(defcustom org-deadline-warning-days 30
473 "No. of days before expiration during which a deadline becomes active. 528 "No. of days before expiration during which a deadline becomes active.
474This variable governs the display in the org file." 529This variable governs the display in the org file."
@@ -510,7 +565,7 @@ When nil, cursor will remain in the current window."
510 565
511(defcustom org-select-agenda-window t 566(defcustom org-select-agenda-window t
512 "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.
513When nil, cursor will remain in the current window." 568When nil, cursor will remain in the current window."
514 :group 'org-agenda 569 :group 'org-agenda
515 :type 'boolean) 570 :type 'boolean)
516 571
@@ -546,7 +601,7 @@ When nil, always start on the current day."
546When 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
547with a prefix argument. 602with a prefix argument.
548When 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
549the entries for specific days." 604the entries for specific days."
550 :group 'org-agenda 605 :group 'org-agenda
551 :type 'boolean) 606 :type 'boolean)
552 607
@@ -591,7 +646,7 @@ priority.
591Leaving out `category-keep' would mean that items will be sorted across 646Leaving out `category-keep' would mean that items will be sorted across
592categories by priority." 647categories by priority."
593 :group 'org-agenda 648 :group 'org-agenda
594 :type '(repeat 649 :type '(repeat
595 (choice 650 (choice
596 (const time-up) 651 (const time-up)
597 (const time-down) 652 (const time-down)
@@ -667,14 +722,26 @@ the variable `org-agenda-time-grid'."
667 :group 'org-agenda 722 :group 'org-agenda
668 :type 'boolean) 723 :type 'boolean)
669 724
670(defcustom org-agenda-time-grid 725(defcustom org-agenda-time-grid
671 '((daily today require-timed) 726 '((daily today require-timed)
672 "----------------" 727 "----------------"
673 (800 1000 1200 1400 1600 1800 2000)) 728 (800 1000 1200 1400 1600 1800 2000))
674 729
675 "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."
676 :group 'org-agenda 743 :group 'org-agenda
677 :type 744 :type
678 '(list 745 '(list
679 (set :greedy t :tag "Grid Display Options" 746 (set :greedy t :tag "Grid Display Options"
680 (const :tag "Show grid in single day agenda display" daily) 747 (const :tag "Show grid in single day agenda display" daily)
@@ -756,10 +823,6 @@ t Everywhere except in headlines"
756 (const :tag "Everywhere except in headlines" t) 823 (const :tag "Everywhere except in headlines" t)
757 )) 824 ))
758 825
759(defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>")
760 "Formats for `format-time-string' which are used for time stamps.
761It is not recommended to change this constant.")
762
763(defcustom org-show-following-heading t 826(defcustom org-show-following-heading t
764 "Non-nil means, show heading following match in `org-occur'. 827 "Non-nil means, show heading following match in `org-occur'.
765When 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
@@ -770,12 +833,73 @@ unnecessary clutter."
770 :group 'org-structure 833 :group 'org-structure
771 :type 'boolean) 834 :type 'boolean)
772 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)
773 884
774(defgroup org-link nil 885(defgroup org-link nil
775 "Options concerning links in Org-mode." 886 "Options concerning links in Org-mode."
776 :tag "Org Link" 887 :tag "Org Link"
777 :group 'org) 888 :group 'org)
778 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
779(defcustom org-allow-space-in-links t 903(defcustom org-allow-space-in-links t
780 "Non-nil means, file names in links may contain space characters. 904 "Non-nil means, file names in links may contain space characters.
781When nil, it becomes possible to put several links into a line. 905When nil, it becomes possible to put several links into a line.
@@ -1314,7 +1438,7 @@ Otherwise, the buffer will just be saved to a file and stay hidden."
1314 :tag "Org Faces" 1438 :tag "Org Faces"
1315 :group 'org) 1439 :group 'org)
1316 1440
1317(defface org-level-1-face ;; font-lock-function-name-face 1441(defface org-level-1 ;; font-lock-function-name-face
1318 '((((type tty) (class color)) (:foreground "blue" :weight bold)) 1442 '((((type tty) (class color)) (:foreground "blue" :weight bold))
1319 (((class color) (background light)) (:foreground "Blue")) 1443 (((class color) (background light)) (:foreground "Blue"))
1320 (((class color) (background dark)) (:foreground "LightSkyBlue")) 1444 (((class color) (background dark)) (:foreground "LightSkyBlue"))
@@ -1322,7 +1446,7 @@ Otherwise, the buffer will just be saved to a file and stay hidden."
1322 "Face used for level 1 headlines." 1446 "Face used for level 1 headlines."
1323 :group 'org-faces) 1447 :group 'org-faces)
1324 1448
1325(defface org-level-2-face ;; font-lock-variable-name-face 1449(defface org-level-2 ;; font-lock-variable-name-face
1326 '((((type tty) (class color)) (:foreground "yellow" :weight light)) 1450 '((((type tty) (class color)) (:foreground "yellow" :weight light))
1327 (((class color) (background light)) (:foreground "DarkGoldenrod")) 1451 (((class color) (background light)) (:foreground "DarkGoldenrod"))
1328 (((class color) (background dark)) (:foreground "LightGoldenrod")) 1452 (((class color) (background dark)) (:foreground "LightGoldenrod"))
@@ -1330,7 +1454,7 @@ Otherwise, the buffer will just be saved to a file and stay hidden."
1330 "Face used for level 2 headlines." 1454 "Face used for level 2 headlines."
1331 :group 'org-faces) 1455 :group 'org-faces)
1332 1456
1333(defface org-level-3-face ;; font-lock-keyword-face 1457(defface org-level-3 ;; font-lock-keyword-face
1334 '((((type tty) (class color)) (:foreground "cyan" :weight bold)) 1458 '((((type tty) (class color)) (:foreground "cyan" :weight bold))
1335 (((class color) (background light)) (:foreground "Purple")) 1459 (((class color) (background light)) (:foreground "Purple"))
1336 (((class color) (background dark)) (:foreground "Cyan")) 1460 (((class color) (background dark)) (:foreground "Cyan"))
@@ -1338,7 +1462,7 @@ Otherwise, the buffer will just be saved to a file and stay hidden."
1338 "Face used for level 3 headlines." 1462 "Face used for level 3 headlines."
1339 :group 'org-faces) 1463 :group 'org-faces)
1340 1464
1341(defface org-level-4-face ;; font-lock-comment-face 1465(defface org-level-4 ;; font-lock-comment-face
1342 '((((type tty pc) (class color) (background light)) (:foreground "red")) 1466 '((((type tty pc) (class color) (background light)) (:foreground "red"))
1343 (((type tty pc) (class color) (background dark)) (:foreground "red1")) 1467 (((type tty pc) (class color) (background dark)) (:foreground "red1"))
1344 (((class color) (background light)) (:foreground "Firebrick")) 1468 (((class color) (background light)) (:foreground "Firebrick"))
@@ -1347,7 +1471,7 @@ Otherwise, the buffer will just be saved to a file and stay hidden."
1347 "Face used for level 4 headlines." 1471 "Face used for level 4 headlines."
1348 :group 'org-faces) 1472 :group 'org-faces)
1349 1473
1350(defface org-level-5-face ;; font-lock-type-face 1474(defface org-level-5 ;; font-lock-type-face
1351 '((((type tty) (class color)) (:foreground "green")) 1475 '((((type tty) (class color)) (:foreground "green"))
1352 (((class color) (background light)) (:foreground "ForestGreen")) 1476 (((class color) (background light)) (:foreground "ForestGreen"))
1353 (((class color) (background dark)) (:foreground "PaleGreen")) 1477 (((class color) (background dark)) (:foreground "PaleGreen"))
@@ -1355,7 +1479,7 @@ Otherwise, the buffer will just be saved to a file and stay hidden."
1355 "Face used for level 5 headlines." 1479 "Face used for level 5 headlines."
1356 :group 'org-faces) 1480 :group 'org-faces)
1357 1481
1358(defface org-level-6-face ;; font-lock-constant-face 1482(defface org-level-6 ;; font-lock-constant-face
1359 '((((type tty) (class color)) (:foreground "magenta")) 1483 '((((type tty) (class color)) (:foreground "magenta"))
1360 (((class color) (background light)) (:foreground "CadetBlue")) 1484 (((class color) (background light)) (:foreground "CadetBlue"))
1361 (((class color) (background dark)) (:foreground "Aquamarine")) 1485 (((class color) (background dark)) (:foreground "Aquamarine"))
@@ -1363,7 +1487,7 @@ Otherwise, the buffer will just be saved to a file and stay hidden."
1363 "Face used for level 6 headlines." 1487 "Face used for level 6 headlines."
1364 :group 'org-faces) 1488 :group 'org-faces)
1365 1489
1366(defface org-level-7-face ;; font-lock-builtin-face 1490(defface org-level-7 ;; font-lock-builtin-face
1367 '((((type tty) (class color)) (:foreground "blue" :weight light)) 1491 '((((type tty) (class color)) (:foreground "blue" :weight light))
1368 (((class color) (background light)) (:foreground "Orchid")) 1492 (((class color) (background light)) (:foreground "Orchid"))
1369 (((class color) (background dark)) (:foreground "LightSteelBlue")) 1493 (((class color) (background dark)) (:foreground "LightSteelBlue"))
@@ -1371,7 +1495,7 @@ Otherwise, the buffer will just be saved to a file and stay hidden."
1371 "Face used for level 7 headlines." 1495 "Face used for level 7 headlines."
1372 :group 'org-faces) 1496 :group 'org-faces)
1373 1497
1374(defface org-level-8-face ;; font-lock-string-face 1498(defface org-level-8 ;; font-lock-string-face
1375 '((((type tty) (class color)) (:foreground "green")) 1499 '((((type tty) (class color)) (:foreground "green"))
1376 (((class color) (background light)) (:foreground "RosyBrown")) 1500 (((class color) (background light)) (:foreground "RosyBrown"))
1377 (((class color) (background dark)) (:foreground "LightSalmon")) 1501 (((class color) (background dark)) (:foreground "LightSalmon"))
@@ -1379,7 +1503,7 @@ Otherwise, the buffer will just be saved to a file and stay hidden."
1379 "Face used for level 8 headlines." 1503 "Face used for level 8 headlines."
1380 :group 'org-faces) 1504 :group 'org-faces)
1381 1505
1382(defface org-warning-face ;; font-lock-warning-face 1506(defface org-warning ;; font-lock-warning-face
1383 '((((type tty) (class color)) (:foreground "red")) 1507 '((((type tty) (class color)) (:foreground "red"))
1384 (((class color) (background light)) (:foreground "Red" :bold t)) 1508 (((class color) (background light)) (:foreground "Red" :bold t))
1385 (((class color) (background dark)) (:foreground "Red1" :bold t)) 1509 (((class color) (background dark)) (:foreground "Red1" :bold t))
@@ -1392,11 +1516,11 @@ Otherwise, the buffer will just be saved to a file and stay hidden."
1392 "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.
1393Normally, only the TODO/DONE keyword indicates the state of a headline. 1517Normally, only the TODO/DONE keyword indicates the state of a headline.
1394When 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
1395`org-headline-done-face' as an additional indication." 1519`org-headline-done' as an additional indication."
1396 :group 'org-faces 1520 :group 'org-faces
1397 :type 'boolean) 1521 :type 'boolean)
1398 1522
1399(defface org-headline-done-face ;; font-lock-string-face 1523(defface org-headline-done ;; font-lock-string-face
1400 '((((type tty) (class color)) (:foreground "green")) 1524 '((((type tty) (class color)) (:foreground "green"))
1401 (((class color) (background light)) (:foreground "RosyBrown")) 1525 (((class color) (background light)) (:foreground "RosyBrown"))
1402 (((class color) (background dark)) (:foreground "LightSalmon")) 1526 (((class color) (background dark)) (:foreground "LightSalmon"))
@@ -1407,7 +1531,7 @@ When this is non-nil, the headline after the keyword is set to the
1407 1531
1408;; Inheritance does not yet work for xemacs. So we just copy... 1532;; Inheritance does not yet work for xemacs. So we just copy...
1409 1533
1410(defface org-deadline-announce-face 1534(defface org-deadline-announce
1411 '((((type tty) (class color)) (:foreground "blue" :weight bold)) 1535 '((((type tty) (class color)) (:foreground "blue" :weight bold))
1412 (((class color) (background light)) (:foreground "Blue")) 1536 (((class color) (background light)) (:foreground "Blue"))
1413 (((class color) (background dark)) (:foreground "LightSkyBlue")) 1537 (((class color) (background dark)) (:foreground "LightSkyBlue"))
@@ -1415,7 +1539,7 @@ When this is non-nil, the headline after the keyword is set to the
1415 "Face for upcoming deadlines." 1539 "Face for upcoming deadlines."
1416 :group 'org-faces) 1540 :group 'org-faces)
1417 1541
1418(defface org-scheduled-today-face 1542(defface org-scheduled-today
1419 '((((type tty) (class color)) (:foreground "green")) 1543 '((((type tty) (class color)) (:foreground "green"))
1420 (((class color) (background light)) (:foreground "DarkGreen")) 1544 (((class color) (background light)) (:foreground "DarkGreen"))
1421 (((class color) (background dark)) (:foreground "PaleGreen")) 1545 (((class color) (background dark)) (:foreground "PaleGreen"))
@@ -1423,7 +1547,7 @@ When this is non-nil, the headline after the keyword is set to the
1423 "Face for items scheduled for a certain day." 1547 "Face for items scheduled for a certain day."
1424 :group 'org-faces) 1548 :group 'org-faces)
1425 1549
1426(defface org-scheduled-previously-face 1550(defface org-scheduled-previously
1427 '((((type tty pc) (class color) (background light)) (:foreground "red")) 1551 '((((type tty pc) (class color) (background light)) (:foreground "red"))
1428 (((type tty pc) (class color) (background dark)) (:foreground "red1")) 1552 (((type tty pc) (class color) (background dark)) (:foreground "red1"))
1429 (((class color) (background light)) (:foreground "Firebrick")) 1553 (((class color) (background light)) (:foreground "Firebrick"))
@@ -1432,7 +1556,7 @@ When this is non-nil, the headline after the keyword is set to the
1432 "Face for items scheduled previously, and not yet done." 1556 "Face for items scheduled previously, and not yet done."
1433 :group 'org-faces) 1557 :group 'org-faces)
1434 1558
1435(defface org-link-face 1559(defface org-link
1436 '((((type tty) (class color)) (:foreground "cyan" :weight bold)) 1560 '((((type tty) (class color)) (:foreground "cyan" :weight bold))
1437 (((class color) (background light)) (:foreground "Purple")) 1561 (((class color) (background light)) (:foreground "Purple"))
1438 (((class color) (background dark)) (:foreground "Cyan")) 1562 (((class color) (background dark)) (:foreground "Cyan"))
@@ -1440,7 +1564,7 @@ When this is non-nil, the headline after the keyword is set to the
1440 "Face for links." 1564 "Face for links."
1441 :group 'org-faces) 1565 :group 'org-faces)
1442 1566
1443(defface org-done-face ;; font-lock-type-face 1567(defface org-done ;; font-lock-type-face
1444 '((((type tty) (class color)) (:foreground "green")) 1568 '((((type tty) (class color)) (:foreground "green"))
1445 (((class color) (background light)) (:foreground "ForestGreen" :bold t)) 1569 (((class color) (background light)) (:foreground "ForestGreen" :bold t))
1446 (((class color) (background dark)) (:foreground "PaleGreen" :bold t)) 1570 (((class color) (background dark)) (:foreground "PaleGreen" :bold t))
@@ -1448,7 +1572,7 @@ When this is non-nil, the headline after the keyword is set to the
1448 "Face used for DONE." 1572 "Face used for DONE."
1449 :group 'org-faces) 1573 :group 'org-faces)
1450 1574
1451(defface org-table-face ;; font-lock-function-name-face 1575(defface org-table ;; font-lock-function-name-face
1452 '((((type tty) (class color)) (:foreground "blue" :weight bold)) 1576 '((((type tty) (class color)) (:foreground "blue" :weight bold))
1453 (((class color) (background light)) (:foreground "Blue")) 1577 (((class color) (background light)) (:foreground "Blue"))
1454 (((class color) (background dark)) (:foreground "LightSkyBlue")) 1578 (((class color) (background dark)) (:foreground "LightSkyBlue"))
@@ -1456,7 +1580,7 @@ When this is non-nil, the headline after the keyword is set to the
1456 "Face used for tables." 1580 "Face used for tables."
1457 :group 'org-faces) 1581 :group 'org-faces)
1458 1582
1459(defface org-time-grid-face ;; font-lock-variable-name-face 1583(defface org-time-grid ;; font-lock-variable-name-face
1460 '((((type tty) (class color)) (:foreground "yellow" :weight light)) 1584 '((((type tty) (class color)) (:foreground "yellow" :weight light))
1461 (((class color) (background light)) (:foreground "DarkGoldenrod")) 1585 (((class color) (background light)) (:foreground "DarkGoldenrod"))
1462 (((class color) (background dark)) (:foreground "LightGoldenrod")) 1586 (((class color) (background dark)) (:foreground "LightGoldenrod"))
@@ -1466,14 +1590,14 @@ When this is non-nil, the headline after the keyword is set to the
1466 1590
1467(defvar org-level-faces 1591(defvar org-level-faces
1468 '( 1592 '(
1469 org-level-1-face 1593 org-level-1
1470 org-level-2-face 1594 org-level-2
1471 org-level-3-face 1595 org-level-3
1472 org-level-4-face 1596 org-level-4
1473 org-level-5-face 1597 org-level-5
1474 org-level-6-face 1598 org-level-6
1475 org-level-7-face 1599 org-level-7
1476 org-level-8-face 1600 org-level-8
1477 )) 1601 ))
1478(defvar org-n-levels (length org-level-faces)) 1602(defvar org-n-levels (length org-level-faces))
1479 1603
@@ -1539,7 +1663,7 @@ sets it back to nil.")
1539 1663
1540;;;###autoload 1664;;;###autoload
1541(define-derived-mode org-mode outline-mode "Org" 1665(define-derived-mode org-mode outline-mode "Org"
1542 "Outline-based notes management and organizer, alias 1666 "Outline-based notes management and organizer, alias
1543\"Carstens outline-mode for keeping track of everything.\" 1667\"Carstens outline-mode for keeping track of everything.\"
1544 1668
1545Org-mode develops organizational tasks around a NOTES file which 1669Org-mode develops organizational tasks around a NOTES file which
@@ -1568,6 +1692,9 @@ The following commands are available:
1568 (make-local-hook 'before-change-functions) ;; needed for XEmacs 1692 (make-local-hook 'before-change-functions) ;; needed for XEmacs
1569 (add-hook 'before-change-functions 'org-before-change-function nil 1693 (add-hook 'before-change-functions 'org-before-change-function nil
1570 'local) 1694 'local)
1695 ;; Paragraph regular expressions
1696 (set (make-local-variable 'paragraph-separate) "\f\\|[ ]*$")
1697 (set (make-local-variable 'paragraph-start) "\f\\|[ ]*$\\|\\([*\f]+\\)")
1571 ;; Inhibit auto-fill for headers, tables and fixed-width lines. 1698 ;; Inhibit auto-fill for headers, tables and fixed-width lines.
1572 (set (make-local-variable 'auto-fill-inhibit-regexp) 1699 (set (make-local-variable 'auto-fill-inhibit-regexp)
1573 (concat "\\*" 1700 (concat "\\*"
@@ -1577,6 +1704,7 @@ The following commands are available:
1577 (if org-enable-table-editor "|" "") 1704 (if org-enable-table-editor "|" "")
1578 (if org-enable-fixed-width-editor ":" "") 1705 (if org-enable-fixed-width-editor ":" "")
1579 "]")))) 1706 "]"))))
1707 (set (make-local-variable 'fill-paragraph-function) 'org-fill-paragraph)
1580 (if (and org-insert-mode-line-in-empty-file 1708 (if (and org-insert-mode-line-in-empty-file
1581 (interactive-p) 1709 (interactive-p)
1582 (= (point-min) (point-max))) 1710 (= (point-min) (point-max)))
@@ -1591,25 +1719,38 @@ The following commands are available:
1591 (let ((this-command 'org-cycle) (last-command 'org-cycle)) 1719 (let ((this-command 'org-cycle) (last-command 'org-cycle))
1592 (org-cycle '(4)) (org-cycle '(4)))))))) 1720 (org-cycle '(4)) (org-cycle '(4))))))))
1593 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
1594;;; Font-Lock stuff 1728;;; Font-Lock stuff
1595 1729
1596(defvar org-mouse-map (make-sparse-keymap)) 1730(defvar org-mouse-map (make-sparse-keymap))
1597(define-key org-mouse-map 1731(define-key org-mouse-map
1598 (if org-xemacs-p [button2] [mouse-2]) 'org-open-at-mouse) 1732 (if org-xemacs-p [button2] [mouse-2]) 'org-open-at-mouse)
1599(define-key org-mouse-map 1733(define-key org-mouse-map
1600 (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)
1601 1735
1602(require 'font-lock) 1736(require 'font-lock)
1603 1737
1604(defconst org-non-link-chars "\t\n\r|") 1738(defconst org-non-link-chars "\t\n\r|<>\000")
1605(defconst org-link-regexp 1739(defconst org-link-regexp
1606 (if org-allow-space-in-links 1740 (if org-allow-space-in-links
1607 (concat 1741 (concat
1608 "\\(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 "]\\)")
1609 (concat 1743 (concat
1610 "\\(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 "]+\\)")
1611 ) 1745 )
1612 "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
1613(defconst org-ts-lengths 1754(defconst org-ts-lengths
1614 (cons (length (format-time-string (car org-time-stamp-formats))) 1755 (cons (length (format-time-string (car org-time-stamp-formats)))
1615 (length (format-time-string (cdr org-time-stamp-formats)))) 1756 (length (format-time-string (cdr org-time-stamp-formats))))
@@ -1654,37 +1795,37 @@ The following commands are available:
1654(defun org-set-font-lock-defaults () 1795(defun org-set-font-lock-defaults ()
1655 (let ((org-font-lock-extra-keywords 1796 (let ((org-font-lock-extra-keywords
1656 (list 1797 (list
1657 '(org-activate-links (0 'org-link-face)) 1798 '(org-activate-links (0 'org-link))
1658 '(org-activate-dates (0 'org-link-face)) 1799 '(org-activate-dates (0 'org-link))
1659 (list (concat "^\\*+[ \t]*" org-not-done-regexp) 1800 (list (concat "^\\*+[ \t]*" org-not-done-regexp)
1660 '(1 'org-warning-face t)) 1801 '(1 'org-warning t))
1661 (list (concat "\\[#[A-Z]\\]") '(0 'org-warning-face t)) 1802 (list (concat "\\[#[A-Z]\\]") '(0 'org-warning t))
1662 (list (concat "\\<" org-deadline-string) '(0 'org-warning-face t)) 1803 (list (concat "\\<" org-deadline-string) '(0 'org-warning t))
1663 (list (concat "\\<" org-scheduled-string) '(0 'org-warning-face t)) 1804 (list (concat "\\<" org-scheduled-string) '(0 'org-warning t))
1664 ;; '("\\(\\s-\\|^\\)\\(\\*\\([a-zA-Z]+\\)\\*\\)\\([^a-zA-Z*]\\|$\\)" 1805 ;; '("\\(\\s-\\|^\\)\\(\\*\\([a-zA-Z]+\\)\\*\\)\\([^a-zA-Z*]\\|$\\)"
1665 ;; (3 'bold)) 1806 ;; (3 'bold))
1666 ;; '("\\(\\s-\\|^\\)\\(/\\([a-zA-Z]+\\)/\\)\\([^a-zA-Z*]\\|$\\)" 1807 ;; '("\\(\\s-\\|^\\)\\(/\\([a-zA-Z]+\\)/\\)\\([^a-zA-Z*]\\|$\\)"
1667 ;; (3 'italic)) 1808 ;; (3 'italic))
1668 ;; '("\\(\\s-\\|^\\)\\(_\\([a-zA-Z]+\\)_\\)\\([^a-zA-Z*]\\|$\\)" 1809 ;; '("\\(\\s-\\|^\\)\\(_\\([a-zA-Z]+\\)_\\)\\([^a-zA-Z*]\\|$\\)"
1669 ;; (3 'underline)) 1810 ;; (3 'underline))
1670 '("\\<FIXME\\>" (0 'org-warning-face t)) 1811 '("\\<FIXME\\>" (0 'org-warning t))
1671 (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string "\\)\\>") 1812 (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string "\\)\\>")
1672 '(1 'org-warning-face t)) 1813 '(1 'org-warning t))
1673 '("^#.*" (0 'font-lock-comment-face t)) 1814 '("^#.*" (0 'font-lock-comment-face t))
1674 (if org-fontify-done-headline 1815 (if org-fontify-done-headline
1675 (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\(.*\\)\\>") 1816 (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\(.*\\)\\>")
1676 '(1 'org-done-face t) '(2 'org-headline-done-face t)) 1817 '(1 'org-done t) '(2 'org-headline-done t))
1677 (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>") 1818 (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>")
1678 '(1 'org-done-face t))) 1819 '(1 'org-done t)))
1679 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" 1820 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
1680 (1 'org-table-face t)) 1821 (1 'org-table t))
1681 '("^[ \t]*\\(:.*\\)" (1 'org-table-face t))))) 1822 '("^[ \t]*\\(:.*\\)" (1 'org-table t)))))
1682 (set (make-local-variable 'org-font-lock-keywords) 1823 (set (make-local-variable 'org-font-lock-keywords)
1683 (append 1824 (append
1684 (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
1685 ; on XEmacs if noutline is ever ported 1826 ; on XEmacs if noutline is ever ported
1686 '((eval . (list "^\\(\\*+\\).*" 1827 '((eval . (list "^\\(\\*+\\).*"
1687 0 '(nth 1828 0 '(nth
1688 (% (- (match-end 1) (match-beginning 1) 1) 1829 (% (- (match-end 1) (match-beginning 1) 1)
1689 org-n-levels) 1830 org-n-levels)
1690 org-level-faces) 1831 org-level-faces)
@@ -1698,7 +1839,7 @@ The following commands are available:
1698 (set (make-local-variable 'font-lock-defaults) 1839 (set (make-local-variable 'font-lock-defaults)
1699 '(org-font-lock-keywords t nil nil backward-paragraph)) 1840 '(org-font-lock-keywords t nil nil backward-paragraph))
1700 (kill-local-variable 'font-lock-keywords) nil)) 1841 (kill-local-variable 'font-lock-keywords) nil))
1701 1842
1702(defun org-unfontify-region (beg end &optional maybe_loudly) 1843(defun org-unfontify-region (beg end &optional maybe_loudly)
1703 "Remove fontification and activation overlays from links." 1844 "Remove fontification and activation overlays from links."
1704 (font-lock-default-unfontify-region beg end) 1845 (font-lock-default-unfontify-region beg end)
@@ -1889,12 +2030,12 @@ Optional argument N means, put the headline into the Nth line of the window."
1889(let ((cmds '(isearch-forward isearch-backward)) cmd) 2030(let ((cmds '(isearch-forward isearch-backward)) cmd)
1890 (while (setq cmd (pop cmds)) 2031 (while (setq cmd (pop cmds))
1891 (substitute-key-definition cmd cmd org-goto-map global-map))) 2032 (substitute-key-definition cmd cmd org-goto-map global-map)))
1892(define-key org-goto-map [(return)] 'org-goto-ret) 2033(define-key org-goto-map "\C-m" 'org-goto-ret)
1893(define-key org-goto-map [(left)] 'org-goto-left) 2034(define-key org-goto-map [(left)] 'org-goto-left)
1894(define-key org-goto-map [(right)] 'org-goto-right) 2035(define-key org-goto-map [(right)] 'org-goto-right)
1895(define-key org-goto-map [(?q)] 'org-goto-quit) 2036(define-key org-goto-map [(?q)] 'org-goto-quit)
1896(define-key org-goto-map [(control ?g)] 'org-goto-quit) 2037(define-key org-goto-map [(control ?g)] 'org-goto-quit)
1897(define-key org-goto-map [(tab)] 'org-cycle) 2038(define-key org-goto-map "\C-i" 'org-cycle)
1898(define-key org-goto-map [(down)] 'outline-next-visible-heading) 2039(define-key org-goto-map [(down)] 'outline-next-visible-heading)
1899(define-key org-goto-map [(up)] 'outline-previous-visible-heading) 2040(define-key org-goto-map [(up)] 'outline-previous-visible-heading)
1900(define-key org-goto-map "n" 'outline-next-visible-heading) 2041(define-key org-goto-map "n" 'outline-next-visible-heading)
@@ -2098,7 +2239,7 @@ in the region."
2098 (org-back-to-heading t) 2239 (org-back-to-heading t)
2099 (let* ((level (save-match-data (funcall outline-level))) 2240 (let* ((level (save-match-data (funcall outline-level)))
2100 (up-head (make-string (1- level) ?*))) 2241 (up-head (make-string (1- level) ?*)))
2101 (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"))
2102 (replace-match up-head nil t) 2243 (replace-match up-head nil t)
2103 (if org-adapt-indentation 2244 (if org-adapt-indentation
2104 (org-fixup-indentation "^ " "" "^ ?\\S-")))) 2245 (org-fixup-indentation "^ " "" "^ ?\\S-"))))
@@ -2279,15 +2420,21 @@ If optional TREE is given, use this text instead of the kill ring."
2279 (- (match-end 0) (match-beginning 0))) 2420 (- (match-end 0) (match-beginning 0)))
2280 (t nil))) 2421 (t nil)))
2281 (previous-level (save-excursion 2422 (previous-level (save-excursion
2282 (outline-previous-visible-heading 1) 2423 (condition-case nil
2283 (if (looking-at re) 2424 (progn
2284 (- (match-end 0) (match-beginning 0)) 2425 (outline-previous-visible-heading 1)
2285 1))) 2426 (if (looking-at re)
2427 (- (match-end 0) (match-beginning 0))
2428 1))
2429 (error 1))))
2286 (next-level (save-excursion 2430 (next-level (save-excursion
2287 (outline-next-visible-heading 1) 2431 (condition-case nil
2288 (if (looking-at re) 2432 (progn
2289 (- (match-end 0) (match-beginning 0)) 2433 (outline-next-visible-heading 1)
2290 1))) 2434 (if (looking-at re)
2435 (- (match-end 0) (match-beginning 0))
2436 1))
2437 (error 1))))
2291 (new-level (or force-level (max previous-level next-level))) 2438 (new-level (or force-level (max previous-level next-level)))
2292 (shift (if (or (= old-level -1) 2439 (shift (if (or (= old-level -1)
2293 (= new-level -1) 2440 (= new-level -1)
@@ -2346,6 +2493,102 @@ If optional TXT is given, check this string instead of the current kill."
2346 (throw 'exit nil))) 2493 (throw 'exit nil)))
2347 t)))) 2494 t))))
2348 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
2349;;; Completion 2592;;; Completion
2350 2593
2351(defun org-complete (&optional arg) 2594(defun org-complete (&optional arg)
@@ -2374,11 +2617,11 @@ At all other locations, this simply calls `ispell-complete-word'."
2374 (table (cond 2617 (table (cond
2375 (opt 2618 (opt
2376 (setq type :opt) 2619 (setq type :opt)
2377 (mapcar (lambda (x) 2620 (mapcar (lambda (x)
2378 (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x) 2621 (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x)
2379 (cons (match-string 2 x) (match-string 1 x))) 2622 (cons (match-string 2 x) (match-string 1 x)))
2380 (org-split-string (org-get-current-options) "\n"))) 2623 (org-split-string (org-get-current-options) "\n")))
2381 (texp 2624 (texp
2382 (setq type :tex) 2625 (setq type :tex)
2383 org-html-entities) 2626 org-html-entities)
2384 ((string-match "\\`\\*+[ \t]*\\'" 2627 ((string-match "\\`\\*+[ \t]*\\'"
@@ -2388,7 +2631,7 @@ At all other locations, this simply calls `ispell-complete-word'."
2388 (t (progn (ispell-complete-word arg) (throw 'exit nil))))) 2631 (t (progn (ispell-complete-word arg) (throw 'exit nil)))))
2389 (completion (try-completion pattern table))) 2632 (completion (try-completion pattern table)))
2390 (cond ((eq completion t) 2633 (cond ((eq completion t)
2391 (if (equal type :opt) 2634 (if (equal type :opt)
2392 (insert (substring (cdr (assoc (upcase pattern) table)) 2635 (insert (substring (cdr (assoc (upcase pattern) table))
2393 (length pattern))))) 2636 (length pattern)))))
2394 ((null completion) 2637 ((null completion)
@@ -2396,7 +2639,7 @@ At all other locations, this simply calls `ispell-complete-word'."
2396 (ding)) 2639 (ding))
2397 ((not (string= pattern completion)) 2640 ((not (string= pattern completion))
2398 (delete-region beg end) 2641 (delete-region beg end)
2399 (if (string-match " +$" completion) 2642 (if (string-match " +$" completion)
2400 (setq completion (replace-match "" t t completion))) 2643 (setq completion (replace-match "" t t completion)))
2401 (insert completion) 2644 (insert completion)
2402 (if (get-buffer-window "*Completions*") 2645 (if (get-buffer-window "*Completions*")
@@ -2633,9 +2876,9 @@ ACTION can be set, up, or down."
2633 (save-match-data 2876 (save-match-data
2634 (if (not (string-match org-priority-regexp s)) 2877 (if (not (string-match org-priority-regexp s))
2635 (* 1000 (- org-lowest-priority org-default-priority)) 2878 (* 1000 (- org-lowest-priority org-default-priority))
2636 (* 1000 (- org-lowest-priority 2879 (* 1000 (- org-lowest-priority
2637 (string-to-char (match-string 2 s))))))) 2880 (string-to-char (match-string 2 s)))))))
2638 2881
2639;;; Timestamps 2882;;; Timestamps
2640 2883
2641(defvar org-last-changed-timestamp nil) 2884(defvar org-last-changed-timestamp nil)
@@ -2667,7 +2910,7 @@ at the cursor, it will be modified."
2667 (setq time (let ((this-command this-command)) 2910 (setq time (let ((this-command this-command))
2668 (org-read-date arg 'totime))) 2911 (org-read-date arg 'totime)))
2669 (and (org-at-timestamp-p) (replace-match 2912 (and (org-at-timestamp-p) (replace-match
2670 (setq org-last-changed-timestamp 2913 (setq org-last-changed-timestamp
2671 (format-time-string fmt time)) 2914 (format-time-string fmt time))
2672 t t)) 2915 t t))
2673 (message "Timestamp updated")) 2916 (message "Timestamp updated"))
@@ -2697,8 +2940,8 @@ but this can be configured with the variables `parse-time-months' and
2697 2940
2698While prompting, a calendar is popped up - you can also select the 2941While prompting, a calendar is popped up - you can also select the
2699date 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
2700month. To scroll it to other months, use the keys `>' and `<'. 2943month. To scroll it to other months, use the keys `>' and `<'.
2701If you don't like the calendar, turn it off with 2944If you don't like the calendar, turn it off with
2702 \(setq org-popup-calendar-for-date-prompt nil). 2945 \(setq org-popup-calendar-for-date-prompt nil).
2703 2946
2704With optional argument TO-TIME, the date will immediately be converted 2947With optional argument TO-TIME, the date will immediately be converted
@@ -2712,7 +2955,7 @@ used to insert the time stamp into the buffer to include the time."
2712 ;; Default time is either today, or, when entering a range, 2955 ;; Default time is either today, or, when entering a range,
2713 ;; the range start. 2956 ;; the range start.
2714 (if (save-excursion 2957 (if (save-excursion
2715 (re-search-backward 2958 (re-search-backward
2716 (concat org-ts-regexp "--\\=") 2959 (concat org-ts-regexp "--\\=")
2717 (- (point) 20) t)) 2960 (- (point) 20) t))
2718 (apply 2961 (apply
@@ -2823,7 +3066,7 @@ This is used by `org-read-date' in a temporary keymap for the calendar buffer."
2823 (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))))
2824 (setq ans1 (format-time-string "%Y-%m-%d" time))) 3067 (setq ans1 (format-time-string "%Y-%m-%d" time)))
2825 (if (active-minibuffer-window) (exit-minibuffer)))) 3068 (if (active-minibuffer-window) (exit-minibuffer))))
2826 3069
2827(defun org-check-deadlines (ndays) 3070(defun org-check-deadlines (ndays)
2828 "Check if there are any deadlines due or past due. 3071 "Check if there are any deadlines due or past due.
2829A 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'
@@ -2863,7 +3106,7 @@ days in order to avoid rounding problems."
2863 (goto-char (point-at-bol)) 3106 (goto-char (point-at-bol))
2864 (re-search-forward org-tr-regexp (point-at-eol) t)) 3107 (re-search-forward org-tr-regexp (point-at-eol) t))
2865 (if (not (org-at-date-range-p)) 3108 (if (not (org-at-date-range-p))
2866 (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")))
2867 (let* ((ts1 (match-string 1)) 3110 (let* ((ts1 (match-string 1))
2868 (ts2 (match-string 2)) 3111 (ts2 (match-string 2))
2869 (havetime (or (> (length ts1) 15) (> (length ts2) 15))) 3112 (havetime (or (> (length ts1) 15) (> (length ts2) 15)))
@@ -3096,6 +3339,7 @@ If there is already a time stamp at the cursor position, update it."
3096(defvar org-agenda-follow-mode nil) 3339(defvar org-agenda-follow-mode nil)
3097(defvar org-agenda-buffer-name "*Org Agenda*") 3340(defvar org-agenda-buffer-name "*Org Agenda*")
3098(defvar org-agenda-redo-command nil) 3341(defvar org-agenda-redo-command nil)
3342(defvar org-agenda-mode-hook nil)
3099 3343
3100;;;###autoload 3344;;;###autoload
3101(defun org-agenda-mode () 3345(defun org-agenda-mode ()
@@ -3114,27 +3358,29 @@ The following commands are available:
3114 (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)
3115 (add-hook 'pre-command-hook 'org-unhighlight nil 'local) 3359 (add-hook 'pre-command-hook 'org-unhighlight nil 'local)
3116 (setq org-agenda-follow-mode nil) 3360 (setq org-agenda-follow-mode nil)
3117 (easy-menu-change 3361 (easy-menu-change
3118 '("Agenda") "Agenda Files" 3362 '("Agenda") "Agenda Files"
3119 (append 3363 (append
3120 (list 3364 (list
3121 ["Edit File List" (customize-variable 'org-agenda-files) t] 3365 ["Edit File List" (customize-variable 'org-agenda-files) t]
3122 "--") 3366 "--")
3123 (mapcar 'org-file-menu-entry org-agenda-files))) 3367 (mapcar 'org-file-menu-entry org-agenda-files)))
3124 (org-agenda-set-mode-name) 3368 (org-agenda-set-mode-name)
3125 (org-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))
3126 3372
3127(define-key org-agenda-mode-map [(tab)] 'org-agenda-goto) 3373(define-key org-agenda-mode-map "\C-i" 'org-agenda-goto)
3128(define-key org-agenda-mode-map [(return)] 'org-agenda-switch-to) 3374(define-key org-agenda-mode-map "\C-m" 'org-agenda-switch-to)
3129(define-key org-agenda-mode-map " " 'org-agenda-show) 3375(define-key org-agenda-mode-map " " 'org-agenda-show)
3130(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)
3131(define-key org-agenda-mode-map "o" 'delete-other-windows) 3377(define-key org-agenda-mode-map "o" 'delete-other-windows)
3132(define-key org-agenda-mode-map "l" 'org-agenda-recenter) 3378(define-key org-agenda-mode-map "l" 'org-agenda-recenter)
3133(define-key org-agenda-mode-map "t" 'org-agenda-todo) 3379(define-key org-agenda-mode-map "t" 'org-agenda-todo)
3134(define-key org-agenda-mode-map "." 'org-agenda-goto-today) 3380(define-key org-agenda-mode-map "." 'org-agenda-goto-today)
3135(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)
3136(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)
3137(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)
3138 3384
3139(define-key org-agenda-mode-map ">" 'org-agenda-date-prompt) 3385(define-key org-agenda-mode-map ">" 'org-agenda-date-prompt)
3140(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)))
@@ -3168,15 +3414,15 @@ The following commands are available:
3168(define-key org-agenda-mode-map "H" 'org-agenda-holidays) 3414(define-key org-agenda-mode-map "H" 'org-agenda-holidays)
3169(define-key org-agenda-mode-map "+" 'org-agenda-priority-up) 3415(define-key org-agenda-mode-map "+" 'org-agenda-priority-up)
3170(define-key org-agenda-mode-map "-" 'org-agenda-priority-down) 3416(define-key org-agenda-mode-map "-" 'org-agenda-priority-down)
3171(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)
3172(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)
3173(define-key org-agenda-mode-map [(right)] 'org-agenda-later) 3419(define-key org-agenda-mode-map [(right)] 'org-agenda-later)
3174(define-key org-agenda-mode-map [(left)] 'org-agenda-earlier) 3420(define-key org-agenda-mode-map [(left)] 'org-agenda-earlier)
3175 3421
3176(defvar org-agenda-keymap (copy-keymap org-agenda-mode-map) 3422(defvar org-agenda-keymap (copy-keymap org-agenda-mode-map)
3177 "Local keymap for agenda entries from Org-mode.") 3423 "Local keymap for agenda entries from Org-mode.")
3178 3424
3179(define-key org-agenda-keymap 3425(define-key org-agenda-keymap
3180 (if org-xemacs-p [(button2)] [(mouse-2)]) 'org-agenda-goto-mouse) 3426 (if org-xemacs-p [(button2)] [(mouse-2)]) 'org-agenda-goto-mouse)
3181(define-key org-agenda-keymap 3427(define-key org-agenda-keymap
3182 (if org-xemacs-p [(button3)] [(mouse-3)]) 'org-agenda-show-mouse) 3428 (if org-xemacs-p [(button3)] [(mouse-3)]) 'org-agenda-show-mouse)
@@ -3188,7 +3434,7 @@ The following commands are available:
3188 ["Show" org-agenda-show t] 3434 ["Show" org-agenda-show t]
3189 ["Go To (other window)" org-agenda-goto t] 3435 ["Go To (other window)" org-agenda-goto t]
3190 ["Go To (one window)" org-agenda-switch-to t] 3436 ["Go To (one window)" org-agenda-switch-to t]
3191 ["Follow Mode" org-agenda-follow-mode 3437 ["Follow Mode" org-agenda-follow-mode
3192 :style toggle :selected org-agenda-follow-mode :active t] 3438 :style toggle :selected org-agenda-follow-mode :active t]
3193 "--" 3439 "--"
3194 ["Cycle TODO" org-agenda-todo t] 3440 ["Cycle TODO" org-agenda-todo t]
@@ -3306,7 +3552,7 @@ dates."
3306 (org-respect-restriction t) 3552 (org-respect-restriction t)
3307 (past t) 3553 (past t)
3308 s e rtn d) 3554 s e rtn d)
3309 (setq org-agenda-redo-command 3555 (setq org-agenda-redo-command
3310 (list 'progn 3556 (list 'progn
3311 (list 'switch-to-buffer-other-window (current-buffer)) 3557 (list 'switch-to-buffer-other-window (current-buffer))
3312 (list 'org-timeline include-all))) 3558 (list 'org-timeline include-all)))
@@ -3315,7 +3561,7 @@ dates."
3315 (setq day-numbers (delq nil (mapcar (lambda(x) 3561 (setq day-numbers (delq nil (mapcar (lambda(x)
3316 (if (>= x today) x nil)) 3562 (if (>= x today) x nil))
3317 day-numbers)))) 3563 day-numbers))))
3318 (switch-to-buffer-other-window 3564 (switch-to-buffer-other-window
3319 (get-buffer-create org-agenda-buffer-name)) 3565 (get-buffer-create org-agenda-buffer-name))
3320 (setq buffer-read-only nil) 3566 (setq buffer-read-only nil)
3321 (erase-buffer) 3567 (erase-buffer)
@@ -3330,7 +3576,7 @@ dates."
3330 (setq date (calendar-gregorian-from-absolute d)) 3576 (setq date (calendar-gregorian-from-absolute d))
3331 (setq s (point)) 3577 (setq s (point))
3332 (if dotodo 3578 (if dotodo
3333 (setq rtn (org-agenda-get-day-entries 3579 (setq rtn (org-agenda-get-day-entries
3334 entry date :todo :timestamp)) 3580 entry date :todo :timestamp))
3335 (setq rtn (org-agenda-get-day-entries entry date :timestamp))) 3581 (setq rtn (org-agenda-get-day-entries entry date :timestamp)))
3336 (if (or rtn (equal d today)) 3582 (if (or rtn (equal d today))
@@ -3340,7 +3586,7 @@ dates."
3340 (calendar-month-name (extract-calendar-month date)) " " 3586 (calendar-month-name (extract-calendar-month date)) " "
3341 (number-to-string (extract-calendar-year date)) "\n") 3587 (number-to-string (extract-calendar-year date)) "\n")
3342 (put-text-property s (1- (point)) 'face 3588 (put-text-property s (1- (point)) 'face
3343 'org-link-face) 3589 'org-link)
3344 (if (equal d today) 3590 (if (equal d today)
3345 (put-text-property s (1- (point)) 'org-today t)) 3591 (put-text-property s (1- (point)) 'org-today t))
3346 (insert (org-finalize-agenda-entries rtn) "\n") 3592 (insert (org-finalize-agenda-entries rtn) "\n")
@@ -3386,7 +3632,7 @@ NDAYS defaults to `org-agenda-ndays'."
3386 (day-numbers (list start)) 3632 (day-numbers (list start))
3387 (inhibit-redisplay t) 3633 (inhibit-redisplay t)
3388 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)
3389 (setq org-agenda-redo-command 3635 (setq org-agenda-redo-command
3390 (list 'org-agenda include-all start-day ndays)) 3636 (list 'org-agenda include-all start-day ndays))
3391 ;; Make the list of days 3637 ;; Make the list of days
3392 (setq ndays (or ndays org-agenda-ndays) 3638 (setq ndays (or ndays org-agenda-ndays)
@@ -3398,7 +3644,7 @@ NDAYS defaults to `org-agenda-ndays'."
3398 (if (not (equal (current-buffer) (get-buffer org-agenda-buffer-name))) 3644 (if (not (equal (current-buffer) (get-buffer org-agenda-buffer-name)))
3399 (progn 3645 (progn
3400 (delete-other-windows) 3646 (delete-other-windows)
3401 (switch-to-buffer-other-window 3647 (switch-to-buffer-other-window
3402 (get-buffer-create org-agenda-buffer-name)))) 3648 (get-buffer-create org-agenda-buffer-name))))
3403 (setq buffer-read-only nil) 3649 (setq buffer-read-only nil)
3404 (erase-buffer) 3650 (erase-buffer)
@@ -3416,10 +3662,10 @@ NDAYS defaults to `org-agenda-ndays'."
3416 rtn (org-agenda-get-day-entries 3662 rtn (org-agenda-get-day-entries
3417 file date :todo)) 3663 file date :todo))
3418 (setq rtnall (append rtnall rtn)))) 3664 (setq rtnall (append rtnall rtn))))
3419 (when rtnall 3665 (when rtnall
3420 (insert "ALL CURRENTLY OPEN TODO ITEMS:\n") 3666 (insert "ALL CURRENTLY OPEN TODO ITEMS:\n")
3421 (add-text-properties (point-min) (1- (point)) 3667 (add-text-properties (point-min) (1- (point))
3422 (list 'face 'org-link-face)) 3668 (list 'face 'org-link))
3423 (insert (org-finalize-agenda-entries rtnall) "\n"))) 3669 (insert (org-finalize-agenda-entries rtnall) "\n")))
3424 (while (setq d (pop day-numbers)) 3670 (while (setq d (pop day-numbers))
3425 (setq date (calendar-gregorian-from-absolute d) 3671 (setq date (calendar-gregorian-from-absolute d)
@@ -3449,13 +3695,13 @@ NDAYS defaults to `org-agenda-ndays'."
3449 (calendar-month-name (extract-calendar-month date)) 3695 (calendar-month-name (extract-calendar-month date))
3450 (extract-calendar-year date))) 3696 (extract-calendar-year date)))
3451 (put-text-property s (1- (point)) 'face 3697 (put-text-property s (1- (point)) 'face
3452 'org-link-face) 3698 'org-link)
3453 (if rtnall (insert 3699 (if rtnall (insert
3454 (org-finalize-agenda-entries ;; FIXME: condition needed 3700 (org-finalize-agenda-entries ;; FIXME: condition needed
3455 (org-agenda-add-time-grid-maybe 3701 (org-agenda-add-time-grid-maybe
3456 rtnall nd todayp)) 3702 rtnall nd todayp))
3457 "\n")) 3703 "\n"))
3458 (put-text-property s (1- (point)) 'day d)))) 3704 (put-text-property s (1- (point)) 'day d))))
3459 (goto-char (point-min)) 3705 (goto-char (point-min))
3460 (setq buffer-read-only t) 3706 (setq buffer-read-only t)
3461 (if org-fit-agenda-window 3707 (if org-fit-agenda-window
@@ -3545,7 +3791,7 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
3545 (error "Not allowed")) 3791 (error "Not allowed"))
3546 (setq org-agenda-ndays 3792 (setq org-agenda-ndays
3547 (if (equal org-agenda-ndays 1) 7 1)) 3793 (if (equal org-agenda-ndays 1) 7 1))
3548 (org-agenda include-all-loc 3794 (org-agenda include-all-loc
3549 (or (get-text-property (point) 'day) 3795 (or (get-text-property (point) 'day)
3550 starting-day)) 3796 starting-day))
3551 (org-agenda-set-mode-name) 3797 (org-agenda-set-mode-name)
@@ -3560,7 +3806,7 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
3560 (if (not (re-search-forward "^\\S-" nil t arg)) 3806 (if (not (re-search-forward "^\\S-" nil t arg))
3561 (progn 3807 (progn
3562 (backward-char 1) 3808 (backward-char 1)
3563 (error "No next date after this line in this buffer."))) 3809 (error "No next date after this line in this buffer")))
3564 (goto-char (match-beginning 0))) 3810 (goto-char (match-beginning 0)))
3565 3811
3566(defun org-agenda-previous-date-line (&optional arg) 3812(defun org-agenda-previous-date-line (&optional arg)
@@ -3568,7 +3814,7 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
3568 (interactive "p") 3814 (interactive "p")
3569 (beginning-of-line 1) 3815 (beginning-of-line 1)
3570 (if (not (re-search-backward "^\\S-" nil t arg)) 3816 (if (not (re-search-backward "^\\S-" nil t arg))
3571 (error "No previous date before this line in this buffer."))) 3817 (error "No previous date before this line in this buffer")))
3572 3818
3573;; Initialize the highlight 3819;; Initialize the highlight
3574(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))
@@ -3634,7 +3880,7 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
3634 "Get the (Emacs Calendar) diary entries for DATE." 3880 "Get the (Emacs Calendar) diary entries for DATE."
3635 (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*") 3881 (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*")
3636 (diary-display-hook '(fancy-diary-display)) 3882 (diary-display-hook '(fancy-diary-display))
3637 (list-diary-entries-hook 3883 (list-diary-entries-hook
3638 (cons 'org-diary-default-entry list-diary-entries-hook)) 3884 (cons 'org-diary-default-entry list-diary-entries-hook))
3639 entries 3885 entries
3640 (org-disable-diary t)) 3886 (org-disable-diary t))
@@ -3658,12 +3904,12 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
3658 (kill-buffer fancy-diary-buffer))) 3904 (kill-buffer fancy-diary-buffer)))
3659 (when entries 3905 (when entries
3660 (setq entries (org-split-string entries "\n")) 3906 (setq entries (org-split-string entries "\n"))
3661 (setq entries 3907 (setq entries
3662 (mapcar 3908 (mapcar
3663 (lambda (x) 3909 (lambda (x)
3664 (setq x (org-format-agenda-item "" x "Diary" 'time)) 3910 (setq x (org-format-agenda-item "" x "Diary" 'time))
3665 ;; Extend the text properties to the beginning of the line 3911 ;; Extend the text properties to the beginning of the line
3666 (add-text-properties 3912 (add-text-properties
3667 0 (length x) 3913 0 (length x)
3668 (text-properties-at (1- (length x)) x) 3914 (text-properties-at (1- (length x)) x)
3669 x) 3915 x)
@@ -3704,7 +3950,7 @@ date. Itt also removes lines that contain only whitespace."
3704 0 (length string) 3950 0 (length string)
3705 (list 'mouse-face 'highlight 3951 (list 'mouse-face 'highlight
3706 'keymap org-agenda-keymap 3952 'keymap org-agenda-keymap
3707 'help-echo 3953 'help-echo
3708 (format 3954 (format
3709 "mouse-2 or RET jump to diary file %s" 3955 "mouse-2 or RET jump to diary file %s"
3710 (abbreviate-file-name (buffer-file-name))) 3956 (abbreviate-file-name (buffer-file-name)))
@@ -3726,7 +3972,7 @@ Needed to avoid empty dates which mess up holiday display."
3726These are the files which are being checked for agenda entries. 3972These are the files which are being checked for agenda entries.
3727Optional argument FILE means, use this file instead of the current. 3973Optional argument FILE means, use this file instead of the current.
3728It is possible (but not recommended) to add this function to the 3974It is possible (but not recommended) to add this function to the
3729`org-mode-hook'." 3975`org-mode-hook'."
3730 (interactive) 3976 (interactive)
3731 (catch 'exit 3977 (catch 'exit
3732 (let* ((file (or file (buffer-file-name) 3978 (let* ((file (or file (buffer-file-name)
@@ -3741,7 +3987,7 @@ It is possible (but not recommended) to add this function to the
3741 org-agenda-files)))) 3987 org-agenda-files))))
3742 (if (not present) 3988 (if (not present)
3743 (progn 3989 (progn
3744 (setq org-agenda-files 3990 (setq org-agenda-files
3745 (cons afile org-agenda-files)) 3991 (cons afile org-agenda-files))
3746 ;; Make sure custom.el does not end up with Org-mode 3992 ;; Make sure custom.el does not end up with Org-mode
3747 (let ((org-mode-hook nil) (default-major-mode 'fundamental-mode)) 3993 (let ((org-mode-hook nil) (default-major-mode 'fundamental-mode))
@@ -3758,7 +4004,7 @@ Optional argument FILE means, use this file instead of the current."
3758 (let* ((file (or file (buffer-file-name))) 4004 (let* ((file (or file (buffer-file-name)))
3759 (true-file (file-truename file)) 4005 (true-file (file-truename file))
3760 (afile (abbreviate-file-name file)) 4006 (afile (abbreviate-file-name file))
3761 (files (delq nil (mapcar 4007 (files (delq nil (mapcar
3762 (lambda (x) 4008 (lambda (x)
3763 (if (equal true-file 4009 (if (equal true-file
3764 (file-truename x)) 4010 (file-truename x))
@@ -3843,7 +4089,7 @@ also be written as
3843 4089
3844The function expects the lisp variables `entry' and `date' to be provided 4090The function expects the lisp variables `entry' and `date' to be provided
3845by 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
3846function from a program - use `org-agenda-get-day-entries' instead." 4092function from a program - use `org-agenda-get-day-entries' instead."
3847 (org-agenda-maybe-reset-markers) 4093 (org-agenda-maybe-reset-markers)
3848 (org-compile-agenda-prefix-format org-agenda-prefix-format) 4094 (org-compile-agenda-prefix-format org-agenda-prefix-format)
3849 (setq args (or args '(:deadline :scheduled :timestamp))) 4095 (setq args (or args '(:deadline :scheduled :timestamp)))
@@ -3885,7 +4131,7 @@ the documentation of `org-diary'."
3885 (if (org-region-active-p) 4131 (if (org-region-active-p)
3886 ;; Respect a region to restrict search 4132 ;; Respect a region to restrict search
3887 (narrow-to-region (region-beginning) (region-end))) 4133 (narrow-to-region (region-beginning) (region-end)))
3888 ;; If we work for the calendar or many files, 4134 ;; If we work for the calendar or many files,
3889 ;; get rid of any restriction 4135 ;; get rid of any restriction
3890 (widen)) 4136 (widen))
3891 ;; 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) :-(
@@ -3936,7 +4182,7 @@ the documentation of `org-diary'."
3936(defun org-agenda-get-todos () 4182(defun org-agenda-get-todos ()
3937 "Return the TODO information for agenda display." 4183 "Return the TODO information for agenda display."
3938 (let* ((props (list 'face nil 4184 (let* ((props (list 'face nil
3939 'done-face 'org-done-face 4185 'done-face 'org-done
3940 'mouse-face 'highlight 4186 'mouse-face 'highlight
3941 'keymap org-agenda-keymap 4187 'keymap org-agenda-keymap
3942 'help-echo 4188 'help-echo
@@ -3951,7 +4197,7 @@ the documentation of `org-diary'."
3951 (goto-char (match-beginning 1)) 4197 (goto-char (match-beginning 1))
3952 (setq marker (org-agenda-new-marker (point-at-bol)) 4198 (setq marker (org-agenda-new-marker (point-at-bol))
3953 txt (org-format-agenda-item "" (match-string 1)) 4199 txt (org-format-agenda-item "" (match-string 1))
3954 priority 4200 priority
3955 (+ (org-get-priority txt) 4201 (+ (org-get-priority txt)
3956 (if org-todo-kwd-priority-p 4202 (if org-todo-kwd-priority-p
3957 (- org-todo-kwd-max-priority -2 4203 (- org-todo-kwd-max-priority -2
@@ -4023,18 +4269,18 @@ the documentation of `org-diary'."
4023 (if deadlinep 4269 (if deadlinep
4024 (add-text-properties 4270 (add-text-properties
4025 0 (length txt) 4271 0 (length txt)
4026 (list 'face 4272 (list 'face
4027 (if donep 'org-done-face 'org-warning-face) 4273 (if donep 'org-done 'org-warning)
4028 'undone-face 'org-warning-face 4274 'undone-face 'org-warning
4029 'done-face 'org-done-face 4275 'done-face 'org-done
4030 'priority (+ 100 priority)) 4276 'priority (+ 100 priority))
4031 txt) 4277 txt)
4032 (if scheduledp 4278 (if scheduledp
4033 (add-text-properties 4279 (add-text-properties
4034 0 (length txt) 4280 0 (length txt)
4035 (list 'face 'org-scheduled-today-face 4281 (list 'face 'org-scheduled-today
4036 'undone-face 'org-scheduled-today-face 4282 'undone-face 'org-scheduled-today
4037 'done-face 'org-done-face 4283 'done-face 'org-done
4038 priority (+ 99 priority)) 4284 priority (+ 99 priority))
4039 txt) 4285 txt)
4040 (add-text-properties 4286 (add-text-properties
@@ -4083,19 +4329,19 @@ the documentation of `org-diary'."
4083 (setq txt org-agenda-no-heading-message)) 4329 (setq txt org-agenda-no-heading-message))
4084 (when txt 4330 (when txt
4085 (add-text-properties 4331 (add-text-properties
4086 0 (length txt) 4332 0 (length txt)
4087 (append 4333 (append
4088 (list 'org-marker (org-agenda-new-marker pos) 4334 (list 'org-marker (org-agenda-new-marker pos)
4089 'org-hd-marker (org-agenda-new-marker pos1) 4335 'org-hd-marker (org-agenda-new-marker pos1)
4090 'priority (+ (- 10 diff) (org-get-priority txt)) 4336 'priority (+ (- 10 diff) (org-get-priority txt))
4091 'face (cond ((<= diff 0) 'org-warning-face) 4337 'face (cond ((<= diff 0) 'org-warning)
4092 ((<= diff 5) 'org-scheduled-previously-face) 4338 ((<= diff 5) 'org-scheduled-previously)
4093 (t nil)) 4339 (t nil))
4094 'undone-face (cond 4340 'undone-face (cond
4095 ((<= diff 0) 'org-warning-face) 4341 ((<= diff 0) 'org-warning)
4096 ((<= diff 5) 'org-scheduled-previously-face) 4342 ((<= diff 5) 'org-scheduled-previously)
4097 (t nil)) 4343 (t nil))
4098 'done-face 'org-done-face) 4344 'done-face 'org-done)
4099 props) 4345 props)
4100 txt) 4346 txt)
4101 (push txt ee))))) 4347 (push txt ee)))))
@@ -4103,9 +4349,9 @@ the documentation of `org-diary'."
4103 4349
4104(defun org-agenda-get-scheduled () 4350(defun org-agenda-get-scheduled ()
4105 "Return the scheduled information for agenda display." 4351 "Return the scheduled information for agenda display."
4106 (let* ((props (list 'face 'org-scheduled-previously-face 4352 (let* ((props (list 'face 'org-scheduled-previously
4107 'undone-face 'org-scheduled-previously-face 4353 'undone-face 'org-scheduled-previously
4108 'done-face 'org-done-face 4354 'done-face 'org-done
4109 'mouse-face 'highlight 4355 'mouse-face 'highlight
4110 'keymap org-agenda-keymap 4356 'keymap org-agenda-keymap
4111 'help-echo 4357 'help-echo
@@ -4176,7 +4422,7 @@ the documentation of `org-diary'."
4176 (setq hdmarker (org-agenda-new-marker (match-end 1))) 4422 (setq hdmarker (org-agenda-new-marker (match-end 1)))
4177 (goto-char (match-end 1)) 4423 (goto-char (match-end 1))
4178 (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") 4424 (looking-at "\\*+[ \t]*\\([^\r\n]+\\)")
4179 (setq txt (org-format-agenda-item 4425 (setq txt (org-format-agenda-item
4180 (format (if (= d1 d2) "" "(%d/%d): ") 4426 (format (if (= d1 d2) "" "(%d/%d): ")
4181 (1+ (- d0 d1)) (1+ (- d2 d1))) 4427 (1+ (- d0 d1)) (1+ (- d2 d1)))
4182 (match-string 1) nil (if (= d0 d1) timestr)))) 4428 (match-string 1) nil (if (= d0 d1) timestr))))
@@ -4258,7 +4504,7 @@ only the correctly processes TXT should be returned - this is used by
4258 (setq s0 (match-string 0 ts) 4504 (setq s0 (match-string 0 ts)
4259 s1 (match-string (if plain 1 2) ts) 4505 s1 (match-string (if plain 1 2) ts)
4260 s2 (match-string (if plain 8 4) ts)) 4506 s2 (match-string (if plain 8 4) ts))
4261 4507
4262 ;; 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
4263 ;; them, we might want to remove them there to avoid duplication. 4509 ;; them, we might want to remove them there to avoid duplication.
4264 ;; The user can turn this off with a variable. 4510 ;; The user can turn this off with a variable.
@@ -4271,7 +4517,7 @@ only the correctly processes TXT should be returned - this is used by
4271 ;; Normalize the time(s) to 24 hour 4517 ;; Normalize the time(s) to 24 hour
4272 (if s1 (setq s1 (org-get-time-of-day s1 'string))) 4518 (if s1 (setq s1 (org-get-time-of-day s1 'string)))
4273 (if s2 (setq s2 (org-get-time-of-day s2 'string)))) 4519 (if s2 (setq s2 (org-get-time-of-day s2 'string))))
4274 4520
4275 ;; Create the final string 4521 ;; Create the final string
4276 (if noprefix 4522 (if noprefix
4277 (setq rtn txt) 4523 (setq rtn txt)
@@ -4283,7 +4529,7 @@ only the correctly processes TXT should be returned - this is used by
4283 category (if (symbolp category) (symbol-name category) category)) 4529 category (if (symbolp category) (symbol-name category) category))
4284 ;; Evaluate the compiled format 4530 ;; Evaluate the compiled format
4285 (setq rtn (concat (eval org-prefix-format-compiled) txt))) 4531 (setq rtn (concat (eval org-prefix-format-compiled) txt)))
4286 4532
4287 ;; And finally add the text properties 4533 ;; And finally add the text properties
4288 (add-text-properties 4534 (add-text-properties
4289 0 (length rtn) (list 'category (downcase category) 4535 0 (length rtn) (list 'category (downcase category)
@@ -4314,12 +4560,12 @@ only the correctly processes TXT should be returned - this is used by
4314 (while (setq time (pop gridtimes)) 4560 (while (setq time (pop gridtimes))
4315 (unless (and remove (member time have)) 4561 (unless (and remove (member time have))
4316 (setq time (int-to-string time)) 4562 (setq time (int-to-string time))
4317 (push (org-format-agenda-item 4563 (push (org-format-agenda-item
4318 nil string "" ;; FIXME: put a category? 4564 nil string "" ;; FIXME: put a category?
4319 (concat (substring time 0 -2) ":" (substring time -2))) 4565 (concat (substring time 0 -2) ":" (substring time -2)))
4320 new) 4566 new)
4321 (put-text-property 4567 (put-text-property
4322 1 (length (car new)) 'face 'org-time-grid-face (car new)))) 4568 1 (length (car new)) 'face 'org-time-grid (car new))))
4323 (if (member 'time-up org-agenda-sorting-strategy) 4569 (if (member 'time-up org-agenda-sorting-strategy)
4324 (append new list) 4570 (append new list)
4325 (append list new))))) 4571 (append list new)))))
@@ -4357,7 +4603,7 @@ If not found, return nil.
4357The optional STRING argument forces conversion into a 5 character wide string 4603The optional STRING argument forces conversion into a 5 character wide string
4358HH:MM." 4604HH:MM."
4359 (save-match-data 4605 (save-match-data
4360 (when 4606 (when
4361 (or 4607 (or
4362 (string-match 4608 (string-match
4363 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s) 4609 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s)
@@ -4405,6 +4651,7 @@ HH:MM."
4405 4651
4406(defun org-entries-lessp (a b) 4652(defun org-entries-lessp (a b)
4407 "Predicate for sorting agenda entries." 4653 "Predicate for sorting agenda entries."
4654 ;; The following variables will be used when the form is evaluated.
4408 (let* ((time-up (org-cmp-time a b)) 4655 (let* ((time-up (org-cmp-time a b))
4409 (time-down (if time-up (- time-up) nil)) 4656 (time-down (if time-up (- time-up) nil))
4410 (priority-up (org-cmp-priority a b)) 4657 (priority-up (org-cmp-priority a b))
@@ -4412,7 +4659,7 @@ HH:MM."
4412 (category-up (org-cmp-category a b)) 4659 (category-up (org-cmp-category a b))
4413 (category-down (if category-up (- category-up) nil)) 4660 (category-down (if category-up (- category-up) nil))
4414 (category-keep (if category-up +1 nil))) ; FIXME +1 or -1? 4661 (category-keep (if category-up +1 nil))) ; FIXME +1 or -1?
4415 (cdr (assoc 4662 (cdr (assoc
4416 (eval (cons 'or org-agenda-sorting-strategy)) 4663 (eval (cons 'or org-agenda-sorting-strategy))
4417 '((-1 . t) (1 . nil) (nil . nil)))))) 4664 '((-1 . t) (1 . nil) (nil . nil))))))
4418 4665
@@ -4427,7 +4674,7 @@ and by additional input from the age of a schedules or deadline entry."
4427(defun org-agenda-goto (&optional highlight) 4674(defun org-agenda-goto (&optional highlight)
4428 "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."
4429 (interactive) 4676 (interactive)
4430 (let* ((marker (or (get-text-property (point) 'org-marker) 4677 (let* ((marker (or (get-text-property (point) 'org-marker)
4431 (org-agenda-error))) 4678 (org-agenda-error)))
4432 (buffer (marker-buffer marker)) 4679 (buffer (marker-buffer marker))
4433 (pos (marker-position marker))) 4680 (pos (marker-position marker)))
@@ -4444,7 +4691,7 @@ and by additional input from the age of a schedules or deadline entry."
4444(defun org-agenda-switch-to () 4691(defun org-agenda-switch-to ()
4445 "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."
4446 (interactive) 4693 (interactive)
4447 (let* ((marker (or (get-text-property (point) 'org-marker) 4694 (let* ((marker (or (get-text-property (point) 'org-marker)
4448 (org-agenda-error))) 4695 (org-agenda-error)))
4449 (buffer (marker-buffer marker)) 4696 (buffer (marker-buffer marker))
4450 (pos (marker-position marker))) 4697 (pos (marker-position marker)))
@@ -4491,7 +4738,7 @@ and by additional input from the age of a schedules or deadline entry."
4491 (org-agenda-error))) 4738 (org-agenda-error)))
4492 4739
4493(defun org-agenda-error () 4740(defun org-agenda-error ()
4494 (error "Command not allowed in this line.")) 4741 (error "Command not allowed in this line"))
4495 4742
4496(defvar org-last-heading-marker (make-marker) 4743(defvar org-last-heading-marker (make-marker)
4497 "Marker pointing to the headline that last changed its TODO state 4744 "Marker pointing to the headline that last changed its TODO state
@@ -4558,7 +4805,7 @@ the new TODO state."
4558 (beginning-of-line 1) 4805 (beginning-of-line 1)
4559 (add-text-properties (point-at-bol) (point-at-eol) props) 4806 (add-text-properties (point-at-bol) (point-at-eol) props)
4560 (if fixface 4807 (if fixface
4561 (add-text-properties 4808 (add-text-properties
4562 (point-at-bol) (point-at-eol) 4809 (point-at-bol) (point-at-eol)
4563 (list 'face 4810 (list 'face
4564 (if org-last-todo-state-is-todo 4811 (if org-last-todo-state-is-todo
@@ -4655,7 +4902,7 @@ be used to request time specification in the time stamp."
4655All the standard commands work: block, weekly etc" 4902All the standard commands work: block, weekly etc"
4656 (interactive) 4903 (interactive)
4657 (require 'diary-lib) 4904 (require 'diary-lib)
4658 (let* ((char (progn 4905 (let* ((char (progn
4659 (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")
4660 (read-char-exclusive))) 4907 (read-char-exclusive)))
4661 (cmd (cdr (assoc char 4908 (cmd (cdr (assoc char
@@ -4685,7 +4932,7 @@ All the standard commands work: block, weekly etc"
4685 (progn 4932 (progn
4686 (fset 'calendar-cursor-to-date 4933 (fset 'calendar-cursor-to-date
4687 (lambda (&optional error) 4934 (lambda (&optional error)
4688 (calendar-gregorian-from-absolute 4935 (calendar-gregorian-from-absolute
4689 (get-text-property point 'day)))) 4936 (get-text-property point 'day))))
4690 (call-interactively cmd)) 4937 (call-interactively cmd))
4691 (fset 'calendar-cursor-to-date oldf))))) 4938 (fset 'calendar-cursor-to-date oldf)))))
@@ -4708,7 +4955,7 @@ the cursor position."
4708 (progn 4955 (progn
4709 (fset 'calendar-cursor-to-date 4956 (fset 'calendar-cursor-to-date
4710 (lambda (&optional error) 4957 (lambda (&optional error)
4711 (calendar-gregorian-from-absolute 4958 (calendar-gregorian-from-absolute
4712 (get-text-property point 'day)))) 4959 (get-text-property point 'day))))
4713 (call-interactively cmd)) 4960 (call-interactively cmd))
4714 (fset 'calendar-cursor-to-date oldf)))) 4961 (fset 'calendar-cursor-to-date oldf))))
@@ -4758,7 +5005,7 @@ This is a command that has to be installed in `calendar-mode-map'."
4758 (unless day 5005 (unless day
4759 (error "Don't know which date to convert")) 5006 (error "Don't know which date to convert"))
4760 (setq date (calendar-gregorian-from-absolute day)) 5007 (setq date (calendar-gregorian-from-absolute day))
4761 (setq s (concat 5008 (setq s (concat
4762 "Gregorian: " (calendar-date-string date) "\n" 5009 "Gregorian: " (calendar-date-string date) "\n"
4763 "ISO: " (calendar-iso-date-string date) "\n" 5010 "ISO: " (calendar-iso-date-string date) "\n"
4764 "Day of Yr: " (calendar-day-of-year-string date) "\n" 5011 "Day of Yr: " (calendar-day-of-year-string date) "\n"
@@ -4805,7 +5052,8 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
4805 (let (type path line (pos (point))) 5052 (let (type path line (pos (point)))
4806 (save-excursion 5053 (save-excursion
4807 (skip-chars-backward 5054 (skip-chars-backward
4808 (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))
4809 (if (re-search-forward 5057 (if (re-search-forward
4810 org-link-regexp 5058 org-link-regexp
4811 (save-excursion 5059 (save-excursion
@@ -4816,7 +5064,7 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
4816 (setq type (match-string 1) 5064 (setq type (match-string 1)
4817 path (match-string 2))) 5065 path (match-string 2)))
4818 (unless path 5066 (unless path
4819 (error "No link found.")) 5067 (error "No link found"))
4820 ;; Remove any trailing spaces in path 5068 ;; Remove any trailing spaces in path
4821 (if (string-match " +\\'" path) 5069 (if (string-match " +\\'" path)
4822 (setq path (replace-match "" t t path))) 5070 (setq path (replace-match "" t t path)))
@@ -4870,6 +5118,10 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
4870 5118
4871 ((string= type "shell") 5119 ((string= type "shell")
4872 (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)))
4873 (if (or (not org-confirm-shell-links) 5125 (if (or (not org-confirm-shell-links)
4874 (yes-or-no-p (format "Execute \"%s\" in the shell? " cmd))) 5126 (yes-or-no-p (format "Execute \"%s\" in the shell? " cmd)))
4875 (shell-command cmd) 5127 (shell-command cmd)
@@ -4965,7 +5217,7 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
4965 (widen) 5217 (widen)
4966 (goto-char (point-max)) 5218 (goto-char (point-max))
4967 (if (re-search-backward 5219 (if (re-search-backward
4968 (concat "^Message-ID:\\s-+" (regexp-quote 5220 (concat "^Message-ID:\\s-+" (regexp-quote
4969 (or article ""))) 5221 (or article "")))
4970 nil t) 5222 nil t)
4971 (rmail-what-message)))))) 5223 (rmail-what-message))))))
@@ -5001,7 +5253,7 @@ If the file does not exist, an error is thrown."
5001 (cdr (assoc t apps))))) 5253 (cdr (assoc t apps)))))
5002 (cond 5254 (cond
5003 ((and (stringp cmd) (not (string-match "^\\s-*$" cmd))) 5255 ((and (stringp cmd) (not (string-match "^\\s-*$" cmd)))
5004 (setq cmd (format cmd file)) 5256 (setq cmd (format cmd (concat "\"" file "\"")))
5005 (save-window-excursion 5257 (save-window-excursion
5006 (shell-command (concat cmd " & &")))) 5258 (shell-command (concat cmd " & &"))))
5007 ((or (stringp cmd) 5259 ((or (stringp cmd)
@@ -5047,10 +5299,12 @@ For file links, arg negates `org-line-numbers-in-file-links'."
5047 (cond 5299 (cond
5048 5300
5049 ((eq major-mode 'bbdb-mode) 5301 ((eq major-mode 'bbdb-mode)
5050 (setq link (concat "bbdb:" 5302 (setq cpltxt (concat
5051 (or (bbdb-record-name (bbdb-current-record)) 5303 "bbdb:"
5052 (bbdb-record-company (bbdb-current-record)))))) 5304 (or (bbdb-record-name (bbdb-current-record))
5053 5305 (bbdb-record-company (bbdb-current-record))))
5306 link (org-make-link cpltxt)))
5307
5054 ((eq major-mode 'calendar-mode) 5308 ((eq major-mode 'calendar-mode)
5055 (let ((cd (calendar-cursor-to-date))) 5309 (let ((cd (calendar-cursor-to-date)))
5056 (setq link 5310 (setq link
@@ -5076,8 +5330,9 @@ For file links, arg negates `org-line-numbers-in-file-links'."
5076 folder) 5330 folder)
5077 (setq folder (replace-match "" t t folder))) 5331 (setq folder (replace-match "" t t folder)))
5078 (setq cpltxt (concat author " on: " subject)) 5332 (setq cpltxt (concat author " on: " subject))
5079 (setq link (concat cpltxt "\n " "vm:" folder 5333 (setq link (concat cpltxt "\n "
5080 "#" message-id))))) 5334 (org-make-link
5335 "vm:" folder "#" message-id))))))
5081 5336
5082 ((eq major-mode 'wl-summary-mode) 5337 ((eq major-mode 'wl-summary-mode)
5083 (let* ((msgnum (wl-summary-message-number)) 5338 (let* ((msgnum (wl-summary-message-number))
@@ -5088,8 +5343,10 @@ For file links, arg negates `org-line-numbers-in-file-links'."
5088 (author (wl-summary-line-from)) ; FIXME: how to get author name? 5343 (author (wl-summary-line-from)) ; FIXME: how to get author name?
5089 (subject "???")) ; FIXME: How to get subject of email? 5344 (subject "???")) ; FIXME: How to get subject of email?
5090 (setq cpltxt (concat author " on: " subject)) 5345 (setq cpltxt (concat author " on: " subject))
5091 (setq link (concat cpltxt "\n " "wl:" wl-summary-buffer-folder-name 5346 (setq link (concat cpltxt "\n "
5092 "#" message-id)))) 5347 (org-make-link
5348 "wl:" wl-summary-buffer-folder-name
5349 "#" message-id)))))
5093 5350
5094 ((eq major-mode 'rmail-mode) 5351 ((eq major-mode 'rmail-mode)
5095 (save-excursion 5352 (save-excursion
@@ -5100,8 +5357,9 @@ For file links, arg negates `org-line-numbers-in-file-links'."
5100 (author (mail-fetch-field "from")) 5357 (author (mail-fetch-field "from"))
5101 (subject (mail-fetch-field "subject"))) 5358 (subject (mail-fetch-field "subject")))
5102 (setq cpltxt (concat author " on: " subject)) 5359 (setq cpltxt (concat author " on: " subject))
5103 (setq link (concat cpltxt "\n " "rmail:" folder 5360 (setq link (concat cpltxt "\n "
5104 "#" message-id)))))) 5361 (org-make-link
5362 "rmail:" folder "#" message-id)))))))
5105 5363
5106 ((eq major-mode 'gnus-group-mode) 5364 ((eq major-mode 'gnus-group-mode)
5107 (let ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus 5365 (let ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus
@@ -5109,11 +5367,12 @@ For file links, arg negates `org-line-numbers-in-file-links'."
5109 ((fboundp 'gnus-group-name) 5367 ((fboundp 'gnus-group-name)
5110 (gnus-group-name)) 5368 (gnus-group-name))
5111 (t "???")))) 5369 (t "???"))))
5112 (setq link (concat 5370 (setq cpltxt (concat
5113 (if (org-xor arg org-usenet-links-prefer-google) 5371 (if (org-xor arg org-usenet-links-prefer-google)
5114 "http://groups.google.com/groups?group=" 5372 "http://groups.google.com/groups?group="
5115 "gnus:") 5373 "gnus:")
5116 group)))) 5374 group)
5375 link (org-make-link cpltxt))))
5117 5376
5118 ((memq major-mode '(gnus-summary-mode gnus-article-mode)) 5377 ((memq major-mode '(gnus-summary-mode gnus-article-mode))
5119 (and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary)) 5378 (and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary))
@@ -5132,27 +5391,34 @@ For file links, arg negates `org-line-numbers-in-file-links'."
5132 cpltxt "\n " 5391 cpltxt "\n "
5133 (format "http://groups.google.com/groups?as_umsgid=%s" 5392 (format "http://groups.google.com/groups?as_umsgid=%s"
5134 (org-fixup-message-id-for-http message-id)))) 5393 (org-fixup-message-id-for-http message-id))))
5135 (setq link (concat cpltxt "\n" "gnus:" group 5394 (setq link (concat cpltxt "\n"
5136 "#" (number-to-string article)))))) 5395 (org-make-link
5396 "gnus:" group
5397 "#" (number-to-string article)))))))
5137 5398
5138 ((eq major-mode 'w3-mode) 5399 ((eq major-mode 'w3-mode)
5139 (setq link (url-view-url t))) 5400 (setq cpltxt (url-view-url t)
5401 link (org-make-link cpltxt)))
5140 ((eq major-mode 'w3m-mode) 5402 ((eq major-mode 'w3m-mode)
5141 (setq link w3m-current-url)) 5403 (setq cpltxt w3m-current-url
5404 link (org-make-link cpltxt)))
5142 5405
5143 ((buffer-file-name) 5406 ((buffer-file-name)
5144 ;; Just link to this file here. 5407 ;; Just link to this file here.
5145 (setq link (concat "file:" 5408 (setq cpltxt (concat "file:"
5146 (abbreviate-file-name (buffer-file-name)))) 5409 (abbreviate-file-name (buffer-file-name))))
5147 ;; Add the line number? 5410 ;; Add the line number?
5148 (if (org-xor org-line-numbers-in-file-links arg) 5411 (if (org-xor org-line-numbers-in-file-links arg)
5149 (setq link 5412 (setq cpltxt
5150 (concat link 5413 (concat cpltxt
5151 ":" (int-to-string 5414 ":" (int-to-string
5152 (+ (if (bolp) 1 0) (count-lines 5415 (+ (if (bolp) 1 0) (count-lines
5153 (point-min) (point)))))))) 5416 (point-min) (point)))))))
5417 (setq link (org-make-link cpltxt)))
5418
5154 ((interactive-p) 5419 ((interactive-p)
5155 (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
5156 (t (setq link nil))) 5422 (t (setq link nil)))
5157 5423
5158 (if (and (interactive-p) link) 5424 (if (and (interactive-p) link)
@@ -5162,6 +5428,10 @@ For file links, arg negates `org-line-numbers-in-file-links'."
5162 (message "Stored: %s" (or cpltxt link))) 5428 (message "Stored: %s" (or cpltxt link)))
5163 link))) 5429 link)))
5164 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
5165(defun org-xor (a b) 5435(defun org-xor (a b)
5166 "Exclusive or." 5436 "Exclusive or."
5167 (if a (not b) b)) 5437 (if a (not b) b))
@@ -5206,7 +5476,8 @@ For file links, arg negates `org-line-numbers-in-file-links'."
5206Completion can be used to select a link previously stored with 5476Completion can be used to select a link previously stored with
5207`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
5208press RET at the prompt), the link defaults to the most recently 5478press RET at the prompt), the link defaults to the most recently
5209stored 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.
5210 5481
5211With 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
5212selected using completion. The path to the file will be relative to 5483selected using completion. The path to the file will be relative to
@@ -5230,15 +5501,20 @@ is in the current directory or below."
5230 (let ((pwd (file-name-as-directory (expand-file-name ".")))) 5501 (let ((pwd (file-name-as-directory (expand-file-name "."))))
5231 (cond 5502 (cond
5232 ((equal complete-file '(16)) 5503 ((equal complete-file '(16))
5233 (insert "file:" (abbreviate-file-name (expand-file-name link)))) 5504 (insert
5505 (org-make-link
5506 "file:" (abbreviate-file-name (expand-file-name link)))))
5234 ((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)") 5507 ((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)")
5235 (expand-file-name link)) 5508 (expand-file-name link))
5236 (insert "file:" (match-string 1 (expand-file-name link)))) 5509 (insert
5237 (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)))))
5238 (setq linktxt (cdr (assoc link org-stored-links))) 5513 (setq linktxt (cdr (assoc link org-stored-links)))
5239 (if (not org-keep-stored-link-after-insertion) 5514 (if (not org-keep-stored-link-after-insertion)
5240 (setq org-stored-links (delq (assoc link org-stored-links) 5515 (setq org-stored-links (delq (assoc link org-stored-links)
5241 org-stored-links))) 5516 org-stored-links)))
5517 (if (not linktxt) (setq link (org-make-link link)))
5242 (let ((lines (org-split-string (or linktxt link) "\n"))) 5518 (let ((lines (org-split-string (or linktxt link) "\n")))
5243 (insert (car lines)) 5519 (insert (car lines))
5244 (setq matched (string-match org-link-regexp (car lines))) 5520 (setq matched (string-match org-link-regexp (car lines)))
@@ -5305,7 +5581,7 @@ If the variable `org-adapt-indentation' is non-nil, the entire text is
5305also 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
5306\(i.e. after the stars). 5582\(i.e. after the stars).
5307 5583
5308See also the variable `org-reverse-note-order'." 5584See also the variable `org-reverse-note-order'."
5309 (catch 'quit 5585 (catch 'quit
5310 (let* ((txt (buffer-substring (point-min) (point-max))) 5586 (let* ((txt (buffer-substring (point-min) (point-max)))
5311 (fastp current-prefix-arg) 5587 (fastp current-prefix-arg)
@@ -5795,7 +6071,7 @@ If the field at the cursor is empty, copy into it the content of the nearest
5795non-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.
5796If 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
5797the cursor is moved with it. Therefore, repeating this command causes the 6073the cursor is moved with it. Therefore, repeating this command causes the
5798column to be filled row-by-row. 6074column to be filled row-by-row.
5799If 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
5800integer, it will be incremented while copying." 6076integer, it will be incremented while copying."
5801 (interactive "p") 6077 (interactive "p")
@@ -5886,7 +6162,7 @@ When called interactively, column is also displayed in echo area."
5886(defun org-table-goto-column (n &optional on-delim force) 6162(defun org-table-goto-column (n &optional on-delim force)
5887 "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.
5888With optional argument ON-DELIM, stop with point before the left delimiter 6164With optional argument ON-DELIM, stop with point before the left delimiter
5889of the field. 6165of the field.
5890If 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.
5891However, when FORCE is non-nil, create new columns if necessary." 6167However, when FORCE is non-nil, create new columns if necessary."
5892 (let ((pos (point-at-eol))) 6168 (let ((pos (point-at-eol)))
@@ -5906,7 +6182,8 @@ However, when FORCE is non-nil, create new columns if necessary."
5906 (if (looking-at " ") (forward-char 1)))))) 6182 (if (looking-at " ") (forward-char 1))))))
5907 6183
5908(defun org-at-table-p (&optional table-type) 6184(defun org-at-table-p (&optional table-type)
5909 "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."
5910 (if org-enable-table-editor 6187 (if org-enable-table-editor
5911 (save-excursion 6188 (save-excursion
5912 (beginning-of-line 1) 6189 (beginning-of-line 1)
@@ -6086,7 +6363,7 @@ However, when FORCE is non-nil, create new columns if necessary."
6086 (if (not (org-at-table-p)) 6363 (if (not (org-at-table-p))
6087 (progn 6364 (progn
6088 (goto-char pos) 6365 (goto-char pos)
6089 (error "Cannot move row further."))) 6366 (error "Cannot move row further")))
6090 (goto-char pos) 6367 (goto-char pos)
6091 (beginning-of-line 1) 6368 (beginning-of-line 1)
6092 (setq pos (point)) 6369 (setq pos (point))
@@ -6173,7 +6450,7 @@ with `org-table-paste-rectangle'"
6173 (goto-char beg) 6450 (goto-char beg)
6174 (org-table-check-inside-data-field) 6451 (org-table-check-inside-data-field)
6175 (setq l01 (count-lines (point-min) (point)) 6452 (setq l01 (count-lines (point-min) (point))
6176 c01 (org-table-current-column)) 6453 c01 (org-table-current-column))
6177 (goto-char end) 6454 (goto-char end)
6178 (org-table-check-inside-data-field) 6455 (org-table-check-inside-data-field)
6179 (setq l02 (count-lines (point-min) (point)) 6456 (setq l02 (count-lines (point-min) (point))
@@ -6194,7 +6471,7 @@ with `org-table-paste-rectangle'"
6194 (setq l1 (1+ l1))))) 6471 (setq l1 (1+ l1)))))
6195 (setq org-table-clip (nreverse region)) 6472 (setq org-table-clip (nreverse region))
6196 (if cut (org-table-align)))) 6473 (if cut (org-table-align))))
6197 6474
6198(defun org-table-paste-rectangle () 6475(defun org-table-paste-rectangle ()
6199 "Paste a rectangular region into a table. 6476 "Paste a rectangular region into a table.
6200The 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
@@ -6305,7 +6582,7 @@ blank, and the content is appended to the field above."
6305 (+ (length org-table-clip) arg) 6582 (+ (length org-table-clip) arg)
6306 arg) 6583 arg)
6307 (length org-table-clip))) 6584 (length org-table-clip)))
6308 (setq org-table-clip 6585 (setq org-table-clip
6309 (mapcar 'list (org-wrap (mapconcat 'car org-table-clip " ") 6586 (mapcar 'list (org-wrap (mapconcat 'car org-table-clip " ")
6310 nil nlines))) 6587 nil nlines)))
6311 (goto-char beg) 6588 (goto-char beg)
@@ -6360,7 +6637,7 @@ The return value is a list of lines, without newlines at the end."
6360 (setq ll (org-do-wrap words w))) 6637 (setq ll (org-do-wrap words w)))
6361 ll)) 6638 ll))
6362 (t (error "Cannot wrap this"))))) 6639 (t (error "Cannot wrap this")))))
6363 6640
6364 6641
6365(defun org-do-wrap (words width) 6642(defun org-do-wrap (words width)
6366 "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."
@@ -6685,28 +6962,32 @@ table editor in arbitrary modes.")
6685 6962
6686;;;###autoload 6963;;;###autoload
6687(defun orgtbl-mode (&optional arg) 6964(defun orgtbl-mode (&optional arg)
6688 "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."
6689 (interactive) 6966 (interactive)
6690 (setq orgtbl-mode 6967 (if (eq major-mode 'org-mode)
6691 (if arg (> (prefix-numeric-value arg) 0) (not orgtbl-mode))) 6968 ;; Exit without error, in case some hook functions calls this
6692 (if orgtbl-mode 6969 ;; by accident in org-mode.
6693 (progn 6970 (message "Orgtbl-mode is not useful in org-mode, command ignored")
6694 (set (make-local-variable (quote org-table-may-need-update)) t) 6971 (setq orgtbl-mode
6695 (make-local-hook (quote before-change-functions)) 6972 (if arg (> (prefix-numeric-value arg) 0) (not orgtbl-mode)))
6696 (add-hook 'before-change-functions 'org-before-change-function 6973 (if orgtbl-mode
6697 nil 'local) 6974 (progn
6698 (set (make-local-variable 'org-old-auto-fill-inhibit-regexp) 6975 (set (make-local-variable (quote org-table-may-need-update)) t)
6699 auto-fill-inhibit-regexp) 6976 (make-local-hook (quote before-change-functions))
6700 (set (make-local-variable 'auto-fill-inhibit-regexp) 6977 (add-hook 'before-change-functions 'org-before-change-function
6701 (if auto-fill-inhibit-regexp 6978 nil 'local)
6702 (concat "\\([ \t]*|\\|" auto-fill-inhibit-regexp) 6979 (set (make-local-variable 'org-old-auto-fill-inhibit-regexp)
6703 "[ \t]*|")) 6980 auto-fill-inhibit-regexp)
6704 (easy-menu-add orgtbl-mode-menu) 6981 (set (make-local-variable 'auto-fill-inhibit-regexp)
6705 (run-hooks 'orgtbl-mode-hook)) 6982 (if auto-fill-inhibit-regexp
6706 (setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp) 6983 (concat "\\([ \t]*|\\|" auto-fill-inhibit-regexp)
6707 (remove-hook 'before-change-functions 'org-before-change-function t) 6984 "[ \t]*|"))
6708 (easy-menu-remove orgtbl-mode-menu) 6985 (easy-menu-add orgtbl-mode-menu)
6709 (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))))
6710 6991
6711;; Install it as a minor mode. 6992;; Install it as a minor mode.
6712(put 'orgtbl-mode :included t) 6993(put 'orgtbl-mode :included t)
@@ -6715,7 +6996,9 @@ table editor in arbitrary modes.")
6715 6996
6716(defun orgtbl-make-binding (fun &rest keys) 6997(defun orgtbl-make-binding (fun &rest keys)
6717 "Create a function for binding in the table minor mode." 6998 "Create a function for binding in the table minor mode."
6718 (list 'lambda '(arg) '(interactive "p") 6999 (list 'lambda '(arg)
7000 (concat "Run `" (symbol-name fun) "' or the default binding.")
7001 '(interactive "p")
6719 (list 'if 7002 (list 'if
6720 '(org-at-table-p) 7003 '(org-at-table-p)
6721 (list 'call-interactively (list 'quote fun)) 7004 (list 'call-interactively (list 'quote fun))
@@ -6734,29 +7017,30 @@ table editor in arbitrary modes.")
6734 7017
6735;; Keybindings for the minor mode 7018;; Keybindings for the minor mode
6736(let ((bindings 7019(let ((bindings
6737 '(([(meta shift left)] org-table-delete-column) 7020 (list
6738 ([(meta left)] org-table-move-column-left) 7021 '([(meta shift left)] org-table-delete-column)
6739 ([(meta right)] org-table-move-column-right) 7022 '([(meta left)] org-table-move-column-left)
6740 ([(meta shift right)] org-table-insert-column) 7023 '([(meta right)] org-table-move-column-right)
6741 ([(meta shift up)] org-table-kill-row) 7024 '([(meta shift right)] org-table-insert-column)
6742 ([(meta shift down)] org-table-insert-row) 7025 '([(meta shift up)] org-table-kill-row)
6743 ([(meta up)] org-table-move-row-up) 7026 '([(meta shift down)] org-table-insert-row)
6744 ([(meta down)] org-table-move-row-down) 7027 '([(meta up)] org-table-move-row-up)
6745 ("\C-c\C-w" org-table-cut-region) 7028 '([(meta down)] org-table-move-row-down)
6746 ("\C-c\M-w" org-table-copy-region) 7029 '("\C-c\C-w" org-table-cut-region)
6747 ("\C-c\C-y" org-table-paste-rectangle) 7030 '("\C-c\M-w" org-table-copy-region)
6748 ("\C-c-" org-table-insert-hline) 7031 '("\C-c\C-y" org-table-paste-rectangle)
6749 ([(shift tab)] org-table-previous-field) 7032 '("\C-c-" org-table-insert-hline)
6750 ("\C-c\C-c" org-table-align) 7033 '([(shift tab)] org-table-previous-field)
6751 ([(return)] org-table-next-row) 7034 '("\C-c\C-c" org-table-align)
6752 ([(shift return)] org-table-copy-down) 7035 '("\C-m" org-table-next-row)
6753 ([(meta return)] org-table-wrap-region) 7036 (list (org-key 'S-return) 'org-table-copy-down)
6754 ("\C-c\C-q" org-table-wrap-region) 7037 '([(meta return)] org-table-wrap-region)
6755 ("\C-c?" org-table-current-column) 7038 '("\C-c\C-q" org-table-wrap-region)
6756 ("\C-c " org-table-blank-field) 7039 '("\C-c?" org-table-current-column)
6757 ("\C-c+" org-table-sum) 7040 '("\C-c " org-table-blank-field)
6758 ("\C-c|" org-table-toggle-vline-visibility) 7041 '("\C-c+" org-table-sum)
6759 ("\C-c=" org-table-eval-formula))) 7042 '("\C-c|" org-table-toggle-vline-visibility)
7043 '("\C-c=" org-table-eval-formula)))
6760 elt key fun cmd) 7044 elt key fun cmd)
6761 (while (setq elt (pop bindings)) 7045 (while (setq elt (pop bindings))
6762 (setq key (car elt) 7046 (setq key (car elt)
@@ -6765,20 +7049,12 @@ table editor in arbitrary modes.")
6765 (define-key orgtbl-mode-map key cmd))) 7049 (define-key orgtbl-mode-map key cmd)))
6766 7050
6767;; Special treatment needed for TAB and RET 7051;; Special treatment needed for TAB and RET
6768;(define-key orgtbl-mode-map [(return)] 7052
6769; (orgtbl-make-binding 'org-table-next-row [(return)] "\C-m")) 7053(define-key orgtbl-mode-map [(return)]
6770;(define-key orgtbl-mode-map "\C-m"
6771; (orgtbl-make-binding 'org-table-next-row "\C-m" [(return)]))
6772;(define-key orgtbl-mode-map [(tab)]
6773; (orgtbl-make-binding 'org-table-next-field [(tab)] "\C-i"))
6774;(define-key orgtbl-mode-map "\C-i"
6775; (orgtbl-make-binding 'org-table-next-field "\C-i" [(tab)]))
6776
6777(define-key orgtbl-mode-map [(return)]
6778 (orgtbl-make-binding 'orgtbl-ret [(return)] "\C-m")) 7054 (orgtbl-make-binding 'orgtbl-ret [(return)] "\C-m"))
6779(define-key orgtbl-mode-map "\C-m" 7055(define-key orgtbl-mode-map "\C-m"
6780 (orgtbl-make-binding 'orgtbl-ret "\C-m" [(return)])) 7056 (orgtbl-make-binding 'orgtbl-ret "\C-m" [(return)]))
6781(define-key orgtbl-mode-map [(tab)] 7057(define-key orgtbl-mode-map [(tab)]
6782 (orgtbl-make-binding 'orgtbl-tab [(tab)] "\C-i")) 7058 (orgtbl-make-binding 'orgtbl-tab [(tab)] "\C-i"))
6783(define-key orgtbl-mode-map "\C-i" 7059(define-key orgtbl-mode-map "\C-i"
6784 (orgtbl-make-binding 'orgtbl-tab "\C-i" [(tab)])) 7060 (orgtbl-make-binding 'orgtbl-tab "\C-i" [(tab)]))
@@ -6888,7 +7164,7 @@ a reduced column width."
6888 ["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"])
6889 "--" 7165 "--"
6890 ["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 ?"]
6891 ["Sum Column/Rectangle" org-table-sum 7167 ["Sum Column/Rectangle" org-table-sum
6892 :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 +"]
6893 ["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 ="]
6894 )) 7170 ))
@@ -7400,9 +7676,10 @@ and all options lines."
7400 (let* ((filename (concat (file-name-sans-extension (buffer-file-name)) 7676 (let* ((filename (concat (file-name-sans-extension (buffer-file-name))
7401 ".txt")) 7677 ".txt"))
7402 (buffer (find-file-noselect filename)) 7678 (buffer (find-file-noselect filename))
7403 (ore (concat 7679 (ore (concat
7404 (org-make-options-regexp 7680 (org-make-options-regexp
7405 '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" "STARTUP" 7681 '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO"
7682 "STARTUP" "ARCHIVE"
7406 "TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE")) 7683 "TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"))
7407 (if org-noutline-p "\\(\n\\|$\\)" ""))) 7684 (if org-noutline-p "\\(\n\\|$\\)" "")))
7408 s e) 7685 s e)
@@ -7457,6 +7734,7 @@ Does include HTML export options as well as TODO and CATEGORY stuff."
7457#+SEQ_TODO: %s 7734#+SEQ_TODO: %s
7458#+TYP_TODO: %s 7735#+TYP_TODO: %s
7459#+STARTUP: %s %s 7736#+STARTUP: %s %s
7737#+ARCHIVE: %s
7460" 7738"
7461 (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
7462 org-export-headline-levels 7740 org-export-headline-levels
@@ -7479,6 +7757,7 @@ Does include HTML export options as well as TODO and CATEGORY stuff."
7479 (cdr (assoc org-startup-folded 7757 (cdr (assoc org-startup-folded
7480 '((nil . "nofold")(t . "fold")(content . "content")))) 7758 '((nil . "nofold")(t . "fold")(content . "content"))))
7481 (if org-startup-with-deadline-check "dlcheck" "nodlcheck") 7759 (if org-startup-with-deadline-check "dlcheck" "nodlcheck")
7760 org-archive-location
7482 )) 7761 ))
7483 7762
7484(defun org-insert-export-options-template () 7763(defun org-insert-export-options-template ()
@@ -7575,6 +7854,7 @@ headlines. The default is 3. Lower levels will become bulleted lists."
7575 (text nil) 7854 (text nil)
7576 (lang-words nil) 7855 (lang-words nil)
7577 (head-count 0) cnt 7856 (head-count 0) cnt
7857 (start 0)
7578 table-open type 7858 table-open type
7579 table-buffer table-orig-buffer 7859 table-buffer table-orig-buffer
7580 ) 7860 )
@@ -7628,7 +7908,7 @@ headlines. The default is 3. Lower levels will become bulleted lists."
7628 ;; This is a headline 7908 ;; This is a headline
7629 (progn 7909 (progn
7630 (setq level (- (match-end 1) (match-beginning 1)) 7910 (setq level (- (match-end 1) (match-beginning 1))
7631 txt (save-match-data 7911 txt (save-match-data
7632 (org-html-expand 7912 (org-html-expand
7633 (match-string 3 line))) 7913 (match-string 3 line)))
7634 todo 7914 todo
@@ -7672,8 +7952,15 @@ headlines. The default is 3. Lower levels will become bulleted lists."
7672 )) 7952 ))
7673 (setq head-count 0) 7953 (setq head-count 0)
7674 (org-init-section-numbers) 7954 (org-init-section-numbers)
7675
7676 (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
7677 ;; replace "<" and ">" by "&lt;" and "&gt;" 7964 ;; replace "<" and ">" by "&lt;" and "&gt;"
7678 ;; handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>") 7965 ;; handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>")
7679 (setq line (org-html-expand line)) 7966 (setq line (org-html-expand line))
@@ -7691,27 +7978,34 @@ headlines. The default is 3. Lower levels will become bulleted lists."
7691 (not (string-match "^[ \t]+\\(:.*\\)" 7978 (not (string-match "^[ \t]+\\(:.*\\)"
7692 (car lines)))) 7979 (car lines))))
7693 "<br>\n" "\n")))) 7980 "<br>\n" "\n"))))
7694 7981 (setq start 0)
7695 (when (string-match org-link-regexp line) 7982 (while (string-match org-protected-link-regexp line start)
7983 (setq start (- (match-end 0) 2))
7696 (setq type (match-string 1 line)) 7984 (setq type (match-string 1 line))
7697 (cond 7985 (cond
7698 ((member type '("http" "https" "ftp" "mailto" "news")) 7986 ((member type '("http" "https" "ftp" "mailto" "news"))
7699 ;; standard URL 7987 ;; standard URL
7700 (setq line (replace-match 7988 (setq line (replace-match
7701 "<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>"
7702 nil nil line))) 7991 nil nil line)))
7703 ((string= type "file") 7992 ((string= type "file")
7704 ;; FILE link 7993 ;; FILE link
7705
7706 (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)))
7707 (file-is-image-p 8001 (file-is-image-p
7708 (save-match-data 8002 (save-match-data
7709 (string-match (org-image-file-name-regexp) filename)))) 8003 (string-match (org-image-file-name-regexp) thefile))))
7710 (setq line (replace-match 8004 (setq line (replace-match
7711 (if (and org-export-html-inline-images 8005 (if (and org-export-html-inline-images
7712 file-is-image-p) 8006 file-is-image-p)
7713 "<img src=\"\\2\"/>" 8007 (concat "<img src=\"" thefile "\"/>")
7714 "<a href=\"\\2\">\\1:\\2</a>") 8008 (concat "<a href=\"" thefile "\">\\1:\\2</a>"))
7715 nil nil line)))) 8009 nil nil line))))
7716 8010
7717 ((member type '("bbdb" "vm" "wl" "rmail" "gnus" "shell")) 8011 ((member type '("bbdb" "vm" "wl" "rmail" "gnus" "shell"))
@@ -7809,20 +8103,15 @@ headlines. The default is 3. Lower levels will become bulleted lists."
7809 (let ((head (and org-export-highlight-first-table-line 8103 (let ((head (and org-export-highlight-first-table-line
7810 (delq nil (mapcar 8104 (delq nil (mapcar
7811 (lambda (x) (string-match "^[ \t]*|-" x)) 8105 (lambda (x) (string-match "^[ \t]*|-" x))
7812 lines)))) 8106 (cdr lines)))))
7813 lastline line fields html empty) 8107 line fields html)
7814 (setq html (concat org-export-html-table-tag "\n")) 8108 (setq html (concat org-export-html-table-tag "\n"))
7815 (while (setq lastline line 8109 (while (setq line (pop lines))
7816 line (pop lines))
7817 (setq empty "&nbsp")
7818 (catch 'next-line 8110 (catch 'next-line
7819 (if (string-match "^[ \t]*|-" line) 8111 (if (string-match "^[ \t]*|-" line)
7820 (if lastline 8112 (progn
7821 ;; A hline: simulate an empty table row instead. 8113 (setq head nil) ;; head ends here, first time around
7822 (setq line (org-fake-empty-table-line lastline) 8114 ;; ignore this line
7823 head nil
7824 empty "")
7825 ;; Ignore this line
7826 (throw 'next-line t))) 8115 (throw 'next-line t)))
7827 ;; Break the line into fields 8116 ;; Break the line into fields
7828 (setq fields (org-split-string line "[ \t]*|[ \t]*")) 8117 (setq fields (org-split-string line "[ \t]*|[ \t]*"))
@@ -7830,7 +8119,6 @@ headlines. The default is 3. Lower levels will become bulleted lists."
7830 html 8119 html
7831 "<tr>" 8120 "<tr>"
7832 (mapconcat (lambda (x) 8121 (mapconcat (lambda (x)
7833 (if (equal x "") (setq x empty))
7834 (if head 8122 (if head
7835 (concat "<th>" x "</th>") 8123 (concat "<th>" x "</th>")
7836 (concat "<td valign=\"top\">" x "</td>"))) 8124 (concat "<td valign=\"top\">" x "</td>")))
@@ -7903,7 +8191,7 @@ But it has the disadvantage, that Org-mode's HTML conversions cannot be used."
7903 (insert (mapconcat 'identity lines "\n")) 8191 (insert (mapconcat 'identity lines "\n"))
7904 (goto-char (point-min)) 8192 (goto-char (point-min))
7905 (if (not (re-search-forward "|[^+]" nil t)) 8193 (if (not (re-search-forward "|[^+]" nil t))
7906 (error "Error processing table.")) 8194 (error "Error processing table"))
7907 (table-recognize-table) 8195 (table-recognize-table)
7908 (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer)) 8196 (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer))
7909 (table-generate-source 'html " org-tmp2 ") 8197 (table-generate-source 'html " org-tmp2 ")
@@ -7919,9 +8207,9 @@ But it has the disadvantage, that Org-mode's HTML conversions cannot be used."
7919 (r (if m (substring string m) ""))) 8207 (r (if m (substring string m) "")))
7920 ;; convert < to &lt; and > to &gt; 8208 ;; convert < to &lt; and > to &gt;
7921 (while (string-match "<" s) 8209 (while (string-match "<" s)
7922 (setq s (replace-match "&lt;" nil nil s))) 8210 (setq s (replace-match "&lt;" t t s)))
7923 (while (string-match ">" s) 8211 (while (string-match ">" s)
7924 (setq s (replace-match "&gt;" nil nil s))) 8212 (setq s (replace-match "&gt;" t t s)))
7925 (if org-export-html-expand 8213 (if org-export-html-expand
7926 (while (string-match "@&lt;\\([^&]*\\)&gt;" s) 8214 (while (string-match "@&lt;\\([^&]*\\)&gt;" s)
7927 (setq s (replace-match "<\\1>" nil nil s)))) 8215 (setq s (replace-match "<\\1>" nil nil s))))
@@ -8130,7 +8418,6 @@ When LEVEL is non-nil, increase section numbers on that level."
8130;; i k @ expendable from outline-mode 8418;; i k @ expendable from outline-mode
8131;; 0123456789 ! $%^& * ()_{} " ~`' free 8419;; 0123456789 ! $%^& * ()_{} " ~`' free
8132 8420
8133(define-key org-mode-map [(tab)] 'org-cycle)
8134(define-key org-mode-map "\C-i" 'org-cycle) 8421(define-key org-mode-map "\C-i" 'org-cycle)
8135(define-key org-mode-map [(meta tab)] 'org-complete) 8422(define-key org-mode-map [(meta tab)] 'org-complete)
8136(define-key org-mode-map "\M-\C-i" 'org-complete) 8423(define-key org-mode-map "\M-\C-i" 'org-complete)
@@ -8148,6 +8435,7 @@ When LEVEL is non-nil, increase section numbers on that level."
8148(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)
8149(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)
8150(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)
8151(define-key org-mode-map "\C-c\C-j" 'org-goto) 8439(define-key org-mode-map "\C-c\C-j" 'org-goto)
8152(define-key org-mode-map "\C-c\C-t" 'org-todo) 8440(define-key org-mode-map "\C-c\C-t" 'org-todo)
8153(define-key org-mode-map "\C-c\C-s" 'org-schedule) 8441(define-key org-mode-map "\C-c\C-s" 'org-schedule)
@@ -8170,21 +8458,19 @@ When LEVEL is non-nil, increase section numbers on that level."
8170(define-key org-mode-map "\C-c[" 'org-add-file) 8458(define-key org-mode-map "\C-c[" 'org-add-file)
8171(define-key org-mode-map "\C-c]" 'org-remove-file) 8459(define-key org-mode-map "\C-c]" 'org-remove-file)
8172(define-key org-mode-map "\C-c\C-r" 'org-timeline) 8460(define-key org-mode-map "\C-c\C-r" 'org-timeline)
8173(define-key org-mode-map [(shift up)] 'org-shiftup) 8461(define-key org-mode-map (org-key 'S-up) 'org-shiftup)
8174(define-key org-mode-map [(shift down)] 'org-shiftdown) 8462(define-key org-mode-map (org-key 'S-down) 'org-shiftdown)
8175(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)
8176(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)
8177(define-key org-mode-map "\C-c-" 'org-table-insert-hline) 8465(define-key org-mode-map "\C-c-" 'org-table-insert-hline)
8178;; 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
8179(unless org-xemacs-p 8467(unless org-xemacs-p
8180 (define-key org-mode-map [S-iso-lefttab] 'org-shifttab)) 8468 (define-key org-mode-map [S-iso-lefttab] 'org-shifttab))
8181(define-key org-mode-map [(shift tab)] 'org-shifttab) 8469(define-key org-mode-map [(shift tab)] 'org-shifttab)
8182(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)
8183(define-key org-mode-map [(return)] 'org-return) 8471(define-key org-mode-map "\C-m" 'org-return)
8184(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)
8185(define-key org-mode-map [(meta return)] 'org-meta-return) 8473(define-key org-mode-map [(meta return)] 'org-meta-return)
8186(define-key org-mode-map [(control up)] 'org-move-line-up)
8187(define-key org-mode-map [(control down)] 'org-move-line-down)
8188(define-key org-mode-map "\C-c?" 'org-table-current-column) 8474(define-key org-mode-map "\C-c?" 'org-table-current-column)
8189(define-key org-mode-map "\C-c " 'org-table-blank-field) 8475(define-key org-mode-map "\C-c " 'org-table-blank-field)
8190(define-key org-mode-map "\C-c+" 'org-table-sum) 8476(define-key org-mode-map "\C-c+" 'org-table-sum)
@@ -8203,15 +8489,12 @@ When LEVEL is non-nil, increase section numbers on that level."
8203(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)
8204(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)
8205 8491
8206
8207;; FIXME: Do we really need to save match data in these commands?
8208;; I would like to remove it in order to minimize impact.
8209;; Self-insert already does not preserve it. How much resources used by this???
8210
8211(defsubst org-table-p () 8492(defsubst org-table-p ()
8212 (if (and (eq major-mode 'org-mode) font-lock-mode) 8493 (if (and (eq major-mode 'org-mode) font-lock-mode)
8213 (eq (get-text-property (point) 'face) 'org-table-face) 8494 (eq (get-text-property (point) 'face) 'org-table)
8214 (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
8215 8498
8216(defun org-self-insert-command (N) 8499(defun org-self-insert-command (N)
8217 "Like `self-insert-command', use overwrite-mode for whitespace in tables. 8500 "Like `self-insert-command', use overwrite-mode for whitespace in tables.
@@ -8283,7 +8566,7 @@ a reduced column width."
8283 8566
8284(defun org-shiftcursor-error () 8567(defun org-shiftcursor-error ()
8285 "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."
8286 (error "This command is only active in tables and on headlines.")) 8569 (error "This command is only active in tables and on headlines"))
8287 8570
8288(defun org-shifttab () 8571(defun org-shifttab ()
8289 "Call `(org-cycle t)' or `org-table-previous-field'." 8572 "Call `(org-cycle t)' or `org-table-previous-field'."
@@ -8414,7 +8697,7 @@ the automatic table editor has been turned off."
8414 (if (y-or-n-p "Convert inactive region to table? ") 8697 (if (y-or-n-p "Convert inactive region to table? ")
8415 (org-table-convert-region (region-beginning) (region-end) arg) 8698 (org-table-convert-region (region-beginning) (region-end) arg)
8416 (error "Abort"))) 8699 (error "Abort")))
8417 (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")))))
8418 8701
8419(defun org-return () 8702(defun org-return ()
8420 "Call `org-table-next-row' or `newline'." 8703 "Call `org-table-next-row' or `newline'."
@@ -8473,7 +8756,9 @@ the automatic table editor has been turned off."
8473 ["Promote Heading" org-metaleft (not (org-at-table-p))] 8756 ["Promote Heading" org-metaleft (not (org-at-table-p))]
8474 ["Promote Subtree" org-shiftmetaleft (not (org-at-table-p))] 8757 ["Promote Subtree" org-shiftmetaleft (not (org-at-table-p))]
8475 ["Demote Heading" org-metaright (not (org-at-table-p))] 8758 ["Demote Heading" org-metaright (not (org-at-table-p))]
8476 ["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])
8477 "--" 8762 "--"
8478 ("TODO Lists" 8763 ("TODO Lists"
8479 ["TODO/DONE/-" org-todo t] 8764 ["TODO/DONE/-" org-todo t]
@@ -8537,7 +8822,7 @@ the automatic table editor has been turned off."
8537 ["Fill Rectangle" org-table-wrap-region (org-at-table-p)]) 8822 ["Fill Rectangle" org-table-wrap-region (org-at-table-p)])
8538 "--" 8823 "--"
8539 ["Which Column?" org-table-current-column (org-at-table-p)] 8824 ["Which Column?" org-table-current-column (org-at-table-p)]
8540 ["Sum Column/Rectangle" org-table-sum 8825 ["Sum Column/Rectangle" org-table-sum
8541 (or (org-at-table-p) (org-region-active-p))] 8826 (or (org-at-table-p) (org-region-active-p))]
8542 ["Eval Formula" org-table-eval-formula (org-at-table-p)] 8827 ["Eval Formula" org-table-eval-formula (org-at-table-p)]
8543 "--" 8828 "--"
@@ -8580,10 +8865,10 @@ With optional NODE, go directly to that node."
8580 (Info-goto-node (format "(org)%s" (or node "")))) 8865 (Info-goto-node (format "(org)%s" (or node ""))))
8581 8866
8582(defun org-install-agenda-files-menu () 8867(defun org-install-agenda-files-menu ()
8583 (easy-menu-change 8868 (easy-menu-change
8584 '("Org") "File List for Agenda" 8869 '("Org") "File List for Agenda"
8585 (append 8870 (append
8586 (list 8871 (list
8587 ["Edit File List" (customize-variable 'org-agenda-files) t] 8872 ["Edit File List" (customize-variable 'org-agenda-files) t]
8588 ["Add Current File to List" org-add-file t] 8873 ["Add Current File to List" org-add-file t]
8589 ["Remove Current File from List" org-remove-file t] 8874 ["Remove Current File from List" org-remove-file t]
@@ -8698,7 +8983,7 @@ that can be added."
8698;; Functions needed for compatibility with old outline.el 8983;; Functions needed for compatibility with old outline.el
8699 8984
8700;; The following functions capture almost the entire compatibility code 8985;; The following functions capture almost the entire compatibility code
8701;; between the different versions of outline-mode. The only other place 8986;; between the different versions of outline-mode. The only other place
8702;; where this is important are the font-lock-keywords. Search for 8987;; where this is important are the font-lock-keywords. Search for
8703;; `org-noutline-p' to find it. 8988;; `org-noutline-p' to find it.
8704 8989
@@ -8738,11 +9023,11 @@ Only visible heading lines are considered, unless INVISIBLE-OK is non-nil."
8738 (outline-back-to-heading invisible-ok) 9023 (outline-back-to-heading invisible-ok)
8739 (if (looking-at outline-regexp) 9024 (if (looking-at outline-regexp)
8740 t 9025 t
8741 (if (re-search-backward (concat (if invisible-ok "[\r\n]" "^") 9026 (if (re-search-backward (concat (if invisible-ok "\\([\r\n]\\|^\\)" "^")
8742 outline-regexp) 9027 outline-regexp)
8743 nil t) 9028 nil t)
8744 (if invisible-ok 9029 (if invisible-ok
8745 (progn (forward-char 1) 9030 (progn (goto-char (match-end 1))
8746 (looking-at outline-regexp))) 9031 (looking-at outline-regexp)))
8747 (error "Before first heading"))))) 9032 (error "Before first heading")))))
8748 9033
@@ -8763,7 +9048,7 @@ If INVISIBLE-OK is non-nil, an invisible heading line is ok too."
8763This function considers both visible and invisible heading lines. 9048This function considers both visible and invisible heading lines.
8764With argument, move up ARG levels." 9049With argument, move up ARG levels."
8765 (if org-noutline-p 9050 (if org-noutline-p
8766 (if (fboundp 'outline-up-heading-all) 9051 (if (fboundp 'outline-up-heading-all)
8767 (outline-up-heading-all arg) ; emacs 21 version of outline.el 9052 (outline-up-heading-all arg) ; emacs 21 version of outline.el
8768 (outline-up-heading arg t)) ; emacs 22 version of outline.el 9053 (outline-up-heading arg t)) ; emacs 22 version of outline.el
8769 (org-back-to-heading t) 9054 (org-back-to-heading t)
@@ -8819,8 +9104,8 @@ When ENTRY is non-nil, show the entire entry."
8819 9104
8820(defun org-show-subtree () 9105(defun org-show-subtree ()
8821 "Show everything after this heading at deeper levels." 9106 "Show everything after this heading at deeper levels."
8822 (outline-flag-region 9107 (outline-flag-region
8823 (point) 9108 (point)
8824 (save-excursion 9109 (save-excursion
8825 (outline-end-of-subtree) (outline-next-heading) (point)) 9110 (outline-end-of-subtree) (outline-next-heading) (point))
8826 (if org-noutline-p nil ?\n))) 9111 (if org-noutline-p nil ?\n)))
@@ -8831,7 +9116,7 @@ Show the heading too, if it is currently invisible."
8831 (interactive) 9116 (interactive)
8832 (save-excursion 9117 (save-excursion
8833 (org-back-to-heading t) 9118 (org-back-to-heading t)
8834 (outline-flag-region 9119 (outline-flag-region
8835 (1- (point)) 9120 (1- (point))
8836 (save-excursion 9121 (save-excursion
8837 (re-search-forward (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move) 9122 (re-search-forward (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move)
@@ -8864,6 +9149,4 @@ Show the heading too, if it is currently invisible."
8864(run-hooks 'org-load-hook) 9149(run-hooks 'org-load-hook)
8865 9150
8866;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd 9151;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd
8867
8868;;; org.el ends here 9152;;; org.el ends here
8869
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 21259ee0ccf..8863d20823e 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -246,11 +246,13 @@ separated by a space."
246 "Regular expression that matches a non-empty start tag. 246 "Regular expression that matches a non-empty start tag.
247Any terminating `>' or `/' is not matched.") 247Any terminating `>' or `/' is not matched.")
248 248
249(defface sgml-namespace-face 249(defface sgml-namespace
250 '((t (:inherit font-lock-builtin-face))) 250 '((t (:inherit font-lock-builtin-face)))
251 "`sgml-mode' face used to highlight the namespace part of identifiers." 251 "`sgml-mode' face used to highlight the namespace part of identifiers."
252 :group 'sgml) 252 :group 'sgml)
253(defvar sgml-namespace-face 'sgml-namespace-face) 253;; backward-compatibility alias
254(put 'sgml-namespace-face 'face-alias 'sgml-namespace)
255(defvar sgml-namespace-face 'sgml-namespace)
254 256
255;; internal 257;; internal
256(defconst sgml-font-lock-keywords-1 258(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 91f714af9d9..e8a00507fdb 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)
@@ -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))
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 0fa44a3b8ee..09fe77cf352 100644
--- a/lisp/thumbs.el
+++ b/lisp/thumbs.el
@@ -77,13 +77,13 @@
77 77
78(defcustom thumbs-per-line 5 78(defcustom thumbs-per-line 5
79 "*Number of thumbnails per line to show in directory." 79 "*Number of thumbnails per line to show in directory."
80 :type 'string 80 :type 'integer
81 :group 'thumbs) 81 :group 'thumbs)
82 82
83(defcustom thumbs-thumbsdir-max-size 50000000 83(defcustom thumbs-thumbsdir-max-size 50000000
84 "Max size for thumbnails directory. 84 "Max size for thumbnails directory.
85When it reaches that size (in bytes), a warning is sent." 85When it reaches that size (in bytes), a warning is sent."
86 :type 'string 86 :type 'integer
87 :group 'thumbs) 87 :group 'thumbs)
88 88
89(defcustom thumbs-conversion-program 89(defcustom thumbs-conversion-program
@@ -104,13 +104,13 @@ It must be 'convert'."
104 104
105(defcustom thumbs-relief 5 105(defcustom thumbs-relief 5
106 "*Size of button-like border around thumbnails." 106 "*Size of button-like border around thumbnails."
107 :type 'string 107 :type 'integer
108 :group 'thumbs) 108 :group 'thumbs)
109 109
110(defcustom thumbs-margin 2 110(defcustom thumbs-margin 2
111 "*Size of the margin around thumbnails. 111 "*Size of the margin around thumbnails.
112This is where you see the cursor." 112This is where you see the cursor."
113 :type 'string 113 :type 'integer
114 :group 'thumbs) 114 :group 'thumbs)
115 115
116(defcustom thumbs-thumbsdir-auto-clean t 116(defcustom thumbs-thumbsdir-auto-clean t
@@ -122,7 +122,7 @@ than `thumbs-thumbsdir-max-size'."
122 122
123(defcustom thumbs-image-resizing-step 10 123(defcustom thumbs-image-resizing-step 10
124 "Step by which to resize image." 124 "Step by which to resize image."
125 :type 'string 125 :type 'integer
126 :group 'thumbs) 126 :group 'thumbs)
127 127
128(defcustom thumbs-temp-dir temporary-file-directory 128(defcustom thumbs-temp-dir temporary-file-directory
@@ -172,17 +172,21 @@ The name is made by appending a number to PREFIX, default \"G\"."
172 (1+ thumbs-gensym-counter)))))) 172 (1+ thumbs-gensym-counter))))))
173 (make-symbol (format "%s%d" pfix num)))))) 173 (make-symbol (format "%s%d" pfix num))))))
174 174
175(defsubst thumbs-temp-dir ()
176 (file-name-as-directory (expand-file-name thumbs-temp-dir)))
177
175(defun thumbs-temp-file () 178(defun thumbs-temp-file ()
176 "Return a unique temporary filename for an image." 179 "Return a unique temporary filename for an image."
177 (format "%s%s-%s.jpg" 180 (format "%s%s-%s.jpg"
178 (expand-file-name thumbs-temp-dir) 181 (thumbs-temp-dir)
179 thumbs-temp-prefix 182 thumbs-temp-prefix
180 (thumbs-gensym "T"))) 183 (thumbs-gensym "T")))
181 184
182(defun thumbs-thumbsdir () 185(defun thumbs-thumbsdir ()
183 "Return the current thumbnails directory (from `thumbs-thumbsdir'). 186 "Return the current thumbnails directory (from `thumbs-thumbsdir').
184Create the thumbnails directory if it does not exist." 187Create the thumbnails directory if it does not exist."
185 (let ((thumbs-thumbsdir (expand-file-name thumbs-thumbsdir))) 188 (let ((thumbs-thumbsdir (file-name-as-directory
189 (expand-file-name thumbs-thumbsdir))))
186 (unless (file-directory-p thumbs-thumbsdir) 190 (unless (file-directory-p thumbs-thumbsdir)
187 (make-directory thumbs-thumbsdir) 191 (make-directory thumbs-thumbsdir)
188 (message "Creating thumbnails directory")) 192 (message "Creating thumbnails directory"))
@@ -267,7 +271,7 @@ Or, alternatively, a SIZE may be specified."
267 (condition-case nil 271 (condition-case nil
268 (apply 'delete-file 272 (apply 'delete-file
269 (directory-files 273 (directory-files
270 thumbs-temp-dir t 274 (thumbs-temp-dir) t
271 thumbs-temp-prefix)) 275 thumbs-temp-prefix))
272 (error nil)) 276 (error nil))
273 (let ((buffer-read-only nil) 277 (let ((buffer-read-only nil)
@@ -306,7 +310,7 @@ Or, alternatively, a SIZE may be specified."
306 "Return a thumbnail name for the image IMG." 310 "Return a thumbnail name for the image IMG."
307 (convert-standard-filename 311 (convert-standard-filename
308 (let ((filename (expand-file-name img))) 312 (let ((filename (expand-file-name img)))
309 (format "%s/%08x-%s.jpg" 313 (format "%s%08x-%s.jpg"
310 (thumbs-thumbsdir) 314 (thumbs-thumbsdir)
311 (sxhash filename) 315 (sxhash filename)
312 (subst-char-in-string 316 (subst-char-in-string
@@ -637,7 +641,7 @@ ACTION and ARG should be a valid convert command."
637 ;; cleaning of old temp file 641 ;; cleaning of old temp file
638 (mapc 'delete-file 642 (mapc 'delete-file
639 (directory-files 643 (directory-files
640 thumbs-temp-dir 644 (thumbs-temp-dir)
641 t 645 t
642 thumbs-temp-prefix)) 646 thumbs-temp-prefix))
643 (let ((buffer-read-only nil) 647 (let ((buffer-read-only nil)
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/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/tree-widget.el b/lisp/tree-widget.el
index 2a20e708729..448879cea5a 100644
--- a/lisp/tree-widget.el
+++ b/lisp/tree-widget.el
@@ -1,6 +1,6 @@
1;;; tree-widget.el --- Tree widget 1;;; tree-widget.el --- Tree widget
2 2
3;; Copyright (C) 2004 Free Software Foundation, Inc. 3;; Copyright (C) 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>
@@ -174,7 +174,7 @@ no-handle an invisible handle
174 174
175;;; Image support 175;;; Image support
176;; 176;;
177(eval-when-compile ;; GNU Emacs/XEmacs compatibility stuff 177(eval-and-compile ;; GNU Emacs/XEmacs compatibility stuff
178 (cond 178 (cond
179 ;; XEmacs 179 ;; XEmacs
180 ((featurep 'xemacs) 180 ((featurep 'xemacs)
@@ -469,21 +469,6 @@ found."
469 'widget-type) 469 'widget-type)
470 property)) 470 property))
471 471
472(defsubst tree-widget-super-format-handler (widget escape)
473 "Call WIDGET's inherited format handler to process ESCAPE character."
474 (let ((handler (tree-widget-get-super widget :format-handler)))
475 (and handler (funcall handler widget escape))))
476
477(defun tree-widget-format-handler (widget escape)
478 "For WIDGET, signal that the %p format template is obsolete.
479Call WIDGET's inherited format handler to process other ESCAPE
480characters."
481 (if (eq escape ?p)
482 (message "The %%p format template is obsolete and ignored")
483 (tree-widget-super-format-handler widget escape)))
484(make-obsolete 'tree-widget-format-handler
485 'tree-widget-super-format-handler)
486
487(defsubst tree-widget-node (widget) 472(defsubst tree-widget-node (widget)
488 "Return the tree WIDGET :node value. 473 "Return the tree WIDGET :node value.
489If not found setup a default 'item' widget." 474If not found setup a default 'item' widget."
@@ -630,26 +615,35 @@ IGNORE other arguments."
630 (let* ((widget-image-enable (tree-widget-use-image-p)) ; Emacs 615 (let* ((widget-image-enable (tree-widget-use-image-p)) ; Emacs
631 (widget-glyph-enable widget-image-enable) ; XEmacs 616 (widget-glyph-enable widget-image-enable) ; XEmacs
632 (node (tree-widget-node tree)) 617 (node (tree-widget-node tree))
618 (flags (widget-get tree :tree-widget--guide-flags))
619 (indent (widget-get tree :indent))
633 children buttons) 620 children buttons)
621 (and indent
622 (null flags)
623 (save-restriction
624 (widen)
625 (or (bolp)
626 (and (eq (char-before) ?<)
627 (save-excursion
628 (backward-char) (bolp)))))
629 (insert-char ?\ indent))
634 (if (widget-get tree :open) 630 (if (widget-get tree :open)
635;;;; Unfolded node. 631;;;; Unfolded node.
636 (let* ((args (widget-get tree :args)) 632 (let ((args (widget-get tree :args))
637 (dynargs (widget-get tree :dynargs)) 633 (dynargs (widget-get tree :dynargs))
638 (flags (widget-get tree :tree-widget--guide-flags)) 634 (guide (tree-widget-guide tree))
639 (rflags (reverse flags)) 635 (noguide (tree-widget-no-guide tree))
640 (guide (tree-widget-guide tree)) 636 (endguide (tree-widget-end-guide tree))
641 (noguide (tree-widget-no-guide tree)) 637 (handle (tree-widget-handle tree))
642 (endguide (tree-widget-end-guide tree)) 638 (nohandle (tree-widget-no-handle tree))
643 (handle (tree-widget-handle tree)) 639 ;; Lookup for images and set widgets' tag-glyphs here,
644 (nohandle (tree-widget-no-handle tree)) 640 ;; to allow to dynamically change the image theme.
645 ;; Lookup for images and set widgets' tag-glyphs here, 641 (guidi (tree-widget-find-image "guide"))
646 ;; to allow to dynamically change the image theme. 642 (noguidi (tree-widget-find-image "no-guide"))
647 (guidi (tree-widget-find-image "guide")) 643 (endguidi (tree-widget-find-image "end-guide"))
648 (noguidi (tree-widget-find-image "no-guide")) 644 (handli (tree-widget-find-image "handle"))
649 (endguidi (tree-widget-find-image "end-guide")) 645 (nohandli (tree-widget-find-image "no-handle"))
650 (handli (tree-widget-find-image "handle")) 646 child)
651 (nohandli (tree-widget-find-image "no-handle"))
652 child)
653 (when dynargs 647 (when dynargs
654 ;; Request the definition of dynamic children 648 ;; Request the definition of dynamic children
655 (setq dynargs (funcall dynargs tree)) 649 (setq dynargs (funcall dynargs tree))
@@ -671,8 +665,9 @@ IGNORE other arguments."
671 (while args 665 (while args
672 (setq child (car args) 666 (setq child (car args)
673 args (cdr args)) 667 args (cdr args))
668 (and indent (insert-char ?\ indent))
674 ;; Insert guide lines elements 669 ;; Insert guide lines elements
675 (dolist (f rflags) 670 (dolist (f (reverse flags))
676 (widget-create-child-and-convert 671 (widget-create-child-and-convert
677 tree (if f guide noguide) 672 tree (if f guide noguide)
678 :tag-glyph (if f guidi noguidi)) 673 :tag-glyph (if f guidi noguidi))
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.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 56c2e1c31e9..6cfb03f2ac6 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."
@@ -2990,7 +3002,7 @@ widget. If that isn't a list, it's evalled and expected to yield a list."
2990 :match 'widget-regexp-match 3002 :match 'widget-regexp-match
2991 :validate 'widget-regexp-validate 3003 :validate 'widget-regexp-validate
2992 ;; Doesn't work well with terminating newline. 3004 ;; Doesn't work well with terminating newline.
2993 ;; :value-face 'widget-single-line-field-face 3005 ;; :value-face 'widget-single-line-field
2994 :tag "Regexp") 3006 :tag "Regexp")
2995 3007
2996(defun widget-regexp-match (widget value) 3008(defun widget-regexp-match (widget value)
@@ -3016,7 +3028,7 @@ It will read a file name from the minibuffer when invoked."
3016 :prompt-value 'widget-file-prompt-value 3028 :prompt-value 'widget-file-prompt-value
3017 :format "%{%t%}: %v" 3029 :format "%{%t%}: %v"
3018 ;; Doesn't work well with terminating newline. 3030 ;; Doesn't work well with terminating newline.
3019 ;; :value-face 'widget-single-line-field-face 3031 ;; :value-face 'widget-single-line-field
3020 :tag "File") 3032 :tag "File")
3021 3033
3022(defun widget-file-complete () 3034(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)
diff --git a/lispref/ChangeLog b/lispref/ChangeLog
index 6742080bd03..d1df2e17667 100644
--- a/lispref/ChangeLog
+++ b/lispref/ChangeLog
@@ -1,3 +1,82 @@
12005-06-15 Kim F. Storm <storm@cua.dk>
2
3 * searching.texi (Entire Match Data): Rephrase warnings about
4 evaporate arg to match-data and set-match-data.
5
62005-06-14 Luc Teirlinck <teirllm@auburn.edu>
7
8 * elisp.texi (Top): Update detailed menu.
9
10 * edebug.texi (Edebug): Update menu.
11 (Instrumenting): Update xrefs.
12 (Edebug Execution Modes): Correct xref.
13 (Jumping): Clarify description of `h' command.
14 Eliminate redundant @ref.
15 (Breaks): New node.
16 (Breakpoints): is now a subsubsection.
17 (Global Break Condition): Mention `C-x X X'.
18 (Edebug Views): Clarify `v' and `p'. Mention `C-x X w'.
19 (Trace Buffer): Clarify STRING arg of `edebug-tracing'.
20 (Edebug Display Update): Correct pxref.
21 (Edebug and Macros): New node.
22 (Instrumenting Macro Calls): Is now a subsubsection.
23 Neither arg of `def-edebug-spec' is evaluated.
24 (Instrumenting Macro Calls): Mention `edebug-eval-macro-args'.
25 (Specification Examples): Fix typo.
26
272005-06-14 Lute Kamstra <lute@gnu.org>
28
29 * debugging.texi (Function Debugging): Primitives can break on
30 entry too.
31
322005-06-14 Kim F. Storm <storm@cua.dk>
33
34 * variables.texi (Setting Variables): Add add-to-ordered-list.
35
362005-06-13 Stefan Monnier <monnier@iro.umontreal.ca>
37
38 * syntax.texi (Parsing Expressions): Document aux functions and vars of
39 syntax-ppss: syntax-ppss-flush-cache and syntax-begin-function.
40
412005-06-13 Lute Kamstra <lute@gnu.org>
42
43 * text.texi (Special Properties): Fix cross reference.
44
452005-06-11 Luc Teirlinck <teirllm@auburn.edu>
46
47 * debugging.texi (Function Debugging): Delete mention of empty
48 string argument to `cancel-debug-on-entry'. Delete inaccurate
49 description of the return value of that command.
50
512005-06-11 Alan Mackenzie <acm@muc.de>
52
53 * text.texi (Adaptive Fill): Amplify the description of
54 fill-context-prefix.
55
562005-06-10 Luc Teirlinck <teirllm@auburn.edu>
57
58 * syntax.texi (Parsing Exprssions): Fix Texinfo error.
59
602005-06-10 Stefan Monnier <monnier@iro.umontreal.ca>
61
62 * syntax.texi (Parsing Expressions): Document syntax-ppss.
63
642005-06-10 Luc Teirlinck <teirllm@auburn.edu>
65
66 * debugging.texi (Error Debugging): Minor rewording.
67 (Function Debugging): FUNCTION-NAME arg to `cancel-debug-on-entry'
68 is optional.
69
702005-06-10 Lute Kamstra <lute@gnu.org>
71
72 * elisp.texi: Use EMACSVER to refer to the current version of Emacs.
73 (Top): Give it a title. Correct version number. Give the
74 detailed node listing a more prominent header.
75 * intro.texi: Don't set VERSION here a second time.
76 Mention Emacs's version too.
77 * anti.texi (Antinews): Use EMACSVER to refer to the current
78 version of Emacs.
79
12005-06-09 Kim F. Storm <storm@cua.dk> 802005-06-09 Kim F. Storm <storm@cua.dk>
2 81
3 * searching.texi (Entire Match Data): Explain new `reseat' argument to 82 * searching.texi (Entire Match Data): Explain new `reseat' argument to
@@ -78,8 +157,8 @@
78 157
792005-05-21 Eli Zaretskii <eliz@gnu.org> 1582005-05-21 Eli Zaretskii <eliz@gnu.org>
80 159
81 * files.texi (Locating Files): New subsection. Describe 160 * files.texi (Locating Files): New subsection.
82 locate-file and executable-find. 161 Describe locate-file and executable-find.
83 162
842005-05-21 Kevin Ryde <user42@zip.com.au> 1632005-05-21 Kevin Ryde <user42@zip.com.au>
85 164
@@ -94,8 +173,8 @@
94 (Major Mode Conventions): Refer to `Auto Major Mode' in more 173 (Major Mode Conventions): Refer to `Auto Major Mode' in more
95 appropriate place. 174 appropriate place.
96 (Derived Modes): Small clarifications. 175 (Derived Modes): Small clarifications.
97 (Minor Mode Conventions, Keymaps and Minor Modes): Replace 176 (Minor Mode Conventions, Keymaps and Minor Modes):
98 references to nodes with references to anchors. 177 Replace references to nodes with references to anchors.
99 (Mode Line Data): Warn that `(:eval FORM)' should not load any files. 178 (Mode Line Data): Warn that `(:eval FORM)' should not load any files.
100 Clarify description of lists whose first element is an integer. 179 Clarify description of lists whose first element is an integer.
101 (Mode Line Variables): Add anchor. 180 (Mode Line Variables): Add anchor.
@@ -247,10 +326,10 @@
247 (Font Lock Basics): Say that font-lock-defaults is buffer-local 326 (Font Lock Basics): Say that font-lock-defaults is buffer-local
248 when set and that some parts are optional. Add cross references. 327 when set and that some parts are optional. Add cross references.
249 (Search-based Fontification): Say how to specify font-lock-keywords. 328 (Search-based Fontification): Say how to specify font-lock-keywords.
250 Add cross references. Add font-lock-multiline to index. Move 329 Add cross references. Add font-lock-multiline to index.
251 font-lock-keywords-case-fold-search here from node "Other Font 330 Move font-lock-keywords-case-fold-search here from node "Other Font
252 Lock Variables". Document font-lock-add-keywords and 331 Lock Variables". Document font-lock-add-keywords and
253 font-lock-remove-keywords 332 font-lock-remove-keywords.
254 (Other Font Lock Variables): Move font-lock-keywords-only, 333 (Other Font Lock Variables): Move font-lock-keywords-only,
255 font-lock-syntax-table, font-lock-beginning-of-syntax-function, 334 font-lock-syntax-table, font-lock-beginning-of-syntax-function,
256 and font-lock-syntactic-face-function to node "Syntactic Font 335 and font-lock-syntactic-face-function to node "Syntactic Font
@@ -265,8 +344,8 @@
265 and font-lock-syntactic-face-function here from node "Other Font 344 and font-lock-syntactic-face-function here from node "Other Font
266 Lock Variables". Move font-lock-syntactic-keywords to "Setting 345 Lock Variables". Move font-lock-syntactic-keywords to "Setting
267 Syntax Properties". Add cross references. 346 Syntax Properties". Add cross references.
268 (Setting Syntax Properties): New node. Move 347 (Setting Syntax Properties): New node.
269 font-lock-syntactic-keywords here from "Syntactic Font Lock". 348 Move font-lock-syntactic-keywords here from "Syntactic Font Lock".
270 * syntax.texi (Syntax Properties): Add cross reference. 349 * syntax.texi (Syntax Properties): Add cross reference.
271 * hooks.texi (Standard Hooks): Add Font-Lock hooks. 350 * hooks.texi (Standard Hooks): Add Font-Lock hooks.
272 351
@@ -325,7 +404,7 @@
325 404
3262005-04-19 Kevin Ryde <user42@zip.com.au> 4052005-04-19 Kevin Ryde <user42@zip.com.au>
327 406
328 * streams.texi (Output Functions): Fix xref. 407 * streams.texi (Output Functions): Fix xref.
329 * strings.texi (String Conversion): Fix xref. 408 * strings.texi (String Conversion): Fix xref.
330 409
3312005-04-19 Kim F. Storm <storm@cua.dk> 4102005-04-19 Kim F. Storm <storm@cua.dk>
@@ -419,8 +498,8 @@
419 498
420 * markers.texi (The Mark): Document temporary Transient Mark mode. 499 * markers.texi (The Mark): Document temporary Transient Mark mode.
421 500
422 * minibuf.texi (Reading File Names): Document 501 * minibuf.texi (Reading File Names):
423 read-file-name-completion-ignore-case. 502 Document read-file-name-completion-ignore-case.
424 503
425 * positions.texi (Screen Lines): Document nil for width argument 504 * positions.texi (Screen Lines): Document nil for width argument
426 to compute-motion. 505 to compute-motion.
@@ -440,11 +519,10 @@
440 (Managing Overlays): Document remove-overlays. 519 (Managing Overlays): Document remove-overlays.
441 (Standard Faces): Document escape-glyph face. 520 (Standard Faces): Document escape-glyph face.
442 521
443 * minibuf.texi (Reading File Names): Document 522 * minibuf.texi (Reading File Names): Document read-file-name-function.
444 read-file-name-function.
445 523
446 * modes.texi (Other Font Lock Variables): Document 524 * modes.texi (Other Font Lock Variables):
447 font-lock-lines-before. 525 Document font-lock-lines-before.
448 526
449 * positions.texi (Skipping Characters): skip-chars-forward allows 527 * positions.texi (Skipping Characters): skip-chars-forward allows
450 character classes. 528 character classes.
@@ -498,18 +576,18 @@
498 (Progress): Clarify. 576 (Progress): Clarify.
499 (Invisible Text): Explain that main loop moves point out. 577 (Invisible Text): Explain that main loop moves point out.
500 (Selective Display): Say "hidden", not "invisible". 578 (Selective Display): Say "hidden", not "invisible".
501 (Managing Overlays): Moved up. Describe relation to Undo here. 579 (Managing Overlays): Move up. Describe relation to Undo here.
502 (Overlay Properties): Clarify intro. 580 (Overlay Properties): Clarify intro.
503 (Finding Overlays): Explain return values when nothing found. 581 (Finding Overlays): Explain return values when nothing found.
504 (Width): truncate-string-to-width has added arg. 582 (Width): truncate-string-to-width has added arg.
505 (Displaying Faces): Clarify and update mode line face handling. 583 (Displaying Faces): Clarify and update mode line face handling.
506 (Face Functions): Minor cleanup. 584 (Face Functions): Minor cleanup.
507 (Conditional Display): Merged into Other Display Specs. 585 (Conditional Display): Merge into Other Display Specs.
508 (Pixel Specification, Other Display Specs): Minor cleanups. 586 (Pixel Specification, Other Display Specs): Minor cleanups.
509 (Images, Image Descriptors): Minor cleanups. 587 (Images, Image Descriptors): Minor cleanups.
510 (GIF Images): Patents have expired. 588 (GIF Images): Patents have expired.
511 (Showing Images): Explain default text for insert-image. 589 (Showing Images): Explain default text for insert-image.
512 (Manipulating Button Types): Merged into Manipulating Buttons. 590 (Manipulating Button Types): Merge into Manipulating Buttons.
513 (Making Buttons): Explain return values. 591 (Making Buttons): Explain return values.
514 (Button Buffer Commands): Add xref. 592 (Button Buffer Commands): Add xref.
515 (Inverse Video): Update mode-line-inverse-video. 593 (Inverse Video): Update mode-line-inverse-video.
@@ -869,8 +947,8 @@
869 * commands.texi (Misc Events): Describe the help-echo event. 947 * commands.texi (Misc Events): Describe the help-echo event.
870 948
871 * text.texi (Special Properties) <help-echo>: Use `pos' 949 * text.texi (Special Properties) <help-echo>: Use `pos'
872 consistently in description of the help-echo property. Use 950 consistently in description of the help-echo property.
873 @code{nil} instead of @var{nil}. 951 Use @code{nil} instead of @var{nil}.
874 952
875 * display.texi (Overlay Properties): Fix the index entry for 953 * display.texi (Overlay Properties): Fix the index entry for
876 help-echo overlay property. 954 help-echo overlay property.
diff --git a/lispref/Makefile.in b/lispref/Makefile.in
index 2fab86ab876..f2e5e46874f 100644
--- a/lispref/Makefile.in
+++ b/lispref/Makefile.in
@@ -124,7 +124,7 @@ distclean: clean
124 124
125maintainer-clean: clean 125maintainer-clean: clean
126 rm -f elisp.dvi elisp.oaux 126 rm -f elisp.dvi elisp.oaux
127 cd $(infodir); rm -f elisp elisp-[1-9] elisp-[1-9][0-9] 127 cd $(infodir); rm -f elisp elisp-[1-9] elisp-[1-9][0-9]
128 128
129dist: $(infodir)/elisp elisp.dvi 129dist: $(infodir)/elisp elisp.dvi
130 -rm -rf temp 130 -rm -rf temp
diff --git a/lispref/anti.texi b/lispref/anti.texi
index 458409f2603..46375f3f157 100644
--- a/lispref/anti.texi
+++ b/lispref/anti.texi
@@ -10,7 +10,8 @@
10 10
11For those users who live backwards in time, here is information about 11For those users who live backwards in time, here is information about
12downgrading to Emacs version 21.4. We hope you will enjoy the greater 12downgrading to Emacs version 21.4. We hope you will enjoy the greater
13simplicity that results from the absence of many Emacs 22 features. 13simplicity that results from the absence of many Emacs @value{EMACSVER}
14features.
14 15
15@section Old Lisp Features in Emacs 21 16@section Old Lisp Features in Emacs 21
16 17
diff --git a/lispref/debugging.texi b/lispref/debugging.texi
index 07dfe18f283..739dd1fe298 100644
--- a/lispref/debugging.texi
+++ b/lispref/debugging.texi
@@ -118,8 +118,8 @@ the error. The easiest way is usually to set
118@end defopt 118@end defopt
119 119
120@defopt eval-expression-debug-on-error 120@defopt eval-expression-debug-on-error
121If you set this variable to a non-@code{nil} value, then 121If this variable has a non-@code{nil} value, then
122@code{debug-on-error} will be set to @code{t} when evaluating with the 122@code{debug-on-error} is set to @code{t} when evaluating with the
123command @code{eval-expression}. If 123command @code{eval-expression}. If
124@code{eval-expression-debug-on-error} is @code{nil}, then the value of 124@code{eval-expression-debug-on-error} is @code{nil}, then the value of
125@code{debug-on-error} is not changed. @xref{Lisp Eval,, Evaluating 125@code{debug-on-error} is not changed. @xref{Lisp Eval,, Evaluating
@@ -210,15 +210,19 @@ called shortly before the problem, step quickly over the call to that
210function, and then step through its caller. 210function, and then step through its caller.
211 211
212@deffn Command debug-on-entry function-name 212@deffn Command debug-on-entry function-name
213This function requests @var{function-name} to invoke the debugger each time 213This function requests @var{function-name} to invoke the debugger each
214it is called. It works by inserting the form @code{(debug 'debug)} into 214time it is called. It works by inserting the form
215the function definition as the first form. 215@code{(implement-debug-on-entry)} into the function definition as the
216 216first form.
217Any function defined as Lisp code may be set to break on entry, 217
218regardless of whether it is interpreted code or compiled code. If the 218Any function or macro defined as Lisp code may be set to break on
219function is a command, it will enter the debugger when called from Lisp 219entry, regardless of whether it is interpreted code or compiled code.
220and when called interactively (after the reading of the arguments). You 220If the function is a command, it will enter the debugger when called
221can't debug primitive functions (i.e., those written in C) this way. 221from Lisp and when called interactively (after the reading of the
222arguments). You can also set debug-on-entry for primitive functions
223(i.e., those written in C) this way, but it only takes effect when the
224primitive is called from Lisp code. Debug-on-entry is not allowed for
225special forms.
222 226
223When @code{debug-on-entry} is called interactively, it prompts for 227When @code{debug-on-entry} is called interactively, it prompts for
224@var{function-name} in the minibuffer. If the function is already set 228@var{function-name} in the minibuffer. If the function is already set
@@ -267,16 +271,13 @@ Debugger entered--entering a function:
267@end example 271@end example
268@end deffn 272@end deffn
269 273
270@deffn Command cancel-debug-on-entry function-name 274@deffn Command cancel-debug-on-entry &optional function-name
271This function undoes the effect of @code{debug-on-entry} on 275This function undoes the effect of @code{debug-on-entry} on
272@var{function-name}. When called interactively, it prompts for 276@var{function-name}. When called interactively, it prompts for
273@var{function-name} in the minibuffer. If @var{function-name} is 277@var{function-name} in the minibuffer. If @var{function-name} is
274@code{nil} or the empty string, it cancels break-on-entry for all 278omitted or @code{nil}, it cancels break-on-entry for all functions.
275functions.
276
277Calling @code{cancel-debug-on-entry} does nothing to a function which is 279Calling @code{cancel-debug-on-entry} does nothing to a function which is
278not currently set up to break on entry. It always returns 280not currently set up to break on entry.
279@var{function-name}.
280@end deffn 281@end deffn
281 282
282@node Explicit Debug 283@node Explicit Debug
diff --git a/lispref/edebug.texi b/lispref/edebug.texi
index cc42926ecf7..981afbb894c 100644
--- a/lispref/edebug.texi
+++ b/lispref/edebug.texi
@@ -65,7 +65,7 @@ enable you to use it.
65* Modes: Edebug Execution Modes. Execution modes, stopping more or less often. 65* Modes: Edebug Execution Modes. Execution modes, stopping more or less often.
66* Jumping:: Commands to jump to a specified place. 66* Jumping:: Commands to jump to a specified place.
67* Misc: Edebug Misc. Miscellaneous commands. 67* Misc: Edebug Misc. Miscellaneous commands.
68* Breakpoints:: Setting breakpoints to make the program stop. 68* Breaks:: Setting breakpoints to make the program stop.
69* Trapping Errors:: Trapping errors with Edebug. 69* Trapping Errors:: Trapping errors with Edebug.
70* Views: Edebug Views. Views inside and outside of Edebug. 70* Views: Edebug Views. Views inside and outside of Edebug.
71* Eval: Edebug Eval. Evaluating expressions within Edebug. 71* Eval: Edebug Eval. Evaluating expressions within Edebug.
@@ -75,7 +75,7 @@ enable you to use it.
75* Trace Buffer:: How to produce trace output in a buffer. 75* Trace Buffer:: How to produce trace output in a buffer.
76* Coverage Testing:: How to test evaluation coverage. 76* Coverage Testing:: How to test evaluation coverage.
77* The Outside Context:: Data that Edebug saves and restores. 77* The Outside Context:: Data that Edebug saves and restores.
78* Instrumenting Macro Calls:: Specifying how to handle macro calls. 78* Edebug and Macros:: Specifying how to handle macro calls.
79* Options: Edebug Options. Option variables for customizing Edebug. 79* Options: Edebug Options. Option variables for customizing Edebug.
80@end menu 80@end menu
81 81
@@ -203,13 +203,13 @@ function.
203@code{interactive} forms with an expression argument, anonymous lambda 203@code{interactive} forms with an expression argument, anonymous lambda
204expressions, and other defining forms. However, Edebug cannot determine 204expressions, and other defining forms. However, Edebug cannot determine
205on its own what a user-defined macro will do with the arguments of a 205on its own what a user-defined macro will do with the arguments of a
206macro call, so you must provide that information; see @ref{Instrumenting 206macro call, so you must provide that information; see @ref{Edebug and
207Macro Calls}, for details. 207Macros}, for details.
208 208
209 When Edebug is about to instrument code for the first time in a 209 When Edebug is about to instrument code for the first time in a
210session, it runs the hook @code{edebug-setup-hook}, then sets it to 210session, it runs the hook @code{edebug-setup-hook}, then sets it to
211@code{nil}. You can use this to load Edebug specifications 211@code{nil}. You can use this to load Edebug specifications
212(@pxref{Instrumenting Macro Calls}) associated with a package you are 212(@pxref{Edebug and Macros}) associated with a package you are
213using, but only when you use Edebug. 213using, but only when you use Edebug.
214 214
215@findex eval-expression @r{(Edebug)} 215@findex eval-expression @r{(Edebug)}
@@ -253,7 +253,7 @@ Step: stop at the next stop point encountered (@code{edebug-step-mode}).
253@item n 253@item n
254Next: stop at the next stop point encountered after an expression 254Next: stop at the next stop point encountered after an expression
255(@code{edebug-next-mode}). Also see @code{edebug-forward-sexp} in 255(@code{edebug-next-mode}). Also see @code{edebug-forward-sexp} in
256@ref{Edebug Misc}. 256@ref{Jumping}.
257 257
258@item t 258@item t
259Trace: pause (normally one second) at each Edebug stop point 259Trace: pause (normally one second) at each Edebug stop point
@@ -341,9 +341,8 @@ Run the program until the end of the containing sexp.
341Step into the function or macro called by the form after point. 341Step into the function or macro called by the form after point.
342@end table 342@end table
343 343
344The @kbd{h} command proceeds to the stop point near the current location 344The @kbd{h} command proceeds to the stop point at or after the current
345of point, using a temporary breakpoint. See @ref{Breakpoints}, for more 345location of point, using a temporary breakpoint.
346information about breakpoints.
347 346
348The @kbd{f} command runs the program forward over one expression. More 347The @kbd{f} command runs the program forward over one expression. More
349precisely, it sets a temporary breakpoint at the position that 348precisely, it sets a temporary breakpoint at the position that
@@ -427,14 +426,23 @@ recursively. Whenever Edebug is active, you can quit to the top level
427with @kbd{q} or abort one recursive edit level with @kbd{C-]}. You can 426with @kbd{q} or abort one recursive edit level with @kbd{C-]}. You can
428display a backtrace of all the pending evaluations with @kbd{d}. 427display a backtrace of all the pending evaluations with @kbd{d}.
429 428
430@node Breakpoints 429@node Breaks
431@subsection Breakpoints 430@subsection Breaks
432 431
433@cindex breakpoints
434Edebug's step mode stops execution when the next stop point is reached. 432Edebug's step mode stops execution when the next stop point is reached.
435There are three other ways to stop Edebug execution once it has started: 433There are three other ways to stop Edebug execution once it has started:
436breakpoints, the global break condition, and source breakpoints. 434breakpoints, the global break condition, and source breakpoints.
437 435
436@menu
437* Breakpoints:: Breakpoints at stop points.
438* Global Break Condition:: Breaking on an event.
439* Source Breakpoints:: Embedding breakpoints in source code.
440@end menu
441
442@node Breakpoints
443@subsubsection Breakpoints
444
445@cindex breakpoints
438While using Edebug, you can specify @dfn{breakpoints} in the program you 446While using Edebug, you can specify @dfn{breakpoints} in the program you
439are testing: these are places where execution should stop. You can set a 447are testing: these are places where execution should stop. You can set a
440breakpoint at any stop point, as defined in @ref{Using Edebug}. For 448breakpoint at any stop point, as defined in @ref{Using Edebug}. For
@@ -494,12 +502,6 @@ function, or to the first breakpoint if there are no following
494breakpoints. This command does not continue execution---it just moves 502breakpoints. This command does not continue execution---it just moves
495point in the buffer. 503point in the buffer.
496 504
497@menu
498* Global Break Condition:: Breaking on an event.
499* Source Breakpoints:: Embedding breakpoints in source code.
500@end menu
501
502
503@node Global Break Condition 505@node Global Break Condition
504@subsubsection Global Break Condition 506@subsubsection Global Break Condition
505 507
@@ -515,7 +517,9 @@ evaluating the condition gets an error, execution does not stop.
515@findex edebug-set-global-break-condition 517@findex edebug-set-global-break-condition
516 The condition expression is stored in 518 The condition expression is stored in
517@code{edebug-global-break-condition}. You can specify a new expression 519@code{edebug-global-break-condition}. You can specify a new expression
518using the @kbd{X} command (@code{edebug-set-global-break-condition}). 520using the @kbd{X} command from the source code buffer while Edebug is
521active, or using @kbd{C-x X X} from any buffer at any time, as long as
522Edebug is loaded (@code{edebug-set-global-break-condition}).
519 523
520 The global break condition is the simplest way to find where in your 524 The global break condition is the simplest way to find where in your
521code some event occurs, but it makes code run much more slowly. So you 525code some event occurs, but it makes code run much more slowly. So you
@@ -582,13 +586,14 @@ effect outside of Edebug.
582 586
583@table @kbd 587@table @kbd
584@item v 588@item v
585Temporarily view the outside window configuration 589View the outside window configuration (@code{edebug-view-outside}).
586(@code{edebug-view-outside}). 590Type @kbd{C-x X w} to return to Edebug.
587 591
588@item p 592@item p
589Temporarily display the outside current buffer with point at its outside 593Temporarily display the outside current buffer with point at its
590position (@code{edebug-bounce-point}). With a prefix argument @var{n}, 594outside position (@code{edebug-bounce-point}), pausing for one second
591pause for @var{n} seconds instead. 595before returning to Edebug. With a prefix argument @var{n}, pause for
596@var{n} seconds instead.
592 597
593@item w 598@item w
594Move point back to the current stop point in the source code buffer 599Move point back to the current stop point in the source code buffer
@@ -610,8 +615,12 @@ source code buffer, you must use @kbd{C-x X W} from the global keymap.
610 615
611 You can view the outside window configuration with @kbd{v} or just 616 You can view the outside window configuration with @kbd{v} or just
612bounce to the point in the current buffer with @kbd{p}, even if 617bounce to the point in the current buffer with @kbd{p}, even if
613it is not normally displayed. After moving point, you may wish to jump 618it is not normally displayed.
614back to the stop point with @kbd{w} from a source code buffer. 619
620 After moving point, you may wish to jump back to the stop point.
621You can do that with @kbd{w} from a source code buffer. You can jump
622back to the stop point in the source code buffer from any buffer using
623@kbd{C-x X w}.
615 624
616 Each time you use @kbd{W} to turn saving @emph{off}, Edebug forgets the 625 Each time you use @kbd{W} to turn saving @emph{off}, Edebug forgets the
617saved outside window configuration---so that even if you turn saving 626saved outside window configuration---so that even if you turn saving
@@ -838,8 +847,9 @@ redefining the functions @code{edebug-print-trace-before} and
838@defmac edebug-tracing string body@dots{} 847@defmac edebug-tracing string body@dots{}
839This macro requests additional trace information around the execution 848This macro requests additional trace information around the execution
840of the @var{body} forms. The argument @var{string} specifies text 849of the @var{body} forms. The argument @var{string} specifies text
841to put in the trace buffer. All the arguments are evaluated, and 850to put in the trace buffer, after the @samp{@{} or @samp{@}}. All
842@code{edebug-tracing} returns the value of the last form in @var{body}. 851the arguments are evaluated, and @code{edebug-tracing} returns the
852value of the last form in @var{body}.
843@end defmac 853@end defmac
844 854
845@defun edebug-trace format-string &rest format-args 855@defun edebug-trace format-string &rest format-args
@@ -990,7 +1000,7 @@ current buffer, are saved and restored.
990@item 1000@item
991@cindex window configuration (Edebug) 1001@cindex window configuration (Edebug)
992The outside window configuration is saved and restored if 1002The outside window configuration is saved and restored if
993@code{edebug-save-windows} is non-@code{nil} (@pxref{Edebug Display Update}). 1003@code{edebug-save-windows} is non-@code{nil} (@pxref{Edebug Options}).
994 1004
995The window configuration is not restored on error or quit, but the 1005The window configuration is not restored on error or quit, but the
996outside selected window @emph{is} reselected even on error or quit in 1006outside selected window @emph{is} reselected even on error or quit in
@@ -1061,8 +1071,21 @@ Edebug is active, @code{defining-kbd-macro} is bound to
1061@code{edebug-continue-kbd-macro}. 1071@code{edebug-continue-kbd-macro}.
1062@end itemize 1072@end itemize
1063 1073
1074@node Edebug and Macros
1075@subsection Edebug and Macros
1076
1077To make Edebug properly instrument expressions that call macros, some
1078extra care is needed. This subsection explains the details.
1079
1080@menu
1081* Instrumenting Macro Calls:: The basic problem.
1082* Specification List:: How to specify complex patterns of evaluation.
1083* Backtracking:: What Edebug does when matching fails.
1084* Specification Examples:: To help understand specifications.
1085@end menu
1086
1064@node Instrumenting Macro Calls 1087@node Instrumenting Macro Calls
1065@subsection Instrumenting Macro Calls 1088@subsubsection Instrumenting Macro Calls
1066 1089
1067 When Edebug instruments an expression that calls a Lisp macro, it needs 1090 When Edebug instruments an expression that calls a Lisp macro, it needs
1068additional information about the macro to do the job properly. This is 1091additional information about the macro to do the job properly. This is
@@ -1101,7 +1124,7 @@ define Edebug specifications for special forms implemented in C.
1101@deffn Macro def-edebug-spec macro specification 1124@deffn Macro def-edebug-spec macro specification
1102Specify which expressions of a call to macro @var{macro} are forms to be 1125Specify which expressions of a call to macro @var{macro} are forms to be
1103evaluated. @var{specification} should be the edebug specification. 1126evaluated. @var{specification} should be the edebug specification.
1104It is not evaluated. 1127Neither argument is evaluated.
1105 1128
1106The @var{macro} argument can actually be any symbol, not just a macro 1129The @var{macro} argument can actually be any symbol, not just a macro
1107name. 1130name.
@@ -1128,12 +1151,12 @@ calling form. The possible elements of a specification list are
1128described in the following sections. 1151described in the following sections.
1129@end table 1152@end table
1130 1153
1131@menu 1154@vindex edebug-eval-macro-args
1132* Specification List:: How to specify complex patterns of evaluation. 1155If a macro has no Edebug specification, neither through a @code{debug}
1133* Backtracking:: What Edebug does when matching fails. 1156declaration nor through a @code{def-edebug-spec} call, the variable
1134* Specification Examples:: To help understand specifications. 1157@code{edebug-eval-macro-args} comes into play. If it is @code{nil},
1135@end menu 1158the default, none of the arguments is instrumented for evaluation.
1136 1159If it is non-@code{nil}, all arguments are instrumented.
1137 1160
1138@node Specification List 1161@node Specification List
1139@subsubsection Specification List 1162@subsubsection Specification List
@@ -1406,7 +1429,7 @@ inside of the sublist to prevent backtracking once a sublist is found.
1406Edebug uses the following specifications for @code{defun} and 1429Edebug uses the following specifications for @code{defun} and
1407@code{defmacro} and the associated argument list and @code{interactive} 1430@code{defmacro} and the associated argument list and @code{interactive}
1408specifications. It is necessary to handle interactive forms specially 1431specifications. It is necessary to handle interactive forms specially
1409since an expression argument it is actually evaluated outside of the 1432since an expression argument is actually evaluated outside of the
1410function body. 1433function body.
1411 1434
1412@smallexample 1435@smallexample
diff --git a/lispref/elisp.texi b/lispref/elisp.texi
index 7a19f8a47da..4be680969a1 100644
--- a/lispref/elisp.texi
+++ b/lispref/elisp.texi
@@ -4,8 +4,10 @@
4@settitle GNU Emacs Lisp Reference Manual 4@settitle GNU Emacs Lisp Reference Manual
5@c %**end of header 5@c %**end of header
6 6
7@c Versino of the manual. 7@c Version of the manual and of Emacs.
8@set VERSION 2.9 8@c Please remember to update the edition number in README as well.
9@set VERSION 2.9
10@set EMACSVER 22.0.50
9 11
10@dircategory Emacs 12@dircategory Emacs
11@direntry 13@direntry
@@ -26,9 +28,7 @@
26 28
27@ifnottex 29@ifnottex
28This Info file contains edition @value{VERSION} of the GNU Emacs Lisp 30This Info file contains edition @value{VERSION} of the GNU Emacs Lisp
29Reference Manual, corresponding to Emacs version 22.1. 31Reference Manual, corresponding to Emacs version @value{EMACSVER}.
30@c Please REMEMBER to update edition number in *four* places in this file
31@c and also in *one* place in intro.texi and *one* in README.
32 32
33Published by the Free Software Foundation 33Published by the Free Software Foundation
3459 Temple Place, Suite 330 3459 Temple Place, Suite 330
@@ -52,9 +52,7 @@ Software Foundation raise funds for GNU development.''
52 52
53@titlepage 53@titlepage
54@title GNU Emacs Lisp Reference Manual 54@title GNU Emacs Lisp Reference Manual
55@subtitle For Emacs Version 22 55@subtitle For Emacs Version @value{EMACSVER}
56@c The edition number appears in several places in this file
57@c and also in the file intro.texi.
58@subtitle Revision @value{VERSION}, January 2002 56@subtitle Revision @value{VERSION}, January 2002
59 57
60@author by Bil Lewis, Dan LaLiberte, Richard Stallman 58@author by Bil Lewis, Dan LaLiberte, Richard Stallman
@@ -66,7 +64,7 @@ Copyright @copyright{} 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1998,@*
66 64
67@sp 2 65@sp 2
68Edition @value{VERSION} @* 66Edition @value{VERSION} @*
69Revised for Emacs Version 22.1,@* 67Revised for Emacs Version @value{EMACSVER},@*
70January 2002.@* 68January 2002.@*
71@sp 2 69@sp 2
72ISBN 1-882114-73-6 70ISBN 1-882114-73-6
@@ -92,11 +90,12 @@ Cover art by Etienne Suvasa.
92@end titlepage 90@end titlepage
93@page 91@page
94 92
93@ifnottex
95@node Top, Introduction, (dir), (dir) 94@node Top, Introduction, (dir), (dir)
95@top Emacs Lisp
96 96
97@ifnottex
98This Info file contains edition @value{VERSION} of the GNU Emacs Lisp 97This Info file contains edition @value{VERSION} of the GNU Emacs Lisp
99Reference Manual, corresponding to GNU Emacs version 22.1. 98Reference Manual, corresponding to GNU Emacs version @value{EMACSVER}.
100@end ifnottex 99@end ifnottex
101 100
102@menu 101@menu
@@ -156,7 +155,7 @@ Reference Manual, corresponding to GNU Emacs version 22.1.
156 155
157Appendices 156Appendices
158 157
159* Antinews:: Info for users downgrading to Emacs 20. 158* Antinews:: Info for users downgrading to Emacs 21.
160* GNU Free Documentation License:: The license for this documentation 159* GNU Free Documentation License:: The license for this documentation
161* GPL:: Conditions for copying and changing GNU Emacs. 160* GPL:: Conditions for copying and changing GNU Emacs.
162* Tips:: Advice and coding conventions for Emacs Lisp. 161* Tips:: Advice and coding conventions for Emacs Lisp.
@@ -171,9 +170,10 @@ Appendices
171* Index:: Index including concepts, functions, variables, 170* Index:: Index including concepts, functions, variables,
172 and other terms. 171 and other terms.
173 172
174* New Symbols:: New functions and variables in Emacs 22. 173* New Symbols:: New functions and variables in Emacs @value{EMACSVER}.
175 174
176 --- The Detailed Node Listing --- 175Detailed Node Listing
176---------------------
177 177
178Here are other nodes that are inferiors of those already listed, 178Here are other nodes that are inferiors of those already listed,
179mentioned here so you can get to them in one step: 179mentioned here so you can get to them in one step:
@@ -514,7 +514,7 @@ Edebug
514* Edebug Execution Modes:: Execution modes, stopping more or less often. 514* Edebug Execution Modes:: Execution modes, stopping more or less often.
515* Jumping:: Commands to jump to a specified place. 515* Jumping:: Commands to jump to a specified place.
516* Edebug Misc:: Miscellaneous commands. 516* Edebug Misc:: Miscellaneous commands.
517* Breakpoints:: Setting breakpoints to make the program stop. 517* Breaks:: Setting breakpoints to make the program stop.
518* Trapping Errors:: Trapping errors with Edebug. 518* Trapping Errors:: Trapping errors with Edebug.
519* Edebug Views:: Views inside and outside of Edebug. 519* Edebug Views:: Views inside and outside of Edebug.
520* Edebug Eval:: Evaluating expressions within Edebug. 520* Edebug Eval:: Evaluating expressions within Edebug.
@@ -524,7 +524,7 @@ Edebug
524* Trace Buffer:: How to produce trace output in a buffer. 524* Trace Buffer:: How to produce trace output in a buffer.
525* Coverage Testing:: How to test evaluation coverage. 525* Coverage Testing:: How to test evaluation coverage.
526* The Outside Context:: Data that Edebug saves and restores. 526* The Outside Context:: Data that Edebug saves and restores.
527* Instrumenting Macro Calls:: Specifying how to handle macro calls. 527* Edebug and Macros:: Specifying how to handle macro calls.
528* Edebug Options:: Option variables for customizing Edebug. 528* Edebug Options:: Option variables for customizing Edebug.
529 529
530Debugging Invalid Lisp Syntax 530Debugging Invalid Lisp Syntax
diff --git a/lispref/intro.texi b/lispref/intro.texi
index 999db7ad722..bb264c81c46 100644
--- a/lispref/intro.texi
+++ b/lispref/intro.texi
@@ -5,9 +5,6 @@
5@c See the file elisp.texi for copying conditions. 5@c See the file elisp.texi for copying conditions.
6@setfilename ../info/intro 6@setfilename ../info/intro
7 7
8@c Versino of the manual.
9@set VERSION 2.9
10
11@node Introduction, Lisp Data Types, Top, Top 8@node Introduction, Lisp Data Types, Top, Top
12@comment node-name, next, previous, up 9@comment node-name, next, previous, up
13@chapter Introduction 10@chapter Introduction
@@ -38,7 +35,8 @@ Lisp that have counterparts in many programming languages, and later
38chapters describe features that are peculiar to Emacs Lisp or relate 35chapters describe features that are peculiar to Emacs Lisp or relate
39specifically to editing. 36specifically to editing.
40 37
41 This is edition @value{VERSION}. 38 This is edition @value{VERSION} of the GNU Emacs Lisp Reference
39Manual, corresponding to Emacs version @value{EMACSVER}.
42 40
43@menu 41@menu
44* Caveats:: Flaws and a request for help. 42* Caveats:: Flaws and a request for help.
diff --git a/lispref/searching.texi b/lispref/searching.texi
index 15037068dd2..38a0f4915d7 100644
--- a/lispref/searching.texi
+++ b/lispref/searching.texi
@@ -1531,8 +1531,9 @@ are reseated to point to nowhere, and if the value is @code{evaporate},
1531the markers are put back on the free list. 1531the markers are put back on the free list.
1532 1532
1533@strong{Warning:} When @code{evaporate} is specified for @var{reseat}, 1533@strong{Warning:} When @code{evaporate} is specified for @var{reseat},
1534no other references to the markers on the @var{reuse} list; otherwise, 1534you must ensure that no other references to the markers on the
1535Emacs may crash during the next garbage collection. 1535@var{reuse} list exists; otherwise, Emacs may crash during the next
1536garbage collection.
1536 1537
1537As always, there must be no possibility of intervening searches between 1538As always, there must be no possibility of intervening searches between
1538the call to a search function and the call to @code{match-data} that is 1539the call to a search function and the call to @code{match-data} that is
@@ -1563,8 +1564,9 @@ are reseated to point to nowhere, and if the value is @code{evaporate},
1563the markers are put back on the free list. 1564the markers are put back on the free list.
1564 1565
1565@strong{Warning:} When @code{evaporate} is specified for @var{reseat}, 1566@strong{Warning:} When @code{evaporate} is specified for @var{reseat},
1566no other references to the markers on the @var{match-list} list; otherwise, 1567you must ensure that no other references to the markers on the
1567Emacs may crash during the next garbage collection. 1568@var{match-list} list exists; otherwise, Emacs may crash during the
1569next garbage collection.
1568 1570
1569@findex store-match-data 1571@findex store-match-data
1570@code{store-match-data} is a semi-obsolete alias for @code{set-match-data}. 1572@code{store-match-data} is a semi-obsolete alias for @code{set-match-data}.
diff --git a/lispref/syntax.texi b/lispref/syntax.texi
index a9df79e9f57..e8707709fe2 100644
--- a/lispref/syntax.texi
+++ b/lispref/syntax.texi
@@ -256,7 +256,7 @@ English text has no comment characters. In Lisp, the semicolon
256@deffn {Syntax class} @w{inherit} 256@deffn {Syntax class} @w{inherit}
257This syntax class does not specify a particular syntax. It says to look 257This syntax class does not specify a particular syntax. It says to look
258in the standard syntax table to find the syntax of this character. The 258in the standard syntax table to find the syntax of this character. The
259designator for this syntax code is @samp{@@}. 259designator for this syntax class is @samp{@@}.
260@end deffn 260@end deffn
261 261
262@deffn {Syntax class} @w{generic comment delimiter} 262@deffn {Syntax class} @w{generic comment delimiter}
@@ -385,7 +385,7 @@ nestable.
385@samp{p} identifies an additional ``prefix character'' for Lisp syntax. 385@samp{p} identifies an additional ``prefix character'' for Lisp syntax.
386These characters are treated as whitespace when they appear between 386These characters are treated as whitespace when they appear between
387expressions. When they appear within an expression, they are handled 387expressions. When they appear within an expression, they are handled
388according to their usual syntax codes. 388according to their usual syntax classes.
389 389
390The function @code{backward-prefix-chars} moves back over these 390The function @code{backward-prefix-chars} moves back over these
391characters, as well as over characters whose primary syntax class is 391characters, as well as over characters whose primary syntax class is
@@ -566,7 +566,7 @@ have certain syntax classes.
566 566
567@defun skip-syntax-forward syntaxes &optional limit 567@defun skip-syntax-forward syntaxes &optional limit
568This function moves point forward across characters having syntax 568This function moves point forward across characters having syntax
569classes mentioned in @var{syntaxes} (a string of syntax code 569classes mentioned in @var{syntaxes} (a string of syntax class
570characters). It stops when it encounters the end of the buffer, or 570characters). It stops when it encounters the end of the buffer, or
571position @var{limit} (if specified), or a character it is not supposed 571position @var{limit} (if specified), or a character it is not supposed
572to skip. 572to skip.
@@ -730,6 +730,36 @@ This function is most often used to compute indentation for languages
730that have nested parentheses. 730that have nested parentheses.
731@end defun 731@end defun
732 732
733@defun syntax-ppss &optional pos
734This function returns the state that the parser would have at position
735@var{pos}, if it were started with a default start state at the
736beginning of the buffer. Thus, it is equivalent to
737@code{(parse-partial-sexp (point-min) @var{pos})}, except that
738@code{syntax-ppss} uses a cache to speed up the computation. Also,
739the 2nd value (previous complete subexpression) and 6th value (minimum
740parenthesis depth) of the returned state are not meaningful.
741@end defun
742
743@defun syntax-ppss-flush-cache beg
744This function flushes the cache used by @code{syntax-ppss}, starting at
745position @var{beg}.
746
747When @code{syntax-ppss} is called, it automatically hooks itself
748to @code{before-change-functions} to keep its cache consistent.
749But this can fail if @code{syntax-ppss} is called while
750@code{before-change-functions} is temporarily let-bound, or if the
751buffer is modified without obeying the hook, such as when using
752@code{inhibit-modification-hooks}. For this reason, it is sometimes
753necessary to flush the cache manually.
754@end defun
755
756@defvar syntax-begin-function
757If this is non-nil, it should be a function that moves to an earlier
758buffer position where the parser state is equivalent to @code{nil},
759i.e., a position outside of any comment, string, or parenthesis.
760@code{syntax-ppss} uses it to supplement its cache.
761@end defvar
762
733@defun scan-lists from count depth 763@defun scan-lists from count depth
734This function scans forward @var{count} balanced parenthetical groupings 764This function scans forward @var{count} balanced parenthetical groupings
735from position @var{from}. It returns the position where the scan stops. 765from position @var{from}. It returns the position where the scan stops.
@@ -779,7 +809,7 @@ whitespace by the functions in this section and by @code{forward-sexp}.
779@end defopt 809@end defopt
780 810
781@vindex parse-sexp-lookup-properties 811@vindex parse-sexp-lookup-properties
782The behaviour of @code{parse-partial-sexp} is also affected by 812The behavior of @code{parse-partial-sexp} is also affected by
783@code{parse-sexp-lookup-properties} (@pxref{Syntax Properties}). 813@code{parse-sexp-lookup-properties} (@pxref{Syntax Properties}).
784 814
785You can use @code{forward-comment} to move forward or backward over 815You can use @code{forward-comment} to move forward or backward over
diff --git a/lispref/text.texi b/lispref/text.texi
index 1d4dc0fce8a..cddeeb8fbde 100644
--- a/lispref/text.texi
+++ b/lispref/text.texi
@@ -1667,8 +1667,12 @@ line won't be broken there.
1667@section Adaptive Fill Mode 1667@section Adaptive Fill Mode
1668@cindex Adaptive Fill mode 1668@cindex Adaptive Fill mode
1669 1669
1670 Adaptive Fill mode chooses a fill prefix automatically from the text 1670 When @dfn{Adaptive Fill Mode} is enabled, Emacs determines the fill
1671in each paragraph being filled. 1671prefix automatically from the text in each paragraph being filled
1672rather than using a predetermined value. During filling, this fill
1673prefix gets inserted at the start of the second and subsequent lines
1674of the paragraph as described in @ref{Filling}, and in @ref{Auto
1675Filling}.
1672 1676
1673@defopt adaptive-fill-mode 1677@defopt adaptive-fill-mode
1674Adaptive Fill mode is enabled when this variable is non-@code{nil}. 1678Adaptive Fill mode is enabled when this variable is non-@code{nil}.
@@ -1677,38 +1681,80 @@ It is @code{t} by default.
1677 1681
1678@defun fill-context-prefix from to 1682@defun fill-context-prefix from to
1679This function implements the heart of Adaptive Fill mode; it chooses a 1683This function implements the heart of Adaptive Fill mode; it chooses a
1680fill prefix based on the text between @var{from} and @var{to}. It does 1684fill prefix based on the text between @var{from} and @var{to},
1681this by looking at the first two lines of the paragraph, based on the 1685typically the start and end of a paragraph. It does this by looking
1682variables described below. 1686at the first two lines of the paragraph, based on the variables
1687described below.
1683@c The optional argument first-line-regexp is not documented 1688@c The optional argument first-line-regexp is not documented
1684@c because it exists for internal purposes and might be eliminated 1689@c because it exists for internal purposes and might be eliminated
1685@c in the future. 1690@c in the future.
1691
1692Usually, this function returns the fill prefix, a string. However,
1693before doing this, the function makes a final check (not specially
1694mentioned in the following) that a line starting with this prefix
1695wouldn't look like the start of a paragraph. Should this happen, the
1696function signals the anomaly by returning @code{nil} instead.
1697
1698In detail, @code{fill-context-prefix} does this:
1699
1700@enumerate
1701@item
1702It takes a candidate for the fill prefix from the first line---it
1703tries first the function in @code{adaptive-fill-function} (if any),
1704then the regular expression @code{adaptive-fill-regexp} (see below).
1705The first non-@code{nil} result of these, or the empty string if
1706they're both @code{nil}, becomes the first line's candidate.
1707@item
1708If the paragraph has as yet only one line, the function tests the
1709validity of the prefix candidate just found. The function then
1710returns the candidate if it's valid, or a string of spaces otherwise.
1711(see the description of @code{adaptive-fill-first-line-regexp} below).
1712@item
1713When the paragraph already has two lines, the function next looks for
1714a prefix candidate on the second line, in just the same way it did for
1715the first line. If it doesn't find one, it returns @code{nil}.
1716@item
1717The function now compares the two candidate prefixes heuristically: if
1718the non-whitespace characters in the line 2 candidate occur in the
1719same order in the line 1 candidate, the function returns the line 2
1720candidate. Otherwise, it returns the largest initial substring which
1721is common to both candidates (which might be the empty string).
1722@end enumerate
1686@end defun 1723@end defun
1687 1724
1688@defopt adaptive-fill-regexp 1725@defopt adaptive-fill-regexp
1689This variable holds a regular expression to control Adaptive Fill mode.
1690Adaptive Fill mode matches this regular expression against the text 1726Adaptive Fill mode matches this regular expression against the text
1691starting after the left margin whitespace (if any) on a line; the 1727starting after the left margin whitespace (if any) on a line; the
1692characters it matches are that line's candidate for the fill prefix. 1728characters it matches are that line's candidate for the fill prefix.
1729
1730The default value of this variable is
1731@w{@samp{"[ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*"}}. This
1732matches a number enclosed in parentheses or followed by a period,
1733or certain punctuation characters, or any sequence of these
1734intermingled with whitespace. In particular, it matches a sequence of
1735whitespace, possibly empty.
1693@end defopt 1736@end defopt
1694 1737
1695@defopt adaptive-fill-first-line-regexp 1738@defopt adaptive-fill-first-line-regexp
1696In a one-line paragraph, if the candidate fill prefix matches this 1739Used only in one-line paragraphs, this regular expression acts as an
1697regular expression, or if it matches @code{comment-start-skip}, then it 1740additional check of the validity of the one available candidate fill
1698is used---otherwise, spaces amounting to the same width are used 1741prefix: the candidate must match this regular expression, or match
1699instead. 1742@code{comment-start-skip}. If it doesn't, @code{fill-context-prefix}
1700 1743replaces the candidate with a string of spaces ``of the same width''
1701However, the fill prefix is never taken from a one-line paragraph 1744as it.
1702if it would act as a paragraph starter on subsequent lines. 1745
1746The default value of this variable is @w{@samp{"\\`[ \t]*\\'"}}, which
1747matches only a string of whitespace. The effect of this default is to
1748force the fill prefixes found in one-line paragraphs always to be pure
1749whitespace.
1703@end defopt 1750@end defopt
1704 1751
1705@defopt adaptive-fill-function 1752@defopt adaptive-fill-function
1706You can specify more complex ways of choosing a fill prefix 1753You can specify more complex ways of choosing a fill prefix
1707automatically by setting this variable to a function. The function is 1754automatically by setting this variable to a function. The function is
1708called when @code{adaptive-fill-regexp} does not match, with point after 1755called with point after the left margin (if any) of a line, and it
1709the left margin of a line, and it should return the appropriate fill 1756must preserve point. It should return either ``that line's'' fill
1710prefix based on that line. If it returns @code{nil}, that means it sees 1757prefix or @code{nil}, meaning it has failed to determine a prefix.
1711no fill prefix in that line.
1712@end defopt 1758@end defopt
1713 1759
1714@node Auto Filling 1760@node Auto Filling
@@ -3078,8 +3124,8 @@ that character a non-@code{nil} @var{cursor} text property.
3078@item pointer 3124@item pointer
3079@kindex pointer @r{(text property)} 3125@kindex pointer @r{(text property)}
3080This specifies a specific pointer shape when the mouse pointer is over 3126This specifies a specific pointer shape when the mouse pointer is over
3081this text or image. See the variable @var{void-area-text-pointer} 3127this text or image. @xref{Pointer Shape}, for possible pointer
3082for possible pointer shapes. 3128shapes.
3083 3129
3084@item line-spacing 3130@item line-spacing
3085@kindex line-spacing @r{(text property)} 3131@kindex line-spacing @r{(text property)}
diff --git a/man/ChangeLog b/man/ChangeLog
index ef16f71987a..cfbbf8aab89 100644
--- a/man/ChangeLog
+++ b/man/ChangeLog
@@ -1,3 +1,17 @@
12005-06-13 Carsten Dominik <dominik@science.uva.nl>
2
3 * org.texi: Version 3.11
4
52005-06-12 Jay Belanger <belanger@truman.edu>
6
7 * calc.texi (Getting Started): Remove extra menu item.
8
92005-06-10 Lute Kamstra <lute@gnu.org>
10
11 * emacs.texi (Top): Correct version number.
12 * anti.texi (Antinews): Correct version number. Use EMACSVER to
13 refer to the current version of Emacs.
14
12005-06-08 Luc Teirlinck <teirllm@auburn.edu> 152005-06-08 Luc Teirlinck <teirllm@auburn.edu>
2 16
3 * files.texi (Log Buffer): Document when there can be more than 17 * files.texi (Log Buffer): Document when there can be more than
diff --git a/man/anti.texi b/man/anti.texi
index f20cada4f48..40e7c861fe2 100644
--- a/man/anti.texi
+++ b/man/anti.texi
@@ -3,11 +3,12 @@
3@c See file emacs.texi for copying conditions. 3@c See file emacs.texi for copying conditions.
4 4
5@node Antinews, Mac OS, X Resources, Top 5@node Antinews, Mac OS, X Resources, Top
6@appendix Emacs 22.1 Antinews 6@appendix Emacs 21 Antinews
7 7
8 For those users who live backwards in time, here is information about 8 For those users who live backwards in time, here is information about
9downgrading to Emacs version 21.4. We hope you will enjoy the greater 9downgrading to Emacs version 21.4. We hope you will enjoy the greater
10simplicity that results from the absence of many Emacs 22 features. 10simplicity that results from the absence of many Emacs @value{EMACSVER}
11features.
11 12
12@itemize @bullet 13@itemize @bullet
13 14
diff --git a/man/calc.texi b/man/calc.texi
index 6e947050107..948b6049198 100644
--- a/man/calc.texi
+++ b/man/calc.texi
@@ -585,7 +585,6 @@ and what are the various ways that it can be used.
585* Notations Used in This Manual:: 585* Notations Used in This Manual::
586* Demonstration of Calc:: 586* Demonstration of Calc::
587* Using Calc:: 587* Using Calc::
588* Demonstration of Calc::
589* History and Acknowledgements:: 588* History and Acknowledgements::
590@end menu 589@end menu
591 590
diff --git a/man/emacs.texi b/man/emacs.texi
index 69081b2c02b..ef9200d595e 100644
--- a/man/emacs.texi
+++ b/man/emacs.texi
@@ -121,7 +121,7 @@ and Sending Mail and Registers and Minibuffer.
121* GNU Free Documentation License:: The license for this documentation. 121* GNU Free Documentation License:: The license for this documentation.
122* Intro:: An introduction to Emacs concepts. 122* Intro:: An introduction to Emacs concepts.
123* Glossary:: The glossary. 123* Glossary:: The glossary.
124* Antinews:: Information about Emacs version 20. 124* Antinews:: Information about Emacs version 21.
125* Mac OS:: Using Emacs in the Mac. 125* Mac OS:: Using Emacs in the Mac.
126* MS-DOS:: Using Emacs on MS-DOS (otherwise known as "MS-DOG"). 126* MS-DOS:: Using Emacs on MS-DOS (otherwise known as "MS-DOG").
127* Manifesto:: What's GNU? Gnu's Not Unix! 127* Manifesto:: What's GNU? Gnu's Not Unix!
diff --git a/man/org.texi b/man/org.texi
index 4f3576d57c4..69c323c5eba 100644
--- a/man/org.texi
+++ b/man/org.texi
@@ -4,8 +4,8 @@
4@setfilename ../info/org 4@setfilename ../info/org
5@settitle Org Mode Manual 5@settitle Org Mode Manual
6 6
7@set VERSION 3.10 7@set VERSION 3.11
8@set DATE May 2005 8@set DATE June 2005
9 9
10@dircategory Emacs 10@dircategory Emacs
11@direntry 11@direntry
@@ -103,6 +103,7 @@ Document Structure
103* Visibility cycling:: Show ad hide, much simplified 103* Visibility cycling:: Show ad hide, much simplified
104* Motion:: Jumping to other headlines 104* Motion:: Jumping to other headlines
105* Structure editing:: Changing sequence and level of headlines 105* Structure editing:: Changing sequence and level of headlines
106* Archiving:: Move done task trees to a different place
106* Sparse trees:: Matches embedded in context 107* Sparse trees:: Matches embedded in context
107 108
108Tables 109Tables
@@ -158,8 +159,8 @@ Miscellaneous
158* Customization:: Adapting Org-mode to your taste 159* Customization:: Adapting Org-mode to your taste
159* FAQ:: Frequently asked questions 160* FAQ:: Frequently asked questions
160* Interaction:: Other Emacs packages 161* Interaction:: Other Emacs packages
161* Acknowledgments:: These people provided feedback and more
162* Bugs:: Things which do not work perfectly 162* Bugs:: Things which do not work perfectly
163* Acknowledgments:: These people provided feedback and more
163 164
164@end detailmenu 165@end detailmenu
165@end menu 166@end menu
@@ -303,6 +304,7 @@ edit the structure of the document.
303* Visibility cycling:: Show ad hide, much simplified 304* Visibility cycling:: Show ad hide, much simplified
304* Motion:: Jumping to other headlines 305* Motion:: Jumping to other headlines
305* Structure editing:: Changing sequence and level of headlines 306* Structure editing:: Changing sequence and level of headlines
307* Archiving:: Move done task trees to a different place
306* Sparse trees:: Matches embedded in context 308* Sparse trees:: Matches embedded in context
307@end menu 309@end menu
308 310
@@ -426,7 +428,7 @@ the original buffer, and the headings hierarchy above it is made
426visible. 428visible.
427@end table 429@end table
428 430
429@node Structure editing, Sparse trees, Motion, Document Structure 431@node Structure editing, Archiving, Motion, Document Structure
430@section Structure editing 432@section Structure editing
431@cindex structure editing 433@cindex structure editing
432@cindex headline, promotion and demotion 434@cindex headline, promotion and demotion
@@ -487,7 +489,30 @@ just after the last headline to change. Note that when the cursor is
487inside a table (@pxref{Tables}), the Meta-Cursor keys have different 489inside a table (@pxref{Tables}), the Meta-Cursor keys have different
488functionality. 490functionality.
489 491
490@node Sparse trees, , Structure editing, Document Structure 492@node Archiving, Sparse trees, Structure editing, Document Structure
493@section Archiving
494@cindex archiving
495
496When an project represented by a (sub)tree is finished, you may want
497to move the tree to an Archive place, either in the same file under a
498special top-level heading, or even to a different file.
499@table @kbd
500@kindex @kbd{C-c $}
501@item @kbd{C-c $}
502Archive the subtree starting at the cursor position to the location
503given by @code{org-archive-location}.
504@end table
505
506@cindex archive locations
507The default archive is a file in the same directory as the current
508file, with the name derived by appending @file{_archive} to the
509current file name. For information and examples on how to change
510this, see the documentation string of the variable
511@code{org-archive-location}. If you are also using the Org-mode
512agenda, archiving to a different file is a good way to keep archived
513trees from contributing agenda items.
514
515@node Sparse trees, , Archiving, Document Structure
491@section Sparse trees 516@section Sparse trees
492@cindex sparse trees 517@cindex sparse trees
493@cindex trees, sparse 518@cindex trees, sparse
@@ -702,7 +727,8 @@ When current field is empty, copy from first non-empty field above.
702When not empty, copy current field down to next row and move cursor 727When not empty, copy current field down to next row and move cursor
703along with it. Depending on the variable 728along with it. Depending on the variable
704@code{org-table-copy-increment}, integer field values will be 729@code{org-table-copy-increment}, integer field values will be
705incremented during copy. 730incremented during copy. This key is also used by CUA-mode
731(@pxref{Interaction}).
706 732
707@cindex formula, in tables 733@cindex formula, in tables
708@cindex calculations, in tables 734@cindex calculations, in tables
@@ -807,33 +833,35 @@ articles, emails and much more.
807@cindex SHELL links 833@cindex SHELL links
808 834
809Org-mode supports links to files, websites, usenet and email messages; 835Org-mode supports links to files, websites, usenet and email messages;
810and BBDB database entries. Links are just plain-text URL-like locators. 836and BBDB database entries. Links are just plain-text URL-like
811The following list shows examples for each link type. 837locators, optionally enclosed by angular brackets. The following list
838shows examples for each link type.
812 839
813@example 840@example
814http://www.astro.uva.nl/~dominik @r{on the web} 841<http://www.astro.uva.nl/~dominik> @r{on the web}
815file:/home/dominik/images/jupiter.jpg @r{file, absolute path} 842<file:/home/dominik/images/jupiter.jpg> @r{file, absolute path}
816file:papers/last.pdf @r{file, relative path} 843<file:papers/last.pdf> @r{file, relative path}
817file:~/code/main.c:255 @r{file, with line number} 844<file:~/code/main.c:255> @r{file, with line number}
818news:comp.emacs @r{Usenet link} 845<news:comp.emacs> @r{Usenet link}
819mailto:adent@@galaxy.net @r{Mail link} 846<mailto:adent@@galaxy.net> @r{Mail link}
820vm:folder @r{VM folder link} 847<vm:folder> @r{VM folder link}
821vm:folder#id @r{VM message link} 848<vm:folder#id> @r{VM message link}
822vm://myself@@some.where.org/folder#id @r{VM on remote machine} 849<vm://myself@@some.where.org/folder#id> @r{VM on remote machine}
823wl:folder @r{WANDERLUST folder link} 850<wl:folder> @r{WANDERLUST folder link}
824wl:folder#id @r{WANDERLUST message link} 851<wl:folder#id> @r{WANDERLUST message link}
825rmail:folder @r{RMAIL folder link} 852<rmail:folder> @r{RMAIL folder link}
826rmail:folder#id @r{RMAIL message link} 853<rmail:folder#id> @r{RMAIL message link}
827gnus:group @r{GNUS group link} 854<gnus:group> @r{GNUS group link}
828gnus:group#id @r{GNUS article link} 855<gnus:group#id> @r{GNUS article link}
829bbdb:Richard Stallman @r{BBDB link} 856<bbdb:Richard Stallman> @r{BBDB link}
830shell:ls *.org @r{A shell command} 857<shell:ls *.org>@footnote{Note that @samp{<} and @samp{>} cannot be part of a link, and therefore of a shell command. If you need redirection, use @@@{ and @@@} instead.} @r{A shell command}
831@end example 858@end example
832 859
833A link may contain space characters and is terminated by the end of 860A link may contain space characters and is terminated by @samp{>} or by
834the line or, in tables, by the end of the table field. Therefore, 861the end of a line. In tables, the end of a table field also terminates
835outside of tables there can be only one link per line (but see the 862a link. Angle brackets around a link are not required, but are
836variable @code{org-allow-space-in-links}). 863recommended to avoid problems with punctuation and other text following
864the link. See also the variable @code{org-allow-space-in-links}.
837 865
838@cindex storing links 866@cindex storing links
839@table @kbd 867@table @kbd
@@ -854,10 +882,11 @@ Insert a link. This prompts for a link to be inserted into the
854buffer. You can just type a link, using one of the link type prefixes 882buffer. You can just type a link, using one of the link type prefixes
855mentioned in the examples above. Through completion, all links stored 883mentioned in the examples above. Through completion, all links stored
856during the current session can be accessed. When called with prefix 884during the current session can be accessed. When called with prefix
857arg, you can use file name completion to enter a file link. Note that 885arg, you can use file name completion to enter a file link. The link
858you don't have to use this command to insert a link. Links in 886will be formatted as given in the variable @code{org-link-format} and
859Org-mode are plain text, and you can type or paste them straight into 887inserted into the buffer. Note that you don't have to use this
860the buffer. 888command to insert a link. Links in Org-mode are plain text, and you
889can type or paste them straight into the buffer.
861 890
862@cindex inserting links 891@cindex inserting links
863@kindex C-c C-o 892@kindex C-c C-o
@@ -930,9 +959,11 @@ cycling (@key{TAB}) to find a better place. Pressing @key{RET} or
930 Or use prefix arg to specify level manually. 959 Or use prefix arg to specify level manually.
931@end multitable 960@end multitable
932 961
933So the fastest way to store the note is to press @kbd{C-c C-c @key{RET} 962So a fast way to store the note is to press @kbd{C-c C-c @key{RET}
934@key{RET}} to append it to the default file. But with little extra 963@key{RET}} to append it to the default file. Even shorter would be
935effort, you can push it directly to the correct location. 964@kbd{C-u C-c C-c}, which does the same without even showing the tree.
965But with little extra effort, you can push it directly to the correct
966location.
936 967
937Before inserting the text into a tree, the function ensures that the 968Before inserting the text into a tree, the function ensures that the
938text has a headline, i.e. a first line that starts with a @samp{*}. 969text has a headline, i.e. a first line that starts with a @samp{*}.
@@ -1140,6 +1171,8 @@ agenda buffer with the @kbd{,} command (@pxref{Agenda commands}).
1140@itemx S-@key{down} 1171@itemx S-@key{down}
1141Increase/decrease priority of current item. Note that these keys are 1172Increase/decrease priority of current item. Note that these keys are
1142also used to modify time stamps (@pxref{Creating timestamps}). 1173also used to modify time stamps (@pxref{Creating timestamps}).
1174Furthermore, these keys is also used by CUA-mode
1175(@pxref{Interaction}).
1143@end table 1176@end table
1144 1177
1145 1178
@@ -1267,7 +1300,8 @@ Insert @samp{SCHEDULED} keyword along with a stamp.
1267@kindex S-@key{right} 1300@kindex S-@key{right}
1268@item S-@key{left} 1301@item S-@key{left}
1269@itemx S-@key{right} 1302@itemx S-@key{right}
1270Change date at cursor by one day. 1303Change date at cursor by one day. These key bindings conflict with
1304CUA-mode (@pxref{Interaction}).
1271 1305
1272@kindex S-@key{up} 1306@kindex S-@key{up}
1273@kindex S-@key{down} 1307@kindex S-@key{down}
@@ -1275,8 +1309,10 @@ Change date at cursor by one day.
1275@itemx S-@key{down} 1309@itemx S-@key{down}
1276Change the item under the cursor in a timestamp. The cursor can be on 1310Change the item under the cursor in a timestamp. The cursor can be on
1277a year, month, day, hour or minute. Note that if the cursor is not at 1311a year, month, day, hour or minute. Note that if the cursor is not at
1278a time stamp, these same keys modify the priority of an item 1312a time stamp, these same keys modify the priority of an item.
1279(@pxref{Priorities}). 1313(@pxref{Priorities}). These key bindings conflict with CUA-mode
1314(@pxref{Interaction}).
1315
1280 1316
1281@kindex C-c C-y 1317@kindex C-c C-y
1282@cindex evaluate time range 1318@cindex evaluate time range
@@ -1872,7 +1908,8 @@ letters, and press @kbd{M-@key{TAB}} to see possible completions.
1872 1908
1873@cindex tables, export to HTML 1909@cindex tables, export to HTML
1874@item 1910@item
1875Tables are transformed into HTML tables. 1911Tables are transformed into HTML tables. Data fields before the first
1912horizontal separator line will be formatted as table header fields.
1876 1913
1877@cindex fixed width 1914@cindex fixed width
1878@item 1915@item
@@ -1960,8 +1997,8 @@ Toggle the COMMENT keyword at the beginning of an entry.
1960* Customization:: Adapting Org-mode to your taste 1997* Customization:: Adapting Org-mode to your taste
1961* FAQ:: Frequently asked questions 1998* FAQ:: Frequently asked questions
1962* Interaction:: Other Emacs packages 1999* Interaction:: Other Emacs packages
1963* Acknowledgments:: These people provided feedback and more
1964* Bugs:: Things which do not work perfectly 2000* Bugs:: Things which do not work perfectly
2001* Acknowledgments:: These people provided feedback and more
1965@end menu 2002@end menu
1966 2003
1967@node Completion, Customization, Miscellaneous, Miscellaneous 2004@node Completion, Customization, Miscellaneous, Miscellaneous
@@ -2024,9 +2061,7 @@ file, but with different outline visibility. Is that possible?}@*
2024In GNU Emacs, you may use @emph{indirect buffers} which do exactly 2061In GNU Emacs, you may use @emph{indirect buffers} which do exactly
2025this. See the documentation on the command 2062this. See the documentation on the command
2026@code{make-indirect-buffer}. In XEmacs, this is currently not 2063@code{make-indirect-buffer}. In XEmacs, this is currently not
2027possible because of the different outline implementation., which visit 2064possible because of the different outline implementation.
2028the same file, but have separate settings, also for outline
2029visibility.
2030 2065
2031@item @b{Is there an easy way to insert links to web locations?}@* 2066@item @b{Is there an easy way to insert links to web locations?}@*
2032@cindex URL, paste into buffer 2067@cindex URL, paste into buffer
@@ -2060,12 +2095,17 @@ configure the @samp{H} switch.
2060If you want to export a subtree, mark the subtree as region and then 2095If you want to export a subtree, mark the subtree as region and then
2061export. Marking can be done with @kbd{C-c @@ C-x C-x}, for example. 2096export. Marking can be done with @kbd{C-c @@ C-x C-x}, for example.
2062 2097
2098@item @b{Org-mode takes over the S-cursor keys. I also want to use
2099CUA-mode, is there a way to fix this conflict?}@*
2100Yes, see @ref{Interaction}
2101
2063@item @b{Is there an easy way to insert an empty table template with a 2102@item @b{Is there an easy way to insert an empty table template with a
2064default number of rows and columns?}@* 2103default number of rows and columns?}@*
2065@cindex table, empty template 2104@cindex table, empty template
2066To insert an empty table template, just type @samp{|-} and use 2105To insert an empty table template, just type @samp{|-} and use
2067@key{TAB}. The default size can be changed with the variable 2106@key{TAB}. The default size can be changed with the variable
2068@code{org-table-default-size}. 2107@code{org-table-default-size}. However, just starting to type the
2108first line is usually much easier.
2069 2109
2070@item @b{When I am in the last column of a table and just above a 2110@item @b{When I am in the last column of a table and just above a
2071horizontal line in the table, pressing TAB creates a new table line 2111horizontal line in the table, pressing TAB creates a new table line
@@ -2082,7 +2122,7 @@ indentation of the first line and realign with @key{TAB}.
2082@end enumerate 2122@end enumerate
2083 2123
2084 2124
2085@node Interaction, Acknowledgments, FAQ, Miscellaneous 2125@node Interaction, Bugs, FAQ, Miscellaneous
2086@section Interaction with other packages 2126@section Interaction with other packages
2087@cindex packages, interaction with other 2127@cindex packages, interaction with other
2088@cindex @file{planner.el} 2128@cindex @file{planner.el}
@@ -2106,11 +2146,64 @@ planner.
2106@cindex @file{table.el} 2146@cindex @file{table.el}
2107@item @file{table.el} by Takaaki Ota 2147@item @file{table.el} by Takaaki Ota
2108Org mode cooperates with table.el, see @ref{table.el}. 2148Org mode cooperates with table.el, see @ref{table.el}.
2149@cindex @file{CUA.el}
2150@item @file{CUA.el} by Kim. F. Storm
2151Keybindings in Org-mode conflict with the @kbd{S-<cursor>} keys
2152used by CUA-mode (as well as pc-select-mode and s-region-mode) to
2153select and extend the region. If you want to use one of these
2154packages along with Org-mode, configure the variable
2155@code{org-CUA-compatible}. When set, Org-mode will move the folowing
2156keybindings in org-mode files, and in the agenda buffer (but not
2157during date selection).
2158@example
2159S-UP -> M-p S-DOWN -> M-n
2160S-LEFT -> M-- S-RIGHT -> M-+
2161S-RET -> C-S-RET
2162@end example
2163Yes, these are unfortunately more difficult to remember. If you want
2164to have other replacement keys, look at the variable
2165@code{org-disputed-keys}.
2166
2109@end table 2167@end table
2110 2168
2111@page @c FIXME 2169@node Bugs, Acknowledgments, Interaction, Miscellaneous
2170@section Bugs
2171@cindex bugs
2172
2173Here is a list of things which should work differently, but which I
2174have found too hard to fix.
2112 2175
2113@node Acknowledgments, Bugs, Interaction, Miscellaneous 2176@itemize @bullet
2177@item
2178If you call @code{fill-paragraph} (bound to @kbd{M-q}) in a table, the
2179filling is correctly disabled. However, if some text directly
2180(without an empty line in between) preceeds or follws a table, calling
2181@code{fill-paragraph} in that text will also fill the table like
2182normal text. Also, @code{fill-region} does bypass the
2183@code{fill-paragraph} code and will fill tables like normal text.
2184@item
2185When the application called by @kbd{C-c C-o} to open a file link fails
2186(for example because the application does not exits or refuses to open
2187the file), it does so silently. No error message is displayed.
2188@item
2189Under XEmacs, if Org-mode entries are included into the diary, it is
2190not possible to jump back from the diary to the org file. Apparently,
2191the text properties are lost when the fancy-diary-display is used.
2192However, from Org-mode's timeline and agenda buffers (created with
2193@kbd{C-c C-r} and @kbd{C-c a}), things do work correctly.
2194@item
2195Linux should also have a default viewer application, using mailcap.
2196Maybe we can use GNUS or VM mime code? Or dired's guessing commands?
2197Any hints (or even patches) are appreciated.
2198@item
2199When you write @samp{x = a /b/ c}, b will be exported in italics.
2200@item
2201The exporters work well, but could be made more efficient.
2202@end itemize
2203
2204@page
2205
2206@node Acknowledgments, , Bugs, Miscellaneous
2114@section Acknowledgments 2207@section Acknowledgments
2115@cindex acknowledgments 2208@cindex acknowledgments
2116 2209
@@ -2136,13 +2229,18 @@ his ideas have found their way into the agenda.
2136Philip Rooke created the Org-mode reference card. He also helped with 2229Philip Rooke created the Org-mode reference card. He also helped with
2137beta testing and contributed a number of very useful ideas. 2230beta testing and contributed a number of very useful ideas.
2138@item 2231@item
2232Christian Schlauer proposed angular brackets around links, and some
2233other useful stuff.
2234@item
2235David Wainberg suggested to implement an archiving mechanism.
2236@item
2139Linking to VM/BBDB/GNUS was inspired by Tom Shannon's 2237Linking to VM/BBDB/GNUS was inspired by Tom Shannon's
2140@file{organizer-mode.el}. 2238@file{organizer-mode.el}.
2141@item 2239@item
2142Scheduling TODO items was inspired by John Wiegley's @file{planner.el}. 2240Scheduling TODO items was inspired by John Wiegley's @file{planner.el}.
2143@item 2241@item
2144Sacha Chua, the current maintainer of Planner suggested to take some 2242Sacha Chua, the current maintainer of Planner, offered linking code
2145linking code from Planner, which I did (for RMAIL and Wanderlust). 2243from Planner. I made use of the offer for links to RMAIL and Wanderlust.
2146@item 2244@item
2147Oliver Oppitz sent several useful suggestions. 2245Oliver Oppitz sent several useful suggestions.
2148@item 2246@item
@@ -2150,38 +2248,13 @@ Carsten Wimmer suggested some changes and helped fix a bug in linking
2150to GNUS. 2248to GNUS.
2151@item 2249@item
2152Pavel Chalmoviansky reported bugs and suggested improvements related 2250Pavel Chalmoviansky reported bugs and suggested improvements related
2153to the agenda treatment of items with specifed time. 2251to the agenda treatment of items with specified time.
2154@item 2252@item
2155Stefan Monnier provided a patch with lots of little fixes to keep the 2253Stefan Monnier provided a patch with lots of little fixes to keep the
2156Emacs-Lisp compiler happy. 2254Emacs-Lisp compiler happy.
2157@end itemize 2255@item
2158 2256Kai Grossjohann pointed out that a number of key bindings in Org-mode
2159@node Bugs, , Acknowledgments, Miscellaneous 2257conflict with other packages.
2160@section Bugs
2161@cindex bugs
2162
2163Here is a list of things which should work differently, but which I
2164have found too hard to fix.
2165
2166@itemize @bullet
2167@item
2168When the application called by @kbd{C-c C-o} to open a file link fails
2169(for example because the application does not exits or refuses to open
2170the file), it does so silently. No error message is displayed.
2171@item
2172Under XEmacs, if Org-mode entries are included into the diary, it is
2173not possible to jump back from the diary to the org file. Apparently,
2174the text properties are lost when the fancy-diary-display is used.
2175However, from Org-mode's timeline and agenda buffers (created with
2176@kbd{C-c C-r} and @kbd{C-c a}), things do work correctly.
2177@item
2178Linux should also have a default viewer application, using mailcap.
2179Maybe we can use GNUS or VM mime code? Or dired's guessing commands?
2180Any hints (or even patches) are appreciated.
2181@item
2182When you write @samp{x = a /b/ c}, b will be exported in italics.
2183@item
2184The exporters work well, but could be made more efficient.
2185@end itemize 2258@end itemize
2186 2259
2187@node Index, Key Index, Miscellaneous, Top 2260@node Index, Key Index, Miscellaneous, Top
diff --git a/nt/ChangeLog b/nt/ChangeLog
index cfc93422a69..66e1ea15438 100644
--- a/nt/ChangeLog
+++ b/nt/ChangeLog
@@ -1,3 +1,35 @@
12005-06-11 Eli Zaretskii <eliz@gnu.org>
2
3 * configure.bat: If their fc.exe returns a meaningful exit status,
4 don't overwrite src/config.h and src/epaths.h with identical
5 copies.
6
7 * INSTALL: Warn about using "cvs up -kb" if one intends to commit
8 changes. Add a pointer to another site with detailed configure
9 and build instructions. Suggest to look at config.log when
10 configure fails. Add MinGW Make 3.80 to the list of successful
11 combinations.
12
13 * gmake.defs (ARCH_CFLAGS): Use $(MCPU_FLAG) instead of a literal
14 "-mcpu=i686".
15
16 * configure.bat: Update copyright years.
17 Delete config.log before doing anything else.
18 Write additional diagnostics to config.log in case of failures to
19 compile test programs, including the failed test program itself.
20 Add a test for support of -mtune=pentium4 switch to GCC; if it is
21 supported, set up MCPU_FLAG variable on the various Makefiles to
22 use that switch during compilations. (This avoids GCC warning
23 about -mcpu being deprecated.)
24
252005-06-10 Eli Zaretskii <eliz@gnu.org>
26
27 * addsection.c (copy_executable_and_add_section): Pass non-zero
28 `verbose' arg to COPY_CHUNK only if DEBUG_DUMP is defined in the
29 environment. Print section names with %.8s.
30 (COPY_CHUNK): New 4th arg `verbose'; print diagnostic messages
31 only if non-zero. All callers changed.
32
12005-06-05 Eli Zaretskii <eliz@gnu.org> 332005-06-05 Eli Zaretskii <eliz@gnu.org>
2 34
3 * inc/sys/socket.h: Change arg 4 of sys_setsockopt to 35 * inc/sys/socket.h: Change arg 4 of sys_setsockopt to
diff --git a/nt/INSTALL b/nt/INSTALL
index e133d65e0d3..214caf7dd80 100644
--- a/nt/INSTALL
+++ b/nt/INSTALL
@@ -15,10 +15,20 @@
15 (.bat files, nmake.defs and makefile.w32-in) may need the line-ends 15 (.bat files, nmake.defs and makefile.w32-in) may need the line-ends
16 fixing first. The easiest way to do this and avoid future conflicts 16 fixing first. The easiest way to do this and avoid future conflicts
17 is to run the following command in this (emacs/nt) directory: 17 is to run the following command in this (emacs/nt) directory:
18
18 cvs update -kb 19 cvs update -kb
20
21 (WARNING: Do NOT use this suggestion if you have write access to the
22 Emacs CVS tree and intend to commit changes to CVS. This is because -kb
23 is sticky: it will be used in all future CVS operations on the files you
24 check out like this.) Alternatively, use programs that convert
25 end-of-line format, such as dos2unix and unix2dos available from
26 GnuWin32 or dtou and utod from the DJGPP project.
27
19 In addition to this file, you should also read INSTALL.CVS in the 28 In addition to this file, you should also read INSTALL.CVS in the
20 parent directory, and make sure that you have a version of "touch.exe" 29 parent directory, and make sure that you have a version of
21 in your path, and that it will create files that do not yet exist. 30 "touch.exe" in your path, and that it will create files that do not
31 yet exist.
22 32
23 To compile Emacs, you will need either Microsoft Visual C++ 2.0 or 33 To compile Emacs, you will need either Microsoft Visual C++ 2.0 or
24 later and nmake, or a Windows port of GCC 2.95 or later with MinGW 34 later and nmake, or a Windows port of GCC 2.95 or later with MinGW
@@ -51,6 +61,10 @@
51 61
52 http://www.emacswiki.org/cgi-bin/wiki/WThirtyTwoInstallationKit 62 http://www.emacswiki.org/cgi-bin/wiki/WThirtyTwoInstallationKit
53 63
64 and at this URL:
65
66 http://ourcomments.org/Emacs/EmacsW32.html
67
54 For reference, here is a list of which builds of GNU make are known 68 For reference, here is a list of which builds of GNU make are known
55 to work or not, and whether they work in the presence and/or absence 69 to work or not, and whether they work in the presence and/or absence
56 of sh.exe, the Cygwin port of Bash. Note that any version of make 70 of sh.exe, the Cygwin port of Bash. Note that any version of make
@@ -77,6 +91,7 @@
77 cygwin compiled make 3.78.1: fails[5] fails[2, 5] 91 cygwin compiled make 3.78.1: fails[5] fails[2, 5]
78 cygwin compiled make 3.79.1: fails[3, 5] fails[2?, 5] 92 cygwin compiled make 3.79.1: fails[3, 5] fails[2?, 5]
79 mingw32 compiled make 3.79.1: okay okay 93 mingw32 compiled make 3.79.1: okay okay
94 mingw32 compiled make 3.80: okay unknown[6]
80 95
81 Notes: 96 Notes:
82 97
@@ -88,6 +103,7 @@
88 [4] may fail on Windows 9X and Windows ME; if so, install Bash. 103 [4] may fail on Windows 9X and Windows ME; if so, install Bash.
89 [5] fails when building leim due to the use of cygwin style paths. 104 [5] fails when building leim due to the use of cygwin style paths.
90 May work if building emacs without leim. 105 May work if building emacs without leim.
106 [6] please report if you try this combination.
91 107
92* Configuring 108* Configuring
93 109
@@ -105,6 +121,12 @@
105 is running, when gcc support is being tested. These cannot be 121 is running, when gcc support is being tested. These cannot be
106 surpressed because of limitations in the Windows 9x command.com shell. 122 surpressed because of limitations in the Windows 9x command.com shell.
107 123
124 You are encouraged to look at the file config.log which shows details
125 for failed tests, after configure.bat finishes. Any unexplained failure
126 should be investigated and perhaps reported as a bug (see the section
127 about reporting bugs in the file README in this directory and in the
128 Emacs manual).
129
108* Optional image library support 130* Optional image library support
109 131
110 In addition to its "native" image formats (pbm and xbm), Emacs can 132 In addition to its "native" image formats (pbm and xbm), Emacs can
@@ -114,7 +136,11 @@
114 configure script is run. This can be setup using environment 136 configure script is run. This can be setup using environment
115 variables, or by specifying --cflags -I... options on the command-line 137 variables, or by specifying --cflags -I... options on the command-line
116 to configure.bat. The configure script will report whether it was 138 to configure.bat. The configure script will report whether it was
117 able to detect the headers. 139 able to detect the headers. If the results of this testing appear to be
140 incorrect, please look for details in the file config.log: it will show
141 the failed test programs and compiler error messages that should explain
142 what is wrong. (Usually, any such failures happen because some headers
143 are missing due to bad packaging of the image support libraries.)
118 144
119 To use the external image support, the DLLs implementing the 145 To use the external image support, the DLLs implementing the
120 functionality must be found when Emacs first needs them, either on the 146 functionality must be found when Emacs first needs them, either on the
@@ -133,7 +159,9 @@
133 159
134 Binaries for the image libraries (among many others) can be found at 160 Binaries for the image libraries (among many others) can be found at
135 the GnuWin32 project. These are built with MinGW, but they can be 161 the GnuWin32 project. These are built with MinGW, but they can be
136 used with both GCC/MinGW and MSVC builds of Emacs. 162 used with both GCC/MinGW and MSVC builds of Emacs. See the info on
163 http://ourcomments.org/Emacs/EmacsW32.html for more details about
164 installing image support libraries.
137 165
138* Building 166* Building
139 167
@@ -187,6 +215,12 @@
187 addsection.c relies on. Versions of w32api-xxx.zip from at least 215 addsection.c relies on. Versions of w32api-xxx.zip from at least
188 1999-11-18 onwards are okay. 216 1999-11-18 onwards are okay.
189 217
218 When in doubt about correctness of what configure did, look at the file
219 config.log, which shows all the failed test programs and compiler
220 messages associated with the failures. If that doesn't give a clue,
221 please report the problems, together with the relevant fragments from
222 config.log, as bugs.
223
190 If configure succeeds, but make fails, install the Cygwin port of 224 If configure succeeds, but make fails, install the Cygwin port of
191 Bash, even if the table above indicates that Emacs should be able to 225 Bash, even if the table above indicates that Emacs should be able to
192 build without sh.exe. (Some versions of Windows shells are too dumb 226 build without sh.exe. (Some versions of Windows shells are too dumb
diff --git a/nt/addsection.c b/nt/addsection.c
index ae44c7f943c..8fbe8c38050 100644
--- a/nt/addsection.c
+++ b/nt/addsection.c
@@ -1,5 +1,5 @@
1/* Add an uninitialized data section to an executable. 1/* Add an uninitialized data section to an executable.
2 Copyright (C) 1999 Free Software Foundation, Inc. 2 Copyright (C) 1999, 2005 Free Software Foundation, Inc.
3 3
4This file is part of GNU Emacs. 4This file is part of GNU Emacs.
5 5
@@ -283,15 +283,19 @@ copy_executable_and_add_section (file_data *p_infile,
283 PIMAGE_SECTION_HEADER dst_section; 283 PIMAGE_SECTION_HEADER dst_section;
284 DWORD offset; 284 DWORD offset;
285 int i; 285 int i;
286 int be_verbose = GetEnvironmentVariable ("DEBUG_DUMP", NULL, 0) > 0;
286 287
287#define COPY_CHUNK(message, src, size) \ 288#define COPY_CHUNK(message, src, size, verbose) \
288 do { \ 289 do { \
289 unsigned char *s = (void *)(src); \ 290 unsigned char *s = (void *)(src); \
290 unsigned long count = (size); \ 291 unsigned long count = (size); \
291 printf ("%s\n", (message)); \ 292 if (verbose) \
292 printf ("\t0x%08x Offset in input file.\n", s - p_infile->file_base); \ 293 { \
293 printf ("\t0x%08x Offset in output file.\n", dst - p_outfile->file_base); \ 294 printf ("%s\n", (message)); \
294 printf ("\t0x%08x Size in bytes.\n", count); \ 295 printf ("\t0x%08x Offset in input file.\n", s - p_infile->file_base); \
296 printf ("\t0x%08x Offset in output file.\n", dst - p_outfile->file_base); \
297 printf ("\t0x%08x Size in bytes.\n", count); \
298 } \
295 memcpy (dst, s, count); \ 299 memcpy (dst, s, count); \
296 dst += count; \ 300 dst += count; \
297 } while (0) 301 } while (0)
@@ -321,13 +325,14 @@ copy_executable_and_add_section (file_data *p_infile,
321 dst = (unsigned char *) p_outfile->file_base; 325 dst = (unsigned char *) p_outfile->file_base;
322 326
323 COPY_CHUNK ("Copying DOS header...", dos_header, 327 COPY_CHUNK ("Copying DOS header...", dos_header,
324 (DWORD) nt_header - (DWORD) dos_header); 328 (DWORD) nt_header - (DWORD) dos_header, be_verbose);
325 dst_nt_header = (PIMAGE_NT_HEADERS) dst; 329 dst_nt_header = (PIMAGE_NT_HEADERS) dst;
326 COPY_CHUNK ("Copying NT header...", nt_header, 330 COPY_CHUNK ("Copying NT header...", nt_header,
327 (DWORD) section - (DWORD) nt_header); 331 (DWORD) section - (DWORD) nt_header, be_verbose);
328 dst_section = (PIMAGE_SECTION_HEADER) dst; 332 dst_section = (PIMAGE_SECTION_HEADER) dst;
329 COPY_CHUNK ("Copying section table...", section, 333 COPY_CHUNK ("Copying section table...", section,
330 nt_header->FileHeader.NumberOfSections * sizeof (*section)); 334 nt_header->FileHeader.NumberOfSections * sizeof (*section),
335 be_verbose);
331 336
332 /* To improve the efficiency of demand loading, make the file 337 /* To improve the efficiency of demand loading, make the file
333 alignment match the section alignment (VC++ 6.0 does this by 338 alignment match the section alignment (VC++ 6.0 does this by
@@ -351,7 +356,9 @@ copy_executable_and_add_section (file_data *p_infile,
351 for (i = 0; i < nt_header->FileHeader.NumberOfSections; i++) 356 for (i = 0; i < nt_header->FileHeader.NumberOfSections; i++)
352 { 357 {
353 char msg[100]; 358 char msg[100];
354 sprintf (msg, "Copying raw data for %s...", section->Name); 359 /* Windows section names are fixed 8-char strings, only
360 zero-terminated if the name is shorter than 8 characters. */
361 sprintf (msg, "Copying raw data for %.8s...", section->Name);
355 362
356 /* Update the file-relative offset for this section's raw data (if 363 /* Update the file-relative offset for this section's raw data (if
357 it has any) in case things have been relocated; we will update 364 it has any) in case things have been relocated; we will update
@@ -362,7 +369,7 @@ copy_executable_and_add_section (file_data *p_infile,
362 /* Can always copy the original raw data. */ 369 /* Can always copy the original raw data. */
363 COPY_CHUNK 370 COPY_CHUNK
364 (msg, OFFSET_TO_PTR (section->PointerToRawData, p_infile), 371 (msg, OFFSET_TO_PTR (section->PointerToRawData, p_infile),
365 section->SizeOfRawData); 372 section->SizeOfRawData, be_verbose);
366 373
367 /* Round up the raw data size to the new alignment. */ 374 /* Round up the raw data size to the new alignment. */
368 dst_section->SizeOfRawData = 375 dst_section->SizeOfRawData =
@@ -402,7 +409,7 @@ copy_executable_and_add_section (file_data *p_infile,
402 COPY_CHUNK 409 COPY_CHUNK
403 ("Copying remainder of executable...", 410 ("Copying remainder of executable...",
404 OFFSET_TO_PTR (offset, p_infile), 411 OFFSET_TO_PTR (offset, p_infile),
405 p_infile->size - offset); 412 p_infile->size - offset, be_verbose);
406 413
407 /* Final size for new image. */ 414 /* Final size for new image. */
408 p_outfile->size = DST_TO_OFFSET (); 415 p_outfile->size = DST_TO_OFFSET ();
diff --git a/nt/configure.bat b/nt/configure.bat
index 216420873c7..8433cacc317 100755
--- a/nt/configure.bat
+++ b/nt/configure.bat
@@ -1,7 +1,8 @@
1@echo off 1@echo off
2rem ---------------------------------------------------------------------- 2rem ----------------------------------------------------------------------
3rem Configuration script for MS Windows 95/98/Me and NT/2000/XP 3rem Configuration script for MS Windows 95/98/Me and NT/2000/XP
4rem Copyright (C) 1999-2003 Free Software Foundation, Inc. 4rem Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005
5rem Free Software Foundation, Inc.
5 6
6rem This file is part of GNU Emacs. 7rem This file is part of GNU Emacs.
7 8
@@ -47,6 +48,8 @@ rem [3] requires LC_MESSAGES support to build; maybe 2.95.x update to
47rem cygwin provides this? 48rem cygwin provides this?
48rem 49rem
49 50
51if exist config.log del config.log
52
50rem ---------------------------------------------------------------------- 53rem ----------------------------------------------------------------------
51rem See if the environment is large enough. We need 43 (?) bytes. 54rem See if the environment is large enough. We need 43 (?) bytes.
52set $foo$=123456789_123456789_123456789_123456789_123 55set $foo$=123456789_123456789_123456789_123456789_123
@@ -236,13 +239,17 @@ if (%nocygwin%) == (Y) goto chkapi
236echo Checking whether gcc requires '-mno-cygwin'... 239echo Checking whether gcc requires '-mno-cygwin'...
237echo #include "cygwin/version.h" >junk.c 240echo #include "cygwin/version.h" >junk.c
238echo main(){} >>junk.c 241echo main(){} >>junk.c
239gcc -c junk.c 242echo gcc -c junk.c >>config.log
243gcc -c junk.c >>config.log 2>&1
240if not exist junk.o goto chkapi 244if not exist junk.o goto chkapi
241gcc -mno-cygwin -c junk.c 245echo gcc -mno-cygwin -c junk.c >>config.log
246gcc -mno-cygwin -c junk.c >>config.log 2>&1
242if exist junk.o set nocygwin=Y 247if exist junk.o set nocygwin=Y
243rm -f junk.c junk.o 248rm -f junk.c junk.o
244 249
245:chkapi 250:chkapi
251echo The failed program was: >>config.log
252type junk.c >>config.log
246rem ---------------------------------------------------------------------- 253rem ----------------------------------------------------------------------
247rem Older versions of the Windows API headers either don't have any of 254rem Older versions of the Windows API headers either don't have any of
248rem the IMAGE_xxx definitions (the headers that come with Cygwin b20.1 255rem the IMAGE_xxx definitions (the headers that come with Cygwin b20.1
@@ -263,9 +270,13 @@ set cf=%usercflags% -mno-cygwin
263:chkapi2 270:chkapi2
264echo on 271echo on
265gcc %cf% -c junk.c 272gcc %cf% -c junk.c
266echo off 273@echo off
274@echo gcc %cf% -c junk.c >>config.log
275gcc %cf% -c junk.c >>config.log 2>&1
267set cf= 276set cf=
268if exist junk.o goto gccOk 277if exist junk.o goto gccOk
278echo The failed program was: >>config.log
279type junk.c >>config.log
269 280
270:nocompiler 281:nocompiler
271echo. 282echo.
@@ -278,8 +289,23 @@ goto end
278 289
279:gccOk 290:gccOk
280set COMPILER=gcc 291set COMPILER=gcc
281rm -f junk.c junk.o
282echo Using 'gcc' 292echo Using 'gcc'
293rm -f junk.c junk.o
294Rem It is not clear what GCC version began supporting -mtune
295Rem and pentium4 on x86, so check this explicitly.
296echo main(){} >junk.c
297echo gcc -c -O2 -mtune=pentium4 junk.c >>config.log
298gcc -c -O2 -mtune=pentium4 junk.c >>config.log 2>&1
299if not errorlevel 1 goto gccMtuneOk
300echo The failed program was: >>config.log
301type junk.c >>config.log
302set mf=-mcpu=i686
303rm -f junk.c junk.o
304goto compilercheckdone
305:gccMtuneOk
306echo GCC supports -mtune=pentium4 >>config.log
307set mf=-mtune=pentium4
308rm -f junk.c junk.o
283goto compilercheckdone 309goto compilercheckdone
284 310
285:clOk 311:clOk
@@ -307,10 +333,13 @@ echo Checking for libpng...
307echo #include "png.h" >junk.c 333echo #include "png.h" >junk.c
308echo main (){} >>junk.c 334echo main (){} >>junk.c
309rem -o option is ignored with cl, but allows result to be consistent. 335rem -o option is ignored with cl, but allows result to be consistent.
310%COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >junk.out 2>junk.err 336echo %COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >>config.log
337%COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >junk.out 2>>config.log
311if exist junk.obj goto havePng 338if exist junk.obj goto havePng
312 339
313echo ...png.h not found, building without PNG support. 340echo ...png.h not found, building without PNG support.
341echo The failed program was: >>config.log
342type junk.c >>config.log
314set HAVE_PNG= 343set HAVE_PNG=
315goto :pngDone 344goto :pngDone
316 345
@@ -327,10 +356,13 @@ echo Checking for jpeg-6b...
327echo #include "jconfig.h" >junk.c 356echo #include "jconfig.h" >junk.c
328echo main (){} >>junk.c 357echo main (){} >>junk.c
329rem -o option is ignored with cl, but allows result to be consistent. 358rem -o option is ignored with cl, but allows result to be consistent.
330%COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >junk.out 2>junk.err 359echo %COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >>config.log
360%COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >junk.out 2>>config.log
331if exist junk.obj goto haveJpeg 361if exist junk.obj goto haveJpeg
332 362
333echo ...jconfig.h not found, building without JPEG support. 363echo ...jconfig.h not found, building without JPEG support.
364echo The failed program was: >>config.log
365type junk.c >>config.log
334set HAVE_JPEG= 366set HAVE_JPEG=
335goto :jpegDone 367goto :jpegDone
336 368
@@ -347,10 +379,13 @@ echo Checking for libgif...
347echo #include "gif_lib.h" >junk.c 379echo #include "gif_lib.h" >junk.c
348echo main (){} >>junk.c 380echo main (){} >>junk.c
349rem -o option is ignored with cl, but allows result to be consistent. 381rem -o option is ignored with cl, but allows result to be consistent.
350%COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >junk.out 2>junk.err 382echo %COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >>config.log
383%COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >junk.out 2>>config.log
351if exist junk.obj goto haveGif 384if exist junk.obj goto haveGif
352 385
353echo ...gif_lib.h not found, building without GIF support. 386echo ...gif_lib.h not found, building without GIF support.
387echo The failed program was: >>config.log
388type junk.c >>config.log
354set HAVE_GIF= 389set HAVE_GIF=
355goto :gifDone 390goto :gifDone
356 391
@@ -367,10 +402,13 @@ echo Checking for tiff...
367echo #include "tiffio.h" >junk.c 402echo #include "tiffio.h" >junk.c
368echo main (){} >>junk.c 403echo main (){} >>junk.c
369rem -o option is ignored with cl, but allows result to be consistent. 404rem -o option is ignored with cl, but allows result to be consistent.
370%COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >junk.out 2>junk.err 405echo %COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >>config.log
406%COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >junk.out 2>>config.log
371if exist junk.obj goto haveTiff 407if exist junk.obj goto haveTiff
372 408
373echo ...tiffio.h not found, building without TIFF support. 409echo ...tiffio.h not found, building without TIFF support.
410echo The failed program was: >>config.log
411type junk.c >>config.log
374set HAVE_TIFF= 412set HAVE_TIFF=
375goto :tiffDone 413goto :tiffDone
376 414
@@ -388,10 +426,13 @@ echo #define FOR_MSW 1 >junk.c
388echo #include "X11/xpm.h" >>junk.c 426echo #include "X11/xpm.h" >>junk.c
389echo main (){} >>junk.c 427echo main (){} >>junk.c
390rem -o option is ignored with cl, but allows result to be consistent. 428rem -o option is ignored with cl, but allows result to be consistent.
391%COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >junk.out 2>junk.err 429echo %COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >>config.log
430%COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >junk.out 2>>config.log
392if exist junk.obj goto haveXpm 431if exist junk.obj goto haveXpm
393 432
394echo ...X11/xpm.h not found, building without XPM support. 433echo ...X11/xpm.h not found, building without XPM support.
434echo The failed program was: >>config.log
435type junk.c >>config.log
395set HAVE_XPM= 436set HAVE_XPM=
396goto :xpmDone 437goto :xpmDone
397 438
@@ -414,6 +455,7 @@ rem except when there is a preceding digit, when a space is required.
414rem 455rem
415echo # Start of settings from configure.bat >config.settings 456echo # Start of settings from configure.bat >config.settings
416echo COMPILER=%COMPILER%>>config.settings 457echo COMPILER=%COMPILER%>>config.settings
458if not "(%mf%)" == "()" echo MCPU_FLAG=%mf%>>config.settings
417if (%nodebug%) == (Y) echo NODEBUG=1 >>config.settings 459if (%nodebug%) == (Y) echo NODEBUG=1 >>config.settings
418if (%noopt%) == (Y) echo NOOPT=1 >>config.settings 460if (%noopt%) == (Y) echo NOOPT=1 >>config.settings
419if (%nocygwin%) == (Y) echo NOCYGWIN=1 >>config.settings 461if (%nocygwin%) == (Y) echo NOCYGWIN=1 >>config.settings
@@ -423,20 +465,34 @@ if not "(%userldflags%)" == "()" echo USER_LDFLAGS=%userldflags%>>config.setting
423echo # End of settings from configure.bat>>config.settings 465echo # End of settings from configure.bat>>config.settings
424echo. >>config.settings 466echo. >>config.settings
425 467
426copy config.nt ..\src\config.h 468copy config.nt config.tmp
427echo. >>..\src\config.h 469echo. >>config.tmp
428echo /* Start of settings from configure.bat. */ >>..\src\config.h 470echo /* Start of settings from configure.bat. */ >>config.tmp
429if not "(%usercflags%)" == "()" echo #define USER_CFLAGS " %usercflags%">>..\src\config.h 471if not "(%usercflags%)" == "()" echo #define USER_CFLAGS " %usercflags%">>config.tmp
430if not "(%userldflags%)" == "()" echo #define USER_LDFLAGS " %userldflags%">>..\src\config.h 472if not "(%userldflags%)" == "()" echo #define USER_LDFLAGS " %userldflags%">>config.tmp
431if not "(%HAVE_PNG%)" == "()" echo #define HAVE_PNG 1 >>..\src\config.h 473if not "(%HAVE_PNG%)" == "()" echo #define HAVE_PNG 1 >>config.tmp
432if not "(%HAVE_JPEG%)" == "()" echo #define HAVE_JPEG 1 >>..\src\config.h 474if not "(%HAVE_JPEG%)" == "()" echo #define HAVE_JPEG 1 >>config.tmp
433if not "(%HAVE_GIF%)" == "()" echo #define HAVE_GIF 1 >>..\src\config.h 475if not "(%HAVE_GIF%)" == "()" echo #define HAVE_GIF 1 >>config.tmp
434if not "(%HAVE_TIFF%)" == "()" echo #define HAVE_TIFF 1 >>..\src\config.h 476if not "(%HAVE_TIFF%)" == "()" echo #define HAVE_TIFF 1 >>config.tmp
435if not "(%HAVE_XPM%)" == "()" echo #define HAVE_XPM 1 >>..\src\config.h 477if not "(%HAVE_XPM%)" == "()" echo #define HAVE_XPM 1 >>config.tmp
436echo /* End of settings from configure.bat. */ >>..\src\config.h 478echo /* End of settings from configure.bat. */ >>config.tmp
437 479
480Rem See if fc.exe returns a meaningful exit status. If it does, we
481Rem might as well avoid unnecessary overwriting of config.h and epaths.h,
482Rem since this forces recompilation of every source file.
483if exist foo.bar del foo.bar
484fc /b foo.bar foo.bar >nul 2>&1
485if not errorlevel 2 goto doCopy
486fc /b config.tmp ..\src\config.h >nul 2>&1
487if errorlevel 1 goto doCopy
488fc /b paths.h ..\src\epaths.h >nul 2>&1
489if errorlevel 0 goto dontCopy
490:doCopy
491copy config.tmp ..\src\config.h
438copy paths.h ..\src\epaths.h 492copy paths.h ..\src\epaths.h
439 493
494:dontCopy
495if exist config.tmp del config.tmp
440copy /b config.settings+%MAKECMD%.defs+..\nt\makefile.w32-in ..\nt\makefile 496copy /b config.settings+%MAKECMD%.defs+..\nt\makefile.w32-in ..\nt\makefile
441copy /b config.settings+%MAKECMD%.defs+..\lib-src\makefile.w32-in ..\lib-src\makefile 497copy /b config.settings+%MAKECMD%.defs+..\lib-src\makefile.w32-in ..\lib-src\makefile
442copy /b config.settings+%MAKECMD%.defs+..\src\makefile.w32-in ..\src\makefile 498copy /b config.settings+%MAKECMD%.defs+..\src\makefile.w32-in ..\src\makefile
@@ -474,6 +530,7 @@ set MAKECMD=
474set usercflags= 530set usercflags=
475set userldflags= 531set userldflags=
476set mingwflag= 532set mingwflag=
533set mf=
477 534
478goto skipArchTag 535goto skipArchTag
479 arch-tag: 300d20a4-1675-4e75-b615-7ce1a8c5376c 536 arch-tag: 300d20a4-1675-4e75-b615-7ce1a8c5376c
diff --git a/nt/gmake.defs b/nt/gmake.defs
index bd201cd3314..23d3dac3719 100644
--- a/nt/gmake.defs
+++ b/nt/gmake.defs
@@ -253,7 +253,7 @@ ifeq "$(ARCH)" "i386"
253ifdef NOOPT 253ifdef NOOPT
254ARCH_CFLAGS = -D_X86_=1 -c $(DEBUG_FLAG) $(NOCYGWIN) 254ARCH_CFLAGS = -D_X86_=1 -c $(DEBUG_FLAG) $(NOCYGWIN)
255else 255else
256ARCH_CFLAGS = -D_X86_=1 -c $(DEBUG_FLAG) $(NOCYGWIN) -mcpu=i686 -O2 \ 256ARCH_CFLAGS = -D_X86_=1 -c $(DEBUG_FLAG) $(NOCYGWIN) $(MCPU_FLAG) -O2 \
257 # -fbuiltin \ 257 # -fbuiltin \
258 # -finline-functions \ 258 # -finline-functions \
259 # -fomit-frame-pointer 259 # -fomit-frame-pointer
diff --git a/src/ChangeLog b/src/ChangeLog
index 8736a6f156a..c38032b163a 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,130 @@
12005-06-15 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
2
3 * macterm.c (mac_compute_glyph_string_overhangs): Don't set
4 overhangs unless the given glyph type is noncomposite CHAR_GLYPH.
5 [USE_CARBON_EVENTS] (mac_convert_event_ref): Convert dead key down
6 events.
7 (XTread_socket): Don't pass keyboard events with the option
8 modifier to the system when Vmac_command_key_is_meta is nil or
9 Vmac_option_modifier is non-nil.
10 [USE_CARBON_EVENTS] (read_socket_inev): New variable.
11 [USE_CARBON_EVENTS] (init_command_handler): Fix argument.
12 [USE_CARBON_EVENTS] (mac_handle_mouse_event): New Carbon event
13 handler function.
14 (install_window_handler) [USE_CARBON_EVENTS]: Install it.
15 (XTread_socket) [USE_CARBON_EVENTS]: Move mouse wheel event
16 handler part to mac_handle_mouse_event.
17
182005-06-14 Juanma Barranquero <lekktu@gmail.com>
19
20 * eval.c (Fdefvaralias): Rename arguments SYMBOL and ALIASED to
21 NEW-ALIAS and BASE-VARIABLE, respectively.
22
232005-06-13 Stefan Monnier <monnier@iro.umontreal.ca>
24
25 * xdisp.c (note_mode_line_or_margin_highlight): Lisp_Object/int mixup.
26 (get_phys_cursor_geometry, format_mode_line_unwind_data)
27 (get_line_height_property, x_produce_glyphs): Remove unused vars.
28
29 * coding.c (run_pre_post_conversion_on_str): Remove unused var `buf'.
30
312005-06-13 Eli Zaretskii <eliz@gnu.org>
32
33 * w32term.c (x_use_underline_position_properties): New variable.
34 (x_draw_glyph_string): Remind in a comment to change doc string of
35 x-use-underline-position-properties if/when underline positioning
36 is implemented.
37 (syms_of_w32term): DEFVAR_BOOL x-use-underline-position-properties,
38 and initialize it to nil.
39
402005-06-12 Jason Rumney <jasonr@gnu.org>
41
42 * w32fns.c (NEWOPENFILENAME): New struct.
43 (Fx_file_dialog): Use it to trick the system into giving us up to
44 date dialogs on systems that are documented to support it.
45 Do not set OFN_FILEMUSTEXIST flag if looking for a directory.
46
472005-06-12 Eli Zaretskii <eliz@gnu.org>
48
49 * w32fns.c (w32_abort): Use the MB_YESNO dialog instead of
50 MB_ABORTRETRYIGNORE. Never return, even if DebugBreak does.
51
522005-06-11 Eli Zaretskii <eliz@gnu.org>
53
54 * image.c (x_create_x_image_and_pixmap) [HAVE_NTGUI]: Cast 4th arg
55 to CreateDIBSection to avoid a compiler warning.
56 (pbm_load): Cast 3rd arg to IMAGE_BACKGROUND to avoid a compiler
57 warning.
58 (png_load): Cast return values of fn_png_create_read_struct and
59 fn_png_create_info_struct, to avoid compiler warnings on W32.
60 Cast 3rd arg to IMAGE_BACKGROUND and image_background_transparent
61 to avoid compiler warnings.
62 (jpeg_load): Cast return value of fn_jpeg_std_error to avoid a
63 compiler warning on W32. Cast 3rd arg to IMAGE_BACKGROUND to
64 avoid a compiler warning.
65 (tiff_load): Cast return values of fn_TIFFOpen and
66 fn_TIFFClientOpen to avoid compiler warning on W32. Cast 3rd arg
67 to IMAGE_BACKGROUND to avoid a compiler warning.
68 (gif_load): Cast return values of fn_DGifOpenFileName and
69 fn_DGifOpen to avoid compiler warnings on W32. Cast 3rd arg to
70 IMAGE_BACKGROUND to avoid a compiler warning.
71 (DrawText) [HAVE_NTGUI || MAC_OS]: If already defined, undef
72 before redefining.
73
74 * w32bdf.c (create_offscreen_bitmap): Cast `bitsp' to `void **' in
75 the call to CreateDIBSection, to avoid a compiler warning.
76
772005-06-11 Jason Rumney <jasonr@gnu.org>
78
79 * w32fns.c (Fx_file_dialog): Unblock input before falling back to
80 minibuffer.
81 * macfns.c (Fx_file_dialog): Likewise.
82
832005-06-10 Eli Zaretskii <eliz@gnu.org>
84
85 * makefile.w32-in ($(TEMACS)): Depend on addsection.exe.
86
872005-06-10 Juanma Barranquero <lekktu@gmail.com>
88
89 * process.c (syms_of_process) [ADAPTIVE_READ_BUFFERING]:
90 * w32fns.c (syms_of_w32fns): Fix spellings.
91
922005-06-10 Eli Zaretskii <eliz@gnu.org>
93
94 * unexw32.c (COPY_CHUNK, COPY_PROC_CHUNK): Add a new argument
95 `verbose'; print diagnostic messages only if it is non-zero.
96 All callers changed to pass a zero value unless DEBUG_DUMP is defined
97 in the environment.
98 (copy_executable_and_dump_data): Print section names with %.8s.
99
1002005-06-10 Masatake YAMATO <jet@gyve.org>
101
102 * xdisp.c (note_mode_line_or_margin_highlight): Call clear_mouse_face
103 when mouse_face is not given.
104 Remove unnecessary tabs.
105
1062005-06-09 Luc Teirlinck <teirllm@auburn.edu>
107
108 * window.c (Fselect_window): Adapt call to Fselect_frame.
109
110 * lisp.h: Update EXFUN of Fselect_frame.
111
112 * keyboard.c (command_loop_1): Adapt call to Fselect_frame.
113
114 * frame.c (Fhandle_switch_frame, Fselect_frame): Delete unused arg
115 no_enter.
116 (Fset_mouse_position, Fset_mouse_pixel_position, Ficonify_frame):
117 Adapt to above change.
118
1192005-06-10 Juanma Barranquero <lekktu@gmail.com>
120
121 * fns.c (Fmemq, Fmaphash): Doc fixes.
122
1232005-06-09 Juanma Barranquero <lekktu@gmail.com>
124
125 * xfaces.c (Fdisplay_supports_face_attributes_p):
126 Fix typo in docstring.
127
12005-06-08 Steven Tamm <steventamm@mac.com> 1282005-06-08 Steven Tamm <steventamm@mac.com>
2 129
3 * unexmacosx.c (copy_data_segment): Copy __la_sym_ptr2 section 130 * unexmacosx.c (copy_data_segment): Copy __la_sym_ptr2 section
@@ -40,8 +167,8 @@
40 167
412005-06-07 Masatake YAMATO <jet@gyve.org> 1682005-06-07 Masatake YAMATO <jet@gyve.org>
42 169
43 * xdisp.c (note_mode_line_or_margin_highlight): Check 170 * xdisp.c (note_mode_line_or_margin_highlight):
44 the overlapping of re-rendering area to avoid flickering. 171 Check the overlapping of re-rendering area to avoid flickering.
45 (note_mouse_highlight): Call clear_mouse_face if PART 172 (note_mouse_highlight): Call clear_mouse_face if PART
46 is not ON_MODE_LINE nor ON_HEADER_LINE. 173 is not ON_MODE_LINE nor ON_HEADER_LINE.
47 174
@@ -56,21 +183,21 @@
56 183
572005-06-06 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> 1842005-06-06 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
58 185
59 * macmenu.c (menu_quit_handler, install_menu_quit_handler): New 186 * macmenu.c (menu_quit_handler, install_menu_quit_handler):
60 functions for popping down menus on C-g. 187 New functions for popping down menus on C-g.
61 (set_frame_menubar, mac_menu_show): Call install_menu_quit_handler. 188 (set_frame_menubar, mac_menu_show): Call install_menu_quit_handler.
62 189
63 * macterm.c: Make mac_quit_char_modifiers and mac_quit_char_keycode 190 * macterm.c: Make mac_quit_char_modifiers and mac_quit_char_keycode
64 non-static. 191 non-static.
65 192
66 * config.in: Added HAVE_CANCELMENUTRACKING 193 * config.in: Add HAVE_CANCELMENUTRACKING.
67 194
682005-06-06 Eli Zaretskii <eliz@gnu.org> 1952005-06-06 Eli Zaretskii <eliz@gnu.org>
69 196
70 * w32heap.h (OFFSET_TO_RVA, RVA_TO_OFFSET, RVA_TO_PTR): Remove 197 * w32heap.h (OFFSET_TO_RVA, RVA_TO_OFFSET, RVA_TO_PTR):
71 macros. 198 Remove macros.
72 199
73 * unexw32.c (RVA_TO_PTR): Moved here from w32heap.h. 200 * unexw32.c (RVA_TO_PTR): Move here from w32heap.h.
74 201
75 * w32proc.c (RVA_TO_PTR): New macro. 202 * w32proc.c (RVA_TO_PTR): New macro.
76 203
@@ -194,11 +321,11 @@
194 (format_mode_line_unwind_data, unwind_format_mode_line): 321 (format_mode_line_unwind_data, unwind_format_mode_line):
195 New functions for unwind protection in mode line formatting. 322 New functions for unwind protection in mode line formatting.
196 (x_consider_frame_title): Use them and new local var 'title_start' 323 (x_consider_frame_title): Use them and new local var 'title_start'
197 to support nested calls to format-mode-line and redisplay. Set 324 to support nested calls to format-mode-line and redisplay.
198 mode_line_target to MODE_LINE_TITLE. 325 Set mode_line_target to MODE_LINE_TITLE.
199 (Fformat_mode_line): Use them and new local var 'string_start' to 326 (Fformat_mode_line): Use them and new local var 'string_start' to
200 support nested calls to format-mode-line and redisplay. Set 327 support nested calls to format-mode-line and redisplay.
201 mode_line_target to MODE_LINE_NOPROP or MODE_LINE_STRING. 328 Set mode_line_target to MODE_LINE_NOPROP or MODE_LINE_STRING.
202 Don't trim trailing dashes. 329 Don't trim trailing dashes.
203 (decode_mode_spec): Don't make infinite number of trailing dashes 330 (decode_mode_spec): Don't make infinite number of trailing dashes
204 for MODE_LINE_NOPROP and MODE_LINE_STRING targets. 331 for MODE_LINE_NOPROP and MODE_LINE_STRING targets.
@@ -12989,9 +13116,9 @@
12989 * sound.c: Added a partial implementation of play-sound-internal 13116 * sound.c: Added a partial implementation of play-sound-internal
12990 for Microsoft Windows. Added various #ifdef / #else / #endif 13117 for Microsoft Windows. Added various #ifdef / #else / #endif
12991 code blocks to separate the code that will compile under 13118 code blocks to separate the code that will compile under
12992 Microsoft Windows from the code that is specific to Gnu/Linux. 13119 Microsoft Windows from the code that is specific to GNU/Linux.
12993 Moved several blocks of code around to make this separation of code 13120 Moved several blocks of code around to make this separation of code
12994 into Windows compatible and Gnu/Linux compatible code blocks easier. 13121 into Windows compatible and GNU/Linux compatible code blocks easier.
12995 13122
12996 * makefile.w32-in: Include sound.c and link with WinMM.lib. 13123 * makefile.w32-in: Include sound.c and link with WinMM.lib.
12997 13124
diff --git a/src/eval.c b/src/eval.c
index 46affcac418..445eb283114 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -722,35 +722,36 @@ usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */)
722 722
723 723
724DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0, 724DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0,
725 doc: /* Make SYMBOL a variable alias for symbol ALIASED. 725 doc: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE.
726Setting the value of SYMBOL will subsequently set the value of ALIASED, 726Setting the value of NEW-ALIAS will subsequently set the value of BASE-VARIABLE,
727and getting the value of SYMBOL will return the value ALIASED has. 727 and getting the value of NEW-ALIAS will return the value BASE-VARIABLE has.
728Third arg DOCSTRING, if non-nil, is documentation for SYMBOL. If it is 728Third arg DOCSTRING, if non-nil, is documentation for NEW-ALIAS. If it is
729omitted or nil, SYMBOL gets the documentation string of ALIASED, or of the 729 omitted or nil, NEW-ALIAS gets the documentation string of BASE-VARIABLE,
730variable at the end of the chain of aliases, if ALIASED is itself an alias. 730 or of the variable at the end of the chain of aliases, if BASE-VARIABLE is
731The return value is ALIASED. */) 731 itself an alias.
732 (symbol, aliased, docstring) 732The return value is BASE-VARIABLE. */)
733 Lisp_Object symbol, aliased, docstring; 733 (new_alias, base_variable, docstring)
734 Lisp_Object new_alias, base_variable, docstring;
734{ 735{
735 struct Lisp_Symbol *sym; 736 struct Lisp_Symbol *sym;
736 737
737 CHECK_SYMBOL (symbol); 738 CHECK_SYMBOL (new_alias);
738 CHECK_SYMBOL (aliased); 739 CHECK_SYMBOL (base_variable);
739 740
740 if (SYMBOL_CONSTANT_P (symbol)) 741 if (SYMBOL_CONSTANT_P (new_alias))
741 error ("Cannot make a constant an alias"); 742 error ("Cannot make a constant an alias");
742 743
743 sym = XSYMBOL (symbol); 744 sym = XSYMBOL (new_alias);
744 sym->indirect_variable = 1; 745 sym->indirect_variable = 1;
745 sym->value = aliased; 746 sym->value = base_variable;
746 sym->constant = SYMBOL_CONSTANT_P (aliased); 747 sym->constant = SYMBOL_CONSTANT_P (base_variable);
747 LOADHIST_ATTACH (symbol); 748 LOADHIST_ATTACH (new_alias);
748 if (!NILP (docstring)) 749 if (!NILP (docstring))
749 Fput (symbol, Qvariable_documentation, docstring); 750 Fput (new_alias, Qvariable_documentation, docstring);
750 else 751 else
751 Fput (symbol, Qvariable_documentation, Qnil); 752 Fput (new_alias, Qvariable_documentation, Qnil);
752 753
753 return aliased; 754 return base_variable;
754} 755}
755 756
756 757
diff --git a/src/fns.c b/src/fns.c
index d8018216bd8..7b33b031282 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -1390,7 +1390,7 @@ The value is actually the tail of LIST whose car is ELT. */)
1390 1390
1391DEFUN ("memq", Fmemq, Smemq, 2, 2, 0, 1391DEFUN ("memq", Fmemq, Smemq, 2, 2, 0,
1392 doc: /* Return non-nil if ELT is an element of LIST. 1392 doc: /* Return non-nil if ELT is an element of LIST.
1393Comparison done with EQ. The value is actually the tail of LIST 1393Comparison done with `eq'. The value is actually the tail of LIST
1394whose car is ELT. */) 1394whose car is ELT. */)
1395 (elt, list) 1395 (elt, list)
1396 Lisp_Object elt, list; 1396 Lisp_Object elt, list;
@@ -4845,7 +4845,7 @@ DEFUN ("remhash", Fremhash, Sremhash, 2, 2, 0,
4845 4845
4846DEFUN ("maphash", Fmaphash, Smaphash, 2, 2, 0, 4846DEFUN ("maphash", Fmaphash, Smaphash, 2, 2, 0,
4847 doc: /* Call FUNCTION for all entries in hash table TABLE. 4847 doc: /* Call FUNCTION for all entries in hash table TABLE.
4848FUNCTION is called with 2 arguments KEY and VALUE. */) 4848FUNCTION is called with two arguments, KEY and VALUE. */)
4849 (function, table) 4849 (function, table)
4850 Lisp_Object function, table; 4850 Lisp_Object function, table;
4851{ 4851{
diff --git a/src/frame.c b/src/frame.c
index 1a84072b40b..204a31fa050 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -729,7 +729,7 @@ do_switch_frame (frame, track, for_deletion)
729 return frame; 729 return frame;
730} 730}
731 731
732DEFUN ("select-frame", Fselect_frame, Sselect_frame, 1, 2, "e", 732DEFUN ("select-frame", Fselect_frame, Sselect_frame, 1, 1, "e",
733 doc: /* Select the frame FRAME. 733 doc: /* Select the frame FRAME.
734Subsequent editing commands apply to its selected window. 734Subsequent editing commands apply to its selected window.
735The selection of FRAME lasts until the next time the user does 735The selection of FRAME lasts until the next time the user does
@@ -740,14 +740,14 @@ the command loop, because it still may have the window system's input
740focus. On a text-only terminal, the next redisplay will display FRAME. 740focus. On a text-only terminal, the next redisplay will display FRAME.
741 741
742This function returns FRAME, or nil if FRAME has been deleted. */) 742This function returns FRAME, or nil if FRAME has been deleted. */)
743 (frame, no_enter) 743 (frame)
744 Lisp_Object frame, no_enter; 744 Lisp_Object frame;
745{ 745{
746 return do_switch_frame (frame, 1, 0); 746 return do_switch_frame (frame, 1, 0);
747} 747}
748 748
749 749
750DEFUN ("handle-switch-frame", Fhandle_switch_frame, Shandle_switch_frame, 1, 2, "e", 750DEFUN ("handle-switch-frame", Fhandle_switch_frame, Shandle_switch_frame, 1, 1, "e",
751 doc: /* Handle a switch-frame event EVENT. 751 doc: /* Handle a switch-frame event EVENT.
752Switch-frame events are usually bound to this function. 752Switch-frame events are usually bound to this function.
753A switch-frame event tells Emacs that the window manager has requested 753A switch-frame event tells Emacs that the window manager has requested
@@ -756,8 +756,8 @@ This function selects the selected window of the frame of EVENT.
756 756
757If EVENT is frame object, handle it as if it were a switch-frame event 757If EVENT is frame object, handle it as if it were a switch-frame event
758to that frame. */) 758to that frame. */)
759 (event, no_enter) 759 (event)
760 Lisp_Object event, no_enter; 760 Lisp_Object event;
761{ 761{
762 /* Preserve prefix arg that the command loop just cleared. */ 762 /* Preserve prefix arg that the command loop just cleared. */
763 current_kboard->Vprefix_arg = Vcurrent_prefix_arg; 763 current_kboard->Vprefix_arg = Vcurrent_prefix_arg;
@@ -1530,7 +1530,7 @@ before calling this function on it, like this.
1530#if defined (MSDOS) && defined (HAVE_MOUSE) 1530#if defined (MSDOS) && defined (HAVE_MOUSE)
1531 if (FRAME_MSDOS_P (XFRAME (frame))) 1531 if (FRAME_MSDOS_P (XFRAME (frame)))
1532 { 1532 {
1533 Fselect_frame (frame, Qnil); 1533 Fselect_frame (frame);
1534 mouse_moveto (XINT (x), XINT (y)); 1534 mouse_moveto (XINT (x), XINT (y));
1535 } 1535 }
1536#endif 1536#endif
@@ -1562,7 +1562,7 @@ before calling this function on it, like this.
1562#if defined (MSDOS) && defined (HAVE_MOUSE) 1562#if defined (MSDOS) && defined (HAVE_MOUSE)
1563 if (FRAME_MSDOS_P (XFRAME (frame))) 1563 if (FRAME_MSDOS_P (XFRAME (frame)))
1564 { 1564 {
1565 Fselect_frame (frame, Qnil); 1565 Fselect_frame (frame);
1566 mouse_moveto (XINT (x), XINT (y)); 1566 mouse_moveto (XINT (x), XINT (y));
1567 } 1567 }
1568#endif 1568#endif
@@ -1684,7 +1684,7 @@ If omitted, FRAME defaults to the currently selected frame. */)
1684#if 0 /* This isn't logically necessary, and it can do GC. */ 1684#if 0 /* This isn't logically necessary, and it can do GC. */
1685 /* Don't let the frame remain selected. */ 1685 /* Don't let the frame remain selected. */
1686 if (EQ (frame, selected_frame)) 1686 if (EQ (frame, selected_frame))
1687 Fhandle_switch_frame (next_frame (frame, Qt), Qnil); 1687 Fhandle_switch_frame (next_frame (frame, Qt));
1688#endif 1688#endif
1689 1689
1690 /* Don't allow minibuf_window to remain on a deleted frame. */ 1690 /* Don't allow minibuf_window to remain on a deleted frame. */
diff --git a/src/image.c b/src/image.c
index bc88c9d1d04..462294b33b4 100644
--- a/src/image.c
+++ b/src/image.c
@@ -1972,7 +1972,8 @@ x_create_x_image_and_pixmap (f, width, height, depth, ximg, pixmap)
1972 and store its handle in *pixmap. */ 1972 and store its handle in *pixmap. */
1973 *pixmap = CreateDIBSection (hdc, &((*ximg)->info), 1973 *pixmap = CreateDIBSection (hdc, &((*ximg)->info),
1974 (depth < 16) ? DIB_PAL_COLORS : DIB_RGB_COLORS, 1974 (depth < 16) ? DIB_PAL_COLORS : DIB_RGB_COLORS,
1975 &((*ximg)->data), NULL, 0); 1975 /* casting avoids a GCC warning */
1976 (void **)&((*ximg)->data), NULL, 0);
1976 1977
1977 /* Realize display palette and garbage all frames. */ 1978 /* Realize display palette and garbage all frames. */
1978 release_frame_dc (f, hdc); 1979 release_frame_dc (f, hdc);
@@ -5517,7 +5518,8 @@ pbm_load (f, img)
5517 /* Maybe fill in the background field while we have ximg handy. */ 5518 /* Maybe fill in the background field while we have ximg handy. */
5518 5519
5519 if (NILP (image_spec_value (img->spec, QCbackground, NULL))) 5520 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
5520 IMAGE_BACKGROUND (img, f, ximg); 5521 /* Casting avoids a GCC warning. */
5522 IMAGE_BACKGROUND (img, f, (XImagePtr_or_DC)ximg);
5521 5523
5522 /* Put the image into a pixmap. */ 5524 /* Put the image into a pixmap. */
5523 x_put_x_image (f, ximg, img->pixmap, width, height); 5525 x_put_x_image (f, ximg, img->pixmap, width, height);
@@ -5843,9 +5845,11 @@ png_load (f, img)
5843 tbr.bytes += sizeof (sig); 5845 tbr.bytes += sizeof (sig);
5844 } 5846 }
5845 5847
5846 /* Initialize read and info structs for PNG lib. */ 5848 /* Initialize read and info structs for PNG lib. Casting return
5847 png_ptr = fn_png_create_read_struct (PNG_LIBPNG_VER_STRING, NULL, 5849 value avoids a GCC warning on W32. */
5848 my_png_error, my_png_warning); 5850 png_ptr = (png_structp)fn_png_create_read_struct (PNG_LIBPNG_VER_STRING,
5851 NULL, my_png_error,
5852 my_png_warning);
5849 if (!png_ptr) 5853 if (!png_ptr)
5850 { 5854 {
5851 if (fp) fclose (fp); 5855 if (fp) fclose (fp);
@@ -5853,7 +5857,8 @@ png_load (f, img)
5853 return 0; 5857 return 0;
5854 } 5858 }
5855 5859
5856 info_ptr = fn_png_create_info_struct (png_ptr); 5860 /* Casting return value avoids a GCC warning on W32. */
5861 info_ptr = (png_infop)fn_png_create_info_struct (png_ptr);
5857 if (!info_ptr) 5862 if (!info_ptr)
5858 { 5863 {
5859 fn_png_destroy_read_struct (&png_ptr, NULL, NULL); 5864 fn_png_destroy_read_struct (&png_ptr, NULL, NULL);
@@ -5862,7 +5867,8 @@ png_load (f, img)
5862 return 0; 5867 return 0;
5863 } 5868 }
5864 5869
5865 end_info = fn_png_create_info_struct (png_ptr); 5870 /* Casting return value avoids a GCC warning on W32. */
5871 end_info = (png_infop)fn_png_create_info_struct (png_ptr);
5866 if (!end_info) 5872 if (!end_info)
5867 { 5873 {
5868 fn_png_destroy_read_struct (&png_ptr, &info_ptr, NULL); 5874 fn_png_destroy_read_struct (&png_ptr, &info_ptr, NULL);
@@ -6135,8 +6141,9 @@ png_load (f, img)
6135 img->width = width; 6141 img->width = width;
6136 img->height = height; 6142 img->height = height;
6137 6143
6138 /* Maybe fill in the background field while we have ximg handy. */ 6144 /* Maybe fill in the background field while we have ximg handy.
6139 IMAGE_BACKGROUND (img, f, ximg); 6145 Casting avoids a GCC warning. */
6146 IMAGE_BACKGROUND (img, f, (XImagePtr_or_DC)ximg);
6140 6147
6141 /* Put the image into the pixmap, then free the X image and its buffer. */ 6148 /* Put the image into the pixmap, then free the X image and its buffer. */
6142 x_put_x_image (f, ximg, img->pixmap, width, height); 6149 x_put_x_image (f, ximg, img->pixmap, width, height);
@@ -6145,9 +6152,9 @@ png_load (f, img)
6145 /* Same for the mask. */ 6152 /* Same for the mask. */
6146 if (mask_img) 6153 if (mask_img)
6147 { 6154 {
6148 /* Fill in the background_transparent field while we have the mask 6155 /* Fill in the background_transparent field while we have the
6149 handy. */ 6156 mask handy. Casting avoids a GCC warning. */
6150 image_background_transparent (img, f, mask_img); 6157 image_background_transparent (img, f, (XImagePtr_or_DC)mask_img);
6151 6158
6152 x_put_x_image (f, mask_img, img->mask, img->width, img->height); 6159 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
6153 x_destroy_x_image (mask_img); 6160 x_destroy_x_image (mask_img);
@@ -6494,8 +6501,9 @@ jpeg_load (f, img)
6494 } 6501 }
6495 6502
6496 /* Customize libjpeg's error handling to call my_error_exit when an 6503 /* Customize libjpeg's error handling to call my_error_exit when an
6497 error is detected. This function will perform a longjmp. */ 6504 error is detected. This function will perform a longjmp.
6498 cinfo.err = fn_jpeg_std_error (&mgr.pub); 6505 Casting return value avoids a GCC warning on W32. */
6506 cinfo.err = (struct jpeg_error_mgr *)fn_jpeg_std_error (&mgr.pub);
6499 mgr.pub.error_exit = my_error_exit; 6507 mgr.pub.error_exit = my_error_exit;
6500 6508
6501 if ((rc = setjmp (mgr.setjmp_buffer)) != 0) 6509 if ((rc = setjmp (mgr.setjmp_buffer)) != 0)
@@ -6606,7 +6614,8 @@ jpeg_load (f, img)
6606 6614
6607 /* Maybe fill in the background field while we have ximg handy. */ 6615 /* Maybe fill in the background field while we have ximg handy. */
6608 if (NILP (image_spec_value (img->spec, QCbackground, NULL))) 6616 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
6609 IMAGE_BACKGROUND (img, f, ximg); 6617 /* Casting avoids a GCC warning. */
6618 IMAGE_BACKGROUND (img, f, (XImagePtr_or_DC)ximg);
6610 6619
6611 /* Put the image into the pixmap. */ 6620 /* Put the image into the pixmap. */
6612 x_put_x_image (f, ximg, img->pixmap, width, height); 6621 x_put_x_image (f, ximg, img->pixmap, width, height);
@@ -6932,8 +6941,9 @@ tiff_load (f, img)
6932 return 0; 6941 return 0;
6933 } 6942 }
6934 6943
6935 /* Try to open the image file. */ 6944 /* Try to open the image file. Casting return value avoids a
6936 tiff = fn_TIFFOpen (SDATA (file), "r"); 6945 GCC warning on W32. */
6946 tiff = (TIFF *)fn_TIFFOpen (SDATA (file), "r");
6937 if (tiff == NULL) 6947 if (tiff == NULL)
6938 { 6948 {
6939 image_error ("Cannot open `%s'", file, Qnil); 6949 image_error ("Cannot open `%s'", file, Qnil);
@@ -6948,14 +6958,15 @@ tiff_load (f, img)
6948 memsrc.len = SBYTES (specified_data); 6958 memsrc.len = SBYTES (specified_data);
6949 memsrc.index = 0; 6959 memsrc.index = 0;
6950 6960
6951 tiff = fn_TIFFClientOpen ("memory_source", "r", &memsrc, 6961 /* Casting return value avoids a GCC warning on W32. */
6952 (TIFFReadWriteProc) tiff_read_from_memory, 6962 tiff = (TIFF *)fn_TIFFClientOpen ("memory_source", "r", &memsrc,
6953 (TIFFReadWriteProc) tiff_write_from_memory, 6963 (TIFFReadWriteProc) tiff_read_from_memory,
6954 tiff_seek_in_memory, 6964 (TIFFReadWriteProc) tiff_write_from_memory,
6955 tiff_close_memory, 6965 tiff_seek_in_memory,
6956 tiff_size_of_memory, 6966 tiff_close_memory,
6957 tiff_mmap_memory, 6967 tiff_size_of_memory,
6958 tiff_unmap_memory); 6968 tiff_mmap_memory,
6969 tiff_unmap_memory);
6959 6970
6960 if (!tiff) 6971 if (!tiff)
6961 { 6972 {
@@ -7018,7 +7029,8 @@ tiff_load (f, img)
7018 7029
7019 /* Maybe fill in the background field while we have ximg handy. */ 7030 /* Maybe fill in the background field while we have ximg handy. */
7020 if (NILP (image_spec_value (img->spec, QCbackground, NULL))) 7031 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
7021 IMAGE_BACKGROUND (img, f, ximg); 7032 /* Casting avoids a GCC warning on W32. */
7033 IMAGE_BACKGROUND (img, f, (XImagePtr_or_DC)ximg);
7022 7034
7023 /* Put the image into the pixmap, then free the X image and its buffer. */ 7035 /* Put the image into the pixmap, then free the X image and its buffer. */
7024 x_put_x_image (f, ximg, img->pixmap, width, height); 7036 x_put_x_image (f, ximg, img->pixmap, width, height);
@@ -7126,6 +7138,11 @@ gif_image_p (object)
7126#ifdef HAVE_GIF 7138#ifdef HAVE_GIF
7127 7139
7128#if defined (HAVE_NTGUI) || defined (MAC_OS) 7140#if defined (HAVE_NTGUI) || defined (MAC_OS)
7141/* winuser.h might define DrawText to DrawTextA or DrawTextW.
7142 Undefine before redefining to avoid a preprocessor warning. */
7143#ifdef DrawText
7144#undef DrawText
7145#endif
7129/* avoid conflict with QuickdrawText.h */ 7146/* avoid conflict with QuickdrawText.h */
7130#define DrawText gif_DrawText 7147#define DrawText gif_DrawText
7131#include <gif_lib.h> 7148#include <gif_lib.h>
@@ -7239,8 +7256,9 @@ gif_load (f, img)
7239 return 0; 7256 return 0;
7240 } 7257 }
7241 7258
7242 /* Open the GIF file. */ 7259 /* Open the GIF file. Casting return value avoids a GCC warning
7243 gif = fn_DGifOpenFileName (SDATA (file)); 7260 on W32. */
7261 gif = (GifFileType *)fn_DGifOpenFileName (SDATA (file));
7244 if (gif == NULL) 7262 if (gif == NULL)
7245 { 7263 {
7246 image_error ("Cannot open `%s'", file, Qnil); 7264 image_error ("Cannot open `%s'", file, Qnil);
@@ -7256,7 +7274,8 @@ gif_load (f, img)
7256 memsrc.len = SBYTES (specified_data); 7274 memsrc.len = SBYTES (specified_data);
7257 memsrc.index = 0; 7275 memsrc.index = 0;
7258 7276
7259 gif = fn_DGifOpen(&memsrc, gif_read_from_memory); 7277 /* Casting return value avoids a GCC warning on W32. */
7278 gif = (GifFileType *)fn_DGifOpen(&memsrc, gif_read_from_memory);
7260 if (!gif) 7279 if (!gif)
7261 { 7280 {
7262 image_error ("Cannot open memory source `%s'", img->spec, Qnil); 7281 image_error ("Cannot open memory source `%s'", img->spec, Qnil);
@@ -7390,7 +7409,8 @@ gif_load (f, img)
7390 7409
7391 /* Maybe fill in the background field while we have ximg handy. */ 7410 /* Maybe fill in the background field while we have ximg handy. */
7392 if (NILP (image_spec_value (img->spec, QCbackground, NULL))) 7411 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
7393 IMAGE_BACKGROUND (img, f, ximg); 7412 /* Casting avoids a GCC warning. */
7413 IMAGE_BACKGROUND (img, f, (XImagePtr_or_DC)ximg);
7394 7414
7395 /* Put the image into the pixmap, then free the X image and its buffer. */ 7415 /* Put the image into the pixmap, then free the X image and its buffer. */
7396 x_put_x_image (f, ximg, img->pixmap, width, height); 7416 x_put_x_image (f, ximg, img->pixmap, width, height);
@@ -7400,7 +7420,7 @@ gif_load (f, img)
7400 return 1; 7420 return 1;
7401} 7421}
7402 7422
7403#else 7423#else /* !HAVE_GIF */
7404 7424
7405#ifdef MAC_OS 7425#ifdef MAC_OS
7406static int 7426static int
diff --git a/src/keyboard.c b/src/keyboard.c
index dee131b8c61..7c268dc475e 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -1509,7 +1509,7 @@ command_loop_1 ()
1509 Is this a good idea? */ 1509 Is this a good idea? */
1510 if (FRAMEP (internal_last_event_frame) 1510 if (FRAMEP (internal_last_event_frame)
1511 && !EQ (internal_last_event_frame, selected_frame)) 1511 && !EQ (internal_last_event_frame, selected_frame))
1512 Fselect_frame (internal_last_event_frame, Qnil); 1512 Fselect_frame (internal_last_event_frame);
1513#endif 1513#endif
1514 /* If it has changed current-menubar from previous value, 1514 /* If it has changed current-menubar from previous value,
1515 really recompute the menubar from the value. */ 1515 really recompute the menubar from the value. */
diff --git a/src/lisp.h b/src/lisp.h
index af07de3fbaa..d523f98f937 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2992,7 +2992,7 @@ extern Lisp_Object do_switch_frame P_ ((Lisp_Object, int, int));
2992extern Lisp_Object get_frame_param P_ ((struct frame *, Lisp_Object)); 2992extern Lisp_Object get_frame_param P_ ((struct frame *, Lisp_Object));
2993extern Lisp_Object frame_buffer_predicate P_ ((Lisp_Object)); 2993extern Lisp_Object frame_buffer_predicate P_ ((Lisp_Object));
2994EXFUN (Fframep, 1); 2994EXFUN (Fframep, 1);
2995EXFUN (Fselect_frame, 2); 2995EXFUN (Fselect_frame, 1);
2996EXFUN (Fselected_frame, 0); 2996EXFUN (Fselected_frame, 0);
2997EXFUN (Fwindow_frame, 1); 2997EXFUN (Fwindow_frame, 1);
2998EXFUN (Fframe_root_window, 1); 2998EXFUN (Fframe_root_window, 1);
diff --git a/src/macfns.c b/src/macfns.c
index 8ec05b59e19..96f588207d1 100644
--- a/src/macfns.c
+++ b/src/macfns.c
@@ -4375,14 +4375,15 @@ If ONLY-DIR-P is non-nil, the user can only select directories. */)
4375 break; 4375 break;
4376 } 4376 }
4377 NavDialogDispose(dialogRef); 4377 NavDialogDispose(dialogRef);
4378 UNBLOCK_INPUT;
4378 } 4379 }
4379 else { 4380 else {
4381 UNBLOCK_INPUT;
4380 /* Fall back on minibuffer if there was a problem */ 4382 /* Fall back on minibuffer if there was a problem */
4381 file = Fcompleting_read (prompt, intern ("read-file-name-internal"), 4383 file = Fcompleting_read (prompt, intern ("read-file-name-internal"),
4382 dir, mustmatch, dir, Qfile_name_history, 4384 dir, mustmatch, dir, Qfile_name_history,
4383 default_filename, Qnil); 4385 default_filename, Qnil);
4384 } 4386 }
4385 UNBLOCK_INPUT;
4386 } 4387 }
4387 4388
4388 UNGCPRO; 4389 UNGCPRO;
diff --git a/src/macterm.c b/src/macterm.c
index dd48d43a039..cef213024fa 100644
--- a/src/macterm.c
+++ b/src/macterm.c
@@ -2002,33 +2002,37 @@ static void
2002mac_compute_glyph_string_overhangs (s) 2002mac_compute_glyph_string_overhangs (s)
2003 struct glyph_string *s; 2003 struct glyph_string *s;
2004{ 2004{
2005 Rect r; 2005 if (s->cmp == NULL
2006 MacFontStruct *font = s->font; 2006 && s->first_glyph->type == CHAR_GLYPH)
2007
2008 TextFont (font->mac_fontnum);
2009 TextSize (font->mac_fontsize);
2010 TextFace (font->mac_fontface);
2011
2012 if (s->two_byte_p)
2013 QDTextBounds (s->nchars * 2, (char *)s->char2b, &r);
2014 else
2015 { 2007 {
2016 int i; 2008 Rect r;
2017 char *buf = xmalloc (s->nchars); 2009 MacFontStruct *font = s->font;
2018 2010
2019 if (buf == NULL) 2011 TextFont (font->mac_fontnum);
2020 SetRect (&r, 0, 0, 0, 0); 2012 TextSize (font->mac_fontsize);
2013 TextFace (font->mac_fontface);
2014
2015 if (s->two_byte_p)
2016 QDTextBounds (s->nchars * 2, (char *)s->char2b, &r);
2021 else 2017 else
2022 { 2018 {
2023 for (i = 0; i < s->nchars; ++i) 2019 int i;
2024 buf[i] = s->char2b[i].byte2; 2020 char *buf = xmalloc (s->nchars);
2025 QDTextBounds (s->nchars, buf, &r); 2021
2026 xfree (buf); 2022 if (buf == NULL)
2023 SetRect (&r, 0, 0, 0, 0);
2024 else
2025 {
2026 for (i = 0; i < s->nchars; ++i)
2027 buf[i] = s->char2b[i].byte2;
2028 QDTextBounds (s->nchars, buf, &r);
2029 xfree (buf);
2030 }
2027 } 2031 }
2028 }
2029 2032
2030 s->right_overhang = r.right > s->width ? r.right - s->width : 0; 2033 s->right_overhang = r.right > s->width ? r.right - s->width : 0;
2031 s->left_overhang = r.left < 0 ? -r.left : 0; 2034 s->left_overhang = r.left < 0 ? -r.left : 0;
2035 }
2032} 2036}
2033 2037
2034 2038
@@ -7495,6 +7499,11 @@ Lisp_Object Vmac_pass_command_to_system;
7495/* If Non-nil, the Mac "Control" key is passed on to the Mac Toolbox 7499/* If Non-nil, the Mac "Control" key is passed on to the Mac Toolbox
7496 for processing before Emacs sees it. */ 7500 for processing before Emacs sees it. */
7497Lisp_Object Vmac_pass_control_to_system; 7501Lisp_Object Vmac_pass_control_to_system;
7502
7503/* Points to the variable `inev' in the function XTread_socket. It is
7504 used for passing an input event to the function back from a Carbon
7505 event handler. */
7506static struct input_event *read_socket_inev = NULL;
7498#endif 7507#endif
7499 7508
7500/* Set in term/mac-win.el to indicate that event loop can now generate 7509/* Set in term/mac-win.el to indicate that event loop can now generate
@@ -7627,45 +7636,79 @@ mac_get_mouse_btn (EventRef ref)
7627 7636
7628/* Normally, ConvertEventRefToEventRecord will correctly handle all 7637/* Normally, ConvertEventRefToEventRecord will correctly handle all
7629 events. However the click of the mouse wheel is not converted to a 7638 events. However the click of the mouse wheel is not converted to a
7630 mouseDown or mouseUp event. This calls ConvertEventRef, but then 7639 mouseDown or mouseUp event. Likewise for dead key down events.
7631 checks to see if it is a mouse up or down carbon event that has not 7640 This calls ConvertEventRef, but then checks to see if it is a mouse
7632 been converted, and if so, converts it by hand (to be picked up in 7641 up/down, or a dead key down carbon event that has not been
7633 the XTread_socket loop). */ 7642 converted, and if so, converts it by hand (to be picked up in the
7643 XTread_socket loop). */
7634static Boolean mac_convert_event_ref (EventRef eventRef, EventRecord *eventRec) 7644static Boolean mac_convert_event_ref (EventRef eventRef, EventRecord *eventRec)
7635{ 7645{
7636 Boolean result = ConvertEventRefToEventRecord (eventRef, eventRec); 7646 Boolean result = ConvertEventRefToEventRecord (eventRef, eventRec);
7637 /* Do special case for mouse wheel button. */ 7647
7638 if (!result && GetEventClass (eventRef) == kEventClassMouse) 7648 if (result)
7649 return result;
7650
7651 switch (GetEventClass (eventRef))
7639 { 7652 {
7640 UInt32 kind = GetEventKind (eventRef); 7653 case kEventClassMouse:
7641 if (kind == kEventMouseDown && !(eventRec->what == mouseDown)) 7654 switch (GetEventKind (eventRef))
7642 { 7655 {
7656 case kEventMouseDown:
7643 eventRec->what = mouseDown; 7657 eventRec->what = mouseDown;
7644 result=1; 7658 result = 1;
7645 } 7659 break;
7646 if (kind == kEventMouseUp && !(eventRec->what == mouseUp)) 7660
7647 { 7661 case kEventMouseUp:
7648 eventRec->what = mouseUp; 7662 eventRec->what = mouseUp;
7649 result=1; 7663 result = 1;
7664 break;
7665
7666 default:
7667 break;
7650 } 7668 }
7651 if (result) 7669
7670 case kEventClassKeyboard:
7671 switch (GetEventKind (eventRef))
7652 { 7672 {
7653 /* Need where and when. */ 7673 case kEventRawKeyDown:
7654 UInt32 mods; 7674 {
7655 GetEventParameter (eventRef, kEventParamMouseLocation, 7675 unsigned char char_codes;
7656 typeQDPoint, NULL, sizeof (Point), 7676 UInt32 key_code;
7657 NULL, &eventRec->where); 7677
7658 /* Use two step process because new event modifiers are 7678 eventRec->what = keyDown;
7659 32-bit and old are 16-bit. Currently, only loss is 7679 GetEventParameter (eventRef, kEventParamKeyMacCharCodes, typeChar,
7660 NumLock & Fn. */ 7680 NULL, sizeof (char), NULL, &char_codes);
7661 GetEventParameter (eventRef, kEventParamKeyModifiers, 7681 GetEventParameter (eventRef, kEventParamKeyCode, typeUInt32,
7662 typeUInt32, NULL, sizeof (UInt32), 7682 NULL, sizeof (UInt32), NULL, &key_code);
7663 NULL, &mods); 7683 eventRec->message = char_codes | ((key_code & 0xff) << 8);
7664 eventRec->modifiers = mods; 7684 result = 1;
7665 7685 }
7666 eventRec->when = EventTimeToTicks (GetEventTime (eventRef)); 7686 break;
7687
7688 default:
7689 break;
7667 } 7690 }
7691
7692 default:
7693 break;
7668 } 7694 }
7695
7696 if (result)
7697 {
7698 /* Need where and when. */
7699 UInt32 mods;
7700
7701 GetEventParameter (eventRef, kEventParamMouseLocation, typeQDPoint,
7702 NULL, sizeof (Point), NULL, &eventRec->where);
7703 /* Use two step process because new event modifiers are 32-bit
7704 and old are 16-bit. Currently, only loss is NumLock & Fn. */
7705 GetEventParameter (eventRef, kEventParamKeyModifiers, typeUInt32,
7706 NULL, sizeof (UInt32), NULL, &mods);
7707 eventRec->modifiers = mods;
7708
7709 eventRec->when = EventTimeToTicks (GetEventTime (eventRef));
7710 }
7711
7669 return result; 7712 return result;
7670} 7713}
7671 7714
@@ -8235,8 +8278,7 @@ mac_handle_command_event (next_handler, event, data)
8235} 8278}
8236 8279
8237static OSErr 8280static OSErr
8238init_command_handler (window) 8281init_command_handler ()
8239 WindowPtr window;
8240{ 8282{
8241 OSErr err = noErr; 8283 OSErr err = noErr;
8242 EventTypeSpec specs[] = {{kEventClassCommand, kEventCommandProcess}}; 8284 EventTypeSpec specs[] = {{kEventClassCommand, kEventCommandProcess}};
@@ -8321,6 +8363,68 @@ mac_handle_window_event (next_handler, event, data)
8321 8363
8322 return eventNotHandledErr; 8364 return eventNotHandledErr;
8323} 8365}
8366
8367static pascal OSStatus
8368mac_handle_mouse_event (next_handler, event, data)
8369 EventHandlerCallRef next_handler;
8370 EventRef event;
8371 void *data;
8372{
8373 OSStatus result;
8374
8375 switch (GetEventKind (event))
8376 {
8377 case kEventMouseWheelMoved:
8378 {
8379 WindowPtr wp;
8380 struct frame *f;
8381 EventMouseWheelAxis axis;
8382 SInt32 delta;
8383 Point point;
8384
8385 result = CallNextEventHandler (next_handler, event);
8386 if (result != eventNotHandledErr || read_socket_inev == NULL)
8387 return result;
8388
8389 GetEventParameter (event, kEventParamWindowRef, typeWindowRef,
8390 NULL, sizeof (WindowRef), NULL, &wp);
8391 f = mac_window_to_frame (wp);
8392 if (f != mac_focus_frame (&one_mac_display_info))
8393 break;
8394
8395 GetEventParameter (event, kEventParamMouseWheelAxis,
8396 typeMouseWheelAxis, NULL,
8397 sizeof (EventMouseWheelAxis), NULL, &axis);
8398 if (axis != kEventMouseWheelAxisY)
8399 break;
8400
8401 GetEventParameter (event, kEventParamMouseWheelDelta, typeSInt32,
8402 NULL, sizeof (SInt32), NULL, &delta);
8403 GetEventParameter (event, kEventParamMouseLocation, typeQDPoint,
8404 NULL, sizeof (Point), NULL, &point);
8405 read_socket_inev->kind = WHEEL_EVENT;
8406 read_socket_inev->code = 0;
8407 read_socket_inev->modifiers =
8408 (mac_event_to_emacs_modifiers (event)
8409 | ((delta < 0) ? down_modifier : up_modifier));
8410 SetPortWindowPort (wp);
8411 GlobalToLocal (&point);
8412 XSETINT (read_socket_inev->x, point.h);
8413 XSETINT (read_socket_inev->y, point.v);
8414 XSETFRAME (read_socket_inev->frame_or_window, f);
8415 read_socket_inev->timestamp =
8416 EventTimeToTicks (GetEventTime (event)) * (1000/60);
8417
8418 return noErr;
8419 }
8420 break;
8421
8422 default:
8423 break;
8424 }
8425
8426 return eventNotHandledErr;
8427}
8324#endif /* USE_CARBON_EVENTS */ 8428#endif /* USE_CARBON_EVENTS */
8325 8429
8326 8430
@@ -8330,16 +8434,24 @@ install_window_handler (window)
8330{ 8434{
8331 OSErr err = noErr; 8435 OSErr err = noErr;
8332#if USE_CARBON_EVENTS 8436#if USE_CARBON_EVENTS
8333 EventTypeSpec specs[] = {{kEventClassWindow, kEventWindowUpdate}, 8437 EventTypeSpec specs_window[] =
8334 {kEventClassWindow, kEventWindowBoundsChanging}}; 8438 {{kEventClassWindow, kEventWindowUpdate},
8335 static EventHandlerUPP handle_window_event_UPP = NULL; 8439 {kEventClassWindow, kEventWindowBoundsChanging}};
8336 8440 EventTypeSpec specs_mouse[] = {{kEventClassMouse, kEventMouseWheelMoved}};
8337 if (handle_window_event_UPP == NULL) 8441 static EventHandlerUPP handle_window_eventUPP = NULL;
8338 handle_window_event_UPP = NewEventHandlerUPP (mac_handle_window_event); 8442 static EventHandlerUPP handle_mouse_eventUPP = NULL;
8339 8443
8340 err = InstallWindowEventHandler (window, handle_window_event_UPP, 8444 if (handle_window_eventUPP == NULL)
8341 GetEventTypeCount (specs), specs, 8445 handle_window_eventUPP = NewEventHandlerUPP (mac_handle_window_event);
8342 NULL, NULL); 8446 if (handle_mouse_eventUPP == NULL)
8447 handle_mouse_eventUPP = NewEventHandlerUPP (mac_handle_mouse_event);
8448 err = InstallWindowEventHandler (window, handle_window_eventUPP,
8449 GetEventTypeCount (specs_window),
8450 specs_window, NULL, NULL);
8451 if (err == noErr)
8452 err = InstallWindowEventHandler (window, handle_mouse_eventUPP,
8453 GetEventTypeCount (specs_mouse),
8454 specs_mouse, NULL, NULL);
8343#endif 8455#endif
8344#if TARGET_API_MAC_CARBON 8456#if TARGET_API_MAC_CARBON
8345 if (mac_do_track_dragUPP == NULL) 8457 if (mac_do_track_dragUPP == NULL)
@@ -8891,68 +9003,19 @@ XTread_socket (sd, expected, hold_quit)
8891#if USE_CARBON_EVENTS 9003#if USE_CARBON_EVENTS
8892 /* Handle new events */ 9004 /* Handle new events */
8893 if (!mac_convert_event_ref (eventRef, &er)) 9005 if (!mac_convert_event_ref (eventRef, &er))
8894 switch (GetEventClass (eventRef)) 9006 {
8895 { 9007 /* There used to be a handler for the kEventMouseWheelMoved
8896 case kEventClassWindow: 9008 event here. But as of Mac OS X 10.4, this kind of event
8897 if (GetEventKind (eventRef) == kEventWindowBoundsChanged) 9009 is not directly posted to the main event queue by
8898 { 9010 two-finger scrolling on the trackpad. Instead, some
8899 WindowPtr window_ptr; 9011 private event is posted and it is converted to a wheel
8900 GetEventParameter(eventRef, kEventParamDirectObject, 9012 event by the default handler for the application target.
8901 typeWindowRef, NULL, sizeof(WindowPtr), 9013 The converted one can be received by a Carbon event
8902 NULL, &window_ptr); 9014 handler installed on a window target. */
8903 f = mac_window_to_frame (window_ptr); 9015 read_socket_inev = &inev;
8904 if (f && !f->async_iconified) 9016 SendEventToEventTarget (eventRef, toolbox_dispatcher);
8905 x_real_positions (f, &f->left_pos, &f->top_pos); 9017 read_socket_inev = NULL;
8906 SendEventToEventTarget (eventRef, toolbox_dispatcher); 9018 }
8907 }
8908 break;
8909 case kEventClassMouse:
8910 if (GetEventKind (eventRef) == kEventMouseWheelMoved)
8911 {
8912 SInt32 delta;
8913 Point point;
8914 struct frame *f = mac_focus_frame (dpyinfo);
8915 WindowPtr window_ptr;
8916
8917#if 0
8918 if (dpyinfo->x_focus_frame == NULL)
8919 {
8920 /* Beep if wheel move occurs when all the frames
8921 are invisible. */
8922 SysBeep(1);
8923 break;
8924 }
8925#endif
8926
8927 GetEventParameter(eventRef, kEventParamMouseWheelDelta,
8928 typeSInt32, NULL, sizeof (SInt32),
8929 NULL, &delta);
8930 GetEventParameter(eventRef, kEventParamMouseLocation,
8931 typeQDPoint, NULL, sizeof (Point),
8932 NULL, &point);
8933 inev.kind = WHEEL_EVENT;
8934 inev.code = 0;
8935 inev.modifiers = (mac_event_to_emacs_modifiers (eventRef)
8936 | ((delta < 0) ? down_modifier
8937 : up_modifier));
8938 window_ptr = FRAME_MAC_WINDOW (f);
8939 SetPortWindowPort (window_ptr);
8940 GlobalToLocal (&point);
8941 XSETINT (inev.x, point.h);
8942 XSETINT (inev.y, point.v);
8943 XSETFRAME (inev.frame_or_window,
8944 mac_window_to_frame (window_ptr));
8945 inev.timestamp = EventTimeToTicks (GetEventTime (eventRef))*(1000/60);
8946 }
8947 else
8948 SendEventToEventTarget (eventRef, toolbox_dispatcher);
8949
8950 break;
8951
8952 default:
8953 /* Send the event to the appropriate receiver. */
8954 SendEventToEventTarget (eventRef, toolbox_dispatcher);
8955 }
8956 else 9019 else
8957#endif /* USE_CARBON_EVENTS */ 9020#endif /* USE_CARBON_EVENTS */
8958 switch (er.what) 9021 switch (er.what)
@@ -9388,7 +9451,10 @@ XTread_socket (sd, expected, hold_quit)
9388 if ((!NILP (Vmac_pass_command_to_system) 9451 if ((!NILP (Vmac_pass_command_to_system)
9389 || !(er.modifiers & cmdKey)) 9452 || !(er.modifiers & cmdKey))
9390 && (!NILP (Vmac_pass_control_to_system) 9453 && (!NILP (Vmac_pass_control_to_system)
9391 || !(er.modifiers & controlKey))) 9454 || !(er.modifiers & controlKey))
9455 && (!NILP (Vmac_command_key_is_meta)
9456 && NILP (Vmac_option_modifier)
9457 || !(er.modifiers & optionKey)))
9392 if (SendEventToEventTarget (eventRef, toolbox_dispatcher) 9458 if (SendEventToEventTarget (eventRef, toolbox_dispatcher)
9393 != eventNotHandledErr) 9459 != eventNotHandledErr)
9394 break; 9460 break;
diff --git a/src/makefile.w32-in b/src/makefile.w32-in
index 471f0cbc6ea..0ab23c72f78 100644
--- a/src/makefile.w32-in
+++ b/src/makefile.w32-in
@@ -170,7 +170,8 @@ $(EMACS): $(DOC) $(TEMACS)
170# (it is the preload heap size in MB). 170# (it is the preload heap size in MB).
171# 171#
172temacs: $(BLD) $(TEMACS) 172temacs: $(BLD) $(TEMACS)
173$(TEMACS): $(TLIB0) $(TLIB1) $(TLIBW32) $(TLASTLIB) $(TOBJ) $(TRES) 173$(TEMACS): $(TLIB0) $(TLIB1) $(TLIBW32) $(TLASTLIB) $(TOBJ) $(TRES) \
174 ../nt/$(BLD)/addsection.exe
174 $(LINK) $(LINK_OUT)$(TEMACS_TMP) $(FULL_LINK_FLAGS) $(TOBJ) $(TRES) $(LIBS) 175 $(LINK) $(LINK_OUT)$(TEMACS_TMP) $(FULL_LINK_FLAGS) $(TOBJ) $(TRES) $(LIBS)
175 "../nt/$(BLD)/addsection" "$(TEMACS_TMP)" "$(TEMACS)" EMHEAP 20 176 "../nt/$(BLD)/addsection" "$(TEMACS_TMP)" "$(TEMACS)" EMHEAP 20
176 echo $(OBJ0) > $(BLD)/buildobj.lst 177 echo $(OBJ0) > $(BLD)/buildobj.lst
diff --git a/src/process.c b/src/process.c
index d60fe1e3bf6..b61c6e8d6fe 100644
--- a/src/process.c
+++ b/src/process.c
@@ -6822,7 +6822,7 @@ The value takes effect when `start-process' is called. */);
6822 doc: /* If non-nil, improve receive buffering by delaying after short reads. 6822 doc: /* If non-nil, improve receive buffering by delaying after short reads.
6823On some systems, when Emacs reads the output from a subprocess, the output data 6823On some systems, when Emacs reads the output from a subprocess, the output data
6824is read in very small blocks, potentially resulting in very poor performance. 6824is read in very small blocks, potentially resulting in very poor performance.
6825This behaviour can be remedied to some extent by setting this variable to a 6825This behavior can be remedied to some extent by setting this variable to a
6826non-nil value, as it will automatically delay reading from such processes, to 6826non-nil value, as it will automatically delay reading from such processes, to
6827allowing them to produce more output before Emacs tries to read it. 6827allowing them to produce more output before Emacs tries to read it.
6828If the value is t, the delay is reset after each write to the process; any other 6828If the value is t, the delay is reset after each write to the process; any other
diff --git a/src/unexw32.c b/src/unexw32.c
index 1b2dbe74c31..ebeb7355673 100644
--- a/src/unexw32.c
+++ b/src/unexw32.c
@@ -1,5 +1,5 @@
1/* unexec for GNU Emacs on Windows NT. 1/* unexec for GNU Emacs on Windows NT.
2 Copyright (C) 1994 Free Software Foundation, Inc. 2 Copyright (C) 1994, 2005 Free Software Foundation, Inc.
3 3
4This file is part of GNU Emacs. 4This file is part of GNU Emacs.
5 5
@@ -491,27 +491,34 @@ copy_executable_and_dump_data (file_data *p_infile,
491 PIMAGE_SECTION_HEADER dst_section; 491 PIMAGE_SECTION_HEADER dst_section;
492 DWORD offset; 492 DWORD offset;
493 int i; 493 int i;
494 int be_verbose = GetEnvironmentVariable ("DEBUG_DUMP", NULL, 0) > 0;
494 495
495#define COPY_CHUNK(message, src, size) \ 496#define COPY_CHUNK(message, src, size, verbose) \
496 do { \ 497 do { \
497 unsigned char *s = (void *)(src); \ 498 unsigned char *s = (void *)(src); \
498 unsigned long count = (size); \ 499 unsigned long count = (size); \
499 printf ("%s\n", (message)); \ 500 if (verbose) \
500 printf ("\t0x%08x Offset in input file.\n", s - p_infile->file_base); \ 501 { \
501 printf ("\t0x%08x Offset in output file.\n", dst - p_outfile->file_base); \ 502 printf ("%s\n", (message)); \
502 printf ("\t0x%08x Size in bytes.\n", count); \ 503 printf ("\t0x%08x Offset in input file.\n", s - p_infile->file_base); \
504 printf ("\t0x%08x Offset in output file.\n", dst - p_outfile->file_base); \
505 printf ("\t0x%08x Size in bytes.\n", count); \
506 } \
503 memcpy (dst, s, count); \ 507 memcpy (dst, s, count); \
504 dst += count; \ 508 dst += count; \
505 } while (0) 509 } while (0)
506 510
507#define COPY_PROC_CHUNK(message, src, size) \ 511#define COPY_PROC_CHUNK(message, src, size, verbose) \
508 do { \ 512 do { \
509 unsigned char *s = (void *)(src); \ 513 unsigned char *s = (void *)(src); \
510 unsigned long count = (size); \ 514 unsigned long count = (size); \
511 printf ("%s\n", (message)); \ 515 if (verbose) \
512 printf ("\t0x%08x Address in process.\n", s); \ 516 { \
513 printf ("\t0x%08x Offset in output file.\n", dst - p_outfile->file_base); \ 517 printf ("%s\n", (message)); \
514 printf ("\t0x%08x Size in bytes.\n", count); \ 518 printf ("\t0x%08x Address in process.\n", s); \
519 printf ("\t0x%08x Offset in output file.\n", dst - p_outfile->file_base); \
520 printf ("\t0x%08x Size in bytes.\n", count); \
521 } \
515 memcpy (dst, s, count); \ 522 memcpy (dst, s, count); \
516 dst += count; \ 523 dst += count; \
517 } while (0) 524 } while (0)
@@ -542,13 +549,14 @@ copy_executable_and_dump_data (file_data *p_infile,
542 dst = (unsigned char *) p_outfile->file_base; 549 dst = (unsigned char *) p_outfile->file_base;
543 550
544 COPY_CHUNK ("Copying DOS header...", dos_header, 551 COPY_CHUNK ("Copying DOS header...", dos_header,
545 (DWORD) nt_header - (DWORD) dos_header); 552 (DWORD) nt_header - (DWORD) dos_header, be_verbose);
546 dst_nt_header = (PIMAGE_NT_HEADERS) dst; 553 dst_nt_header = (PIMAGE_NT_HEADERS) dst;
547 COPY_CHUNK ("Copying NT header...", nt_header, 554 COPY_CHUNK ("Copying NT header...", nt_header,
548 (DWORD) section - (DWORD) nt_header); 555 (DWORD) section - (DWORD) nt_header, be_verbose);
549 dst_section = (PIMAGE_SECTION_HEADER) dst; 556 dst_section = (PIMAGE_SECTION_HEADER) dst;
550 COPY_CHUNK ("Copying section table...", section, 557 COPY_CHUNK ("Copying section table...", section,
551 nt_header->FileHeader.NumberOfSections * sizeof (*section)); 558 nt_header->FileHeader.NumberOfSections * sizeof (*section),
559 be_verbose);
552 560
553 /* Align the first section's raw data area, and set the header size 561 /* Align the first section's raw data area, and set the header size
554 field accordingly. */ 562 field accordingly. */
@@ -558,7 +566,9 @@ copy_executable_and_dump_data (file_data *p_infile,
558 for (i = 0; i < nt_header->FileHeader.NumberOfSections; i++) 566 for (i = 0; i < nt_header->FileHeader.NumberOfSections; i++)
559 { 567 {
560 char msg[100]; 568 char msg[100];
561 sprintf (msg, "Copying raw data for %s...", section->Name); 569 /* Windows section names are fixed 8-char strings, only
570 zero-terminated if the name is shorter than 8 characters. */
571 sprintf (msg, "Copying raw data for %.8s...", section->Name);
562 572
563 dst_save = dst; 573 dst_save = dst;
564 574
@@ -571,7 +581,7 @@ copy_executable_and_dump_data (file_data *p_infile,
571 /* Can always copy the original raw data. */ 581 /* Can always copy the original raw data. */
572 COPY_CHUNK 582 COPY_CHUNK
573 (msg, OFFSET_TO_PTR (section->PointerToRawData, p_infile), 583 (msg, OFFSET_TO_PTR (section->PointerToRawData, p_infile),
574 section->SizeOfRawData); 584 section->SizeOfRawData, be_verbose);
575 /* Ensure alignment slop is zeroed. */ 585 /* Ensure alignment slop is zeroed. */
576 ROUND_UP_DST_AND_ZERO (dst_nt_header->OptionalHeader.FileAlignment); 586 ROUND_UP_DST_AND_ZERO (dst_nt_header->OptionalHeader.FileAlignment);
577 587
@@ -580,7 +590,8 @@ copy_executable_and_dump_data (file_data *p_infile,
580 { 590 {
581 dst = dst_save 591 dst = dst_save
582 + RVA_TO_SECTION_OFFSET (PTR_TO_RVA (data_start), dst_section); 592 + RVA_TO_SECTION_OFFSET (PTR_TO_RVA (data_start), dst_section);
583 COPY_PROC_CHUNK ("Dumping initialized data...", data_start, data_size); 593 COPY_PROC_CHUNK ("Dumping initialized data...",
594 data_start, data_size, be_verbose);
584 dst = dst_save + dst_section->SizeOfRawData; 595 dst = dst_save + dst_section->SizeOfRawData;
585 } 596 }
586 if (section == bss_section) 597 if (section == bss_section)
@@ -589,7 +600,8 @@ copy_executable_and_dump_data (file_data *p_infile,
589 data size as necessary. */ 600 data size as necessary. */
590 dst = dst_save 601 dst = dst_save
591 + RVA_TO_SECTION_OFFSET (PTR_TO_RVA (bss_start), dst_section); 602 + RVA_TO_SECTION_OFFSET (PTR_TO_RVA (bss_start), dst_section);
592 COPY_PROC_CHUNK ("Dumping bss data...", bss_start, bss_size); 603 COPY_PROC_CHUNK ("Dumping bss data...", bss_start,
604 bss_size, be_verbose);
593 ROUND_UP_DST (dst_nt_header->OptionalHeader.FileAlignment); 605 ROUND_UP_DST (dst_nt_header->OptionalHeader.FileAlignment);
594 dst_section->PointerToRawData = PTR_TO_OFFSET (dst_save, p_outfile); 606 dst_section->PointerToRawData = PTR_TO_OFFSET (dst_save, p_outfile);
595 /* Determine new size of raw data area. */ 607 /* Determine new size of raw data area. */
@@ -604,7 +616,8 @@ copy_executable_and_dump_data (file_data *p_infile,
604 section's raw data size as necessary. */ 616 section's raw data size as necessary. */
605 dst = dst_save 617 dst = dst_save
606 + RVA_TO_SECTION_OFFSET (PTR_TO_RVA (bss_start_static), dst_section); 618 + RVA_TO_SECTION_OFFSET (PTR_TO_RVA (bss_start_static), dst_section);
607 COPY_PROC_CHUNK ("Dumping static bss data...", bss_start_static, bss_size_static); 619 COPY_PROC_CHUNK ("Dumping static bss data...", bss_start_static,
620 bss_size_static, be_verbose);
608 ROUND_UP_DST (dst_nt_header->OptionalHeader.FileAlignment); 621 ROUND_UP_DST (dst_nt_header->OptionalHeader.FileAlignment);
609 dst_section->PointerToRawData = PTR_TO_OFFSET (dst_save, p_outfile); 622 dst_section->PointerToRawData = PTR_TO_OFFSET (dst_save, p_outfile);
610 /* Determine new size of raw data area. */ 623 /* Determine new size of raw data area. */
@@ -622,7 +635,8 @@ copy_executable_and_dump_data (file_data *p_infile,
622 section's size to the appropriate size. */ 635 section's size to the appropriate size. */
623 dst = dst_save 636 dst = dst_save
624 + RVA_TO_SECTION_OFFSET (PTR_TO_RVA (heap_start), dst_section); 637 + RVA_TO_SECTION_OFFSET (PTR_TO_RVA (heap_start), dst_section);
625 COPY_PROC_CHUNK ("Dumping heap...", heap_start, heap_size); 638 COPY_PROC_CHUNK ("Dumping heap...", heap_start, heap_size,
639 be_verbose);
626 ROUND_UP_DST (dst_nt_header->OptionalHeader.FileAlignment); 640 ROUND_UP_DST (dst_nt_header->OptionalHeader.FileAlignment);
627 dst_section->PointerToRawData = PTR_TO_OFFSET (dst_save, p_outfile); 641 dst_section->PointerToRawData = PTR_TO_OFFSET (dst_save, p_outfile);
628 /* Determine new size of raw data area. */ 642 /* Determine new size of raw data area. */
@@ -657,7 +671,7 @@ copy_executable_and_dump_data (file_data *p_infile,
657 COPY_CHUNK 671 COPY_CHUNK
658 ("Copying remainder of executable...", 672 ("Copying remainder of executable...",
659 OFFSET_TO_PTR (offset, p_infile), 673 OFFSET_TO_PTR (offset, p_infile),
660 p_infile->size - offset); 674 p_infile->size - offset, be_verbose);
661 675
662 /* Final size for new image. */ 676 /* Final size for new image. */
663 p_outfile->size = DST_TO_OFFSET (); 677 p_outfile->size = DST_TO_OFFSET ();
diff --git a/src/w32bdf.c b/src/w32bdf.c
index 5f073dc8478..425669ee2a5 100644
--- a/src/w32bdf.c
+++ b/src/w32bdf.c
@@ -604,7 +604,7 @@ create_offscreen_bitmap(HDC hdc, int width, int height, unsigned char **bitsp)
604 info.c[1].rgbRed = info.c[1].rgbGreen = info.c[1].rgbBlue = 255; 604 info.c[1].rgbRed = info.c[1].rgbGreen = info.c[1].rgbBlue = 255;
605 605
606 return CreateDIBSection(hdc, (LPBITMAPINFO)&info, 606 return CreateDIBSection(hdc, (LPBITMAPINFO)&info,
607 DIB_RGB_COLORS, bitsp, NULL, 0); 607 DIB_RGB_COLORS, (void **)bitsp, NULL, 0);
608} 608}
609 609
610glyph_metric * 610glyph_metric *
diff --git a/src/w32fns.c b/src/w32fns.c
index e05c45c2a4e..db7297059a2 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -7821,6 +7821,19 @@ file_dialog_callback (hwnd, msg, wParam, lParam)
7821 return 0; 7821 return 0;
7822} 7822}
7823 7823
7824/* Since we compile with _WIN32_WINNT set to 0x0400 (for NT4 compatibility)
7825 we end up with the old file dialogs. Define a big enough struct for the
7826 new dialog to trick GetOpenFileName into giving us the new dialogs on
7827 Windows 2000 and XP. */
7828typedef struct
7829{
7830 OPENFILENAME real_details;
7831 void * pReserved;
7832 DWORD dwReserved;
7833 DWORD FlagsEx;
7834} NEWOPENFILENAME;
7835
7836
7824DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0, 7837DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0,
7825 doc: /* Read file name, prompting with PROMPT in directory DIR. 7838 doc: /* Read file name, prompting with PROMPT in directory DIR.
7826Use a file selection dialog. 7839Use a file selection dialog.
@@ -7869,39 +7882,58 @@ If ONLY-DIR-P is non-nil, the user can only select directories. */)
7869 filename[0] = '\0'; 7882 filename[0] = '\0';
7870 7883
7871 { 7884 {
7872 OPENFILENAME file_details; 7885 NEWOPENFILENAME new_file_details;
7873 7886 BOOL file_opened = FALSE;
7887 OPENFILENAME * file_details = &new_file_details.real_details;
7888
7874 /* Prevent redisplay. */ 7889 /* Prevent redisplay. */
7875 specbind (Qinhibit_redisplay, Qt); 7890 specbind (Qinhibit_redisplay, Qt);
7876 BLOCK_INPUT; 7891 BLOCK_INPUT;
7877 7892
7878 bzero (&file_details, sizeof (file_details)); 7893 bzero (&new_file_details, sizeof (new_file_details));
7879 file_details.lStructSize = sizeof (file_details); 7894 /* Apparently NT4 crashes if you give it an unexpected size.
7880 file_details.hwndOwner = FRAME_W32_WINDOW (f); 7895 I'm not sure about Windows 9x, so play it safe. */
7896 if (w32_major_version > 4 && w32_major_version < 95)
7897 file_details->lStructSize = sizeof (new_file_details);
7898 else
7899 file_details->lStructSize = sizeof (file_details);
7900
7901 file_details->hwndOwner = FRAME_W32_WINDOW (f);
7881 /* Undocumented Bug in Common File Dialog: 7902 /* Undocumented Bug in Common File Dialog:
7882 If a filter is not specified, shell links are not resolved. */ 7903 If a filter is not specified, shell links are not resolved. */
7883 file_details.lpstrFilter = "All Files (*.*)\0*.*\0Directories\0*|*\0\0"; 7904 file_details->lpstrFilter = "All Files (*.*)\0*.*\0Directories\0*|*\0\0";
7884 file_details.lpstrFile = filename; 7905 file_details->lpstrFile = filename;
7885 file_details.nMaxFile = sizeof (filename); 7906 file_details->nMaxFile = sizeof (filename);
7886 file_details.lpstrInitialDir = init_dir; 7907 file_details->lpstrInitialDir = init_dir;
7887 file_details.lpstrTitle = SDATA (prompt); 7908 file_details->lpstrTitle = SDATA (prompt);
7888 7909
7889 if (! NILP (only_dir_p)) 7910 if (! NILP (only_dir_p))
7890 default_filter_index = 2; 7911 default_filter_index = 2;
7891 7912
7892 file_details.nFilterIndex = default_filter_index; 7913 file_details->nFilterIndex = default_filter_index;
7893 7914
7894 file_details.Flags = (OFN_HIDEREADONLY | OFN_NOCHANGEDIR 7915 file_details->Flags = (OFN_HIDEREADONLY | OFN_NOCHANGEDIR
7895 | OFN_EXPLORER | OFN_ENABLEHOOK); 7916 | OFN_EXPLORER | OFN_ENABLEHOOK);
7896 if (!NILP (mustmatch)) 7917 if (!NILP (mustmatch))
7897 file_details.Flags |= OFN_FILEMUSTEXIST | OFN_PATHMUSTEXIST; 7918 {
7919 /* Require that the path to the parent directory exists. */
7920 file_details->Flags |= OFN_PATHMUSTEXIST;
7921 /* If we are looking for a file, require that it exists. */
7922 if (NILP (only_dir_p))
7923 file_details->Flags |= OFN_FILEMUSTEXIST;
7924 }
7925
7926 file_details->lpfnHook = (LPOFNHOOKPROC) file_dialog_callback;
7898 7927
7899 file_details.lpfnHook = (LPOFNHOOKPROC) file_dialog_callback; 7928 file_opened = GetOpenFileName (file_details);
7900 7929
7901 if (GetOpenFileName (&file_details)) 7930 UNBLOCK_INPUT;
7931
7932 if (file_opened)
7902 { 7933 {
7903 dostounix_filename (filename); 7934 dostounix_filename (filename);
7904 if (file_details.nFilterIndex == 2) 7935
7936 if (file_details->nFilterIndex == 2)
7905 { 7937 {
7906 /* "Directories" selected - strip dummy file name. */ 7938 /* "Directories" selected - strip dummy file name. */
7907 char * last = strrchr (filename, '/'); 7939 char * last = strrchr (filename, '/');
@@ -7919,7 +7951,6 @@ If ONLY-DIR-P is non-nil, the user can only select directories. */)
7919 dir, mustmatch, dir, Qfile_name_history, 7951 dir, mustmatch, dir, Qfile_name_history,
7920 default_filename, Qnil); 7952 default_filename, Qnil);
7921 7953
7922 UNBLOCK_INPUT;
7923 file = unbind_to (count, file); 7954 file = unbind_to (count, file);
7924 } 7955 }
7925 7956
@@ -8760,7 +8791,7 @@ fontsets are automatically created. */);
8760 DEFVAR_BOOL ("w32-strict-painting", 8791 DEFVAR_BOOL ("w32-strict-painting",
8761 &w32_strict_painting, 8792 &w32_strict_painting,
8762 doc: /* Non-nil means use strict rules for repainting frames. 8793 doc: /* Non-nil means use strict rules for repainting frames.
8763Set this to nil to get the old behaviour for repainting; this should 8794Set this to nil to get the old behavior for repainting; this should
8764only be necessary if the default setting causes problems. */); 8795only be necessary if the default setting causes problems. */);
8765 w32_strict_painting = 1; 8796 w32_strict_painting = 1;
8766 8797
@@ -8953,24 +8984,25 @@ void globals_of_w32fns ()
8953 8984
8954#undef abort 8985#undef abort
8955 8986
8987void w32_abort (void) NO_RETURN;
8988
8956void 8989void
8957w32_abort() 8990w32_abort()
8958{ 8991{
8959 int button; 8992 int button;
8960 button = MessageBox (NULL, 8993 button = MessageBox (NULL,
8961 "A fatal error has occurred!\n\n" 8994 "A fatal error has occurred!\n\n"
8962 "Select Abort to exit, Retry to debug, Ignore to continue", 8995 "Would you like to attach a debugger?\n\n"
8996 "Select YES to debug, NO to abort Emacs",
8963 "Emacs Abort Dialog", 8997 "Emacs Abort Dialog",
8964 MB_ICONEXCLAMATION | MB_TASKMODAL 8998 MB_ICONEXCLAMATION | MB_TASKMODAL
8965 | MB_SETFOREGROUND | MB_ABORTRETRYIGNORE); 8999 | MB_SETFOREGROUND | MB_YESNO);
8966 switch (button) 9000 switch (button)
8967 { 9001 {
8968 case IDRETRY: 9002 case IDYES:
8969 DebugBreak (); 9003 DebugBreak ();
8970 break; 9004 exit (2); /* tell the compiler we will never return */
8971 case IDIGNORE: 9005 case IDNO:
8972 break;
8973 case IDABORT:
8974 default: 9006 default:
8975 abort (); 9007 abort ();
8976 break; 9008 break;
diff --git a/src/w32term.c b/src/w32term.c
index 51f001bfd45..0bb5607512c 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -89,6 +89,10 @@ static int any_help_event_p;
89/* Last window where we saw the mouse. Used by mouse-autoselect-window. */ 89/* Last window where we saw the mouse. Used by mouse-autoselect-window. */
90static Lisp_Object last_window; 90static Lisp_Object last_window;
91 91
92/* Non-zero means make use of UNDERLINE_POSITION font properties.
93 (Not yet supported, see TODO in x_draw_glyph_string.) */
94int x_use_underline_position_properties;
95
92extern unsigned int msh_mousewheel; 96extern unsigned int msh_mousewheel;
93 97
94extern void free_frame_menubar (); 98extern void free_frame_menubar ();
@@ -2639,7 +2643,9 @@ x_draw_glyph_string (s)
2639 unsigned long dy = s->height - h; 2643 unsigned long dy = s->height - h;
2640 2644
2641 /* TODO: Use font information for positioning and thickness 2645 /* TODO: Use font information for positioning and thickness
2642 of underline. See OUTLINETEXTMETRIC, and xterm.c. */ 2646 of underline. See OUTLINETEXTMETRIC, and xterm.c.
2647 Note: If you make this work, don't forget to change the
2648 doc string of x-use-underline-position-properties below. */
2643 if (s->face->underline_defaulted_p) 2649 if (s->face->underline_defaulted_p)
2644 { 2650 {
2645 w32_fill_area (s->f, s->hdc, s->gc->foreground, s->x, 2651 w32_fill_area (s->f, s->hdc, s->gc->foreground, s->x,
@@ -6707,6 +6713,18 @@ the cursor have no effect. */);
6707 &w32_use_visible_system_caret, 0)) 6713 &w32_use_visible_system_caret, 0))
6708 w32_use_visible_system_caret = 0; 6714 w32_use_visible_system_caret = 0;
6709 6715
6716 /* We don't yet support this, but defining this here avoids whining
6717 from cus-start.el and other places, like "M-x set-variable". */
6718 DEFVAR_BOOL ("x-use-underline-position-properties",
6719 &x_use_underline_position_properties,
6720 doc: /* *Non-nil means make use of UNDERLINE_POSITION font properties.
6721nil means ignore them. If you encounter fonts with bogus
6722UNDERLINE_POSITION font properties, for example 7x13 on XFree prior
6723to 4.1, set this to nil.
6724
6725NOTE: Not supported on MS-Windows yet. */);
6726 x_use_underline_position_properties = 0;
6727
6710 DEFVAR_LISP ("x-toolkit-scroll-bars", &Vx_toolkit_scroll_bars, 6728 DEFVAR_LISP ("x-toolkit-scroll-bars", &Vx_toolkit_scroll_bars,
6711 doc: /* If not nil, Emacs uses toolkit scroll bars. */); 6729 doc: /* If not nil, Emacs uses toolkit scroll bars. */);
6712 Vx_toolkit_scroll_bars = Qt; 6730 Vx_toolkit_scroll_bars = Qt;
diff --git a/src/window.c b/src/window.c
index 4d7c71f82c6..8e1a97ee1aa 100644
--- a/src/window.c
+++ b/src/window.c
@@ -3234,7 +3234,7 @@ selects the buffer of the selected window before each command. */)
3234 so that FRAME_FOCUS_FRAME is moved appropriately as we 3234 so that FRAME_FOCUS_FRAME is moved appropriately as we
3235 move around in the state where a minibuffer in a separate 3235 move around in the state where a minibuffer in a separate
3236 frame is active. */ 3236 frame is active. */
3237 Fselect_frame (WINDOW_FRAME (w), Qnil); 3237 Fselect_frame (WINDOW_FRAME (w));
3238 } 3238 }
3239 else 3239 else
3240 sf->selected_window = window; 3240 sf->selected_window = window;
diff --git a/src/xdisp.c b/src/xdisp.c
index 8d146ebcb23..71fa930a4c6 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -1901,7 +1901,7 @@ get_phys_cursor_geometry (w, row, glyph, heightp)
1901 int *heightp; 1901 int *heightp;
1902{ 1902{
1903 struct frame *f = XFRAME (WINDOW_FRAME (w)); 1903 struct frame *f = XFRAME (WINDOW_FRAME (w));
1904 int x, y, wd, h, h0, y0; 1904 int y, wd, h, h0, y0;
1905 1905
1906 /* Compute the width of the rectangle to draw. If on a stretch 1906 /* Compute the width of the rectangle to draw. If on a stretch
1907 glyph, and `x-stretch-block-cursor' is nil, don't draw a 1907 glyph, and `x-stretch-block-cursor' is nil, don't draw a
@@ -8358,7 +8358,6 @@ static Lisp_Object
8358format_mode_line_unwind_data (obuf) 8358format_mode_line_unwind_data (obuf)
8359 struct buffer *obuf; 8359 struct buffer *obuf;
8360{ 8360{
8361 int i = 0;
8362 Lisp_Object vector; 8361 Lisp_Object vector;
8363 8362
8364 /* Reduce consing by keeping one vector in 8363 /* Reduce consing by keeping one vector in
@@ -19302,7 +19301,7 @@ get_line_height_property (it, prop)
19302 struct it *it; 19301 struct it *it;
19303 Lisp_Object prop; 19302 Lisp_Object prop;
19304{ 19303{
19305 Lisp_Object position, val; 19304 Lisp_Object position;
19306 19305
19307 if (STRINGP (it->object)) 19306 if (STRINGP (it->object))
19308 position = make_number (IT_STRING_CHARPOS (*it)); 19307 position = make_number (IT_STRING_CHARPOS (*it));
@@ -19647,7 +19646,6 @@ x_produce_glyphs (it)
19647 else 19646 else
19648 { 19647 {
19649 Lisp_Object spacing; 19648 Lisp_Object spacing;
19650 int total = 0;
19651 19649
19652 it->phys_ascent = it->ascent; 19650 it->phys_ascent = it->ascent;
19653 it->phys_descent = it->descent; 19651 it->phys_descent = it->descent;
@@ -21664,7 +21662,7 @@ note_mode_line_or_margin_highlight (window, x, y, area)
21664 int ignore; 21662 int ignore;
21665 21663
21666 int vpos, hpos; 21664 int vpos, hpos;
21667 21665
21668 b = Fprevious_single_property_change (make_number (charpos + 1), 21666 b = Fprevious_single_property_change (make_number (charpos + 1),
21669 Qmouse_face, string, Qnil); 21667 Qmouse_face, string, Qnil);
21670 if (NILP (b)) 21668 if (NILP (b))
@@ -21712,18 +21710,18 @@ note_mode_line_or_margin_highlight (window, x, y, area)
21712 hpos = (area == ON_MODE_LINE 21710 hpos = (area == ON_MODE_LINE
21713 ? (w->current_matrix)->nrows - 1 21711 ? (w->current_matrix)->nrows - 1
21714 : 0); 21712 : 0);
21715 21713
21716 /* If the re-rendering position is included in the last 21714 /* If the re-rendering position is included in the last
21717 re-rendering area, we should do nothing. */ 21715 re-rendering area, we should do nothing. */
21718 if ( window == dpyinfo->mouse_face_window 21716 if ( EQ (window, dpyinfo->mouse_face_window)
21719 && dpyinfo->mouse_face_beg_col <= vpos 21717 && dpyinfo->mouse_face_beg_col <= vpos
21720 && vpos < dpyinfo->mouse_face_end_col 21718 && vpos < dpyinfo->mouse_face_end_col
21721 && dpyinfo->mouse_face_beg_row == hpos ) 21719 && dpyinfo->mouse_face_beg_row == hpos )
21722 return; 21720 return;
21723 21721
21724 if (clear_mouse_face (dpyinfo)) 21722 if (clear_mouse_face (dpyinfo))
21725 cursor = No_Cursor; 21723 cursor = No_Cursor;
21726 21724
21727 dpyinfo->mouse_face_beg_col = vpos; 21725 dpyinfo->mouse_face_beg_col = vpos;
21728 dpyinfo->mouse_face_beg_row = hpos; 21726 dpyinfo->mouse_face_beg_row = hpos;
21729 21727
@@ -21748,8 +21746,9 @@ note_mode_line_or_margin_highlight (window, x, y, area)
21748 if (NILP (pointer)) 21746 if (NILP (pointer))
21749 pointer = Qhand; 21747 pointer = Qhand;
21750 } 21748 }
21749 else if ((area == ON_MODE_LINE) || (area == ON_HEADER_LINE))
21750 clear_mouse_face (dpyinfo);
21751 } 21751 }
21752
21753 define_frame_cursor1 (f, cursor, pointer); 21752 define_frame_cursor1 (f, cursor, pointer);
21754} 21753}
21755 21754
diff --git a/src/xfaces.c b/src/xfaces.c
index fc8a0bc05af..25d11c066b0 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -6258,7 +6258,7 @@ DEFUN ("display-supports-face-attributes-p",
6258 1, 2, 0, 6258 1, 2, 0,
6259 doc: /* Return non-nil if all the face attributes in ATTRIBUTES are supported. 6259 doc: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
6260The optional argument DISPLAY can be a display name, a frame, or 6260The optional argument DISPLAY can be a display name, a frame, or
6261nil (meaning the selected frame's display) 6261nil (meaning the selected frame's display).
6262 6262
6263The definition of `supported' is somewhat heuristic, but basically means 6263The definition of `supported' is somewhat heuristic, but basically means
6264that a face containing all the attributes in ATTRIBUTES, when merged 6264that a face containing all the attributes in ATTRIBUTES, when merged
@@ -6271,7 +6271,7 @@ Point (2) implies that a `:weight black' attribute will be satisfied by
6271any display that can display bold, and a `:foreground \"yellow\"' as long 6271any display that can display bold, and a `:foreground \"yellow\"' as long
6272as it can display a yellowish color, but `:slant italic' will _not_ be 6272as it can display a yellowish color, but `:slant italic' will _not_ be
6273satisfied by the tty display code's automatic substitution of a `dim' 6273satisfied by the tty display code's automatic substitution of a `dim'
6274face for italic. */) 6274face for italic. */)
6275 (attributes, display) 6275 (attributes, display)
6276 Lisp_Object attributes, display; 6276 Lisp_Object attributes, display;
6277{ 6277{