aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiles Bader2004-11-04 08:55:40 +0000
committerMiles Bader2004-11-04 08:55:40 +0000
commitd1a3e560ff62e047d9fa8e8b3b1bc1e56e104c26 (patch)
tree935f61a936f33c7690a201b19b86e89c3d864b61
parent32dc0e8f9bc2d460b3d964c21989de70282bab61 (diff)
parent0683d2414d4de8626f7c46f59937f9bef27302ce (diff)
downloademacs-d1a3e560ff62e047d9fa8e8b3b1bc1e56e104c26.tar.gz
emacs-d1a3e560ff62e047d9fa8e8b3b1bc1e56e104c26.zip
Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-69
Merge from emacs--cvs-trunk--0 Patches applied: * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-643 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-649 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-650 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-651 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-655 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-656 Update from CVS: lisp/man.el (Man-xref-normal-file): Fix help-echo. * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-657 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-658 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-659 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-660 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-661 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-667 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-668 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-61 - miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-68 Update from CVS
-rw-r--r--ChangeLog9
-rw-r--r--admin/ChangeLog4
-rw-r--r--admin/FOR-RELEASE218
-rwxr-xr-xconfigure220
-rw-r--r--configure.in19
-rw-r--r--etc/NEWS43
-rw-r--r--etc/TODO2
-rw-r--r--etc/compilation.txt21
-rw-r--r--lisp/ChangeLog429
-rw-r--r--lisp/add-log.el36
-rw-r--r--lisp/allout.el61
-rw-r--r--lisp/apropos.el2
-rw-r--r--lisp/autorevert.el3
-rw-r--r--lisp/buff-menu.el5
-rw-r--r--lisp/calc/calc-frac.el7
-rw-r--r--lisp/calendar/icalendar.el724
-rw-r--r--lisp/comint.el2
-rw-r--r--lisp/cus-edit.el14
-rw-r--r--lisp/descr-text.el9
-rw-r--r--lisp/dired.el2
-rw-r--r--lisp/ehelp.el4
-rw-r--r--lisp/elide-head.el4
-rw-r--r--lisp/emacs-lisp/advice.el2
-rw-r--r--lisp/emacs-lisp/autoload.el11
-rw-r--r--lisp/emacs-lisp/bytecomp.el22
-rw-r--r--lisp/emacs-lisp/easy-mmode.el2
-rw-r--r--lisp/emacs-lisp/easymenu.el20
-rw-r--r--lisp/emacs-lisp/elp.el2
-rw-r--r--lisp/emacs-lisp/lselect.el16
-rw-r--r--lisp/emulation/cua-base.el5
-rw-r--r--lisp/eshell/em-unix.el2
-rw-r--r--lisp/fast-lock.el2
-rw-r--r--lisp/files.el213
-rw-r--r--lisp/gnus/ChangeLog155
-rw-r--r--lisp/gnus/deuglify.el3
-rw-r--r--lisp/gnus/gnus-agent.el4
-rw-r--r--lisp/gnus/gnus-art.el11
-rw-r--r--lisp/gnus/gnus-cite.el5
-rw-r--r--lisp/gnus/gnus-delay.el1
-rw-r--r--lisp/gnus/gnus-diary.el3
-rw-r--r--lisp/gnus/gnus-group.el5
-rw-r--r--lisp/gnus/gnus-msg.el6
-rw-r--r--lisp/gnus/gnus-registry.el1
-rw-r--r--lisp/gnus/gnus-spec.el18
-rw-r--r--lisp/gnus/gnus-srvr.el4
-rw-r--r--lisp/gnus/gnus-start.el2
-rw-r--r--lisp/gnus/gnus-sum.el72
-rw-r--r--lisp/gnus/gnus-win.el2
-rw-r--r--lisp/gnus/gnus.el3
-rw-r--r--lisp/gnus/html2text.el246
-rw-r--r--lisp/gnus/message.el7
-rw-r--r--lisp/gnus/mm-decode.el4
-rw-r--r--lisp/gnus/mm-url.el3
-rw-r--r--lisp/gnus/mm-util.el113
-rw-r--r--lisp/gnus/mm-uu.el1
-rw-r--r--lisp/gnus/mml-sec.el3
-rw-r--r--lisp/gnus/mml2015.el1
-rw-r--r--lisp/gnus/nndiary.el1
-rw-r--r--lisp/gnus/nnmail.el5
-rw-r--r--lisp/gnus/nnspool.el5
-rw-r--r--lisp/gnus/sha1.el2
-rw-r--r--lisp/gnus/sieve.el1
-rw-r--r--lisp/gnus/spam-stat.el1
-rw-r--r--lisp/gnus/starttls.el7
-rw-r--r--lisp/help-at-pt.el23
-rw-r--r--lisp/help-fns.el2
-rw-r--r--lisp/help.el2
-rw-r--r--lisp/ibuffer.el1
-rw-r--r--lisp/ido.el2
-rw-r--r--lisp/imenu.el49
-rw-r--r--lisp/info.el31
-rw-r--r--lisp/kmacro.el15
-rw-r--r--lisp/mail/emacsbug.el3
-rw-r--r--lisp/makefile.w32-in4
-rw-r--r--lisp/man.el2
-rw-r--r--lisp/menu-bar.el9
-rw-r--r--lisp/mouse-sel.el9
-rw-r--r--lisp/mouse.el102
-rw-r--r--lisp/net/eudc.el142
-rw-r--r--lisp/net/password.el184
-rw-r--r--lisp/net/tls.el3
-rw-r--r--lisp/obsolete/hilit19.el96
-rw-r--r--lisp/pcomplete.el8
-rw-r--r--lisp/play/5x5.el5
-rw-r--r--lisp/play/fortune.el4
-rw-r--r--lisp/progmodes/ada-xref.el6
-rw-r--r--lisp/progmodes/autoconf.el4
-rw-r--r--lisp/progmodes/compile.el14
-rw-r--r--lisp/progmodes/cperl-mode.el6
-rw-r--r--lisp/progmodes/flymake.el49
-rw-r--r--lisp/progmodes/gdb-ui.el146
-rw-r--r--lisp/progmodes/grep.el38
-rw-r--r--lisp/progmodes/idlw-shell.el6
-rw-r--r--lisp/progmodes/idlwave.el8
-rw-r--r--lisp/progmodes/vhdl-mode.el14
-rw-r--r--lisp/reveal.el79
-rw-r--r--lisp/shadowfile.el5
-rw-r--r--lisp/simple.el4
-rw-r--r--lisp/speedbar.el4
-rw-r--r--lisp/strokes.el2
-rw-r--r--lisp/subr.el59
-rw-r--r--lisp/tar-mode.el2
-rw-r--r--lisp/textmodes/bibtex.el1187
-rw-r--r--lisp/textmodes/texinfo.el4
-rw-r--r--lisp/thumbs.el7
-rw-r--r--lisp/toolbar/diropen.pbmbin0 -> 81 bytes
-rw-r--r--lisp/toolbar/diropen.xpm215
-rw-r--r--lisp/toolbar/tool-bar.el3
-rw-r--r--lisp/type-break.el35
-rw-r--r--lisp/url/ChangeLog12
-rw-r--r--lisp/url/url-imap.el2
-rw-r--r--lisp/url/url-irc.el2
-rw-r--r--lisp/url/url-news.el2
-rw-r--r--lisp/url/url-nfs.el2
-rw-r--r--lisp/vc-cvs.el77
-rw-r--r--lisp/vc-mcvs.el10
-rw-r--r--lisp/vc.el8
-rw-r--r--lisp/x-dnd.el5
-rw-r--r--lispref/ChangeLog25
-rw-r--r--lispref/advice.texi18
-rw-r--r--lispref/commands.texi77
-rw-r--r--lispref/frames.texi12
-rw-r--r--lispref/minibuf.texi61
-rw-r--r--lwlib/ChangeLog7
-rw-r--r--lwlib/xlwmenu.c25
-rw-r--r--man/ChangeLog18
-rw-r--r--man/emacs-mime.texi8
-rw-r--r--man/frames.texi5
-rw-r--r--man/idlwave.texi2
-rw-r--r--man/reftex.texi6
-rw-r--r--man/speedbar.texi4
-rw-r--r--src/.gdbinit28
-rw-r--r--src/ChangeLog233
-rw-r--r--src/ChangeLog.812
-rw-r--r--src/Makefile.in2
-rw-r--r--src/atimer.c3
-rw-r--r--src/callproc.c5
-rw-r--r--src/config.in9
-rw-r--r--src/dispnew.c2
-rw-r--r--src/editfns.c7
-rw-r--r--src/emacs.c1
-rw-r--r--src/eval.c46
-rw-r--r--src/fileio.c3
-rw-r--r--src/fontset.c4
-rw-r--r--src/gtkutil.c129
-rw-r--r--src/gtkutil.h3
-rw-r--r--src/indent.c53
-rw-r--r--src/insdel.c118
-rw-r--r--src/lisp.h2
-rw-r--r--src/macfns.c38
-rw-r--r--src/macterm.c40
-rw-r--r--src/process.c48
-rw-r--r--src/search.c2
-rw-r--r--src/syntax.c44
-rw-r--r--src/w32fns.c34
-rw-r--r--src/w32term.c4
-rw-r--r--src/window.c40
-rw-r--r--src/xdisp.c35
-rw-r--r--src/xfns.c89
-rw-r--r--src/xmenu.c24
-rw-r--r--src/xselect.c20
-rw-r--r--src/xterm.c4
162 files changed, 4587 insertions, 2306 deletions
diff --git a/ChangeLog b/ChangeLog
index f215921b6e6..fea2ce35e64 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
12004-11-02 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
2
3 * configure.in (HAVE_GTK_FILE_CHOOSER, $HAVE_GTK_FILE_SELECTION): New
4 tests for new and old GTK file dialogs.
5 (HAVE_GTK): Only set with_toolkit_scroll_bars if not explicitly set
6 to no.
7
8 * configure: Rebuild
9
12004-10-20 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> 102004-10-20 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
2 11
3 * configure.in (HAVE_PERSONALITY_LINUX32): New test if PER_LINUX32 12 * configure.in (HAVE_PERSONALITY_LINUX32): New test if PER_LINUX32
diff --git a/admin/ChangeLog b/admin/ChangeLog
index 3c67f2e1bbb..ac21c3aeabc 100644
--- a/admin/ChangeLog
+++ b/admin/ChangeLog
@@ -1,3 +1,7 @@
12004-11-02 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
2
3 * FOR-RELEASE (Indications): Remove two stage update for toolbar (Done).
4
12004-09-20 Luc Teirlinck <teirllm@auburn.edu> 52004-09-20 Luc Teirlinck <teirllm@auburn.edu>
2 6
3 * FOR-RELEASE (Indications): Rearrange checklists for Emacs and 7 * FOR-RELEASE (Indications): Rearrange checklists for Emacs and
diff --git a/admin/FOR-RELEASE b/admin/FOR-RELEASE
index 1898cf4dea4..e5e719f9037 100644
--- a/admin/FOR-RELEASE
+++ b/admin/FOR-RELEASE
@@ -8,6 +8,8 @@ Tasks needed before the next release.
8 8
9** Face remapping. 9** Face remapping.
10 10
11** Let mouse-1 follow links.
12
11 13
12* FATAL ERRORS 14* FATAL ERRORS
13 15
@@ -18,12 +20,228 @@ redisplay uses an invalidated face_id with FACE_FROM_ID
18which then returns a NULL pointer. Said to happen with 20which then returns a NULL pointer. Said to happen with
19isearch faces. 21isearch faces.
20 22
23** Investigate reported crashes in compact_small_strings.
24
25** Investigate reported crashes related to using an
26invalid pointer from string_free_list.
27
28
29* LOSSAGE
30
31** Clean up flymake.el to follow Emacs Lisp conventions.
32
21 33
22* GTK RELATED BUGS 34* GTK RELATED BUGS
23 35
24** Make GTK scrollbars behave like others w.r.t. overscrolling. 36** Make GTK scrollbars behave like others w.r.t. overscrolling.
25 37
26 38
39* REDISPLAY RELATED BUGS
40
41** Avoid unbreakable loops in redisplay.
42
43Redisplay may loop if there is an error in some display property, e.g.
44 (space 'left-margin)
45
46A fix would be to somehow disable handling of display properties if an error
47is encountered.
48
49** Problem with cursor border around images and window-margins:
50
51The border around the image when the cursor is on the image
52flows into the right fringe and margin.
53
54 (progn
55 (auto-image-file-mode 1)
56 (find-file (concat data-directory "splash.xpm"))
57 (set-window-margins (selected-window) 25 25))
58
59
60** Problem with modeline and window margins:
61
62The mode line's right "box" line is misplaced under the right margin,
63rather than at the right window edge.
64
65emacs -Q
66(set-window-margins nil 25 25)
67C-x 2
68
69
70** custom mode-line face makes Emacs freeze up
71
72From: Stephen Berman <Stephen.Berman@gmx.net>
73Date: Sun, 24 Oct 2004 02:08:56 +0200
74
751. Start Emacs with -q -no-site-file.
76
772. Type `M-x customize-face' and at the prompt `mode-line'.
78
793. In the Custom buffer for mode-line face
80 a. check width and give it the value `narrow';
81 b. check height and give it the value 120 in 1/10 pt;
82 c. check underline and give it the value `on' (or `colored');
83 d. check overline and give it the value `on' (or `colored').
84
854. Set for current session.
86
875. Invoke Ediff on any two files.
88
896. Now Emacs is frozen and consumes 95-99% of CPU.
90
91The customizations in step 3 appear to be the minimum necessary to
92induce this bug. Leave out any one of them and Ediff runs without a
93problem. Also if the 1/10 point value of height is 130 or greater
94there's no bug (with the default font family; with e.g. Helvetica the
95bug is induced only by a value of 100 or less).
96
97I've noticed this freeze up only when invoking Ediff. The only thing
98I've been able to do is kill Emacs externally, via top or with kill
99when run in gdb, after interrupting. When the freeze up happens
100within a gdb session, there is no automatic debugging feedback. After
101interrupting I can get a backtrace, here's an example:
102
103Update: Maybe only reveals itself when compiled with GTK+
104
105
106** Mouse-face overlay bleeds into header line
107
108From: Stephen Berman <Stephen.Berman@gmx.net>
109Date: Thu, 21 Oct 2004 18:11:01 +0200
110
111Mouse-face overlays bleed into the header line when the beginning of
112the overlay is above (point-min). To reproduce:
113
1141. Start Emacs with -q -no-site-file.
115
1162. In *scratch* eval (setq ov (make-overlay 66 92)), (overlay-put ov
117'mouse-face 'highlight), and (setq header-line-format "test").
118
1193. Drag the mouse over the string "evaluation.\n;; If you want" and
120notice the highlighting of only this string.
121
1224. Now click on the down arrow in the scroll bar until the line
123beginning ";; If you want" is directly below the header line.
124
1255. Drag the mouse over ";; If you want" and notice that not only it
126but also the header line are highlighted.
127
128
129** scroll-preserve-screen-position doesn't work with a header-line-format
130
131From: jbyler+emacs-lists@anon41.eml.cc
132Date: Tue, 17 Aug 2004 17:10:14 -0400
133
134There seems to be an off-by-one error triggered by using a header line
135together with scroll-preserve-screen-position. The symptom: instead of
136staying in the same position on the screen when scrolling, the cursor
137moves one screen line down each time the buffer is scrolled. Put
138another way: repeatedly typing C-v M-v or using a mouse scroll wheel to
139scroll up and down causes the cursor to migrate slowly down the screen
140instead of staying put as it should.
141
142To reproduce:
143
144emacs -q --no-site-file
145(setq scroll-preserve-screen-position t)
146(setq header-line-format "")
147C-v M-v C-v M-v C-v M-v etc.
148
149
150** Clicking on partially visible lines fails
151
152From: David Kastrup <dak@gnu.org>
153Date: 27 Apr 2004 16:42:58 +0200
154
155I had gnus display a mouse-highlighted line (a URL from browse-url)
156partially at the bottom of its window. If I click with middle mouse
157key on it, the window gets recentered while I hold the mouse key
158pressed. If I release it, the window returns into its old position
159(cursor in top row) and nothing happens, presumably because the click
160was not registered on the line itself, but on the magically
161recentered version.
162
163That is a nuisance. Recentering of even partially visible click
164targets should only happen if window-point moves there, but not at
165the time of the click. From the moment I hold down a key until it
166gets released, the displayed window portion should not change, with
167the sole exception of scrolling when dragging at the edge of the
168screen.
169
170
171** Can't drag modeline when mouse-autoselect-window is set
172
173From: Klaus Zeitler <kzeitler@lucent.com>
174Date: Mon, 11 Oct 2004 11:14:49 +0200
175
1761. start emacs -q --no-site-file
1772. set variable mouse-autoselect-window to t
1783. split-window-vertically
179
180now I can drag the modeline only upwards but not downwards
181
182
183** line-spacing and (recenter -1)
184
185From: SAITO Takuya <tabmore@rivo.mediatti.net>
186Date: Mon, 31 May 2004 02:07:57 +0900 (JST)
187
188(recenter -1) does not show point at the bottom of the window
189if line-spacing is set to positive integer.
190
191Start emacs -Q, and evaluate below:
192
193(progn
194 (setq line-spacing 1)
195 (dotimes (i (window-height))
196 (insert "\n" (int-to-string i)))
197 (recenter -1))
198
199Then, point is displayed at the center of the window.
200But point should be displayed at the bottom of the window like Emacs-21.3.
201
202
203** line-spacing and garbage in fringe
204
205From: SAITO Takuya <tabmore@rivo.mediatti.net>
206Date: Mon, 31 May 2004 02:08:05 +0900 (JST)
207
208Start emacs -Q and evaluate below with C-xC-e:
209
210(let ((lines 2)
211 (spacing 1))
212 (setq line-spacing spacing
213 indicate-buffer-boundaries t)
214 (insert (make-string (window-height) ?\n))
215 (goto-char (point-min))
216 (message (make-string (* (window-width) lines) ?.))
217 (scroll-up 1))
218
219then, garbage is displayed in right fringe.
220
221Above code reproduces this bug with
222(frame-parameter nil 'font)
223=> "-Adobe-Courier-Medium-R-Normal--12-120-75-75-M-70-ISO8859-1"
224
225If you use different font, you may need different value of
226`lines' and/or `spacing'.
227
228
229** line-spacing and Electric-pop-up-window
230
231From: SAITO Takuya <tabmore@rivo.mediatti.net>
232Date: Mon, 31 May 2004 02:08:10 +0900 (JST)
233
234Electric-pop-up-window does not work well
235if truncate long lines disabled and/or
236`line-spacing' is set to positive integer.
237
238For example, start emacs -Q --line-spacing 1, and type M-` .
239Then, the last line of *Completions* buffer is not visible.
240
241fit-window-to-buffer works well for me, so I guess
242Electric-pop-up-window can use it.
243
244
27* DOCUMENTATION 245* DOCUMENTATION
28 246
29** Finish updating the Emacs Lisp manual. 247** Finish updating the Emacs Lisp manual.
diff --git a/configure b/configure
index 316babd4d3c..c776e1fd633 100755
--- a/configure
+++ b/configure
@@ -9797,7 +9797,9 @@ _ACEOF
9797 9797
9798 USE_X_TOOLKIT=none 9798 USE_X_TOOLKIT=none
9799 9799
9800 with_toolkit_scroll_bars=yes 9800 if test "$with_toolkit_scroll_bars" != no; then
9801 with_toolkit_scroll_bars=yes
9802 fi
9801 9803
9802 HAVE_GTK_MULTIDISPLAY=no 9804 HAVE_GTK_MULTIDISPLAY=no
9803 9805
@@ -9909,6 +9911,222 @@ cat >>confdefs.h <<\_ACEOF
9909_ACEOF 9911_ACEOF
9910 9912
9911 fi 9913 fi
9914 HAVE_GTK_FILE_SELECTION=no
9915
9916for ac_func in gtk_file_selection_new
9917do
9918as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
9919echo "$as_me:$LINENO: checking for $ac_func" >&5
9920echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
9921if eval "test \"\${$as_ac_var+set}\" = set"; then
9922 echo $ECHO_N "(cached) $ECHO_C" >&6
9923else
9924 cat >conftest.$ac_ext <<_ACEOF
9925/* confdefs.h. */
9926_ACEOF
9927cat confdefs.h >>conftest.$ac_ext
9928cat >>conftest.$ac_ext <<_ACEOF
9929/* end confdefs.h. */
9930/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
9931 For example, HP-UX 11i <limits.h> declares gettimeofday. */
9932#define $ac_func innocuous_$ac_func
9933
9934/* System header to define __stub macros and hopefully few prototypes,
9935 which can conflict with char $ac_func (); below.
9936 Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
9937 <limits.h> exists even on freestanding compilers. */
9938
9939#ifdef __STDC__
9940# include <limits.h>
9941#else
9942# include <assert.h>
9943#endif
9944
9945#undef $ac_func
9946
9947/* Override any gcc2 internal prototype to avoid an error. */
9948#ifdef __cplusplus
9949extern "C"
9950{
9951#endif
9952/* We use char because int might match the return type of a gcc2
9953 builtin and then its argument prototype would still apply. */
9954char $ac_func ();
9955/* The GNU C library defines this for functions which it implements
9956 to always fail with ENOSYS. Some functions are actually named
9957 something starting with __ and the normal name is an alias. */
9958#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
9959choke me
9960#else
9961char (*f) () = $ac_func;
9962#endif
9963#ifdef __cplusplus
9964}
9965#endif
9966
9967int
9968main ()
9969{
9970return f != $ac_func;
9971 ;
9972 return 0;
9973}
9974_ACEOF
9975rm -f conftest.$ac_objext conftest$ac_exeext
9976if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
9977 (eval $ac_link) 2>conftest.er1
9978 ac_status=$?
9979 grep -v '^ *+' conftest.er1 >conftest.err
9980 rm -f conftest.er1
9981 cat conftest.err >&5
9982 echo "$as_me:$LINENO: \$? = $ac_status" >&5
9983 (exit $ac_status); } &&
9984 { ac_try='test -z "$ac_c_werror_flag"
9985 || test ! -s conftest.err'
9986 { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
9987 (eval $ac_try) 2>&5
9988 ac_status=$?
9989 echo "$as_me:$LINENO: \$? = $ac_status" >&5
9990 (exit $ac_status); }; } &&
9991 { ac_try='test -s conftest$ac_exeext'
9992 { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
9993 (eval $ac_try) 2>&5
9994 ac_status=$?
9995 echo "$as_me:$LINENO: \$? = $ac_status" >&5
9996 (exit $ac_status); }; }; then
9997 eval "$as_ac_var=yes"
9998else
9999 echo "$as_me: failed program was:" >&5
10000sed 's/^/| /' conftest.$ac_ext >&5
10001
10002eval "$as_ac_var=no"
10003fi
10004rm -f conftest.err conftest.$ac_objext \
10005 conftest$ac_exeext conftest.$ac_ext
10006fi
10007echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
10008echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
10009if test `eval echo '${'$as_ac_var'}'` = yes; then
10010 cat >>confdefs.h <<_ACEOF
10011#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
10012_ACEOF
10013 HAVE_GTK_FILE_SELECTION=yes
10014fi
10015done
10016
10017
10018 HAVE_GTK_FILE_CHOOSER=no
10019
10020for ac_func in gtk_file_chooser_dialog_new
10021do
10022as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
10023echo "$as_me:$LINENO: checking for $ac_func" >&5
10024echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
10025if eval "test \"\${$as_ac_var+set}\" = set"; then
10026 echo $ECHO_N "(cached) $ECHO_C" >&6
10027else
10028 cat >conftest.$ac_ext <<_ACEOF
10029/* confdefs.h. */
10030_ACEOF
10031cat confdefs.h >>conftest.$ac_ext
10032cat >>conftest.$ac_ext <<_ACEOF
10033/* end confdefs.h. */
10034/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
10035 For example, HP-UX 11i <limits.h> declares gettimeofday. */
10036#define $ac_func innocuous_$ac_func
10037
10038/* System header to define __stub macros and hopefully few prototypes,
10039 which can conflict with char $ac_func (); below.
10040 Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
10041 <limits.h> exists even on freestanding compilers. */
10042
10043#ifdef __STDC__
10044# include <limits.h>
10045#else
10046# include <assert.h>
10047#endif
10048
10049#undef $ac_func
10050
10051/* Override any gcc2 internal prototype to avoid an error. */
10052#ifdef __cplusplus
10053extern "C"
10054{
10055#endif
10056/* We use char because int might match the return type of a gcc2
10057 builtin and then its argument prototype would still apply. */
10058char $ac_func ();
10059/* The GNU C library defines this for functions which it implements
10060 to always fail with ENOSYS. Some functions are actually named
10061 something starting with __ and the normal name is an alias. */
10062#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
10063choke me
10064#else
10065char (*f) () = $ac_func;
10066#endif
10067#ifdef __cplusplus
10068}
10069#endif
10070
10071int
10072main ()
10073{
10074return f != $ac_func;
10075 ;
10076 return 0;
10077}
10078_ACEOF
10079rm -f conftest.$ac_objext conftest$ac_exeext
10080if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
10081 (eval $ac_link) 2>conftest.er1
10082 ac_status=$?
10083 grep -v '^ *+' conftest.er1 >conftest.err
10084 rm -f conftest.er1
10085 cat conftest.err >&5
10086 echo "$as_me:$LINENO: \$? = $ac_status" >&5
10087 (exit $ac_status); } &&
10088 { ac_try='test -z "$ac_c_werror_flag"
10089 || test ! -s conftest.err'
10090 { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
10091 (eval $ac_try) 2>&5
10092 ac_status=$?
10093 echo "$as_me:$LINENO: \$? = $ac_status" >&5
10094 (exit $ac_status); }; } &&
10095 { ac_try='test -s conftest$ac_exeext'
10096 { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
10097 (eval $ac_try) 2>&5
10098 ac_status=$?
10099 echo "$as_me:$LINENO: \$? = $ac_status" >&5
10100 (exit $ac_status); }; }; then
10101 eval "$as_ac_var=yes"
10102else
10103 echo "$as_me: failed program was:" >&5
10104sed 's/^/| /' conftest.$ac_ext >&5
10105
10106eval "$as_ac_var=no"
10107fi
10108rm -f conftest.err conftest.$ac_objext \
10109 conftest$ac_exeext conftest.$ac_ext
10110fi
10111echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
10112echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
10113if test `eval echo '${'$as_ac_var'}'` = yes; then
10114 cat >>confdefs.h <<_ACEOF
10115#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
10116_ACEOF
10117 HAVE_GTK_FILE_CHOOSER=yes
10118fi
10119done
10120
10121
10122 if test "$HAVE_GTK_FILE_SELECTION" = yes \
10123 && test "$HAVE_GTK_FILE_CHOOSER" = yes; then
10124
10125cat >>confdefs.h <<\_ACEOF
10126#define HAVE_GTK_FILE_BOTH 1
10127_ACEOF
10128
10129 fi
9912fi 10130fi
9913 10131
9914if test x"${USE_X_TOOLKIT}" = xmaybe; then 10132if test x"${USE_X_TOOLKIT}" = xmaybe; then
diff --git a/configure.in b/configure.in
index 48ea02a351f..1478d4d4b5d 100644
--- a/configure.in
+++ b/configure.in
@@ -1967,7 +1967,9 @@ if test "${with_gtk}" = "yes" || test "$USE_X_TOOLKIT" = "gtk"; then
1967 1967
1968 dnl GTK scrollbars resemble toolkit scrollbars a lot, so to avoid 1968 dnl GTK scrollbars resemble toolkit scrollbars a lot, so to avoid
1969 dnl a lot if #ifdef:s, say we have toolkit scrollbars. 1969 dnl a lot if #ifdef:s, say we have toolkit scrollbars.
1970 with_toolkit_scroll_bars=yes 1970 if test "$with_toolkit_scroll_bars" != no; then
1971 with_toolkit_scroll_bars=yes
1972 fi
1971 1973
1972 dnl Check if we can use multiple displays with this GTK version. 1974 dnl Check if we can use multiple displays with this GTK version.
1973 dnl If gdk_display_open exists, assume all others are there also. 1975 dnl If gdk_display_open exists, assume all others are there also.
@@ -1977,6 +1979,21 @@ if test "${with_gtk}" = "yes" || test "$USE_X_TOOLKIT" = "gtk"; then
1977 AC_DEFINE(HAVE_GTK_MULTIDISPLAY, 1, 1979 AC_DEFINE(HAVE_GTK_MULTIDISPLAY, 1,
1978 [Define to 1 if GTK can handle more than one display.]) 1980 [Define to 1 if GTK can handle more than one display.])
1979 fi 1981 fi
1982 dnl Check if we have the old file selection dialog.
1983 dnl If gdk_display_open exists, assume all others are there also.
1984 HAVE_GTK_FILE_SELECTION=no
1985 AC_CHECK_FUNCS(gtk_file_selection_new, HAVE_GTK_FILE_SELECTION=yes)
1986
1987 dnl Check if we have the new file chooser dialog
1988 dnl If gdk_display_open exists, assume all others are there also.
1989 HAVE_GTK_FILE_CHOOSER=no
1990 AC_CHECK_FUNCS(gtk_file_chooser_dialog_new, HAVE_GTK_FILE_CHOOSER=yes)
1991
1992 if test "$HAVE_GTK_FILE_SELECTION" = yes \
1993 && test "$HAVE_GTK_FILE_CHOOSER" = yes; then
1994 AC_DEFINE(HAVE_GTK_FILE_BOTH, 1,
1995 [Define to 1 if GTK has both file selection and chooser dialog.])
1996 fi
1980fi 1997fi
1981 1998
1982dnl Do not put whitespace before the #include statements below. 1999dnl Do not put whitespace before the #include statements below.
diff --git a/etc/NEWS b/etc/NEWS
index 718faca4ea8..ab810850722 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -718,14 +718,17 @@ version 4.7 or newer, compiles to Info pages with embedded images.
718 718
719** BibTeX mode: 719** BibTeX mode:
720*** The new command bibtex-url browses a URL for the BibTeX entry at 720*** The new command bibtex-url browses a URL for the BibTeX entry at
721point (bound to C-c C-l and mouse-2 on clickable fields). 721point (bound to C-c C-l and mouse-2, RET on clickable fields).
722
722*** The new command bibtex-entry-update (bound to C-c C-u) updates 723*** The new command bibtex-entry-update (bound to C-c C-u) updates
723an existing BibTeX entry. 724an existing BibTeX entry.
725
724*** New `bibtex-entry-format' option `required-fields', enabled by default. 726*** New `bibtex-entry-format' option `required-fields', enabled by default.
727
725*** bibtex-maintain-sorted-entries can take values `plain', 728*** bibtex-maintain-sorted-entries can take values `plain',
726`crossref', and `entry-class' which control the sorting scheme used 729`crossref', and `entry-class' which control the sorting scheme used
727for BibTeX entries. `bibtex-sort-entry-class' controls the sorting 730for BibTeX entries. `bibtex-sort-entry-class' controls the sorting
728scheme `entry-class'. TAB completion for reference keys and 731scheme `entry-class'. TAB completion for reference keys and
729automatic detection of duplicates does not require anymore that 732automatic detection of duplicates does not require anymore that
730bibtex-maintain-sorted-entries is non-nil. 733bibtex-maintain-sorted-entries is non-nil.
731 734
@@ -742,11 +745,22 @@ types for which fields are filled automatically (if possible).
742point according to context (bound to M-tab). 745point according to context (bound to M-tab).
743 746
744*** The new commands bibtex-find-entry and bibtex-find-crossref 747*** The new commands bibtex-find-entry and bibtex-find-crossref
745locate entries and crossref'd entries. 748locate entries and crossref'd entries. Crossref fields are clickable
749(bound to mouse-2, RET).
746 750
747*** In BibTeX mode the command fill-paragraph (bound to M-q) fills 751*** In BibTeX mode the command fill-paragraph (bound to M-q) fills
748individual fields of a BibTeX entry. 752individual fields of a BibTeX entry.
749 753
754*** The new command bibtex-validate-globally checks for duplicate keys
755in multiple BibTeX files. See also the new variables bibtex-files
756and bibtex-file-path.
757
758*** The new command bibtex-find-entry-globally searches BibTeX entries
759in multiple BibTeX files.
760
761*** The new command bibtex-copy-summary-as-kill pushes summary
762of BibTeX entry to kill ring (bound to C-c C-t).
763
750** When display margins are present in a window, the fringes are now 764** When display margins are present in a window, the fringes are now
751displayed between the margins and the buffer's text area, rather than 765displayed between the margins and the buffer's text area, rather than
752at the edges of the window. 766at the edges of the window.
@@ -945,6 +959,9 @@ coding system now also encodes characters from most of Emacs's
945one-dimensional internal charsets, specifically the ISO-8859 ones. 959one-dimensional internal charsets, specifically the ISO-8859 ones.
946The utf-16 coding system is affected similarly. 960The utf-16 coding system is affected similarly.
947 961
962** New variable `utf-translate-cjk-unicode-range' controls which
963Unicode characters to translate in `utf-translate-cjk-mode'.
964
948** iso-10646-1 (`Unicode') fonts can be used to display any range of 965** iso-10646-1 (`Unicode') fonts can be used to display any range of
949characters encodable by the utf-8 coding system. Just specify the 966characters encodable by the utf-8 coding system. Just specify the
950fontset appropriately. 967fontset appropriately.
@@ -999,6 +1016,11 @@ be navigated with the arrow keys (like Gtk+ and W32).
999disabled by customizing the variable `use-file-dialog'. 1016disabled by customizing the variable `use-file-dialog'.
1000 1017
1001+++ 1018+++
1019** For Gtk+ version 2.4, you can make Emacs use the old file dialog
1020by setting the variable `use-old-gtk-file-dialog' to t. Default is to use
1021the new dialog.
1022
1023+++
1002** Emacs can produce an underscore-like (horizontal bar) cursor. 1024** Emacs can produce an underscore-like (horizontal bar) cursor.
1003The underscore cursor is set by putting `(cursor-type . hbar)' in 1025The underscore cursor is set by putting `(cursor-type . hbar)' in
1004default-frame-alist. It supports variable heights, like the `bar' 1026default-frame-alist. It supports variable heights, like the `bar'
@@ -2371,6 +2393,13 @@ configuration files.
2371* Lisp Changes in Emacs 21.4 2393* Lisp Changes in Emacs 21.4
2372 2394
2373+++ 2395+++
2396** The new function `called-interactively-p' does what many people
2397have mistakenly believed `interactively-p' did: it returns t if the
2398calling function was called through `call-interactively'.
2399This should only be used when you cannot add a new "interactively"
2400argument to the command.
2401
2402+++
2374** An interactive specification may now use the code letter 'U' to get 2403** An interactive specification may now use the code letter 'U' to get
2375the up-event that was discarded in case the last key sequence read for a 2404the up-event that was discarded in case the last key sequence read for a
2376previous 'k' or 'K' argument was a down-event; otherwise nil is used. 2405previous 'k' or 'K' argument was a down-event; otherwise nil is used.
@@ -3178,11 +3207,13 @@ KEEP-MARGINS which will preserve the window's current margin, fringe,
3178and scroll-bar settings if non-nil. 3207and scroll-bar settings if non-nil.
3179 3208
3180+++ 3209+++
3181** Renamed file hooks to follow the convention: 3210** Renamed hooks to better follow the naming convention:
3182find-file-hooks to find-file-hook, 3211find-file-hooks to find-file-hook,
3183find-file-not-found-hooks to find-file-not-found-functions, 3212find-file-not-found-hooks to find-file-not-found-functions,
3184write-file-hooks to write-file-functions, 3213write-file-hooks to write-file-functions,
3185write-contents-hooks to write-contents-functions. 3214write-contents-hooks to write-contents-functions,
3215x-lost-selection-hooks to x-lost-selection-functions,
3216x-sent-selection-hooks to x-sent-selection-functions.
3186Marked local-write-file-hooks as obsolete (use the LOCAL arg of `add-hook'). 3217Marked local-write-file-hooks as obsolete (use the LOCAL arg of `add-hook').
3187 3218
3188+++ 3219+++
diff --git a/etc/TODO b/etc/TODO
index defc43892c2..21a7c7d8dc0 100644
--- a/etc/TODO
+++ b/etc/TODO
@@ -85,6 +85,8 @@ to the FSF.
85 at the same time and do it in a context-sensitive way. 85 at the same time and do it in a context-sensitive way.
86*** ability to add mode-specific data to the partial-parse-state. 86*** ability to add mode-specific data to the partial-parse-state.
87 87
88** Add a way to convert a keyboard macro to equivalent Lisp code.
89
88** Have a command suggestion help system that recognizes patterns 90** Have a command suggestion help system that recognizes patterns
89 of commands which could be replaced with a simpler common command. 91 of commands which could be replaced with a simpler common command.
90 It should not make more than one suggestion per 10 minutes. 92 It should not make more than one suggestion per 10 minutes.
diff --git a/etc/compilation.txt b/etc/compilation.txt
index ff86583299d..bae217e8323 100644
--- a/etc/compilation.txt
+++ b/etc/compilation.txt
@@ -108,6 +108,24 @@ symbol: epc
108Error 24 at (2:progran.f90) : syntax error 108Error 24 at (2:progran.f90) : syntax error
109 109
110 110
111* Fortran checker
112
113symbols: ftnchek-file ftnchek-line-file ftnchek-line
114
115File average.f:
116
117Warning in module COMPAV: Variables may be used before set:
118 SUM used at line 14
119 SUM set at line 14
120
121Warning near line 16 col 20: integer quotient expr I/J converted to real
122
123 Dummy arg W in module SUBA line 8 file arrayclash.f is array
124 L4 used at line 55 file test/assign.f; never set
125Warning near line 10 file arrayclash.f: Module contains no executable
126Nonportable usage near line 31 col 9 file assign.f: mixed default and explicit
127
128
111* IAR Systems C Compiler 129* IAR Systems C Compiler
112 130
113symbol: iar 131symbol: iar
@@ -125,7 +143,7 @@ foo.c(3:8) : warning EDC0833: Implicit return statement encountered.
125foo.c(5:5) : error EDC0350: Syntax error. 143foo.c(5:5) : error EDC0350: Syntax error.
126 144
127 145
128* Ultrix MIPS RISC CC & DEC AXP OSF/1 cc & IRIX 5.2 146* Ultrix MIPS RISC CC, DEC AXP OSF/1 cc, IRIX 5.2 & NAG Fortran
129 147
130symbol: irix 148symbol: irix
131 149
@@ -136,6 +154,7 @@ cfe: Warning 712: foo.c, line 2: illegal combination of pointer and ...
136cfe: Warning 600: xfe.c: 170: Not in a conditional directive while ... 154cfe: Warning 600: xfe.c: 170: Not in a conditional directive while ...
137/usr/lib/cmplrs/cc/cfe: Error: foo.c: 1: blah blah 155/usr/lib/cmplrs/cc/cfe: Error: foo.c: 1: blah blah
138/usr/lib/cmplrs/cc/cfe: warning: foo.c: 1: blah blah 156/usr/lib/cmplrs/cc/cfe: warning: foo.c: 1: blah blah
157foo bar: baz.f, line 27: ...
139 158
140 159
141* Java Exception & Valgrind (memory debugger for x86 GNU/Linux) 160* Java Exception & Valgrind (memory debugger for x86 GNU/Linux)
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 260dfb22af5..3b3579e3908 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,421 @@
12004-11-03 Daniel Pfeiffer <occitan@esperanto.org>
2
3 * files.el (xml-based-modes): Delete var.
4 (magic-mode-alist): New more general var.
5 (set-auto-mode): Use it.
6
7 * buff-menu.el (Buffer-menu-make-sort-button): Preserve point even
8 when clicking from another window.
9
102004-11-03 Thien-Thi Nguyen <ttn@gnu.org>
11
12 * vc-cvs.el (vc-cvs-local-month-numbers): Delete var.
13 (vc-cvs-annotate-time): Incorporate value of deleted var.
14 Remove special-case handling of beginning-of-buffer cruft.
15 Cache ending position (point) and return value in text property
16 `vc-cvs-annotate-time', and consult it on subsequent invocations.
17
18 * vc-cvs.el (vc-cvs-annotate-command):
19 Delete extraneous lines from beginning of buffer.
20 * vc-mcvs.el (vc-mcvs-annotate-command): Likewise.
21
22 * progmodes/grep.el (grep-default-command): Take empty string
23 for tag if all other methods yield nil. Shell-quote the tag.
24
25 * vc.el (vc-annotate-display-autoscale): Add prefix-arg
26 spec in `interactive' form, and mention it in the docstring.
27 Also, make sure point is at bol after calling `annotate-time'.
28
292004-11-02 Richard M. Stallman <rms@gnu.org>
30
31 * emacs-lisp/elp.el (elp-instrument-function):
32 Use called-interactively-p.
33
34 * emacs-lisp/easymenu.el (easy-menu-intern):
35 Don't downcase; rather, case-flip the first letter of each word.
36
37 * emacs-lisp/easy-mmode.el (define-minor-mode):
38 Use called-interactively-p.
39
40 * emacs-lisp/bytecomp.el (byte-compile-warning-types):
41 Add interactive-only.
42 (byte-compile-warnings): Add interactive-only as option.
43 (byte-compile-interactive-only-functions): New variable.
44 (byte-compile-form): Warn about calls to functions
45 in byte-compile-interactive-only-functions.
46
47 * emacs-lisp/autoload.el (update-file-autoloads):
48 Don't use interactive-p; take new arg SAVE-AFTER.
49
50 * emacs-lisp/advice.el (ad-make-advised-definition):
51 Use called-interactively-p.
52
532004-11-02 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
54
55 * files.el (find-file-existing): New function.
56
57 * menu-bar.el (menu-bar-files-menu): Make "Open File..." call
58 find-file-existing. Add "New File..." that calls find-file.
59
60 * diropen.pbm diropen.xpm: New files.
61
62 * toolbar/tool-bar.el (tool-bar-setup): Tool bar item dired uses
63 icon diropen. New tool bar item find-file-existing uses icon open.
64
65 * dired.el (dired-read-dir-and-switches): Call read-driectory-name
66 instead of read-file-name.
67
682004-11-02 Ulf Jasper <ulf.jasper@web.de>
69
70 * calendar/icalendar.el (icalendar-version): Increase to 0.08.
71 (icalendar--split-value): Change name of work buffer.
72 (icalendar--get-weekday-abbrev): Return nil on error.
73 (icalendar--date-to-isodate): New function.
74 (icalendar-convert-diary-to-ical)
75 (icalendar-extract-ical-from-buffer): Use only two args for
76 make-obsolete (XEmacs compatibility).
77 (icalendar-export-file, icalendar-import-file): Blank at end of
78 prompt.
79 (icalendar-export-region): Doc fix.
80 If error, return non-nil and write errors to a buffer.
81 Use correct weekday for weekly recurring events.
82 Check whether date has been parsed for ordinary events.
83 Make weekly events start in the year 2000.
84 DTEND is non-inclusive, shift end date by one day if
85 necessary (not for entries that have date and time).
86 Rename local let variables: oops -> found-error, datestring ->
87 startdatestring.
88
892004-11-02 Kim F. Storm <storm@cua.dk>
90
91 * files.el (set-auto-mode-0): Don't rely on dynamic binding of
92 keep-mode-if-same variable. Add it as optional arg instead.
93 (set-auto-mode): Call set-auto-mode-0 with keep-mode-if-same.
94
95 * ehelp.el (electric-help-map): Reorder Q/q and R/r entries so
96 substitute-command-keys will select lower-case bindings like those
97 used in the static help texts.
98
99 * descr-text.el (describe-text-properties): Don't err if called in
100 the *Help* buffer; output to *Help-2* buffer instead.
101
102 * kmacro.el (group kmacro): Add :version.
103 (kmacro-keyboard-quit): New function to cleanup on C-g.
104 (kmacro-start-macro): Set defining-kbd-macro to append when
105 appending to last macro.
106
107 * simple.el (keyboard-quit): Call kmacro-keyboard-quit.
108
1092004-11-02 Nick Roberts <nickrob@snap.net.nz>
110
111 * progmodes/gdb-ui.el (gdb-enable-debug-log)
112 (gdb-use-inferior-io-buffer, gdb-use-colon-colon-notation)
113 (gud-gdba-command-name, gdb-show-main, gdb-many-windows):
114 Add :version keyword.
115
1162004-11-02 Pavel Kobiakov <pk_at_work@yahoo.com>
117
118 * progmodes/flymake.el (flymake-err-line-patterns): Use
119 `flymake-reformat-err-line-patterns-from-compile-el' to convert
120 `compilation-error-regexp-alist-alist' to internal Flymake format.
121
122 * progmodes/flymake.el: eliminated byte-compiler warnings.
123
1242004-11-01 Jay Belanger <belanger@truman.edu>
125
126 * calc/calc-frac.el (calc-over-notation): Replaced
127 `completing-read' with `interactive "s"'.
128
1292004-11-01 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
130
131 * mouse.el (mouse-yank-at-click, mouse-yank-secondary):
132 Revert change from 2004-10-16. '*' checks the current buffer, but the
133 mouse click may be in another buffer.
134
1352004-11-01 John Paul Wallington <jpw@gnu.org>
136
137 * files.el (large-file-warning-threshold): Add :version keyword.
138 (kill-some-buffers): Doc fix.
139
140 * thumbs.el (group thumbs): Add :version keyword.
141
142 * textmodes/bibtex.el (bibtex-make-field): Fix typo.
143
1442004-11-01 Richard M. Stallman <rms@gnu.org>
145
146 * textmodes/ispell.el (ispell-word): Don't use interactive-p.
147
148 * textmodes/flyspell.el (flyspell-word): Don't use interactive-p.
149
150 * allout.el (allout group): Add :version.
151 (allout-init): Don't use interactive-p.
152 (allout-ascend-to-depth, allout-ascend, allout-end-of-level)
153 (allout-forward-current-level, allout-backward-current-level):
154 Don't use interactive-p.
155
156 * textmodes/bibtex.el (bibtex-make-field): Don't use interactive-p.
157 (bibtex-find-text): Likewise.
158
159 * progmodes/vhdl-mode.el (vhdl-fill-region)
160 (vhdl-beginning-of-statement): Don't use interactive-p.
161
162 * progmodes/idlwave.el (idlwave-update-routine-info):
163 Don't use interactive-p.
164
165 * progmodes/idlw-shell.el (idlwave-shell-send-char):
166 Don't use interactive-p.
167
168 * progmodes/cperl-mode.el (cperl-switch-to-doc-buffer):
169 Don't use interactive-p.
170
171 * progmodes/ada-xref.el (ada-make-body-gnatstub):
172 Don't use interactive-p.
173
174 * play/fortune.el (fortune-to-signature): Don't use interactive-p.
175 (fortune-in-buffer): Doc fix.
176
177 * play/5x5.el (5x5-new-game): Set up the buffer even if not interactive.
178
179 * net/eudc.el (eudc-display-records): Use with-output-to-temp-buffer;
180 don't select the temporary buffer.
181 (eudc-get-email): New optional arg ERROR; don't use interactive-p.
182 (eudc-get-phone): Likewise.
183
1842004-11-01 Kim F. Storm <storm@cua.dk>
185
186 * man.el (Man-xref-normal-file): Fix help-echo.
187
1882004-10-31 Stefan Monnier <monnier@iro.umontreal.ca>
189
190 * reveal.el (reveal-last-tick): New var.
191 (reveal-post-command): Use it to avoid closing overlays when we're
192 appending text to them.
193
1942004-10-31 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de>
195
196 * textmodes/bibtex.el: Require button.
197 (bibtex-autokey-transcriptions): Translate TeX `\ ' to space.
198 (bibtex-reference-keys): Distinguish between header keys and
199 crossref keys.
200 (bibtex-beginning-of-field): New function.
201 (bibtex-url-map): Remove.
202 (bibtex-font-lock-keywords): Use bibtex-font-lock-crossref.
203 (bibtex-font-lock-url-regexp): Assume that field names begin at
204 the beginning of a line.
205 (bibtex-font-lock-url): Simplify. Do not use bibtex-enclosing-field.
206 Remove field delimiters. Use bibtex-beginning-of-field.
207 Bugfix, point can be inside a field with a url.
208 (bibtex-font-lock-crossref, bibtex-button-action, bibtex-button):
209 New functions.
210 (bibtex-mark-active, bibtex-run-with-idle-timer): Remove.
211 (bibtex-key-in-head): Simplify.
212 (bibtex-current-line): Use bolp.
213 (bibtex-parse-keys): Remove unused arg `add'.
214 Use bibtex-type-in-head and bibtex-key-in-head.
215 (bibtex-parse-entry, bibtex-autofill-entry):
216 Use bibtex-type-in-head and bibtex-key-in-head.
217 (bibtex-autokey-get-field): Do not alter case of replacement text.
218 (bibtex-autokey-get-names): Do all processing of name list.
219 (bibtex-autokey-get-year): New function.
220 (bibtex-autokey-get-title): Do all processing of title words.
221 (bibtex-generate-autokey): Simplify.
222 (bibtex-string-files-init): Use default-directory.
223 Allow for absolute file names in bibtex-string-files.
224 (bibtex-files, bibtex-file-path): New variables.
225 (bibtex-files-expand): New function.
226 (bibtex-find-entry-globally): New command.
227 (bibtex-summary-function): New variable.
228 (bibtex-summary): Default value of bibtex-summary-function.
229 (bibtex-find-crossref): New optional args pnt and split.
230 (bibtex-complete-key-cleanup): Call bibtex-summary-function.
231 (bibtex-copy-summary-as-kill): New command bound to C-cC-t.
232 (bibtex-validate): Fix docstring. Check only abbreviated month fields.
233 Fix handling of required and alternative fields.
234 Identify duplicate keys even if bibtex-maintain-sorted-entries is nil.
235 Use cons and display-buffer.
236 (bibtex-validate-globally): New command.
237 (bibtex-clean-entry): Use bibtex-files-expand. Do not call
238 bibtex-parse-keys and bibtex-parse-strings for updating
239 bibtex-reference-keys and bibtex-strings.
240 (bibtex-realign): Remove blank lines past the last entry.
241 (bibtex-reformat): Use bibtex-entry-format as default.
242 (bibtex-choose-completion-string): Remove.
243 (bibtex-complete): Do not use bibtex-choose-completion-string.
244 (bibtex-url): Simplify.
245
2462004-10-31 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
247
248 * x-dnd.el (x-dnd-test-function, x-dnd-protocol-alist)
249 (x-dnd-types-alist, x-dnd-open-file-other-window)
250 (x-dnd-known-types): Add :version.
251
2522004-10-31 John Paul Wallington <jpw@gnu.org>
253
254 * ibuffer.el (group ibuffer): Add :version keyword.
255
2562004-10-31 Kim F. Storm <storm@cua.dk>
257
258 * ido.el (group ido): Add :version keyword.
259 (ido-mode): Remove :version keyword.
260
261 * emulation/cua-base.el (group cua): Add :version keyword.
262 (cua-mode): Remove :version keyword.
263
2642004-10-30 Luc Teirlinck <teirllm@auburn.edu>
265
266 * autorevert.el (auto-revert-tail-mode-text): Add :version keyword.
267
268 * help-at-pt.el (help-at-pt-timer): Move defvar up to avoid
269 compiler warning.
270 (help-at-pt-timer-delay): Add :initialize keyword. Simplify :set
271 function.
272 (help-at-pt-display-when-idle): Remove autoload.
273
2742004-10-30 Stefan Monnier <monnier@iro.umontreal.ca>
275
276 * makefile.w32-in (custom-deps, autoloads): Fix *-hooks -> *-hook.
277
2782004-10-30 Juri Linkov <juri@jurta.org>
279
280 * help.el (function-called-at-point):
281 * help-fns.el (variable-at-point): Read -> intern.
282
2832004-10-30 Simon Josefsson <jas@extundo.com>
284
285 * progmodes/autoconf.el (autoconf-font-lock-keywords):
286 Recognize AS_* too.
287
2882004-10-29 Simon Josefsson <jas@extundo.com>
289
290 * subr.el (read-passwd): Move back from password.el.
291
292 * password.el: Remove, not ready yet.
293
2942004-10-29 Andreas Schwab <schwab@suse.de>
295
296 * speedbar.el (speedbar-frame-parameters): Improve customize type.
297
2982004-10-29 Sam Steingold <sds@gnu.org>
299
300 * mouse.el (mouse-show-mark): Replace the last occurrence of
301 x-lost-selection-hooks with x-lost-selection-functions.
302
3032004-10-28 Stefan Monnier <monnier@iro.umontreal.ca>
304
305 * mouse.el (mouse-show-mark): Adjust to new name and don't assume
306 x-lost-selection-functions is bound.
307
308 * mouse-sel.el (mouse-sel-mode):
309 * emacs-lisp/lselect.el: Adjust to new names for
310 x-(lost|sent)-selection-functions.
311
312 * subr.el (x-lost-selection-hooks, x-sent-selection-hooks):
313 New obsolete aliases of x-lost-selection-functions and
314 x-sent-selection-functions.
315
3162004-10-28 Kim F. Storm <storm@cua.dk>
317
318 * imenu.el (imenu-scanning-message): Remove.
319 (imenu-progress-message): Make it a no-op.
320
3212004-10-28 John Paul Wallington <jpw@gnu.org>
322
323 * files.el (set-auto-mode): Call `throw' correctly.
324
3252004-10-28 Juri Linkov <juri@jurta.org>
326
327 * info.el (Info-file-list-for-emacs): Add ("Info" . "info")
328 to search `Info-...' commands in `info' manual.
329 (Info-goto-emacs-command-node, Info-goto-emacs-key-command-node):
330 Add 'info-file "emacs" property.
331 (Info-find-emacs-command-nodes): Fix index line number regexp.
332 Set real line number (instead of fake 0) in first element of the
333 returned list.
334 (Info-goto-emacs-command-node): Use line number of first element
335 to set point in the first found Info node.
336
337 * progmodes/grep.el (grep-regexp-alist): Move match highlighting
338 code to `grep-mode-font-lock-keywords'.
339 (grep-mode-font-lock-keywords): Delete grep markers instead
340 of making them invisible.
341
3422004-10-28 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
343
344 * mail/emacsbug.el (report-emacs-bug): Insert x-server-vendor
345 and x-server-version in bug report.
346
3472004-10-28 Daniel Pfeiffer <occitan@esperanto.org>
348
349 * files.el (set-auto-mode-0): New function.
350 (set-auto-mode): Use it to handle aliased modes and to
351 be consistent between C-x C-f and C-x C-w.
352
3532004-10-28 Kenichi Handa <handa@m17n.org>
354
355 * international/utf-8.el (utf-translate-cjk-charsets):
356 Add katakana-jisx0201.
357
358 * international/subst-jis.el: Add data for JISX0201.
359
3602004-10-27 Stefan Monnier <monnier@iro.umontreal.ca>
361
362 * obsolete/hilit19.el (hilit-mode): New function.
363 Move all the toplevel side-effecting stuff into it, so that loading
364 hilit19 doesn't mess everything up any more.
365
3662004-10-27 Richard M. Stallman <rms@gnu.org>
367
368 * add-log.el (add-change-log-entry): Set up mailing address
369 and full name later, and don't alter add-log-mailing-address
370 or add-log-full-name.
371
372 * elide-head.el (elide-head): Change error to message.
373 (elide-head-show): Likewise.
374
375 * apropos.el (apropos-macrop): Doc fix.
376
377 * mouse.el (mouse-show-mark): Do most processing the same
378 regardless of transient-mark-mode.
379
380 * shadowfile.el (shadow-copy-files): Use interactive-p
381 only to control whether to print a message.
382
383 * tar-mode.el (tar-mode): Use write-contents-functions,
384 not write-contents-hooks.
385
386 * eshell/em-unix.el (eshell-du-sum-directory): Don't use
387 directory-sep-char.
388
3892004-10-27 Richard M. Stallman <rms@gnu.org>
390
391 * strokes.el (strokes-unload-hook): Fix previous change.
392
393 * type-break.el (type-break-run-at-time): Always use run-at-time;
394 forget the alternatives.
395 (type-break-cancel-function-timers): Always use cancel-function-timers;
396 forget the alternatives.
397
398 * pcomplete.el (pcomplete-entries): Don't use directory-sep-char.
399
4002004-10-27 Kenichi Handa <handa@m17n.org>
401
402 * international/subst-jis.el: Use utf-translate-cjk-substitutable-p.
403
404 * international/subst-gb2312.el: Likewise.
405
406 * international/subst-big5.el: Likewise.
407
408 * international/subst-ksc.el: Likewise.
409
410 * international/utf-8.el (utf-translate-cjk-unicode-range-string):
411 New variable.
412 (utf-translate-cjk-set-unicode-range): New function.
413 (utf-translate-cjk-unicode-range): Make it customizable.
414 (utf-8-post-read-conversion):
415 Use utf-translate-cjk-unicode-range-string.
416 (ccl-decode-mule-utf-8): Check utf-subst-table-for-decode for more
417 Unicode ranges.
418
12004-10-26 Daniel Pfeiffer <occitan@esperanto.org> 4192004-10-26 Daniel Pfeiffer <occitan@esperanto.org>
2 420
3 * files.el (auto-mode-alist): Add pod, js, xbm and xpm and group 421 * files.el (auto-mode-alist): Add pod, js, xbm and xpm and group
@@ -46,8 +464,8 @@
46 464
472004-10-26 Pavel Kobiakov <pk_at_work@yahoo.com> 4652004-10-26 Pavel Kobiakov <pk_at_work@yahoo.com>
48 466
49 * progmodes/flymake.el (flymake-split-string): Use 467 * progmodes/flymake.el (flymake-split-string):
50 `flymake-split-string-remove-empty-edges' in any case. 468 Use `flymake-split-string-remove-empty-edges' in any case.
51 469
522004-10-26 Masatake YAMATO <jet@gyve.org> 4702004-10-26 Masatake YAMATO <jet@gyve.org>
53 471
@@ -55,6 +473,11 @@
55 Use `compilation-error-regexp-alist-alist' instead of 473 Use `compilation-error-regexp-alist-alist' instead of
56 `compilation-error-regexp-alist'. 474 `compilation-error-regexp-alist'.
57 475
4762004-10-25 Stefan Monnier <monnier@iro.umontreal.ca>
477
478 * textmodes/tex-mode.el (tex-font-lock-keywords-1): Fix up the spurious
479 verbatim face on the \ of \end{verbatim}.
480
582004-10-25 Jay Belanger <belanger@truman.edu> 4812004-10-25 Jay Belanger <belanger@truman.edu>
59 482
60 * calc/calc-incom.el (calc-digit-dots): Inhibit read-only before 483 * calc/calc-incom.el (calc-digit-dots): Inhibit read-only before
@@ -980,7 +1403,7 @@
980 1403
9812004-09-17 Jay Belanger <belanger@truman.edu> 14042004-09-17 Jay Belanger <belanger@truman.edu>
982 1405
983 * calc/calc.el (calc-mode-var-list): Fixed the value of 1406 * calc/calc.el (calc-mode-var-list): Fix the value of
984 `calc-matrix-brackets'. 1407 `calc-matrix-brackets'.
985 1408
9862004-09-17 Romain Francoise <romain@orebokech.com> 14092004-09-17 Romain Francoise <romain@orebokech.com>
diff --git a/lisp/add-log.el b/lisp/add-log.el
index 26faea2ddc3..ae135b2bfb3 100644
--- a/lisp/add-log.el
+++ b/lisp/add-log.el
@@ -471,20 +471,6 @@ Today's date is calculated according to `change-log-time-zone-rule' if
471non-nil, otherwise in local time." 471non-nil, otherwise in local time."
472 (interactive (list current-prefix-arg 472 (interactive (list current-prefix-arg
473 (prompt-for-change-log-name))) 473 (prompt-for-change-log-name)))
474 (or add-log-full-name
475 (setq add-log-full-name (user-full-name)))
476 (or add-log-mailing-address
477 (setq add-log-mailing-address user-mail-address))
478 (if whoami
479 (progn
480 (setq add-log-full-name (read-input "Full name: " add-log-full-name))
481 ;; Note that some sites have room and phone number fields in
482 ;; full name which look silly when inserted. Rather than do
483 ;; anything about that here, let user give prefix argument so that
484 ;; s/he can edit the full name field in prompter if s/he wants.
485 (setq add-log-mailing-address
486 (read-input "Mailing address: " add-log-mailing-address))))
487
488 (let* ((defun (add-log-current-defun)) 474 (let* ((defun (add-log-current-defun))
489 (version (and change-log-version-info-enabled 475 (version (and change-log-version-info-enabled
490 (change-log-version-number-search))) 476 (change-log-version-number-search)))
@@ -495,7 +481,19 @@ non-nil, otherwise in local time."
495 (file-name (expand-file-name (find-change-log file-name buffer-file))) 481 (file-name (expand-file-name (find-change-log file-name buffer-file)))
496 ;; Set ITEM to the file name to use in the new item. 482 ;; Set ITEM to the file name to use in the new item.
497 (item (add-log-file-name buffer-file file-name)) 483 (item (add-log-file-name buffer-file file-name))
498 bound) 484 bound
485 (full-name (or add-log-full-name (user-full-name)))
486 (mailing-address (or add-log-mailing-address user-mail-address)))
487
488 (if whoami
489 (progn
490 (setq full-name (read-input "Full name: " full-name))
491 ;; Note that some sites have room and phone number fields in
492 ;; full name which look silly when inserted. Rather than do
493 ;; anything about that here, let user give prefix argument so that
494 ;; s/he can edit the full name field in prompter if s/he wants.
495 (setq mailing-address
496 (read-input "Mailing address: " mailing-address))))
499 497
500 (unless (equal file-name buffer-file-name) 498 (unless (equal file-name buffer-file-name)
501 (if (or other-window (window-dedicated-p (selected-window))) 499 (if (or other-window (window-dedicated-p (selected-window)))
@@ -515,11 +513,11 @@ non-nil, otherwise in local time."
515 ;; Advance into first entry if it is usable; else make new one. 513 ;; Advance into first entry if it is usable; else make new one.
516 (let ((new-entries (mapcar (lambda (addr) 514 (let ((new-entries (mapcar (lambda (addr)
517 (concat (funcall add-log-time-format) 515 (concat (funcall add-log-time-format)
518 " " add-log-full-name 516 " " full-name
519 " <" addr ">")) 517 " <" addr ">"))
520 (if (consp add-log-mailing-address) 518 (if (consp mailing-address)
521 add-log-mailing-address 519 mailing-address
522 (list add-log-mailing-address))))) 520 (list mailing-address)))))
523 (if (and (not add-log-always-start-new-record) 521 (if (and (not add-log-always-start-new-record)
524 (let ((hit nil)) 522 (let ((hit nil))
525 (dolist (entry new-entries hit) 523 (dolist (entry new-entries hit)
diff --git a/lisp/allout.el b/lisp/allout.el
index dd4495cfa84..fa88588ec36 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -68,7 +68,8 @@
68(defgroup allout nil 68(defgroup allout nil
69 "Extensive outline mode for use alone and with other modes." 69 "Extensive outline mode for use alone and with other modes."
70 :prefix "allout-" 70 :prefix "allout-"
71 :group 'editing) 71 :group 'editing
72 :version "21.4")
72 73
73;;;_ + Layout, Mode, and Topic Header Configuration 74;;;_ + Layout, Mode, and Topic Header Configuration
74 75
@@ -954,20 +955,16 @@ the following two lines in your Emacs init file:
954\(require 'allout) 955\(require 'allout)
955\(allout-init t)" 956\(allout-init t)"
956 957
957 (interactive) 958 (interactive
958 (if (interactive-p) 959 (let ((m (completing-read
959 (progn 960 (concat "Select outline auto setup mode "
960 (setq mode 961 "(empty for report, ? for options) ")
961 (completing-read 962 '(("nil")("full")("activate")("deactivate")
962 (concat "Select outline auto setup mode " 963 ("ask") ("report") (""))
963 "(empty for report, ? for options) ") 964 nil
964 '(("nil")("full")("activate")("deactivate") 965 t)))
965 ("ask") ("report") ("")) 966 (if (string= m "") 'report
966 nil 967 (intern-soft m))))
967 t))
968 (if (string= mode "")
969 (setq mode 'report)
970 (setq mode (intern-soft mode)))))
971 (let 968 (let
972 ;; convenience aliases, for consistent ref to respective vars: 969 ;; convenience aliases, for consistent ref to respective vars:
973 ((hook 'allout-find-file-hook) 970 ((hook 'allout-find-file-hook)
@@ -1902,16 +1899,12 @@ If already there, move cursor to bullet for hot-spot operation.
1902 (if (= (allout-recent-depth) depth) 1899 (if (= (allout-recent-depth) depth)
1903 (progn (goto-char allout-recent-prefix-beginning) 1900 (progn (goto-char allout-recent-prefix-beginning)
1904 depth) 1901 depth)
1905 (goto-char last-good) 1902 (goto-char last-good)))))
1906 nil))
1907 (if (interactive-p) (allout-end-of-prefix))))
1908;;;_ > allout-ascend () 1903;;;_ > allout-ascend ()
1909(defun allout-ascend () 1904(defun allout-ascend ()
1910 "Ascend one level, returning t if successful, nil if not." 1905 "Ascend one level, returning t if successful, nil if not."
1911 (prog1 1906 (if (allout-beginning-of-level)
1912 (if (allout-beginning-of-level) 1907 (allout-previous-heading)))
1913 (allout-previous-heading))
1914 (if (interactive-p) (allout-end-of-prefix))))
1915;;;_ > allout-descend-to-depth (depth) 1908;;;_ > allout-descend-to-depth (depth)
1916(defun allout-descend-to-depth (depth) 1909(defun allout-descend-to-depth (depth)
1917 "Descend to depth DEPTH within current topic. 1910 "Descend to depth DEPTH within current topic.
@@ -1931,13 +1924,13 @@ Returning depth if successful, nil if not."
1931 nil)) 1924 nil))
1932 ) 1925 )
1933;;;_ > allout-up-current-level (arg &optional dont-complain) 1926;;;_ > allout-up-current-level (arg &optional dont-complain)
1934(defun allout-up-current-level (arg &optional dont-complain) 1927(defun allout-up-current-level (arg &optional dont-complain interactive)
1935 "Move out ARG levels from current visible topic. 1928 "Move out ARG levels from current visible topic.
1936 1929
1937Positions on heading line of containing topic. Error if unable to 1930Positions on heading line of containing topic. Error if unable to
1938ascend that far, or nil if unable to ascend but optional arg 1931ascend that far, or nil if unable to ascend but optional arg
1939DONT-COMPLAIN is non-nil." 1932DONT-COMPLAIN is non-nil."
1940 (interactive "p") 1933 (interactive "p\np")
1941 (allout-back-to-current-heading) 1934 (allout-back-to-current-heading)
1942 (let ((present-level (allout-recent-depth)) 1935 (let ((present-level (allout-recent-depth))
1943 (last-good (point)) 1936 (last-good (point))
@@ -1958,12 +1951,12 @@ DONT-COMPLAIN is non-nil."
1958 (if (or failed 1951 (if (or failed
1959 (> arg 0)) 1952 (> arg 0))
1960 (progn (goto-char last-good) 1953 (progn (goto-char last-good)
1961 (if (interactive-p) (allout-end-of-prefix)) 1954 (if interactive (allout-end-of-prefix))
1962 (if (not dont-complain) 1955 (if (not dont-complain)
1963 (error "Can't ascend past outermost level") 1956 (error "Can't ascend past outermost level")
1964 (if (interactive-p) (allout-end-of-prefix)) 1957 (if interactive (allout-end-of-prefix))
1965 nil)) 1958 nil))
1966 (if (interactive-p) (allout-end-of-prefix)) 1959 (if interactive (allout-end-of-prefix))
1967 allout-recent-prefix-beginning))) 1960 allout-recent-prefix-beginning)))
1968 1961
1969;;;_ - Linear 1962;;;_ - Linear
@@ -2029,7 +2022,7 @@ Presumes point is at the start of a topic prefix."
2029 (let ((depth (allout-depth))) 2022 (let ((depth (allout-depth)))
2030 (while (allout-previous-sibling depth nil)) 2023 (while (allout-previous-sibling depth nil))
2031 (prog1 (allout-recent-depth) 2024 (prog1 (allout-recent-depth)
2032 (if (interactive-p) (allout-end-of-prefix))))) 2025 (allout-end-of-prefix))))
2033;;;_ > allout-next-visible-heading (arg) 2026;;;_ > allout-next-visible-heading (arg)
2034(defun allout-next-visible-heading (arg) 2027(defun allout-next-visible-heading (arg)
2035 "Move to the next ARG'th visible heading line, backward if arg is negative. 2028 "Move to the next ARG'th visible heading line, backward if arg is negative.
@@ -2067,13 +2060,13 @@ matches)."
2067 (interactive "p") 2060 (interactive "p")
2068 (allout-next-visible-heading (- arg))) 2061 (allout-next-visible-heading (- arg)))
2069;;;_ > allout-forward-current-level (arg) 2062;;;_ > allout-forward-current-level (arg)
2070(defun allout-forward-current-level (arg) 2063(defun allout-forward-current-level (arg &optional interactive)
2071 "Position point at the next heading of the same level. 2064 "Position point at the next heading of the same level.
2072 2065
2073Takes optional repeat-count, goes backward if count is negative. 2066Takes optional repeat-count, goes backward if count is negative.
2074 2067
2075Returns resulting position, else nil if none found." 2068Returns resulting position, else nil if none found."
2076 (interactive "p") 2069 (interactive "p\np")
2077 (let ((start-depth (allout-current-depth)) 2070 (let ((start-depth (allout-current-depth))
2078 (start-point (point)) 2071 (start-point (point))
2079 (start-arg arg) 2072 (start-arg arg)
@@ -2101,7 +2094,7 @@ Returns resulting position, else nil if none found."
2101 (= (allout-recent-depth) start-depth))) 2094 (= (allout-recent-depth) start-depth)))
2102 allout-recent-prefix-beginning 2095 allout-recent-prefix-beginning
2103 (goto-char last-good) 2096 (goto-char last-good)
2104 (if (not (interactive-p)) 2097 (if (not interactive)
2105 nil 2098 nil
2106 (allout-end-of-prefix) 2099 (allout-end-of-prefix)
2107 (error "Hit %s level %d topic, traversed %d of %d requested" 2100 (error "Hit %s level %d topic, traversed %d of %d requested"
@@ -2110,10 +2103,10 @@ Returns resulting position, else nil if none found."
2110 (- (abs start-arg) arg) 2103 (- (abs start-arg) arg)
2111 (abs start-arg)))))) 2104 (abs start-arg))))))
2112;;;_ > allout-backward-current-level (arg) 2105;;;_ > allout-backward-current-level (arg)
2113(defun allout-backward-current-level (arg) 2106(defun allout-backward-current-level (arg &optional interactive)
2114 "Inverse of `allout-forward-current-level'." 2107 "Inverse of `allout-forward-current-level'."
2115 (interactive "p") 2108 (interactive "p\np")
2116 (if (interactive-p) 2109 (if interactive
2117 (let ((current-prefix-arg (* -1 arg))) 2110 (let ((current-prefix-arg (* -1 arg)))
2118 (call-interactively 'allout-forward-current-level)) 2111 (call-interactively 'allout-forward-current-level))
2119 (allout-forward-current-level (* -1 arg)))) 2112 (allout-forward-current-level (* -1 arg))))
diff --git a/lisp/apropos.el b/lisp/apropos.el
index e5904e73b71..8bfaa3ad592 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -875,7 +875,7 @@ If non-nil TEXT is a string that will be printed as a heading."
875 875
876 876
877(defun apropos-macrop (symbol) 877(defun apropos-macrop (symbol)
878 "T if SYMBOL is a Lisp macro." 878 "Return t if SYMBOL is a Lisp macro."
879 (and (fboundp symbol) 879 (and (fboundp symbol)
880 (consp (setq symbol 880 (consp (setq symbol
881 (symbol-function symbol))) 881 (symbol-function symbol)))
diff --git a/lisp/autorevert.el b/lisp/autorevert.el
index 5f6d26bfabb..1900d43d9e5 100644
--- a/lisp/autorevert.el
+++ b/lisp/autorevert.el
@@ -172,7 +172,8 @@ When non-nil, a message is generated whenever a file is reverted."
172 172
173\(When the string is not empty, make sure that it has a leading space.)" 173\(When the string is not empty, make sure that it has a leading space.)"
174 :group 'auto-revert 174 :group 'auto-revert
175 :type 'string) 175 :type 'string
176 :version "21.4")
176 177
177(defcustom auto-revert-mode-hook nil 178(defcustom auto-revert-mode-hook nil
178 "Functions to run when Auto-Revert Mode is activated." 179 "Functions to run when Auto-Revert Mode is activated."
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index da21f5336d8..e980055d422 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -627,8 +627,9 @@ For more information, see the function `buffer-menu'."
627 (define-key map [header-line mouse-2] 627 (define-key map [header-line mouse-2]
628 `(lambda (e) 628 `(lambda (e)
629 (interactive "e") 629 (interactive "e")
630 (if e (set-buffer (window-buffer (posn-window (event-end e))))) 630 (save-window-excursion
631 (Buffer-menu-sort ,column))) 631 (if e (mouse-select-window e))
632 (Buffer-menu-sort ,column))))
632 map))) 633 map)))
633 634
634(defun list-buffers-noselect (&optional files-only) 635(defun list-buffers-noselect (&optional files-only)
diff --git a/lisp/calc/calc-frac.el b/lisp/calc/calc-frac.el
index 3aa3bbdae41..48201a7dc8a 100644
--- a/lisp/calc/calc-frac.el
+++ b/lisp/calc/calc-frac.el
@@ -54,12 +54,7 @@
54 54
55 55
56(defun calc-over-notation (fmt) 56(defun calc-over-notation (fmt)
57 (interactive 57 (interactive "sFraction separator: ")
58 (list
59 (completing-read "Fraction separator: " (mapcar (lambda (s)
60 (cons s 0))
61 '(":" "::" "/" "//" ":/"))
62 nil t)))
63 (calc-wrapper 58 (calc-wrapper
64 (if (string-match "\\`\\([^ 0-9][^ 0-9]?\\)[0-9]*\\'" fmt) 59 (if (string-match "\\`\\([^ 0-9][^ 0-9]?\\)[0-9]*\\'" fmt)
65 (let ((n nil)) 60 (let ((n nil))
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el
index 5f581e1d74a..dc3bf016053 100644
--- a/lisp/calendar/icalendar.el
+++ b/lisp/calendar/icalendar.el
@@ -31,16 +31,7 @@
31 31
32;;; History: 32;;; History:
33 33
34;; 0.07: Renamed commands! 34;; 0.07 onwards: see lisp/ChangeLog
35;; icalendar-extract-ical-from-buffer -> icalendar-import-buffer
36;; icalendar-convert-diary-to-ical -> icalendar-export-file
37;; Naming scheme: icalendar-.* = user command; icalendar--.* =
38;; internal.
39;; Added icalendar-export-region.
40;; The import and export commands do not clear their target file,
41;; but append their results to the target file.
42;; I18n-problems fixed -- use calendar-(month|day)-name-array.
43;; Fixed problems with export of multi-line diary entries.
44 35
45;; 0.06: Bugfixes regarding icalendar-import-format-*. 36;; 0.06: Bugfixes regarding icalendar-import-format-*.
46;; Fix in icalendar-convert-diary-to-ical -- thanks to Philipp 37;; Fix in icalendar-convert-diary-to-ical -- thanks to Philipp
@@ -99,7 +90,7 @@
99 90
100;;; Code: 91;;; Code:
101 92
102(defconst icalendar-version 0.07 93(defconst icalendar-version 0.08
103 "Version number of icalendar.el.") 94 "Version number of icalendar.el.")
104 95
105;; ====================================================================== 96;; ======================================================================
@@ -333,7 +324,7 @@ children."
333 param-name param-value) 324 param-name param-value)
334 (when value-string 325 (when value-string
335 (save-current-buffer 326 (save-current-buffer
336 (set-buffer (get-buffer-create " *ical-temp*")) 327 (set-buffer (get-buffer-create " *icalendar-work*"))
337 (set-buffer-modified-p nil) 328 (set-buffer-modified-p nil)
338 (erase-buffer) 329 (erase-buffer)
339 (insert value-string) 330 (insert value-string)
@@ -529,7 +520,17 @@ Note that this silently ignores seconds."
529 (setq num (1+ num)))) 520 (setq num (1+ num))))
530 calendar-day-name-array)) 521 calendar-day-name-array))
531 ;; Error: 522 ;; Error:
532 "??")) 523 nil))
524
525(defun icalendar--date-to-isodate (date &optional day-shift)
526 "Convert DATE to iso-style date.
527DATE must be a list of the form (month day year).
528If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days."
529 (let ((mdy (calendar-gregorian-from-absolute
530 (+ (calendar-absolute-from-gregorian date)
531 (or day-shift 0)))))
532 (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy))))
533
533 534
534(defun icalendar--datestring-to-isodate (datestring &optional day-shift) 535(defun icalendar--datestring-to-isodate (datestring &optional day-shift)
535 "Convert diary-style DATESTRING to iso-style date. 536 "Convert diary-style DATESTRING to iso-style date.
@@ -587,7 +588,7 @@ takes care of european-style."
587 (if (> day 0) 588 (if (> day 0)
588 (let ((mdy (calendar-gregorian-from-absolute 589 (let ((mdy (calendar-gregorian-from-absolute
589 (+ (calendar-absolute-from-gregorian (list month day 590 (+ (calendar-absolute-from-gregorian (list month day
590 year)) 591 year))
591 (or day-shift 0))))) 592 (or day-shift 0)))))
592 (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy))) 593 (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy)))
593 nil))) 594 nil)))
@@ -625,22 +626,24 @@ would be \"pm\"."
625 "Export diary file to iCalendar format. 626 "Export diary file to iCalendar format.
626All diary entries in the file DIARY-FILENAME are converted to iCalendar 627All diary entries in the file DIARY-FILENAME are converted to iCalendar
627format. The result is appended to the file ICAL-FILENAME." 628format. The result is appended to the file ICAL-FILENAME."
628 (interactive "FExport diary data from file: 629 (interactive "FExport diary data from file:
629Finto iCalendar file: ") 630Finto iCalendar file: ")
630 (save-current-buffer 631 (save-current-buffer
631 (set-buffer (find-file diary-filename)) 632 (set-buffer (find-file diary-filename))
632 (icalendar-export-region (point-min) (point-max) ical-filename))) 633 (icalendar-export-region (point-min) (point-max) ical-filename)))
633 634
634(defalias 'icalendar-convert-diary-to-ical 'icalendar-export-file) 635(defalias 'icalendar-convert-diary-to-ical 'icalendar-export-file)
635(make-obsolete 'icalendar-convert-diary-to-ical 'icalendar-export-file 636(make-obsolete 'icalendar-convert-diary-to-ical 'icalendar-export-file)
636 "icalendar 0.07")
637 637
638;; User function 638;; User function
639(defun icalendar-export-region (min max ical-filename) 639(defun icalendar-export-region (min max ical-filename)
640 "Export region in diary file to iCalendar format. 640 "Export region in diary file to iCalendar format.
641All diary entries in the region from MIN to MAX in the current buffer are 641All diary entries in the region from MIN to MAX in the current buffer are
642converted to iCalendar format. The result is appended to the file 642converted to iCalendar format. The result is appended to the file
643ICAL-FILENAME." 643ICAL-FILENAME.
644
645Returns non-nil if an error occurred. In this case an error message is
646written to the buffer ` *icalendar-errors*'."
644 (interactive "r 647 (interactive "r
645FExport diary data into iCalendar file: ") 648FExport diary data into iCalendar file: ")
646 (let ((result "") 649 (let ((result "")
@@ -649,9 +652,14 @@ FExport diary data into iCalendar file: ")
649 (entry-rest "") 652 (entry-rest "")
650 (header "") 653 (header "")
651 (contents) 654 (contents)
652 (oops nil) 655 (found-error nil)
653 (nonmarker (concat "^" (regexp-quote diary-nonmarking-symbol) 656 (nonmarker (concat "^" (regexp-quote diary-nonmarking-symbol)
654 "?"))) 657 "?")))
658 ;; prepare buffer with error messages
659 (save-current-buffer
660 (set-buffer (get-buffer-create " *icalendar-errors*"))
661 (erase-buffer))
662 ;; here we go
655 (save-excursion 663 (save-excursion
656 (goto-char min) 664 (goto-char min)
657 (while (re-search-forward 665 (while (re-search-forward
@@ -664,330 +672,366 @@ FExport diary data into iCalendar file: ")
664 (car (current-time)) 672 (car (current-time))
665 (cadr (current-time)) 673 (cadr (current-time))
666 (car (cddr (current-time))))) 674 (car (cddr (current-time)))))
667 (setq oops nil) 675 (condition-case error-val
668 (cond 676 (progn
669 ;; anniversaries 677 (cond
670 ((string-match 678 ;; anniversaries
671 (concat nonmarker 679 ((string-match
672 "%%(diary-anniversary \\([^)]+\\))\\s-*\\(.*\\)") 680 (concat nonmarker
673 entry-main) 681 "%%(diary-anniversary \\([^)]+\\))\\s-*\\(.*\\)")
674 (icalendar--dmsg "diary-anniversary %s" entry-main) 682 entry-main)
675 (let* ((datetime (substring entry-main (match-beginning 1) 683 (icalendar--dmsg "diary-anniversary %s" entry-main)
676 (match-end 1))) 684 (let* ((datetime (substring entry-main (match-beginning 1)
677 (summary (icalendar--convert-string-for-export 685 (match-end 1)))
678 (substring entry-main (match-beginning 2) 686 (summary (icalendar--convert-string-for-export
679 (match-end 2)))) 687 (substring entry-main (match-beginning 2)
680 (startisostring (icalendar--datestring-to-isodate 688 (match-end 2))))
681 datetime)) 689 (startisostring (icalendar--datestring-to-isodate
682 (endisostring (icalendar--datestring-to-isodate 690 datetime))
683 datetime 1))) 691 (endisostring (icalendar--datestring-to-isodate
684 (setq contents 692 datetime 1)))
685 (concat "\nDTSTART;VALUE=DATE:" startisostring 693 (setq contents
686 "\nDTEND;VALUE=DATE:" endisostring 694 (concat "\nDTSTART;VALUE=DATE:" startisostring
687 "\nSUMMARY:" summary 695 "\nDTEND;VALUE=DATE:" endisostring
688 "\nRRULE:FREQ=YEARLY;INTERVAL=1" 696 "\nSUMMARY:" summary
689 ;; the following is redundant, 697 "\nRRULE:FREQ=YEARLY;INTERVAL=1"
690 ;; but korganizer seems to expect this... ;( 698 ;; the following is redundant,
691 ;; and evolution doesn't understand it... :( 699 ;; but korganizer seems to expect this... ;(
692 ;; so... who is wrong?! 700 ;; and evolution doesn't understand it... :(
693 ";BYMONTH=" (substring startisostring 4 6) 701 ;; so... who is wrong?!
694 ";BYMONTHDAY=" (substring startisostring 6 8) 702 ";BYMONTH=" (substring startisostring 4 6)
695 ))) 703 ";BYMONTHDAY=" (substring startisostring 6 8)
696 (unless (string= entry-rest "") 704 )))
697 (setq contents (concat contents "\nDESCRIPTION:" 705 (unless (string= entry-rest "")
698 (icalendar--convert-string-for-export 706 (setq contents (concat contents "\nDESCRIPTION:"
699 entry-rest))))) 707 (icalendar--convert-string-for-export
700 ;; cyclic events 708 entry-rest)))))
701 ;; %%(diary-cyclic ) 709 ;; cyclic events
702 ((string-match 710 ;; %%(diary-cyclic )
703 (concat nonmarker 711 ((string-match
704 "%%(diary-cyclic \\([^ ]+\\) +" 712 (concat nonmarker
705 "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)") 713 "%%(diary-cyclic \\([^ ]+\\) +"
706 entry-main) 714 "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)")
707 (icalendar--dmsg "diary-cyclic %s" entry-main) 715 entry-main)
708 (let* ((frequency (substring entry-main (match-beginning 1) 716 (icalendar--dmsg "diary-cyclic %s" entry-main)
709 (match-end 1))) 717 (let* ((frequency (substring entry-main (match-beginning 1)
710 (datetime (substring entry-main (match-beginning 2) 718 (match-end 1)))
711 (match-end 2))) 719 (datetime (substring entry-main (match-beginning 2)
712 (summary (icalendar--convert-string-for-export 720 (match-end 2)))
713 (substring entry-main (match-beginning 3) 721 (summary (icalendar--convert-string-for-export
714 (match-end 3)))) 722 (substring entry-main (match-beginning 3)
715 (startisostring (icalendar--datestring-to-isodate 723 (match-end 3))))
716 datetime)) 724 (startisostring (icalendar--datestring-to-isodate
717 (endisostring (icalendar--datestring-to-isodate 725 datetime))
718 datetime 1))) 726 (endisostring (icalendar--datestring-to-isodate
719 (setq contents 727 datetime 1)))
720 (concat "\nDTSTART;VALUE=DATE:" startisostring 728 (setq contents
721 "\nDTEND;VALUE=DATE:" endisostring 729 (concat "\nDTSTART;VALUE=DATE:" startisostring
722 "\nSUMMARY:" summary 730 "\nDTEND;VALUE=DATE:" endisostring
723 "\nRRULE:FREQ=DAILY;INTERVAL=" frequency 731 "\nSUMMARY:" summary
724 ;; strange: korganizer does not expect 732 "\nRRULE:FREQ=DAILY;INTERVAL=" frequency
725 ;; BYSOMETHING here... 733 ;; strange: korganizer does not expect
726 ))) 734 ;; BYSOMETHING here...
727 (unless (string= entry-rest "") 735 )))
728 (setq contents (concat contents "\nDESCRIPTION:" 736 (unless (string= entry-rest "")
729 (icalendar--convert-string-for-export 737 (setq contents (concat contents "\nDESCRIPTION:"
730 entry-rest))))) 738 (icalendar--convert-string-for-export
731 ;; diary-date -- FIXME 739 entry-rest)))))
732 ((string-match 740 ;; diary-date -- FIXME
733 (concat nonmarker 741 ((string-match
734 "%%(diary-date \\([^)]+\\))\\s-*\\(.*\\)") 742 (concat nonmarker
735 entry-main) 743 "%%(diary-date \\([^)]+\\))\\s-*\\(.*\\)")
736 (icalendar--dmsg "diary-date %s" entry-main) 744 entry-main)
737 (setq oops t)) 745 (icalendar--dmsg "diary-date %s" entry-main)
738 ;; float events -- FIXME 746 (error "`diary-date' is not supported yet"))
739 ((string-match 747 ;; float events -- FIXME
740 (concat nonmarker 748 ((string-match
741 "%%(diary-float \\([^)]+\\))\\s-*\\(.*\\)") 749 (concat nonmarker
742 entry-main) 750 "%%(diary-float \\([^)]+\\))\\s-*\\(.*\\)")
743 (icalendar--dmsg "diary-float %s" entry-main) 751 entry-main)
744 (setq oops t)) 752 (icalendar--dmsg "diary-float %s" entry-main)
745 ;; block events 753 (error "`diary-float' is not supported yet"))
746 ((string-match 754 ;; block events
747 (concat nonmarker 755 ((string-match
748 "%%(diary-block \\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\) +" 756 (concat nonmarker
749 "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)") 757 "%%(diary-block \\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\) +"
750 entry-main) 758 "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)")
751 (icalendar--dmsg "diary-block %s" entry-main) 759 entry-main)
752 (let* ((startstring (substring entry-main (match-beginning 1) 760 (icalendar--dmsg "diary-block %s" entry-main)
753 (match-end 1))) 761 (let* ((startstring (substring entry-main (match-beginning 1)
754 (endstring (substring entry-main (match-beginning 2) 762 (match-end 1)))
755 (match-end 2))) 763 (endstring (substring entry-main (match-beginning 2)
756 (summary (icalendar--convert-string-for-export 764 (match-end 2)))
757 (substring entry-main (match-beginning 3) 765 (summary (icalendar--convert-string-for-export
758 (match-end 3)))) 766 (substring entry-main (match-beginning 3)
759 (startisostring (icalendar--datestring-to-isodate 767 (match-end 3))))
760 startstring)) 768 (startisostring (icalendar--datestring-to-isodate
761 (endisostring (icalendar--datestring-to-isodate 769 startstring))
762 endstring 1))) 770 (endisostring (icalendar--datestring-to-isodate
763 (setq contents 771 endstring 1)))
764 (concat "\nDTSTART;VALUE=DATE:" startisostring 772 (setq contents
765 "\nDTEND;VALUE=DATE:" endisostring 773 (concat "\nDTSTART;VALUE=DATE:" startisostring
766 "\nSUMMARY:" summary 774 "\nDTEND;VALUE=DATE:" endisostring
767 )) 775 "\nSUMMARY:" summary
768 (unless (string= entry-rest "") 776 ))
769 (setq contents (concat contents "\nDESCRIPTION:" 777 (unless (string= entry-rest "")
770 (icalendar--convert-string-for-export 778 (setq contents (concat contents "\nDESCRIPTION:"
771 entry-rest)))))) 779 (icalendar--convert-string-for-export
772 ;; other sexp diary entries -- FIXME 780 entry-rest))))))
773 ((string-match 781 ;; other sexp diary entries -- FIXME
774 (concat nonmarker 782 ((string-match
775 "%%(\\([^)]+\\))\\s-*\\(.*\\)") 783 (concat nonmarker
776 entry-main) 784 "%%(\\([^)]+\\))\\s-*\\(.*\\)")
777 (icalendar--dmsg "diary-sexp %s" entry-main) 785 entry-main)
778 (setq oops t)) 786 (icalendar--dmsg "diary-sexp %s" entry-main)
779 ;; weekly by day 787 (error "sexp-entries are not supported yet"))
780 ;; Monday 8:30 Team meeting 788 ;; weekly by day
781 ((and (string-match 789 ;; Monday 8:30 Team meeting
782 (concat nonmarker 790 ((and (string-match
783 "\\([a-z]+\\)\\s-+" 791 (concat nonmarker
784 "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" 792 "\\([a-z]+\\)\\s-+"
785 "\\(-0?" 793 "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
786 "\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" 794 "\\(-0?"
787 "\\)?" 795 "\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
788 "\\s-*\\(.*\\)$") 796 "\\)?"
789 entry-main) 797 "\\s-*\\(.*\\)$")
790 (icalendar--get-weekday-abbrev 798 entry-main)
791 (substring entry-main (match-beginning 1) (match-end 1)))) 799 (icalendar--get-weekday-abbrev
792 (icalendar--dmsg "weekly %s" entry-main) 800 (substring entry-main (match-beginning 1) (match-end 1))))
793 (let* ((day (icalendar--get-weekday-abbrev 801 (icalendar--dmsg "weekly %s" entry-main)
794 (substring entry-main (match-beginning 1) 802 (let* ((day (icalendar--get-weekday-abbrev
795 (match-end 1)))) 803 (substring entry-main (match-beginning 1)
796 (starttimestring (icalendar--diarytime-to-isotime 804 (match-end 1))))
797 (if (match-beginning 3) 805 (starttimestring (icalendar--diarytime-to-isotime
798 (substring entry-main 806 (if (match-beginning 3)
799 (match-beginning 3) 807 (substring entry-main
800 (match-end 3)) 808 (match-beginning 3)
801 nil) 809 (match-end 3))
802 (if (match-beginning 4) 810 nil)
803 (substring entry-main 811 (if (match-beginning 4)
804 (match-beginning 4) 812 (substring entry-main
805 (match-end 4)) 813 (match-beginning 4)
806 nil))) 814 (match-end 4))
807 (endtimestring (icalendar--diarytime-to-isotime 815 nil)))
808 (if (match-beginning 6) 816 (endtimestring (icalendar--diarytime-to-isotime
809 (substring entry-main 817 (if (match-beginning 6)
810 (match-beginning 6) 818 (substring entry-main
811 (match-end 6)) 819 (match-beginning 6)
812 nil) 820 (match-end 6))
813 (if (match-beginning 7) 821 nil)
814 (substring entry-main 822 (if (match-beginning 7)
815 (match-beginning 7) 823 (substring entry-main
816 (match-end 7)) 824 (match-beginning 7)
817 nil))) 825 (match-end 7))
818 (summary (icalendar--convert-string-for-export 826 nil)))
819 (substring entry-main (match-beginning 8) 827 (summary (icalendar--convert-string-for-export
820 (match-end 8))))) 828 (substring entry-main (match-beginning 8)
821 (when starttimestring 829 (match-end 8)))))
822 (unless endtimestring 830 (when starttimestring
823 (let ((time (read (icalendar--rris "^T0?" "" 831 (unless endtimestring
824 starttimestring)))) 832 (let ((time (read (icalendar--rris "^T0?" ""
825 (setq endtimestring (format "T%06d" (+ 10000 time)))))) 833 starttimestring))))
826 (setq contents 834 (setq endtimestring (format "T%06d" (+ 10000 time))))))
827 (concat "\nDTSTART" 835 (setq contents
828 (if starttimestring "" ";VALUE=DATE") 836 (concat "\nDTSTART;"
829 ":19000101" ;; FIXME? Probability that this 837 (if starttimestring
830 ;; is the right day is 1/7 838 "VALUE=DATE-TIME:"
831 (or starttimestring "") 839 "VALUE=DATE:")
832 "\nDTEND" 840 ;; find the correct week day,
833 (if endtimestring "" ";VALUE=DATE") 841 ;; 1st january 2000 was a saturday
834 ":19000101" ;; FIXME? 842 (format
835 (or endtimestring "") 843 "200001%02d"
836 "\nSUMMARY:" summary 844 (+ (icalendar--get-weekday-number day) 2))
837 "\nRRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=" day 845 (or starttimestring "")
838 ))) 846 "\nDTEND;"
839 (unless (string= entry-rest "") 847 (if endtimestring
840 (setq contents (concat contents "\nDESCRIPTION:" 848 "VALUE=DATE-TIME:"
841 (icalendar--convert-string-for-export 849 "VALUE=DATE:")
842 entry-rest))))) 850 (format
843 ;; yearly by day 851 "200001%02d"
844 ;; 1 May Tag der Arbeit 852 ;; end is non-inclusive!
845 ((string-match 853 (+ (icalendar--get-weekday-number day)
846 (concat nonmarker 854 (if endtimestring 2 3)))
847 (if european-calendar-style 855 (or endtimestring "")
848 "0?\\([1-9]+[0-9]?\\)\\s-+\\([a-z]+\\)\\s-+" 856 "\nSUMMARY:" summary
849 "\\([a-z]+\\)\\s-+0?\\([1-9]+[0-9]?\\)\\s-+") 857 "\nRRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=" day
850 "\\*?\\s-*" 858 )))
851 "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" 859 (unless (string= entry-rest "")
852 "\\(" 860 (setq contents (concat contents "\nDESCRIPTION:"
853 "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" 861 (icalendar--convert-string-for-export
854 "\\)?" 862 entry-rest)))))
855 "\\s-*\\([^0-9]+.*\\)$" ; must not match years 863 ;; yearly by day
856 ) 864 ;; 1 May Tag der Arbeit
857 entry-main) 865 ((string-match
858 (icalendar--dmsg "yearly %s" entry-main) 866 (concat nonmarker
859 (let* ((daypos (if european-calendar-style 1 2)) 867 (if european-calendar-style
860 (monpos (if european-calendar-style 2 1)) 868 "0?\\([1-9]+[0-9]?\\)\\s-+\\([a-z]+\\)\\s-+"
861 (day (read (substring entry-main (match-beginning daypos) 869 "\\([a-z]+\\)\\s-+0?\\([1-9]+[0-9]?\\)\\s-+")
862 (match-end daypos)))) 870 "\\*?\\s-*"
863 (month (icalendar--get-month-number 871 "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
864 (substring entry-main (match-beginning monpos) 872 "\\("
865 (match-end monpos)))) 873 "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
866 (starttimestring (icalendar--diarytime-to-isotime 874 "\\)?"
867 (if (match-beginning 4) 875 "\\s-*\\([^0-9]+.*\\)$" ; must not match years
868 (substring entry-main 876 )
869 (match-beginning 4) 877 entry-main)
870 (match-end 4)) 878 (icalendar--dmsg "yearly %s" entry-main)
871 nil) 879 (let* ((daypos (if european-calendar-style 1 2))
872 (if (match-beginning 5) 880 (monpos (if european-calendar-style 2 1))
873 (substring entry-main 881 (day (read (substring entry-main (match-beginning daypos)
874 (match-beginning 5) 882 (match-end daypos))))
875 (match-end 5)) 883 (month (icalendar--get-month-number
876 nil))) 884 (substring entry-main (match-beginning monpos)
877 (endtimestring (icalendar--diarytime-to-isotime 885 (match-end monpos))))
878 (if (match-beginning 7) 886 (starttimestring (icalendar--diarytime-to-isotime
879 (substring entry-main 887 (if (match-beginning 4)
880 (match-beginning 7) 888 (substring entry-main
881 (match-end 7)) 889 (match-beginning 4)
882 nil) 890 (match-end 4))
883 (if (match-beginning 8) 891 nil)
884 (substring entry-main 892 (if (match-beginning 5)
885 (match-beginning 8) 893 (substring entry-main
886 (match-end 8)) 894 (match-beginning 5)
887 nil))) 895 (match-end 5))
888 (summary (icalendar--convert-string-for-export 896 nil)))
889 (substring entry-main (match-beginning 9) 897 (endtimestring (icalendar--diarytime-to-isotime
890 (match-end 9))))) 898 (if (match-beginning 7)
891 (when starttimestring 899 (substring entry-main
892 (unless endtimestring 900 (match-beginning 7)
893 (let ((time (read (icalendar--rris "^T0?" "" 901 (match-end 7))
894 starttimestring)))) 902 nil)
895 (setq endtimestring (format "T%06d" (+ 10000 time)))))) 903 (if (match-beginning 8)
896 (setq contents 904 (substring entry-main
897 (concat "\nDTSTART" 905 (match-beginning 8)
898 (if starttimestring "" ";VALUE=DATE") 906 (match-end 8))
899 (format ":1900%02d%02d" month day) 907 nil)))
900 (or starttimestring "") 908 (summary (icalendar--convert-string-for-export
901 "\nDTEND" 909 (substring entry-main (match-beginning 9)
902 (if endtimestring "" ";VALUE=DATE") 910 (match-end 9)))))
903 (format ":1900%02d%02d" month day) 911 (when starttimestring
904 (or endtimestring "") 912 (unless endtimestring
905 "\nSUMMARY:" summary 913 (let ((time (read (icalendar--rris "^T0?" ""
906 "\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=" 914 starttimestring))))
907 (format "%2d" month) 915 (setq endtimestring (format "T%06d" (+ 10000 time))))))
908 ";BYMONTHDAY=" 916 (setq contents
909 (format "%2d" day) 917 (concat "\nDTSTART;"
910 ))) 918 (if starttimestring "VALUE=DATE-TIME:"
911 (unless (string= entry-rest "") 919 "VALUE=DATE:")
912 (setq contents (concat contents "\nDESCRIPTION:" 920 (format "1900%02d%02d" month day)
913 (icalendar--convert-string-for-export 921 (or starttimestring "")
914 entry-rest))))) 922 "\nDTEND;"
915 ;; "ordinary" events, start and end time given 923 (if endtimestring "VALUE=DATE-TIME:"
916 ;; 1 Feb 2003 Hs Hochzeitsfeier, Dreieich 924 "VALUE=DATE:")
917 ((string-match 925 ;; end is not included! shift by one day
918 (concat nonmarker 926 (icalendar--date-to-isodate
919 "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)\\s-+" 927 (list month day 1900) (if endtimestring 0 1))
920 "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" 928 (or endtimestring "")
921 "\\(" 929 "\nSUMMARY:"
922 "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" 930 summary
923 "\\)?" 931 "\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH="
924 "\\s-*\\(.*\\)") 932 (format "%2d" month)
925 entry-main) 933 ";BYMONTHDAY="
926 (icalendar--dmsg "ordinary %s" entry-main) 934 (format "%2d" day)
927 (let* ((datestring (icalendar--datestring-to-isodate 935 )))
928 (substring entry-main (match-beginning 1) 936 (unless (string= entry-rest "")
929 (match-end 1)))) 937 (setq contents (concat contents "\nDESCRIPTION:"
930 (starttimestring (icalendar--diarytime-to-isotime 938 (icalendar--convert-string-for-export
931 (if (match-beginning 3) 939 entry-rest)))))
932 (substring entry-main 940 ;; "ordinary" events, start and end time given
933 (match-beginning 3) 941 ;; 1 Feb 2003 Hs Hochzeitsfeier, Dreieich
934 (match-end 3)) 942 ((string-match
935 nil) 943 (concat nonmarker
936 (if (match-beginning 4) 944 "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)\\s-+"
937 (substring entry-main 945 "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
938 (match-beginning 4) 946 "\\("
939 (match-end 4)) 947 "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
940 nil))) 948 "\\)?"
941 (endtimestring (icalendar--diarytime-to-isotime 949 "\\s-*\\(.*\\)")
942 (if (match-beginning 6) 950 entry-main)
943 (substring entry-main 951 (icalendar--dmsg "ordinary %s" entry-main)
944 (match-beginning 6) 952 (let* ((startdatestring (icalendar--datestring-to-isodate
945 (match-end 6)) 953 (substring entry-main
946 nil) 954 (match-beginning 1)
947 (if (match-beginning 7) 955 (match-end 1))))
948 (substring entry-main 956 (starttimestring (icalendar--diarytime-to-isotime
949 (match-beginning 7) 957 (if (match-beginning 3)
950 (match-end 7)) 958 (substring entry-main
951 nil))) 959 (match-beginning 3)
952 (summary (icalendar--convert-string-for-export 960 (match-end 3))
953 (substring entry-main (match-beginning 8) 961 nil)
954 (match-end 8))))) 962 (if (match-beginning 4)
955 (when starttimestring 963 (substring entry-main
956 (unless endtimestring 964 (match-beginning 4)
957 (let ((time (read (icalendar--rris "^T0?" "" 965 (match-end 4))
958 starttimestring)))) 966 nil)))
959 (setq endtimestring (format "T%06d" (+ 10000 time)))))) 967 (endtimestring (icalendar--diarytime-to-isotime
960 (setq contents (format 968 (if (match-beginning 6)
961 "\nDTSTART%s:%s%s\nDTEND%s:%s%s\nSUMMARY:%s" 969 (substring entry-main
962 (if starttimestring "" ";VALUE=DATE") 970 (match-beginning 6)
963 datestring 971 (match-end 6))
964 (or starttimestring "") 972 nil)
965 (if endtimestring "" 973 (if (match-beginning 7)
966 ";VALUE=DATE") 974 (substring entry-main
967 datestring 975 (match-beginning 7)
968 (or endtimestring "") 976 (match-end 7))
969 summary)) 977 nil)))
970 (unless (string= entry-rest "") 978 (summary (icalendar--convert-string-for-export
971 (setq contents (concat contents "\nDESCRIPTION:" 979 (substring entry-main (match-beginning 8)
972 (icalendar--convert-string-for-export 980 (match-end 8)))))
973 entry-rest)))))) 981 (unless startdatestring
974 ;; everything else 982 (error "Could not parse date"))
975 (t 983 (when starttimestring
976 ;; Oops! what's that? 984 (unless endtimestring
977 (setq oops t))) 985 (let ((time (read (icalendar--rris "^T0?" ""
978 (if oops 986 starttimestring))))
979 (message "Cannot export entry on line %d" 987 (setq endtimestring (format "T%06d" (+ 10000 time))))))
980 (count-lines (point-min) (point))) 988 (setq contents (concat
981 (setq result (concat result header contents "\nEND:VEVENT")))) 989 "\nDTSTART;"
990 (if starttimestring "VALUE=DATE-TIME:"
991 "VALUE=DATE:")
992 startdatestring
993 (or starttimestring "")
994 "\nDTEND;"
995 (if endtimestring "VALUE=DATE-TIME:"
996 "VALUE=DATE:")
997 (icalendar--datestring-to-isodate
998 (substring entry-main
999 (match-beginning 1)
1000 (match-end 1))
1001 (if endtimestring 0 1))
1002 (or endtimestring "")
1003 "\nSUMMARY:"
1004 summary))
1005 ;; could not parse the date
1006 (unless (string= entry-rest "")
1007 (setq contents (concat contents "\nDESCRIPTION:"
1008 (icalendar--convert-string-for-export
1009 entry-rest))))))
1010 ;; everything else
1011 (t
1012 ;; Oops! what's that?
1013 (error "Could not parse entry")))
1014 (setq result (concat result header contents "\nEND:VEVENT")))
1015 ;; handle errors
1016 (error
1017 (setq found-error t)
1018 (save-current-buffer
1019 (set-buffer (get-buffer-create " *icalendar-errors*"))
1020 (insert (format "Error in line %d -- %s: `%s'\n"
1021 (count-lines (point-min) (point))
1022 (cadr error-val)
1023 entry-main))))))
1024
982 ;; we're done, insert everything into the file 1025 ;; we're done, insert everything into the file
983 (let ((coding-system-for-write 'utf8)) 1026 (let ((coding-system-for-write 'utf8))
984 (set-buffer (find-file ical-filename)) 1027 (set-buffer (find-file ical-filename))
985 (goto-char (point-max)) 1028 (goto-char (point-max))
986 (insert "BEGIN:VCALENDAR") 1029 (insert "BEGIN:VCALENDAR")
987 (insert "\nPRODID:-//Emacs//NONSGML icalendar.el//EN") 1030 (insert "\nPRODID:-//Emacs//NONSGML icalendar.el//EN")
988 (insert "\nVERSION:2.0") 1031 (insert "\nVERSION:2.0")
989 (insert result) 1032 (insert result)
990 (insert "\nEND:VCALENDAR\n"))))) 1033 (insert "\nEND:VCALENDAR\n")))
1034 found-error))
991 1035
992;; ====================================================================== 1036;; ======================================================================
993;; Import -- convert icalendar to emacs-diary 1037;; Import -- convert icalendar to emacs-diary
@@ -1001,7 +1045,7 @@ Argument ICAL-FILENAME output iCalendar file.
1001Argument DIARY-FILENAME input `diary-file'. 1045Argument DIARY-FILENAME input `diary-file'.
1002Optional argument NON-MARKING determines whether events are created as 1046Optional argument NON-MARKING determines whether events are created as
1003non-marking or not." 1047non-marking or not."
1004 (interactive "fImport iCalendar data from file: 1048 (interactive "fImport iCalendar data from file:
1005Finto diary file: 1049Finto diary file:
1006p") 1050p")
1007 ;; clean up the diary file 1051 ;; clean up the diary file
@@ -1062,9 +1106,7 @@ reading, parsing, or converting iCalendar data!"
1062 "Current buffer does not contain icalendar contents!")))) 1106 "Current buffer does not contain icalendar contents!"))))
1063 1107
1064(defalias 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer) 1108(defalias 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer)
1065 1109(make-obsolete 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer)
1066(make-obsolete 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer
1067 "icalendar 0.07")
1068 1110
1069;; ====================================================================== 1111;; ======================================================================
1070;; private area 1112;; private area
@@ -1184,7 +1226,7 @@ written into the buffer ` *icalendar-errors*'."
1184 (setq diary-string 1226 (setq diary-string
1185 (format "%s %s%s%s" 1227 (format "%s %s%s%s"
1186 (aref calendar-day-name-array 1228 (aref calendar-day-name-array
1187 weekday) 1229 weekday)
1188 start-t (if end-t "-" "") 1230 start-t (if end-t "-" "")
1189 (or end-t ""))) 1231 (or end-t "")))
1190 ;; FIXME!!!! 1232 ;; FIXME!!!!
diff --git a/lisp/comint.el b/lisp/comint.el
index 16fd9782116..352ed876ee0 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -788,7 +788,7 @@ buffer. The hook `comint-exec-hook' is run after each exec."
788 788
789(defun comint-insert-input (&optional event) 789(defun comint-insert-input (&optional event)
790 "In a Comint buffer, set the current input to the previous input at point." 790 "In a Comint buffer, set the current input to the previous input at point."
791 (interactive "@") 791 (interactive "e")
792 (if event (mouse-set-point event)) 792 (if event (mouse-set-point event))
793 (let ((pos (point))) 793 (let ((pos (point)))
794 (if (not (eq (get-char-property pos 'field) 'input)) 794 (if (not (eq (get-char-property pos 'field) 'input))
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 9e0efc5d3d0..89fcb633133 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -896,15 +896,14 @@ then prompt for the MODE to customize."
896 (let ((name (format "*Customize Group: %s*" 896 (let ((name (format "*Customize Group: %s*"
897 (custom-unlispify-tag-name group)))) 897 (custom-unlispify-tag-name group))))
898 (if (get-buffer name) 898 (if (get-buffer name)
899 (let ((window (selected-window)) 899 (let (
900 ;; Copied from `custom-buffer-create-other-window'. 900 ;; Copied from `custom-buffer-create-other-window'.
901 (pop-up-windows t) 901 (pop-up-windows t)
902 (special-display-buffer-names nil) 902 (special-display-buffer-names nil)
903 (special-display-regexps nil) 903 (special-display-regexps nil)
904 (same-window-buffer-names nil) 904 (same-window-buffer-names nil)
905 (same-window-regexps nil)) 905 (same-window-regexps nil))
906 (pop-to-buffer name) 906 (pop-to-buffer name))
907 (select-window window))
908 (custom-buffer-create-other-window 907 (custom-buffer-create-other-window
909 (list (list group 'custom-group)) 908 (list (list group 'custom-group))
910 name 909 name
@@ -1240,21 +1239,20 @@ that option."
1240 1239
1241;;;###autoload 1240;;;###autoload
1242(defun custom-buffer-create-other-window (options &optional name description) 1241(defun custom-buffer-create-other-window (options &optional name description)
1243 "Create a buffer containing OPTIONS. 1242 "Create a buffer containing OPTIONS, and display it in another window.
1243The result includes selecting that window.
1244Optional NAME is the name of the buffer. 1244Optional NAME is the name of the buffer.
1245OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where 1245OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
1246SYMBOL is a customization option, and WIDGET is a widget for editing 1246SYMBOL is a customization option, and WIDGET is a widget for editing
1247that option." 1247that option."
1248 (unless name (setq name "*Customization*")) 1248 (unless name (setq name "*Customization*"))
1249 (let ((window (selected-window)) 1249 (let ((pop-up-windows t)
1250 (pop-up-windows t)
1251 (special-display-buffer-names nil) 1250 (special-display-buffer-names nil)
1252 (special-display-regexps nil) 1251 (special-display-regexps nil)
1253 (same-window-buffer-names nil) 1252 (same-window-buffer-names nil)
1254 (same-window-regexps nil)) 1253 (same-window-regexps nil))
1255 (pop-to-buffer (custom-get-fresh-buffer name)) 1254 (pop-to-buffer (custom-get-fresh-buffer name))
1256 (custom-buffer-create-internal options description) 1255 (custom-buffer-create-internal options description)))
1257 (select-window window)))
1258 1256
1259(defcustom custom-reset-button-menu nil 1257(defcustom custom-reset-button-menu nil
1260 "If non-nil, only show a single reset button in customize buffers. 1258 "If non-nil, only show a single reset button in customize buffers.
diff --git a/lisp/descr-text.el b/lisp/descr-text.el
index 8f915d52d3a..2693575f4e2 100644
--- a/lisp/descr-text.el
+++ b/lisp/descr-text.el
@@ -176,11 +176,12 @@ otherwise."
176 (describe-text-properties-1 pos output-buffer) 176 (describe-text-properties-1 pos output-buffer)
177 (if (not (or (text-properties-at pos) (overlays-at pos))) 177 (if (not (or (text-properties-at pos) (overlays-at pos)))
178 (message "This is plain text.") 178 (message "This is plain text.")
179 (let ((buffer (current-buffer))) 179 (let ((buffer (current-buffer))
180 (when (eq buffer (get-buffer "*Help*")) 180 (target-buffer "*Help*"))
181 (error "Can't do self inspection")) 181 (when (eq buffer (get-buffer target-buffer))
182 (setq target-buffer "*Help-2*"))
182 (save-excursion 183 (save-excursion
183 (with-output-to-temp-buffer "*Help*" 184 (with-output-to-temp-buffer target-buffer
184 (set-buffer standard-output) 185 (set-buffer standard-output)
185 (setq output-buffer (current-buffer)) 186 (setq output-buffer (current-buffer))
186 (widget-insert "Text content at position " (format "%d" pos) ":\n\n") 187 (widget-insert "Text content at position " (format "%d" pos) ":\n\n")
diff --git a/lisp/dired.el b/lisp/dired.el
index 96b2905337e..c0fc33729c2 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -546,7 +546,7 @@ Optional third argument FILTER, if non-nil, is a function to select
546 (if current-prefix-arg 546 (if current-prefix-arg
547 (read-string "Dired listing switches: " 547 (read-string "Dired listing switches: "
548 dired-listing-switches)) 548 dired-listing-switches))
549 (read-file-name (format "Dired %s(directory): " str) 549 (read-directory-name (format "Dired %s(directory): " str)
550 nil default-directory nil)))) 550 nil default-directory nil))))
551 551
552;;;###autoload (define-key ctl-x-map "d" 'dired) 552;;;###autoload (define-key ctl-x-map "d" 'dired)
diff --git a/lisp/ehelp.el b/lisp/ehelp.el
index e80c129d3ea..82a8e10301e 100644
--- a/lisp/ehelp.el
+++ b/lisp/ehelp.el
@@ -85,11 +85,11 @@
85 (define-key map "<" 'beginning-of-buffer) 85 (define-key map "<" 'beginning-of-buffer)
86 (define-key map ">" 'end-of-buffer) 86 (define-key map ">" 'end-of-buffer)
87 ;(define-key map "\C-g" 'electric-help-exit) 87 ;(define-key map "\C-g" 'electric-help-exit)
88 (define-key map "q" 'electric-help-exit)
89 (define-key map "Q" 'electric-help-exit) 88 (define-key map "Q" 'electric-help-exit)
89 (define-key map "q" 'electric-help-exit)
90 ;;a better key than this? 90 ;;a better key than this?
91 (define-key map "r" 'electric-help-retain)
92 (define-key map "R" 'electric-help-retain) 91 (define-key map "R" 'electric-help-retain)
92 (define-key map "r" 'electric-help-retain)
93 (define-key map "\ex" 'electric-help-execute-extended) 93 (define-key map "\ex" 'electric-help-execute-extended)
94 (define-key map "\C-x" 'electric-help-ctrl-x-prefix) 94 (define-key map "\C-x" 'electric-help-ctrl-x-prefix)
95 95
diff --git a/lisp/elide-head.el b/lisp/elide-head.el
index 8fc8e12a3fb..fed6ecee7af 100644
--- a/lisp/elide-head.el
+++ b/lisp/elide-head.el
@@ -98,7 +98,7 @@ This is suitable as an entry on `find-file-hook' or appropriate mode hooks."
98 (if rest (setq rest (cdr rest)))) 98 (if rest (setq rest (cdr rest))))
99 (if (not (and beg end)) 99 (if (not (and beg end))
100 (if (interactive-p) 100 (if (interactive-p)
101 (error "No header found")) 101 (message "No header found"))
102 (goto-char beg) 102 (goto-char beg)
103 (end-of-line) 103 (end-of-line)
104 (if (overlayp elide-head-overlay) 104 (if (overlayp elide-head-overlay)
@@ -115,7 +115,7 @@ This is suitable as an entry on `find-file-hook' or appropriate mode hooks."
115 (overlay-buffer elide-head-overlay)) 115 (overlay-buffer elide-head-overlay))
116 (delete-overlay elide-head-overlay) 116 (delete-overlay elide-head-overlay)
117 (if (interactive-p) 117 (if (interactive-p)
118 (error "No header hidden")))) 118 (message "No header hidden"))))
119 119
120(provide 'elide-head) 120(provide 'elide-head)
121 121
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index 7686722c5be..cfaac96bbb1 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -3106,7 +3106,7 @@ in any of these classes."
3106 (not advised-interactive-form)) 3106 (not advised-interactive-form))
3107 ;; Check whether we were called interactively 3107 ;; Check whether we were called interactively
3108 ;; in order to do proper prompting: 3108 ;; in order to do proper prompting:
3109 `(if (interactive-p) 3109 `(if (called-interactively-p)
3110 (call-interactively ',origname) 3110 (call-interactively ',origname)
3111 ,(ad-make-mapped-call orig-arglist 3111 ,(ad-make-mapped-call orig-arglist
3112 advised-arglist 3112 advised-arglist
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index 5a5eb55a2a2..196786e9179 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -360,11 +360,14 @@ are used."
360 (message "Generating autoloads for %s...done" file))) 360 (message "Generating autoloads for %s...done" file)))
361 361
362;;;###autoload 362;;;###autoload
363(defun update-file-autoloads (file) 363(defun update-file-autoloads (file &optional save-after)
364 "Update the autoloads for FILE in `generated-autoload-file' 364 "Update the autoloads for FILE in `generated-autoload-file'
365\(which FILE might bind in its local variables). 365\(which FILE might bind in its local variables).
366Return FILE if there was no autoload cookie in it." 366If SAVE-AFTER is non-nil (which is always, when called interactively),
367 (interactive "fUpdate autoloads for file: ") 367save the buffer too.
368
369Return FILE if there was no autoload cookie in it, else nil."
370 (interactive "fUpdate autoloads for file: \np")
368 (let ((load-name (let ((name (file-name-nondirectory file))) 371 (let ((load-name (let ((name (file-name-nondirectory file)))
369 (if (string-match "\\.elc?\\(\\.\\|$\\)" name) 372 (if (string-match "\\.elc?\\(\\.\\|$\\)" name)
370 (substring name 0 (match-beginning 0)) 373 (substring name 0 (match-beginning 0))
@@ -464,7 +467,7 @@ Autoload section for %s is up to date."
464 (or existing-buffer 467 (or existing-buffer
465 (kill-buffer (current-buffer)))))))) 468 (kill-buffer (current-buffer))))))))
466 (generate-file-autoloads file)))) 469 (generate-file-autoloads file))))
467 (and (interactive-p) 470 (and save-after
468 (buffer-modified-p) 471 (buffer-modified-p)
469 (save-buffer)) 472 (save-buffer))
470 473
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 846f3efd2ee..da1e5fba8b2 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -98,6 +98,9 @@
98;; `obsolete' (obsolete variables and functions) 98;; `obsolete' (obsolete variables and functions)
99;; `noruntime' (calls to functions only defined 99;; `noruntime' (calls to functions only defined
100;; within `eval-when-compile') 100;; within `eval-when-compile')
101;; `cl-warnings' (calls to CL functions)
102;; `interactive-only' (calls to commands that are
103;; not good to call from Lisp)
101;; byte-compile-compatibility Whether the compiler should 104;; byte-compile-compatibility Whether the compiler should
102;; generate .elc files which can be loaded into 105;; generate .elc files which can be loaded into
103;; generic emacs 18. 106;; generic emacs 18.
@@ -325,7 +328,8 @@ If it is 'byte, then only byte-level optimizations will be logged."
325 :type 'boolean) 328 :type 'boolean)
326 329
327(defconst byte-compile-warning-types 330(defconst byte-compile-warning-types
328 '(redefine callargs free-vars unresolved obsolete noruntime cl-functions) 331 '(redefine callargs free-vars unresolved
332 obsolete noruntime cl-functions interactive-only)
329 "The list of warning types used when `byte-compile-warnings' is t.") 333 "The list of warning types used when `byte-compile-warnings' is t.")
330(defcustom byte-compile-warnings t 334(defcustom byte-compile-warnings t
331 "*List of warnings that the byte-compiler should issue (t for all). 335 "*List of warnings that the byte-compiler should issue (t for all).
@@ -341,13 +345,21 @@ Elements of the list may be be:
341 noruntime functions that may not be defined at runtime (typically 345 noruntime functions that may not be defined at runtime (typically
342 defined only under `eval-when-compile'). 346 defined only under `eval-when-compile').
343 cl-functions calls to runtime functions from the CL package (as 347 cl-functions calls to runtime functions from the CL package (as
344 distinguished from macros and aliases)." 348 distinguished from macros and aliases).
349 interactive-only
350 commands that normally shouldn't be called from Lisp code."
345 :group 'bytecomp 351 :group 'bytecomp
346 :type `(choice (const :tag "All" t) 352 :type `(choice (const :tag "All" t)
347 (set :menu-tag "Some" 353 (set :menu-tag "Some"
348 (const free-vars) (const unresolved) 354 (const free-vars) (const unresolved)
349 (const callargs) (const redefine) 355 (const callargs) (const redefine)
350 (const obsolete) (const noruntime) (const cl-functions)))) 356 (const obsolete) (const noruntime)
357 (const cl-functions) (const interactive-only))))
358
359(defvar byte-compile-interactive-only-functions
360 '(beginning-of-buffer end-of-buffer replace-string replace-regexp
361 insert-file)
362 "List of commands that are not meant to be called from Lisp.")
351 363
352(defvar byte-compile-not-obsolete-var nil 364(defvar byte-compile-not-obsolete-var nil
353 "If non-nil, this is a variable that shouldn't be reported as obsolete.") 365 "If non-nil, this is a variable that shouldn't be reported as obsolete.")
@@ -2710,6 +2722,10 @@ If FORM is a lambda or a macro, byte-compile it as a function."
2710 (byte-compile-set-symbol-position fn) 2722 (byte-compile-set-symbol-position fn)
2711 (when (byte-compile-const-symbol-p fn) 2723 (when (byte-compile-const-symbol-p fn)
2712 (byte-compile-warn "`%s' called as a function" fn)) 2724 (byte-compile-warn "`%s' called as a function" fn))
2725 (and (memq 'interactive-only byte-compile-warnings)
2726 (memq (car form) byte-compile-interactive-only-functions)
2727 (byte-compile-warn "`%s' used from Lisp code\n\
2728That command is designed for interactive use only" fn))
2713 (if (and handler 2729 (if (and handler
2714 (or (not (byte-compile-version-cond 2730 (or (not (byte-compile-version-cond
2715 byte-compile-compatibility)) 2731 byte-compile-compatibility))
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index 2439fdd4de6..b6b91710ed4 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -209,7 +209,7 @@ With zero or negative ARG turn mode off.
209 ,@body 209 ,@body
210 ;; The on/off hooks are here for backward compatibility only. 210 ;; The on/off hooks are here for backward compatibility only.
211 (run-hooks ',hook (if ,mode ',hook-on ',hook-off)) 211 (run-hooks ',hook (if ,mode ',hook-on ',hook-off))
212 (if (interactive-p) 212 (if (called-interactively-p)
213 (progn 213 (progn
214 ,(if globalp `(customize-mark-as-set ',mode)) 214 ,(if globalp `(customize-mark-as-set ',mode))
215 (unless (current-message) 215 (unless (current-message)
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el
index dbd7194f50a..e039b80aee5 100644
--- a/lisp/emacs-lisp/easymenu.el
+++ b/lisp/emacs-lisp/easymenu.el
@@ -42,7 +42,25 @@ menus, turn this variable off, otherwise it is probably better to keep it on."
42 :version "20.3") 42 :version "20.3")
43 43
44(defsubst easy-menu-intern (s) 44(defsubst easy-menu-intern (s)
45 (if (stringp s) (intern (downcase s)) s)) 45 (if (stringp s)
46 (let ((copy (copy-sequence s))
47 (pos 0)
48 found)
49 ;; For each letter that starts a word, flip its case.
50 ;; This way, the usual convention for menu strings (capitalized)
51 ;; corresponds to the usual convention for menu item event types
52 ;; (all lower case). It's a 1-1 mapping so causes no conflicts.
53 (while (setq found (string-match "\\<\\sw" copy pos))
54 (setq pos (match-end 0))
55 (unless (= (upcase (aref copy found))
56 (downcase (aref copy found)))
57 (aset copy found
58 (if (= (upcase (aref copy found))
59 (aref copy found))
60 (downcase (aref copy found))
61 (upcase (aref copy found))))))
62 (intern copy))
63 s))
46 64
47;;;###autoload 65;;;###autoload
48(put 'easy-menu-define 'lisp-indent-function 'defun) 66(put 'easy-menu-define 'lisp-indent-function 'defun)
diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el
index 17991067fab..d701db9e9b6 100644
--- a/lisp/emacs-lisp/elp.el
+++ b/lisp/emacs-lisp/elp.el
@@ -257,7 +257,7 @@ FUNSYM must be a symbol of a defined function."
257 (setq newguts (append newguts `((elp-wrapper 257 (setq newguts (append newguts `((elp-wrapper
258 (quote ,funsym) 258 (quote ,funsym)
259 ,(when (commandp funsym) 259 ,(when (commandp funsym)
260 '(interactive-p)) 260 '(called-interactively-p))
261 args)))) 261 args))))
262 ;; to record profiling times, we set the symbol's function 262 ;; to record profiling times, we set the symbol's function
263 ;; definition so that it runs the elp-wrapper function with the 263 ;; definition so that it runs the elp-wrapper function with the
diff --git a/lisp/emacs-lisp/lselect.el b/lisp/emacs-lisp/lselect.el
index b292eefbaec..42dad0c48d8 100644
--- a/lisp/emacs-lisp/lselect.el
+++ b/lisp/emacs-lisp/lselect.el
@@ -1,6 +1,6 @@
1;;; lselect.el --- Lucid interface to X Selections 1;;; lselect.el --- Lucid interface to X Selections
2 2
3;; Copyright (C) 1990, 1993 Free Software Foundation, Inc. 3;; Copyright (C) 1990, 1993, 2004 Free Software Foundation, Inc.
4 4
5;; Maintainer: FSF 5;; Maintainer: FSF
6;; Keywords: emulations 6;; Keywords: emulations
@@ -146,7 +146,7 @@ secondary selection instead of the primary selection."
146 (x-disown-selection-internal (if secondary-p 'SECONDARY 'PRIMARY))) 146 (x-disown-selection-internal (if secondary-p 'SECONDARY 'PRIMARY)))
147 147
148(defun x-dehilight-selection (selection) 148(defun x-dehilight-selection (selection)
149 "for use as a value of x-lost-selection-hooks." 149 "for use as a value of `x-lost-selection-functions'."
150 (cond ((eq selection 'PRIMARY) 150 (cond ((eq selection 'PRIMARY)
151 (if primary-selection-extent 151 (if primary-selection-extent
152 (let ((inhibit-quit t)) 152 (let ((inhibit-quit t))
@@ -160,23 +160,23 @@ secondary selection instead of the primary selection."
160 (setq secondary-selection-extent nil))))) 160 (setq secondary-selection-extent nil)))))
161 nil) 161 nil)
162 162
163(setq x-lost-selection-hooks 'x-dehilight-selection) 163(setq x-lost-selection-functions 'x-dehilight-selection)
164 164
165(defun x-notice-selection-requests (selection type successful) 165(defun x-notice-selection-requests (selection type successful)
166 "for possible use as the value of x-sent-selection-hooks." 166 "for possible use as the value of `x-sent-selection-functions'."
167 (if (not successful) 167 (if (not successful)
168 (message "Selection request failed to convert %s to %s" 168 (message "Selection request failed to convert %s to %s"
169 selection type) 169 selection type)
170 (message "Sent selection %s as %s" selection type))) 170 (message "Sent selection %s as %s" selection type)))
171 171
172(defun x-notice-selection-failures (selection type successful) 172(defun x-notice-selection-failures (selection type successful)
173 "for possible use as the value of x-sent-selection-hooks." 173 "for possible use as the value of `x-sent-selection-functions'."
174 (or successful 174 (or successful
175 (message "Selection request failed to convert %s to %s" 175 (message "Selection request failed to convert %s to %s"
176 selection type))) 176 selection type)))
177 177
178;(setq x-sent-selection-hooks 'x-notice-selection-requests) 178;(setq x-sent-selection-functions 'x-notice-selection-requests)
179;(setq x-sent-selection-hooks 'x-notice-selection-failures) 179;(setq x-sent-selection-functions 'x-notice-selection-failures)
180 180
181 181
182;; Random utility functions 182;; Random utility functions
@@ -232,5 +232,5 @@ the kill ring or the Clipboard."
232 232
233(provide 'lselect) 233(provide 'lselect)
234 234
235;;; arch-tag: 92fa54d4-c5d1-4e9b-ad58-cf1e13930556 235;; arch-tag: 92fa54d4-c5d1-4e9b-ad58-cf1e13930556
236;;; lselect.el ends here 236;;; lselect.el ends here
diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el
index fb3c537936f..523a07d26de 100644
--- a/lisp/emulation/cua-base.el
+++ b/lisp/emulation/cua-base.el
@@ -1,6 +1,7 @@
1;;; cua-base.el --- emulate CUA key bindings 1;;; cua-base.el --- emulate CUA key bindings
2 2
3;; Copyright (C) 1997,98,99,200,01,02,03,04 Free Software Foundation, Inc. 3;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
4;; Free Software Foundation, Inc.
4 5
5;; Author: Kim F. Storm <storm@cua.dk> 6;; Author: Kim F. Storm <storm@cua.dk>
6;; Keywords: keyboard emulation convenience cua 7;; Keywords: keyboard emulation convenience cua
@@ -266,6 +267,7 @@
266 :group 'editing-basics 267 :group 'editing-basics
267 :group 'convenience 268 :group 'convenience
268 :group 'emulations 269 :group 'emulations
270 :version "21.4"
269 :link '(emacs-commentary-link :tag "Commentary" "cua-base.el") 271 :link '(emacs-commentary-link :tag "Commentary" "cua-base.el")
270 :link '(emacs-library-link :tag "Lisp File" "cua-base.el")) 272 :link '(emacs-library-link :tag "Lisp File" "cua-base.el"))
271 273
@@ -1337,7 +1339,6 @@ paste (in addition to the normal emacs bindings)."
1337 :set-after '(cua-enable-modeline-indications cua-use-hyper-key) 1339 :set-after '(cua-enable-modeline-indications cua-use-hyper-key)
1338 :require 'cua-base 1340 :require 'cua-base
1339 :link '(emacs-commentary-link "cua-base.el") 1341 :link '(emacs-commentary-link "cua-base.el")
1340 :version "21.4"
1341 (setq mark-even-if-inactive t) 1342 (setq mark-even-if-inactive t)
1342 (setq highlight-nonselected-windows nil) 1343 (setq highlight-nonselected-windows nil)
1343 (make-variable-buffer-local 'cua--explicit-region-start) 1344 (make-variable-buffer-local 'cua--explicit-region-start)
diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el
index ce30cec6604..d932916d8c9 100644
--- a/lisp/eshell/em-unix.el
+++ b/lisp/eshell/em-unix.el
@@ -799,7 +799,7 @@ external command."
799 (size 0.0)) 799 (size 0.0))
800 (while entries 800 (while entries
801 (unless (string-match "\\`\\.\\.?\\'" (caar entries)) 801 (unless (string-match "\\`\\.\\.?\\'" (caar entries))
802 (let* ((entry (concat path (char-to-string directory-sep-char) 802 (let* ((entry (concat path "/"
803 (caar entries))) 803 (caar entries)))
804 (symlink (and (stringp (cadr (car entries))) 804 (symlink (and (stringp (cadr (car entries)))
805 (cadr (car entries))))) 805 (cadr (car entries)))))
diff --git a/lisp/fast-lock.el b/lisp/fast-lock.el
index 6812361a28b..4a409bd77aa 100644
--- a/lisp/fast-lock.el
+++ b/lisp/fast-lock.el
@@ -26,7 +26,7 @@
26 26
27;;; Commentary: 27;;; Commentary:
28 28
29;; Lazy Lock mode is a Font Lock support mode. 29;; Fast Lock mode is a Font Lock support mode.
30;; It makes visiting a file in Font Lock mode faster by restoring its face text 30;; It makes visiting a file in Font Lock mode faster by restoring its face text
31;; properties from automatically saved associated Font Lock cache files. 31;; properties from automatically saved associated Font Lock cache files.
32;; 32;;
diff --git a/lisp/files.el b/lisp/files.el
index c9fb3514b57..523a5a12f7b 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -977,6 +977,14 @@ expand wildcards (if any) and visit multiple files."
977 (mapcar 'switch-to-buffer (cdr value))) 977 (mapcar 'switch-to-buffer (cdr value)))
978 (switch-to-buffer-other-frame value)))) 978 (switch-to-buffer-other-frame value))))
979 979
980(defun find-file-existing (filename &optional wildcards)
981 "Edit the existing file FILENAME.
982Like \\[find-file] but only allow files that exists."
983 (interactive (find-file-read-args "Find existing file: " t))
984 (unless (file-exists-p filename) (error "%s does not exist" filename))
985 (find-file filename wildcards)
986 (current-buffer))
987
980(defun find-file-read-only (filename &optional wildcards) 988(defun find-file-read-only (filename &optional wildcards)
981 "Edit file FILENAME but don't allow changes. 989 "Edit file FILENAME but don't allow changes.
982Like \\[find-file] but marks buffer as read-only. 990Like \\[find-file] but marks buffer as read-only.
@@ -1225,6 +1233,7 @@ suppresses this warning."
1225When nil, never request confirmation." 1233When nil, never request confirmation."
1226 :group 'files 1234 :group 'files
1227 :group 'find-file 1235 :group 'find-file
1236 :version "21.4"
1228 :type '(choice integer (const :tag "Never request confirmation" nil))) 1237 :type '(choice integer (const :tag "Never request confirmation" nil)))
1229 1238
1230(defun find-file-noselect (filename &optional nowarn rawfile wildcards) 1239(defun find-file-noselect (filename &optional nowarn rawfile wildcards)
@@ -1645,7 +1654,9 @@ in that case, this function acts as if `enable-local-variables' were t."
1645 (mapc 1654 (mapc
1646 (lambda (elt) 1655 (lambda (elt)
1647 (cons (purecopy (car elt)) (cdr elt))) 1656 (cons (purecopy (car elt)) (cdr elt)))
1648 '(("\\.te?xt\\'" . text-mode) 1657 '(;; do this first, so that .html.pl is Polish html, not Perl
1658 ("\\.s?html?\\(\\.[a-zA-Z_]+\\)?\\'" . html-mode)
1659 ("\\.te?xt\\'" . text-mode)
1649 ("\\.[tT]e[xX]\\'" . tex-mode) 1660 ("\\.[tT]e[xX]\\'" . tex-mode)
1650 ("\\.ins\\'" . tex-mode) ;Installation files for TeX packages. 1661 ("\\.ins\\'" . tex-mode) ;Installation files for TeX packages.
1651 ("\\.ltx\\'" . latex-mode) 1662 ("\\.ltx\\'" . latex-mode)
@@ -1661,7 +1672,6 @@ in that case, this function acts as if `enable-local-variables' were t."
1661 ("\\.ad[abs]\\'" . ada-mode) 1672 ("\\.ad[abs]\\'" . ada-mode)
1662 ("\\.ad[bs].dg\\'" . ada-mode) 1673 ("\\.ad[bs].dg\\'" . ada-mode)
1663 ("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode) 1674 ("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode)
1664 ("\\.s?html?\\'" . html-mode)
1665 ("\\.mk\\'" . makefile-mode) 1675 ("\\.mk\\'" . makefile-mode)
1666 ("\\([Mm]\\|GNUm\\)akep*file\\'" . makefile-mode) 1676 ("\\([Mm]\\|GNUm\\)akep*file\\'" . makefile-mode)
1667 ("\\.am\\'" . makefile-mode) ;For Automake. 1677 ("\\.am\\'" . makefile-mode) ;For Automake.
@@ -1689,7 +1699,8 @@ in that case, this function acts as if `enable-local-variables' were t."
1689 ("\\.bib\\'" . bibtex-mode) 1699 ("\\.bib\\'" . bibtex-mode)
1690 ("\\.sql\\'" . sql-mode) 1700 ("\\.sql\\'" . sql-mode)
1691 ("\\.m[4c]\\'" . m4-mode) 1701 ("\\.m[4c]\\'" . m4-mode)
1692 ("\\.m[fp]\\'" . metapost-mode) 1702 ("\\.mf\\'" . metafont-mode)
1703 ("\\.mp\\'" . metapost-mode)
1693 ("\\.vhdl?\\'" . vhdl-mode) 1704 ("\\.vhdl?\\'" . vhdl-mode)
1694 ("\\.article\\'" . text-mode) 1705 ("\\.article\\'" . text-mode)
1695 ("\\.letter\\'" . text-mode) 1706 ("\\.letter\\'" . text-mode)
@@ -1834,20 +1845,27 @@ be interpreted by the interpreter matched by the second group of the
1834regular expression. The mode is then determined as the mode associated 1845regular expression. The mode is then determined as the mode associated
1835with that interpreter in `interpreter-mode-alist'.") 1846with that interpreter in `interpreter-mode-alist'.")
1836 1847
1837(defvar xml-based-modes '(html-mode) 1848(defvar magic-mode-alist
1838 "Modes that override an XML declaration. 1849 '(;; The < comes before the groups (but the first) to reduce backtracking.
1839When `set-auto-mode' sees an <?xml or <!DOCTYPE declaration, that 1850 ;; Is there a nicer way of getting . including \n?
1840buffer will be in some XML mode. If `auto-mode-alist' associates 1851 ;; TODO: UTF-16 <?xml may be preceded by a BOM 0xff 0xfe or 0xfe 0xff.
1841the file with one of the modes in this list, that mode will be 1852 ("\\(?:<\\?xml\\s +[^>]*>\\)?\\s *<\\(?:!--\\(?:.\\|\n\\)*?-->\\s *<\\)*\\(?:!DOCTYPE\\s +[^>]*>\\s *<\\)?\\s *\\(?:!--\\(?:.\\|\n\\)*?-->\\s *<\\)*[Hh][Tt][Mm][Ll]" . html-mode)
1842used. Else `xml-mode' or `sgml-mode' is used.") 1853 ;; These two must come after html, because they are more general:
1843 1854 ("<\\?xml " . xml-mode)
1844(defun set-auto-mode (&optional just-from-file-name) 1855 ("\\s *<\\(?:!--\\(?:.\\|\n\\)*?-->\\s *<\\)*!DOCTYPE " . sgml-mode)
1856 ("%![^V]" . ps-mode))
1857 "Alist of buffer beginnings vs corresponding major mode functions.
1858Each element looks like (REGEXP . FUNCTION). FUNCTION will be
1859called, unless it is nil.")
1860
1861(defun set-auto-mode (&optional keep-mode-if-same)
1845 "Select major mode appropriate for current buffer. 1862 "Select major mode appropriate for current buffer.
1863
1846This checks for a -*- mode tag in the buffer's text, checks the 1864This checks for a -*- mode tag in the buffer's text, checks the
1847interpreter that runs this file against `interpreter-mode-alist', 1865interpreter that runs this file against `interpreter-mode-alist',
1848looks for an <?xml or <!DOCTYPE declaration (see 1866compares the buffer beginning against `magic-mode-alist',
1849`xml-based-modes'), or compares the filename against the entries 1867or compares the filename against the entries in
1850in `auto-mode-alist'. 1868`auto-mode-alist'.
1851 1869
1852It does not check for the `mode:' local variable in the 1870It does not check for the `mode:' local variable in the
1853Local Variables section of the file; for that, use `hack-local-variables'. 1871Local Variables section of the file; for that, use `hack-local-variables'.
@@ -1855,88 +1873,103 @@ Local Variables section of the file; for that, use `hack-local-variables'.
1855If `enable-local-variables' is nil, this function does not check for a 1873If `enable-local-variables' is nil, this function does not check for a
1856-*- mode tag. 1874-*- mode tag.
1857 1875
1858If the optional argument JUST-FROM-FILE-NAME is non-nil, 1876If the optional argument KEEP-MODE-IF-SAME is non-nil, then we
1859then we do not set anything but the major mode, 1877only set the major mode, if that would change it."
1860and we don't even do that unless it would come from the file name."
1861 ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*- 1878 ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
1862 (let (end done mode modes xml) 1879 (let (end done mode modes xml)
1863 (unless just-from-file-name 1880 ;; Find a -*- mode tag
1864 ;; Find a -*- mode tag 1881 (save-excursion
1865 (save-excursion 1882 (goto-char (point-min))
1866 (goto-char (point-min)) 1883 (skip-chars-forward " \t\n")
1867 (skip-chars-forward " \t\n") 1884 ;; While we're at this point, check xml for later.
1868 ;; While we're at this point, check xml for later. 1885 (setq xml (looking-at "<\\?xml \\|<!DOCTYPE"))
1869 (setq xml (looking-at "<\\?xml \\|<!DOCTYPE")) 1886 (and enable-local-variables
1870 (and enable-local-variables 1887 (setq end (set-auto-mode-1))
1871 (setq end (set-auto-mode-1)) 1888 (if (save-excursion (search-forward ":" end t))
1872 (if (save-excursion (search-forward ":" end t)) 1889 ;; Find all specifications for the `mode:' variable
1873 ;; Find all specifications for the `mode:' variable 1890 ;; and execute them left to right.
1874 ;; and execute them left to right. 1891 (while (let ((case-fold-search t))
1875 (while (let ((case-fold-search t)) 1892 (or (and (looking-at "mode:")
1876 (or (and (looking-at "mode:") 1893 (goto-char (match-end 0)))
1877 (goto-char (match-end 0))) 1894 (re-search-forward "[ \t;]mode:" end t)))
1878 (re-search-forward "[ \t;]mode:" end t))) 1895 (skip-chars-forward " \t")
1879 (skip-chars-forward " \t") 1896 (let ((beg (point)))
1880 (let ((beg (point))) 1897 (if (search-forward ";" end t)
1881 (if (search-forward ";" end t) 1898 (forward-char -1)
1882 (forward-char -1) 1899 (goto-char end))
1883 (goto-char end)) 1900 (skip-chars-backward " \t")
1884 (skip-chars-backward " \t") 1901 (push (intern (concat (downcase (buffer-substring beg (point))) "-mode"))
1885 (push (intern (concat (downcase (buffer-substring beg (point))) "-mode")) 1902 modes)))
1886 modes))) 1903 ;; Simple -*-MODE-*- case.
1887 ;; Simple -*-MODE-*- case. 1904 (push (intern (concat (downcase (buffer-substring (point) end))
1888 (push (intern (concat (downcase (buffer-substring (point) end)) 1905 "-mode"))
1889 "-mode")) 1906 modes))))
1890 modes)))) 1907 ;; If we found modes to use, invoke them now, outside the save-excursion.
1891 ;; If we found modes to use, invoke them now, outside the save-excursion. 1908 (if modes
1892 (if modes 1909 (catch 'nop
1893 (dolist (mode (nreverse modes)) 1910 (dolist (mode (nreverse modes))
1894 (if (not (functionp mode)) 1911 (if (not (functionp mode))
1895 (message "Ignoring unknown mode `%s'" mode) 1912 (message "Ignoring unknown mode `%s'" mode)
1896 (setq done t) 1913 (setq done t)
1897 (funcall mode))) 1914 (or (set-auto-mode-0 mode keep-mode-if-same)
1898 ;; If we didn't, look for an interpreter specified in the first line. 1915 (throw 'nop nil)))))
1899 ;; As a special case, allow for things like "#!/bin/env perl", which 1916 ;; If we didn't, look for an interpreter specified in the first line.
1900 ;; finds the interpreter anywhere in $PATH. 1917 ;; As a special case, allow for things like "#!/bin/env perl", which
1901 (setq mode (save-excursion 1918 ;; finds the interpreter anywhere in $PATH.
1902 (goto-char (point-min)) 1919 (setq mode (save-excursion
1903 (if (looking-at auto-mode-interpreter-regexp) 1920 (goto-char (point-min))
1904 (match-string 2) 1921 (if (looking-at auto-mode-interpreter-regexp)
1905 "")) 1922 (match-string 2)
1906 ;; Map interpreter name to a mode, signalling we're done at the 1923 ""))
1907 ;; same time. 1924 ;; Map interpreter name to a mode, signalling we're done at the
1908 done (assoc (file-name-nondirectory mode) 1925 ;; same time.
1909 interpreter-mode-alist)) 1926 done (assoc (file-name-nondirectory mode)
1910 ;; If we found an interpreter mode to use, invoke it now. 1927 interpreter-mode-alist)))
1911 (if done (funcall (cdr done))))) 1928 ;; If we found an interpreter mode to use, invoke it now.
1912 (if (and (not done) buffer-file-name) 1929 (if done
1913 (let ((name buffer-file-name)) 1930 (set-auto-mode-0 (cdr done) keep-mode-if-same)
1914 ;; Remove backup-suffixes from file name. 1931 (if (setq done (save-excursion
1915 (setq name (file-name-sans-versions name)) 1932 (goto-char (point-min))
1916 (while (not done) 1933 (assoc-default nil magic-mode-alist
1917 ;; Find first matching alist entry. 1934 (lambda (re dummy)
1918 (let ((case-fold-search 1935 (looking-at re)))))
1919 (memq system-type '(vax-vms windows-nt cygwin)))) 1936 (set-auto-mode-0 done keep-mode-if-same)
1920 (if (and (setq mode (assoc-default name auto-mode-alist 1937 (if buffer-file-name
1938 (let ((name buffer-file-name))
1939 ;; Remove backup-suffixes from file name.
1940 (setq name (file-name-sans-versions name))
1941 (while name
1942 ;; Find first matching alist entry.
1943 (let ((case-fold-search
1944 (memq system-type '(vax-vms windows-nt cygwin))))
1945 (if (and (setq mode (assoc-default name auto-mode-alist
1921 'string-match)) 1946 'string-match))
1922 (consp mode) 1947 (consp mode)
1923 (cadr mode)) 1948 (cadr mode))
1924 (setq mode (car mode) 1949 (setq mode (car mode)
1925 name (substring name 0 (match-beginning 0))) 1950 name (substring name 0 (match-beginning 0)))
1926 (setq done t))) 1951 (setq name)))
1927 (if mode 1952 (when mode
1928 ;; When JUST-FROM-FILE-NAME is set, we are working on behalf 1953 (set-auto-mode-0 mode keep-mode-if-same)))))))))
1929 ;; of set-visited-file-name. In that case, if the major mode 1954
1930 ;; specified is the same one we already have, don't actually 1955
1931 ;; reset it. We don't want to lose minor modes such as Font 1956;; When `keep-mode-if-same' is set, we are working on behalf of
1932 ;; Lock. 1957;; set-visited-file-name. In that case, if the major mode specified is the
1933 (unless (and just-from-file-name (eq mode major-mode)) 1958;; same one we already have, don't actually reset it. We don't want to lose
1934 (if (if xml (memq mode xml-based-modes) t) 1959;; minor modes such as Font Lock.
1935 (funcall mode) 1960(defun set-auto-mode-0 (mode &optional keep-mode-if-same)
1936 (xml-mode))))))) 1961 "Apply MODE and return it.
1937 (and (not done) 1962If optional arg KEEP-MODE-IF-SAME is non-nil, MODE is chased of
1938 xml 1963any aliases and compared to current major mode. If they are the
1939 (xml-mode)))) 1964same, do nothing and return nil."
1965 (when keep-mode-if-same
1966 (while (symbolp (symbol-function mode))
1967 (setq mode (symbol-function mode)))
1968 (if (eq mode major-mode)
1969 (setq mode nil)))
1970 (when mode
1971 (funcall mode)
1972 mode))
1940 1973
1941 1974
1942(defun set-auto-mode-1 () 1975(defun set-auto-mode-1 ()
@@ -3797,7 +3830,7 @@ This command is used in the special Dired buffer created by
3797 3830
3798(defun kill-some-buffers (&optional list) 3831(defun kill-some-buffers (&optional list)
3799 "Kill some buffers. Asks the user whether to kill each one of them. 3832 "Kill some buffers. Asks the user whether to kill each one of them.
3800Non-interactively, if optional argument LIST is non-`nil', it 3833Non-interactively, if optional argument LIST is non-nil, it
3801specifies the list of buffers to kill, asking for approval for each one." 3834specifies the list of buffers to kill, asking for approval for each one."
3802 (interactive) 3835 (interactive)
3803 (if (null list) 3836 (if (null list)
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 02d8fe24007..0b93724e9e5 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,158 @@
12004-11-04 Katsumi Yamaoka <yamaoka@jpl.org>
2
3 * gnus-art. (gnus-article-edit-article): Don't associate the
4 article buffer with a draft file. This is a temporary measure
5 against the 2004-08-22 change to gnus-article-edit-mode.
6
72004-11-02 Katsumi Yamaoka <yamaoka@jpl.org>
8
9 * html2text.el (html2text-get-attr): Remove unused argument `tag'.
10 (html2text-format-tags): Remove unused variable `attr'.
11
12 * mm-util.el (mm-enrich-utf-8-by-mule-ucs): Fix cleaning of
13 after-load-alist.
14
15 * mm-util.el (mm-mime-mule-charset-alist): Add the windows-1251
16 entry. From Ilya N. Golubev <gin@mo.msk.ru>.
17 (mm-enrich-utf-8-by-mule-ucs): New function run when Mule-UCS is
18 loaded under XEmacs.
19 (): Don't make duplicated entries in mm-mime-mule-charset-alist.
20
21 * mm-util.el (mm-coding-system-p): Return a coding-system.
22 (mm-mime-mule-charset-alist): Use shift_jis instead of
23 iso-2022-jp-2 for the katakana-jisx0201 mule charset; add new
24 entries for the mime charsets iso-2022-jp-3 and shift_jis.
25 (mm-coding-system-priorities): Use shift_jis and iso-8859-1
26 instead of japanese-shift-jis and iso-latin-1 respectively in
27 order to share the default value with both Emacs and XEmacs-mule.
28 (mm-mule-charset-to-mime-charset): Make
29 mm-coding-system-priorities effective.
30 (mm-sort-coding-systems-predicate): Canonicalize coding-systems
31 while predicating of candidates upon the priorities.
32
332004-11-01 Reiner Steib <Reiner.Steib@gmx.de>
34
35 * gnus-msg.el (gnus-summary-resend-default-address): Add :version.
36
37 * tls.el (tls-process-connection-type, tls-success)
38 (tls-certtool-program): Add :version.
39
40 * starttls.el (starttls-gnutls-program, starttls-use-gnutls)
41 (starttls-extra-arguments, starttls-process-connection-type)
42 (starttls-connect, starttls-failure, starttls-success):
43
44 * spam-stat.el (spam-stat): Add :version.
45
46 * sieve.el (sieve): Add :version.
47
48 * sha1.el (sha1): Added :version.
49 (sha1-use-external): Removed redundant version.
50
51 * nnmail.el (nnmail-split-fancy-with-parent-ignore-groups)
52 (nnmail-cache-ignore-groups, nnmail-spool-hook)
53 (nnmail-split-fancy-match-partial-words)
54 (nnmail-split-lowercase-expanded):
55
56 * nndiary.el (nndiary): Add :version.
57
58 * mml2015.el (mml2015-unabbrev-trust-alist): Add :version.
59
60 * mml-sec.el (mml-default-sign-method)
61 (mml-default-encrypt-method, mml-signencrypt-style-alist): Add
62 :version.
63
64 * mm-uu.el (mm-uu-diff-groups-regexp): Add :version.
65
66 * mm-url.el (mm-url-use-external, mm-url-program)
67 (mm-url-arguments): Add :version.
68
69 * mm-decode.el (mm-inline-text-html-with-w3m-keymap)
70 (mm-attachment-file-modes, mm-decrypt-option)
71 (mm-w3m-safe-url-regexp): Add :version.
72
73 * message.el (message-cite-prefix-regexp)
74 (message-sendmail-envelope-from, message-minibuffer-local-map)
75 (message-user-fqdn, message-completion-alist): Add :version.
76
77 * gnus-win.el (gnus-configure-windows-hook)
78 (gnus-use-frames-on-any-display): Add :version.
79
80 * gnus-art.el (gnus-article-address-banner-alist)
81 (gnus-treat-unsplit-urls, gnus-treat-unfold-headers)
82 (gnus-treat-from-picon, gnus-treat-mail-picon)
83 (gnus-treat-x-pgp-sig): Add :version.
84
85 * gnus-sum.el (gnus-spam-mark, gnus-recent-mark)
86 (gnus-undownloaded-mark, gnus-summary-article-move-hook)
87 (gnus-summary-article-delete-hook)
88 (gnus-summary-display-while-building): Add :version.
89
90 * gnus-start.el (gnus-subscribe-newsgroup-hooks)
91 (gnus-get-top-new-news-hook):Add :version.
92
93 * gnus-srvr.el (gnus-server-agent-face, gnus-server-opened-face)
94 (gnus-server-closed-face, gnus-server-denied-face): Add :version.
95
96 * gnus-registry.el (gnus-registry): Add :version.
97
98 * gnus-spec.el (gnus-use-correct-string-widths)
99 (gnus-make-format-preserve-properties): Add :version.
100
101 * gnus.el (gnus-group-charter-alist)
102 (gnus-group-fetch-control-use-browse-url)
103 (gnus-install-group-spam-parameters): Add :version.
104
105 * gnus-diary.el (gnus-diary): Add :version.
106
107 * gnus-delay.el (gnus-delay): Add :version.
108
109 * gnus-cite.el (gnus-cite-unsightly-citation-regexp)
110 (gnus-cite-ignore-quoted-from, gnus-cite-attribution-face)
111 (gnus-cite-blank-line-after-header, gnus-article-boring-faces):
112 Add :version.
113
114 * gnus-agent.el (gnus-agent-max-fetch-size)
115 (gnus-agent-enable-expiration, gnus-agent-queue-mail)
116 (gnus-agent-prompt-send-queue): Add :version.
117
118 * deuglify.el (gnus-outlook-deuglify): Add :version.
119
120 * html2text.el: Beautify code. Improve doc strings. Some checkdoc
121 cleanup.
122 (html2text-get-attr, html2text-fix-paragraph): Simplify code.
123 (html2text-format-tag-list): Added "strong" and "em". From
124 "Alfred M. Szmidt" <ams@kemisten.nu> (tiny change).
125
1262004-10-29 Katsumi Yamaoka <yamaoka@jpl.org>
127
128 * gnus-msg.el (gnus-configure-posting-styles): Work with empty
129 signature file. Suggested by Manoj Srivastava
130 <srivasta@golden-gryphon.com>.
131
132 * mm-util.el (mm-coding-system-priorities): Prefer iso-8859-1 than
133 iso-2022-jp even in the Japanese language environment. Suggested
134 by Jason Rumney <jasonr@gnu.org>.
135
1362004-10-28 Katsumi Yamaoka <yamaoka@jpl.org>
137
138 * gnus-sum.el (gnus-update-summary-mark-positions): Allow users to
139 use the same characters as the dummy marks; make it free from
140 getting affected by the language environment.
141 (gnus-summary-read-group-1): Update mark positions only when the
142 format spec is updated.
143
144 * gnus-spec.el (gnus-update-format-specifications): Return a list
145 of updated types.
146
1472004-10-26 Katsumi Yamaoka <yamaoka@jpl.org>
148
149 * nnspool.el (nnspool-spool-directory): Use news-path if the
150 news-directory variable is not bound.
151
152 * gnus-group.el (gnus-group-line-format-alist): Convert the value
153 of gnus-tmp-news-method into string if it may be passed to
154 gnus-correct-length which takes only a string argument.
155
12004-10-25 Reiner Steib <Reiner.Steib@gmx.de> 1562004-10-25 Reiner Steib <Reiner.Steib@gmx.de>
2 157
3 * html2text.el (html2text-buffer-head): Removed. Use `goto-char' 158 * html2text.el (html2text-buffer-head): Removed. Use `goto-char'
diff --git a/lisp/gnus/deuglify.el b/lisp/gnus/deuglify.el
index 07e630d793b..4fe1001a050 100644
--- a/lisp/gnus/deuglify.el
+++ b/lisp/gnus/deuglify.el
@@ -230,7 +230,8 @@
230;;; User Customizable Variables: 230;;; User Customizable Variables:
231 231
232(defgroup gnus-outlook-deuglify nil 232(defgroup gnus-outlook-deuglify nil
233 "Deuglify articles generated by broken user agents like MS Outlook (Express).") 233 "Deuglify articles generated by broken user agents like MS Outlook (Express)."
234 :version "21.4")
234 235
235;;;###autoload 236;;;###autoload
236(defcustom gnus-outlook-deuglify-unwrap-min 45 237(defcustom gnus-outlook-deuglify-unwrap-min 45
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index c62460946ab..23fcbbde5df 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -160,6 +160,7 @@ read articles as they would just be downloaded again."
160 "Chunk size for `gnus-agent-fetch-session'. 160 "Chunk size for `gnus-agent-fetch-session'.
161The function will split its article fetches into chunks smaller than 161The function will split its article fetches into chunks smaller than
162this limit." 162this limit."
163 :version "21.4"
163 :group 'gnus-agent 164 :group 'gnus-agent
164 :type 'integer) 165 :type 'integer)
165 166
@@ -170,6 +171,7 @@ contents from a group's local storage. This value may be overridden
170to disable expiration in specific categories, topics, and groups. Of 171to disable expiration in specific categories, topics, and groups. Of
171course, you could change gnus-agent-enable-expiration to DISABLE then 172course, you could change gnus-agent-enable-expiration to DISABLE then
172enable expiration per categories, topics, and groups." 173enable expiration per categories, topics, and groups."
174 :version "21.4"
173 :group 'gnus-agent 175 :group 'gnus-agent
174 :type '(radio (const :format "Enable " ENABLE) 176 :type '(radio (const :format "Enable " ENABLE)
175 (const :format "Disable " DISABLE))) 177 (const :format "Disable " DISABLE)))
@@ -195,6 +197,7 @@ See Info node `(gnus)Server Buffer'."
195 "Whether and when outgoing mail should be queued by the agent. 197 "Whether and when outgoing mail should be queued by the agent.
196When `always', always queue outgoing mail. When nil, never 198When `always', always queue outgoing mail. When nil, never
197queue. Otherwise, queue if and only if unplugged." 199queue. Otherwise, queue if and only if unplugged."
200 :version "21.4"
198 :group 'gnus-agent 201 :group 'gnus-agent
199 :type '(radio (const :format "Always" always) 202 :type '(radio (const :format "Always" always)
200 (const :format "Never" nil) 203 (const :format "Never" nil)
@@ -203,6 +206,7 @@ queue. Otherwise, queue if and only if unplugged."
203(defcustom gnus-agent-prompt-send-queue nil 206(defcustom gnus-agent-prompt-send-queue nil
204 "If non-nil, `gnus-group-send-queue' will prompt if called when 207 "If non-nil, `gnus-group-send-queue' will prompt if called when
205unplugged." 208unplugged."
209 :version "21.4"
206 :group 'gnus-agent 210 :group 'gnus-agent
207 :type 'boolean) 211 :type 'boolean)
208 212
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 7a365d81a2c..c0266300983 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -318,6 +318,7 @@ advertisements. For example:
318 (symbol :tag "Item in `gnus-article-banner-alist'" none) 318 (symbol :tag "Item in `gnus-article-banner-alist'" none)
319 regexp 319 regexp
320 (const :tag "None" nil)))) 320 (const :tag "None" nil))))
321 :version "21.4"
321 :group 'gnus-article-washing) 322 :group 'gnus-article-washing)
322 323
323(defcustom gnus-emphasis-alist 324(defcustom gnus-emphasis-alist
@@ -920,6 +921,7 @@ See Info node `(gnus)Customizing Articles' for details."
920 "Remove newlines from within URLs. 921 "Remove newlines from within URLs.
921Valid values are nil, t, `head', `last', an integer or a predicate. 922Valid values are nil, t, `head', `last', an integer or a predicate.
922See Info node `(gnus)Customizing Articles' for details." 923See Info node `(gnus)Customizing Articles' for details."
924 :version "21.4"
923 :group 'gnus-article-treat 925 :group 'gnus-article-treat
924 :link '(custom-manual "(gnus)Customizing Articles") 926 :link '(custom-manual "(gnus)Customizing Articles")
925 :type gnus-article-treat-custom) 927 :type gnus-article-treat-custom)
@@ -1124,6 +1126,7 @@ See Info node `(gnus)Customizing Articles' for details."
1124 "Unfold folded header lines. 1126 "Unfold folded header lines.
1125Valid values are nil, t, `head', `last', an integer or a predicate. 1127Valid values are nil, t, `head', `last', an integer or a predicate.
1126See Info node `(gnus)Customizing Articles' for details." 1128See Info node `(gnus)Customizing Articles' for details."
1129 :version "21.4"
1127 :group 'gnus-article-treat 1130 :group 'gnus-article-treat
1128 :link '(custom-manual "(gnus)Customizing Articles") 1131 :link '(custom-manual "(gnus)Customizing Articles")
1129 :type gnus-article-treat-custom) 1132 :type gnus-article-treat-custom)
@@ -1238,6 +1241,7 @@ See Info node `(gnus)Customizing Articles' and Info node
1238Valid values are nil, t, `head', `last', an integer or a predicate. 1241Valid values are nil, t, `head', `last', an integer or a predicate.
1239See Info node `(gnus)Customizing Articles' and Info node 1242See Info node `(gnus)Customizing Articles' and Info node
1240`(gnus)Picons' for details." 1243`(gnus)Picons' for details."
1244 :version "21.4"
1241 :group 'gnus-article-treat 1245 :group 'gnus-article-treat
1242 :group 'gnus-picon 1246 :group 'gnus-picon
1243 :link '(custom-manual "(gnus)Customizing Articles") 1247 :link '(custom-manual "(gnus)Customizing Articles")
@@ -1253,6 +1257,7 @@ See Info node `(gnus)Customizing Articles' and Info node
1253Valid values are nil, t, `head', `last', an integer or a predicate. 1257Valid values are nil, t, `head', `last', an integer or a predicate.
1254See Info node `(gnus)Customizing Articles' and Info node 1258See Info node `(gnus)Customizing Articles' and Info node
1255`(gnus)Picons' for details." 1259`(gnus)Picons' for details."
1260 :version "21.4"
1256 :group 'gnus-article-treat 1261 :group 'gnus-article-treat
1257 :group 'gnus-picon 1262 :group 'gnus-picon
1258 :link '(custom-manual "(gnus)Customizing Articles") 1263 :link '(custom-manual "(gnus)Customizing Articles")
@@ -1338,6 +1343,7 @@ See Info node `(gnus)Customizing Articles' for details."
1338To automatically treat X-PGP-Sig, set it to head. 1343To automatically treat X-PGP-Sig, set it to head.
1339Valid values are nil, t, `head', `last', an integer or a predicate. 1344Valid values are nil, t, `head', `last', an integer or a predicate.
1340See Info node `(gnus)Customizing Articles' for details." 1345See Info node `(gnus)Customizing Articles' for details."
1346 :version "21.4"
1341 :group 'gnus-article-treat 1347 :group 'gnus-article-treat
1342 :group 'mime-security 1348 :group 'mime-security
1343 :link '(custom-manual "(gnus)Customizing Articles") 1349 :link '(custom-manual "(gnus)Customizing Articles")
@@ -5645,7 +5651,10 @@ groups."
5645 "Start editing the contents of the current article buffer." 5651 "Start editing the contents of the current article buffer."
5646 (let ((winconf (current-window-configuration))) 5652 (let ((winconf (current-window-configuration)))
5647 (set-buffer gnus-article-buffer) 5653 (set-buffer gnus-article-buffer)
5648 (gnus-article-edit-mode) 5654 (let ((message-auto-save-directory
5655 ;; Don't associate the article buffer with a draft file.
5656 nil))
5657 (gnus-article-edit-mode))
5649 (funcall start-func) 5658 (funcall start-func)
5650 (set-buffer-modified-p nil) 5659 (set-buffer-modified-p nil)
5651 (gnus-configure-windows 'edit-article) 5660 (gnus-configure-windows 'edit-article)
diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el
index bf9f5863428..5306f3b17bf 100644
--- a/lisp/gnus/gnus-cite.el
+++ b/lisp/gnus/gnus-cite.el
@@ -124,6 +124,7 @@ The text matching the first grouping will be used as a button."
124(defcustom gnus-cite-unsightly-citation-regexp 124(defcustom gnus-cite-unsightly-citation-regexp
125 "^-----Original Message-----\nFrom: \\(.+\n\\)+\n" 125 "^-----Original Message-----\nFrom: \\(.+\n\\)+\n"
126 "Regexp matching Microsoft-type rest-of-message citations." 126 "Regexp matching Microsoft-type rest-of-message citations."
127 :version "21.4"
127 :group 'gnus-cite 128 :group 'gnus-cite
128 :type 'regexp) 129 :type 'regexp)
129 130
@@ -131,6 +132,7 @@ The text matching the first grouping will be used as a button."
131 "Non-nil means don't regard lines beginning with \">From \" as cited text. 132 "Non-nil means don't regard lines beginning with \">From \" as cited text.
132Those lines may have been quoted by MTAs in order not to mix up with 133Those lines may have been quoted by MTAs in order not to mix up with
133the envelope From line." 134the envelope From line."
135 :version "21.4"
134 :group 'gnus-cite 136 :group 'gnus-cite
135 :type 'boolean) 137 :type 'boolean)
136 138
@@ -141,6 +143,7 @@ the envelope From line."
141(defcustom gnus-cite-attribution-face 'gnus-cite-attribution-face 143(defcustom gnus-cite-attribution-face 'gnus-cite-attribution-face
142 "Face used for attribution lines. 144 "Face used for attribution lines.
143It is merged with the face for the cited text belonging to the attribution." 145It is merged with the face for the cited text belonging to the attribution."
146 :version "21.4"
144 :group 'gnus-cite 147 :group 'gnus-cite
145 :type 'face) 148 :type 'face)
146 149
@@ -278,7 +281,6 @@ This should make it easier to see who wrote what."
278 281
279(defcustom gnus-cite-blank-line-after-header t 282(defcustom gnus-cite-blank-line-after-header t
280 "If non-nil, put a blank line between the citation header and the button." 283 "If non-nil, put a blank line between the citation header and the button."
281 :version "21.4"
282 :group 'gnus-cite 284 :group 'gnus-cite
283 :type 'boolean) 285 :type 'boolean)
284 286
@@ -290,7 +292,6 @@ This should make it easier to see who wrote what."
290If an article has more pages below the one you are looking at, but 292If an article has more pages below the one you are looking at, but
291nothing on those pages is a word of at least three letters that is not 293nothing on those pages is a word of at least three letters that is not
292in a boring face, then the pages will be skipped." 294in a boring face, then the pages will be skipped."
293 :version "21.4"
294 :type '(repeat face) 295 :type '(repeat face)
295 :group 'gnus-article-hiding) 296 :group 'gnus-article-hiding)
296 297
diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el
index ee431076fad..8a566e3e5d8 100644
--- a/lisp/gnus/gnus-delay.el
+++ b/lisp/gnus/gnus-delay.el
@@ -41,6 +41,7 @@
41;;;###autoload 41;;;###autoload
42(defgroup gnus-delay nil 42(defgroup gnus-delay nil
43 "Arrange for sending postings later." 43 "Arrange for sending postings later."
44 :version "21.4"
44 :group 'gnus) 45 :group 'gnus)
45 46
46(defcustom gnus-delay-group "delayed" 47(defcustom gnus-delay-group "delayed"
diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el
index e82d77fa58b..7d2df362bbc 100644
--- a/lisp/gnus/gnus-diary.el
+++ b/lisp/gnus/gnus-diary.el
@@ -102,7 +102,8 @@
102(require 'gnus-art) 102(require 'gnus-art)
103 103
104(defgroup gnus-diary nil 104(defgroup gnus-diary nil
105 "Utilities on top of the nndiary backend for Gnus.") 105 "Utilities on top of the nndiary backend for Gnus."
106 :version "21.4")
106 107
107(defcustom gnus-diary-summary-line-format "%U%R%z %uD: %(%s%) (%ud)\n" 108(defcustom gnus-diary-summary-line-format "%U%R%z %uD: %(%s%) (%ud)\n"
108 "*Summary line format for nndiary groups." 109 "*Summary line format for nndiary groups."
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index f3b2f91cd5e..c55264b22de 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -491,7 +491,10 @@ simple manner.")
491 (?O gnus-tmp-moderated-string ?s) 491 (?O gnus-tmp-moderated-string ?s)
492 (?p gnus-tmp-process-marked ?c) 492 (?p gnus-tmp-process-marked ?c)
493 (?s gnus-tmp-news-server ?s) 493 (?s gnus-tmp-news-server ?s)
494 (?n gnus-tmp-news-method ?s) 494 (?n ,(if (featurep 'xemacs)
495 '(symbol-name gnus-tmp-news-method)
496 'gnus-tmp-news-method)
497 ?s)
495 (?P gnus-group-indentation ?s) 498 (?P gnus-group-indentation ?s)
496 (?E gnus-tmp-group-icon ?s) 499 (?E gnus-tmp-group-icon ?s)
497 (?B gnus-tmp-summary-live ?c) 500 (?B gnus-tmp-summary-live ?c)
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index 7dcef4b813b..6b093480940 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -281,6 +281,7 @@ If nil, Gnus will never ask for confirmation if replying to mail."
281 "If non-nil, Gnus tries to suggest a default address to resend to. 281 "If non-nil, Gnus tries to suggest a default address to resend to.
282If nil, the address field will always be empty after invoking 282If nil, the address field will always be empty after invoking
283`gnus-summary-resend-message'." 283`gnus-summary-resend-message'."
284 :version "21.4"
284 :group 'gnus-message 285 :group 'gnus-message
285 :type 'boolean) 286 :type 'boolean)
286 287
@@ -1871,8 +1872,9 @@ this is a reply."
1871 (setq v (with-temp-buffer 1872 (setq v (with-temp-buffer
1872 (insert-file-contents v) 1873 (insert-file-contents v)
1873 (goto-char (point-max)) 1874 (goto-char (point-max))
1874 (while (bolp) 1875 (skip-chars-backward "\n")
1875 (delete-char -1)) 1876 (delete-region (+ (point) (if (bolp) 0 1))
1877 (point-max))
1876 (buffer-string)))) 1878 (buffer-string))))
1877 (setq results (delq (assoc element results) results)) 1879 (setq results (delq (assoc element results) results))
1878 (push (cons element v) results)))) 1880 (push (cons element v) results))))
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index 841f0057566..046114cbe24 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -66,6 +66,7 @@
66 66
67(defgroup gnus-registry nil 67(defgroup gnus-registry nil
68 "The Gnus registry." 68 "The Gnus registry."
69 :version "21.4"
69 :group 'gnus) 70 :group 'gnus)
70 71
71(defvar gnus-registry-hashtb nil 72(defvar gnus-registry-hashtb nil
diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el
index 690fc7e026a..1177df4731a 100644
--- a/lisp/gnus/gnus-spec.el
+++ b/lisp/gnus/gnus-spec.el
@@ -32,12 +32,14 @@
32 32
33(defcustom gnus-use-correct-string-widths (featurep 'xemacs) 33(defcustom gnus-use-correct-string-widths (featurep 'xemacs)
34 "*If non-nil, use correct functions for dealing with wide characters." 34 "*If non-nil, use correct functions for dealing with wide characters."
35 :version "21.4"
35 :group 'gnus-format 36 :group 'gnus-format
36 :type 'boolean) 37 :type 'boolean)
37 38
38(defcustom gnus-make-format-preserve-properties (featurep 'xemacs) 39(defcustom gnus-make-format-preserve-properties (featurep 'xemacs)
39 "*If non-nil, use a replacement `format' function which preserves 40 "*If non-nil, use a replacement `format' function which preserves
40text properties. This is only needed on XEmacs, as FSF Emacs does this anyway." 41text properties. This is only needed on XEmacs, as FSF Emacs does this anyway."
42 :version "21.4"
41 :group 'gnus-format 43 :group 'gnus-format
42 :type 'boolean) 44 :type 'boolean)
43 45
@@ -183,7 +185,8 @@ text properties. This is only needed on XEmacs, as FSF Emacs does this anyway."
183 (insert (gnus-pp-to-string spec)))) 185 (insert (gnus-pp-to-string spec))))
184 186
185(defun gnus-update-format-specifications (&optional force &rest types) 187(defun gnus-update-format-specifications (&optional force &rest types)
186 "Update all (necessary) format specifications." 188 "Update all (necessary) format specifications.
189Return a list of updated types."
187 ;; Make the indentation array. 190 ;; Make the indentation array.
188 ;; See whether all the stored info needs to be flushed. 191 ;; See whether all the stored info needs to be flushed.
189 (when (or force 192 (when (or force
@@ -195,13 +198,12 @@ text properties. This is only needed on XEmacs, as FSF Emacs does this anyway."
195 (setq gnus-format-specs nil)) 198 (setq gnus-format-specs nil))
196 199
197 ;; Go through all the formats and see whether they need updating. 200 ;; Go through all the formats and see whether they need updating.
198 (let (new-format entry type val) 201 (let (new-format entry type val updated)
199 (while (setq type (pop types)) 202 (while (setq type (pop types))
200 ;; Jump to the proper buffer to find out the value of the 203 ;; Jump to the proper buffer to find out the value of the
201 ;; variable, if possible. (It may be buffer-local.) 204 ;; variable, if possible. (It may be buffer-local.)
202 (save-excursion 205 (save-excursion
203 (let ((buffer (intern (format "gnus-%s-buffer" type))) 206 (let ((buffer (intern (format "gnus-%s-buffer" type))))
204 val)
205 (when (and (boundp buffer) 207 (when (and (boundp buffer)
206 (setq val (symbol-value buffer)) 208 (setq val (symbol-value buffer))
207 (gnus-buffer-exists-p val)) 209 (gnus-buffer-exists-p val))
@@ -231,10 +233,12 @@ text properties. This is only needed on XEmacs, as FSF Emacs does this anyway."
231 (setcar (cdr entry) val) 233 (setcar (cdr entry) val)
232 (setcar entry new-format)) 234 (setcar entry new-format))
233 (push (list type new-format val) gnus-format-specs)) 235 (push (list type new-format val) gnus-format-specs))
234 (set (intern (format "gnus-%s-line-format-spec" type)) val))))) 236 (set (intern (format "gnus-%s-line-format-spec" type)) val)
237 (push type updated))))
235 238
236 (unless (assq 'version gnus-format-specs) 239 (unless (assq 'version gnus-format-specs)
237 (push (cons 'version emacs-version) gnus-format-specs))) 240 (push (cons 'version emacs-version) gnus-format-specs))
241 updated))
238 242
239(defvar gnus-mouse-face-0 'highlight) 243(defvar gnus-mouse-face-0 'highlight)
240(defvar gnus-mouse-face-1 'highlight) 244(defvar gnus-mouse-face-1 'highlight)
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index 7fef378722a..d42c5d71cfd 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -205,21 +205,25 @@ If nil, a faster, but more primitive, buffer is used instead."
205 205
206(defcustom gnus-server-agent-face 'gnus-server-agent-face 206(defcustom gnus-server-agent-face 'gnus-server-agent-face
207 "Face name to use on AGENTIZED servers." 207 "Face name to use on AGENTIZED servers."
208 :version "21.4"
208 :group 'gnus-server-visual 209 :group 'gnus-server-visual
209 :type 'face) 210 :type 'face)
210 211
211(defcustom gnus-server-opened-face 'gnus-server-opened-face 212(defcustom gnus-server-opened-face 'gnus-server-opened-face
212 "Face name to use on OPENED servers." 213 "Face name to use on OPENED servers."
214 :version "21.4"
213 :group 'gnus-server-visual 215 :group 'gnus-server-visual
214 :type 'face) 216 :type 'face)
215 217
216(defcustom gnus-server-closed-face 'gnus-server-closed-face 218(defcustom gnus-server-closed-face 'gnus-server-closed-face
217 "Face name to use on CLOSED servers." 219 "Face name to use on CLOSED servers."
220 :version "21.4"
218 :group 'gnus-server-visual 221 :group 'gnus-server-visual
219 :type 'face) 222 :type 'face)
220 223
221(defcustom gnus-server-denied-face 'gnus-server-denied-face 224(defcustom gnus-server-denied-face 'gnus-server-denied-face
222 "Face name to use on DENIED servers." 225 "Face name to use on DENIED servers."
226 :version "21.4"
223 :group 'gnus-server-visual 227 :group 'gnus-server-visual
224 :type 'face) 228 :type 'face)
225 229
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index ecce9f00b37..e51227063f0 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -299,6 +299,7 @@ claim them."
299(defcustom gnus-subscribe-newsgroup-hooks nil 299(defcustom gnus-subscribe-newsgroup-hooks nil
300 "*Hooks run after you subscribe to a new group. 300 "*Hooks run after you subscribe to a new group.
301The hooks will be called with new group's name as argument." 301The hooks will be called with new group's name as argument."
302 :version "21.4"
302 :group 'gnus-group-new 303 :group 'gnus-group-new
303 :type 'hook) 304 :type 'hook)
304 305
@@ -405,6 +406,7 @@ This hook is called as the first thing when Gnus is started."
405 406
406(defcustom gnus-get-top-new-news-hook nil 407(defcustom gnus-get-top-new-news-hook nil
407 "A hook run just before Gnus checks for new news globally." 408 "A hook run just before Gnus checks for new news globally."
409 :version "21.4"
408 :group 'gnus-group-new 410 :group 'gnus-group-new
409 :type 'hook) 411 :type 'hook)
410 412
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 68f40b3a7bb..33abc379ff4 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -469,6 +469,7 @@ this variable specifies group names."
469 469
470(defcustom gnus-spam-mark ?$ 470(defcustom gnus-spam-mark ?$
471 "*Mark used for spam articles." 471 "*Mark used for spam articles."
472 :version "21.4"
472 :group 'gnus-summary-marks 473 :group 'gnus-summary-marks
473 :type 'character) 474 :type 'character)
474 475
@@ -505,6 +506,7 @@ this variable specifies group names."
505 506
506(defcustom gnus-recent-mark ?N 507(defcustom gnus-recent-mark ?N
507 "*Mark used for articles that are recent." 508 "*Mark used for articles that are recent."
509 :version "21.4"
508 :group 'gnus-summary-marks 510 :group 'gnus-summary-marks
509 :type 'character) 511 :type 'character)
510 512
@@ -552,6 +554,7 @@ this variable specifies group names."
552 554
553(defcustom gnus-undownloaded-mark ?- 555(defcustom gnus-undownloaded-mark ?-
554 "*Mark used for articles that weren't downloaded." 556 "*Mark used for articles that weren't downloaded."
557 :version "21.4"
555 :group 'gnus-summary-marks 558 :group 'gnus-summary-marks
556 :type 'character) 559 :type 'character)
557 560
@@ -890,16 +893,19 @@ automatically when it is selected."
890 893
891(defcustom gnus-summary-article-move-hook nil 894(defcustom gnus-summary-article-move-hook nil
892 "*A hook called after an article is moved, copied, respooled, or crossposted." 895 "*A hook called after an article is moved, copied, respooled, or crossposted."
896 :version "21.4"
893 :group 'gnus-summary 897 :group 'gnus-summary
894 :type 'hook) 898 :type 'hook)
895 899
896(defcustom gnus-summary-article-delete-hook nil 900(defcustom gnus-summary-article-delete-hook nil
897 "*A hook called after an article is deleted." 901 "*A hook called after an article is deleted."
902 :version "21.4"
898 :group 'gnus-summary 903 :group 'gnus-summary
899 :type 'hook) 904 :type 'hook)
900 905
901(defcustom gnus-summary-article-expire-hook nil 906(defcustom gnus-summary-article-expire-hook nil
902 "*A hook called after an article is expired." 907 "*A hook called after an article is expired."
908 :version "21.4"
903 :group 'gnus-summary 909 :group 'gnus-summary
904 :type 'hook) 910 :type 'hook)
905 911
@@ -3225,43 +3231,54 @@ buffer that was in action when the last article was fetched."
3225 (save-excursion 3231 (save-excursion
3226 (when (gnus-buffer-exists-p gnus-summary-buffer) 3232 (when (gnus-buffer-exists-p gnus-summary-buffer)
3227 (set-buffer gnus-summary-buffer)) 3233 (set-buffer gnus-summary-buffer))
3228 (let ((gnus-replied-mark 129) 3234 (let ((spec gnus-summary-line-format-spec)
3229 (gnus-score-below-mark 130) 3235 pos)
3230 (gnus-score-over-mark 130)
3231 (gnus-undownloaded-mark 131)
3232 (spec gnus-summary-line-format-spec)
3233 gnus-visual pos)
3234 (save-excursion 3236 (save-excursion
3235 (gnus-set-work-buffer) 3237 (gnus-set-work-buffer)
3236 (let ((gnus-summary-line-format-spec spec) 3238 (let ((gnus-tmp-unread ?Z)
3239 (gnus-replied-mark ?Z)
3240 (gnus-score-below-mark ?Z)
3241 (gnus-score-over-mark ?Z)
3242 (gnus-undownloaded-mark ?Z)
3243 (gnus-summary-line-format-spec spec)
3237 (gnus-newsgroup-downloadable '(0)) 3244 (gnus-newsgroup-downloadable '(0))
3238 marks) 3245 (header [0 "" "" "05 Apr 2001 23:33:09 +0400" "" "" 0 0 "" nil])
3239 (insert ?\200 "\200" ?\201 "\201" ?\202 "\202" ?\203 "\203") 3246 case-fold-search ignores)
3240 (while (not (bobp)) 3247 ;; Here, all marks are bound to Z.
3241 (push (buffer-substring (1- (point)) (point)) marks) 3248 (gnus-summary-insert-line header
3242 (backward-char)) 3249 0 nil t gnus-tmp-unread t nil "" nil 1)
3250 (goto-char (point-min))
3251 ;; Memorize the positions of the same characters as dummy marks.
3252 (while (re-search-forward "[A-D]" nil t)
3253 (push (point) ignores))
3243 (erase-buffer) 3254 (erase-buffer)
3244 (gnus-summary-insert-line 3255 ;; We use A-D as dummy marks in order to know column positions
3245 [0 "" "" "05 Apr 2001 23:33:09 +0400" "" "" 0 0 "" nil] 3256 ;; where marks should be inserted.
3246 0 nil t 128 t nil "" nil 1) 3257 (setq gnus-tmp-unread ?A
3258 gnus-replied-mark ?B
3259 gnus-score-below-mark ?C
3260 gnus-score-over-mark ?C
3261 gnus-undownloaded-mark ?D)
3262 (gnus-summary-insert-line header
3263 0 nil t gnus-tmp-unread t nil "" nil 1)
3264 ;; Ignore characters which aren't dummy marks.
3265 (dolist (p ignores)
3266 (delete-region (goto-char (1- p)) p)
3267 (insert ?Z))
3247 (goto-char (point-min)) 3268 (goto-char (point-min))
3248 (setq pos (list (cons 'unread 3269 (setq pos (list (cons 'unread
3249 (and (or (search-forward (nth 0 marks) nil t) 3270 (and (search-forward "A" nil t)
3250 (search-forward (nth 1 marks) nil t))
3251 (- (point) (point-min) 1))))) 3271 (- (point) (point-min) 1)))))
3252 (goto-char (point-min)) 3272 (goto-char (point-min))
3253 (push (cons 'replied (and (or (search-forward (nth 2 marks) nil t) 3273 (push (cons 'replied (and (search-forward "B" nil t)
3254 (search-forward (nth 3 marks) nil t))
3255 (- (point) (point-min) 1))) 3274 (- (point) (point-min) 1)))
3256 pos) 3275 pos)
3257 (goto-char (point-min)) 3276 (goto-char (point-min))
3258 (push (cons 'score (and (or (search-forward (nth 4 marks) nil t) 3277 (push (cons 'score (and (search-forward "C" nil t)
3259 (search-forward (nth 5 marks) nil t))
3260 (- (point) (point-min) 1))) 3278 (- (point) (point-min) 1)))
3261 pos) 3279 pos)
3262 (goto-char (point-min)) 3280 (goto-char (point-min))
3263 (push (cons 'download (and (or (search-forward (nth 6 marks) nil t) 3281 (push (cons 'download (and (search-forward "D" nil t)
3264 (search-forward (nth 7 marks) nil t))
3265 (- (point) (point-min) 1))) 3282 (- (point) (point-min) 1)))
3266 pos))) 3283 pos)))
3267 (setq gnus-summary-mark-positions pos)))) 3284 (setq gnus-summary-mark-positions pos))))
@@ -3559,9 +3576,11 @@ If NO-DISPLAY, don't generate a summary buffer."
3559 (gnus-active gnus-newsgroup-name))) 3576 (gnus-active gnus-newsgroup-name)))
3560 ;; You can change the summary buffer in some way with this hook. 3577 ;; You can change the summary buffer in some way with this hook.
3561 (gnus-run-hooks 'gnus-select-group-hook) 3578 (gnus-run-hooks 'gnus-select-group-hook)
3562 (gnus-update-format-specifications 3579 (when (memq 'summary (gnus-update-format-specifications
3563 nil 'summary 'summary-mode 'summary-dummy) 3580 nil 'summary 'summary-mode 'summary-dummy))
3564 (gnus-update-summary-mark-positions) 3581 ;; The format specification for the summary line was updated,
3582 ;; so we need to update the mark positions as well.
3583 (gnus-update-summary-mark-positions))
3565 ;; Do score processing. 3584 ;; Do score processing.
3566 (when gnus-use-scoring 3585 (when gnus-use-scoring
3567 (gnus-possibly-score-headers)) 3586 (gnus-possibly-score-headers))
@@ -9165,6 +9184,7 @@ If nil, use to the current newsgroup method."
9165 "If non-nil, show and update the summary buffer as it's being built. 9184 "If non-nil, show and update the summary buffer as it's being built.
9166If the value is t, update the buffer after every line is inserted. If 9185If the value is t, update the buffer after every line is inserted. If
9167the value is an integer (N), update the display every N lines." 9186the value is an integer (N), update the display every N lines."
9187 :version "21.4"
9168 :group 'gnus-thread 9188 :group 'gnus-thread
9169 :type '(choice (const :tag "off" nil) 9189 :type '(choice (const :tag "off" nil)
9170 number 9190 number
diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el
index 8de4673fddc..554c9dc3437 100644
--- a/lisp/gnus/gnus-win.el
+++ b/lisp/gnus/gnus-win.el
@@ -62,6 +62,7 @@
62 "*If non-nil, frames on all displays will be considered useable by Gnus. 62 "*If non-nil, frames on all displays will be considered useable by Gnus.
63When nil, only frames on the same display as the selected frame will be 63When nil, only frames on the same display as the selected frame will be
64used to display Gnus windows." 64used to display Gnus windows."
65 :version "21.4"
65 :group 'gnus-windows 66 :group 'gnus-windows
66 :type 'boolean) 67 :type 'boolean)
67 68
@@ -198,6 +199,7 @@ See the Gnus manual for an explanation of the syntax used.")
198 199
199(defcustom gnus-configure-windows-hook nil 200(defcustom gnus-configure-windows-hook nil
200 "*A hook called when configuring windows." 201 "*A hook called when configuring windows."
202 :version "21.4"
201 :group 'gnus-windows 203 :group 'gnus-windows
202 :type 'hook) 204 :type 'hook)
203 205
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index bff1c3bba2f..c8dc878eacd 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -1314,6 +1314,7 @@ If the default site is too slow, try one of these:
1314 (gnus-replace-in-string name "\\." "-") "-charter.html"))) 1314 (gnus-replace-in-string name "\\." "-") "-charter.html")))
1315 "*An alist of (HIERARCHY . FORM) pairs used to construct the URL of a charter. 1315 "*An alist of (HIERARCHY . FORM) pairs used to construct the URL of a charter.
1316When FORM is evaluated `name' is bound to the name of the group." 1316When FORM is evaluated `name' is bound to the name of the group."
1317 :version "21.4"
1317 :group 'gnus-group-various 1318 :group 'gnus-group-various
1318 :type '(repeat (cons (string :tag "Hierarchy") (sexp :tag "Form")))) 1319 :type '(repeat (cons (string :tag "Hierarchy") (sexp :tag "Form"))))
1319 1320
@@ -1321,6 +1322,7 @@ When FORM is evaluated `name' is bound to the name of the group."
1321 "*Non-nil means that control messages are displayed using `browse-url'. 1322 "*Non-nil means that control messages are displayed using `browse-url'.
1322Otherwise they are fetched with ange-ftp and displayed in an ephemeral 1323Otherwise they are fetched with ange-ftp and displayed in an ephemeral
1323group." 1324group."
1325 :version "21.4"
1324 :group 'gnus-group-various 1326 :group 'gnus-group-various
1325 :type 'boolean) 1327 :type 'boolean)
1326 1328
@@ -1788,6 +1790,7 @@ total number of articles in the group.")
1788(defcustom gnus-install-group-spam-parameters t 1790(defcustom gnus-install-group-spam-parameters t
1789 "*Disable the group parameters for spam detection. 1791 "*Disable the group parameters for spam detection.
1790Enable if `G c' in XEmacs is giving you trouble, and make sure to submit a bug report." 1792Enable if `G c' in XEmacs is giving you trouble, and make sure to submit a bug report."
1793 :version "21.4"
1791 :type 'boolean 1794 :type 'boolean
1792 :group 'gnus-start) 1795 :group 'gnus-start)
1793 1796
diff --git a/lisp/gnus/html2text.el b/lisp/gnus/html2text.el
index 31d1869c695..ef05af9bae6 100644
--- a/lisp/gnus/html2text.el
+++ b/lisp/gnus/html2text.el
@@ -24,11 +24,11 @@
24 24
25;; These functions provide a simple way to wash/clean html infected 25;; These functions provide a simple way to wash/clean html infected
26;; mails. Definitely do not work in all cases, but some improvement 26;; mails. Definitely do not work in all cases, but some improvement
27;; in readability is generally obtained. Formatting is only done in 27;; in readability is generally obtained. Formatting is only done in
28;; the buffer, so the next time you enter the article it will be 28;; the buffer, so the next time you enter the article it will be
29;; "re-htmlized". 29;; "re-htmlized".
30;; 30;;
31;; The main function is "html2text" 31;; The main function is `html2text'.
32 32
33;;; Code: 33;;; Code:
34 34
@@ -47,9 +47,9 @@
47 "The map of entity to text. 47 "The map of entity to text.
48 48
49This is an alist were each element is a dotted pair consisting of an 49This is an alist were each element is a dotted pair consisting of an
50old string, and a replacement string. This replacement is done by the 50old string, and a replacement string. This replacement is done by the
51function \"html2text-substitute\" which basically performs a 51function `html2text-substitute' which basically performs a
52replace-string operation for every element in the list. This is 52`replace-string' operation for every element in the list. This is
53completely verbatim - without any use of REGEXP.") 53completely verbatim - without any use of REGEXP.")
54 54
55(defvar html2text-remove-tag-list 55(defvar html2text-remove-tag-list
@@ -57,11 +57,11 @@ completely verbatim - without any use of REGEXP.")
57 "A list of removable tags. 57 "A list of removable tags.
58 58
59This is a list of tags which should be removed, without any 59This is a list of tags which should be removed, without any
60formatting. Observe that if you the tags in the list are presented 60formatting. Note that tags in the list are presented *without*
61*without* any \"<\" or \">\". All occurences of a tag appearing in 61any \"<\" or \">\". All occurences of a tag appearing in this
62this list are removed, irrespective of whether it is a closing or 62list are removed, irrespective of whether it is a closing or
63opening tag, or if the tag has additional attributes. The actual 63opening tag, or if the tag has additional attributes. The
64deletion is done by the function \"html2text-remove-tags\". 64deletion is done by the function `html2text-remove-tags'.
65 65
66For instance the text: 66For instance the text:
67 67
@@ -75,8 +75,10 @@ If this list contains the element \"font\".")
75 75
76(defvar html2text-format-tag-list 76(defvar html2text-format-tag-list
77 '(("b" . html2text-clean-bold) 77 '(("b" . html2text-clean-bold)
78 ("strong" . html2text-clean-bold)
78 ("u" . html2text-clean-underline) 79 ("u" . html2text-clean-underline)
79 ("i" . html2text-clean-italic) 80 ("i" . html2text-clean-italic)
81 ("em" . html2text-clean-italic)
80 ("blockquote" . html2text-clean-blockquote) 82 ("blockquote" . html2text-clean-blockquote)
81 ("a" . html2text-clean-anchor) 83 ("a" . html2text-clean-anchor)
82 ("ul" . html2text-clean-ul) 84 ("ul" . html2text-clean-ul)
@@ -86,7 +88,7 @@ If this list contains the element \"font\".")
86 "An alist of tags and processing functions. 88 "An alist of tags and processing functions.
87 89
88This is an alist where each dotted pair consists of a tag, and then 90This is an alist where each dotted pair consists of a tag, and then
89the name of a function to be called when this tag is found. The 91the name of a function to be called when this tag is found. The
90function is called with the arguments p1, p2, p3 and p4. These are 92function is called with the arguments p1, p2, p3 and p4. These are
91demontrated below: 93demontrated below:
92 94
@@ -117,17 +119,15 @@ formatting, and then moved afterward.")
117;; 119;;
118 120
119 121
120(defun html2text-replace-string (from-string to-string p1 p2) 122(defun html2text-replace-string (from-string to-string min max)
121 (goto-char p1) 123 "Replace FROM-STRING with TO-STRING in region from MIN to MAX."
124 (goto-char min)
122 (let ((delta (- (string-width to-string) (string-width from-string))) 125 (let ((delta (- (string-width to-string) (string-width from-string)))
123 (change 0)) 126 (change 0))
124 (while (search-forward from-string p2 t) 127 (while (search-forward from-string max t)
125 (replace-match to-string) 128 (replace-match to-string)
126 (setq change (+ change delta)) 129 (setq change (+ change delta)))
127 ) 130 change))
128 change
129 )
130 )
131 131
132;; 132;;
133;; </Utility functions> 133;; </Utility functions>
@@ -140,11 +140,11 @@ formatting, and then moved afterward.")
140;; <Functions related to attributes> i.e. <font size=+3> 140;; <Functions related to attributes> i.e. <font size=+3>
141;; 141;;
142 142
143(defun html2text-attr-value (attr-list attr) 143(defun html2text-attr-value (list attribute)
144 (nth 1 (assoc attr attr-list)) 144 "Get value of ATTRIBUTE from LIST."
145 ) 145 (nth 1 (assoc attribute list)))
146 146
147(defun html2text-get-attr (p1 p2 tag) 147(defun html2text-get-attr (p1 p2)
148 (goto-char p1) 148 (goto-char p1)
149 (re-search-forward " +[^ ]" p2 t) 149 (re-search-forward " +[^ ]" p2 t)
150 (let* ((attr-string (buffer-substring-no-properties (1- (point)) (1- p2))) 150 (let* ((attr-string (buffer-substring-no-properties (1- (point)) (1- p2)))
@@ -161,14 +161,10 @@ formatting, and then moved afterward.")
161 ((string-match "[^ ]=[^ ]" prev) 161 ((string-match "[^ ]=[^ ]" prev)
162 (let ((attr (nth 0 (split-string prev "="))) 162 (let ((attr (nth 0 (split-string prev "=")))
163 (value (nth 1 (split-string prev "=")))) 163 (value (nth 1 (split-string prev "="))))
164 (setq attr-list (cons (list attr value) attr-list)) 164 (setq attr-list (cons (list attr value) attr-list))))
165 )
166 )
167 ;; size= 3 165 ;; size= 3
168 ((string-match "[^ ]=\\'" prev) 166 ((string-match "[^ ]=\\'" prev)
169 (setq attr-list (cons (list (substring prev 0 -1) this) attr-list)) 167 (setq attr-list (cons (list (substring prev 0 -1) this) attr-list))))
170 )
171 )
172 168
173 (while (< index (length tmp-list)) 169 (while (< index (length tmp-list))
174 (cond 170 (cond
@@ -176,29 +172,20 @@ formatting, and then moved afterward.")
176 ((string-match "[^ ]=[^ ]" this) 172 ((string-match "[^ ]=[^ ]" this)
177 (let ((attr (nth 0 (split-string this "="))) 173 (let ((attr (nth 0 (split-string this "=")))
178 (value (nth 1 (split-string this "=")))) 174 (value (nth 1 (split-string this "="))))
179 (setq attr-list (cons (list attr value) attr-list)) 175 (setq attr-list (cons (list attr value) attr-list))))
180 )
181 )
182 ;; size =3 176 ;; size =3
183 ((string-match "\\`=[^ ]" this) 177 ((string-match "\\`=[^ ]" this)
184 (setq attr-list (cons (list prev (substring this 1)) attr-list))) 178 (setq attr-list (cons (list prev (substring this 1)) attr-list)))
185
186 ;; size= 3 179 ;; size= 3
187 ((string-match "[^ ]=\\'" this) 180 ((string-match "[^ ]=\\'" this)
188 (setq attr-list (cons (list (substring this 0 -1) next) attr-list)) 181 (setq attr-list (cons (list (substring this 0 -1) next) attr-list)))
189 )
190
191 ;; size = 3 182 ;; size = 3
192 ((string= "=" this) 183 ((string= "=" this)
193 (setq attr-list (cons (list prev next) attr-list)) 184 (setq attr-list (cons (list prev next) attr-list))))
194 )
195 )
196 (setq index (1+ index)) 185 (setq index (1+ index))
197 (setq prev this) 186 (setq prev this)
198 (setq this next) 187 (setq this next)
199 (setq next (nth (1+ index) tmp-list)) 188 (setq next (nth (1+ index) tmp-list)))
200 )
201
202 ;; 189 ;;
203 ;; Tags with no accompanying "=" i.e. value=nil 190 ;; Tags with no accompanying "=" i.e. value=nil
204 ;; 191 ;;
@@ -207,41 +194,25 @@ formatting, and then moved afterward.")
207 (setq next (nth 2 tmp-list)) 194 (setq next (nth 2 tmp-list))
208 (setq index 1) 195 (setq index 1)
209 196
210 (if (not (string-match "=" prev)) 197 (when (and (not (string-match "=" prev))
211 (progn 198 (not (string= (substring this 0 1) "=")))
212 (if (not (string= (substring this 0 1) "=")) 199 (setq attr-list (cons (list prev nil) attr-list)))
213 (setq attr-list (cons (list prev nil) attr-list))
214 )
215 )
216 )
217
218 (while (< index (1- (length tmp-list))) 200 (while (< index (1- (length tmp-list)))
219 (if (not (string-match "=" this)) 201 (when (and (not (string-match "=" this))
220 (if (not (or (string= (substring next 0 1) "=") 202 (not (or (string= (substring next 0 1) "=")
221 (string= (substring prev -1) "="))) 203 (string= (substring prev -1) "="))))
222 (setq attr-list (cons (list this nil) attr-list)) 204 (setq attr-list (cons (list this nil) attr-list)))
223 )
224 )
225 (setq index (1+ index)) 205 (setq index (1+ index))
226 (setq prev this) 206 (setq prev this)
227 (setq this next) 207 (setq this next)
228 (setq next (nth (1+ index) tmp-list)) 208 (setq next (nth (1+ index) tmp-list)))
229 ) 209
230 210 (when (and this
231 (if this 211 (not (string-match "=" this))
232 (progn 212 (not (string= (substring prev -1) "=")))
233 (if (not (string-match "=" this)) 213 (setq attr-list (cons (list this nil) attr-list)))
234 (progn 214 ;; return - value
235 (if (not (string= (substring prev -1) "=")) 215 attr-list))
236 (setq attr-list (cons (list this nil) attr-list))
237 )
238 )
239 )
240 )
241 )
242 attr-list ;; return - value
243 )
244 )
245 216
246;; 217;;
247;; </Functions related to attributes> 218;; </Functions related to attributes>
@@ -266,10 +237,7 @@ formatting, and then moved afterward.")
266 (cond 237 (cond
267 ((string= list-type "ul") (insert " o ")) 238 ((string= list-type "ul") (insert " o "))
268 ((string= list-type "ol") (insert (format " %s: " item-nr))) 239 ((string= list-type "ol") (insert (format " %s: " item-nr)))
269 (t (insert " x "))) 240 (t (insert " x "))))))
270 )
271 )
272 )
273 241
274(defun html2text-clean-dtdd (p1 p2) 242(defun html2text-clean-dtdd (p1 p2)
275 (goto-char p1) 243 (goto-char p1)
@@ -308,61 +276,51 @@ formatting, and then moved afterward.")
308 (html2text-delete-single-tag p1 p2) 276 (html2text-delete-single-tag p1 p2)
309 (goto-char p1) 277 (goto-char p1)
310 (newline 1) 278 (newline 1)
311 (insert (make-string fill-column ?-)) 279 (insert (make-string fill-column ?-)))
312 )
313 280
314(defun html2text-clean-ul (p1 p2 p3 p4) 281(defun html2text-clean-ul (p1 p2 p3 p4)
315 (html2text-delete-tags p1 p2 p3 p4) 282 (html2text-delete-tags p1 p2 p3 p4)
316 (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ul") 283 (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ul"))
317 )
318 284
319(defun html2text-clean-ol (p1 p2 p3 p4) 285(defun html2text-clean-ol (p1 p2 p3 p4)
320 (html2text-delete-tags p1 p2 p3 p4) 286 (html2text-delete-tags p1 p2 p3 p4)
321 (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ol") 287 (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ol"))
322 )
323 288
324(defun html2text-clean-dl (p1 p2 p3 p4) 289(defun html2text-clean-dl (p1 p2 p3 p4)
325 (html2text-delete-tags p1 p2 p3 p4) 290 (html2text-delete-tags p1 p2 p3 p4)
326 (html2text-clean-dtdd p1 (- p3 (- p1 p2))) 291 (html2text-clean-dtdd p1 (- p3 (- p1 p2))))
327 )
328 292
329(defun html2text-clean-center (p1 p2 p3 p4) 293(defun html2text-clean-center (p1 p2 p3 p4)
330 (html2text-delete-tags p1 p2 p3 p4) 294 (html2text-delete-tags p1 p2 p3 p4)
331 (center-region p1 (- p3 (- p2 p1))) 295 (center-region p1 (- p3 (- p2 p1))))
332 )
333 296
334(defun html2text-clean-bold (p1 p2 p3 p4) 297(defun html2text-clean-bold (p1 p2 p3 p4)
335 (put-text-property p2 p3 'face 'bold) 298 (put-text-property p2 p3 'face 'bold)
336 (html2text-delete-tags p1 p2 p3 p4) 299 (html2text-delete-tags p1 p2 p3 p4))
337 )
338 300
339(defun html2text-clean-title (p1 p2 p3 p4) 301(defun html2text-clean-title (p1 p2 p3 p4)
340 (put-text-property p2 p3 'face 'bold) 302 (put-text-property p2 p3 'face 'bold)
341 (html2text-delete-tags p1 p2 p3 p4) 303 (html2text-delete-tags p1 p2 p3 p4))
342 )
343 304
344(defun html2text-clean-underline (p1 p2 p3 p4) 305(defun html2text-clean-underline (p1 p2 p3 p4)
345 (put-text-property p2 p3 'face 'underline) 306 (put-text-property p2 p3 'face 'underline)
346 (html2text-delete-tags p1 p2 p3 p4) 307 (html2text-delete-tags p1 p2 p3 p4))
347 )
348 308
349(defun html2text-clean-italic (p1 p2 p3 p4) 309(defun html2text-clean-italic (p1 p2 p3 p4)
350 (put-text-property p2 p3 'face 'italic) 310 (put-text-property p2 p3 'face 'italic)
351 (html2text-delete-tags p1 p2 p3 p4) 311 (html2text-delete-tags p1 p2 p3 p4))
352 )
353 312
354(defun html2text-clean-font (p1 p2 p3 p4) 313(defun html2text-clean-font (p1 p2 p3 p4)
355 (html2text-delete-tags p1 p2 p3 p4) 314 (html2text-delete-tags p1 p2 p3 p4))
356 )
357 315
358(defun html2text-clean-blockquote (p1 p2 p3 p4) 316(defun html2text-clean-blockquote (p1 p2 p3 p4)
359 (html2text-delete-tags p1 p2 p3 p4) 317 (html2text-delete-tags p1 p2 p3 p4))
360 )
361 318
362(defun html2text-clean-anchor (p1 p2 p3 p4) 319(defun html2text-clean-anchor (p1 p2 p3 p4)
363 ;; If someone can explain how to make the URL clickable I will 320 ;; If someone can explain how to make the URL clickable I will surely
364 ;; surely improve upon this. 321 ;; improve upon this.
365 (let* ((attr-list (html2text-get-attr p1 p2 "a")) 322 ;; Maybe `goto-addr.el' can be used here.
323 (let* ((attr-list (html2text-get-attr p1 p2))
366 (href (html2text-attr-value attr-list "href"))) 324 (href (html2text-attr-value attr-list "href")))
367 (delete-region p1 p4) 325 (delete-region p1 p4)
368 (when href 326 (when href
@@ -386,38 +344,27 @@ formatting, and then moved afterward.")
386 (let ((has-br-line) 344 (let ((has-br-line)
387 (refill-start) 345 (refill-start)
388 (refill-stop)) 346 (refill-stop))
389 (if (re-search-forward "<br>$" p2 t) 347 (when (re-search-forward "<br>$" p2 t)
390 (setq has-br-line t) 348 (goto-char p1)
391 ) 349 (when (re-search-forward ".+[^<][^b][^r][^>]$" p2 t)
392 (if has-br-line 350 (beginning-of-line)
393 (progn 351 (setq refill-start (point))
394 (goto-char p1) 352 (goto-char p2)
395 (if (re-search-forward ".+[^<][^b][^r][^>]$" p2 t) 353 (re-search-backward ".+[^<][^b][^r][^>]$" refill-start t)
396 (progn 354 (next-line 1)
397 (beginning-of-line) 355 (end-of-line)
398 (setq refill-start (point)) 356 ;; refill-stop should ideally be adjusted to
399 (goto-char p2) 357 ;; accomodate the "<br>" strings which are removed
400 (re-search-backward ".+[^<][^b][^r][^>]$" refill-start t) 358 ;; between refill-start and refill-stop. Can simply
401 (next-line 1) 359 ;; be returned from my-replace-string
402 (end-of-line) 360 (setq refill-stop (+ (point)
403 ;; refill-stop should ideally be adjusted to 361 (html2text-replace-string
404 ;; accomodate the "<br>" strings which are removed 362 "<br>" ""
405 ;; between refill-start and refill-stop. Can simply 363 refill-start (point))))
406 ;; be returned from my-replace-string 364 ;; (message "Point = %s refill-stop = %s" (point) refill-stop)
407 (setq refill-stop (+ (point) 365 ;; (sleep-for 4)
408 (html2text-replace-string 366 (fill-region refill-start refill-stop))))
409 "<br>" "" 367 (html2text-replace-string "<br>" "" p1 p2))
410 refill-start (point))))
411 ;; (message "Point = %s refill-stop = %s" (point) refill-stop)
412 ;; (sleep-for 4)
413 (fill-region refill-start refill-stop)
414 )
415 )
416 )
417 )
418 )
419 (html2text-replace-string "<br>" "" p1 p2)
420 )
421 368
422;; 369;;
423;; This one is interactive ... 370;; This one is interactive ...
@@ -452,7 +399,7 @@ fashion, quite close to pure guess-work. It does work in some cases though."
452;; 399;;
453 400
454(defun html2text-remove-tags (tag-list) 401(defun html2text-remove-tags (tag-list)
455 "Removes the tags listed in the list \"html2text-remove-tag-list\". 402 "Removes the tags listed in the list `html2text-remove-tag-list'.
456See the documentation for that variable." 403See the documentation for that variable."
457 (interactive) 404 (interactive)
458 (dolist (tag tag-list) 405 (dolist (tag tag-list)
@@ -461,7 +408,7 @@ See the documentation for that variable."
461 (delete-region (match-beginning 0) (match-end 0))))) 408 (delete-region (match-beginning 0) (match-end 0)))))
462 409
463(defun html2text-format-tags () 410(defun html2text-format-tags ()
464 "See the variable \"html2text-format-tag-list\" for documentation" 411 "See the variable `html2text-format-tag-list' for documentation."
465 (interactive) 412 (interactive)
466 (dolist (tag-and-function html2text-format-tag-list) 413 (dolist (tag-and-function html2text-format-tag-list)
467 (let ((tag (car tag-and-function)) 414 (let ((tag (car tag-and-function))
@@ -471,8 +418,7 @@ See the documentation for that variable."
471 (point-max) t) 418 (point-max) t)
472 (let ((p1) 419 (let ((p1)
473 (p2 (point)) 420 (p2 (point))
474 (p3) (p4) 421 (p3) (p4))
475 (attr (match-string 1)))
476 (search-backward "<" (point-min) t) 422 (search-backward "<" (point-min) t)
477 (setq p1 (point)) 423 (setq p1 (point))
478 (re-search-forward (format "</%s>" tag) (point-max) t) 424 (re-search-forward (format "</%s>" tag) (point-max) t)
@@ -480,27 +426,18 @@ See the documentation for that variable."
480 (search-backward "</" (point-min) t) 426 (search-backward "</" (point-min) t)
481 (setq p3 (point)) 427 (setq p3 (point))
482 (funcall function p1 p2 p3 p4) 428 (funcall function p1 p2 p3 p4)
483 (goto-char p1) 429 (goto-char p1))))))
484 )
485 )
486 )
487 )
488 )
489 430
490(defun html2text-substitute () 431(defun html2text-substitute ()
491 "See the variable \"html2text-replace-list\" for documentation" 432 "See the variable `html2text-replace-list' for documentation."
492 (interactive) 433 (interactive)
493 (dolist (e html2text-replace-list) 434 (dolist (e html2text-replace-list)
494 (goto-char (point-min)) 435 (goto-char (point-min))
495 (let ((old-string (car e)) 436 (let ((old-string (car e))
496 (new-string (cdr e))) 437 (new-string (cdr e)))
497 (html2text-replace-string old-string new-string (point-min) (point-max)) 438 (html2text-replace-string old-string new-string (point-min) (point-max)))))
498 )
499 )
500 )
501 439
502(defun html2text-format-single-elements () 440(defun html2text-format-single-elements ()
503 ""
504 (interactive) 441 (interactive)
505 (dolist (tag-and-function html2text-format-single-element-list) 442 (dolist (tag-and-function html2text-format-single-element-list)
506 (let ((tag (car tag-and-function)) 443 (let ((tag (car tag-and-function))
@@ -512,12 +449,7 @@ See the documentation for that variable."
512 (p2 (point))) 449 (p2 (point)))
513 (search-backward "<" (point-min) t) 450 (search-backward "<" (point-min) t)
514 (setq p1 (point)) 451 (setq p1 (point))
515 (funcall function p1 p2) 452 (funcall function p1 p2))))))
516 )
517 )
518 )
519 )
520 )
521 453
522;; 454;;
523;; Main function 455;; Main function
@@ -540,6 +472,6 @@ See the documentation for that variable."
540;; 472;;
541;; </Interactive functions> 473;; </Interactive functions>
542;; 474;;
543 475(provide 'html2text)
544;;; arch-tag: e9e57b79-35d4-4de1-a647-e7e01fe56d1e 476;;; arch-tag: e9e57b79-35d4-4de1-a647-e7e01fe56d1e
545;;; html2text.el ends here 477;;; html2text.el ends here
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 585a72af549..fb63d6724be 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -587,6 +587,7 @@ Done before generating the new subject of a forward."
587 non-word-constituents 587 non-word-constituents
588 "]\\)+>+\\|[ \t]*[]>|}+]\\)+")))) 588 "]\\)+>+\\|[ \t]*[]>|}+]\\)+"))))
589 "*Regexp matching the longest possible citation prefix on a line." 589 "*Regexp matching the longest possible citation prefix on a line."
590 :version "21.4"
590 :group 'message-insertion 591 :group 'message-insertion
591 :link '(custom-manual "(message)Insertion Variables") 592 :link '(custom-manual "(message)Insertion Variables")
592 :type 'regexp) 593 :type 'regexp)
@@ -743,6 +744,7 @@ Doing so would be even more evil than leaving it out."
743 "*Envelope-from when sending mail with sendmail. 744 "*Envelope-from when sending mail with sendmail.
744If this is nil, use `user-mail-address'. If it is the symbol 745If this is nil, use `user-mail-address'. If it is the symbol
745`header', use the From: header of the message." 746`header', use the From: header of the message."
747 :version "21.4"
746 :type '(choice (string :tag "From name") 748 :type '(choice (string :tag "From name")
747 (const :tag "Use From: header from message" header) 749 (const :tag "Use From: header from message" header)
748 (const :tag "Use `user-mail-address'" nil)) 750 (const :tag "Use `user-mail-address'" nil))
@@ -855,7 +857,8 @@ the signature is inserted."
855 (let ((map (make-sparse-keymap 'message-minibuffer-local-map))) 857 (let ((map (make-sparse-keymap 'message-minibuffer-local-map)))
856 (set-keymap-parent map minibuffer-local-map) 858 (set-keymap-parent map minibuffer-local-map)
857 map) 859 map)
858 "Keymap for `message-read-from-minibuffer'.") 860 "Keymap for `message-read-from-minibuffer'."
861 :version "21.4")
859 862
860;;;###autoload 863;;;###autoload
861(defcustom message-citation-line-function 'message-insert-citation-line 864(defcustom message-citation-line-function 'message-insert-citation-line
@@ -1435,6 +1438,7 @@ no, only reply back to the author."
1435 1438
1436(defcustom message-user-fqdn nil 1439(defcustom message-user-fqdn nil
1437 "*Domain part of Messsage-Ids." 1440 "*Domain part of Messsage-Ids."
1441 :version "21.4"
1438 :group 'message-headers 1442 :group 'message-headers
1439 :link '(custom-manual "(message)News Headers") 1443 :link '(custom-manual "(message)News Headers")
1440 :type '(radio (const :format "%v " nil) 1444 :type '(radio (const :format "%v " nil)
@@ -6590,6 +6594,7 @@ which specify the range to operate on."
6590 '("^\\(Disposition-Notification-To\\|Return-Receipt-To\\):" 6594 '("^\\(Disposition-Notification-To\\|Return-Receipt-To\\):"
6591 . message-expand-name)) 6595 . message-expand-name))
6592 "Alist of (RE . FUN). Use FUN for completion on header lines matching RE." 6596 "Alist of (RE . FUN). Use FUN for completion on header lines matching RE."
6597 :version "21.4"
6593 :group 'message 6598 :group 'message
6594 :type '(alist :key-type regexp :value-type function)) 6599 :type '(alist :key-type regexp :value-type function))
6595 6600
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 51ec38dc387..b167ea7d104 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -150,12 +150,14 @@ when displaying the image. The default value is \"\\\\`cid:\" which only
150matches parts embedded to the Multipart/Related type MIME contents and 150matches parts embedded to the Multipart/Related type MIME contents and
151Gnus will never connect to the spammer's site arbitrarily. You may 151Gnus will never connect to the spammer's site arbitrarily. You may
152set this variable to nil if you consider all urls to be safe." 152set this variable to nil if you consider all urls to be safe."
153 :version "21.4"
153 :type '(choice (regexp :tag "Regexp") 154 :type '(choice (regexp :tag "Regexp")
154 (const :tag "All URLs are safe" nil)) 155 (const :tag "All URLs are safe" nil))
155 :group 'mime-display) 156 :group 'mime-display)
156 157
157(defcustom mm-inline-text-html-with-w3m-keymap t 158(defcustom mm-inline-text-html-with-w3m-keymap t
158 "If non-nil, use emacs-w3m command keys in the article buffer." 159 "If non-nil, use emacs-w3m command keys in the article buffer."
160 :version "21.4"
159 :type 'boolean 161 :type 'boolean
160 :group 'mime-display) 162 :group 'mime-display)
161 163
@@ -378,6 +380,7 @@ If not set, `default-directory' will be used."
378 380
379(defcustom mm-attachment-file-modes 384 381(defcustom mm-attachment-file-modes 384
380 "Set the mode bits of saved attachments to this integer." 382 "Set the mode bits of saved attachments to this integer."
383 :version "21.4"
381 :type 'integer 384 :type 'integer
382 :group 'mime-display) 385 :group 'mime-display)
383 386
@@ -435,6 +438,7 @@ If not set, `default-directory' will be used."
435 "Option of decrypting encrypted parts. 438 "Option of decrypting encrypted parts.
436`never', not decrypt; `always', always decrypt; 439`never', not decrypt; `always', always decrypt;
437`known', only decrypt known protocols. Otherwise, ask user." 440`known', only decrypt known protocols. Otherwise, ask user."
441 :version "21.4"
438 :type '(choice (item always) 442 :type '(choice (item always)
439 (item never) 443 (item never)
440 (item :tag "only known protocols" known) 444 (item :tag "only known protocols" known)
diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el
index 1652dbca245..1388371c981 100644
--- a/lisp/gnus/mm-url.el
+++ b/lisp/gnus/mm-url.el
@@ -49,6 +49,7 @@
49 (require 'url) 49 (require 'url)
50 (error nil))) 50 (error nil)))
51 "*If non-nil, use external grab program `mm-url-program'." 51 "*If non-nil, use external grab program `mm-url-program'."
52 :version "21.4"
52 :type 'boolean 53 :type 'boolean
53 :group 'mm-url) 54 :group 'mm-url)
54 55
@@ -67,6 +68,7 @@
67 (t "GET")) 68 (t "GET"))
68 "The url grab program. 69 "The url grab program.
69Likely values are `wget', `w3m', `lynx' and `curl'." 70Likely values are `wget', `w3m', `lynx' and `curl'."
71 :version "21.4"
70 :type '(choice 72 :type '(choice
71 (symbol :tag "wget" wget) 73 (symbol :tag "wget" wget)
72 (symbol :tag "w3m" w3m) 74 (symbol :tag "w3m" w3m)
@@ -77,6 +79,7 @@ Likely values are `wget', `w3m', `lynx' and `curl'."
77 79
78(defcustom mm-url-arguments nil 80(defcustom mm-url-arguments nil
79 "The arguments for `mm-url-program'." 81 "The arguments for `mm-url-program'."
82 :version "21.4"
80 :type '(repeat string) 83 :type '(repeat string)
81 :group 'mm-url) 84 :group 'mm-url)
82 85
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index 3831e1a07ce..d961b2b4100 100644
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -123,13 +123,16 @@
123 123
124(defun mm-coding-system-p (cs) 124(defun mm-coding-system-p (cs)
125 "Return non-nil if CS is a symbol naming a coding system. 125 "Return non-nil if CS is a symbol naming a coding system.
126In XEmacs, also return non-nil if CS is a coding system object." 126In XEmacs, also return non-nil if CS is a coding system object.
127If CS is available, return CS itself in Emacs, and return a coding
128system object in XEmacs."
127 (if (fboundp 'find-coding-system) 129 (if (fboundp 'find-coding-system)
128 (find-coding-system cs) 130 (find-coding-system cs)
129 (if (fboundp 'coding-system-p) 131 (if (fboundp 'coding-system-p)
130 (coding-system-p cs) 132 (when (coding-system-p cs)
133 cs)
131 ;; Is this branch ever actually useful? 134 ;; Is this branch ever actually useful?
132 (memq cs (mm-get-coding-system-list))))) 135 (car (memq cs (mm-get-coding-system-list))))))
133 136
134(defvar mm-charset-synonym-alist 137(defvar mm-charset-synonym-alist
135 `( 138 `(
@@ -219,12 +222,12 @@ In XEmacs, also return non-nil if CS is a coding system object."
219 (big5 chinese-big5-1 chinese-big5-2) 222 (big5 chinese-big5-1 chinese-big5-2)
220 (tibetan tibetan) 223 (tibetan tibetan)
221 (thai-tis620 thai-tis620) 224 (thai-tis620 thai-tis620)
225 (windows-1251 cyrillic-iso8859-5)
222 (iso-2022-7bit ethiopic arabic-1-column arabic-2-column) 226 (iso-2022-7bit ethiopic arabic-1-column arabic-2-column)
223 (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7 227 (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7
224 latin-jisx0201 japanese-jisx0208-1978 228 latin-jisx0201 japanese-jisx0208-1978
225 chinese-gb2312 japanese-jisx0208 229 chinese-gb2312 japanese-jisx0208
226 korean-ksc5601 japanese-jisx0212 230 korean-ksc5601 japanese-jisx0212)
227 katakana-jisx0201)
228 (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7 231 (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7
229 latin-jisx0201 japanese-jisx0208-1978 232 latin-jisx0201 japanese-jisx0208-1978
230 chinese-gb2312 japanese-jisx0208 233 chinese-gb2312 japanese-jisx0208
@@ -239,6 +242,9 @@ In XEmacs, also return non-nil if CS is a coding system object."
239 chinese-cns11643-3 chinese-cns11643-4 242 chinese-cns11643-3 chinese-cns11643-4
240 chinese-cns11643-5 chinese-cns11643-6 243 chinese-cns11643-5 chinese-cns11643-6
241 chinese-cns11643-7) 244 chinese-cns11643-7)
245 (iso-2022-jp-3 latin-jisx0201 japanese-jisx0208-1978 japanese-jisx0208
246 japanese-jisx0213-1 japanese-jisx0213-2)
247 (shift_jis latin-jisx0201 katakana-jisx0201 japanese-jisx0208)
242 ,(if (or (not (fboundp 'charsetp)) ;; non-Mule case 248 ,(if (or (not (fboundp 'charsetp)) ;; non-Mule case
243 (charsetp 'unicode-a) 249 (charsetp 'unicode-a)
244 (not (mm-coding-system-p 'mule-utf-8))) 250 (not (mm-coding-system-p 'mule-utf-8)))
@@ -249,32 +255,56 @@ In XEmacs, also return non-nil if CS is a coding system object."
249 (coding-system-get 'mule-utf-8 'safe-charsets))))) 255 (coding-system-get 'mule-utf-8 'safe-charsets)))))
250 "Alist of MIME-charset/MULE-charsets.") 256 "Alist of MIME-charset/MULE-charsets.")
251 257
252;; Correct by construction, but should be unnecessary: 258(defun mm-enrich-utf-8-by-mule-ucs ()
253;; XEmacs hates it. 259 "Make the `utf-8' MIME charset usable by the Mule-UCS package.
254(when (and (not (featurep 'xemacs)) 260This function will run when the `un-define' module is loaded under
255 (fboundp 'coding-system-list) 261XEmacs, and fill the `utf-8' entry in `mm-mime-mule-charset-alist'
256 (fboundp 'sort-coding-systems)) 262with Mule charsets. It is completely useless for Emacs."
257 (setq mm-mime-mule-charset-alist 263 (unless (cdr (delete '(mm-enrich-utf-8-by-mule-ucs)
258 (apply 264 (assoc "un-define" after-load-alist)))
259 'nconc 265 (setq after-load-alist
260 (mapcar 266 (delete '("un-define") after-load-alist)))
261 (lambda (cs) 267 (when (boundp 'unicode-basic-translation-charset-order-list)
262 (when (and (or (coding-system-get cs :mime-charset) ; Emacs 22 268 (condition-case nil
263 (coding-system-get cs 'mime-charset)) 269 (let ((val (delq
264 (not (eq t (coding-system-get cs 'safe-charsets)))) 270 'ascii
265 (list (cons (or (coding-system-get cs :mime-charset) 271 (copy-sequence
266 (coding-system-get cs 'mime-charset)) 272 (symbol-value
267 (delq 'ascii 273 'unicode-basic-translation-charset-order-list))))
268 (coding-system-get cs 'safe-charsets)))))) 274 (elem (assq 'utf-8 mm-mime-mule-charset-alist)))
269 (sort-coding-systems (coding-system-list 'base-only)))))) 275 (if elem
276 (setcdr elem val)
277 (setq mm-mime-mule-charset-alist
278 (nconc mm-mime-mule-charset-alist
279 (list (cons 'utf-8 val))))))
280 (error))))
281
282;; Correct by construction, but should be unnecessary for Emacs:
283(if (featurep 'xemacs)
284 (eval-after-load "un-define" '(mm-enrich-utf-8-by-mule-ucs))
285 (when (and (fboundp 'coding-system-list)
286 (fboundp 'sort-coding-systems))
287 (let ((css (sort-coding-systems (coding-system-list 'base-only)))
288 cs mime mule alist)
289 (while css
290 (setq cs (pop css)
291 mime (or (coding-system-get cs :mime-charset) ; Emacs 22
292 (coding-system-get cs 'mime-charset)))
293 (when (and mime
294 (not (eq t (setq mule
295 (coding-system-get cs 'safe-charsets))))
296 (not (assq mime alist)))
297 (push (cons mime (delq 'ascii mule)) alist)))
298 (setq mm-mime-mule-charset-alist (nreverse alist)))))
270 299
271(defcustom mm-coding-system-priorities 300(defcustom mm-coding-system-priorities
272 (if (boundp 'current-language-environment) 301 (if (boundp 'current-language-environment)
273 (let ((lang (symbol-value 'current-language-environment))) 302 (let ((lang (symbol-value 'current-language-environment)))
274 (cond ((string= lang "Japanese") 303 (cond ((string= lang "Japanese")
275 ;; Japanese users may prefer iso-2022-jp to shift-jis. 304 ;; Japanese users prefer iso-2022-jp to euc-japan or
276 '(iso-2022-jp iso-2022-jp-2 japanese-shift-jis 305 ;; shift_jis, however iso-8859-1 should be used when
277 iso-latin-1 utf-8))))) 306 ;; there are only ASCII text and Latin-1 characters.
307 '(iso-8859-1 iso-2022-jp iso-2022-jp-2 shift_jis utf-8)))))
278 "Preferred coding systems for encoding outgoing messages. 308 "Preferred coding systems for encoding outgoing messages.
279 309
280More than one suitable coding system may be found for some text. 310More than one suitable coding system may be found for some text.
@@ -301,16 +331,20 @@ mail with multiple parts is preferred to sending a Unicode one.")
301 "Return the MIME charset corresponding to the given Mule CHARSET." 331 "Return the MIME charset corresponding to the given Mule CHARSET."
302 (if (and (fboundp 'find-coding-systems-for-charsets) 332 (if (and (fboundp 'find-coding-systems-for-charsets)
303 (fboundp 'sort-coding-systems)) 333 (fboundp 'sort-coding-systems))
304 (let (mime) 334 (let ((css (sort (sort-coding-systems
305 (dolist (cs (sort-coding-systems 335 (find-coding-systems-for-charsets (list charset)))
306 (copy-sequence 336 'mm-sort-coding-systems-predicate))
307 (find-coding-systems-for-charsets (list charset))))) 337 cs mime)
308 (unless mime 338 (while (and (not mime)
309 (when cs 339 css)
310 (setq mime (or (coding-system-get cs :mime-charset) 340 (when (setq cs (pop css))
311 (coding-system-get cs 'mime-charset)))))) 341 (setq mime (or (coding-system-get cs :mime-charset)
342 (coding-system-get cs 'mime-charset)))))
312 mime) 343 mime)
313 (let ((alist mm-mime-mule-charset-alist) 344 (let ((alist (mapcar (lambda (cs)
345 (assq cs mm-mime-mule-charset-alist))
346 (sort (mapcar 'car mm-mime-mule-charset-alist)
347 'mm-sort-coding-systems-predicate)))
314 out) 348 out)
315 (while alist 349 (while alist
316 (when (memq charset (cdar alist)) 350 (when (memq charset (cdar alist))
@@ -482,11 +516,14 @@ This affects whether coding conversion should be attempted generally."
482 (let ((priorities 516 (let ((priorities
483 (mapcar (lambda (cs) 517 (mapcar (lambda (cs)
484 ;; Note: invalid entries are dropped silently 518 ;; Note: invalid entries are dropped silently
485 (and (coding-system-p cs) 519 (and (setq cs (mm-coding-system-p cs))
486 (coding-system-base cs))) 520 (coding-system-base cs)))
487 mm-coding-system-priorities))) 521 mm-coding-system-priorities)))
488 (> (length (memq a priorities)) 522 (and (setq a (mm-coding-system-p a))
489 (length (memq b priorities))))) 523 (if (setq b (mm-coding-system-p b))
524 (> (length (memq (coding-system-base a) priorities))
525 (length (memq (coding-system-base b) priorities)))
526 t))))
490 527
491(defun mm-find-mime-charset-region (b e) 528(defun mm-find-mime-charset-region (b e)
492 "Return the MIME charsets needed to encode the region between B and E. 529 "Return the MIME charsets needed to encode the region between B and E.
diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el
index 17fa59311db..b140cb76df5 100644
--- a/lisp/gnus/mm-uu.el
+++ b/lisp/gnus/mm-uu.el
@@ -80,6 +80,7 @@ This can be either \"inline\" or \"attachment\".")
80 80
81(defcustom mm-uu-diff-groups-regexp "gnus\\.commits" 81(defcustom mm-uu-diff-groups-regexp "gnus\\.commits"
82 "*Regexp matching diff groups." 82 "*Regexp matching diff groups."
83 :version "21.4"
83 :type 'regexp 84 :type 'regexp
84 :group 'gnus-article-mime) 85 :group 'gnus-article-mime)
85 86
diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el
index b8107364411..8bd2ed784ad 100644
--- a/lisp/gnus/mml-sec.el
+++ b/lisp/gnus/mml-sec.el
@@ -43,6 +43,7 @@
43(defcustom mml-default-sign-method "pgpmime" 43(defcustom mml-default-sign-method "pgpmime"
44 "Default sign method. 44 "Default sign method.
45The string must have an entry in `mml-sign-alist'." 45The string must have an entry in `mml-sign-alist'."
46 :version "21.4"
46 :type '(choice (const "smime") 47 :type '(choice (const "smime")
47 (const "pgp") 48 (const "pgp")
48 (const "pgpauto") 49 (const "pgpauto")
@@ -60,6 +61,7 @@ The string must have an entry in `mml-sign-alist'."
60(defcustom mml-default-encrypt-method "pgpmime" 61(defcustom mml-default-encrypt-method "pgpmime"
61 "Default encryption method. 62 "Default encryption method.
62The string must have an entry in `mml-encrypt-alist'." 63The string must have an entry in `mml-encrypt-alist'."
64 :version "21.4"
63 :type '(choice (const "smime") 65 :type '(choice (const "smime")
64 (const "pgp") 66 (const "pgp")
65 (const "pgpauto") 67 (const "pgpauto")
@@ -83,6 +85,7 @@ Note that the output generated by using a `combined' mode is NOT
83understood by all PGP implementations, in particular PGP version 85understood by all PGP implementations, in particular PGP version
842 does not support it! See Info node `(message)Security' for 862 does not support it! See Info node `(message)Security' for
85details." 87details."
88 :version "21.4"
86 :group 'message 89 :group 'message
87 :type '(repeat (list (choice (const :tag "S/MIME" "smime") 90 :type '(repeat (list (choice (const :tag "S/MIME" "smime")
88 (const :tag "PGP" "pgp") 91 (const :tag "PGP" "pgp")
diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el
index 6c89cfbe798..e083c2c9d9c 100644
--- a/lisp/gnus/mml2015.el
+++ b/lisp/gnus/mml2015.el
@@ -83,6 +83,7 @@
83 ("TRUST_FULLY" . t) 83 ("TRUST_FULLY" . t)
84 ("TRUST_ULTIMATE" . t)) 84 ("TRUST_ULTIMATE" . t))
85 "Map GnuPG trust output values to a boolean saying if you trust the key." 85 "Map GnuPG trust output values to a boolean saying if you trust the key."
86 :version "21.4"
86 :group 'mime-security 87 :group 'mime-security
87 :type '(repeat (cons (regexp :tag "GnuPG output regexp") 88 :type '(repeat (cons (regexp :tag "GnuPG output regexp")
88 (boolean :tag "Trust key")))) 89 (boolean :tag "Trust key"))))
diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el
index 81d5443b640..13000a8ad19 100644
--- a/lisp/gnus/nndiary.el
+++ b/lisp/gnus/nndiary.el
@@ -223,6 +223,7 @@
223 223
224(defgroup nndiary nil 224(defgroup nndiary nil
225 "The Gnus Diary backend." 225 "The Gnus Diary backend."
226 :version "21.4"
226 :group 'gnus-diary) 227 :group 'gnus-diary)
227 228
228(defcustom nndiary-mail-sources 229(defcustom nndiary-mail-sources
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index c1a23d8ca9b..040be1e60e1 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -119,6 +119,7 @@ If nil, the first match found will be used."
119(defcustom nnmail-split-fancy-with-parent-ignore-groups nil 119(defcustom nnmail-split-fancy-with-parent-ignore-groups nil
120 "Regexp that matches group names to be ignored when applying `nnmail-split-fancy-with-parent'. 120 "Regexp that matches group names to be ignored when applying `nnmail-split-fancy-with-parent'.
121This can also be a list of regexps." 121This can also be a list of regexps."
122 :version "21.4"
122 :group 'nnmail-split 123 :group 'nnmail-split
123 :type '(choice (const :tag "none" nil) 124 :type '(choice (const :tag "none" nil)
124 (regexp :value ".*") 125 (regexp :value ".*")
@@ -127,6 +128,7 @@ This can also be a list of regexps."
127(defcustom nnmail-cache-ignore-groups nil 128(defcustom nnmail-cache-ignore-groups nil
128 "Regexp that matches group names to be ignored when inserting message ids into the cache (`nnmail-cache-insert'). 129 "Regexp that matches group names to be ignored when inserting message ids into the cache (`nnmail-cache-insert').
129This can also be a list of regexps." 130This can also be a list of regexps."
131 :version "21.4"
130 :group 'nnmail-split 132 :group 'nnmail-split
131 :type '(choice (const :tag "none" nil) 133 :type '(choice (const :tag "none" nil)
132 (regexp :value ".*") 134 (regexp :value ".*")
@@ -353,6 +355,7 @@ discarded after running the split process."
353 355
354(defcustom nnmail-spool-hook nil 356(defcustom nnmail-spool-hook nil
355 "*A hook called when a new article is spooled." 357 "*A hook called when a new article is spooled."
358 :version "21.4"
356 :group 'nnmail 359 :group 'nnmail
357 :type 'hook) 360 :type 'hook)
358 361
@@ -575,6 +578,7 @@ Normally, regexes given in `nnmail-split-fancy' are implicitly surrounded
575by \"\\=\\<...\\>\". If this variable is true, they are not implicitly\ 578by \"\\=\\<...\\>\". If this variable is true, they are not implicitly\
576 surrounded 579 surrounded
577by anything." 580by anything."
581 :version "21.4"
578 :group 'nnmail 582 :group 'nnmail
579 :type 'boolean) 583 :type 'boolean)
580 584
@@ -582,6 +586,7 @@ by anything."
582 "Whether to lowercase expanded entries (i.e. \\N) when splitting mails. 586 "Whether to lowercase expanded entries (i.e. \\N) when splitting mails.
583This avoids the creation of multiple groups when users send to an address 587This avoids the creation of multiple groups when users send to an address
584using different case (i.e. mailing-list@domain vs Mailing-List@Domain)." 588using different case (i.e. mailing-list@domain vs Mailing-List@Domain)."
589 :version "21.4"
585 :group 'nnmail 590 :group 'nnmail
586 :type 'boolean) 591 :type 'boolean)
587 592
diff --git a/lisp/gnus/nnspool.el b/lisp/gnus/nnspool.el
index 9a08cdfe71c..d54897a7750 100644
--- a/lisp/gnus/nnspool.el
+++ b/lisp/gnus/nnspool.el
@@ -44,7 +44,10 @@ This is most commonly `inews' or `injnews'.")
44 "Switches for nnspool-request-post to pass to `inews' for posting news. 44 "Switches for nnspool-request-post to pass to `inews' for posting news.
45If you are using Cnews, you probably should set this variable to nil.") 45If you are using Cnews, you probably should set this variable to nil.")
46 46
47(defvoo nnspool-spool-directory (file-name-as-directory news-directory) 47(defvoo nnspool-spool-directory
48 (file-name-as-directory (if (boundp 'news-directory)
49 (symbol-value 'news-directory)
50 news-path))
48 "Local news spool directory.") 51 "Local news spool directory.")
49 52
50(defvoo nnspool-nov-directory (concat nnspool-spool-directory "over.view/") 53(defvoo nnspool-nov-directory (concat nnspool-spool-directory "over.view/")
diff --git a/lisp/gnus/sha1.el b/lisp/gnus/sha1.el
index a9b68805d3f..51a826fe5fc 100644
--- a/lisp/gnus/sha1.el
+++ b/lisp/gnus/sha1.el
@@ -60,6 +60,7 @@
60 60
61(defgroup sha1 nil 61(defgroup sha1 nil
62 "Elisp interface for SHA1 hash computation." 62 "Elisp interface for SHA1 hash computation."
63 :version "21.4"
63 :group 'extensions) 64 :group 'extensions)
64 65
65(defcustom sha1-maximum-internal-length 500 66(defcustom sha1-maximum-internal-length 500
@@ -82,7 +83,6 @@ It must be a string \(program name\) or list of strings \(name and its args\)."
82 (error)) 83 (error))
83 "*Use external SHA1 program. 84 "*Use external SHA1 program.
84If this variable is set to nil, use internal function only." 85If this variable is set to nil, use internal function only."
85 :version "21.4"
86 :type 'boolean 86 :type 'boolean
87 :group 'sha1) 87 :group 'sha1)
88 88
diff --git a/lisp/gnus/sieve.el b/lisp/gnus/sieve.el
index f4645168dec..c37ffb616db 100644
--- a/lisp/gnus/sieve.el
+++ b/lisp/gnus/sieve.el
@@ -65,6 +65,7 @@
65 65
66(defgroup sieve nil 66(defgroup sieve nil
67 "Manage sieve scripts." 67 "Manage sieve scripts."
68 :version "21.4"
68 :group 'tools) 69 :group 'tools)
69 70
70(defcustom sieve-new-script "<new script>" 71(defcustom sieve-new-script "<new script>"
diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el
index f197d165cdd..eb33b7ad0b3 100644
--- a/lisp/gnus/spam-stat.el
+++ b/lisp/gnus/spam-stat.el
@@ -128,6 +128,7 @@
128Use the functions to build a dictionary of words and their statistical 128Use the functions to build a dictionary of words and their statistical
129distribution in spam and non-spam mails. Then use a function to determine 129distribution in spam and non-spam mails. Then use a function to determine
130whether a buffer contains spam or not." 130whether a buffer contains spam or not."
131 :version "21.4"
131 :group 'gnus) 132 :group 'gnus)
132 133
133(defcustom spam-stat-file "~/.spam-stat.el" 134(defcustom spam-stat-file "~/.spam-stat.el"
diff --git a/lisp/gnus/starttls.el b/lisp/gnus/starttls.el
index c172e88c515..7a2eef5e7d0 100644
--- a/lisp/gnus/starttls.el
+++ b/lisp/gnus/starttls.el
@@ -126,6 +126,7 @@
126 "Name of GNUTLS command line tool. 126 "Name of GNUTLS command line tool.
127This program is used when GNUTLS is used, i.e. when 127This program is used when GNUTLS is used, i.e. when
128`starttls-use-gnutls' is non-nil." 128`starttls-use-gnutls' is non-nil."
129 :version "21.4"
129 :type 'string 130 :type 'string
130 :group 'starttls) 131 :group 'starttls)
131 132
@@ -138,6 +139,7 @@ i.e. when `starttls-use-gnutls' is nil."
138 139
139(defcustom starttls-use-gnutls (not (executable-find starttls-program)) 140(defcustom starttls-use-gnutls (not (executable-find starttls-program))
140 "*Whether to use GNUTLS instead of the `starttls' command." 141 "*Whether to use GNUTLS instead of the `starttls' command."
142 :version "21.4"
141 :type 'boolean 143 :type 'boolean
142 :group 'starttls) 144 :group 'starttls)
143 145
@@ -156,11 +158,13 @@ This program is used when GNUTLS is used, i.e. when
156For example, non-TLS compliant servers may require 158For example, non-TLS compliant servers may require
157'(\"--protocols\" \"ssl3\"). Invoke \"gnutls-cli --help\" to 159'(\"--protocols\" \"ssl3\"). Invoke \"gnutls-cli --help\" to
158find out which parameters are available." 160find out which parameters are available."
161 :version "21.4"
159 :type '(repeat string) 162 :type '(repeat string)
160 :group 'starttls) 163 :group 'starttls)
161 164
162(defcustom starttls-process-connection-type nil 165(defcustom starttls-process-connection-type nil
163 "*Value for `process-connection-type' to use when starting STARTTLS process." 166 "*Value for `process-connection-type' to use when starting STARTTLS process."
167 :version "21.4"
164 :type 'boolean 168 :type 'boolean
165 :group 'starttls) 169 :group 'starttls)
166 170
@@ -170,6 +174,7 @@ The default is what GNUTLS's \"gnutls-cli\" outputs."
170 ;; GNUTLS cli.c:main() print this string when it is starting to run 174 ;; GNUTLS cli.c:main() print this string when it is starting to run
171 ;; in the application read/write phase. If the logic, or the string 175 ;; in the application read/write phase. If the logic, or the string
172 ;; itself, is modified, this must be updated. 176 ;; itself, is modified, this must be updated.
177 :version "21.4"
173 :type 'regexp 178 :type 'regexp
174 :group 'starttls) 179 :group 'starttls)
175 180
@@ -178,6 +183,7 @@ The default is what GNUTLS's \"gnutls-cli\" outputs."
178The default is what GNUTLS's \"gnutls-cli\" outputs." 183The default is what GNUTLS's \"gnutls-cli\" outputs."
179 ;; GNUTLS cli.c:do_handshake() print this string on failure. If the 184 ;; GNUTLS cli.c:do_handshake() print this string on failure. If the
180 ;; logic, or the string itself, is modified, this must be updated. 185 ;; logic, or the string itself, is modified, this must be updated.
186 :version "21.4"
181 :type 'regexp 187 :type 'regexp
182 :group 'starttls) 188 :group 'starttls)
183 189
@@ -188,6 +194,7 @@ The default is what GNUTLS's \"gnutls-cli\" outputs."
188 ;; common.c:print_info(), that unconditionally print this string 194 ;; common.c:print_info(), that unconditionally print this string
189 ;; last. If that logic, or the string itself, is modified, this 195 ;; last. If that logic, or the string itself, is modified, this
190 ;; must be updated. 196 ;; must be updated.
197 :version "21.4"
191 :type 'regexp 198 :type 'regexp
192 :group 'starttls) 199 :group 'starttls)
193 200
diff --git a/lisp/help-at-pt.el b/lisp/help-at-pt.el
index d6ac6ec3fdc..2266c8d5a2a 100644
--- a/lisp/help-at-pt.el
+++ b/lisp/help-at-pt.el
@@ -1,6 +1,6 @@
1;;; help-at-pt.el --- local help through the keyboard 1;;; help-at-pt.el --- local help through the keyboard
2 2
3;; Copyright (C) 2003 Free Software Foundation, Inc. 3;; Copyright (C) 2003, 2004 Free Software Foundation, Inc.
4 4
5;; Author: Luc Teirlinck <teirllm@auburn.edu> 5;; Author: Luc Teirlinck <teirllm@auburn.edu>
6;; Keywords: help 6;; Keywords: help
@@ -98,6 +98,13 @@ mainly meant for use from Lisp."
98 (message "%s" help) 98 (message "%s" help)
99 (if (not arg) (message "No local help at point"))))) 99 (if (not arg) (message "No local help at point")))))
100 100
101(defvar help-at-pt-timer nil
102 "Non-nil means that a timer is set that checks for local help.
103If non-nil, this is the value returned by the call of
104`run-with-idle-timer' that set that timer. This variable is used
105internally to enable `help-at-pt-display-when-idle'. Do not set it
106yourself.")
107
101(defcustom help-at-pt-timer-delay 1 108(defcustom help-at-pt-timer-delay 1
102 "*Delay before displaying local help. 109 "*Delay before displaying local help.
103This is used if `help-at-pt-display-when-idle' is enabled. 110This is used if `help-at-pt-display-when-idle' is enabled.
@@ -112,17 +119,12 @@ active, but if one is already active, Custom will make it use the
112new value." 119new value."
113 :group 'help-at-pt 120 :group 'help-at-pt
114 :type 'number 121 :type 'number
122 :initialize 'custom-initialize-default
115 :set (lambda (variable value) 123 :set (lambda (variable value)
116 (set-default variable value) 124 (set-default variable value)
117 (when (and (boundp 'help-at-pt-timer) help-at-pt-timer) 125 (and (boundp 'help-at-pt-timer)
118 (timer-set-idle-time help-at-pt-timer value t)))) 126 help-at-pt-timer
119 127 (timer-set-idle-time help-at-pt-timer value t))))
120(defvar help-at-pt-timer nil
121 "Non-nil means that a timer is set that checks for local help.
122If non-nil, this is the value returned by the call of
123`run-with-idle-timer' that set that timer. This variable is used
124internally to enable `help-at-pt-display-when-idle'. Do not set it
125yourself.")
126 128
127;;;###autoload 129;;;###autoload
128(defun help-at-pt-cancel-timer () 130(defun help-at-pt-cancel-timer ()
@@ -144,7 +146,6 @@ This is done by setting a timer, if none is currently active."
144 (run-with-idle-timer 146 (run-with-idle-timer
145 help-at-pt-timer-delay t #'help-at-pt-maybe-display)))) 147 help-at-pt-timer-delay t #'help-at-pt-maybe-display))))
146 148
147;;;###autoload
148(defcustom help-at-pt-display-when-idle 'never 149(defcustom help-at-pt-display-when-idle 'never
149 "*Automatically show local help on point-over. 150 "*Automatically show local help on point-over.
150If the value is t, the string obtained from any `kbd-help' or 151If the value is t, the string obtained from any `kbd-help' or
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 57b0b39767e..8f2a1b7fa6e 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -473,7 +473,7 @@ Return 0 if there is no such symbol."
473 (and (symbolp obj) (boundp obj) obj)))) 473 (and (symbolp obj) (boundp obj) obj))))
474 (error nil)) 474 (error nil))
475 (let* ((str (find-tag-default)) 475 (let* ((str (find-tag-default))
476 (obj (if str (read str)))) 476 (obj (if str (intern str))))
477 (and (symbolp obj) (boundp obj) obj)) 477 (and (symbolp obj) (boundp obj) obj))
478 0)) 478 0))
479 479
diff --git a/lisp/help.el b/lisp/help.el
index ee35d007639..5ec9b1f5299 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -267,7 +267,7 @@ If that doesn't give a function, return nil."
267 (and (symbolp obj) (fboundp obj) obj)))) 267 (and (symbolp obj) (fboundp obj) obj))))
268 (error nil)))) 268 (error nil))))
269 (let* ((str (find-tag-default)) 269 (let* ((str (find-tag-default))
270 (obj (if str (read str)))) 270 (obj (if str (intern str))))
271 (and (symbolp obj) (fboundp obj) obj)))) 271 (and (symbolp obj) (fboundp obj) obj))))
272 272
273 273
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el
index 30c97a383d3..6dce953df0f 100644
--- a/lisp/ibuffer.el
+++ b/lisp/ibuffer.el
@@ -45,6 +45,7 @@
45Ibuffer allows you to operate on buffers in a manner much like Dired. 45Ibuffer allows you to operate on buffers in a manner much like Dired.
46Operations include sorting, marking by regular expression, and 46Operations include sorting, marking by regular expression, and
47the ability to filter the displayed buffers by various criteria." 47the ability to filter the displayed buffers by various criteria."
48 :version "21.4"
48 :group 'convenience) 49 :group 'convenience)
49 50
50(defcustom ibuffer-formats '((mark modified read-only " " (name 18 18 :left :elide) 51(defcustom ibuffer-formats '((mark modified read-only " " (name 18 18 :left :elide)
diff --git a/lisp/ido.el b/lisp/ido.el
index f9066544e1f..8d55887eae5 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -338,6 +338,7 @@
338 "Switch between files using substrings." 338 "Switch between files using substrings."
339 :group 'extensions 339 :group 'extensions
340 :group 'convenience 340 :group 'convenience
341 :version "21.4"
341 :link '(emacs-commentary-link :tag "Commentary" "ido.el") 342 :link '(emacs-commentary-link :tag "Commentary" "ido.el")
342 :link '(emacs-library-link :tag "Lisp File" "ido.el")) 343 :link '(emacs-library-link :tag "Lisp File" "ido.el"))
343 344
@@ -359,7 +360,6 @@ use either \\[customize] or the function `ido-mode'."
359 :require 'ido 360 :require 'ido
360 :link '(emacs-commentary-link "ido.el") 361 :link '(emacs-commentary-link "ido.el")
361 :set-after '(ido-save-directory-list-file) 362 :set-after '(ido-save-directory-list-file)
362 :version "21.4"
363 :type '(choice (const :tag "Turn on only buffer" buffer) 363 :type '(choice (const :tag "Turn on only buffer" buffer)
364 (const :tag "Turn on only file" file) 364 (const :tag "Turn on only file" file)
365 (const :tag "Turn on both buffer and file" both) 365 (const :tag "Turn on both buffer and file" both)
diff --git a/lisp/imenu.el b/lisp/imenu.el
index 924746f3bd1..7c775dc6337 100644
--- a/lisp/imenu.el
+++ b/lisp/imenu.el
@@ -161,16 +161,17 @@ element should come before the second. The arguments are cons cells;
161 :type 'integer 161 :type 'integer
162 :group 'imenu) 162 :group 'imenu)
163 163
164(defcustom imenu-scanning-message "Scanning buffer for index (%3d%%)" 164;; No longer used. KFS 2004-10-27
165 "*Progress message during the index scanning of the buffer. 165;; (defcustom imenu-scanning-message "Scanning buffer for index (%3d%%)"
166If non-nil, user gets a message during the scanning of the buffer. 166;; "*Progress message during the index scanning of the buffer.
167 167;; If non-nil, user gets a message during the scanning of the buffer.
168Relevant only if the mode-specific function that creates the buffer 168;;
169index use `imenu-progress-message', and not useful if that is fast, in 169;; Relevant only if the mode-specific function that creates the buffer
170which case you might as well set this to nil." 170;; index use `imenu-progress-message', and not useful if that is fast, in
171 :type '(choice string 171;; which case you might as well set this to nil."
172 (const :tag "None" nil)) 172;; :type '(choice string
173 :group 'imenu) 173;; (const :tag "None" nil))
174;; :group 'imenu)
174 175
175(defcustom imenu-space-replacement "." 176(defcustom imenu-space-replacement "."
176 "*The replacement string for spaces in index names. 177 "*The replacement string for spaces in index names.
@@ -300,16 +301,22 @@ The function in this variable is called when selecting a normal index-item.")
300;; is calculated. 301;; is calculated.
301;; PREVPOS is the variable in which we store the last position displayed. 302;; PREVPOS is the variable in which we store the last position displayed.
302(defmacro imenu-progress-message (prevpos &optional relpos reverse) 303(defmacro imenu-progress-message (prevpos &optional relpos reverse)
303 `(and 304
304 imenu-scanning-message 305;; Made obsolete/empty, as computers are now faster than the eye, and
305 (let ((pos ,(if relpos 306;; it had problems updating the messages correctly, and could shadow
306 relpos 307;; more important messages/prompts in the minibuffer. KFS 2004-10-27.
307 `(imenu--relative-position ,reverse)))) 308
308 (if ,(if relpos t 309;; `(and
309 `(> pos (+ 5 ,prevpos))) 310;; imenu-scanning-message
310 (progn 311;; (let ((pos ,(if relpos
311 (message imenu-scanning-message pos) 312;; relpos
312 (setq ,prevpos pos)))))) 313;; `(imenu--relative-position ,reverse))))
314;; (if ,(if relpos t
315;; `(> pos (+ 5 ,prevpos)))
316;; (progn
317;; (message imenu-scanning-message pos)
318;; (setq ,prevpos pos)))))
319)
313 320
314 321
315;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 322;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -765,7 +772,7 @@ the alist look like:
765 (INDEX-NAME . INDEX-POSITION) 772 (INDEX-NAME . INDEX-POSITION)
766or like: 773or like:
767 (INDEX-NAME INDEX-POSITION FUNCTION ARGUMENTS...) 774 (INDEX-NAME INDEX-POSITION FUNCTION ARGUMENTS...)
768They may also be nested index alists like: 775They may also be nested index alists like:
769 (INDEX-NAME . INDEX-ALIST) 776 (INDEX-NAME . INDEX-ALIST)
770depending on PATTERNS." 777depending on PATTERNS."
771 778
diff --git a/lisp/info.el b/lisp/info.el
index 4fc7b5c9cf7..2e0ddd0fb02 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -1980,7 +1980,7 @@ Because of ambiguities, this should be concatenated with something like
1980 (if (match-beginning 5) 1980 (if (match-beginning 5)
1981 (string-to-number (match-string 5)) 1981 (string-to-number (match-string 5))
1982 (buffer-substring (match-beginning 0) (1- (match-beginning 1))))) 1982 (buffer-substring (match-beginning 0) (1- (match-beginning 1)))))
1983;;; Comment out the next line to use names of cross-references: 1983;;; Uncomment next line to use names of cross-references in non-index nodes:
1984;;; (setq Info-point-loc 1984;;; (setq Info-point-loc
1985;;; (buffer-substring (match-beginning 0) (1- (match-beginning 1)))) 1985;;; (buffer-substring (match-beginning 0) (1- (match-beginning 1))))
1986 ) 1986 )
@@ -3214,7 +3214,7 @@ Allowed only if variable `Info-enable-edit' is non-nil."
3214 (message "Tags may have changed. Use Info-tagify if necessary"))) 3214 (message "Tags may have changed. Use Info-tagify if necessary")))
3215 3215
3216(defvar Info-file-list-for-emacs 3216(defvar Info-file-list-for-emacs
3217 '("ediff" "eudc" "forms" "gnus" "info" ("mh" . "mh-e") 3217 '("ediff" "eudc" "forms" "gnus" "info" ("Info" . "info") ("mh" . "mh-e")
3218 "sc" "message" ("dired" . "dired-x") "viper" "vip" "idlwave" 3218 "sc" "message" ("dired" . "dired-x") "viper" "vip" "idlwave"
3219 ("c" . "ccmode") ("c++" . "ccmode") ("objc" . "ccmode") 3219 ("c" . "ccmode") ("c++" . "ccmode") ("objc" . "ccmode")
3220 ("java" . "ccmode") ("idl" . "ccmode") ("pike" . "ccmode") 3220 ("java" . "ccmode") ("idl" . "ccmode") ("pike" . "ccmode")
@@ -3245,11 +3245,13 @@ The `info-file' property of COMMAND says which Info manual to search.
3245If COMMAND has no property, the variable `Info-file-list-for-emacs' 3245If COMMAND has no property, the variable `Info-file-list-for-emacs'
3246defines heuristics for which Info manual to try. 3246defines heuristics for which Info manual to try.
3247The locations are of the format used in `Info-history', i.e. 3247The locations are of the format used in `Info-history', i.e.
3248\(FILENAME NODENAME BUFFERPOS\)." 3248\(FILENAME NODENAME BUFFERPOS\), where BUFFERPOS is the line number
3249 (let ((where '()) 3249in the first element of the returned list (which is treated specially in
3250`Info-goto-emacs-command-node'), and 0 for the rest elements of a list."
3251 (let ((where '()) line-number
3250 (cmd-desc (concat "^\\* +" (regexp-quote (symbol-name command)) 3252 (cmd-desc (concat "^\\* +" (regexp-quote (symbol-name command))
3251 "\\( <[0-9]+>\\)?:\\s *\\(.*\\)\\." 3253 "\\( <[0-9]+>\\)?:\\s *\\(.*\\)\\."
3252 "\\([ \t]*(line[ \t]*[0-9]*)\\)?$")) 3254 "\\(?:[ \t\n]+(line +\\([0-9]+\\))\\)?"))
3253 (info-file "emacs")) ;default 3255 (info-file "emacs")) ;default
3254 ;; Determine which info file this command is documented in. 3256 ;; Determine which info file this command is documented in.
3255 (if (get command 'info-file) 3257 (if (get command 'info-file)
@@ -3288,11 +3290,17 @@ The locations are of the format used in `Info-history', i.e.
3288 (cons (list Info-current-file 3290 (cons (list Info-current-file
3289 (match-string-no-properties 2) 3291 (match-string-no-properties 2)
3290 0) 3292 0)
3291 where))) 3293 where))
3294 (setq line-number (and (match-beginning 3)
3295 (string-to-number (match-string 3)))))
3292 (and (setq nodes (cdr nodes) node (car nodes)))) 3296 (and (setq nodes (cdr nodes) node (car nodes))))
3293 (Info-goto-node node))) 3297 (Info-goto-node node)))
3294 where)) 3298 (if (and line-number where)
3299 (cons (list (nth 0 (car where)) (nth 1 (car where)) line-number)
3300 (cdr where))
3301 where)))
3295 3302
3303;;;###autoload (put 'Info-goto-emacs-command-node 'info-file "emacs")
3296;;;###autoload 3304;;;###autoload
3297(defun Info-goto-emacs-command-node (command) 3305(defun Info-goto-emacs-command-node (command)
3298 "Go to the Info node in the Emacs manual for command COMMAND. 3306 "Go to the Info node in the Emacs manual for command COMMAND.
@@ -3316,9 +3324,11 @@ COMMAND must be a symbol or string."
3316 ;; Bind Info-history to nil, to prevent the last Index node 3324 ;; Bind Info-history to nil, to prevent the last Index node
3317 ;; visited by Info-find-emacs-command-nodes from being 3325 ;; visited by Info-find-emacs-command-nodes from being
3318 ;; pushed onto the history. 3326 ;; pushed onto the history.
3319 (let ((Info-history nil) (Info-history-list nil)) 3327 (let ((Info-history nil) (Info-history-list nil)
3320 (Info-find-node (car (car where)) 3328 (line-number (nth 2 (car where))))
3321 (car (cdr (car where))))) 3329 (Info-find-node (nth 0 (car where)) (nth 1 (car where)))
3330 (if (and (integerp line-number) (> line-number 0))
3331 (forward-line (1- line-number))))
3322 (if (> num-matches 1) 3332 (if (> num-matches 1)
3323 (progn 3333 (progn
3324 ;; (car where) will be pushed onto Info-history 3334 ;; (car where) will be pushed onto Info-history
@@ -3332,6 +3342,7 @@ COMMAND must be a symbol or string."
3332 (if (> num-matches 2) "them" "it"))))) 3342 (if (> num-matches 2) "them" "it")))))
3333 (error "Couldn't find documentation for %s" command)))) 3343 (error "Couldn't find documentation for %s" command))))
3334 3344
3345;;;###autoload (put 'Info-goto-emacs-key-command-node 'info-file "emacs")
3335;;;###autoload 3346;;;###autoload
3336(defun Info-goto-emacs-key-command-node (key) 3347(defun Info-goto-emacs-key-command-node (key)
3337 "Go to the node in the Emacs manual which describes the command bound to KEY. 3348 "Go to the node in the Emacs manual which describes the command bound to KEY.
diff --git a/lisp/kmacro.el b/lisp/kmacro.el
index 2b4cbcaf323..9ee34a8432c 100644
--- a/lisp/kmacro.el
+++ b/lisp/kmacro.el
@@ -1,6 +1,6 @@
1;;; kmacro.el --- enhanced keyboard macros 1;;; kmacro.el --- enhanced keyboard macros
2 2
3;; Copyright (C) 2002 Free Software Foundation, Inc. 3;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
4 4
5;; Author: Kim F. Storm <storm@cua.dk> 5;; Author: Kim F. Storm <storm@cua.dk>
6;; Keywords: keyboard convenience 6;; Keywords: keyboard convenience
@@ -120,6 +120,7 @@
120 "Simplified keyboard macro user interface." 120 "Simplified keyboard macro user interface."
121 :group 'keyboard 121 :group 'keyboard
122 :group 'convenience 122 :group 'convenience
123 :version "21.4"
123 :link '(emacs-commentary-link :tag "Commentary" "kmacro.el") 124 :link '(emacs-commentary-link :tag "Commentary" "kmacro.el")
124 :link '(emacs-library-link :tag "Lisp File" "kmacro.el")) 125 :link '(emacs-library-link :tag "Lisp File" "kmacro.el"))
125 126
@@ -222,6 +223,14 @@ macro to be executed before appending to it."
222 (global-set-key (vector kmacro-call-mouse-event) 'kmacro-end-call-mouse)) 223 (global-set-key (vector kmacro-call-mouse-event) 'kmacro-end-call-mouse))
223 224
224 225
226;;; Called from keyboard-quit
227
228(defun kmacro-keyboard-quit ()
229 (or (not defining-kbd-macro)
230 (eq defining-kbd-macro 'append)
231 (kmacro-ring-empty-p)
232 (kmacro-pop-ring)))
233
225 234
226;;; Keyboard macro counter 235;;; Keyboard macro counter
227 236
@@ -585,7 +594,9 @@ Use \\[kmacro-bind-to-key] to bind it to a key sequence."
585 (and append 594 (and append
586 (if kmacro-execute-before-append 595 (if kmacro-execute-before-append
587 (> (car arg) 4) 596 (> (car arg) 4)
588 (= (car arg) 4))))))) 597 (= (car arg) 4))))
598 (if (and defining-kbd-macro append)
599 (setq defining-kbd-macro 'append)))))
589 600
590 601
591;;;###autoload 602;;;###autoload
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el
index e93f76c3042..c5579b3c0db 100644
--- a/lisp/mail/emacsbug.el
+++ b/lisp/mail/emacsbug.el
@@ -128,6 +128,9 @@ usually do not have translators to read other languages for them.\n\n")
128 (insert "\n\n\n") 128 (insert "\n\n\n")
129 129
130 (insert "In " (emacs-version) "\n") 130 (insert "In " (emacs-version) "\n")
131 (if (fboundp 'x-server-vendor)
132 (insert "Distributor `" (x-server-vendor) "', version "
133 (mapconcat 'number-to-string (x-server-version) ".") "\n"))
131 (if (and system-configuration-options 134 (if (and system-configuration-options
132 (not (equal system-configuration-options ""))) 135 (not (equal system-configuration-options "")))
133 (insert "configured using `configure " 136 (insert "configured using `configure "
diff --git a/lisp/makefile.w32-in b/lisp/makefile.w32-in
index e23830bc210..c0d5b4c7683 100644
--- a/lisp/makefile.w32-in
+++ b/lisp/makefile.w32-in
@@ -171,7 +171,7 @@ cus-load.el:
171 touch $@ 171 touch $@
172custom-deps: cus-load.el doit 172custom-deps: cus-load.el doit
173 @echo Directories: $(WINS) 173 @echo Directories: $(WINS)
174 -$(emacs) -l cus-dep --eval $(ARGQUOTE)(setq find-file-hooks nil)$(ARGQUOTE) -f custom-make-dependencies $(lisp) $(WINS) 174 -$(emacs) -l cus-dep --eval $(ARGQUOTE)(setq find-file-hook nil)$(ARGQUOTE) -f custom-make-dependencies $(lisp) $(WINS)
175 175
176finder-data: doit 176finder-data: doit
177 @echo Directories: $(WINS) 177 @echo Directories: $(WINS)
@@ -221,7 +221,7 @@ loaddefs.el-CMD:
221autoloads: loaddefs.el doit 221autoloads: loaddefs.el doit
222 @echo Directories: $(WINS) 222 @echo Directories: $(WINS)
223 $(emacs) -l autoload \ 223 $(emacs) -l autoload \
224 --eval $(ARGQUOTE)(setq find-file-hooks nil \ 224 --eval $(ARGQUOTE)(setq find-file-hook nil \
225 find-file-suppress-same-file-warnings t \ 225 find-file-suppress-same-file-warnings t \
226 generated-autoload-file \ 226 generated-autoload-file \
227 $(DQUOTE)$(lisp)/loaddefs.el$(DQUOTE))$(ARGQUOTE) \ 227 $(DQUOTE)$(lisp)/loaddefs.el$(DQUOTE))$(ARGQUOTE) \
diff --git a/lisp/man.el b/lisp/man.el
index afd183fa720..e4573748fcb 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -426,7 +426,7 @@ Otherwise, the value is whatever the function
426 (view-file f) 426 (view-file f)
427 (error "Cannot read a file: %s" f)) 427 (error "Cannot read a file: %s" f))
428 (error "Cannot find a file: %s" f)))) 428 (error "Cannot find a file: %s" f))))
429 'help-echo "mouse-2: mouse-2: display this file") 429 'help-echo "mouse-2: display this file")
430 430
431 431
432;; ====================================================================== 432;; ======================================================================
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 22840896c17..2c1d37c80e2 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -186,10 +186,15 @@ A large number or nil slows down menu responsiveness."
186 '(menu-item "Open Directory..." dired 186 '(menu-item "Open Directory..." dired
187 :help "Read a directory, operate on its files")) 187 :help "Read a directory, operate on its files"))
188(define-key menu-bar-files-menu [open-file] 188(define-key menu-bar-files-menu [open-file]
189 '(menu-item "Open File..." find-file 189 '(menu-item "Open File..." find-file-existing
190 :enable (not (window-minibuffer-p 190 :enable (not (window-minibuffer-p
191 (frame-selected-window menu-updating-frame))) 191 (frame-selected-window menu-updating-frame)))
192 :help "Read a file into an Emacs buffer")) 192 :help "Read an existing file into an Emacs buffer"))
193(define-key menu-bar-files-menu [new-file]
194 '(menu-item "New File..." find-file
195 :enable (not (window-minibuffer-p
196 (frame-selected-window menu-updating-frame)))
197 :help "Read or create a file and edit it"))
193 198
194 199
195;; The "Edit" menu items 200;; The "Edit" menu items
diff --git a/lisp/mouse-sel.el b/lisp/mouse-sel.el
index b6f4558f280..4f3741a5213 100644
--- a/lisp/mouse-sel.el
+++ b/lisp/mouse-sel.el
@@ -1,6 +1,7 @@
1;;; mouse-sel.el --- multi-click selection support for Emacs 19 1;;; mouse-sel.el --- multi-click selection support for Emacs 19
2 2
3;; Copyright (C) 1993,1994,1995,2001,2002 Free Software Foundation, Inc. 3;; Copyright (C) 1993, 1994, 1995, 2001, 2002, 2004
4;; Free Software Foundation, Inc.
4 5
5;; Author: Mike Williams <mdub@bigfoot.com> 6;; Author: Mike Williams <mdub@bigfoot.com>
6;; Keywords: mouse 7;; Keywords: mouse
@@ -243,7 +244,7 @@ primary selection and region."
243 :group 'mouse-sel 244 :group 'mouse-sel
244 (if mouse-sel-mode 245 (if mouse-sel-mode
245 (progn 246 (progn
246 (add-hook 'x-lost-selection-hooks 'mouse-sel-lost-selection-hook) 247 (add-hook 'x-lost-selection-functions 'mouse-sel-lost-selection-hook)
247 (when mouse-sel-default-bindings 248 (when mouse-sel-default-bindings
248 ;; Save original bindings and replace them with new ones. 249 ;; Save original bindings and replace them with new ones.
249 (setq mouse-sel-original-bindings 250 (setq mouse-sel-original-bindings
@@ -263,7 +264,7 @@ primary selection and region."
263 interprogram-paste-function nil)))) 264 interprogram-paste-function nil))))
264 265
265 ;; Restore original bindings 266 ;; Restore original bindings
266 (remove-hook 'x-lost-selection-hooks 'mouse-sel-lost-selection-hook) 267 (remove-hook 'x-lost-selection-functions 'mouse-sel-lost-selection-hook)
267 (dolist (binding mouse-sel-original-bindings) 268 (dolist (binding mouse-sel-original-bindings)
268 (global-set-key (car binding) (cdr binding))) 269 (global-set-key (car binding) (cdr binding)))
269 ;; Restore the old values of these variables, 270 ;; Restore the old values of these variables,
@@ -712,5 +713,5 @@ If `mouse-yank-at-point' is non-nil, insert at point instead."
712 713
713(provide 'mouse-sel) 714(provide 'mouse-sel)
714 715
715;;; arch-tag: 86e6c73f-deaa-48d3-a24e-c565fda1f7d7 716;; arch-tag: 86e6c73f-deaa-48d3-a24e-c565fda1f7d7
716;;; mouse-sel.el ends here 717;;; mouse-sel.el ends here
diff --git a/lisp/mouse.el b/lisp/mouse.el
index abf62a97836..2a467aa8069 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -1025,54 +1025,56 @@ If MODE is 2 then do the same for lines."
1025 "List of keys which shall cause the mouse region to be deleted.") 1025 "List of keys which shall cause the mouse region to be deleted.")
1026 1026
1027(defun mouse-show-mark () 1027(defun mouse-show-mark ()
1028 (if transient-mark-mode 1028 (let ((inhibit-quit t)
1029 (delete-overlay mouse-drag-overlay) 1029 (echo-keystrokes 0)
1030 (let ((inhibit-quit t) 1030 event events key ignore
1031 (echo-keystrokes 0) 1031 (x-lost-selection-functions
1032 event events key ignore 1032 (when (boundp 'x-lost-selection-functions)
1033 x-lost-selection-hooks) 1033 (copy-sequence x-lost-selection-functions))))
1034 (add-hook 'x-lost-selection-hooks 1034 (add-hook 'x-lost-selection-functions
1035 (lambda (seltype) 1035 (lambda (seltype)
1036 (if (eq seltype 'PRIMARY) 1036 (when (eq seltype 'PRIMARY)
1037 (progn (setq ignore t) 1037 (setq ignore t)
1038 (throw 'mouse-show-mark t))))) 1038 (throw 'mouse-show-mark t))))
1039 (move-overlay mouse-drag-overlay (point) (mark t)) 1039 (if transient-mark-mode
1040 (catch 'mouse-show-mark 1040 (delete-overlay mouse-drag-overlay)
1041 ;; In this loop, execute scroll bar and switch-frame events. 1041 (move-overlay mouse-drag-overlay (point) (mark t)))
1042 ;; Also ignore down-events that are undefined. 1042 (catch 'mouse-show-mark
1043 (while (progn (setq event (read-event)) 1043 ;; In this loop, execute scroll bar and switch-frame events.
1044 (setq events (append events (list event))) 1044 ;; Also ignore down-events that are undefined.
1045 (setq key (apply 'vector events)) 1045 (while (progn (setq event (read-event))
1046 (or (and (consp event) 1046 (setq events (append events (list event)))
1047 (eq (car event) 'switch-frame)) 1047 (setq key (apply 'vector events))
1048 (and (consp event) 1048 (or (and (consp event)
1049 (eq (posn-point (event-end event)) 1049 (eq (car event) 'switch-frame))
1050 'vertical-scroll-bar)) 1050 (and (consp event)
1051 (and (memq 'down (event-modifiers event)) 1051 (eq (posn-point (event-end event))
1052 (not (key-binding key)) 1052 'vertical-scroll-bar))
1053 (not (mouse-undouble-last-event events)) 1053 (and (memq 'down (event-modifiers event))
1054 (not (member key mouse-region-delete-keys))))) 1054 (not (key-binding key))
1055 (and (consp event) 1055 (not (mouse-undouble-last-event events))
1056 (or (eq (car event) 'switch-frame) 1056 (not (member key mouse-region-delete-keys)))))
1057 (eq (posn-point (event-end event)) 1057 (and (consp event)
1058 'vertical-scroll-bar)) 1058 (or (eq (car event) 'switch-frame)
1059 (let ((keys (vector 'vertical-scroll-bar event))) 1059 (eq (posn-point (event-end event))
1060 (and (key-binding keys) 1060 'vertical-scroll-bar))
1061 (progn 1061 (let ((keys (vector 'vertical-scroll-bar event)))
1062 (call-interactively (key-binding keys) 1062 (and (key-binding keys)
1063 nil keys) 1063 (progn
1064 (setq events nil))))))) 1064 (call-interactively (key-binding keys)
1065 ;; If we lost the selection, just turn off the highlighting. 1065 nil keys)
1066 (if ignore 1066 (setq events nil)))))))
1067 nil 1067 ;; If we lost the selection, just turn off the highlighting.
1068 ;; For certain special keys, delete the region. 1068 (unless ignore
1069 (if (member key mouse-region-delete-keys) 1069 ;; For certain special keys, delete the region.
1070 (delete-region (overlay-start mouse-drag-overlay) 1070 (if (member key mouse-region-delete-keys)
1071 (overlay-end mouse-drag-overlay)) 1071 (delete-region (overlay-start mouse-drag-overlay)
1072 ;; Otherwise, unread the key so it gets executed normally. 1072 (overlay-end mouse-drag-overlay))
1073 (setq unread-command-events 1073 ;; Otherwise, unread the key so it gets executed normally.
1074 (nconc events unread-command-events)))) 1074 (setq unread-command-events
1075 (setq quit-flag nil) 1075 (nconc events unread-command-events))))
1076 (setq quit-flag nil)
1077 (unless transient-mark-mode
1076 (delete-overlay mouse-drag-overlay)))) 1078 (delete-overlay mouse-drag-overlay))))
1077 1079
1078(defun mouse-set-mark (click) 1080(defun mouse-set-mark (click)
@@ -1110,7 +1112,7 @@ and set mark at the beginning.
1110Prefix arguments are interpreted as with \\[yank]. 1112Prefix arguments are interpreted as with \\[yank].
1111If `mouse-yank-at-point' is non-nil, insert at point 1113If `mouse-yank-at-point' is non-nil, insert at point
1112regardless of where you click." 1114regardless of where you click."
1113 (interactive "*e\nP") 1115 (interactive "e\nP")
1114 ;; Give temporary modes such as isearch a chance to turn off. 1116 ;; Give temporary modes such as isearch a chance to turn off.
1115 (run-hooks 'mouse-leave-buffer-hook) 1117 (run-hooks 'mouse-leave-buffer-hook)
1116 (or mouse-yank-at-point (mouse-set-point click)) 1118 (or mouse-yank-at-point (mouse-set-point click))
@@ -1412,7 +1414,7 @@ The function returns a non-nil value if it creates a secondary selection."
1412Move point to the end of the inserted text. 1414Move point to the end of the inserted text.
1413If `mouse-yank-at-point' is non-nil, insert at point 1415If `mouse-yank-at-point' is non-nil, insert at point
1414regardless of where you click." 1416regardless of where you click."
1415 (interactive "*e") 1417 (interactive "e")
1416 ;; Give temporary modes such as isearch a chance to turn off. 1418 ;; Give temporary modes such as isearch a chance to turn off.
1417 (run-hooks 'mouse-leave-buffer-hook) 1419 (run-hooks 'mouse-leave-buffer-hook)
1418 (or mouse-yank-at-point (mouse-set-point click)) 1420 (or mouse-yank-at-point (mouse-set-point click))
diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el
index 6d12d5e6364..bcdd1d195bf 100644
--- a/lisp/net/eudc.el
+++ b/lisp/net/eudc.el
@@ -462,73 +462,73 @@ attribute name ATTR."
462 "Display the record list RECORDS in a formatted buffer. 462 "Display the record list RECORDS in a formatted buffer.
463If RAW-ATTR-NAMES is non-nil, the raw attribute names are displayed 463If RAW-ATTR-NAMES is non-nil, the raw attribute names are displayed
464otherwise they are formatted according to `eudc-user-attribute-names-alist'." 464otherwise they are formatted according to `eudc-user-attribute-names-alist'."
465 (let ((buffer (get-buffer-create "*Directory Query Results*")) 465 (let (inhibit-read-only
466 inhibit-read-only
467 precords 466 precords
468 (width 0) 467 (width 0)
469 beg 468 beg
470 first-record 469 first-record
471 attribute-name) 470 attribute-name)
472 (switch-to-buffer buffer) 471 (with-output-to-temp-buffer "*Directory Query Results*"
473 (setq buffer-read-only t) 472 (with-current-buffer standard-output
474 (setq inhibit-read-only t) 473 (setq buffer-read-only t)
475 (erase-buffer) 474 (setq inhibit-read-only t)
476 (insert "Directory Query Result\n") 475 (erase-buffer)
477 (insert "======================\n\n\n") 476 (insert "Directory Query Result\n")
478 (if (null records) 477 (insert "======================\n\n\n")
479 (insert "No match found.\n" 478 (if (null records)
480 (if eudc-strict-return-matches 479 (insert "No match found.\n"
481 "Try setting `eudc-strict-return-matches' to nil or change `eudc-default-return-attributes'.\n" 480 (if eudc-strict-return-matches
482 "")) 481 "Try setting `eudc-strict-return-matches' to nil or change `eudc-default-return-attributes'.\n"
483 ;; Replace field names with user names, compute max width 482 ""))
484 (setq precords 483 ;; Replace field names with user names, compute max width
485 (mapcar 484 (setq precords
486 (function
487 (lambda (record)
488 (mapcar 485 (mapcar
489 (function 486 (function
490 (lambda (field) 487 (lambda (record)
491 (setq attribute-name 488 (mapcar
492 (if raw-attr-names 489 (function
493 (symbol-name (car field)) 490 (lambda (field)
494 (eudc-format-attribute-name-for-display (car field)))) 491 (setq attribute-name
495 (if (> (length attribute-name) width) 492 (if raw-attr-names
496 (setq width (length attribute-name))) 493 (symbol-name (car field))
497 (cons attribute-name (cdr field)))) 494 (eudc-format-attribute-name-for-display (car field))))
498 record))) 495 (if (> (length attribute-name) width)
499 records)) 496 (setq width (length attribute-name)))
500 ;; Display the records 497 (cons attribute-name (cdr field))))
501 (setq first-record (point)) 498 record)))
502 (mapcar 499 records))
503 (function 500 ;; Display the records
504 (lambda (record) 501 (setq first-record (point))
505 (setq beg (point)) 502 (mapcar
506 ;; Map over the record fields to print the attribute/value pairs 503 (function
507 (mapcar (function 504 (lambda (record)
508 (lambda (field) 505 (setq beg (point))
509 (eudc-print-record-field field width))) 506 ;; Map over the record fields to print the attribute/value pairs
510 record) 507 (mapcar (function
511 ;; Store the record internal format in some convenient place 508 (lambda (field)
512 (overlay-put (make-overlay beg (point)) 509 (eudc-print-record-field field width)))
513 'eudc-record 510 record)
514 (car records)) 511 ;; Store the record internal format in some convenient place
515 (setq records (cdr records)) 512 (overlay-put (make-overlay beg (point))
516 (insert "\n"))) 513 'eudc-record
517 precords)) 514 (car records))
518 (insert "\n") 515 (setq records (cdr records))
519 (widget-create 'push-button 516 (insert "\n")))
520 :notify (lambda (&rest ignore) 517 precords))
521 (eudc-query-form)) 518 (insert "\n")
522 "New query") 519 (widget-create 'push-button
523 (widget-insert " ") 520 :notify (lambda (&rest ignore)
524 (widget-create 'push-button 521 (eudc-query-form))
525 :notify (lambda (&rest ignore) 522 "New query")
526 (kill-this-buffer)) 523 (widget-insert " ")
527 "Quit") 524 (widget-create 'push-button
528 (eudc-mode) 525 :notify (lambda (&rest ignore)
529 (widget-setup) 526 (kill-this-buffer))
530 (if first-record 527 "Quit")
531 (goto-char first-record)))) 528 (eudc-mode)
529 (widget-setup)
530 (if first-record
531 (goto-char first-record))))))
532 532
533(defun eudc-process-form () 533(defun eudc-process-form ()
534 "Process the query form in current buffer and display the results." 534 "Process the query form in current buffer and display the results."
@@ -709,34 +709,36 @@ server for future sessions."
709 (eudc-save-options))) 709 (eudc-save-options)))
710 710
711;;;###autoload 711;;;###autoload
712(defun eudc-get-email (name) 712(defun eudc-get-email (name &optional error)
713 "Get the email field of NAME from the directory server." 713 "Get the email field of NAME from the directory server.
714 (interactive "sName: ") 714If ERROR is non-nil, report an error if there is none."
715 (interactive "sName: \np")
715 (or eudc-server 716 (or eudc-server
716 (call-interactively 'eudc-set-server)) 717 (call-interactively 'eudc-set-server))
717 (let ((result (eudc-query (list (cons 'name name)) '(email))) 718 (let ((result (eudc-query (list (cons 'name name)) '(email)))
718 email) 719 email)
719 (if (null (cdr result)) 720 (if (null (cdr result))
720 (setq email (eudc-cdaar result)) 721 (setq email (eudc-cdaar result))
721 (error "Multiple match. Use the query form")) 722 (error "Multiple match--use the query form"))
722 (if (interactive-p) 723 (if error
723 (if email 724 (if email
724 (message "%s" email) 725 (message "%s" email)
725 (error "No record matching %s" name))) 726 (error "No record matching %s" name)))
726 email)) 727 email))
727 728
728;;;###autoload 729;;;###autoload
729(defun eudc-get-phone (name) 730(defun eudc-get-phone (name &optional error)
730 "Get the phone field of NAME from the directory server." 731 "Get the phone field of NAME from the directory server.
731 (interactive "sName: ") 732If ERROR is non-nil, report an error if there is none."
733 (interactive "sName: \np")
732 (or eudc-server 734 (or eudc-server
733 (call-interactively 'eudc-set-server)) 735 (call-interactively 'eudc-set-server))
734 (let ((result (eudc-query (list (cons 'name name)) '(phone))) 736 (let ((result (eudc-query (list (cons 'name name)) '(phone)))
735 phone) 737 phone)
736 (if (null (cdr result)) 738 (if (null (cdr result))
737 (setq phone (eudc-cdaar result)) 739 (setq phone (eudc-cdaar result))
738 (error "Multiple match. Use the query form")) 740 (error "Multiple match--use the query form"))
739 (if (interactive-p) 741 (if error
740 (if phone 742 (if phone
741 (message "%s" phone) 743 (message "%s" phone)
742 (error "No record matching %s" name))) 744 (error "No record matching %s" name)))
diff --git a/lisp/net/password.el b/lisp/net/password.el
deleted file mode 100644
index da009ed9ea0..00000000000
--- a/lisp/net/password.el
+++ /dev/null
@@ -1,184 +0,0 @@
1;;; password.el --- Read passwords from user, possibly using a password cache.
2
3;; Copyright (C) 1999, 2000, 2003, 2004 Free Software Foundation, Inc.
4
5;; Author: Simon Josefsson <simon@josefsson.org>
6;; Created: 2003-12-21
7;; Keywords: password cache passphrase key
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 2, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING. If not, write to the
23;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24;; Boston, MA 02111-1307, USA.
25
26;;; Commentary:
27
28;; Greatly influenced by pgg.el written by Daiki Ueno, with timer
29;; fixes for XEmacs by Katsumi Yamaoka. In fact, this is mostly just
30;; a rip-off.
31;;
32;; (password-read "Password? " "test")
33;; ;; Minibuffer prompt for password.
34;; => "foo"
35;;
36;; (password-cache-add "test" "foo")
37;; => nil
38
39;; Note the previous two can be replaced with:
40;; (password-read-and-add "Password? " "test")
41;; ;; Minibuffer prompt for password.
42;; => "foo"
43;; ;; "foo" is now cached with key "test"
44
45
46;; (password-read "Password? " "test")
47;; ;; No minibuffer prompt
48;; => "foo"
49;;
50;; (password-read "Password? " "test")
51;; ;; No minibuffer prompt
52;; => "foo"
53;;
54;; ;; Wait `password-cache-expiry' seconds.
55;;
56;; (password-read "Password? " "test")
57;; ;; Minibuffer prompt for password is back.
58;; => "foo"
59
60;;; Code:
61
62(when (featurep 'xemacs)
63 (require 'run-at-time))
64
65(eval-when-compile
66 (require 'cl))
67
68(defcustom password-cache t
69 "Whether to cache passwords."
70 :group 'password
71 :type 'boolean)
72
73(defcustom password-cache-expiry 16
74 "How many seconds passwords are cached, or nil to disable expiring.
75Whether passwords are cached at all is controlled by `password-cache'."
76 :group 'password
77 :type '(choice (const :tag "Never" nil)
78 (integer :tag "Seconds")))
79
80(defvar password-data (make-vector 7 0))
81
82(defun password-read (prompt &optional key)
83 "Read password, for use with KEY, from user, or from cache if wanted.
84KEY indicate the purpose of the password, so the cache can
85separate passwords. The cache is not used if KEY is nil. It is
86typically a string.
87The variable `password-cache' control whether the cache is used."
88 (or (and password-cache
89 key
90 (symbol-value (intern-soft key password-data)))
91 (read-passwd prompt)))
92
93(defun password-read-and-add (prompt &optional key)
94 "Read password, for use with KEY, from user, or from cache if wanted.
95Then store the password in the cache. Uses `password-read' and
96`password-cache-add'."
97 (let ((password (password-read prompt key)))
98 (when (and password key)
99 (password-cache-add key password))
100 password))
101
102(defun password-cache-remove (key)
103 "Remove password indexed by KEY from password cache.
104This is typically run be a timer setup from `password-cache-add',
105but can be invoked at any time to forcefully remove passwords
106from the cache. This may be useful when it has been detected
107that a password is invalid, so that `password-read' query the
108user again."
109 (let ((password (symbol-value (intern-soft key password-data))))
110 (when password
111 (fillarray password ?_)
112 (unintern key password-data))))
113
114(defun password-cache-add (key password)
115 "Add password to cache.
116The password is removed by a timer after `password-cache-expiry'
117seconds."
118 (set (intern key password-data) password)
119 (when password-cache-expiry
120 (run-at-time password-cache-expiry nil
121 #'password-cache-remove
122 key))
123 nil)
124
125;;;###autoload
126(defun read-passwd (prompt &optional confirm default)
127 "Read a password, prompting with PROMPT, and return it.
128If optional CONFIRM is non-nil, read the password twice to make sure.
129Optional DEFAULT is a default password to use instead of empty input.
130
131This function echoes `.' for each character that the user types.
132The user ends with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line.
133C-g quits; if `inhibit-quit' was non-nil around this function,
134then it returns nil if the user types C-g.
135
136Once the caller uses the password, it can erase the password
137by doing (clear-string STRING)."
138 (with-local-quit
139 (if confirm
140 (let (success)
141 (while (not success)
142 (let ((first (read-passwd prompt nil default))
143 (second (read-passwd "Confirm password: " nil default)))
144 (if (equal first second)
145 (progn
146 (and (arrayp second) (clear-string second))
147 (setq success first))
148 (and (arrayp first) (clear-string first))
149 (and (arrayp second) (clear-string second))
150 (message "Password not repeated accurately; please start over")
151 (sit-for 1))))
152 success)
153 (let ((pass nil)
154 (c 0)
155 (echo-keystrokes 0)
156 (cursor-in-echo-area t))
157 (while (progn (message "%s%s"
158 prompt
159 (make-string (length pass) ?.))
160 (setq c (read-char-exclusive nil t))
161 (and (/= c ?\r) (/= c ?\n) (/= c ?\e)))
162 (clear-this-command-keys)
163 (if (= c ?\C-u)
164 (progn
165 (and (arrayp pass) (clear-string pass))
166 (setq pass ""))
167 (if (and (/= c ?\b) (/= c ?\177))
168 (let* ((new-char (char-to-string c))
169 (new-pass (concat pass new-char)))
170 (and (arrayp pass) (clear-string pass))
171 (clear-string new-char)
172 (setq c ?\0)
173 (setq pass new-pass))
174 (if (> (length pass) 0)
175 (let ((new-pass (substring pass 0 -1)))
176 (and (arrayp pass) (clear-string pass))
177 (setq pass new-pass))))))
178 (message nil)
179 (or pass default "")))))
180
181(provide 'password)
182
183;;; arch-tag: ab160494-16c8-4c68-a4a1-73eebf6686e5
184;;; password.el ends here
diff --git a/lisp/net/tls.el b/lisp/net/tls.el
index 5f57c084f9b..1b58760c17c 100644
--- a/lisp/net/tls.el
+++ b/lisp/net/tls.el
@@ -67,18 +67,21 @@ after successful negotiation."
67 67
68(defcustom tls-process-connection-type nil 68(defcustom tls-process-connection-type nil
69 "*Value for `process-connection-type' to use when starting TLS process." 69 "*Value for `process-connection-type' to use when starting TLS process."
70 :version "21.4"
70 :type 'boolean 71 :type 'boolean
71 :group 'tls) 72 :group 'tls)
72 73
73(defcustom tls-success "- Handshake was completed" 74(defcustom tls-success "- Handshake was completed"
74 "*Regular expression indicating completed TLS handshakes. 75 "*Regular expression indicating completed TLS handshakes.
75The default is what GNUTLS's \"gnutls-cli\" outputs." 76The default is what GNUTLS's \"gnutls-cli\" outputs."
77 :version "21.4"
76 :type 'regexp 78 :type 'regexp
77 :group 'tls) 79 :group 'tls)
78 80
79(defcustom tls-certtool-program (executable-find "certtool") 81(defcustom tls-certtool-program (executable-find "certtool")
80 "Name of GnuTLS certtool. 82 "Name of GnuTLS certtool.
81Used by `tls-certificate-information'." 83Used by `tls-certificate-information'."
84 :version "21.4"
82 :type '(repeat string) 85 :type '(repeat string)
83 :group 'tls) 86 :group 'tls)
84 87
diff --git a/lisp/obsolete/hilit19.el b/lisp/obsolete/hilit19.el
index 4d8af4b5a2b..a5fd33adcaa 100644
--- a/lisp/obsolete/hilit19.el
+++ b/lisp/obsolete/hilit19.el
@@ -1,6 +1,6 @@
1;;; hilit19.el --- customizable highlighting for Emacs 19 1;;; hilit19.el --- customizable highlighting for Emacs 19
2 2
3;; Copyright (c) 1993, 1994, 2001 Free Software Foundation, Inc. 3;; Copyright (c) 1993, 1994, 2001, 2004 Free Software Foundation, Inc.
4 4
5;; Author: Jonathan Stigelman <stig@hackvan.com> 5;; Author: Jonathan Stigelman <stig@hackvan.com>
6;; Maintainer: FSF 6;; Maintainer: FSF
@@ -397,8 +397,6 @@ See the hilit-lookup-face-create documentation for valid face names.")
397If hilit19 is dumped into emacs at your site, you may have to set this in 397If hilit19 is dumped into emacs at your site, you may have to set this in
398your init file.") 398your init file.")
399 399
400(eval-when-compile (setq byte-optimize t))
401
402;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 400;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
403;; Use this to report bugs: 401;; Use this to report bugs:
404 402
@@ -945,47 +943,61 @@ the entire buffer is forced."
945;; Initialization. 943;; Initialization.
946;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 944;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
947 945
948(and (not hilit-inhibit-rebinding) 946(define-minor-mode hilit-mode
949 (progn 947 "Obsolete minor mode. Use `global-font-lock-mode' instead."
950 (substitute-key-definition 'yank 'hilit-yank 948 :global t
951 (current-global-map)) 949
952 (substitute-key-definition 'yank-pop 'hilit-yank-pop 950 (unless (and hilit-inhibit-rebinding hilit-mode)
953 (current-global-map)) 951 (substitute-key-definition
954 (substitute-key-definition 'recenter 'hilit-recenter 952 (if hilit-mode 'yank 'hilit-yank)
955 (current-global-map)))) 953 (if hilit-mode 'hilit-yank 'yank)
956 954 (current-global-map))
957(global-set-key [?\C-\S-l] 'hilit-repaint-command) 955 (substitute-key-definition
958 956 (if hilit-mode 'yank-pop 'hilit-yank-pop)
959(add-hook 'find-file-hook 'hilit-find-file-hook t) 957 (if hilit-mode 'hilit-yank-pop 'yank-pop)
958 (current-global-map))
959 (substitute-key-definition
960 (if hilit-mode 'recenter 'hilit-recenter)
961 (if hilit-mode 'hilit-recenter 'recenter)
962 (current-global-map)))
963
964 (if hilit-mode
965 (global-set-key [?\C-\S-l] 'hilit-repaint-command)
966 (global-unset-key [?\C-\S-l]))
967
968 (if hilit-mode
969 (add-hook 'find-file-hook 'hilit-find-file-hook t)
970 (remove-hook 'find-file-hook 'hilit-find-file-hook))
971
972 (unless (and hilit-inhibit-hooks hilit-mode)
973 (condition-case c
974 (progn
975
976 ;; BUFFER highlights...
977 (mapcar (lambda (hook)
978 (if hilit-mode
979 (add-hook hook 'hilit-rehighlight-buffer-quietly)
980 (remove-hook hook 'hilit-rehighlight-buffer-quietly)))
981 '(
982 Info-selection-hook
983
984 ;; runs too early vm-summary-mode-hooks
985 vm-summary-pointer-hook
986 vm-preview-message-hook
987 vm-show-message-hook
988
989 rmail-show-message-hook
990 mail-setup-hook
991 mh-show-mode-hook
992
993 dired-after-readin-hook
994 ))
995 )
996 (error (message "Error loading highlight hooks: %s" c)
997 (ding) (sit-for 1)))))
960 998
961(eval-when-compile (require 'gnus)) ; no compilation gripes 999(eval-when-compile (require 'gnus)) ; no compilation gripes
962 1000
963(and (not hilit-inhibit-hooks)
964 (condition-case c
965 (progn
966
967 ;; BUFFER highlights...
968 (mapcar (function
969 (lambda (hook)
970 (add-hook hook 'hilit-rehighlight-buffer-quietly)))
971 '(
972 Info-selection-hook
973
974;; runs too early vm-summary-mode-hooks
975 vm-summary-pointer-hook
976 vm-preview-message-hook
977 vm-show-message-hook
978
979 rmail-show-message-hook
980 mail-setup-hook
981 mh-show-mode-hook
982
983 dired-after-readin-hook
984 ))
985 )
986 (error (message "Error loading highlight hooks: %s" c)
987 (ding) (sit-for 1))))
988
989;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1001;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
990;; Default patterns for various modes. 1002;; Default patterns for various modes.
991;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1003;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1510,5 +1522,5 @@ number of backslashes."
1510 1522
1511(provide 'hilit19) 1523(provide 'hilit19)
1512 1524
1513;;; arch-tag: db99739a-4837-41ee-ad02-3baced8ae71d 1525;; arch-tag: db99739a-4837-41ee-ad02-3baced8ae71d
1514;;; hilit19.el ends here 1526;;; hilit19.el ends here
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 5dff6d954f8..f4b796dd1a7 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -150,7 +150,7 @@ This mirrors the optional behavior of tcsh."
150 :type 'boolean 150 :type 'boolean
151 :group 'pcomplete) 151 :group 'pcomplete)
152 152
153(defcustom pcomplete-suffix-list (list directory-sep-char ?:) 153(defcustom pcomplete-suffix-list (list ?/ ?:)
154 "*A list of characters which constitute a proper suffix." 154 "*A list of characters which constitute a proper suffix."
155 :type '(repeat character) 155 :type '(repeat character)
156 :group 'pcomplete) 156 :group 'pcomplete)
@@ -740,7 +740,7 @@ component, `default-directory' is used as the basis for completion."
740 (function 740 (function
741 (lambda (file) 741 (lambda (file)
742 (if (eq (aref file (1- (length file))) 742 (if (eq (aref file (1- (length file)))
743 directory-sep-char) 743 ?/)
744 (and pcomplete-dir-ignore 744 (and pcomplete-dir-ignore
745 (string-match pcomplete-dir-ignore file)) 745 (string-match pcomplete-dir-ignore file))
746 (and pcomplete-file-ignore 746 (and pcomplete-file-ignore
@@ -757,11 +757,11 @@ component, `default-directory' is used as the basis for completion."
757 ;; since . is earlier in the ASCII alphabet than 757 ;; since . is earlier in the ASCII alphabet than
758 ;; / 758 ;; /
759 (let ((left (if (eq (aref l (1- (length l))) 759 (let ((left (if (eq (aref l (1- (length l)))
760 directory-sep-char) 760 ?/)
761 (substring l 0 (1- (length l))) 761 (substring l 0 (1- (length l)))
762 l)) 762 l))
763 (right (if (eq (aref r (1- (length r))) 763 (right (if (eq (aref r (1- (length r)))
764 directory-sep-char) 764 ?/)
765 (substring r 0 (1- (length r))) 765 (substring r 0 (1- (length r)))
766 r))) 766 r)))
767 (if above-cutoff 767 (if above-cutoff
diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el
index 886e53a6afa..83d67958f44 100644
--- a/lisp/play/5x5.el
+++ b/lisp/play/5x5.el
@@ -224,9 +224,8 @@ Quit current game \\[5x5-quit-game]"
224 5x5-y-pos (/ 5x5-grid-size 2) 224 5x5-y-pos (/ 5x5-grid-size 2)
225 5x5-moves 0 225 5x5-moves 0
226 5x5-grid (5x5-make-move (5x5-make-new-grid) 5x5-y-pos 5x5-x-pos)) 226 5x5-grid (5x5-make-move (5x5-make-new-grid) 5x5-y-pos 5x5-x-pos))
227 (when (interactive-p) 227 (5x5-draw-grid (list 5x5-grid))
228 (5x5-draw-grid (list 5x5-grid)) 228 (5x5-position-cursor)))
229 (5x5-position-cursor))))
230 229
231(defun 5x5-quit-game () 230(defun 5x5-quit-game ()
232 "Quit the current game of `5x5'." 231 "Quit the current game of `5x5'."
diff --git a/lisp/play/fortune.el b/lisp/play/fortune.el
index 306cf7daac1..3919f57e78c 100644
--- a/lisp/play/fortune.el
+++ b/lisp/play/fortune.el
@@ -271,7 +271,7 @@ and choose the directory as the fortune-file."
271 (fortune-ask-file) 271 (fortune-ask-file)
272 fortune-file))) 272 fortune-file)))
273 (save-excursion 273 (save-excursion
274 (fortune-in-buffer (interactive-p) file) 274 (fortune-in-buffer t file)
275 (set-buffer fortune-buffer-name) 275 (set-buffer fortune-buffer-name)
276 (let* ((fortune (buffer-string)) 276 (let* ((fortune (buffer-string))
277 (signature (concat fortune-sigstart fortune fortune-sigend))) 277 (signature (concat fortune-sigstart fortune fortune-sigend)))
@@ -285,7 +285,7 @@ and choose the directory as the fortune-file."
285(defun fortune-in-buffer (interactive &optional file) 285(defun fortune-in-buffer (interactive &optional file)
286 "Put a fortune cookie in the *fortune* buffer. 286 "Put a fortune cookie in the *fortune* buffer.
287 287
288When INTERACTIVE is nil, don't display it. Optional argument FILE, 288INTERACTIVE is ignored. Optional argument FILE,
289when supplied, specifies the file to choose the fortune from." 289when supplied, specifies the file to choose the fortune from."
290 (let ((fortune-buffer (or (get-buffer fortune-buffer-name) 290 (let ((fortune-buffer (or (get-buffer fortune-buffer-name)
291 (generate-new-buffer fortune-buffer-name))) 291 (generate-new-buffer fortune-buffer-name)))
diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el
index fc1d2d46ab3..472cfc3053e 100644
--- a/lisp/progmodes/ada-xref.el
+++ b/lisp/progmodes/ada-xref.el
@@ -2154,17 +2154,17 @@ This is a GNAT specific function that uses gnatkrunch."
2154 adaname 2154 adaname
2155 ) 2155 )
2156 2156
2157(defun ada-make-body-gnatstub () 2157(defun ada-make-body-gnatstub (&optional interactive)
2158 "Create an Ada package body in the current buffer. 2158 "Create an Ada package body in the current buffer.
2159This function uses the `gnatstub' program to create the body. 2159This function uses the `gnatstub' program to create the body.
2160This function typically is to be hooked into `ff-file-created-hooks'." 2160This function typically is to be hooked into `ff-file-created-hooks'."
2161 (interactive) 2161 (interactive "p")
2162 2162
2163 (save-some-buffers nil nil) 2163 (save-some-buffers nil nil)
2164 2164
2165 ;; If the current buffer is the body (as is the case when calling this 2165 ;; If the current buffer is the body (as is the case when calling this
2166 ;; function from ff-file-created-hooks), then kill this temporary buffer 2166 ;; function from ff-file-created-hooks), then kill this temporary buffer
2167 (unless (interactive-p) 2167 (unless interactive
2168 (progn 2168 (progn
2169 (set-buffer-modified-p nil) 2169 (set-buffer-modified-p nil)
2170 (kill-buffer (current-buffer)))) 2170 (kill-buffer (current-buffer))))
diff --git a/lisp/progmodes/autoconf.el b/lisp/progmodes/autoconf.el
index 5bdb1fb25eb..ec83e33b10d 100644
--- a/lisp/progmodes/autoconf.el
+++ b/lisp/progmodes/autoconf.el
@@ -1,6 +1,6 @@
1;;; autoconf.el --- mode for editing Autoconf configure.in files 1;;; autoconf.el --- mode for editing Autoconf configure.in files
2 2
3;; Copyright (C) 2000, 2003 Free Software Foundation, Inc. 3;; Copyright (C) 2000, 2003, 2004 Free Software Foundation, Inc.
4 4
5;; Author: Dave Love <fx@gnu.org> 5;; Author: Dave Love <fx@gnu.org>
6;; Keywords: languages 6;; Keywords: languages
@@ -49,7 +49,7 @@
49 "AC_\\(SUBST\\|DEFINE\\(_UNQUOTED\\)?\\)(\\(\\sw+\\)") 49 "AC_\\(SUBST\\|DEFINE\\(_UNQUOTED\\)?\\)(\\(\\sw+\\)")
50 50
51(defvar autoconf-font-lock-keywords 51(defvar autoconf-font-lock-keywords
52 `(("A[CHM]_\\sw+" . font-lock-keyword-face) 52 `(("A[CHMS]_\\sw+" . font-lock-keyword-face)
53 (,autoconf-definition-regexp 53 (,autoconf-definition-regexp
54 3 font-lock-function-name-face) 54 3 font-lock-function-name-face)
55 ;; Are any other M4 keywords really appropriate for configure.in, 55 ;; Are any other M4 keywords really appropriate for configure.in,
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 0dc73e96664..223455e9872 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -181,6 +181,16 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
181 (epc 181 (epc
182 "^Error [0-9]+ at (\\([0-9]+\\):\\([^)\n]+\\))" 2 1) 182 "^Error [0-9]+ at (\\([0-9]+\\):\\([^)\n]+\\))" 2 1)
183 183
184 (ftnchek-file
185 "^File \\(.+\\.f\\):$"
186 1 nil nil 0)
187 (ftnchek-line-file
188 "\\(^Warning .* \\)?line \\([0-9]+\\)\\(?: col \\([0-9]+\\)\\)? file \\(.+\\.f\\)"
189 4 2 3 (1) nil (1 'default nil t))
190 (ftnchek-line
191 "\\(?:^\\(Warning\\) .* \\)?line \\([0-9]+\\)\\(?: col \\([0-9]+\\)\\)?"
192 nil 2 3 (1) nil (1 (compilation-face '(1)) nil t))
193
184 (iar 194 (iar
185 "^\"\\(.*\\)\",\\([0-9]+\\)\\s-+\\(?:Error\\|Warnin\\(g\\)\\)\\[[0-9]+\\]:" 195 "^\"\\(.*\\)\",\\([0-9]+\\)\\s-+\\(?:Error\\|Warnin\\(g\\)\\)\\[[0-9]+\\]:"
186 1 2 nil (3)) 196 1 2 nil (3))
@@ -191,8 +201,8 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
191 201
192 ;; fixme: should be `mips' 202 ;; fixme: should be `mips'
193 (irix 203 (irix
194 "^[-[:alnum:]_/]+: \\(?:[sS]evere\\|[eE]rror\\|[wW]arnin\\(g\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*:\ 204 "^[-[:alnum:]_/ ]+: \\(?:\\(?:[sS]evere\\|[eE]rror\\|[wW]arnin\\(g\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*: \\)?\
195 \\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 3 4 nil (1 . 2)) 205\\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 3 4 nil (1 . 2))
196 206
197 (java 207 (java
198 "^\\(?:[ \t]+at \\|==[0-9]+== +\\(?:at\\|b\\(y\\)\\)\\).+(\\([^()\n]+\\):\\([0-9]+\\))$" 2 3 nil (1)) 208 "^\\(?:[ \t]+at \\|==[0-9]+== +\\(?:at\\|b\\(y\\)\\)\\).+(\\([^()\n]+\\):\\([0-9]+\\))$" 2 3 nil (1))
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index e679a48d642..94458df56e8 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -6664,11 +6664,11 @@ prototype \&SUB Returns prototype of the function given a reference.
6664=pod Switch from Perl to POD. 6664=pod Switch from Perl to POD.
6665") 6665")
6666 6666
6667(defun cperl-switch-to-doc-buffer () 6667(defun cperl-switch-to-doc-buffer (&optional interactive)
6668 "Go to the perl documentation buffer and insert the documentation." 6668 "Go to the perl documentation buffer and insert the documentation."
6669 (interactive) 6669 (interactive "p")
6670 (let ((buf (get-buffer-create cperl-doc-buffer))) 6670 (let ((buf (get-buffer-create cperl-doc-buffer)))
6671 (if (interactive-p) 6671 (if interactive
6672 (switch-to-buffer-other-window buf) 6672 (switch-to-buffer-other-window buf)
6673 (set-buffer buf)) 6673 (set-buffer buf))
6674 (if (= (buffer-size) 0) 6674 (if (= (buffer-size) 0)
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index 3ccea967bc5..737071203e0 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -56,7 +56,7 @@
56(defun flymake-makehash(&optional test) 56(defun flymake-makehash(&optional test)
57 (cond 57 (cond
58 ((equal flymake-emacs 'xemacs) (if test (make-hash-table :test test) (make-hash-table))) 58 ((equal flymake-emacs 'xemacs) (if test (make-hash-table :test test) (make-hash-table)))
59 (t (makehash test)) 59 (t (makehash test))
60 ) 60 )
61) 61)
62 62
@@ -370,8 +370,8 @@
370 (let* ((init-f (nth 0 (flymake-get-file-name-mode-and-masks file-name)))) 370 (let* ((init-f (nth 0 (flymake-get-file-name-mode-and-masks file-name))))
371 ;(flymake-log 0 "calling %s" init-f) 371 ;(flymake-log 0 "calling %s" init-f)
372 ;(funcall init-f (current-buffer)) 372 ;(funcall init-f (current-buffer))
373 init-f
373 ) 374 )
374 (nth 0 (flymake-get-file-name-mode-and-masks file-name))
375) 375)
376 376
377(defun flymake-get-cleanup-function(file-name) 377(defun flymake-get-cleanup-function(file-name)
@@ -846,7 +846,7 @@ Whenether a buffer for master-file-name exists, use it as a source instead of re
846 (set-buffer source-buffer) 846 (set-buffer source-buffer)
847 847
848 (flymake-parse-residual source-buffer) 848 (flymake-parse-residual source-buffer)
849 (flymake-post-syntax-check source-buffer) 849 (flymake-post-syntax-check source-buffer exit-status command)
850 (flymake-set-buffer-is-running source-buffer nil) 850 (flymake-set-buffer-is-running source-buffer nil)
851 ) 851 )
852 ) 852 )
@@ -863,7 +863,7 @@ Whenether a buffer for master-file-name exists, use it as a source instead of re
863 ) 863 )
864) 864)
865 865
866(defun flymake-post-syntax-check(source-buffer) 866(defun flymake-post-syntax-check(source-buffer exit-status command)
867 "" 867 ""
868 (flymake-set-buffer-err-info source-buffer (flymake-get-buffer-new-err-info source-buffer)) 868 (flymake-set-buffer-err-info source-buffer (flymake-get-buffer-new-err-info source-buffer))
869 (flymake-set-buffer-new-err-info source-buffer nil) 869 (flymake-set-buffer-new-err-info source-buffer nil)
@@ -1220,7 +1220,33 @@ Whenether a buffer for master-file-name exists, use it as a source instead of re
1220 ) 1220 )
1221) 1221)
1222 1222
1223(eval-when-compile (require 'compile)) 1223(defun flymake-reformat-err-line-patterns-from-compile-el(original-list)
1224 "grab error line patterns from original list in compile.el format, convert to flymake internal format"
1225 (let* ((converted-list '()))
1226 (mapcar
1227 (lambda (item)
1228 (setq item (cdr item))
1229 (let ((regexp (nth 0 item))
1230 (file (nth 1 item))
1231 (line (nth 2 item))
1232 (col (nth 3 item))
1233 end-line)
1234 (if (consp file) (setq file (car file)))
1235 (if (consp line) (setq end-line (cdr line) line (car line)))
1236 (if (consp col) (setq col (car col)))
1237
1238 (when (not (functionp line))
1239 (setq converted-list (cons (list regexp file line col) converted-list))
1240 )
1241 )
1242 )
1243 original-list
1244 )
1245 converted-list
1246 )
1247)
1248
1249(require 'compile)
1224(defvar flymake-err-line-patterns ; regexp file-idx line-idx col-idx (optional) text-idx(optional), match-end to end of string is error text 1250(defvar flymake-err-line-patterns ; regexp file-idx line-idx col-idx (optional) text-idx(optional), match-end to end of string is error text
1225 (append 1251 (append
1226 '( 1252 '(
@@ -1243,9 +1269,9 @@ Whenether a buffer for master-file-name exists, use it as a source instead of re
1243 (" *\\(\\[javac\\]\\)? *\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)\:\\([0-9]+\\)\:[ \t\n]*\\(.+\\)" 1269 (" *\\(\\[javac\\]\\)? *\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)\:\\([0-9]+\\)\:[ \t\n]*\\(.+\\)"
1244 2 4 nil 5) 1270 2 4 nil 5)
1245 ) 1271 )
1246 ;; compilation-error-regexp-alist) 1272 ;; compilation-error-regexp-alist)
1247 (mapcar (lambda (x) (cdr x)) compilation-error-regexp-alist-alist)) 1273 (flymake-reformat-err-line-patterns-from-compile-el compilation-error-regexp-alist-alist))
1248 "patterns for matching error/warning lines, (regexp file-idx line-idx err-text-idx)" 1274 "patterns for matching error/warning lines, (regexp file-idx line-idx err-text-idx). Use flymake-reformat-err-line-patterns-from-compile-el to add patterns from compile.el"
1249) 1275)
1250;(defcustom flymake-err-line-patterns 1276;(defcustom flymake-err-line-patterns
1251; '( 1277; '(
@@ -1452,7 +1478,7 @@ Whenether a buffer for master-file-name exists, use it as a source instead of re
1452 (let* ((dir (nth idx include-dirs))) 1478 (let* ((dir (nth idx include-dirs)))
1453 (setq full-file-name (concat dir "/" rel-file-name)) 1479 (setq full-file-name (concat dir "/" rel-file-name))
1454 (when (file-exists-p full-file-name) 1480 (when (file-exists-p full-file-name)
1455 (setq done t) 1481 (setq found t)
1456 ) 1482 )
1457 ) 1483 )
1458 (setq idx (1+ idx)) 1484 (setq idx (1+ idx))
@@ -1574,7 +1600,7 @@ Whenether a buffer for master-file-name exists, use it as a source instead of re
1574 process 1600 process
1575 ) 1601 )
1576 (error 1602 (error
1577 (let ((err-str (format "Failed to launch syntax check process '%s' with args %s: %s" 1603 (let* ((err-str (format "Failed to launch syntax check process '%s' with args %s: %s"
1578 cmd args (error-message-string err))) 1604 cmd args (error-message-string err)))
1579 (source-file-name (buffer-file-name buffer)) 1605 (source-file-name (buffer-file-name buffer))
1580 (cleanup-f (flymake-get-cleanup-function source-file-name))) 1606 (cleanup-f (flymake-get-cleanup-function source-file-name)))
@@ -1905,7 +1931,8 @@ Whenether a buffer for master-file-name exists, use it as a source instead of re
1905(defun flymake-mode(&optional arg) 1931(defun flymake-mode(&optional arg)
1906 "toggle flymake-mode" 1932 "toggle flymake-mode"
1907 (interactive) 1933 (interactive)
1908 (let ((old-flymake-mode flymake-mode)) 1934 (let ((old-flymake-mode flymake-mode)
1935 (turn-on nil))
1909 1936
1910 (setq turn-on 1937 (setq turn-on
1911 (if (null arg) 1938 (if (null arg)
diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el
index 64f8808c7f1..90c0a50c7dc 100644
--- a/lisp/progmodes/gdb-ui.el
+++ b/lisp/progmodes/gdb-ui.el
@@ -25,28 +25,28 @@
25 25
26;;; Commentary: 26;;; Commentary:
27 27
28;; This mode acts as a graphical user interface to GDB. You can interact with 28;; This mode acts as a graphical user interface to GDB. You can interact with
29;; GDB through the GUD buffer in the usual way, but there are also further 29;; GDB through the GUD buffer in the usual way, but there are also further
30;; buffers which control the execution and describe the state of your program. 30;; buffers which control the execution and describe the state of your program.
31;; It separates the input/output of your program from that of GDB, if 31;; It separates the input/output of your program from that of GDB, if
32;; required, and watches expressions in the speedbar. It also uses features of 32;; required, and watches expressions in the speedbar. It also uses features of
33;; Emacs 21 such as the fringe/display margin for breakpoints, and the toolbar 33;; Emacs 21 such as the fringe/display margin for breakpoints, and the toolbar
34;; (see the GDB Graphical Interface section in the Emacs info manual). 34;; (see the GDB Graphical Interface section in the Emacs info manual).
35 35
36;; Start the debugger with M-x gdba. 36;; Start the debugger with M-x gdba.
37 37
38;; This file has evolved from gdba.el from GDB 5.0 written by Tom Lord and Jim 38;; This file has evolved from gdba.el from GDB 5.0 written by Tom Lord and Jim
39;; Kingdon and uses GDB's annotation interface. You don't need to know about 39;; Kingdon and uses GDB's annotation interface. You don't need to know about
40;; annotations to use this mode as a debugger, but if you are interested 40;; annotations to use this mode as a debugger, but if you are interested
41;; developing the mode itself, then see the Annotations section in the GDB 41;; developing the mode itself, then see the Annotations section in the GDB
42;; info manual. 42;; info manual.
43;; 43;;
44;; GDB developers plan to make the annotation interface obsolete. A new 44;; GDB developers plan to make the annotation interface obsolete. A new
45;; interface called GDB/MI (machine interface) has been designed to replace 45;; interface called GDB/MI (machine interface) has been designed to replace
46;; it. Some GDB/MI commands are used in this file through the CLI command 46;; it. Some GDB/MI commands are used in this file through the CLI command
47;; 'interpreter mi <mi-command>'. A file called gdb-mi.el is included in the 47;; 'interpreter mi <mi-command>'. A file called gdb-mi.el is included in the
48;; GDB repository for future releases (6.2 onwards) that uses GDB/MI as the 48;; GDB repository for future releases (6.2 onwards) that uses GDB/MI as the
49;; primary interface to GDB. It is still under development and is part of a 49;; primary interface to GDB. It is still under development and is part of a
50;; process to migrate Emacs from annotations to GDB/MI. 50;; process to migrate Emacs from annotations to GDB/MI.
51;; 51;;
52;; Known Bugs: 52;; Known Bugs:
@@ -63,7 +63,7 @@
63(defvar gdb-current-language nil) 63(defvar gdb-current-language nil)
64(defvar gdb-view-source t "Non-nil means that source code can be viewed.") 64(defvar gdb-view-source t "Non-nil means that source code can be viewed.")
65(defvar gdb-selected-view 'source "Code type that user wishes to view.") 65(defvar gdb-selected-view 'source "Code type that user wishes to view.")
66(defvar gdb-var-list nil "List of variables in watch window") 66(defvar gdb-var-list nil "List of variables in watch window.")
67(defvar gdb-var-changed nil "Non-nil means that gdb-var-list has changed.") 67(defvar gdb-var-changed nil "Non-nil means that gdb-var-list has changed.")
68(defvar gdb-buffer-type nil) 68(defvar gdb-buffer-type nil)
69(defvar gdb-overlay-arrow-position nil) 69(defvar gdb-overlay-arrow-position nil)
@@ -85,12 +85,12 @@ other with the source file with the main routine of the inferior.
85If `gdb-many-windows' is t, regardless of the value of 85If `gdb-many-windows' is t, regardless of the value of
86`gdb-show-main', the layout below will appear unless 86`gdb-show-main', the layout below will appear unless
87`gdb-use-inferior-io-buffer' is nil when the source buffer 87`gdb-use-inferior-io-buffer' is nil when the source buffer
88occupies the full width of the frame. Keybindings are given in 88occupies the full width of the frame. Keybindings are given in
89relevant buffer. 89relevant buffer.
90 90
91Watch expressions appear in the speedbar/slowbar. 91Watch expressions appear in the speedbar/slowbar.
92 92
93The following interactive lisp functions help control operation : 93The following commands help control operation :
94 94
95`gdb-many-windows' - Toggle the number of windows gdb uses. 95`gdb-many-windows' - Toggle the number of windows gdb uses.
96`gdb-restore-windows' - To restore the window layout. 96`gdb-restore-windows' - To restore the window layout.
@@ -120,8 +120,7 @@ detailed description of this mode.
120 RET gdb-frames-select | SPC gdb-toggle-breakpoint 120 RET gdb-frames-select | SPC gdb-toggle-breakpoint
121 | RET gdb-goto-breakpoint 121 | RET gdb-goto-breakpoint
122 | d gdb-delete-breakpoint 122 | d gdb-delete-breakpoint
123--------------------------------------------------------------------- 123---------------------------------------------------------------------"
124"
125 ;; 124 ;;
126 (interactive (list (gud-query-cmdline 'gdba))) 125 (interactive (list (gud-query-cmdline 'gdba)))
127 ;; 126 ;;
@@ -134,12 +133,14 @@ detailed description of this mode.
134(defcustom gdb-enable-debug-log nil 133(defcustom gdb-enable-debug-log nil
135 "Non-nil means record the process input and output in `gdb-debug-log'." 134 "Non-nil means record the process input and output in `gdb-debug-log'."
136 :type 'boolean 135 :type 'boolean
137 :group 'gud) 136 :group 'gud
137 :version "21.4")
138 138
139(defcustom gdb-use-inferior-io-buffer nil 139(defcustom gdb-use-inferior-io-buffer nil
140 "Non-nil means display output from the inferior in a separate buffer." 140 "Non-nil means display output from the inferior in a separate buffer."
141 :type 'boolean 141 :type 'boolean
142 :group 'gud) 142 :group 'gud
143 :version "21.4")
143 144
144(defun gdb-ann3 () 145(defun gdb-ann3 ()
145 (setq gdb-debug-log nil) 146 (setq gdb-debug-log nil)
@@ -210,10 +211,10 @@ detailed description of this mode.
210 (run-hooks 'gdba-mode-hook)) 211 (run-hooks 'gdba-mode-hook))
211 212
212(defcustom gdb-use-colon-colon-notation nil 213(defcustom gdb-use-colon-colon-notation nil
213 "Non-nil means use FUNCTION::VARIABLE format to display variables in the 214 "If non-nil use FUN::VAR format to display variables in the speedbar." ;
214speedbar."
215 :type 'boolean 215 :type 'boolean
216 :group 'gud) 216 :group 'gud
217 :version "21.4")
217 218
218(defun gud-watch () 219(defun gud-watch ()
219 "Watch expression at point." 220 "Watch expression at point."
@@ -376,7 +377,7 @@ speedbar."
376 (setq gdb-var-changed t)))))) 377 (setq gdb-var-changed t))))))
377 378
378(defun gdb-edit-value (text token indent) 379(defun gdb-edit-value (text token indent)
379 "Assign a value to a variable displayed in the speedbar" 380 "Assign a value to a variable displayed in the speedbar."
380 (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list)) 381 (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
381 (varnum (cadr var)) (value)) 382 (varnum (cadr var)) (value))
382 (setq value (read-string "New value: ")) 383 (setq value (read-string "New value: "))
@@ -389,8 +390,8 @@ speedbar."
389 'ignore)))) 390 'ignore))))
390 391
391(defcustom gdb-show-changed-values t 392(defcustom gdb-show-changed-values t
392 "Non-nil means use font-lock-warning-face to display values that have 393 "If non-nil highlight values that have recently changed in the speedbar.
393recently changed in the speedbar." 394The highlighting is done with `font-lock-warning-face'."
394 :type 'boolean 395 :type 'boolean
395 :group 'gud) 396 :group 'gud)
396 397
@@ -422,23 +423,23 @@ INDENT is the current indentation depth."
422 "The disposition of the output of the current gdb command. 423 "The disposition of the output of the current gdb command.
423Possible values are these symbols: 424Possible values are these symbols:
424 425
425 user -- gdb output should be copied to the GUD buffer 426 `user' -- gdb output should be copied to the GUD buffer
426 for the user to see. 427 for the user to see.
427 428
428 inferior -- gdb output should be copied to the inferior-io buffer 429 `inferior' -- gdb output should be copied to the inferior-io buffer
429 430
430 pre-emacs -- output should be ignored util the post-prompt 431 `pre-emacs' -- output should be ignored util the post-prompt
431 annotation is received. Then the output-sink 432 annotation is received. Then the output-sink
432 becomes:... 433 becomes:...
433 emacs -- output should be collected in the partial-output-buffer 434 `emacs' -- output should be collected in the partial-output-buffer
434 for subsequent processing by a command. This is the 435 for subsequent processing by a command. This is the
435 disposition of output generated by commands that 436 disposition of output generated by commands that
436 gdb mode sends to gdb on its own behalf. 437 gdb mode sends to gdb on its own behalf.
437 post-emacs -- ignore output until the prompt annotation is 438 `post-emacs' -- ignore output until the prompt annotation is
438 received, then go to USER disposition. 439 received, then go to USER disposition.
439 440
440gdba (gdb-ui.el) uses all five values, gdbmi (gdb-mi.el) only two 441gdba (gdb-ui.el) uses all five values, gdbmi (gdb-mi.el) only two
441(user and emacs).") 442\(`user' and `emacs').")
442 443
443(defvar gdb-current-item nil 444(defvar gdb-current-item nil
444 "The most recent command item sent to gdb.") 445 "The most recent command item sent to gdb.")
@@ -619,7 +620,7 @@ The key should be one of the cars in `gdb-buffer-rules-assoc'."
619 620
620(defun gdb-send (proc string) 621(defun gdb-send (proc string)
621 "A comint send filter for gdb. 622 "A comint send filter for gdb.
622This filter may simply queue output for a later time." 623This filter may simply queue input for a later time."
623 (if gud-running 624 (if gud-running
624 (process-send-string proc (concat string "\n")) 625 (process-send-string proc (concat string "\n"))
625 (gdb-enqueue-input (concat string "\n")))) 626 (gdb-enqueue-input (concat string "\n"))))
@@ -660,7 +661,8 @@ This filter may simply queue output for a later time."
660(defcustom gud-gdba-command-name "gdb -annotate=3" 661(defcustom gud-gdba-command-name "gdb -annotate=3"
661 "Default command to execute an executable under the GDB-UI debugger." 662 "Default command to execute an executable under the GDB-UI debugger."
662 :type 'string 663 :type 'string
663 :group 'gud) 664 :group 'gud
665 :version "21.4")
664 666
665(defvar gdb-annotation-rules 667(defvar gdb-annotation-rules
666 '(("pre-prompt" gdb-pre-prompt) 668 '(("pre-prompt" gdb-pre-prompt)
@@ -705,25 +707,25 @@ This filter may simply queue output for a later time."
705 (setq gdb-current-item item) 707 (setq gdb-current-item item)
706 (with-current-buffer gud-comint-buffer 708 (with-current-buffer gud-comint-buffer
707 (if (eq gud-minor-mode 'gdba) 709 (if (eq gud-minor-mode 'gdba)
708 (progn 710 (if (stringp item)
709 (if (stringp item)
710 (progn
711 (setq gdb-output-sink 'user)
712 (process-send-string (get-buffer-process gud-comint-buffer) item))
713 (progn 711 (progn
714 (gdb-clear-partial-output) 712 (setq gdb-output-sink 'user)
715 (setq gdb-output-sink 'pre-emacs) 713 (process-send-string (get-buffer-process gud-comint-buffer) item))
716 (process-send-string (get-buffer-process gud-comint-buffer) 714 (progn
717 (car item))))) 715 (gdb-clear-partial-output)
718 ; case: eq gud-minor-mode 'gdbmi 716 (setq gdb-output-sink 'pre-emacs)
717 (process-send-string (get-buffer-process gud-comint-buffer)
718 (car item))))
719 ;; case: eq gud-minor-mode 'gdbmi
719 (gdb-clear-partial-output) 720 (gdb-clear-partial-output)
720 (setq gdb-output-sink 'emacs) 721 (setq gdb-output-sink 'emacs)
721 (process-send-string (get-buffer-process gud-comint-buffer) 722 (process-send-string (get-buffer-process gud-comint-buffer)
722 (car item))))) 723 (car item)))))
723 724
724(defun gdb-pre-prompt (ignored) 725(defun gdb-pre-prompt (ignored)
725 "An annotation handler for `pre-prompt'. This terminates the collection of 726 "An annotation handler for `pre-prompt'.
726output from a previous command if that happens to be in effect." 727This terminates the collection of output from a previous command if that
728happens to be in effect."
727 (let ((sink gdb-output-sink)) 729 (let ((sink gdb-output-sink))
728 (cond 730 (cond
729 ((eq sink 'user) t) 731 ((eq sink 'user) t)
@@ -761,8 +763,9 @@ This sends the next command (if any) to gdb."
761 (setq gdb-prompting t)) 763 (setq gdb-prompting t))
762 764
763(defun gdb-starting (ignored) 765(defun gdb-starting (ignored)
764 "An annotation handler for `starting'. This says that I/O for the 766 "An annotation handler for `starting'.
765subprocess is now the program being debugged, not GDB." 767This says that I/O for the subprocess is now the program being debugged,
768not GDB."
766 (let ((sink gdb-output-sink)) 769 (let ((sink gdb-output-sink))
767 (cond 770 (cond
768 ((eq sink 'user) 771 ((eq sink 'user)
@@ -773,8 +776,9 @@ subprocess is now the program being debugged, not GDB."
773 (t (error "Unexpected `starting' annotation"))))) 776 (t (error "Unexpected `starting' annotation")))))
774 777
775(defun gdb-stopping (ignored) 778(defun gdb-stopping (ignored)
776 "An annotation handler for `exited' and other annotations which say that I/O 779 "An annotation handler for `exited' and other annotations.
777for the subprocess is now GDB, not the program being debugged." 780They say that I/O for the subprocess is now GDB, not the program
781being debugged."
778 (if gdb-use-inferior-io-buffer 782 (if gdb-use-inferior-io-buffer
779 (let ((sink gdb-output-sink)) 783 (let ((sink gdb-output-sink))
780 (cond 784 (cond
@@ -792,8 +796,9 @@ for the subprocess is now GDB, not the program being debugged."
792 (t (error "Unexpected frame-begin annotation (%S)" sink))))) 796 (t (error "Unexpected frame-begin annotation (%S)" sink)))))
793 797
794(defun gdb-stopped (ignored) 798(defun gdb-stopped (ignored)
795 "An annotation handler for `stopped'. It is just like gdb-stopping, except 799 "An annotation handler for `stopped'.
796that if we already set the output sink to 'user in gdb-stopping, that is fine." 800It is just like `gdb-stopping', except that if we already set the output
801sink to `user' in `gdb-stopping', that is fine."
797 (setq gud-running nil) 802 (setq gud-running nil)
798 (let ((sink gdb-output-sink)) 803 (let ((sink gdb-output-sink))
799 (cond 804 (cond
@@ -803,8 +808,9 @@ that if we already set the output sink to 'user in gdb-stopping, that is fine."
803 (t (error "Unexpected stopped annotation"))))) 808 (t (error "Unexpected stopped annotation")))))
804 809
805(defun gdb-post-prompt (ignored) 810(defun gdb-post-prompt (ignored)
806 "An annotation handler for `post-prompt'. This begins the collection of 811 "An annotation handler for `post-prompt'.
807output from the current command if that happens to be appropriate." 812This begins the collection of output from the current command if that
813happens to be appropriate."
808 (if (not gdb-pending-triggers) 814 (if (not gdb-pending-triggers)
809 (progn 815 (progn
810 (gdb-get-current-frame) 816 (gdb-get-current-frame)
@@ -832,7 +838,7 @@ output from the current command if that happens to be appropriate."
832 (error "Phase error in gdb-post-prompt (got %s)" sink))))) 838 (error "Phase error in gdb-post-prompt (got %s)" sink)))))
833 839
834(defun gud-gdba-marker-filter (string) 840(defun gud-gdba-marker-filter (string)
835 "A gud marker filter for gdb. Handle a burst of output from GDB." 841 "A gud marker filter for gdb. Handle a burst of output from GDB."
836 (if gdb-enable-debug-log (push (cons 'recv string) gdb-debug-log)) 842 (if gdb-enable-debug-log (push (cons 'recv string) gdb-debug-log))
837 ;; Recall the left over gud-marker-acc from last time 843 ;; Recall the left over gud-marker-acc from last time
838 (setq gud-marker-acc (concat gud-marker-acc string)) 844 (setq gud-marker-acc (concat gud-marker-acc string))
@@ -1065,10 +1071,10 @@ static char *magick[] = {
1065 "PBM data used for disabled breakpoint icon.") 1071 "PBM data used for disabled breakpoint icon.")
1066 1072
1067(defvar breakpoint-enabled-icon nil 1073(defvar breakpoint-enabled-icon nil
1068 "Icon for enabled breakpoint in display margin") 1074 "Icon for enabled breakpoint in display margin.")
1069 1075
1070(defvar breakpoint-disabled-icon nil 1076(defvar breakpoint-disabled-icon nil
1071 "Icon for disabled breakpoint in display margin") 1077 "Icon for disabled breakpoint in display margin.")
1072 1078
1073;; Bitmap for breakpoint in fringe 1079;; Bitmap for breakpoint in fringe
1074(define-fringe-bitmap 'breakpoint 1080(define-fringe-bitmap 'breakpoint
@@ -1133,7 +1139,7 @@ static char *magick[] = {
1133 (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom))) 1139 (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom)))
1134 1140
1135(defun gdb-mouse-toggle-breakpoint (event) 1141(defun gdb-mouse-toggle-breakpoint (event)
1136 "Toggle breakpoint in left fringe/margin with mouse click" 1142 "Toggle breakpoint in left fringe/margin with mouse click."
1137 (interactive "e") 1143 (interactive "e")
1138 (mouse-minibuffer-check event) 1144 (mouse-minibuffer-check event)
1139 (let ((posn (event-end event))) 1145 (let ((posn (event-end event)))
@@ -1683,7 +1689,8 @@ static char *magick[] = {
1683(defcustom gdb-show-main nil 1689(defcustom gdb-show-main nil
1684 "Nil means don't display source file containing the main routine." 1690 "Nil means don't display source file containing the main routine."
1685 :type 'boolean 1691 :type 'boolean
1686 :group 'gud) 1692 :group 'gud
1693 :version "21.4")
1687 1694
1688(defun gdb-setup-windows () 1695(defun gdb-setup-windows ()
1689 "Layout the window pattern for gdb-many-windows." 1696 "Layout the window pattern for gdb-many-windows."
@@ -1718,13 +1725,14 @@ static char *magick[] = {
1718 (other-window 1)) 1725 (other-window 1))
1719 1726
1720(defcustom gdb-many-windows nil 1727(defcustom gdb-many-windows nil
1721 "Nil (the default value) means just pop up the GUD buffer 1728 "Nil means just pop up the GUD buffer unless `gdb-show-main' is t.
1722unless `gdb-show-main' is t. In this case it starts with two 1729In this case it starts with two windows: one displaying the GUD
1723windows: one displaying the GUD buffer and the other with the 1730buffer and the other with the source file with the main routine
1724source file with the main routine of the inferior. Non-nil means 1731of the inferior. Non-nil means display the layout shown for
1725display the layout shown for `gdba'." 1732`gdba'."
1726 :type 'boolean 1733 :type 'boolean
1727 :group 'gud) 1734 :group 'gud
1735 :version "21.4")
1728 1736
1729(defun gdb-many-windows (arg) 1737(defun gdb-many-windows (arg)
1730"Toggle the number of windows in the basic arrangement." 1738"Toggle the number of windows in the basic arrangement."
@@ -1760,8 +1768,8 @@ This arrangement depends on the value of `gdb-many-windows'."
1760 (other-window 1))) 1768 (other-window 1)))
1761 1769
1762(defun gdb-reset () 1770(defun gdb-reset ()
1763 "Exit a debugging session cleanly by killing the gdb buffers and resetting 1771 "Exit a debugging session cleanly.
1764 the source buffers." 1772Kills the gdb buffers and resets the source buffers."
1765 (dolist (buffer (buffer-list)) 1773 (dolist (buffer (buffer-list))
1766 (unless (eq buffer gud-comint-buffer) 1774 (unless (eq buffer gud-comint-buffer)
1767 (with-current-buffer buffer 1775 (with-current-buffer buffer
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index 4d9e05109a8..7a13ddba6ed 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -1,7 +1,7 @@
1;;; grep.el --- run compiler as inferior of Emacs, parse error messages 1;;; grep.el --- run compiler as inferior of Emacs, parse error messages
2 2
3;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 1999, 2001, 02, 2004 3;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
4;; Free Software Foundation, Inc. 4;; 2001, 2002, 2004 Free Software Foundation, Inc.
5 5
6;; Author: Roland McGrath <roland@gnu.org> 6;; Author: Roland McGrath <roland@gnu.org>
7;; Maintainer: FSF 7;; Maintainer: FSF
@@ -252,21 +252,12 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies
252\\(?:-\\(?:\\([0-9]+\\)\\3\\)?\\.?\\([0-9]+\\)?\\)?[:) \t]" 1 (2 . 5) (4 . 6)) 252\\(?:-\\(?:\\([0-9]+\\)\\3\\)?\\.?\\([0-9]+\\)?\\)?[:) \t]" 1 (2 . 5) (4 . 6))
253 ("^\\(.+?\\)[:(]+\\([0-9]+\\)\\([:)]\\).*?\\(\033\\[01;41m\\)\\(.*?\\)\\(\033\\[00m\\)" 253 ("^\\(.+?\\)[:(]+\\([0-9]+\\)\\([:)]\\).*?\\(\033\\[01;41m\\)\\(.*?\\)\\(\033\\[00m\\)"
254 1 2 254 1 2
255 ;; Calculate column positions (beg . end) of first grep match on a line
255 ((lambda () 256 ((lambda ()
256 (setq compilation-error-screen-columns nil) 257 (setq compilation-error-screen-columns nil)
257 (- (match-beginning 5) (match-end 3) 8)) 258 (- (match-beginning 5) (match-end 3) 8))
258 . 259 .
259 (lambda () (- (match-end 5) (match-end 3) 8))) 260 (lambda () (- (match-end 5) (match-end 3) 8))))
260 nil nil
261 (4 (list 'face nil 'invisible t 'intangible t))
262 (5 (list 'face compilation-column-face))
263 (6 (list 'face nil 'invisible t 'intangible t))
264 ;; highlight other matches on the same line
265 ("\\(\033\\[01;41m\\)\\(.*?\\)\\(\033\\[00m\\)"
266 nil nil
267 (1 (list 'face nil 'invisible t 'intangible t))
268 (2 (list 'face compilation-column-face) t)
269 (3 (list 'face nil 'invisible t 'intangible t))))
270 ("^Binary file \\(.+\\) matches$" 1 nil nil 1)) 261 ("^Binary file \\(.+\\) matches$" 1 nil nil 1))
271 "Regexp used to match grep hits. See `compilation-error-regexp-alist'.") 262 "Regexp used to match grep hits. See `compilation-error-regexp-alist'.")
272 263
@@ -294,7 +285,16 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies
294 ("^Grep \\(exited abnormally\\) with code \\([0-9]+\\).*" 285 ("^Grep \\(exited abnormally\\) with code \\([0-9]+\\).*"
295 (0 '(face nil message nil help-echo nil mouse-face nil) t) 286 (0 '(face nil message nil help-echo nil mouse-face nil) t)
296 (1 compilation-warning-face) 287 (1 compilation-warning-face)
297 (2 compilation-line-face))) 288 (2 compilation-line-face))
289 ;; Highlight grep matches and delete markers
290 ("\\(\033\\[01;41m\\)\\(.*?\\)\\(\033\\[00m\\)"
291 (2 compilation-column-face)
292 ((lambda (p))
293 (progn
294 ;; Delete markers with `replace-match' because it updates
295 ;; the match-data, whereas `delete-region' would render it obsolete.
296 (replace-match "" t t nil 3)
297 (replace-match "" t t nil 1)))))
298 "Additional things to highlight in grep output. 298 "Additional things to highlight in grep output.
299This gets tacked on the end of the generated expressions.") 299This gets tacked on the end of the generated expressions.")
300 300
@@ -436,9 +436,11 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'."
436 436
437(defun grep-default-command () 437(defun grep-default-command ()
438 (let ((tag-default 438 (let ((tag-default
439 (funcall (or find-tag-default-function 439 (shell-quote-argument
440 (get major-mode 'find-tag-default-function) 440 (or (funcall (or find-tag-default-function
441 'find-tag-default))) 441 (get major-mode 'find-tag-default-function)
442 'find-tag-default))
443 "")))
442 (sh-arg-re "\\(\\(?:\"\\(?:[^\"]\\|\\\\\"\\)+\"\\|'[^']+'\\|[^\"' \t\n]\\)+\\)") 444 (sh-arg-re "\\(\\(?:\"\\(?:[^\"]\\|\\\\\"\\)+\"\\|'[^']+'\\|[^\"' \t\n]\\)+\\)")
443 (grep-default (or (car grep-history) grep-command))) 445 (grep-default (or (car grep-history) grep-command)))
444 ;; Replace the thing matching for with that around cursor. 446 ;; Replace the thing matching for with that around cursor.
@@ -460,7 +462,7 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'."
460 0 (match-beginning 2)) 462 0 (match-beginning 2))
461 " *." 463 " *."
462 (file-name-extension buffer-file-name)))) 464 (file-name-extension buffer-file-name))))
463 (replace-match (or tag-default "") t t grep-default 1)))) 465 (replace-match tag-default t t grep-default 1))))
464 466
465;;;###autoload 467;;;###autoload
466(defun grep (command-args &optional highlight-regexp) 468(defun grep (command-args &optional highlight-regexp)
diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el
index ae0c43c2730..692fce0234e 100644
--- a/lisp/progmodes/idlw-shell.el
+++ b/lisp/progmodes/idlw-shell.el
@@ -1137,10 +1137,10 @@ prompt is present and if `idlwave-shell-ready' is non-nil."
1137 (goto-char save-point)) 1137 (goto-char save-point))
1138 (set-buffer save-buffer)))) 1138 (set-buffer save-buffer))))
1139 1139
1140(defun idlwave-shell-send-char (c &optional no-error) 1140(defun idlwave-shell-send-char (c &optional error)
1141 "Send one character to the shell, without a newline." 1141 "Send one character to the shell, without a newline."
1142 (interactive "cChar to send to IDL: ") 1142 (interactive "cChar to send to IDL: \np")
1143 (let ((errf (if (interactive-p) 'error 'message)) 1143 (let ((errf (if error 'error 'message))
1144 buf proc) 1144 buf proc)
1145 (if (or (not (setq buf (get-buffer (idlwave-shell-buffer)))) 1145 (if (or (not (setq buf (get-buffer (idlwave-shell-buffer))))
1146 (not (setq proc (get-buffer-process buf)))) 1146 (not (setq proc (get-buffer-process buf))))
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el
index a49f70aa0b0..a5e07049843 100644
--- a/lisp/progmodes/idlwave.el
+++ b/lisp/progmodes/idlwave.el
@@ -4231,7 +4231,7 @@ will re-read the catalog."
4231 4231
4232 4232
4233(defvar idlwave-load-rinfo-idle-timer) 4233(defvar idlwave-load-rinfo-idle-timer)
4234(defun idlwave-update-routine-info (&optional arg) 4234(defun idlwave-update-routine-info (&optional arg dont-concentrate)
4235 "Update the internal routine-info lists. 4235 "Update the internal routine-info lists.
4236These lists are used by `idlwave-routine-info' (\\[idlwave-routine-info]) 4236These lists are used by `idlwave-routine-info' (\\[idlwave-routine-info])
4237and by `idlwave-complete' (\\[idlwave-complete]) to provide information 4237and by `idlwave-complete' (\\[idlwave-complete]) to provide information
@@ -4248,10 +4248,12 @@ Scans all IDLWAVE-mode buffers of the current editing session (see
4248When an IDL shell is running, this command also queries the IDL program 4248When an IDL shell is running, this command also queries the IDL program
4249for currently compiled routines. 4249for currently compiled routines.
4250 4250
4251???Document what DONT-CONCENTRATE means???
4252
4251With prefix ARG, also reload the system and library lists. 4253With prefix ARG, also reload the system and library lists.
4252With two prefix ARG's, also rescans the library tree. 4254With two prefix ARG's, also rescans the library tree.
4253With three prefix args, dispatch asynchronous process to do the update." 4255With three prefix args, dispatch asynchronous process to do the update."
4254 (interactive "P") 4256 (interactive "P\np")
4255 ;; Stop any idle processing 4257 ;; Stop any idle processing
4256 (if (or (and (fboundp 'itimerp) 4258 (if (or (and (fboundp 'itimerp)
4257 (itimerp idlwave-load-rinfo-idle-timer)) 4259 (itimerp idlwave-load-rinfo-idle-timer))
@@ -4300,7 +4302,7 @@ With three prefix args, dispatch asynchronous process to do the update."
4300 idlwave-query-shell-for-routine-info))) 4302 idlwave-query-shell-for-routine-info)))
4301 4303
4302 (if (or (not ask-shell) 4304 (if (or (not ask-shell)
4303 (not (interactive-p))) 4305 (not dont-concentrate))
4304 ;; 1. If we are not going to ask the shell, we need to do the 4306 ;; 1. If we are not going to ask the shell, we need to do the
4305 ;; concatenation now. 4307 ;; concatenation now.
4306 ;; 2. When this function is called non-interactively, it means 4308 ;; 2. When this function is called non-interactively, it means
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index 42aabace4d2..cb2a3e2dfcc 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -6120,17 +6120,17 @@ stops due to beginning or end of buffer."
6120 (vhdl-keep-region-active) 6120 (vhdl-keep-region-active)
6121 foundp)) 6121 foundp))
6122 6122
6123(defun vhdl-beginning-of-statement (&optional count lim) 6123(defun vhdl-beginning-of-statement (&optional count lim interactive)
6124 "Go to the beginning of the innermost VHDL statement. 6124 "Go to the beginning of the innermost VHDL statement.
6125With prefix arg, go back N - 1 statements. If already at the 6125With prefix arg, go back N - 1 statements. If already at the
6126beginning of a statement then go to the beginning of the preceding 6126beginning of a statement then go to the beginning of the preceding
6127one. If within a string or comment, or next to a comment (only 6127one. If within a string or comment, or next to a comment (only
6128whitespace between), move by sentences instead of statements. 6128whitespace between), move by sentences instead of statements.
6129 6129
6130When called from a program, this function takes 2 optional args: the 6130When called from a program, this function takes 3 optional args: the
6131prefix arg, and a buffer position limit which is the farthest back to 6131prefix arg, and a buffer position limit which is the farthest back to
6132search." 6132search, and something whose meaning I don't understand."
6133 (interactive "p") 6133 (interactive "p\np")
6134 (let ((count (or count 1)) 6134 (let ((count (or count 1))
6135 (case-fold-search t) 6135 (case-fold-search t)
6136 (lim (or lim (point-min))) 6136 (lim (or lim (point-min)))
@@ -6139,7 +6139,7 @@ search."
6139 (save-excursion 6139 (save-excursion
6140 (goto-char lim) 6140 (goto-char lim)
6141 (setq state (parse-partial-sexp (point) here nil nil))) 6141 (setq state (parse-partial-sexp (point) here nil nil)))
6142 (if (and (interactive-p) 6142 (if (and interactive
6143 (or (nth 3 state) 6143 (or (nth 3 state)
6144 (nth 4 state) 6144 (nth 4 state)
6145 (looking-at (concat "[ \t]*" comment-start-skip)))) 6145 (looking-at (concat "[ \t]*" comment-start-skip))))
@@ -7531,10 +7531,10 @@ buffer."
7531 7531
7532(defun vhdl-fill-region (beg end &optional arg) 7532(defun vhdl-fill-region (beg end &optional arg)
7533 "Fill lines for a region of code." 7533 "Fill lines for a region of code."
7534 (interactive "r") 7534 (interactive "r\np")
7535 (save-excursion 7535 (save-excursion
7536 (goto-char beg) 7536 (goto-char beg)
7537 (let ((margin (if (interactive-p) (current-indentation) (current-column)))) 7537 (let ((margin (if interactive (current-indentation) (current-column))))
7538 (goto-char end) 7538 (goto-char end)
7539 (setq end (point-marker)) 7539 (setq end (point-marker))
7540 ;; remove inline comments, newlines and whitespace 7540 ;; remove inline comments, newlines and whitespace
diff --git a/lisp/reveal.el b/lisp/reveal.el
index 2809db23e2e..393400071a6 100644
--- a/lisp/reveal.el
+++ b/lisp/reveal.el
@@ -1,6 +1,6 @@
1;;; reveal.el --- Automatically reveal hidden text at point 1;;; reveal.el --- Automatically reveal hidden text at point
2 2
3;; Copyright (C) 2000, 2001 Free Software Foundation, Inc. 3;; Copyright (C) 2000, 2001, 2004 Free Software Foundation, Inc.
4 4
5;; Author: Stefan Monnier <monnier@cs.yale.edu> 5;; Author: Stefan Monnier <monnier@cs.yale.edu>
6;; Keywords: outlines 6;; Keywords: outlines
@@ -59,6 +59,9 @@
59(defvar reveal-open-spots nil) 59(defvar reveal-open-spots nil)
60(make-variable-buffer-local 'reveal-open-spots) 60(make-variable-buffer-local 'reveal-open-spots)
61 61
62(defvar reveal-last-tick nil)
63(make-variable-buffer-local 'reveal-last-tick)
64
62;; Actual code 65;; Actual code
63 66
64(defun reveal-post-command () 67(defun reveal-post-command ()
@@ -90,16 +93,16 @@
90 (overlays-at (point)))) 93 (overlays-at (point))))
91 (push (cons (selected-window) ol) reveal-open-spots) 94 (push (cons (selected-window) ol) reveal-open-spots)
92 (setq old-ols (delq ol old-ols)) 95 (setq old-ols (delq ol old-ols))
93 (let ((open (overlay-get ol 'reveal-toggle-invisible))) 96 (let ((open (overlay-get ol 'reveal-toggle-invisible)) inv)
94 (when (or open 97 (when (or open
95 (let ((inv (overlay-get ol 'invisible))) 98 (and (setq inv (overlay-get ol 'invisible))
96 (and inv (symbolp inv) 99 (symbolp inv)
97 (or (setq open (or (get inv 'reveal-toggle-invisible) 100 (or (setq open (or (get inv 'reveal-toggle-invisible)
98 (overlay-get ol 'isearch-open-invisible-temporary))) 101 (overlay-get ol 'isearch-open-invisible-temporary)))
99 (overlay-get ol 'isearch-open-invisible) 102 (overlay-get ol 'isearch-open-invisible)
100 (and (consp buffer-invisibility-spec) 103 (and (consp buffer-invisibility-spec)
101 (assq inv buffer-invisibility-spec))) 104 (assq inv buffer-invisibility-spec)))
102 (overlay-put ol 'reveal-invisible inv)))) 105 (overlay-put ol 'reveal-invisible inv)))
103 (if (null open) 106 (if (null open)
104 (overlay-put ol 'invisible nil) 107 (overlay-put ol 'invisible nil)
105 ;; Use the provided opening function and repeat (since the 108 ;; Use the provided opening function and repeat (since the
@@ -113,27 +116,39 @@
113 (setq repeat nil) 116 (setq repeat nil)
114 (overlay-put ol 'invisible nil)))))))) 117 (overlay-put ol 'invisible nil))))))))
115 ;; Close old overlays. 118 ;; Close old overlays.
116 (dolist (ol old-ols) 119 (if (not (eq reveal-last-tick
117 (when (and (eq (current-buffer) (overlay-buffer ol)) 120 (setq reveal-last-tick (buffer-modified-tick))))
118 (not (rassq ol reveal-open-spots))) 121 ;; The buffer was modified since last command: let's refrain from
119 (if (and (>= (point) (save-excursion 122 ;; closing any overlay because it tends to behave poorly when
120 (goto-char (overlay-start ol)) 123 ;; inserting text at the end of an overlay (basically the overlay
121 (line-beginning-position 1))) 124 ;; should be rear-advance when it's open, but things like
122 (<= (point) (save-excursion 125 ;; outline-minor-mode make it non-rear-advance because it's
123 (goto-char (overlay-end ol)) 126 ;; a better choice when it's closed).
124 (line-beginning-position 2)))) 127 (dolist (ol old-ols)
125 ;; Still near the overlay: keep it open. 128 (push (cons (selected-window) ol) reveal-open-spots))
126 (push (cons (selected-window) ol) reveal-open-spots) 129 ;; The last command was only a point motion or some such
127 ;; Really close it. 130 ;; non-buffer-modifying command. Let's close whatever can be closed.
128 (let ((open (overlay-get ol 'reveal-toggle-invisible)) inv) 131 (dolist (ol old-ols)
129 (if (or open 132 (when (and (eq (current-buffer) (overlay-buffer ol))
130 (and (setq inv (overlay-get ol 'reveal-invisible)) 133 (not (rassq ol reveal-open-spots)))
131 (setq open (or (get inv 'reveal-toggle-invisible) 134 (if (and (>= (point) (save-excursion
132 (overlay-get ol 'isearch-open-invisible-temporary))))) 135 (goto-char (overlay-start ol))
133 (condition-case err 136 (line-beginning-position 1)))
134 (funcall open ol t) 137 (<= (point) (save-excursion
135 (error (message "!!Reveal-hide: %s !!" err))) 138 (goto-char (overlay-end ol))
136 (overlay-put ol 'invisible inv))))))) 139 (line-beginning-position 2))))
140 ;; Still near the overlay: keep it open.
141 (push (cons (selected-window) ol) reveal-open-spots)
142 ;; Really close it.
143 (let ((open (overlay-get ol 'reveal-toggle-invisible)) inv)
144 (if (or open
145 (and (setq inv (overlay-get ol 'reveal-invisible))
146 (setq open (or (get inv 'reveal-toggle-invisible)
147 (overlay-get ol 'isearch-open-invisible-temporary)))))
148 (condition-case err
149 (funcall open ol t)
150 (error (message "!!Reveal-hide: %s !!" err)))
151 (overlay-put ol 'invisible inv))))))))
137 (error (message "Reveal: %s" err))))) 152 (error (message "Reveal: %s" err)))))
138 153
139;;;###autoload 154;;;###autoload
@@ -171,5 +186,5 @@ With zero or negative ARG turn mode off."
171 186
172(provide 'reveal) 187(provide 'reveal)
173 188
174;;; arch-tag: 96ba0242-2274-4ed7-8e10-26bc0707b4d8 189;; arch-tag: 96ba0242-2274-4ed7-8e10-26bc0707b4d8
175;;; reveal.el ends here 190;;; reveal.el ends here
diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el
index f047223cbae..b3149500ae5 100644
--- a/lisp/shadowfile.el
+++ b/lisp/shadowfile.el
@@ -518,8 +518,9 @@ Pending copies are stored in variable `shadow-files-to-copy', and in
518`shadow-save-buffers-kill-emacs', so it is not usually necessary to 518`shadow-save-buffers-kill-emacs', so it is not usually necessary to
519call it manually." 519call it manually."
520 (interactive "P") 520 (interactive "P")
521 (if (and (not shadow-files-to-copy) (interactive-p)) 521 (if (not shadow-files-to-copy)
522 (message "No files need to be shadowed.") 522 (if (interactive-p)
523 (message "No files need to be shadowed."))
523 (save-excursion 524 (save-excursion
524 (map-y-or-n-p (function 525 (map-y-or-n-p (function
525 (lambda (pair) 526 (lambda (pair)
diff --git a/lisp/simple.el b/lisp/simple.el
index 6420ebffd54..cde0e75f030 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1,7 +1,7 @@
1;;; simple.el --- basic editing commands for Emacs 1;;; simple.el --- basic editing commands for Emacs
2 2
3;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99, 3;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99,
4;; 2000, 01, 02, 03, 04 4;; 2000, 01, 02, 03, 2004
5;; Free Software Foundation, Inc. 5;; Free Software Foundation, Inc.
6 6
7;; Maintainer: FSF 7;; Maintainer: FSF
@@ -3916,6 +3916,8 @@ During execution of Lisp code, this character causes a quit directly.
3916At top-level, as an editor command, this simply beeps." 3916At top-level, as an editor command, this simply beeps."
3917 (interactive) 3917 (interactive)
3918 (deactivate-mark) 3918 (deactivate-mark)
3919 (if (fboundp 'kmacro-keyboard-quit)
3920 (kmacro-keyboard-quit))
3919 (setq defining-kbd-macro nil) 3921 (setq defining-kbd-macro nil)
3920 (signal 'quit nil)) 3922 (signal 'quit nil))
3921 3923
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index db16f2f78f3..c182dffdba7 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -354,7 +354,9 @@ Any parameter supported by a frame may be added. The parameter `height'
354will be initialized to the height of the frame speedbar is 354will be initialized to the height of the frame speedbar is
355attached to and added to this list before the new frame is initialized." 355attached to and added to this list before the new frame is initialized."
356 :group 'speedbar 356 :group 'speedbar
357 :type '(repeat (sexp :tag "Parameter:"))) 357 :type '(repeat (cons :format "%v"
358 (symbol :tag "Parameter")
359 (sexp :tag "Value"))))
358 360
359;; These values by Hrvoje Niksic <hniksic@srce.hr> 361;; These values by Hrvoje Niksic <hniksic@srce.hr>
360(defcustom speedbar-frame-plist 362(defcustom speedbar-frame-plist
diff --git a/lisp/strokes.el b/lisp/strokes.el
index 57f1e3355b2..f1121d1fee5 100644
--- a/lisp/strokes.el
+++ b/lisp/strokes.el
@@ -1746,7 +1746,7 @@ Store XPM in buffer BUFNAME if supplied \(default is ` *strokes-xpm*'\)"
1746 (strokes-mode -1) 1746 (strokes-mode -1)
1747 (remove-hook 'kill-emacs-query-functions 'strokes-prompt-user-save-strokes)) 1747 (remove-hook 'kill-emacs-query-functions 'strokes-prompt-user-save-strokes))
1748 1748
1749(add-hooks 'strokes-unload-hook 'strokes-unload-hook) 1749(add-hook 'strokes-unload-hook 'strokes-unload-hook)
1750 1750
1751(run-hooks 'strokes-load-hook) 1751(run-hooks 'strokes-load-hook)
1752(provide 'strokes) 1752(provide 'strokes)
diff --git a/lisp/subr.el b/lisp/subr.el
index 7d666f4c157..54d382dea61 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -817,6 +817,10 @@ is converted into a string by expressing it in decimal."
817(make-obsolete-variable 'post-command-idle-delay 817(make-obsolete-variable 'post-command-idle-delay
818 "use timers instead, with `run-with-idle-timer'." "before 19.34") 818 "use timers instead, with `run-with-idle-timer'." "before 19.34")
819 819
820(defvaralias 'x-lost-selection-hooks 'x-lost-selection-functions)
821(make-obsolete-variable 'x-lost-selection-hooks 'x-lost-selection-functions "21.4")
822(defvaralias 'x-sent-selection-hooks 'x-sent-selection-functions)
823(make-obsolete-variable 'x-sent-selection-hooks 'x-sent-selection-functions "21.4")
820 824
821;;;; Alternate names for functions - these are not being phased out. 825;;;; Alternate names for functions - these are not being phased out.
822 826
@@ -1211,6 +1215,61 @@ any other non-digit terminates the character code and is then used as input."))
1211 (setq first nil)) 1215 (setq first nil))
1212 code)) 1216 code))
1213 1217
1218(defun read-passwd (prompt &optional confirm default)
1219 "Read a password, prompting with PROMPT, and return it.
1220If optional CONFIRM is non-nil, read the password twice to make sure.
1221Optional DEFAULT is a default password to use instead of empty input.
1222
1223This function echoes `.' for each character that the user types.
1224The user ends with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line.
1225C-g quits; if `inhibit-quit' was non-nil around this function,
1226then it returns nil if the user types C-g.
1227
1228Once the caller uses the password, it can erase the password
1229by doing (clear-string STRING)."
1230 (with-local-quit
1231 (if confirm
1232 (let (success)
1233 (while (not success)
1234 (let ((first (read-passwd prompt nil default))
1235 (second (read-passwd "Confirm password: " nil default)))
1236 (if (equal first second)
1237 (progn
1238 (and (arrayp second) (clear-string second))
1239 (setq success first))
1240 (and (arrayp first) (clear-string first))
1241 (and (arrayp second) (clear-string second))
1242 (message "Password not repeated accurately; please start over")
1243 (sit-for 1))))
1244 success)
1245 (let ((pass nil)
1246 (c 0)
1247 (echo-keystrokes 0)
1248 (cursor-in-echo-area t))
1249 (while (progn (message "%s%s"
1250 prompt
1251 (make-string (length pass) ?.))
1252 (setq c (read-char-exclusive nil t))
1253 (and (/= c ?\r) (/= c ?\n) (/= c ?\e)))
1254 (clear-this-command-keys)
1255 (if (= c ?\C-u)
1256 (progn
1257 (and (arrayp pass) (clear-string pass))
1258 (setq pass ""))
1259 (if (and (/= c ?\b) (/= c ?\177))
1260 (let* ((new-char (char-to-string c))
1261 (new-pass (concat pass new-char)))
1262 (and (arrayp pass) (clear-string pass))
1263 (clear-string new-char)
1264 (setq c ?\0)
1265 (setq pass new-pass))
1266 (if (> (length pass) 0)
1267 (let ((new-pass (substring pass 0 -1)))
1268 (and (arrayp pass) (clear-string pass))
1269 (setq pass new-pass))))))
1270 (message nil)
1271 (or pass default "")))))
1272
1214;; This should be used by `call-interactively' for `n' specs. 1273;; This should be used by `call-interactively' for `n' specs.
1215(defun read-number (prompt &optional default) 1274(defun read-number (prompt &optional default)
1216 (let ((n nil)) 1275 (let ((n nil))
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index 181fc9baca5..4fc73288de2 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -580,7 +580,7 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'.
580 ;; Prevent loss of data when saving the file. 580 ;; Prevent loss of data when saving the file.
581 (set (make-local-variable 'file-precious-flag) t) 581 (set (make-local-variable 'file-precious-flag) t)
582 (auto-save-mode 0) 582 (auto-save-mode 0)
583 (set (make-local-variable 'write-contents-hooks) '(tar-mode-write-file)) 583 (set (make-local-variable 'write-contents-functions) '(tar-mode-write-file))
584 (widen) 584 (widen)
585 (if (and (boundp 'tar-header-offset) tar-header-offset) 585 (if (and (boundp 'tar-header-offset) tar-header-offset)
586 (narrow-to-region (point-min) tar-header-offset) 586 (narrow-to-region (point-min) tar-header-offset)
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index ddc1d4ecb62..dd989fbea81 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -42,6 +42,8 @@
42 42
43;;; Code: 43;;; Code:
44 44
45(require 'button)
46
45 47
46;; User Options: 48;; User Options:
47 49
@@ -496,7 +498,7 @@ Each element is a pair of strings (ABBREVIATION . EXPANSION)."
496 498
497(defcustom bibtex-string-files nil 499(defcustom bibtex-string-files nil
498 "*List of BibTeX files containing string definitions. 500 "*List of BibTeX files containing string definitions.
499Those files must be specified using pathnames relative to the 501List elements can be absolute file names or file names relative to the
500directories specified in `bibtex-string-file-path'." 502directories specified in `bibtex-string-file-path'."
501 :group 'bibtex 503 :group 'bibtex
502 :type '(repeat file)) 504 :type '(repeat file))
@@ -504,6 +506,18 @@ directories specified in `bibtex-string-file-path'."
504(defvar bibtex-string-file-path (getenv "BIBINPUTS") 506(defvar bibtex-string-file-path (getenv "BIBINPUTS")
505 "*Colon separated list of paths to search for `bibtex-string-files'.") 507 "*Colon separated list of paths to search for `bibtex-string-files'.")
506 508
509(defcustom bibtex-files nil
510 "*List of BibTeX files checked for duplicate keys.
511List elements can be absolute file names or file names relative to the
512directories specified in `bibtex-file-path'. If an element is a directory,
513check all BibTeX files in this directory. If an element is the symbol
514`bibtex-file-path', check all BibTeX files in `bibtex-file-path'."
515 :group 'bibtex
516 :type '(repeat file))
517
518(defvar bibtex-file-path (getenv "BIBINPUTS")
519 "*Colon separated list of paths to search for `bibtex-files'.")
520
507(defcustom bibtex-help-message t 521(defcustom bibtex-help-message t
508 "*If non-nil print help messages in the echo area on entering a new field." 522 "*If non-nil print help messages in the echo area on entering a new field."
509 :group 'bibtex 523 :group 'bibtex
@@ -557,7 +571,7 @@ See `bibtex-generate-autokey' for details."
557 ;; braces, quotes, concatenation. 571 ;; braces, quotes, concatenation.
558 ("[`'\"{}#]" . "") 572 ("[`'\"{}#]" . "")
559 ;; spaces 573 ;; spaces
560 ("[ \t\n]+" . " ")) 574 ("\\\\?[ \t\n]+\\|~" . " "))
561 "Alist of (OLD-REGEXP . NEW-STRING) pairs. 575 "Alist of (OLD-REGEXP . NEW-STRING) pairs.
562Used by the default values of `bibtex-autokey-name-change-strings' and 576Used by the default values of `bibtex-autokey-name-change-strings' and
563`bibtex-autokey-titleword-change-strings'. Defaults to translating some 577`bibtex-autokey-titleword-change-strings'. Defaults to translating some
@@ -756,12 +770,22 @@ If non-nil, the column for the equal sign is the value of
756 770
757(defcustom bibtex-autoadd-commas t 771(defcustom bibtex-autoadd-commas t
758 "If non-nil automatically add missing commas at end of BibTeX fields." 772 "If non-nil automatically add missing commas at end of BibTeX fields."
773 :group 'bibtex
759 :type 'boolean) 774 :type 'boolean)
760 775
761(defcustom bibtex-autofill-types '("Proceedings") 776(defcustom bibtex-autofill-types '("Proceedings")
762 "Automatically fill fields if possible for those BibTeX entry types." 777 "Automatically fill fields if possible for those BibTeX entry types."
778 :group 'bibtex
763 :type '(repeat string)) 779 :type '(repeat string))
764 780
781(defcustom bibtex-summary-function 'bibtex-summary
782 "Function to call for generating a one-line summary of a BibTeX entry.
783It takes one argument, the key of the entry.
784Used by `bibtex-complete-key-cleanup' and `bibtex-copy-summary-as-kill'."
785 :group 'bibtex
786 :type '(choice (const :tag "Default" bibtex-summary)
787 (function :tag "Personalized function")))
788
765(defcustom bibtex-generate-url-list 789(defcustom bibtex-generate-url-list
766 '((("url" . ".*:.*")) 790 '((("url" . ".*:.*"))
767 ;; Example of a complex setup. 791 ;; Example of a complex setup.
@@ -778,7 +802,7 @@ These schemes are used by `bibtex-url'.
778Each scheme is of the form ((FIELD . REGEXP) STEP...). 802Each scheme is of the form ((FIELD . REGEXP) STEP...).
779 803
780FIELD is a field name as returned by `bibtex-parse-entry'. 804FIELD is a field name as returned by `bibtex-parse-entry'.
781REGEXP is matched against the text of FIELD. If the match succeed, then 805REGEXP is matched against the text of FIELD. If the match succeeds, then
782this scheme will be used. If no STEPS are specified the matched text is used 806this scheme will be used. If no STEPS are specified the matched text is used
783as the URL, otherwise the URL is built by concatenating the STEPS. 807as the URL, otherwise the URL is built by concatenating the STEPS.
784 808
@@ -838,6 +862,7 @@ Case is always ignored. Always remove the field delimiters."
838 (define-key km "\C-c\C-c" 'bibtex-clean-entry) 862 (define-key km "\C-c\C-c" 'bibtex-clean-entry)
839 (define-key km "\C-c\C-q" 'bibtex-fill-entry) 863 (define-key km "\C-c\C-q" 'bibtex-fill-entry)
840 (define-key km "\C-c\C-s" 'bibtex-find-entry) 864 (define-key km "\C-c\C-s" 'bibtex-find-entry)
865 (define-key km "\C-c\C-t" 'bibtex-copy-summary-as-kill)
841 (define-key km "\C-c?" 'bibtex-print-help-message) 866 (define-key km "\C-c?" 'bibtex-print-help-message)
842 (define-key km "\C-c\C-p" 'bibtex-pop-previous) 867 (define-key km "\C-c\C-p" 'bibtex-pop-previous)
843 (define-key km "\C-c\C-n" 'bibtex-pop-next) 868 (define-key km "\C-c\C-n" 'bibtex-pop-next)
@@ -892,7 +917,9 @@ Case is always ignored. Always remove the field delimiters."
892 ("Moving in BibTeX Buffer" 917 ("Moving in BibTeX Buffer"
893 ["Find Entry" bibtex-find-entry t] 918 ["Find Entry" bibtex-find-entry t]
894 ["Find Crossref Entry" bibtex-find-crossref t]) 919 ["Find Crossref Entry" bibtex-find-crossref t])
895 "--" 920 ("Moving between BibTeX Buffers"
921 ["Find Entry Globally" bibtex-find-entry-globally t])
922 "--"
896 ("Operating on Current Field" 923 ("Operating on Current Field"
897 ["Fill Field" fill-paragraph t] 924 ["Fill Field" fill-paragraph t]
898 ["Remove Delimiters" bibtex-remove-delimiters t] 925 ["Remove Delimiters" bibtex-remove-delimiters t]
@@ -922,6 +949,8 @@ Case is always ignored. Always remove the field delimiters."
922 ["Paste Most Recently Killed Entry" bibtex-yank t] 949 ["Paste Most Recently Killed Entry" bibtex-yank t]
923 ["Paste Previously Killed Entry" bibtex-yank-pop t] 950 ["Paste Previously Killed Entry" bibtex-yank-pop t]
924 "--" 951 "--"
952 ["Copy Summary to Kill Ring" bibtex-copy-summary-as-kill t]
953 "--"
925 ["Ispell Entry" bibtex-ispell-entry t] 954 ["Ispell Entry" bibtex-ispell-entry t]
926 ["Ispell Entry Abstract" bibtex-ispell-abstract t] 955 ["Ispell Entry Abstract" bibtex-ispell-abstract t]
927 ["Narrow to Entry" bibtex-narrow-to-entry t] 956 ["Narrow to Entry" bibtex-narrow-to-entry t]
@@ -934,7 +963,9 @@ Case is always ignored. Always remove the field delimiters."
934 ["Reformat Entries" bibtex-reformat t] 963 ["Reformat Entries" bibtex-reformat t]
935 ["Count Entries" bibtex-count-entries t] 964 ["Count Entries" bibtex-count-entries t]
936 "--" 965 "--"
937 ["Convert Alien Buffer" bibtex-convert-alien t]))) 966 ["Convert Alien Buffer" bibtex-convert-alien t])
967 ("Operating on Multiple Buffers"
968 ["Validate Entries" bibtex-validate-globally t])))
938 969
939(easy-menu-define 970(easy-menu-define
940 bibtex-entry-menu bibtex-mode-map "Entry-Types Menu in BibTeX mode" 971 bibtex-entry-menu bibtex-mode-map "Entry-Types Menu in BibTeX mode"
@@ -955,13 +986,6 @@ Case is always ignored. Always remove the field delimiters."
955 ["String" bibtex-String t] 986 ["String" bibtex-String t]
956 ["Preamble" bibtex-Preamble t])) 987 ["Preamble" bibtex-Preamble t]))
957 988
958(defvar bibtex-url-map
959 (let ((km (make-sparse-keymap)))
960 (define-key km [(mouse-2)] 'bibtex-url)
961 km)
962 "Local keymap for clickable URLs.")
963(fset 'bibtex-url-map bibtex-url-map)
964
965 989
966;; Internal Variables 990;; Internal Variables
967 991
@@ -996,8 +1020,9 @@ Initialized from `bibtex-predefined-strings' and `bibtex-string-files'.")
996(make-variable-buffer-local 'bibtex-strings) 1020(make-variable-buffer-local 'bibtex-strings)
997 1021
998(defvar bibtex-reference-keys 1022(defvar bibtex-reference-keys
999 (lazy-completion-table bibtex-reference-keys bibtex-parse-keys nil nil t) 1023 (lazy-completion-table bibtex-reference-keys bibtex-parse-keys nil t)
1000 "Completion table for BibTeX reference keys.") 1024 "Completion table for BibTeX reference keys.
1025The CDRs of the elements are t for header keys and nil for crossref keys.")
1001(make-variable-buffer-local 'bibtex-reference-keys) 1026(make-variable-buffer-local 'bibtex-reference-keys)
1002 1027
1003(defvar bibtex-buffer-last-parsed-tick nil 1028(defvar bibtex-buffer-last-parsed-tick nil
@@ -1103,13 +1128,13 @@ Initialized from `bibtex-predefined-strings' and `bibtex-string-files'.")
1103 (,(concat "^[ \t]*\\(" bibtex-field-name "\\)[ \t]*=") 1128 (,(concat "^[ \t]*\\(" bibtex-field-name "\\)[ \t]*=")
1104 1 font-lock-variable-name-face) 1129 1 font-lock-variable-name-face)
1105 ;; url 1130 ;; url
1106 (bibtex-font-lock-url 0 '(face nil mouse-face highlight 1131 bibtex-font-lock-url bibtex-font-lock-crossref)
1107 keymap bibtex-url-map)))
1108 "*Default expressions to highlight in BibTeX mode.") 1132 "*Default expressions to highlight in BibTeX mode.")
1109 1133
1110(defvar bibtex-font-lock-url-regexp 1134(defvar bibtex-font-lock-url-regexp
1111 (concat "\\<" (regexp-opt (mapcar 'caar bibtex-generate-url-list) t) 1135 ;; Assume that field names begin at the beginning of a line.
1112 "\\>[ \t]*=[ \t]*") 1136 (concat "^[ \t]*" (regexp-opt (mapcar 'caar bibtex-generate-url-list) t)
1137 "[ \t]*=[ \t]*")
1113 "Regexp for `bibtex-font-lock-url'.") 1138 "Regexp for `bibtex-font-lock-url'.")
1114 1139
1115(defvar bibtex-field-name-for-parsing nil 1140(defvar bibtex-field-name-for-parsing nil
@@ -1128,32 +1153,12 @@ Auto-generated from `bibtex-sort-entry-class'.
1128Used when `bibtex-maintain-sorted-entries' is `entry-class'.") 1153Used when `bibtex-maintain-sorted-entries' is `entry-class'.")
1129 1154
1130 1155
1131;; Special support taking care of variants
1132(defvar zmacs-regions)
1133(defalias 'bibtex-mark-active
1134 (if (boundp 'mark-active)
1135 ;; In Emacs mark-active indicates if mark is active.
1136 (lambda () mark-active)
1137 ;; In XEmacs (mark) returns nil when not active.
1138 (lambda () (if zmacs-regions (mark) (mark t)))))
1139
1140(defalias 'bibtex-run-with-idle-timer
1141 (if (fboundp 'run-with-idle-timer)
1142 ;; timer.el is distributed with Emacs
1143 'run-with-idle-timer
1144 ;; timer.el is not distributed with XEmacs
1145 ;; Notice that this does not (yet) pass the arguments, but they
1146 ;; are not used (yet) in bibtex.el. Fix if needed.
1147 (lambda (secs repeat function &rest args)
1148 (start-itimer "bibtex" function secs (if repeat secs nil) t))))
1149
1150
1151;; Support for hideshow minor mode 1156;; Support for hideshow minor mode
1152(defun bibtex-hs-forward-sexp (arg) 1157(defun bibtex-hs-forward-sexp (arg)
1153 "Replacement for `forward-sexp' to be used by `hs-minor-mode'. 1158 "Replacement for `forward-sexp' to be used by `hs-minor-mode'.
1154ARG is ignored." 1159ARG is ignored."
1155 (if (looking-at "@\\S(*\\s(") 1160 (if (looking-at "@\\S(*\\s(")
1156 (goto-char (1- (match-end 0)))) 1161 (goto-char (1- (match-end 0))))
1157 (forward-sexp 1)) 1162 (forward-sexp 1))
1158 1163
1159(add-to-list 1164(add-to-list
@@ -1471,12 +1476,10 @@ delimiters if present."
1471 (buffer-substring-no-properties (1+ (match-beginning bibtex-type-in-head)) 1476 (buffer-substring-no-properties (1+ (match-beginning bibtex-type-in-head))
1472 (match-end bibtex-type-in-head))) 1477 (match-end bibtex-type-in-head)))
1473 1478
1474(defun bibtex-key-in-head (&optional empty) 1479(defsubst bibtex-key-in-head (&optional empty)
1475 "Extract BibTeX key in head. Return optional arg EMPTY if key is empty." 1480 "Extract BibTeX key in head. Return optional arg EMPTY if key is empty."
1476 (if (match-beginning bibtex-key-in-head) 1481 (or (match-string-no-properties bibtex-key-in-head)
1477 (buffer-substring-no-properties (match-beginning bibtex-key-in-head) 1482 empty))
1478 (match-end bibtex-key-in-head))
1479 empty))
1480 1483
1481;; Helper Functions 1484;; Helper Functions
1482 1485
@@ -1492,7 +1495,7 @@ delimiters if present."
1492(defun bibtex-current-line () 1495(defun bibtex-current-line ()
1493 "Compute line number of point regardless whether the buffer is narrowed." 1496 "Compute line number of point regardless whether the buffer is narrowed."
1494 (+ (count-lines 1 (point)) 1497 (+ (count-lines 1 (point))
1495 (if (equal (current-column) 0) 1 0))) 1498 (if (bolp) 1 0)))
1496 1499
1497(defun bibtex-skip-to-valid-entry (&optional backward) 1500(defun bibtex-skip-to-valid-entry (&optional backward)
1498 "Move point to beginning of the next valid BibTeX entry. 1501 "Move point to beginning of the next valid BibTeX entry.
@@ -1525,24 +1528,25 @@ entry is found, nil otherwise."
1525 found)) 1528 found))
1526 1529
1527(defun bibtex-map-entries (fun) 1530(defun bibtex-map-entries (fun)
1528 "Call FUN for each BibTeX entry starting with the current. 1531 "Call FUN for each BibTeX entry in buffer (possibly narrowed).
1529Do this to the end of the file. FUN is called with three arguments, the key of 1532FUN is called with three arguments, the key of the entry and the buffer
1530the entry and the buffer positions (marker) of beginning and end of entry. 1533positions (marker) of beginning and end of entry. Point is inside the entry.
1531Point is inside the entry. If `bibtex-sort-ignore-string-entries' is non-nil, 1534If `bibtex-sort-ignore-string-entries' is non-nil, FUN will not be called for
1532FUN will not be called for @String entries." 1535@String entries."
1533 (let ((case-fold-search t)) 1536 (let ((case-fold-search t))
1534 (bibtex-beginning-of-entry) 1537 (save-excursion
1535 (while (re-search-forward bibtex-entry-head nil t) 1538 (goto-char (point-min))
1536 (let ((entry-type (bibtex-type-in-head)) 1539 (while (re-search-forward bibtex-entry-head nil t)
1537 (key (bibtex-key-in-head "")) 1540 (let ((entry-type (bibtex-type-in-head))
1538 (beg (copy-marker (match-beginning 0))) 1541 (key (bibtex-key-in-head ""))
1539 (end (copy-marker (save-excursion (bibtex-end-of-entry))))) 1542 (beg (copy-marker (match-beginning 0)))
1540 (save-excursion 1543 (end (copy-marker (save-excursion (bibtex-end-of-entry)))))
1541 (if (or (and (not bibtex-sort-ignore-string-entries) 1544 (save-excursion
1542 (bibtex-string= entry-type "string")) 1545 (if (or (and (not bibtex-sort-ignore-string-entries)
1543 (assoc-string entry-type bibtex-entry-field-alist t)) 1546 (bibtex-string= entry-type "string"))
1544 (funcall fun key beg end))) 1547 (assoc-string entry-type bibtex-entry-field-alist t))
1545 (goto-char end))))) 1548 (funcall fun key beg end)))
1549 (goto-char end))))))
1546 1550
1547(defun bibtex-progress-message (&optional flag interval) 1551(defun bibtex-progress-message (&optional flag interval)
1548 "Echo a message about progress of current buffer. 1552 "Echo a message about progress of current buffer.
@@ -1581,13 +1585,13 @@ If FLAG is nil, a message is echoed if point was incremented at least
1581 "\"")) 1585 "\""))
1582 1586
1583(defun bibtex-entry-left-delimiter () 1587(defun bibtex-entry-left-delimiter ()
1584 "Return a string dependent on `bibtex-field-delimiters'." 1588 "Return a string dependent on `bibtex-entry-delimiters'."
1585 (if (equal bibtex-entry-delimiters 'braces) 1589 (if (equal bibtex-entry-delimiters 'braces)
1586 "{" 1590 "{"
1587 "(")) 1591 "("))
1588 1592
1589(defun bibtex-entry-right-delimiter () 1593(defun bibtex-entry-right-delimiter ()
1590 "Return a string dependent on `bibtex-field-delimiters'." 1594 "Return a string dependent on `bibtex-entry-delimiters'."
1591 (if (equal bibtex-entry-delimiters 'braces) 1595 (if (equal bibtex-entry-delimiters 'braces)
1592 "}" 1596 "}"
1593 ")")) 1597 ")"))
@@ -1641,7 +1645,7 @@ are defined, but only for the head part of the entry
1641 (setq infix-start (bibtex-end-of-field bounds)) 1645 (setq infix-start (bibtex-end-of-field bounds))
1642 (setq finished t)) 1646 (setq finished t))
1643 (goto-char infix-start)) 1647 (goto-char infix-start))
1644 ;; This matches the infix* part. The AND construction assures 1648 ;; This matches the infix* part. The AND construction assures
1645 ;; that BOUND is respected. 1649 ;; that BOUND is respected.
1646 (when (and (looking-at bibtex-entry-postfix) 1650 (when (and (looking-at bibtex-entry-postfix)
1647 (eq (char-before (match-end 0)) entry-closer) 1651 (eq (char-before (match-end 0)) entry-closer)
@@ -1826,8 +1830,8 @@ Formats current entry according to variable `bibtex-entry-format'."
1826 (cdr field))) 1830 (cdr field)))
1827 (cdr field)) 1831 (cdr field))
1828 req-field-list (if crossref-key 1832 req-field-list (if crossref-key
1829 (nth 0 (nth 2 entry-list)) ; crossref part 1833 (nth 0 (nth 2 entry-list)) ; crossref part
1830 (nth 0 (nth 1 entry-list)))) ; required part 1834 (nth 0 (nth 1 entry-list)))) ; required part
1831 1835
1832 (dolist (rfield req-field-list) 1836 (dolist (rfield req-field-list)
1833 (when (nth 3 rfield) ; we should have an alternative 1837 (when (nth 3 rfield) ; we should have an alternative
@@ -1864,9 +1868,9 @@ Formats current entry according to variable `bibtex-entry-format'."
1864 deleted) 1868 deleted)
1865 1869
1866 ;; We have more elegant high-level functions for several 1870 ;; We have more elegant high-level functions for several
1867 ;; tasks done by bibtex-format-entry. However, they contain 1871 ;; tasks done by bibtex-format-entry. However, they contain
1868 ;; quite some redundancy compared with what we need to do 1872 ;; quite some redundancy compared with what we need to do
1869 ;; anyway. So for speed-up we avoid using them. 1873 ;; anyway. So for speed-up we avoid using them.
1870 1874
1871 (if (memq 'opts-or-alts format) 1875 (if (memq 'opts-or-alts format)
1872 (cond ((and empty-field 1876 (cond ((and empty-field
@@ -1875,8 +1879,8 @@ Formats current entry according to variable `bibtex-entry-format'."
1875 field-name req-field-list t))) 1879 field-name req-field-list t)))
1876 (or (not field) ; OPT field 1880 (or (not field) ; OPT field
1877 (nth 3 field))))) ; ALT field 1881 (nth 3 field))))) ; ALT field
1878 ;; Either it is an empty ALT field. Then we have checked 1882 ;; Either it is an empty ALT field. Then we have checked
1879 ;; already that we have one non-empty alternative. Or it 1883 ;; already that we have one non-empty alternative. Or it
1880 ;; is an empty OPT field that we do not miss anyway. 1884 ;; is an empty OPT field that we do not miss anyway.
1881 ;; So we can safely delete this field. 1885 ;; So we can safely delete this field.
1882 (delete-region beg-field end-field) 1886 (delete-region beg-field end-field)
@@ -2041,19 +2045,33 @@ applied to the content of FIELD. It is an alist with pairs
2041 (dolist (pattern change-list content) 2045 (dolist (pattern change-list content)
2042 (setq content (replace-regexp-in-string (car pattern) 2046 (setq content (replace-regexp-in-string (car pattern)
2043 (cdr pattern) 2047 (cdr pattern)
2044 content))))) 2048 content t)))))
2045 2049
2046(defun bibtex-autokey-get-names () 2050(defun bibtex-autokey-get-names ()
2047 "Get contents of the name field of the current entry. 2051 "Get contents of the name field of the current entry.
2048Do some modifications based on `bibtex-autokey-name-change-strings' 2052Do some modifications based on `bibtex-autokey-name-change-strings'.
2049and return results as a list." 2053Return the names as a concatenated string obeying `bibtex-autokey-names'
2050 (let ((case-fold-search t) 2054and `bibtex-autokey-names-stretch'."
2051 (names (bibtex-autokey-get-field "author\\|editor" 2055 (let ((names (bibtex-autokey-get-field "author\\|editor"
2052 bibtex-autokey-name-change-strings))) 2056 bibtex-autokey-name-change-strings)))
2053 ;; Some entries do not have a name field. 2057 ;; Some entries do not have a name field.
2054 (unless (string= "" names) 2058 (unless (string= "" names)
2055 (mapcar 'bibtex-autokey-demangle-name 2059 (let* ((case-fold-search t)
2056 (split-string names "[ \t\n]+and[ \t\n]+"))))) 2060 (name-list (mapcar 'bibtex-autokey-demangle-name
2061 (split-string names "[ \t\n]+and[ \t\n]+")))
2062 additional-names)
2063 (unless (or (not (numberp bibtex-autokey-names))
2064 (<= (length name-list)
2065 (+ bibtex-autokey-names
2066 bibtex-autokey-names-stretch)))
2067 ;; Take bibtex-autokey-names elements from beginning of name-list
2068 (setq name-list (nreverse (nthcdr (- (length name-list)
2069 bibtex-autokey-names)
2070 (nreverse name-list)))
2071 additional-names bibtex-autokey-additional-names))
2072 (concat (mapconcat 'identity name-list
2073 bibtex-autokey-name-separator)
2074 additional-names)))))
2057 2075
2058(defun bibtex-autokey-demangle-name (fullname) 2076(defun bibtex-autokey-demangle-name (fullname)
2059 "Get the last part from a well-formed FULLNAME and perform abbreviations." 2077 "Get the last part from a well-formed FULLNAME and perform abbreviations."
@@ -2082,8 +2100,15 @@ and return results as a list."
2082 (funcall bibtex-autokey-name-case-convert name) 2100 (funcall bibtex-autokey-name-case-convert name)
2083 bibtex-autokey-name-length))) 2101 bibtex-autokey-name-length)))
2084 2102
2103(defun bibtex-autokey-get-year ()
2104 "Return year field contents as a string obeying `bibtex-autokey-year-length'."
2105 (let ((yearfield (bibtex-autokey-get-field "year")))
2106 (substring yearfield (max 0 (- (length yearfield)
2107 bibtex-autokey-year-length)))))
2108
2085(defun bibtex-autokey-get-title () 2109(defun bibtex-autokey-get-title ()
2086 "Get title field contents up to a terminator." 2110 "Get title field contents up to a terminator.
2111Return the result as a string"
2087 (let ((case-fold-search t) 2112 (let ((case-fold-search t)
2088 (titlestring 2113 (titlestring
2089 (bibtex-autokey-get-field "title" 2114 (bibtex-autokey-get-field "title"
@@ -2092,35 +2117,37 @@ and return results as a list."
2092 (dolist (terminator bibtex-autokey-title-terminators) 2117 (dolist (terminator bibtex-autokey-title-terminators)
2093 (if (string-match terminator titlestring) 2118 (if (string-match terminator titlestring)
2094 (setq titlestring (substring titlestring 0 (match-beginning 0))))) 2119 (setq titlestring (substring titlestring 0 (match-beginning 0)))))
2095 ;; gather words from titlestring into a list. Ignore 2120 ;; gather words from titlestring into a list. Ignore
2096 ;; specific words and use only a specific amount of words. 2121 ;; specific words and use only a specific amount of words.
2097 (let ((counter 0) 2122 (let ((counter 0)
2098 titlewords titlewords-extra titleword end-match) 2123 titlewords titlewords-extra word)
2099 (while (and (or (not (numberp bibtex-autokey-titlewords)) 2124 (while (and (or (not (numberp bibtex-autokey-titlewords))
2100 (< counter (+ bibtex-autokey-titlewords 2125 (< counter (+ bibtex-autokey-titlewords
2101 bibtex-autokey-titlewords-stretch))) 2126 bibtex-autokey-titlewords-stretch)))
2102 (string-match "\\b\\w+" titlestring)) 2127 (string-match "\\b\\w+" titlestring))
2103 (setq end-match (match-end 0) 2128 (setq word (match-string 0 titlestring)
2104 titleword (substring titlestring 2129 titlestring (substring titlestring (match-end 0)))
2105 (match-beginning 0) end-match)) 2130 ;; Ignore words matched by one of the elements of
2131 ;; bibtex-autokey-titleword-ignore
2106 (unless (let ((lst bibtex-autokey-titleword-ignore)) 2132 (unless (let ((lst bibtex-autokey-titleword-ignore))
2107 (while (and lst 2133 (while (and lst
2108 (not (string-match (concat "\\`\\(?:" (car lst) 2134 (not (string-match (concat "\\`\\(?:" (car lst)
2109 "\\)\\'") titleword))) 2135 "\\)\\'") word)))
2110 (setq lst (cdr lst))) 2136 (setq lst (cdr lst)))
2111 lst) 2137 lst)
2112 (setq titleword 2138 (setq word (funcall bibtex-autokey-titleword-case-convert word)
2113 (funcall bibtex-autokey-titleword-case-convert titleword)) 2139 counter (1+ counter))
2114 (if (or (not (numberp bibtex-autokey-titlewords)) 2140 (if (or (not (numberp bibtex-autokey-titlewords))
2115 (< counter bibtex-autokey-titlewords)) 2141 (< counter bibtex-autokey-titlewords))
2116 (setq titlewords (append titlewords (list titleword))) 2142 (push word titlewords)
2117 (setq titlewords-extra 2143 (push word titlewords-extra))))
2118 (append titlewords-extra (list titleword)))) 2144 ;; Obey bibtex-autokey-titlewords-stretch:
2119 (setq counter (1+ counter))) 2145 ;; If by now we have processed all words in titlestring, we include
2120 (setq titlestring (substring titlestring end-match))) 2146 ;; titlewords-extra in titlewords. Otherwise, we ignore titlewords-extra.
2121 (unless (string-match "\\b\\w+" titlestring) 2147 (unless (string-match "\\b\\w+" titlestring)
2122 (setq titlewords (append titlewords titlewords-extra))) 2148 (setq titlewords (append titlewords-extra titlewords)))
2123 (mapcar 'bibtex-autokey-demangle-title titlewords)))) 2149 (mapconcat 'bibtex-autokey-demangle-title (nreverse titlewords)
2150 bibtex-autokey-titleword-separator))))
2124 2151
2125(defun bibtex-autokey-demangle-title (titleword) 2152(defun bibtex-autokey-demangle-title (titleword)
2126 "Do some abbreviations on TITLEWORD. 2153 "Do some abbreviations on TITLEWORD.
@@ -2211,65 +2238,36 @@ The generation algorithm works as follows:
2211 the key is then presented in the minibuffer to the user, 2238 the key is then presented in the minibuffer to the user,
2212 where it can be edited. The key given by the user is then 2239 where it can be edited. The key given by the user is then
2213 used." 2240 used."
2214 (let* ((name-etal "") 2241 (let* ((names (bibtex-autokey-get-names))
2215 (namelist 2242 (year (bibtex-autokey-get-year))
2216 (let ((nl (bibtex-autokey-get-names)) 2243 (title (bibtex-autokey-get-title))
2217 nnl)
2218 (if (or (not (numberp bibtex-autokey-names))
2219 (<= (length nl)
2220 (+ bibtex-autokey-names
2221 bibtex-autokey-names-stretch)))
2222 nl
2223 (setq name-etal bibtex-autokey-additional-names)
2224 (while (< (length nnl) bibtex-autokey-names)
2225 (setq nnl (append nnl (list (car nl)))
2226 nl (cdr nl)))
2227 nnl)))
2228 (namepart (concat (mapconcat 'identity
2229 namelist
2230 bibtex-autokey-name-separator)
2231 name-etal))
2232 (yearfield (bibtex-autokey-get-field "year"))
2233 (yearpart (if (equal yearfield "")
2234 ""
2235 (substring yearfield
2236 (- (length yearfield)
2237 bibtex-autokey-year-length))))
2238 (titlepart (mapconcat 'identity
2239 (bibtex-autokey-get-title)
2240 bibtex-autokey-titleword-separator))
2241 (autokey (concat bibtex-autokey-prefix-string 2244 (autokey (concat bibtex-autokey-prefix-string
2242 namepart 2245 names
2243 (unless (or (equal namepart "") 2246 (unless (or (equal names "")
2244 (equal yearpart "")) 2247 (equal year ""))
2245 bibtex-autokey-name-year-separator) 2248 bibtex-autokey-name-year-separator)
2246 yearpart 2249 year
2247 (unless (or (and (equal namepart "") 2250 (unless (or (and (equal names "")
2248 (equal yearpart "")) 2251 (equal year ""))
2249 (equal titlepart "")) 2252 (equal title ""))
2250 bibtex-autokey-year-title-separator) 2253 bibtex-autokey-year-title-separator)
2251 titlepart))) 2254 title)))
2252 (if bibtex-autokey-before-presentation-function 2255 (if bibtex-autokey-before-presentation-function
2253 (funcall bibtex-autokey-before-presentation-function autokey) 2256 (funcall bibtex-autokey-before-presentation-function autokey)
2254 autokey))) 2257 autokey)))
2255 2258
2256 2259
2257(defun bibtex-parse-keys (&optional add abortable verbose) 2260(defun bibtex-read-key (prompt &optional key)
2261 "Read BibTeX key from minibuffer using PROMPT and default KEY."
2262 (completing-read prompt bibtex-reference-keys
2263 nil nil key 'bibtex-key-history))
2264
2265(defun bibtex-parse-keys (&optional abortable verbose)
2258 "Set `bibtex-reference-keys' to the keys used in the whole buffer. 2266 "Set `bibtex-reference-keys' to the keys used in the whole buffer.
2259The buffer might possibly be restricted. 2267Find both entry keys and crossref entries. If ABORTABLE is non-nil abort on
2260Find both entry keys and crossref entries. 2268user input. If VERBOSE is non-nil gives messages about progress. Return alist
2261If ADD is non-nil add the new keys to `bibtex-reference-keys' instead of 2269of keys if parsing was completed, `aborted' otherwise."
2262simply resetting it. If ADD is an alist of keys, also add ADD to 2270 (let (ref-keys crossref-keys)
2263`bibtex-reference-keys'. If ABORTABLE is non-nil abort on user
2264input. If VERBOSE is non-nil gives messages about progress.
2265Return alist of keys if parsing was completed, `aborted' otherwise."
2266 (let ((reference-keys (if (and add
2267 (listp bibtex-reference-keys))
2268 bibtex-reference-keys)))
2269 (if (listp add)
2270 (dolist (key add)
2271 (unless (assoc (car key) reference-keys)
2272 (push key reference-keys))))
2273 (save-excursion 2271 (save-excursion
2274 (save-match-data 2272 (save-match-data
2275 (if verbose 2273 (if verbose
@@ -2286,22 +2284,24 @@ Return alist of keys if parsing was completed, `aborted' otherwise."
2286 (if (and abortable (input-pending-p)) 2284 (if (and abortable (input-pending-p))
2287 ;; user has aborted by typing a key --> return `aborted' 2285 ;; user has aborted by typing a key --> return `aborted'
2288 (throw 'userkey 'aborted)) 2286 (throw 'userkey 'aborted))
2289 (let ((key (cond ((match-end 3) 2287 (cond ((match-end 3)
2290 ;; This is a crossref. 2288 ;; This is a crossref.
2291 (buffer-substring-no-properties 2289 (let ((key (buffer-substring-no-properties
2292 (1+ (match-beginning 3)) (1- (match-end 3)))) 2290 (1+ (match-beginning 3)) (1- (match-end 3)))))
2293 ((assoc-string (bibtex-type-in-head) 2291 (unless (assoc key crossref-keys)
2294 bibtex-entry-field-alist t) 2292 (push (list key) crossref-keys))))
2295 ;; This is an entry. 2293 ;; only keys of known entries
2296 (match-string-no-properties bibtex-key-in-head))))) 2294 ((assoc-string (bibtex-type-in-head)
2297 (if (and (stringp key) 2295 bibtex-entry-field-alist t)
2298 (not (assoc key reference-keys))) 2296 ;; This is an entry.
2299 (push (list key) reference-keys))))) 2297 (let ((key (bibtex-key-in-head)))
2298 (unless (assoc key ref-keys)
2299 (push (cons key t) ref-keys)))))))
2300 2300
2301 (let (;; ignore @String entries because they are handled 2301 (let (;; ignore @String entries because they are handled
2302 ;; separately by bibtex-parse-strings 2302 ;; separately by bibtex-parse-strings
2303 (bibtex-sort-ignore-string-entries t) 2303 (bibtex-sort-ignore-string-entries t)
2304 crossref-key bounds) 2304 bounds)
2305 (bibtex-map-entries 2305 (bibtex-map-entries
2306 (lambda (key beg end) 2306 (lambda (key beg end)
2307 (if (and abortable 2307 (if (and abortable
@@ -2309,17 +2309,19 @@ Return alist of keys if parsing was completed, `aborted' otherwise."
2309 ;; user has aborted by typing a key --> return `aborted' 2309 ;; user has aborted by typing a key --> return `aborted'
2310 (throw 'userkey 'aborted)) 2310 (throw 'userkey 'aborted))
2311 (if verbose (bibtex-progress-message)) 2311 (if verbose (bibtex-progress-message))
2312 (unless (assoc key reference-keys) 2312 (unless (assoc key ref-keys)
2313 (push (list key) reference-keys)) 2313 (push (cons key t) ref-keys))
2314 (if (and (setq bounds (bibtex-search-forward-field "crossref" end)) 2314 (if (and (setq bounds (bibtex-search-forward-field "crossref" end))
2315 (setq crossref-key (bibtex-text-in-field-bounds bounds t)) 2315 (setq key (bibtex-text-in-field-bounds bounds t))
2316 (not (assoc crossref-key reference-keys))) 2316 (not (assoc key crossref-keys)))
2317 (push (list crossref-key) reference-keys)))))) 2317 (push (list key) crossref-keys))))))
2318 2318
2319 (dolist (key crossref-keys)
2320 (unless (assoc (car key) ref-keys) (push key ref-keys)))
2319 (if verbose 2321 (if verbose
2320 (bibtex-progress-message 'done)) 2322 (bibtex-progress-message 'done))
2321 ;; successful operation --> return `bibtex-reference-keys' 2323 ;; successful operation --> return `bibtex-reference-keys'
2322 (setq bibtex-reference-keys reference-keys)))))) 2324 (setq bibtex-reference-keys ref-keys))))))
2323 2325
2324(defun bibtex-parse-strings (&optional add abortable) 2326(defun bibtex-parse-strings (&optional add abortable)
2325 "Set `bibtex-strings' to the string definitions in the whole buffer. 2327 "Set `bibtex-strings' to the string definitions in the whole buffer.
@@ -2355,39 +2357,44 @@ Return alist of strings if parsing was completed, `aborted' otherwise."
2355 2357
2356(defun bibtex-string-files-init () 2358(defun bibtex-string-files-init ()
2357 "Return initialization for `bibtex-strings'. 2359 "Return initialization for `bibtex-strings'.
2358Use `bibtex-predefined-strings' and bib files `bibtex-string-files'." 2360Use `bibtex-predefined-strings' and BibTeX files `bibtex-string-files'."
2359 (save-match-data 2361 (save-match-data
2360 ;; collect pathnames 2362 (let ((dirlist (split-string (or bibtex-string-file-path default-directory)
2361 (let ((dirlist (split-string (or bibtex-string-file-path ".")
2362 ":+")) 2363 ":+"))
2363 (case-fold-search) 2364 (case-fold-search)
2364 compl) 2365 string-files fullfilename compl bounds found)
2366 ;; collect absolute file names of valid string files
2365 (dolist (filename bibtex-string-files) 2367 (dolist (filename bibtex-string-files)
2366 (unless (string-match "\\.bib\\'" filename) 2368 (unless (string-match "\\.bib\\'" filename)
2367 (setq filename (concat filename ".bib"))) 2369 (setq filename (concat filename ".bib")))
2368 ;; test filenames 2370 ;; test filenames
2369 (let (fullfilename bounds found) 2371 (if (file-name-absolute-p filename)
2372 (if (file-readable-p filename)
2373 (push filename string-files)
2374 (error "BibTeX strings file %s not found" filename))
2370 (dolist (dir dirlist) 2375 (dolist (dir dirlist)
2371 (when (file-readable-p 2376 (when (file-readable-p
2372 (setq fullfilename (expand-file-name filename dir))) 2377 (setq fullfilename (expand-file-name filename dir)))
2373 ;; file was found 2378 (push fullfilename string-files)
2374 (with-temp-buffer
2375 (insert-file-contents fullfilename)
2376 (goto-char (point-min))
2377 (while (setq bounds (bibtex-search-forward-string))
2378 (push (cons (bibtex-reference-key-in-string bounds)
2379 (bibtex-text-in-string bounds t))
2380 compl)
2381 (goto-char (bibtex-end-of-string bounds))))
2382 (setq found t))) 2379 (setq found t)))
2383 (unless found 2380 (unless found
2384 (error "File %s not in paths defined via bibtex-string-file-path" 2381 (error "File %s not in paths defined via bibtex-string-file-path"
2385 filename)))) 2382 filename))))
2383 ;; parse string files
2384 (dolist (filename string-files)
2385 (with-temp-buffer
2386 (insert-file-contents filename)
2387 (goto-char (point-min))
2388 (while (setq bounds (bibtex-search-forward-string))
2389 (push (cons (bibtex-reference-key-in-string bounds)
2390 (bibtex-text-in-string bounds t))
2391 compl)
2392 (goto-char (bibtex-end-of-string bounds)))))
2386 (append bibtex-predefined-strings (nreverse compl))))) 2393 (append bibtex-predefined-strings (nreverse compl)))))
2387 2394
2388(defun bibtex-parse-buffers-stealthily () 2395(defun bibtex-parse-buffers-stealthily ()
2389 "Parse buffer in the background during idle time. 2396 "Parse buffer in the background during idle time.
2390Called by `bibtex-run-with-idle-timer'. Whenever Emacs has been idle 2397Called by `run-with-idle-timer'. Whenever Emacs has been idle
2391for `bibtex-parse-keys-timeout' seconds, all BibTeX buffers (starting 2398for `bibtex-parse-keys-timeout' seconds, all BibTeX buffers (starting
2392with the current) are parsed." 2399with the current) are parsed."
2393 (save-excursion 2400 (save-excursion
@@ -2402,7 +2409,7 @@ with the current) are parsed."
2402 (widen) 2409 (widen)
2403 ;; Output no progress messages in bibtex-parse-keys 2410 ;; Output no progress messages in bibtex-parse-keys
2404 ;; because when in y-or-n-p that can hide the question. 2411 ;; because when in y-or-n-p that can hide the question.
2405 (if (and (listp (bibtex-parse-keys nil t)) 2412 (if (and (listp (bibtex-parse-keys t))
2406 ;; update bibtex-strings 2413 ;; update bibtex-strings
2407 (listp (bibtex-parse-strings strings-init t))) 2414 (listp (bibtex-parse-strings strings-init t)))
2408 2415
@@ -2410,6 +2417,51 @@ with the current) are parsed."
2410 (setq bibtex-buffer-last-parsed-tick (buffer-modified-tick))))) 2417 (setq bibtex-buffer-last-parsed-tick (buffer-modified-tick)))))
2411 (setq buffers (cdr buffers)))))) 2418 (setq buffers (cdr buffers))))))
2412 2419
2420(defun bibtex-files-expand (&optional current)
2421 "Return an expanded list of BibTeX buffers based on `bibtex-files'.
2422Initialize in these buffers `bibtex-reference-keys' if not yet set.
2423List includes current buffer if CURRENT is non-nil."
2424 (let ((file-path (split-string (or bibtex-file-path default-directory) ":+"))
2425 file-list dir-list buffer-list)
2426 (dolist (file bibtex-files)
2427 (cond ((eq file 'bibtex-file-path)
2428 (setq dir-list (append dir-list file-path)))
2429 ((file-accessible-directory-p file)
2430 (push file dir-list))
2431 ((progn (unless (string-match "\\.bib\\'" file)
2432 (setq file (concat file ".bib")))
2433 (file-name-absolute-p file))
2434 (push file file-list))
2435 (t
2436 (let (fullfilename found)
2437 (dolist (dir file-path)
2438 (when (file-readable-p
2439 (setq fullfilename (expand-file-name file dir)))
2440 (push fullfilename file-list)
2441 (setq found t)))
2442 (unless found
2443 (error "File %s not in paths defined via bibtex-file-path"
2444 file))))))
2445 (dolist (file file-list)
2446 (unless (file-readable-p file)
2447 (error "BibTeX file %s not found" file)))
2448 ;; expand dir-list
2449 (dolist (dir dir-list)
2450 (setq file-list
2451 (append file-list (directory-files dir t "\\.bib\\'" t))))
2452 (delete-dups file-list)
2453 (dolist (file file-list)
2454 (when (file-readable-p file)
2455 (push (find-file-noselect file) buffer-list)
2456 (with-current-buffer (car buffer-list)
2457 (unless (listp bibtex-reference-keys)
2458 (bibtex-parse-keys)))))
2459 (cond ((and current (not (memq (current-buffer) buffer-list)))
2460 (push (current-buffer) buffer-list))
2461 ((and (not current) (memq (current-buffer) buffer-list))
2462 (setq buffer-list (delq (current-buffer) buffer-list))))
2463 buffer-list))
2464
2413(defun bibtex-complete-internal (completions) 2465(defun bibtex-complete-internal (completions)
2414 "Complete word fragment before point to longest prefix of COMPLETIONS. 2466 "Complete word fragment before point to longest prefix of COMPLETIONS.
2415COMPLETIONS should be a list of strings. If point is not after the part 2467COMPLETIONS should be a list of strings. If point is not after the part
@@ -2459,58 +2511,59 @@ expansion of STR using expansion list STRINGS-ALIST."
2459 (bibtex-remove-delimiters)))))))) 2511 (bibtex-remove-delimiters))))))))
2460 2512
2461(defun bibtex-complete-key-cleanup (key) 2513(defun bibtex-complete-key-cleanup (key)
2462 "Display message on entry KEY after completion of a crossref key." 2514 "Display summary message on entry KEY after completion of a crossref key.
2515Use `bibtex-summary-function' to generate summary."
2463 (save-excursion 2516 (save-excursion
2464 ;; Don't do anything if we completed the key of an entry. 2517 ;; Don't do anything if we completed the key of an entry.
2465 (let ((pnt (bibtex-beginning-of-entry))) 2518 (let ((pnt (bibtex-beginning-of-entry)))
2466 (if (and (stringp key) 2519 (if (and (stringp key)
2467 (bibtex-find-entry key) 2520 (bibtex-find-entry key)
2468 (/= pnt (point))) 2521 (/= pnt (point)))
2469 (let* ((bibtex-autokey-name-case-convert 'identity) 2522 (message "Ref: %s" (funcall bibtex-summary-function key))))))
2470 (bibtex-autokey-name-length 'infty) 2523
2471 (nl (bibtex-autokey-get-names)) 2524(defun bibtex-copy-summary-as-kill (key)
2472 (name (concat (nth 0 nl) (if (nth 1 nl) " etal"))) 2525 "Push summery of BibTeX entry KEY to kill ring.
2473 (year (bibtex-autokey-get-field "year")) 2526Use `bibtex-summary-function' to generate summary."
2474 (bibtex-autokey-titlewords 5) 2527 (interactive
2475 (bibtex-autokey-titlewords-stretch 2) 2528 (list (bibtex-read-key
2476 (bibtex-autokey-titleword-case-convert 'identity) 2529 "Key: " (save-excursion
2477 (bibtex-autokey-titleword-length 5) 2530 (bibtex-beginning-of-entry)
2478 (title (mapconcat 'identity 2531 (when (re-search-forward bibtex-entry-head nil t)
2479 (bibtex-autokey-get-title) " ")) 2532 (bibtex-key-in-head))))))
2480 (journal (bibtex-autokey-get-field 2533 (kill-new (message "%s" (funcall bibtex-summary-function key))))
2481 "journal" bibtex-autokey-transcriptions)) 2534
2482 (volume (bibtex-autokey-get-field "volume")) 2535(defun bibtex-summary (key)
2483 (pages (bibtex-autokey-get-field "pages" '(("-.*\\'" . ""))))) 2536 "Return summary of BibTeX entry KEY.
2484 (message "Ref:%s" 2537Used as default value of `bibtex-summary-function'."
2485 (mapconcat (lambda (arg) 2538 ;; It would be neat to customize this function. How?
2486 (if (not (string= "" (cdr arg))) 2539 (save-excursion
2487 (concat (car arg) (cdr arg)))) 2540 (if (bibtex-find-entry key)
2488 `((" " . ,name) (" " . ,year) 2541 (let* ((bibtex-autokey-name-case-convert 'identity)
2489 (": " . ,title) (", " . ,journal) 2542 (bibtex-autokey-name-length 'infty)
2490 (" " . ,volume) (":" . ,pages)) 2543 (bibtex-autokey-names 1)
2491 ""))))))) 2544 (bibtex-autokey-names-stretch 0)
2492 2545 (bibtex-autokey-name-separator " ")
2493(defun bibtex-choose-completion-string (choice buffer mini-p base-size) 2546 (bibtex-autokey-additional-names " etal")
2494 ;; Code borrowed from choose-completion-string: 2547 (names (bibtex-autokey-get-names))
2495 ;; We must duplicate the code from choose-completion-string 2548 (bibtex-autokey-year-length 4)
2496 ;; because it runs the hook choose-completion-string-functions 2549 (year (bibtex-autokey-get-year))
2497 ;; before it inserts the completion. But we want to do something 2550 (bibtex-autokey-titlewords 5)
2498 ;; after the completion has been inserted. 2551 (bibtex-autokey-titlewords-stretch 2)
2499 ;; 2552 (bibtex-autokey-titleword-case-convert 'identity)
2500 ;; Insert the completion into the buffer where it was requested. 2553 (bibtex-autokey-titleword-length 5)
2501 (set-buffer buffer) 2554 (bibtex-autokey-titleword-separator " ")
2502 (if base-size 2555 (title (bibtex-autokey-get-title))
2503 (delete-region (+ base-size (point-min)) 2556 (journal (bibtex-autokey-get-field
2504 (point)) 2557 "journal" bibtex-autokey-transcriptions))
2505 ;; Delete the longest partial match for CHOICE 2558 (volume (bibtex-autokey-get-field "volume"))
2506 ;; that can be found before point. 2559 (pages (bibtex-autokey-get-field "pages" '(("-.*\\'" . "")))))
2507 (choose-completion-delete-max-match choice)) 2560 (mapconcat (lambda (arg)
2508 (insert choice) 2561 (if (not (string= "" (cdr arg)))
2509 (remove-text-properties (- (point) (length choice)) (point) 2562 (concat (car arg) (cdr arg))))
2510 '(mouse-face nil)) 2563 `((" " . ,names) (" " . ,year) (": " . ,title)
2511 ;; Update point in the window that BUFFER is showing in. 2564 (", " . ,journal) (" " . ,volume) (":" . ,pages))
2512 (let ((window (get-buffer-window buffer t))) 2565 ""))
2513 (set-window-point window (point)))) 2566 (error "Key `%s' not found." key))))
2514 2567
2515(defun bibtex-pop (arg direction) 2568(defun bibtex-pop (arg direction)
2516 "Fill current field from the ARG'th same field's text in DIRECTION. 2569 "Fill current field from the ARG'th same field's text in DIRECTION.
@@ -2550,7 +2603,7 @@ Generic function used by `bibtex-pop-previous' and `bibtex-pop-next'."
2550 (if failure 2603 (if failure
2551 (error "No %s matching BibTeX field" 2604 (error "No %s matching BibTeX field"
2552 (if (eq direction 'previous) "previous" "next")) 2605 (if (eq direction 'previous) "previous" "next"))
2553 ;; Found a matching field. Remember boundaries. 2606 ;; Found a matching field. Remember boundaries.
2554 (setq bibtex-pop-previous-search-point (bibtex-start-of-field bounds) 2607 (setq bibtex-pop-previous-search-point (bibtex-start-of-field bounds)
2555 bibtex-pop-next-search-point (bibtex-end-of-field bounds) 2608 bibtex-pop-next-search-point (bibtex-end-of-field bounds)
2556 new-text (bibtex-text-in-field-bounds bounds)) 2609 new-text (bibtex-text-in-field-bounds bounds))
@@ -2563,10 +2616,82 @@ Generic function used by `bibtex-pop-previous' and `bibtex-pop-next'."
2563 (bibtex-find-text nil)) 2616 (bibtex-find-text nil))
2564 (setq this-command 'bibtex-pop)) 2617 (setq this-command 'bibtex-pop))
2565 2618
2566(defsubst bibtex-read-key (prompt &optional key) 2619(defun bibtex-beginning-of-field ()
2567 "Read BibTeX key from minibuffer using PROMPT and default KEY." 2620 "Move point backward to beginning of field.
2568 (completing-read prompt bibtex-reference-keys 2621This function uses a simple, fast algorithm assuming that the field
2569 nil nil key 'bibtex-key-history)) 2622begins at the beginning of a line. We use this function for font-locking."
2623 (let ((field-reg (concat "^[ \t]*" bibtex-field-name "[ \t]*=")))
2624 (beginning-of-line)
2625 (unless (looking-at field-reg)
2626 (re-search-backward field-reg nil t))))
2627
2628(defun bibtex-font-lock-url (bound)
2629 "Font-lock for URLs."
2630 (let ((case-fold-search t)
2631 (pnt (point))
2632 field bounds start end found)
2633 (bibtex-beginning-of-field)
2634 (while (and (not found)
2635 (prog1 (re-search-forward bibtex-font-lock-url-regexp bound t)
2636 (setq field (match-string-no-properties 1)))
2637 (setq bounds (bibtex-parse-field-text))
2638 (progn
2639 (setq start (car bounds) end (cdr bounds))
2640 ;; Always ignore field delimiters
2641 (if (memq (char-before end) '(?\} ?\"))
2642 (setq end (1- end)))
2643 (if (memq (char-after start) '(?\{ ?\"))
2644 (setq start (1+ start)))
2645 (>= bound start)))
2646 (let ((lst bibtex-generate-url-list) url)
2647 (goto-char start)
2648 (while (and (not found)
2649 (setq url (caar lst)))
2650 (setq found (and (bibtex-string= field (car url))
2651 (re-search-forward (cdr url) end t)
2652 (>= (match-beginning 0) pnt))
2653 lst (cdr lst))))
2654 (goto-char end))
2655 (if found (bibtex-button (match-beginning 0) (match-end 0)
2656 'bibtex-url (match-beginning 0)))
2657 found))
2658
2659(defun bibtex-font-lock-crossref (bound)
2660 "Font-lock for crossref fields."
2661 (let ((case-fold-search t)
2662 (pnt (point))
2663 (crossref-reg (concat "^[ \t]*crossref[ \t]*=[ \t\n]*"
2664 "\\(\"[^\"]*\"\\|{[^}]*}\\)[ \t\n]*[,})]"))
2665 start end found)
2666 (bibtex-beginning-of-field)
2667 (while (and (not found)
2668 (re-search-forward crossref-reg bound t))
2669 (setq start (1+ (match-beginning 1))
2670 end (1- (match-end 1))
2671 found (>= start pnt)))
2672 (if found (bibtex-button start end 'bibtex-find-crossref
2673 (buffer-substring-no-properties start end)
2674 start t))
2675 found))
2676
2677(defun bibtex-button-action (button)
2678 "Call BUTTON's BibTeX function."
2679 (apply (button-get button 'bibtex-function)
2680 (button-get button 'bibtex-args)))
2681
2682(define-button-type 'bibtex-url
2683 'action 'bibtex-button-action
2684 'bibtex-function 'bibtex-url
2685 'help-echo (purecopy "mouse-2, RET: follow URL"))
2686
2687(define-button-type 'bibtex-find-crossref
2688 'action 'bibtex-button-action
2689 'bibtex-function 'bibtex-find-crossref
2690 'help-echo (purecopy "mouse-2, RET: follow crossref"))
2691
2692(defun bibtex-button (beg end type &rest args)
2693 (make-text-button beg end 'type type 'bibtex-args args))
2694
2570 2695
2571;; Interactive Functions: 2696;; Interactive Functions:
2572 2697
@@ -2668,7 +2793,7 @@ non-nil.
2668 (make-local-variable 'bibtex-buffer-last-parsed-tick) 2793 (make-local-variable 'bibtex-buffer-last-parsed-tick)
2669 ;; Install stealthy parse function if not already installed 2794 ;; Install stealthy parse function if not already installed
2670 (unless bibtex-parse-idle-timer 2795 (unless bibtex-parse-idle-timer
2671 (setq bibtex-parse-idle-timer (bibtex-run-with-idle-timer 2796 (setq bibtex-parse-idle-timer (run-with-idle-timer
2672 bibtex-parse-keys-timeout t 2797 bibtex-parse-keys-timeout t
2673 'bibtex-parse-buffers-stealthily))) 2798 'bibtex-parse-buffers-stealthily)))
2674 (set (make-local-variable 'paragraph-start) "[ \f\n\t]*$") 2799 (set (make-local-variable 'paragraph-start) "[ \f\n\t]*$")
@@ -2680,8 +2805,8 @@ non-nil.
2680 (set (make-local-variable 'outline-regexp) "[ \t]*@") 2805 (set (make-local-variable 'outline-regexp) "[ \t]*@")
2681 (set (make-local-variable 'fill-paragraph-function) 'bibtex-fill-field) 2806 (set (make-local-variable 'fill-paragraph-function) 'bibtex-fill-field)
2682 (set (make-local-variable 'fill-prefix) (make-string (+ bibtex-entry-offset 2807 (set (make-local-variable 'fill-prefix) (make-string (+ bibtex-entry-offset
2683 bibtex-contline-indentation) 2808 bibtex-contline-indentation)
2684 ? )) 2809 ? ))
2685 (set (make-local-variable 'font-lock-defaults) 2810 (set (make-local-variable 'font-lock-defaults)
2686 '(bibtex-font-lock-keywords 2811 '(bibtex-font-lock-keywords
2687 nil t ((?$ . "\"") 2812 nil t ((?$ . "\"")
@@ -2693,7 +2818,7 @@ non-nil.
2693 ) 2818 )
2694 nil 2819 nil
2695 (font-lock-syntactic-keywords . bibtex-font-lock-syntactic-keywords) 2820 (font-lock-syntactic-keywords . bibtex-font-lock-syntactic-keywords)
2696 (font-lock-extra-managed-props . (mouse-face keymap)) 2821 (font-lock-extra-managed-props . (category))
2697 (font-lock-mark-block-function 2822 (font-lock-mark-block-function
2698 . (lambda () 2823 . (lambda ()
2699 (set-mark (bibtex-end-of-entry)) 2824 (set-mark (bibtex-end-of-entry))
@@ -2776,8 +2901,7 @@ according to `bibtex-entry-field-alist', but are not yet present."
2776 ;; bibtex-parse-entry moves point to the end of the last field. 2901 ;; bibtex-parse-entry moves point to the end of the last field.
2777 (let* ((fields-alist (bibtex-parse-entry)) 2902 (let* ((fields-alist (bibtex-parse-entry))
2778 (field-list (bibtex-field-list 2903 (field-list (bibtex-field-list
2779 (substring (cdr (assoc "=type=" fields-alist)) 2904 (cdr (assoc "=type=" fields-alist)))))
2780 1)))) ; don't want @
2781 (dolist (field (car field-list)) 2905 (dolist (field (car field-list))
2782 (unless (assoc-string (car field) fields-alist t) 2906 (unless (assoc-string (car field) fields-alist t)
2783 (bibtex-make-field field))) 2907 (bibtex-make-field field)))
@@ -2793,8 +2917,8 @@ TEXT may be nil. Remove \"OPT\" and \"ALT\" from FIELD.
2793Move point to the end of the last field." 2917Move point to the end of the last field."
2794 (let (alist bounds) 2918 (let (alist bounds)
2795 (when (looking-at bibtex-entry-maybe-empty-head) 2919 (when (looking-at bibtex-entry-maybe-empty-head)
2796 (push (cons "=type=" (match-string bibtex-type-in-head)) alist) 2920 (push (cons "=type=" (bibtex-type-in-head)) alist)
2797 (push (cons "=key=" (match-string bibtex-key-in-head)) alist) 2921 (push (cons "=key=" (bibtex-key-in-head)) alist)
2798 (goto-char (match-end 0)) 2922 (goto-char (match-end 0))
2799 (while (setq bounds (bibtex-parse-field bibtex-field-name)) 2923 (while (setq bounds (bibtex-parse-field bibtex-field-name))
2800 (push (cons (bibtex-name-in-field bounds t) 2924 (push (cons (bibtex-name-in-field bounds t)
@@ -2809,8 +2933,8 @@ Move point to the end of the last field."
2809 (undo-boundary) ;So you can easily undo it, if it didn't work right. 2933 (undo-boundary) ;So you can easily undo it, if it didn't work right.
2810 (bibtex-beginning-of-entry) 2934 (bibtex-beginning-of-entry)
2811 (when (looking-at bibtex-entry-head) 2935 (when (looking-at bibtex-entry-head)
2812 (let ((type (match-string bibtex-type-in-head)) 2936 (let ((type (bibtex-type-in-head))
2813 (key (match-string bibtex-key-in-head)) 2937 (key (bibtex-key-in-head))
2814 (key-end (match-end bibtex-key-in-head)) 2938 (key-end (match-end bibtex-key-in-head))
2815 (case-fold-search t) 2939 (case-fold-search t)
2816 tmp other-key other bounds) 2940 tmp other-key other bounds)
@@ -2823,9 +2947,9 @@ Move point to the end of the last field."
2823 (bibtex-beginning-of-entry) 2947 (bibtex-beginning-of-entry)
2824 (when (and 2948 (when (and
2825 (looking-at bibtex-entry-head) 2949 (looking-at bibtex-entry-head)
2826 (bibtex-string= type (match-string bibtex-type-in-head)) 2950 (bibtex-string= type (bibtex-type-in-head))
2827 ;; In case we found ourselves :-( 2951 ;; In case we found ourselves :-(
2828 (not (equal key (setq tmp (match-string bibtex-key-in-head))))) 2952 (not (equal key (setq tmp (bibtex-key-in-head)))))
2829 (setq other-key tmp) 2953 (setq other-key tmp)
2830 (setq other (point)))) 2954 (setq other (point))))
2831 (save-excursion 2955 (save-excursion
@@ -2833,9 +2957,9 @@ Move point to the end of the last field."
2833 (bibtex-skip-to-valid-entry) 2957 (bibtex-skip-to-valid-entry)
2834 (when (and 2958 (when (and
2835 (looking-at bibtex-entry-head) 2959 (looking-at bibtex-entry-head)
2836 (bibtex-string= type (match-string bibtex-type-in-head)) 2960 (bibtex-string= type (bibtex-type-in-head))
2837 ;; In case we found ourselves :-( 2961 ;; In case we found ourselves :-(
2838 (not (equal key (setq tmp (match-string bibtex-key-in-head)))) 2962 (not (equal key (setq tmp (bibtex-key-in-head))))
2839 (or (not other-key) 2963 (or (not other-key)
2840 ;; Check which is the best match. 2964 ;; Check which is the best match.
2841 (< (length (try-completion "" (list key other-key))) 2965 (< (length (try-completion "" (list key other-key)))
@@ -2883,24 +3007,26 @@ Move point to the end of the last field."
2883 (message (nth 1 comment)) 3007 (message (nth 1 comment))
2884 (message "No comment available"))))) 3008 (message "No comment available")))))
2885 3009
2886(defun bibtex-make-field (field &optional called-by-yank) 3010(defun bibtex-make-field (field &optional called-by-yank interactive)
2887 "Make a field named FIELD in current BibTeX entry. 3011 "Make a field named FIELD in current BibTeX entry.
2888FIELD is either a string or a list of the form 3012FIELD is either a string or a list of the form
2889\(FIELD-NAME COMMENT-STRING INIT ALTERNATIVE-FLAG) as in 3013\(FIELD-NAME COMMENT-STRING INIT ALTERNATIVE-FLAG) as in
2890`bibtex-entry-field-alist'. 3014`bibtex-entry-field-alist'.
2891If CALLED-BY-YANK is non-nil, don't insert delimiters." 3015If CALLED-BY-YANK is non-nil, don't insert delimiters.
3016In that case, or when called interactively, also don't do (WHAT?)."
2892 (interactive 3017 (interactive
2893 (list (let ((completion-ignore-case t) 3018 (list (let ((completion-ignore-case t)
2894 (field-list (bibtex-field-list 3019 (field-list (bibtex-field-list
2895 (save-excursion 3020 (save-excursion
2896 (bibtex-enclosing-entry-maybe-empty-head) 3021 (bibtex-enclosing-entry-maybe-empty-head)
2897 (bibtex-type-in-head))))) 3022 (bibtex-type-in-head)))))
2898 (completing-read "BibTeX field name: " 3023 (completing-read "BibTeX field name: "
2899 (append (car field-list) (cdr field-list)) 3024 (append (car field-list) (cdr field-list))
2900 nil nil nil bibtex-field-history)))) 3025 nil nil nil bibtex-field-history))
3026 t))
2901 (unless (consp field) 3027 (unless (consp field)
2902 (setq field (list field))) 3028 (setq field (list field)))
2903 (if (or (interactive-p) called-by-yank) 3029 (if (or interactive called-by-yank)
2904 (let (bibtex-help-message) 3030 (let (bibtex-help-message)
2905 (bibtex-find-text nil t t) 3031 (bibtex-find-text nil t t)
2906 (if (looking-at "[}\"]") 3032 (if (looking-at "[}\"]")
@@ -2923,7 +3049,7 @@ If CALLED-BY-YANK is non-nil, don't insert delimiters."
2923 ((fboundp init) 3049 ((fboundp init)
2924 (insert (funcall init))))) 3050 (insert (funcall init)))))
2925 (unless called-by-yank (insert (bibtex-field-right-delimiter))) 3051 (unless called-by-yank (insert (bibtex-field-right-delimiter)))
2926 (when (interactive-p) 3052 (when interactive
2927 (forward-char -1) 3053 (forward-char -1)
2928 (bibtex-print-help-message))) 3054 (bibtex-print-help-message)))
2929 3055
@@ -3003,17 +3129,13 @@ If mark is active it counts entries in region, if not in whole buffer."
3003 (not count-string-entries))) 3129 (not count-string-entries)))
3004 (save-excursion 3130 (save-excursion
3005 (save-restriction 3131 (save-restriction
3006 (narrow-to-region (if (bibtex-mark-active) 3132 (narrow-to-region (if mark-active (region-beginning)
3007 (region-beginning)
3008 (bibtex-beginning-of-first-entry)) 3133 (bibtex-beginning-of-first-entry))
3009 (if (bibtex-mark-active) 3134 (if mark-active (region-end) (point-max)))
3010 (region-end)
3011 (point-max)))
3012 (goto-char (point-min))
3013 (bibtex-map-entries (lambda (key beg end) 3135 (bibtex-map-entries (lambda (key beg end)
3014 (setq number (1+ number)))))) 3136 (setq number (1+ number))))))
3015 (message "%s contains %d entries." 3137 (message "%s contains %d entries."
3016 (if (bibtex-mark-active) "Region" "Buffer") 3138 (if mark-active "Region" "Buffer")
3017 number))) 3139 number)))
3018 3140
3019(defun bibtex-ispell-entry () 3141(defun bibtex-ispell-entry ()
@@ -3110,12 +3232,39 @@ will be ignored."
3110 nil ; ENDKEY function 3232 nil ; ENDKEY function
3111 'bibtex-lessp))) ; PREDICATE 3233 'bibtex-lessp))) ; PREDICATE
3112 3234
3113(defun bibtex-find-crossref (crossref-key) 3235(defun bibtex-find-entry-globally (key)
3236 "Move point to the beginning of BibTeX entry named KEY in `bibtex-files'."
3237 (interactive
3238 (list (let (key-alist)
3239 (dolist (buffer (bibtex-files-expand t))
3240 (with-current-buffer buffer
3241 (setq key-alist (append bibtex-reference-keys key-alist))))
3242 (completing-read "Find key: " key-alist
3243 nil nil nil 'bibtex-key-history))))
3244 (let ((buffer-list (bibtex-files-expand t))
3245 buffer found)
3246 (while (and (not found)
3247 (setq buffer (pop buffer-list)))
3248 (with-current-buffer buffer
3249 (if (cdr (assoc-string key bibtex-reference-keys))
3250 (setq found t))))
3251 (if found
3252 (progn
3253 (let ((same-window-buffer-names
3254 (cons (buffer-name buffer) same-window-buffer-names)))
3255 (pop-to-buffer buffer))
3256 (bibtex-find-entry key))
3257 (message "Key `%s' not found" key))))
3258
3259(defun bibtex-find-crossref (crossref-key &optional pnt split)
3114 "Move point to the beginning of BibTeX entry CROSSREF-KEY. 3260 "Move point to the beginning of BibTeX entry CROSSREF-KEY.
3115Return position of entry if CROSSREF-KEY is found and nil otherwise. 3261Return position of entry if CROSSREF-KEY is found and nil otherwise.
3116If position of current entry is after CROSSREF-KEY an error is signaled. 3262If position of current entry is after CROSSREF-KEY an error is signaled.
3263Optional arg PNT is the position of the referencing entry.
3264If optional arg SPLIT is non-nil, split window so that both the referencing
3265and the crossrefed entry are displayed.
3117If called interactively, CROSSREF-KEY defaults to crossref key of current 3266If called interactively, CROSSREF-KEY defaults to crossref key of current
3118entry." 3267entry and SPLIT is t."
3119 (interactive 3268 (interactive
3120 (let ((crossref-key 3269 (let ((crossref-key
3121 (save-excursion 3270 (save-excursion
@@ -3123,11 +3272,23 @@ entry."
3123 (let ((bounds (bibtex-search-forward-field "crossref" t))) 3272 (let ((bounds (bibtex-search-forward-field "crossref" t)))
3124 (if bounds 3273 (if bounds
3125 (bibtex-text-in-field-bounds bounds t)))))) 3274 (bibtex-text-in-field-bounds bounds t))))))
3126 (list (bibtex-read-key "Find crossref key: " crossref-key)))) 3275 (list (bibtex-read-key "Find crossref key: " crossref-key) (point) t)))
3127 (let ((pos (save-excursion (bibtex-find-entry crossref-key)))) 3276 (let ((pos (save-excursion (bibtex-find-entry crossref-key))))
3128 (if (and pos (> (point) pos)) 3277 (unless pnt (setq pnt (point)))
3129 (error "This entry must not follow the crossrefed entry!")) 3278 (cond ((not pos)
3130 (goto-char pos))) 3279 (message "Crossref key `%s' not found" crossref-key))
3280 (split
3281 (goto-char pnt)
3282 (select-window (split-window))
3283 (goto-char pos)
3284 (beginning-of-line)
3285 (set-window-start (selected-window) (point))
3286 (if (> pnt pos)
3287 (error "The referencing entry must preceed the crossrefed entry!")))
3288 ((> pnt pos)
3289 (error "The referencing entry must preceed the crossrefed entry!"))
3290 (t (goto-char pos)))
3291 pos))
3131 3292
3132(defun bibtex-find-entry (key &optional start) 3293(defun bibtex-find-entry (key &optional start)
3133 "Move point to the beginning of BibTeX entry named KEY. 3294 "Move point to the beginning of BibTeX entry named KEY.
@@ -3212,23 +3373,21 @@ Return t if preparation was successful or nil if entry KEY already exists."
3212 3373
3213(defun bibtex-validate (&optional test-thoroughly) 3374(defun bibtex-validate (&optional test-thoroughly)
3214 "Validate if buffer or region is syntactically correct. 3375 "Validate if buffer or region is syntactically correct.
3215Only known entry types are checked, so you can put comments 3376Check also for duplicate keys and correct sort order provided
3216outside of entries. 3377`bibtex-maintain-sorted-entries' is non-nil.
3217With optional argument TEST-THOROUGHLY non-nil it checks for absence of 3378With optional argument TEST-THOROUGHLY non-nil check also for
3218required fields and questionable month fields as well. 3379the absence of required fields and for questionable month fields.
3219If mark is active, validate current region, if not the whole buffer. 3380If mark is active, validate current region, if not the whole buffer.
3220Returns t if test was successful, nil otherwise." 3381Only check known entry types, so you can put comments outside of entries.
3382Return t if test was successful, nil otherwise."
3221 (interactive "P") 3383 (interactive "P")
3222 (let* ((case-fold-search t) 3384 (let* ((case-fold-search t)
3223 error-list syntax-error) 3385 error-list syntax-error)
3224 (save-excursion 3386 (save-excursion
3225 (save-restriction 3387 (save-restriction
3226 (narrow-to-region (if (bibtex-mark-active) 3388 (narrow-to-region (if mark-active (region-beginning)
3227 (region-beginning)
3228 (bibtex-beginning-of-first-entry)) 3389 (bibtex-beginning-of-first-entry))
3229 (if (bibtex-mark-active) 3390 (if mark-active (region-end) (point-max)))
3230 (region-end)
3231 (point-max)))
3232 3391
3233 ;; looking if entries fit syntactical structure 3392 ;; looking if entries fit syntactical structure
3234 (goto-char (point-min)) 3393 (goto-char (point-min))
@@ -3244,41 +3403,54 @@ Returns t if test was successful, nil otherwise."
3244 (if (equal (point) pnt) 3403 (if (equal (point) pnt)
3245 (forward-char) 3404 (forward-char)
3246 (goto-char pnt) 3405 (goto-char pnt)
3247 (push (list (bibtex-current-line) 3406 (push (cons (bibtex-current-line)
3248 "Syntax error (check esp. commas, braces, and quotes)") 3407 "Syntax error (check esp. commas, braces, and quotes)")
3249 error-list) 3408 error-list)
3250 (forward-char)))))) 3409 (forward-char))))))
3251 (bibtex-progress-message 'done) 3410 (bibtex-progress-message 'done)
3252 3411
3253 (if error-list 3412 (if error-list
3413 ;; proceed only if there were no syntax errors.
3254 (setq syntax-error t) 3414 (setq syntax-error t)
3255 ;; looking for correct sort order and duplicates (only if 3415
3256 ;; there were no syntax errors) 3416 ;; looking for duplicate keys and correct sort order
3257 (if bibtex-maintain-sorted-entries 3417 (let (previous current key-list)
3258 (let (previous current) 3418 (bibtex-progress-message "Checking for duplicate keys")
3259 (goto-char (point-min)) 3419 (bibtex-map-entries
3260 (bibtex-progress-message "Checking correct sort order") 3420 (lambda (key beg end)
3261 (bibtex-map-entries 3421 (bibtex-progress-message)
3262 (lambda (key beg end) 3422 (goto-char beg)
3263 (bibtex-progress-message) 3423 (setq current (bibtex-entry-index))
3264 (goto-char beg) 3424 (cond ((not previous))
3265 (setq current (bibtex-entry-index)) 3425 ((member key key-list)
3266 (cond ((or (not previous) 3426 (push (cons (bibtex-current-line)
3267 (bibtex-lessp previous current)) 3427 (format "Duplicate key `%s'" key))
3268 (setq previous current)) 3428 error-list))
3269 ((string-equal (car previous) (car current)) 3429 ((and bibtex-maintain-sorted-entries
3270 (push (list (bibtex-current-line) 3430 (not (bibtex-lessp previous current)))
3271 "Duplicate key with previous") 3431 (push (cons (bibtex-current-line)
3272 error-list)) 3432 "Entries out of order")
3273 (t 3433 error-list)))
3274 (setq previous current) 3434 (push key key-list)
3275 (push (list (bibtex-current-line) 3435 (setq previous current)))
3276 "Entries out of order") 3436 (bibtex-progress-message 'done))
3277 error-list))))) 3437
3278 (bibtex-progress-message 'done))) 3438 ;; Check for duplicate keys in `bibtex-files'.
3439 (bibtex-parse-keys)
3440 (dolist (buffer (bibtex-files-expand))
3441 (dolist (key (with-current-buffer buffer
3442 ;; We don't want to be fooled by outdated
3443 ;; bibtex-reference-keys.
3444 (bibtex-parse-keys) bibtex-reference-keys))
3445 (when (and (cdr key)
3446 (cdr (assoc-string (car key) bibtex-reference-keys)))
3447 (bibtex-find-entry (car key))
3448 (push (cons (bibtex-current-line)
3449 (format "Duplicate key `%s' in %s" (car key)
3450 (abbreviate-file-name (buffer-file-name buffer))))
3451 error-list))))
3279 3452
3280 (when test-thoroughly 3453 (when test-thoroughly
3281 (goto-char (point-min))
3282 (bibtex-progress-message 3454 (bibtex-progress-message
3283 "Checking required fields and month fields") 3455 "Checking required fields and month fields")
3284 (let ((bibtex-sort-ignore-string-entries t)) 3456 (let ((bibtex-sort-ignore-string-entries t))
@@ -3292,73 +3464,135 @@ Returns t if test was successful, nil otherwise."
3292 bibtex-entry-field-alist t))) 3464 bibtex-entry-field-alist t)))
3293 (req (copy-sequence (elt (elt entry-list 1) 0))) 3465 (req (copy-sequence (elt (elt entry-list 1) 0)))
3294 (creq (copy-sequence (elt (elt entry-list 2) 0))) 3466 (creq (copy-sequence (elt (elt entry-list 2) 0)))
3295 crossref-there bounds) 3467 crossref-there bounds alt-there field)
3296 (goto-char beg) 3468 (goto-char beg)
3297 (while (setq bounds (bibtex-search-forward-field 3469 (while (setq bounds (bibtex-search-forward-field
3298 bibtex-field-name end)) 3470 bibtex-field-name end))
3299 (goto-char (bibtex-start-of-text-in-field bounds)) 3471 (goto-char (bibtex-start-of-text-in-field bounds))
3300 (let ((field-name (bibtex-name-in-field bounds))) 3472 (let ((field-name (bibtex-name-in-field bounds)))
3301 (if (and (bibtex-string= field-name "month") 3473 (if (and (bibtex-string= field-name "month")
3302 (not (assoc-string (bibtex-text-in-field-bounds bounds) 3474 ;; Check only abbreviated month fields.
3303 bibtex-predefined-month-strings t))) 3475 (let ((month (bibtex-text-in-field-bounds bounds)))
3304 (push (list (bibtex-current-line) 3476 (not (or (string-match "\\`[\"{].+[\"}]\\'" month)
3477 (assoc-string
3478 month
3479 bibtex-predefined-month-strings t)))))
3480 (push (cons (bibtex-current-line)
3305 "Questionable month field") 3481 "Questionable month field")
3306 error-list)) 3482 error-list))
3307 (setq req (delete (assoc-string field-name req t) req) 3483 (setq field (assoc-string field-name req t))
3484 (if (nth 3 field)
3485 (if alt-there (push (cons (bibtex-current-line)
3486 "More than one non-empty alternative")
3487 error-list)
3488 (setq alt-there t)))
3489 (setq req (delete field req)
3308 creq (delete (assoc-string field-name creq t) creq)) 3490 creq (delete (assoc-string field-name creq t) creq))
3309 (if (bibtex-string= field-name "crossref") 3491 (if (bibtex-string= field-name "crossref")
3310 (setq crossref-there t)))) 3492 (setq crossref-there t))))
3311 (if crossref-there 3493 (if crossref-there
3312 (setq req creq)) 3494 (setq req creq))
3313 (if (or (> (length req) 1) 3495 (let (alt)
3314 (and (= (length req) 1) 3496 (dolist (field req)
3315 (not (elt (car req) 3)))) 3497 (if (nth 3 field)
3316 ;; two (or more) fields missed or one field 3498 (push (car field) alt)
3317 ;; missed and this isn't flagged alternative 3499 (push (cons (save-excursion (goto-char beg)
3318 ;; (notice that this fails if there are more 3500 (bibtex-current-line))
3319 ;; than two alternatives in a BibTeX entry, 3501 (format "Required field `%s' missing"
3320 ;; which isn't the case momentarily) 3502 (car field)))
3321 (push (list (save-excursion 3503 error-list)))
3322 (bibtex-beginning-of-entry) 3504 ;; The following fails if there are more than two
3323 (bibtex-current-line)) 3505 ;; alternatives in a BibTeX entry, which isn't
3324 (concat "Required field `" (caar req) "' missing")) 3506 ;; the case momentarily.
3325 error-list)))))) 3507 (if (cdr alt)
3508 (push (cons (save-excursion (goto-char beg)
3509 (bibtex-current-line))
3510 (format "Alternative fields `%s'/`%s' missing"
3511 (car alt) (cadr alt)))
3512 error-list)))))))
3326 (bibtex-progress-message 'done))))) 3513 (bibtex-progress-message 'done)))))
3514
3327 (if error-list 3515 (if error-list
3328 (let ((bufnam (buffer-name)) 3516 (let ((file (file-name-nondirectory (buffer-file-name)))
3329 (dir default-directory)) 3517 (dir default-directory)
3330 (setq error-list 3518 (err-buf "*BibTeX validation errors*"))
3331 (sort error-list 3519 (setq error-list (sort error-list 'car-less-than-car))
3332 (lambda (a b) 3520 (with-current-buffer (get-buffer-create err-buf)
3333 (< (car a) (car b))))) 3521 (setq default-directory dir)
3334 (let ((pop-up-windows t)) 3522 (unless (eq major-mode 'compilation-mode) (compilation-mode))
3335 (pop-to-buffer nil t)) 3523 (toggle-read-only -1)
3336 (switch-to-buffer 3524 (delete-region (point-min) (point-max))
3337 (get-buffer-create "*BibTeX validation errors*") t) 3525 (insert "BibTeX mode command `bibtex-validate'\n"
3338 ;; don't use switch-to-buffer-other-window, since this 3526 (if syntax-error
3339 ;; doesn't allow the second parameter NORECORD 3527 "Maybe undetected errors due to syntax errors. Correct and validate again.\n"
3340 (setq default-directory dir) 3528 "\n"))
3341 (toggle-read-only -1) 3529 (dolist (err error-list)
3342 (compilation-mode) 3530 (insert (format "%s:%d: %s\n" file (car err) (cdr err))))
3343 (delete-region (point-min) (point-max)) 3531 (set-buffer-modified-p nil)
3344 (goto-char (point-min)) 3532 (toggle-read-only 1)
3345 (insert "BibTeX mode command `bibtex-validate'\n" 3533 (goto-line 3)) ; first error message
3346 (if syntax-error 3534 (display-buffer err-buf)
3347 "Maybe undetected errors due to syntax errors. Correct and validate again." 3535 ;; return nil
3348 "") 3536 nil)
3349 "\n") 3537 (message "%s is syntactically correct"
3350 (dolist (err error-list) 3538 (if mark-active "Region" "Buffer"))
3351 (insert bufnam ":" (number-to-string (elt err 0)) 3539 t)))
3352 ": " (elt err 1) "\n")) 3540
3353 (set-buffer-modified-p nil) 3541(defun bibtex-validate-globally (&optional strings)
3354 (toggle-read-only 1) 3542 "Check for duplicate keys in `bibtex-files'.
3543With prefix arg STRINGS, check for duplicate strings, too.
3544Return t if test was successful, nil otherwise."
3545 (interactive "P")
3546 (let ((buffer-list (bibtex-files-expand t))
3547 buffer-key-list current-buf current-keys error-list)
3548 ;; Check for duplicate keys within BibTeX buffer
3549 (dolist (buffer buffer-list)
3550 (save-excursion
3551 (set-buffer buffer)
3552 (let (entry-type key key-list)
3355 (goto-char (point-min)) 3553 (goto-char (point-min))
3356 (other-window -1) 3554 (while (re-search-forward bibtex-entry-head nil t)
3555 (setq entry-type (bibtex-type-in-head)
3556 key (bibtex-key-in-head))
3557 (if (or (and strings (bibtex-string= entry-type "string"))
3558 (assoc-string entry-type bibtex-entry-field-alist t))
3559 (if (member key key-list)
3560 (push (format "%s:%d: Duplicate key `%s'\n"
3561 (buffer-file-name)
3562 (bibtex-current-line) key)
3563 error-list)
3564 (push key key-list))))
3565 (push (cons buffer key-list) buffer-key-list))))
3566
3567 ;; Check for duplicate keys among BibTeX buffers
3568 (while (setq current-buf (pop buffer-list))
3569 (setq current-keys (cdr (assq current-buf buffer-key-list)))
3570 (with-current-buffer current-buf
3571 (dolist (buffer buffer-list)
3572 (dolist (key (cdr (assq buffer buffer-key-list)))
3573 (when (assoc-string key current-keys)
3574 (bibtex-find-entry key)
3575 (push (format "%s:%d: Duplicat key `%s' in %s\n"
3576 (buffer-file-name) (bibtex-current-line) key
3577 (abbreviate-file-name (buffer-file-name buffer)))
3578 error-list))))))
3579
3580 ;; Process error list
3581 (if error-list
3582 (let ((err-buf "*BibTeX validation errors*"))
3583 (with-current-buffer (get-buffer-create err-buf)
3584 (unless (eq major-mode 'compilation-mode) (compilation-mode))
3585 (toggle-read-only -1)
3586 (delete-region (point-min) (point-max))
3587 (insert "BibTeX mode command `bibtex-validate-globally'\n\n")
3588 (dolist (err (sort error-list 'string-lessp)) (insert err))
3589 (set-buffer-modified-p nil)
3590 (toggle-read-only 1)
3591 (goto-line 3)) ; first error message
3592 (display-buffer err-buf)
3357 ;; return nil 3593 ;; return nil
3358 nil) 3594 nil)
3359 (if (bibtex-mark-active) 3595 (message "No duplicate keys.")
3360 (message "Region is syntactically correct")
3361 (message "Buffer is syntactically correct"))
3362 t))) 3596 t)))
3363 3597
3364(defun bibtex-next-field (arg) 3598(defun bibtex-next-field (arg)
@@ -3378,10 +3612,9 @@ Returns t if test was successful, nil otherwise."
3378 3612
3379(defun bibtex-find-text (arg &optional as-if-interactive no-error) 3613(defun bibtex-find-text (arg &optional as-if-interactive no-error)
3380 "Go to end of text of current field; with ARG, go to beginning." 3614 "Go to end of text of current field; with ARG, go to beginning."
3381 (interactive "P") 3615 (interactive "P\np")
3382 (bibtex-inside-field) 3616 (bibtex-inside-field)
3383 (let ((bounds (bibtex-enclosing-field (or (interactive-p) 3617 (let ((bounds (bibtex-enclosing-field as-if-interactive)))
3384 as-if-interactive))))
3385 (if bounds 3618 (if bounds
3386 (progn (if arg 3619 (progn (if arg
3387 (progn (goto-char (bibtex-start-of-text-in-field bounds)) 3620 (progn (goto-char (bibtex-start-of-text-in-field bounds))
@@ -3404,7 +3637,7 @@ Returns t if test was successful, nil otherwise."
3404 (match-end 0)))) 3637 (match-end 0))))
3405 (t 3638 (t
3406 (unless no-error 3639 (unless no-error
3407 (error "Not on BibTeX field"))))))) 3640 (error "Not on BibTeX field")))))))
3408 3641
3409(defun bibtex-remove-OPT-or-ALT () 3642(defun bibtex-remove-OPT-or-ALT ()
3410 "Remove the string starting optional/alternative fields. 3643 "Remove the string starting optional/alternative fields.
@@ -3470,6 +3703,7 @@ but do not actually kill it."
3470 (setq bibtex-last-kill-command 'field)) 3703 (setq bibtex-last-kill-command 'field))
3471 3704
3472(defun bibtex-copy-field-as-kill () 3705(defun bibtex-copy-field-as-kill ()
3706 "Copy the field at point to the kill ring."
3473 (interactive) 3707 (interactive)
3474 (bibtex-kill-field t)) 3708 (bibtex-kill-field t))
3475 3709
@@ -3492,9 +3726,9 @@ With prefix arg COPY-ONLY the current entry to
3492 (setcdr (nthcdr (1- bibtex-entry-kill-ring-max) 3726 (setcdr (nthcdr (1- bibtex-entry-kill-ring-max)
3493 bibtex-entry-kill-ring) 3727 bibtex-entry-kill-ring)
3494 nil)) 3728 nil))
3495 (setq bibtex-entry-kill-ring-yank-pointer bibtex-entry-kill-ring) 3729 (setq bibtex-entry-kill-ring-yank-pointer bibtex-entry-kill-ring)
3496 (unless copy-only 3730 (unless copy-only
3497 (delete-region beg end)))) 3731 (delete-region beg end))))
3498 (setq bibtex-last-kill-command 'entry)) 3732 (setq bibtex-last-kill-command 'entry))
3499 3733
3500(defun bibtex-copy-entry-as-kill () 3734(defun bibtex-copy-entry-as-kill ()
@@ -3584,7 +3818,7 @@ At end of the cleaning process, the functions in
3584 ;; (bibtex-format-preamble) 3818 ;; (bibtex-format-preamble)
3585 (error "No clean up of @Preamble entries")) 3819 (error "No clean up of @Preamble entries"))
3586 ((bibtex-string= entry-type "string")) 3820 ((bibtex-string= entry-type "string"))
3587 ;; (bibtex-format-string) 3821 ;; (bibtex-format-string)
3588 (t (bibtex-format-entry))) 3822 (t (bibtex-format-entry)))
3589 ;; set key 3823 ;; set key
3590 (when (or new-key (not key)) 3824 (when (or new-key (not key))
@@ -3597,7 +3831,7 @@ At end of the cleaning process, the functions in
3597 (delete-region (match-beginning bibtex-key-in-head) 3831 (delete-region (match-beginning bibtex-key-in-head)
3598 (match-end bibtex-key-in-head))) 3832 (match-end bibtex-key-in-head)))
3599 (insert key)) 3833 (insert key))
3600 ;; sorting 3834
3601 (unless called-by-reformat 3835 (unless called-by-reformat
3602 (let* ((start (bibtex-beginning-of-entry)) 3836 (let* ((start (bibtex-beginning-of-entry))
3603 (end (progn (bibtex-end-of-entry) 3837 (end (progn (bibtex-end-of-entry)
@@ -3606,9 +3840,12 @@ At end of the cleaning process, the functions in
3606 (goto-char (match-beginning 0))) 3840 (goto-char (match-beginning 0)))
3607 (point))) 3841 (point)))
3608 (entry (buffer-substring start end)) 3842 (entry (buffer-substring start end))
3609 (index (progn (goto-char start) 3843 ;; include the crossref key in index
3610 (bibtex-entry-index))) 3844 (index (let ((bibtex-maintain-sorted-entries 'crossref))
3845 (goto-char start)
3846 (bibtex-entry-index)))
3611 error) 3847 error)
3848 ;; sorting
3612 (if (and bibtex-maintain-sorted-entries 3849 (if (and bibtex-maintain-sorted-entries
3613 (not (and bibtex-sort-ignore-string-entries 3850 (not (and bibtex-sort-ignore-string-entries
3614 (bibtex-string= entry-type "string")))) 3851 (bibtex-string= entry-type "string"))))
@@ -3623,17 +3860,37 @@ At end of the cleaning process, the functions in
3623 (setq error (or (/= (point) start) 3860 (setq error (or (/= (point) start)
3624 (bibtex-find-entry key end)))) 3861 (bibtex-find-entry key end))))
3625 (if error 3862 (if error
3626 (error "New inserted entry yields duplicate key")))) 3863 (error "New inserted entry yields duplicate key"))
3627 ;; final clean up 3864 (dolist (buffer (bibtex-files-expand))
3628 (unless called-by-reformat 3865 (with-current-buffer buffer
3629 (save-excursion 3866 (if (cdr (assoc-string key bibtex-reference-keys))
3630 (save-restriction 3867 (error "Duplicate key in %s" (buffer-file-name)))))
3631 (bibtex-narrow-to-entry) 3868
3632 ;; Only update the list of keys if it has been built already. 3869 ;; Only update the list of keys if it has been built already.
3633 (cond ((bibtex-string= entry-type "string") 3870 (cond ((bibtex-string= entry-type "string")
3634 (if (listp bibtex-strings) (bibtex-parse-strings t))) 3871 (if (and (listp bibtex-strings)
3635 ((listp bibtex-reference-keys) (bibtex-parse-keys t))) 3872 (not (assoc key bibtex-strings)))
3636 (run-hooks 'bibtex-clean-entry-hook)))))) 3873 (push (list key) bibtex-strings)))
3874 ;; We have a normal entry.
3875 ((listp bibtex-reference-keys)
3876 (cond ((not (assoc key bibtex-reference-keys))
3877 (push (cons key t) bibtex-reference-keys))
3878 ((not (cdr (assoc key bibtex-reference-keys)))
3879 ;; Turn a crossref key into a header key
3880 (setq bibtex-reference-keys
3881 (cons (cons key t)
3882 (delete (list key) bibtex-reference-keys)))))
3883 ;; Handle crossref key.
3884 (if (and (nth 1 index)
3885 (not (assoc (nth 1 index) bibtex-reference-keys)))
3886 (push (list (nth 1 index)) bibtex-reference-keys)))))
3887
3888 ;; final clean up
3889 (if bibtex-clean-entry-hook
3890 (save-excursion
3891 (save-restriction
3892 (bibtex-narrow-to-entry)
3893 (run-hooks 'bibtex-clean-entry-hook)))))))
3637 3894
3638(defun bibtex-fill-field-bounds (bounds justify &optional move) 3895(defun bibtex-fill-field-bounds (bounds justify &optional move)
3639 "Fill BibTeX field delimited by BOUNDS. 3896 "Fill BibTeX field delimited by BOUNDS.
@@ -3705,13 +3962,24 @@ If `bibtex-align-at-equal-sign' is non-nil, align equal signs, too."
3705 "Realign BibTeX entries such that they are separated by one blank line." 3962 "Realign BibTeX entries such that they are separated by one blank line."
3706 (goto-char (point-min)) 3963 (goto-char (point-min))
3707 (let ((case-fold-search t)) 3964 (let ((case-fold-search t))
3965 ;; No blank lines prior to the first valid entry if there no
3966 ;; non-white characters in front of it.
3708 (when (looking-at bibtex-valid-entry-whitespace-re) 3967 (when (looking-at bibtex-valid-entry-whitespace-re)
3709 (replace-match "\\1")) 3968 (replace-match "\\1"))
3969 ;; Valid entries are separated by one blank line.
3710 (while (re-search-forward bibtex-valid-entry-whitespace-re nil t) 3970 (while (re-search-forward bibtex-valid-entry-whitespace-re nil t)
3711 (replace-match "\n\n\\1")))) 3971 (replace-match "\n\n\\1"))
3972 ;; One blank line past the last valid entry if it is followed by
3973 ;; non-white characters, no blank line otherwise.
3974 (beginning-of-line)
3975 (when (re-search-forward bibtex-valid-entry-re nil t)
3976 (bibtex-end-of-entry)
3977 (bibtex-delete-whitespace)
3978 (open-line (if (eobp) 1 2)))))
3712 3979
3713(defun bibtex-reformat (&optional read-options) 3980(defun bibtex-reformat (&optional read-options)
3714 "Reformat all BibTeX entries in buffer or region. 3981 "Reformat all BibTeX entries in buffer or region.
3982Without prefix argument, reformatting is based on `bibtex-entry-format'.
3715With prefix argument, read options for reformatting from minibuffer. 3983With prefix argument, read options for reformatting from minibuffer.
3716With \\[universal-argument] \\[universal-argument] prefix argument, reuse previous answers (if any) again. 3984With \\[universal-argument] \\[universal-argument] prefix argument, reuse previous answers (if any) again.
3717If mark is active reformat entries in region, if not in whole buffer." 3985If mark is active reformat entries in region, if not in whole buffer."
@@ -3722,55 +3990,54 @@ If mark is active reformat entries in region, if not in whole buffer."
3722 (or bibtex-reformat-previous-options 3990 (or bibtex-reformat-previous-options
3723 bibtex-reformat-previous-reference-keys))) 3991 bibtex-reformat-previous-reference-keys)))
3724 (bibtex-entry-format 3992 (bibtex-entry-format
3725 (if read-options 3993 (cond (read-options
3726 (if use-previous-options 3994 (if use-previous-options
3727 bibtex-reformat-previous-options 3995 bibtex-reformat-previous-options
3728 (setq bibtex-reformat-previous-options 3996 (setq bibtex-reformat-previous-options
3729 (mapcar (lambda (option) 3997 (mapcar (lambda (option)
3730 (if (y-or-n-p (car option)) (cdr option))) 3998 (if (y-or-n-p (car option)) (cdr option)))
3731 `(("Realign entries (recommended)? " . 'realign) 3999 `(("Realign entries (recommended)? " . 'realign)
3732 ("Remove empty optional and alternative fields? " . 'opts-or-alts) 4000 ("Remove empty optional and alternative fields? " . 'opts-or-alts)
3733 ("Remove delimiters around pure numerical fields? " . 'numerical-fields) 4001 ("Remove delimiters around pure numerical fields? " . 'numerical-fields)
3734 (,(concat (if bibtex-comma-after-last-field "Insert" "Remove") 4002 (,(concat (if bibtex-comma-after-last-field "Insert" "Remove")
3735 " comma at end of entry? ") . 'last-comma) 4003 " comma at end of entry? ") . 'last-comma)
3736 ("Replace double page dashes by single ones? " . 'page-dashes) 4004 ("Replace double page dashes by single ones? " . 'page-dashes)
3737 ("Force delimiters? " . 'delimiters) 4005 ("Inherit booktitle? " . 'inherit-booktitle)
3738 ("Unify case of entry types and field names? " . 'unify-case))))) 4006 ("Force delimiters? " . 'delimiters)
3739 '(realign))) 4007 ("Unify case of entry types and field names? " . 'unify-case))))))
4008 ;; Do not include required-fields because `bibtex-reformat'
4009 ;; cannot handle the error messages of `bibtex-format-entry'.
4010 ;; Use `bibtex-validate' to check for required fields.
4011 ((eq t bibtex-entry-format)
4012 '(realign opts-or-alts numerical-fields delimiters
4013 last-comma page-dashes unify-case inherit-booktitle))
4014 (t
4015 (remove 'required-fields (push 'realign bibtex-entry-format)))))
3740 (reformat-reference-keys 4016 (reformat-reference-keys
3741 (if read-options 4017 (if read-options
3742 (if use-previous-options 4018 (if use-previous-options
3743 bibtex-reformat-previous-reference-keys 4019 bibtex-reformat-previous-reference-keys
3744 (setq bibtex-reformat-previous-reference-keys 4020 (setq bibtex-reformat-previous-reference-keys
3745 (y-or-n-p "Generate new reference keys automatically? "))))) 4021 (y-or-n-p "Generate new reference keys automatically? ")))))
3746 (start-point (if (bibtex-mark-active)
3747 (region-beginning)
3748 (point-min)))
3749 (end-point (if (bibtex-mark-active)
3750 (region-end)
3751 (point-max)))
3752 (bibtex-sort-ignore-string-entries t) 4022 (bibtex-sort-ignore-string-entries t)
3753 bibtex-autokey-edit-before-use) 4023 bibtex-autokey-edit-before-use)
3754 4024
3755 (save-restriction 4025 (save-restriction
3756 (narrow-to-region start-point end-point) 4026 (narrow-to-region (if mark-active (region-beginning) (point-min))
4027 (if mark-active (region-end) (point-max)))
3757 (if (memq 'realign bibtex-entry-format) 4028 (if (memq 'realign bibtex-entry-format)
3758 (bibtex-realign)) 4029 (bibtex-realign))
3759 (goto-char start-point)
3760 (bibtex-progress-message "Formatting" 1) 4030 (bibtex-progress-message "Formatting" 1)
3761 (bibtex-map-entries (lambda (key beg end) 4031 (bibtex-map-entries (lambda (key beg end)
3762 (bibtex-progress-message) 4032 (bibtex-progress-message)
3763 (bibtex-clean-entry reformat-reference-keys t))) 4033 (bibtex-clean-entry reformat-reference-keys t)))
3764 (when (memq 'realign bibtex-entry-format)
3765 (bibtex-delete-whitespace)
3766 (open-line (if (eobp) 1 2)))
3767 (bibtex-progress-message 'done)) 4034 (bibtex-progress-message 'done))
3768 (when (and reformat-reference-keys 4035 (when reformat-reference-keys
3769 bibtex-maintain-sorted-entries)
3770 (bibtex-progress-message "Sorting" 1)
3771 (bibtex-sort-buffer)
3772 (kill-local-variable 'bibtex-reference-keys) 4036 (kill-local-variable 'bibtex-reference-keys)
3773 (bibtex-progress-message 'done)) 4037 (when bibtex-maintain-sorted-entries
4038 (bibtex-progress-message "Sorting" 1)
4039 (bibtex-sort-buffer)
4040 (bibtex-progress-message 'done)))
3774 (goto-char pnt))) 4041 (goto-char pnt)))
3775 4042
3776(defun bibtex-convert-alien (&optional read-options) 4043(defun bibtex-convert-alien (&optional read-options)
@@ -3837,21 +4104,23 @@ signaled if point is outside key or BibTeX field."
3837 ;; key completion 4104 ;; key completion
3838 (setq choose-completion-string-functions 4105 (setq choose-completion-string-functions
3839 (lambda (choice buffer mini-p base-size) 4106 (lambda (choice buffer mini-p base-size)
3840 (bibtex-choose-completion-string choice buffer mini-p base-size) 4107 (let ((choose-completion-string-functions nil))
4108 (choose-completion-string choice buffer base-size))
3841 (bibtex-complete-key-cleanup choice) 4109 (bibtex-complete-key-cleanup choice)
3842 ;; return t (required by choose-completion-string-functions) 4110 ;; return t (required by choose-completion-string-functions)
3843 t)) 4111 t))
3844 (bibtex-complete-key-cleanup (bibtex-complete-internal 4112 (bibtex-complete-key-cleanup (bibtex-complete-internal
3845 bibtex-reference-keys))) 4113 bibtex-reference-keys)))
3846 4114
3847 (compl 4115 (compl
3848 ;; string completion 4116 ;; string completion
3849 (setq choose-completion-string-functions 4117 (setq choose-completion-string-functions
3850 `(lambda (choice buffer mini-p base-size) 4118 `(lambda (choice buffer mini-p base-size)
3851 (bibtex-choose-completion-string choice buffer mini-p base-size) 4119 (let ((choose-completion-string-functions nil))
3852 (bibtex-complete-string-cleanup choice ',compl) 4120 (choose-completion-string choice buffer base-size))
3853 ;; return t (required by choose-completion-string-functions) 4121 (bibtex-complete-string-cleanup choice ',compl)
3854 t)) 4122 ;; return t (required by choose-completion-string-functions)
4123 t))
3855 (bibtex-complete-string-cleanup (bibtex-complete-internal compl) 4124 (bibtex-complete-string-cleanup (bibtex-complete-internal compl)
3856 compl)) 4125 compl))
3857 4126
@@ -3960,80 +4229,56 @@ signaled if point is outside key or BibTeX field."
3960 "\n") 4229 "\n")
3961 (goto-char endpos))) 4230 (goto-char endpos)))
3962 4231
3963(defun bibtex-url (&optional event) 4232(defun bibtex-url (&optional pos)
3964 "Browse a URL for the BibTeX entry at position PNT. 4233 "Browse a URL for the BibTeX entry at point.
4234Optional POS is the location of the BibTeX entry.
3965The URL is generated using the schemes defined in `bibtex-generate-url-list' 4235The URL is generated using the schemes defined in `bibtex-generate-url-list'
3966\(see there\). Then the URL is passed to `browse-url'." 4236\(see there\). Then the URL is passed to `browse-url'."
3967 (interactive (list last-input-event)) 4237 (interactive)
3968 (save-excursion 4238 (save-excursion
3969 (if event (posn-set-point (event-end event))) 4239 (if pos (goto-char pos))
3970 (bibtex-beginning-of-entry) 4240 (bibtex-beginning-of-entry)
3971 (let ((fields-alist (bibtex-parse-entry)) 4241 (let ((fields-alist (bibtex-parse-entry))
4242 ;; Always ignore case,
3972 (case-fold-search t) 4243 (case-fold-search t)
3973 (lst bibtex-generate-url-list) 4244 (lst bibtex-generate-url-list)
4245 (delim-regexp "\\`[{\"]\\(.*\\)[}\"]\\'")
3974 field url scheme) 4246 field url scheme)
3975 (while (setq scheme (car lst)) 4247 (while (setq scheme (pop lst))
3976 (when (and (setq field (cdr (assoc-string (caar scheme) 4248 (when (and (setq field (cdr (assoc-string (caar scheme)
3977 fields-alist t))) 4249 fields-alist t)))
3978 (progn 4250 ;; Always remove field delimiters
3979 (if (string-match "\\`[{\"]\\(.*\\)[}\"]\\'" field) 4251 (progn (if (string-match delim-regexp field)
3980 (setq field (match-string 1 field))) 4252 (setq field (match-string 1 field)))
3981 (string-match (cdar scheme) field))) 4253 (string-match (cdar scheme) field)))
3982 (setq lst nil) 4254 (setq lst nil)
3983 (if (null (cdr scheme)) 4255 (if (null (cdr scheme))
3984 (setq url (match-string 0 field))) 4256 (setq url (match-string 0 field)))
3985 (dolist (step (cdr scheme)) 4257 (dolist (step (cdr scheme))
3986 (cond ((stringp step) 4258 (cond ((stringp step)
3987 (setq url (concat url step))) 4259 (setq url (concat url step)))
3988 ((setq field (assoc-string (car step) fields-alist t)) 4260 ((setq field (cdr (assoc-string (car step) fields-alist t)))
3989 ;; always remove field delimiters 4261 ;; Always remove field delimiters
3990 (let* ((text (if (string-match "\\`[{\"]\\(.*\\)[}\"]\\'" 4262 (if (string-match delim-regexp field)
3991 (cdr field)) 4263 (setq field (match-string 1 field)))
3992 (match-string 1 (cdr field)) 4264 (if (string-match (nth 1 step) field)
3993 (cdr field))) 4265 (setq field (cond
3994 (str (if (string-match (nth 1 step) text) 4266 ((functionp (nth 2 step))
3995 (cond 4267 (funcall (nth 2 step) field))
3996 ((functionp (nth 2 step)) 4268 ((numberp (nth 2 step))
3997 (funcall (nth 2 step) text)) 4269 (match-string (nth 2 step) field))
3998 ((numberp (nth 2 step)) 4270 (t
3999 (match-string (nth 2 step) text)) 4271 (replace-match (nth 2 step) nil nil field))))
4000 (t 4272 ;; If the scheme is set up correctly,
4001 (replace-match (nth 2 step) nil nil text))) 4273 ;; we should never reach this point
4002 ;; If the scheme is set up correctly, 4274 (error "Match failed: %s" field))
4003 ;; we should never reach this point 4275 (setq url (concat url field)))
4004 (error "Match failed: %s" text)))) 4276 ;; If the scheme is set up correctly,
4005 (setq url (concat url str)))) 4277 ;; we should never reach this point
4006 ;; If the scheme is set up correctly, 4278 (t (error "Step failed: %s" step))))
4007 ;; we should never reach this point 4279 (message "%s" url)
4008 (t (error "Step failed: %s" step)))) 4280 (browse-url url)))
4009 (message "%s" url) 4281 (unless url (message "No URL known.")))))
4010 (browse-url url))
4011 (setq lst (cdr lst)))
4012 (unless url (message "No URL known.")))))
4013
4014(defun bibtex-font-lock-url (bound)
4015 "Font-lock for URLs."
4016 (let ((case-fold-search t)
4017 (bounds (bibtex-enclosing-field t))
4018 (pnt (point))
4019 found field)
4020 ;; We use start-of-field as syntax-begin
4021 (goto-char (if bounds (bibtex-start-of-field bounds) pnt))
4022 (while (and (not found)
4023 (prog1 (re-search-forward bibtex-font-lock-url-regexp bound t)
4024 (setq field (match-string-no-properties 1)))
4025 (setq bounds (bibtex-parse-field-text))
4026 (>= bound (car bounds))
4027 (>= (car bounds) pnt))
4028 (let ((lst bibtex-generate-url-list) url)
4029 (goto-char (car bounds))
4030 (while (and (not found)
4031 (setq url (caar lst)))
4032 (when (bibtex-string= field (car url))
4033 (setq found (re-search-forward (cdr url) (cdr bounds) t)))
4034 (setq lst (cdr lst))))
4035 (goto-char (cdr bounds)))
4036 found))
4037 4282
4038 4283
4039;; Make BibTeX a Feature 4284;; Make BibTeX a Feature
diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el
index 8e5b94114a3..54c9d6ad7db 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,88,89,90,91,92,93,96,97,2000,01,03,04 3;; Copyright (C) 1985, 1988, 1989, 1990, 1991, 1992, 1993, 1996, 1997,
4;; Free Software Foundation, Inc. 4;; 2000, 2001, 2003, 2004 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]
diff --git a/lisp/thumbs.el b/lisp/thumbs.el
index 13970e59ee8..b6a68df33c4 100644
--- a/lisp/thumbs.el
+++ b/lisp/thumbs.el
@@ -30,8 +30,8 @@
30;;; Commentary: 30;;; Commentary:
31 31
32;; This package create two new mode: thumbs-mode and 32;; This package create two new mode: thumbs-mode and
33;; thumbs-view-image-mode. It is used for images browsing and viewing 33;; thumbs-view-image-mode. It is used for images browsing and viewing
34;; from within emacs. Minimal image manipulation functions are also 34;; from within Emacs. Minimal image manipulation functions are also
35;; available via external programs. 35;; available via external programs.
36;; 36;;
37;; The 'convert' program from 'ImageMagick' 37;; The 'convert' program from 'ImageMagick'
@@ -62,6 +62,7 @@
62 62
63(defgroup thumbs nil 63(defgroup thumbs nil
64 "Thumbnails previewer." 64 "Thumbnails previewer."
65 :version "21.4"
65 :group 'multimedia) 66 :group 'multimedia)
66 67
67(defcustom thumbs-thumbsdir 68(defcustom thumbs-thumbsdir
@@ -416,7 +417,7 @@ and SAME-WINDOW to show thumbs in the same window."
416(defalias 'thumbs 'thumbs-show-all-from-dir) 417(defalias 'thumbs 'thumbs-show-all-from-dir)
417 418
418(defun thumbs-find-image (img &optional num otherwin) 419(defun thumbs-find-image (img &optional num otherwin)
419 (funcall 420 (funcall
420 (if otherwin 'switch-to-buffer-other-window 'switch-to-buffer) 421 (if otherwin 'switch-to-buffer-other-window 'switch-to-buffer)
421 (concat "*Image: " (file-name-nondirectory img) " - " 422 (concat "*Image: " (file-name-nondirectory img) " - "
422 (number-to-string (or num 0)) "*")) 423 (number-to-string (or num 0)) "*"))
diff --git a/lisp/toolbar/diropen.pbm b/lisp/toolbar/diropen.pbm
new file mode 100644
index 00000000000..0f1996db78c
--- /dev/null
+++ b/lisp/toolbar/diropen.pbm
Binary files differ
diff --git a/lisp/toolbar/diropen.xpm b/lisp/toolbar/diropen.xpm
new file mode 100644
index 00000000000..bdc0b19d7dd
--- /dev/null
+++ b/lisp/toolbar/diropen.xpm
@@ -0,0 +1,215 @@
1/* XPM */
2static char * diropen_xpm[] = {
3"24 24 188 2",
4" c None",
5". c #000000",
6"+ c #010100",
7"@ c #B5B8A5",
8"# c #E4E7D2",
9"$ c #878A76",
10"% c #33342B",
11"& c #0B0B0B",
12"* c #E2E5CF",
13"= c #CFD4AF",
14"- c #CED3AE",
15"; c #B2B696",
16"> c #2D2D25",
17", c #23241D",
18"' c #9D9F90",
19") c #C6CAA6",
20"! c #C4C9A5",
21"~ c #C6CBA7",
22"{ c #C7CCA8",
23"] c #C9CEA9",
24"^ c #555847",
25"/ c #1A1B15",
26"( c #20201A",
27"_ c #D4D6C2",
28": c #BEC2A0",
29"< c #B3B896",
30"[ c #B0B595",
31"} c #B3B797",
32"| c #B6BB99",
33"1 c #BBC09E",
34"2 c #BCC19F",
35"3 c #81856C",
36"4 c #3E3F32",
37"5 c #010101",
38"6 c #DADDC8",
39"7 c #AFB494",
40"8 c #AAAF8F",
41"9 c #A3A789",
42"0 c #A6AA8B",
43"a c #A9AD8E",
44"b c #A7AB8D",
45"c c #A4A88A",
46"d c #A1A588",
47"e c #AAAD96",
48"f c #B3B5A5",
49"g c #B8BBAA",
50"h c #BABCAB",
51"i c #40413B",
52"j c #CACDBB",
53"k c #BABDA8",
54"l c #0C0C09",
55"m c #DDDFCB",
56"n c #969B7E",
57"o c #9DA286",
58"p c #95987C",
59"q c #96997E",
60"r c #9A9D81",
61"s c #999D80",
62"t c #9DA184",
63"u c #A5AA8B",
64"v c #A4A98A",
65"w c #A3A889",
66"x c #A2A588",
67"y c #33352B",
68"z c #9B9E83",
69"A c #898D74",
70"B c #D8DBC9",
71"C c #84866E",
72"D c #7D8169",
73"E c #151612",
74"F c #D7DAC9",
75"G c #797D67",
76"H c #3D3F34",
77"I c #E0E0D9",
78"J c #EBEDDD",
79"K c #E8EBD9",
80"L c #D8DBCA",
81"M c #1A1A18",
82"N c #0A0A09",
83"O c #6E7067",
84"P c #8D8F84",
85"Q c #4A4B45",
86"R c #2C2D29",
87"S c #4B4C46",
88"T c #E7EAD8",
89"U c #E3E6D4",
90"V c #DEE1D0",
91"W c #DADCCC",
92"X c #DADCD1",
93"Y c #2B2C28",
94"Z c #D7DAC6",
95"` c #6F735E",
96" . c #0D0D0D",
97".. c #F4F4EC",
98"+. c #606251",
99"@. c #92957B",
100"#. c #4A4C3E",
101"$. c #434438",
102"%. c #CACFAB",
103"&. c #C6CBA8",
104"*. c #C2C6A4",
105"=. c #ABB091",
106"-. c #23251E",
107";. c #494B3D",
108">. c #DCDCD4",
109",. c #EAECDD",
110"'. c #CDD2AD",
111"). c #20201B",
112"!. c #1C1C17",
113"~. c #A4A88B",
114"{. c #414337",
115"]. c #BABF9D",
116"^. c #B5B999",
117"/. c #81836C",
118"(. c #070806",
119"_. c #D5D8C4",
120":. c #161616",
121"<. c #F2F2EA",
122"[. c #CACFAA",
123"}. c #050504",
124"|. c #3C3D32",
125"1. c #C9CEAA",
126"2. c #C8CDA9",
127"3. c #BFC4A2",
128"4. c #3E4035",
129"5. c #BCC09F",
130"6. c #B6BB9A",
131"7. c #B0B494",
132"8. c #9DA185",
133"9. c #535445",
134"0. c #B6B8A7",
135"a. c #747470",
136"b. c #ECECE2",
137"c. c #C3C8A5",
138"d. c #C2C7A4",
139"e. c #393B30",
140"f. c #BFC4A1",
141"g. c #BDC2A0",
142"h. c #C0C5A2",
143"i. c #3A3B31",
144"j. c #A9AD8F",
145"k. c #A3A78A",
146"l. c #80836D",
147"m. c #020201",
148"n. c #A6A998",
149"o. c #B8BC9B",
150"p. c #1B1C17",
151"q. c #181814",
152"r. c #AFB394",
153"s. c #ACB091",
154"t. c #878A72",
155"u. c #9B9F83",
156"v. c #9A9D82",
157"w. c #8A8D75",
158"x. c #4F5243",
159"y. c #070705",
160"z. c #9E9F91",
161"A. c #E5E6DA",
162"B. c #ADB192",
163"C. c #A6AA8C",
164"D. c #A5A98C",
165"E. c #4B4D3F",
166"F. c #70735F",
167"G. c #9FA286",
168"H. c #999D81",
169"I. c #35362D",
170"J. c #2D2E26",
171"K. c #8A8D74",
172"L. c #71735F",
173"M. c #080908",
174"N. c #E3E5D9",
175"O. c #C0C3AF",
176"P. c #94987C",
177"Q. c #8F9379",
178"R. c #8B8F75",
179"S. c #8A8E74",
180"T. c #888C73",
181"U. c #7D816A",
182"V. c #0E0F0C",
183"W. c #3E4034",
184"X. c #4E5042",
185"Y. c #282922",
186"Z. c #121310",
187"`. c #24251F",
188" + c #71745F",
189".+ c #6A6D59",
190"++ c #434538",
191"@+ c #080907",
192" ",
193" ",
194" ",
195" . . . . . . . ",
196" + @ # # # # # $ % ",
197" & * = = = - - ; > ",
198", ' * ) ! ~ { ] ] ^ / . . ",
199"( _ : < [ } | 1 2 3 4 5 . . . . . . . ",
200", 6 7 8 9 0 8 a b c d e f g h . i j k . ",
201"l m n o p q r s q t u v w x 9 . y z A . ",
202". B C D E . . . . . . . . . . . . . . . 5 5 ",
203". F G H I J K K L M N O P Q R . S T U V W X Y ",
204". Z ` ...= = = +.. @.= = = #.. $.%.&.*.1 =.-. ",
205". Z ;.>.,.'.- - ).!.'.'.'.'.~.. {.&.*.].^./.(. ",
206". _.:.<.%.[.%.[.}.|.1.{ 2.2.3.. 4.5.6.7.8.9.l ",
207". 0.a.b.c.d.d.*.}.e.f.g.h.g.} . i.[ j.k.l.m. ",
208". n.>.o.o.^.} } p.q.r.r.r.s.t.. % u.v.w.x.y. ",
209". z.A.B.j.C.D.k.E.. F.G.u.H.I.. J.K.K.L.M. ",
210". N.O.P.Q.R.S.T.U.V.}.W.X.Y.Z.. `. +.+++@+ ",
211" . . . . . . . . . . . . . . . . . . }. ",
212" ",
213" ",
214" ",
215" "};
diff --git a/lisp/toolbar/tool-bar.el b/lisp/toolbar/tool-bar.el
index bf1c229ccb9..f22d84cafaf 100644
--- a/lisp/toolbar/tool-bar.el
+++ b/lisp/toolbar/tool-bar.el
@@ -223,7 +223,8 @@ MAP must contain appropriate binding for `[menu-bar]' which holds a keymap."
223 ;; might inadvertently click that button. 223 ;; might inadvertently click that button.
224 ;;(tool-bar-add-item-from-menu 'save-buffers-kill-emacs "exit") 224 ;;(tool-bar-add-item-from-menu 'save-buffers-kill-emacs "exit")
225 (tool-bar-add-item-from-menu 'find-file "new") 225 (tool-bar-add-item-from-menu 'find-file "new")
226 (tool-bar-add-item-from-menu 'dired "open") 226 (tool-bar-add-item-from-menu 'find-file-existing "open")
227 (tool-bar-add-item-from-menu 'dired "diropen")
227 (tool-bar-add-item-from-menu 'kill-this-buffer "close") 228 (tool-bar-add-item-from-menu 'kill-this-buffer "close")
228 (tool-bar-add-item-from-menu 'save-buffer "save" nil 229 (tool-bar-add-item-from-menu 'save-buffer "save" nil
229 :visible '(or buffer-file-name 230 :visible '(or buffer-file-name
diff --git a/lisp/type-break.el b/lisp/type-break.el
index 253e1406f06..ec96ab09fe2 100644
--- a/lisp/type-break.el
+++ b/lisp/type-break.el
@@ -1005,8 +1005,8 @@ FRAC should be the inverse of the fractional value; for example, a value of
1005 (setcar type-break-keystroke-threshold lower) 1005 (setcar type-break-keystroke-threshold lower)
1006 (setcdr type-break-keystroke-threshold upper) 1006 (setcdr type-break-keystroke-threshold upper)
1007 (if (interactive-p) 1007 (if (interactive-p)
1008 (message "min threshold: %d\tmax threshold: %d" lower upper) 1008 (message "min threshold: %d\tmax threshold: %d" lower upper))
1009 type-break-keystroke-threshold))) 1009 type-break-keystroke-threshold))
1010 1010
1011 1011
1012;;; misc functions 1012;;; misc functions
@@ -1103,37 +1103,12 @@ With optional non-nil ALL, force redisplay of all mode-lines."
1103 1103
1104(defun type-break-run-at-time (time repeat function) 1104(defun type-break-run-at-time (time repeat function)
1105 (condition-case nil (or (require 'timer) (require 'itimer)) (error nil)) 1105 (condition-case nil (or (require 'timer) (require 'itimer)) (error nil))
1106 (cond ((fboundp 'run-at-time) 1106 (run-at-time time repeat function))
1107 (run-at-time time repeat function))
1108 ((fboundp 'start-timer)
1109 (let ((name (if (symbolp function)
1110 (symbol-name function)
1111 "type-break")))
1112 (start-timer name function time repeat)))
1113 ((fboundp 'start-itimer)
1114 (let ((name (if (symbolp function)
1115 (symbol-name function)
1116 "type-break")))
1117 (start-itimer name function time repeat)))))
1118 1107
1119(defvar timer-dont-exit) 1108(defvar timer-dont-exit)
1120(defun type-break-cancel-function-timers (function) 1109(defun type-break-cancel-function-timers (function)
1121 (cond ((fboundp 'cancel-function-timers) 1110 (let ((timer-dont-exit t))
1122 (let ((timer-dont-exit t)) 1111 (cancel-function-timers function)))
1123 (cancel-function-timers function)))
1124 ((fboundp 'delete-timer)
1125 (let ((list timer-list))
1126 (while list
1127 (and (eq (funcall 'timer-function (car list)) function)
1128 (delete-timer (car list)))
1129 (setq list (cdr list)))))
1130 ((fboundp 'delete-itimer)
1131 (with-no-warnings
1132 (let ((list itimer-list))
1133 (while list
1134 (and (eq (funcall 'itimer-function (car list)) function)
1135 (delete-itimer (car list)))
1136 (setq list (cdr list))))))))
1137 1112
1138 1113
1139;;; Demo wrappers 1114;;; Demo wrappers
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index 053984fcaeb..261635d51e2 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,15 @@
12004-11-02 Masatake YAMATO <jet@gyve.org>
2
3 * url-imap.el (url-imap-open-host): Don't use
4 `string-to-int'. The port returned by `url-port'
5 is expected to be an integer.
6
7 * url-irc.el (url-irc): Ditto.
8
9 * url-news.el (url-news-open-host): Ditto.
10
11 * url-nfs.el (url-nfs-build-filename): Ditto.
12
12004-10-20 John Paul Wallington <jpw@gnu.org> 132004-10-20 John Paul Wallington <jpw@gnu.org>
2 14
3 * url-gw.el (url-gateway-nslookup-host): 15 * url-gw.el (url-gateway-nslookup-host):
diff --git a/lisp/url/url-imap.el b/lisp/url/url-imap.el
index 79b53e5d012..7b8f9deb19d 100644
--- a/lisp/url/url-imap.el
+++ b/lisp/url/url-imap.el
@@ -47,8 +47,6 @@
47 (let ((imap-username user) 47 (let ((imap-username user)
48 (imap-password pass) 48 (imap-password pass)
49 (authenticator (if user 'login 'anonymous))) 49 (authenticator (if user 'login 'anonymous)))
50 (if (stringp port)
51 (setq port (string-to-int port)))
52 (nnimap-open-server host 50 (nnimap-open-server host
53 `((nnimap-server-port ,port) 51 `((nnimap-server-port ,port)
54 (nnimap-stream 'network) 52 (nnimap-stream 'network)
diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el
index 8b54b6d9222..31254dee451 100644
--- a/lisp/url/url-irc.el
+++ b/lisp/url/url-irc.el
@@ -61,7 +61,7 @@ PASSWORD - What password to use"
61;;;###autoload 61;;;###autoload
62(defun url-irc (url) 62(defun url-irc (url)
63 (let* ((host (url-host url)) 63 (let* ((host (url-host url))
64 (port (string-to-int (url-port url))) 64 (port (url-port url))
65 (pass (url-password url)) 65 (pass (url-password url))
66 (user (url-user url)) 66 (user (url-user url))
67 (chan (url-filename url))) 67 (chan (url-filename url)))
diff --git a/lisp/url/url-news.el b/lisp/url/url-news.el
index 432c81f5d44..9d7f64bb4a4 100644
--- a/lisp/url/url-news.el
+++ b/lisp/url/url-news.el
@@ -38,7 +38,7 @@
38(defun url-news-open-host (host port user pass) 38(defun url-news-open-host (host port user pass)
39 (if (fboundp 'nnheader-init-server-buffer) 39 (if (fboundp 'nnheader-init-server-buffer)
40 (nnheader-init-server-buffer)) 40 (nnheader-init-server-buffer))
41 (nntp-open-server host (list (string-to-int port))) 41 (nntp-open-server host (list port))
42 (if (and user pass) 42 (if (and user pass)
43 (progn 43 (progn
44 (nntp-send-command "^.*\r?\n" "AUTHINFO USER" user) 44 (nntp-send-command "^.*\r?\n" "AUTHINFO USER" user)
diff --git a/lisp/url/url-nfs.el b/lisp/url/url-nfs.el
index 3b834bba75f..ff36c1bdae9 100644
--- a/lisp/url/url-nfs.el
+++ b/lisp/url/url-nfs.el
@@ -62,7 +62,7 @@ Each can be used any number of times.")
62 62
63(defun url-nfs-build-filename (url) 63(defun url-nfs-build-filename (url)
64 (let* ((host (url-host url)) 64 (let* ((host (url-host url))
65 (port (string-to-int (url-port url))) 65 (port (url-port url))
66 (pass (url-password url)) 66 (pass (url-password url))
67 (user (url-user url)) 67 (user (url-user url))
68 (file (url-filename url))) 68 (file (url-filename url)))
diff --git a/lisp/vc-cvs.el b/lisp/vc-cvs.el
index 0c1e6bc1745..45ff233eb86 100644
--- a/lisp/vc-cvs.el
+++ b/lisp/vc-cvs.el
@@ -5,7 +5,7 @@
5;; Author: FSF (see vc.el for full credits) 5;; Author: FSF (see vc.el for full credits)
6;; Maintainer: Andre Spiegel <spiegel@gnu.org> 6;; Maintainer: Andre Spiegel <spiegel@gnu.org>
7 7
8;; $Id: vc-cvs.el,v 1.67 2004/01/20 17:41:18 uid65624 Exp $ 8;; $Id$
9 9
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11 11
@@ -89,12 +89,12 @@ and past information to determine the current status of a file.
89The value can also be a regular expression or list of regular 89The value can also be a regular expression or list of regular
90expressions to match against the host name of a repository; then VC 90expressions to match against the host name of a repository; then VC
91only stays local for hosts that match it. Alternatively, the value 91only stays local for hosts that match it. Alternatively, the value
92can be a list of regular expressions where the first element is the 92can be a list of regular expressions where the first element is the
93symbol `except'; then VC always stays local except for hosts matched 93symbol `except'; then VC always stays local except for hosts matched
94by these regular expressions." 94by these regular expressions."
95 :type '(choice (const :tag "Always stay local" t) 95 :type '(choice (const :tag "Always stay local" t)
96 (const :tag "Don't stay local" nil) 96 (const :tag "Don't stay local" nil)
97 (list :format "\nExamine hostname and %v" :tag "Examine hostname ..." 97 (list :format "\nExamine hostname and %v" :tag "Examine hostname ..."
98 (set :format "%v" :inline t (const :format "%t" :tag "don't" except)) 98 (set :format "%v" :inline t (const :format "%t" :tag "don't" except))
99 (regexp :format " stay local,\n%t: %v" :tag "if it matches") 99 (regexp :format " stay local,\n%t: %v" :tag "if it matches")
100 (repeat :format "%v%i\n" :inline t (regexp :tag "or")))) 100 (repeat :format "%v%i\n" :inline t (regexp :tag "or"))))
@@ -152,12 +152,6 @@ See also variable `vc-cvs-sticky-date-format-string'."
152;;; Internal variables 152;;; Internal variables
153;;; 153;;;
154 154
155(defvar vc-cvs-local-month-numbers
156 '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) ("Apr" . 4)
157 ("May" . 5) ("Jun" . 6) ("Jul" . 7) ("Aug" . 8)
158 ("Sep" . 9) ("Oct" . 10) ("Nov" . 11) ("Dec" . 12))
159 "Local association list of month numbers.")
160
161 155
162;;; 156;;;
163;;; State-querying functions 157;;; State-querying functions
@@ -590,7 +584,11 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
590(defun vc-cvs-annotate-command (file buffer &optional version) 584(defun vc-cvs-annotate-command (file buffer &optional version)
591 "Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER. 585 "Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER.
592Optional arg VERSION is a version to annotate from." 586Optional arg VERSION is a version to annotate from."
593 (vc-cvs-command buffer 0 file "annotate" (if version (concat "-r" version)))) 587 (vc-cvs-command buffer 0 file "annotate" (if version (concat "-r" version)))
588 (with-current-buffer buffer
589 (goto-char (point-min))
590 (re-search-forward "^[0-9]")
591 (delete-region (point-min) (1- (point)))))
594 592
595(defun vc-cvs-annotate-current-time () 593(defun vc-cvs-annotate-current-time ()
596 "Return the current time, based at midnight of the current day, and 594 "Return the current time, based at midnight of the current day, and
@@ -601,29 +599,36 @@ encoded as fractional days."
601(defun vc-cvs-annotate-time () 599(defun vc-cvs-annotate-time ()
602 "Return the time of the next annotation (as fraction of days) 600 "Return the time of the next annotation (as fraction of days)
603systime, or nil if there is none." 601systime, or nil if there is none."
604 (let ((time-stamp 602 (let* ((bol (point))
605 "^\\S-+\\s-+\\S-+\\s-+\\([0-9]+\\)-\\(\\sw+\\)-\\([0-9]+\\)): ")) 603 (cache (get-text-property bol 'vc-cvs-annotate-time))
606 (if (looking-at time-stamp) 604 buffer-read-only)
607 (progn 605 (cond
608 (let* ((day (string-to-number (match-string 1))) 606 (cache)
609 (month (cdr (assoc (match-string 2) 607 ((looking-at
610 vc-cvs-local-month-numbers))) 608 "^\\S-+\\s-+\\S-+\\s-+\\([0-9]+\\)-\\(\\sw+\\)-\\([0-9]+\\)): ")
611 (year-tmp (string-to-number (match-string 3))) 609 (let ((day (string-to-number (match-string 1)))
612 ;; Years 0..68 are 2000..2068. 610 (month (cdr (assq (intern (match-string 2))
613 ;; Years 69..99 are 1969..1999. 611 '((Jan . 1) (Feb . 2) (Mar . 3)
614 (year (+ (cond ((> 69 year-tmp) 2000) 612 (Apr . 4) (May . 5) (Jun . 6)
615 ((> 100 year-tmp) 1900) 613 (Jul . 7) (Aug . 8) (Sep . 9)
616 (t 0)) 614 (Oct . 10) (Nov . 11) (Dec . 12)))))
617 year-tmp))) 615 (year (let ((tmp (string-to-number (match-string 3))))
618 (goto-char (match-end 0)) ; Position at end makes for nicer overlay result 616 ;; Years 0..68 are 2000..2068.
619 (vc-annotate-convert-time (encode-time 0 0 0 day month year)))) 617 ;; Years 69..99 are 1969..1999.
620 ;; If we did not look directly at an annotation, there might be 618 (+ (cond ((> 69 tmp) 2000)
621 ;; some further down. This is the case if we are positioned at 619 ((> 100 tmp) 1900)
622 ;; the very top of the buffer, for instance. 620 (t 0))
623 (if (re-search-forward time-stamp nil t) 621 tmp))))
624 (progn 622 (put-text-property
625 (beginning-of-line nil) 623 bol (1+ bol) 'vc-cvs-annotate-time
626 (vc-cvs-annotate-time)))))) 624 (setq cache (cons
625 ;; Position at end makes for nicer overlay result.
626 (match-end 0)
627 (vc-annotate-convert-time
628 (encode-time 0 0 0 day month year))))))))
629 (when cache
630 (goto-char (car cache)) ; fontify from here to eol
631 (cdr cache)))) ; days (float)
627 632
628(defun vc-cvs-annotate-extract-revision-at-line () 633(defun vc-cvs-annotate-extract-revision-at-line ()
629 (save-excursion 634 (save-excursion
@@ -839,7 +844,7 @@ CVS/Entries should only be accessed through this function."
839 (let ((coding-system-for-read (or file-name-coding-system 844 (let ((coding-system-for-read (or file-name-coding-system
840 default-file-name-coding-system))) 845 default-file-name-coding-system)))
841 (vc-insert-file (expand-file-name "CVS/Entries" dir)))) 846 (vc-insert-file (expand-file-name "CVS/Entries" dir))))
842 847
843(defun vc-cvs-valid-symbolic-tag-name-p (tag) 848(defun vc-cvs-valid-symbolic-tag-name-p (tag)
844 "Return non-nil if TAG is a valid symbolic tag name." 849 "Return non-nil if TAG is a valid symbolic tag name."
845 ;; According to the CVS manual, a valid symbolic tag must start with 850 ;; According to the CVS manual, a valid symbolic tag must start with
@@ -929,7 +934,7 @@ is non-nil."
929 "\\(.*\\)")) ;Sticky tag 934 "\\(.*\\)")) ;Sticky tag
930 (vc-file-setprop file 'vc-workfile-version (match-string 1)) 935 (vc-file-setprop file 'vc-workfile-version (match-string 1))
931 (vc-file-setprop file 'vc-cvs-sticky-tag 936 (vc-file-setprop file 'vc-cvs-sticky-tag
932 (vc-cvs-parse-sticky-tag (match-string 4) 937 (vc-cvs-parse-sticky-tag (match-string 4)
933 (match-string 5))) 938 (match-string 5)))
934 ;; Compare checkout time and modification time. 939 ;; Compare checkout time and modification time.
935 ;; This is intentionally different from the algorithm that CVS uses 940 ;; This is intentionally different from the algorithm that CVS uses
diff --git a/lisp/vc-mcvs.el b/lisp/vc-mcvs.el
index d2ac776170f..ea577489239 100644
--- a/lisp/vc-mcvs.el
+++ b/lisp/vc-mcvs.el
@@ -26,9 +26,9 @@
26;;; Commentary: 26;;; Commentary:
27 27
28;; The home page of the Meta-CVS version control system is at 28;; The home page of the Meta-CVS version control system is at
29;; 29;;
30;; http://users.footprints.net/~kaz/mcvs.html 30;; http://users.footprints.net/~kaz/mcvs.html
31;; 31;;
32;; This is derived from vc-cvs.el as follows: 32;; This is derived from vc-cvs.el as follows:
33;; - cp vc-cvs.el vc-mcvs.el 33;; - cp vc-cvs.el vc-mcvs.el
34;; - Replace CVS/ with MCVS/CVS/ 34;; - Replace CVS/ with MCVS/CVS/
@@ -478,7 +478,11 @@ Optional arg VERSION is a version to annotate from."
478 (vc-mcvs-command 478 (vc-mcvs-command
479 buffer 479 buffer
480 (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0) 480 (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0)
481 file "annotate" (if version (concat "-r" version)))) 481 file "annotate" (if version (concat "-r" version)))
482 (with-current-buffer buffer
483 (goto-char (point-min))
484 (re-search-forward "^[0-9]")
485 (delete-region (point-min) (1- (point)))))
482 486
483(defalias 'vc-mcvs-annotate-current-time 'vc-cvs-annotate-current-time) 487(defalias 'vc-mcvs-annotate-current-time 'vc-cvs-annotate-current-time)
484(defalias 'vc-mcvs-annotate-time 'vc-cvs-annotate-time) 488(defalias 'vc-mcvs-annotate-time 'vc-cvs-annotate-time)
diff --git a/lisp/vc.el b/lisp/vc.el
index 15d0258e85d..5aac27e31a4 100644
--- a/lisp/vc.el
+++ b/lisp/vc.el
@@ -2896,9 +2896,9 @@ if present. The current time is used as the offset."
2896(defun vc-annotate-display-autoscale (&optional full) 2896(defun vc-annotate-display-autoscale (&optional full)
2897 "Highlight the output of \\[vc-annotate] using an autoscaled color map. 2897 "Highlight the output of \\[vc-annotate] using an autoscaled color map.
2898Autoscaling means that the map is scaled from the current time to the 2898Autoscaling means that the map is scaled from the current time to the
2899oldest annotation in the buffer, or, with argument FULL non-nil, to 2899oldest annotation in the buffer, or, with prefix argument FULL, to
2900cover the range from the oldest annotation to the newest." 2900cover the range from the oldest annotation to the newest."
2901 (interactive) 2901 (interactive "P")
2902 (let ((newest 0.0) 2902 (let ((newest 0.0)
2903 (oldest 999999.) ;Any CVS users at the founding of Rome? 2903 (oldest 999999.) ;Any CVS users at the founding of Rome?
2904 (current (vc-annotate-convert-time (current-time))) 2904 (current (vc-annotate-convert-time (current-time)))
@@ -2907,7 +2907,9 @@ cover the range from the oldest annotation to the newest."
2907 ;; Run through this file and find the oldest and newest dates annotated. 2907 ;; Run through this file and find the oldest and newest dates annotated.
2908 (save-excursion 2908 (save-excursion
2909 (goto-char (point-min)) 2909 (goto-char (point-min))
2910 (while (setq date (vc-call-backend vc-annotate-backend 'annotate-time)) 2910 (while (setq date (prog1 (vc-call-backend vc-annotate-backend
2911 'annotate-time)
2912 (forward-line 1)))
2911 (if (> date newest) 2913 (if (> date newest)
2912 (setq newest date)) 2914 (setq newest date))
2913 (if (< date oldest) 2915 (if (< date oldest)
diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el
index 0f9237f3409..f2b081fdcc5 100644
--- a/lisp/x-dnd.el
+++ b/lisp/x-dnd.el
@@ -47,6 +47,7 @@ The function shall return nil to reject the drop or a cons with two values,
47the wanted action as car and the wanted type as cdr. The wanted action 47the wanted action as car and the wanted type as cdr. The wanted action
48can be copy, move, link, ask or private. 48can be copy, move, link, ask or private.
49The default value for this variable is `x-dnd-default-test-function'." 49The default value for this variable is `x-dnd-default-test-function'."
50 :version "21.4"
50 :type 'symbol 51 :type 'symbol
51 :group 'x) 52 :group 'x)
52 53
@@ -69,6 +70,7 @@ Insertion of text is not handeled by these functions, see `x-dnd-types-alist'
69for that. 70for that.
70The function shall return the action done (move, copy, link or private) 71The function shall return the action done (move, copy, link or private)
71if some action was made, or nil if the URL is ignored." 72if some action was made, or nil if the URL is ignored."
73 :version "21.4"
72 :type 'alist 74 :type 'alist
73 :group 'x) 75 :group 'x)
74 76
@@ -96,11 +98,13 @@ this drop (copy, move, link, private or ask) as determined by a previous
96call to `x-dnd-test-function'. DATA is the drop data. 98call to `x-dnd-test-function'. DATA is the drop data.
97The function shall return the action used (copy, move, link or private) if drop 99The function shall return the action used (copy, move, link or private) if drop
98is successful, nil if not." 100is successful, nil if not."
101 :version "21.4"
99 :type 'alist 102 :type 'alist
100 :group 'x) 103 :group 'x)
101 104
102(defcustom x-dnd-open-file-other-window nil 105(defcustom x-dnd-open-file-other-window nil
103 "If non-nil, always use find-file-other-window to open dropped files." 106 "If non-nil, always use find-file-other-window to open dropped files."
107 :version "21.4"
104 :type 'boolean 108 :type 'boolean
105 :group 'x) 109 :group 'x)
106 110
@@ -120,6 +124,7 @@ is successful, nil if not."
120 ) 124 )
121 "The types accepted by default for dropped data. 125 "The types accepted by default for dropped data.
122The types are chosen in the order they appear in the list." 126The types are chosen in the order they appear in the list."
127 :version "21.4"
123 :type '(repeat string) 128 :type '(repeat string)
124 :group 'x 129 :group 'x
125) 130)
diff --git a/lispref/ChangeLog b/lispref/ChangeLog
index dc8f1771263..d1bb65d3358 100644
--- a/lispref/ChangeLog
+++ b/lispref/ChangeLog
@@ -1,3 +1,28 @@
12004-11-01 Richard M. Stallman <rms@gnu.org>
2
3 * commands.texi (Interactive Call): Add called-interactively-p.
4
52004-10-29 Simon Josefsson <jas@extundo.com>
6
7 * minibuf.texi (Reading a Password): Revert.
8
92004-10-28 Richard M. Stallman <rms@gnu.org>
10
11 * frames.texi (Display Feature Testing): Explain about "vendor".
12
132004-10-27 Richard M. Stallman <rms@gnu.org>
14
15 * commands.texi (Interactive Codes): `N' uses numeric prefix,
16 not raw. Clarify `n'.
17 (Interactive Call): Rewrite interactive-p, focusing on when
18 and how to use it.
19 (Misc Events): Clarify previous change.
20
21 * advice.texi (Simple Advice): Clarify what job the example does.
22 (Around-Advice): Clarify ad-do-it.
23 (Activation of Advice): An option of ad-default-compilation-action
24 is `never', not `nil'.
25
12004-10-26 Kim F. Storm <storm@cua.dk> 262004-10-26 Kim F. Storm <storm@cua.dk>
2 27
3 * commands.texi (Interactive Codes): Add U code letter. 28 * commands.texi (Interactive Codes): Add U code letter.
diff --git a/lispref/advice.texi b/lispref/advice.texi
index 46d4f96a35b..ae22fecc1fb 100644
--- a/lispref/advice.texi
+++ b/lispref/advice.texi
@@ -51,7 +51,8 @@ is @code{nil}.)
51 51
52 Suppose you wanted to add a similar feature to @code{previous-line}, 52 Suppose you wanted to add a similar feature to @code{previous-line},
53which would insert a new line at the beginning of the buffer for the 53which would insert a new line at the beginning of the buffer for the
54command to move to. How could you do this? 54command to move to (when @code{next-line-add-newlines} is
55non-@code{nil}). How could you do this?
55 56
56 You could do it by redefining the whole function, but that is not 57 You could do it by redefining the whole function, but that is not
57modular. The advice feature provides a cleaner alternative: you can 58modular. The advice feature provides a cleaner alternative: you can
@@ -273,9 +274,9 @@ Its effect is to make sure that case is ignored in
273searches when the original definition of @code{foo} is run. 274searches when the original definition of @code{foo} is run.
274 275
275@defvar ad-do-it 276@defvar ad-do-it
276This is not really a variable, but it is somewhat used like one 277This is not really a variable, rather a place-holder that looks like a
277in around-advice. It specifies the place to run the function's 278variable. You use it in around-advice to specify the place to run the
278original definition and other ``earlier'' around-advice. 279function's original definition and other ``earlier'' around-advice.
279@end defvar 280@end defvar
280 281
281If the around-advice does not use @code{ad-do-it}, then it does not run 282If the around-advice does not use @code{ad-do-it}, then it does not run
@@ -360,10 +361,9 @@ advice.
360This command activates all the advice defined for @var{function}. 361This command activates all the advice defined for @var{function}.
361@end deffn 362@end deffn
362 363
363To activate advice for a function whose advice is already active is not 364 Activating advice does nothing if @var{function}'s advice is already
364a no-op. It is a useful operation which puts into effect any changes in 365active. But if there is new advice, added since the previous time you
365that function's advice since the previous activation of advice for that 366activated advice for @var{function}, it activates the new advice.
366function.
367 367
368@deffn Command ad-deactivate function 368@deffn Command ad-deactivate function
369This command deactivates the advice for @var{function}. 369This command deactivates the advice for @var{function}.
@@ -430,7 +430,7 @@ This variable controls whether to compile the combined definition
430that results from activating advice for a function. 430that results from activating advice for a function.
431 431
432A value of @code{always} specifies to compile unconditionally. 432A value of @code{always} specifies to compile unconditionally.
433A value of @code{nil} specifies never compile the advice. 433A value of @code{never} specifies never compile the advice.
434 434
435A value of @code{maybe} specifies to compile if the byte-compiler is 435A value of @code{maybe} specifies to compile if the byte-compiler is
436already loaded. A value of @code{like-original} specifies to compile 436already loaded. A value of @code{like-original} specifies to compile
diff --git a/lispref/commands.texi b/lispref/commands.texi
index cb772ff6eb5..3c9612e5186 100644
--- a/lispref/commands.texi
+++ b/lispref/commands.texi
@@ -382,15 +382,14 @@ method, and returned as a string (@pxref{Input Methods,,, emacs, The GNU
382Emacs Manual}). Prompt. 382Emacs Manual}). Prompt.
383 383
384@item n 384@item n
385A number read with the minibuffer. If the input is not a number, the 385A number, read with the minibuffer. If the input is not a number, the
386user is asked to try again. The prefix argument, if any, is not used. 386user has to try again. @samp{n} never uses the prefix argument.
387Prompt. 387Prompt.
388 388
389@item N 389@item N
390@cindex raw prefix argument usage 390The numeric prefix argument; but if there is no prefix argument, read
391The numeric prefix argument; but if there is no prefix argument, read a 391a number as with @kbd{n}. The value is always a number. @xref{Prefix
392number as with @kbd{n}. Requires a number. @xref{Prefix Command 392Command Arguments}. Prompt.
393Arguments}. Prompt.
394 393
395@item p 394@item p
396@cindex numeric prefix argument usage 395@cindex numeric prefix argument usage
@@ -398,6 +397,7 @@ The numeric prefix argument. (Note that this @samp{p} is lower case.)
398No I/O. 397No I/O.
399 398
400@item P 399@item P
400@cindex raw prefix argument usage
401The raw prefix argument. (Note that this @samp{P} is upper case.) No 401The raw prefix argument. (Note that this @samp{P} is upper case.) No
402I/O. 402I/O.
403 403
@@ -613,25 +613,23 @@ part of the prompt.
613@end deffn 613@end deffn
614 614
615@defun interactive-p 615@defun interactive-p
616This function returns @code{t} if the containing function (the one whose 616This function returns @code{t} if the containing function (the one
617code includes the call to @code{interactive-p}) was called 617whose code includes the call to @code{interactive-p}) was called in
618interactively, with the function @code{call-interactively}. (It makes 618direct response to user input. This means that it was called with the
619no difference whether @code{call-interactively} was called from Lisp or 619function @code{call-interactively}, and that a keyboard macro is
620directly from the editor command loop.) If the containing function was 620not running, and that Emacs is not running in batch mode.
621called by Lisp evaluation (or with @code{apply} or @code{funcall}), then 621
622it was not called interactively. 622If the containing function was called by Lisp evaluation (or with
623@code{apply} or @code{funcall}), then it was not called interactively.
623@end defun 624@end defun
624 625
625 The most common use of @code{interactive-p} is for deciding whether to 626 The most common use of @code{interactive-p} is for deciding whether
626print an informative message. As a special exception, 627to give the user additional visual feedback (such as by printing an
627@code{interactive-p} returns @code{nil} whenever a keyboard macro is 628informative message). For example:
628being run. This is to suppress the informative messages and speed
629execution of the macro.
630
631 For example:
632 629
633@example 630@example
634@group 631@group
632;; @r{Here's the usual way to use @code{interactive-p}.}
635(defun foo () 633(defun foo ()
636 (interactive) 634 (interactive)
637 (when (interactive-p) 635 (when (interactive-p)
@@ -640,6 +638,7 @@ execution of the macro.
640@end group 638@end group
641 639
642@group 640@group
641;; @r{This function is just to illustrate the behavior.}
643(defun bar () 642(defun bar ()
644 (interactive) 643 (interactive)
645 (setq foobar (list (foo) (interactive-p)))) 644 (setq foobar (list (foo) (interactive-p))))
@@ -653,7 +652,7 @@ execution of the macro.
653 652
654@group 653@group
655;; @r{Type @kbd{M-x bar}.} 654;; @r{Type @kbd{M-x bar}.}
656;; @r{This does not print anything.} 655;; @r{This does not display a message.}
657@end group 656@end group
658 657
659@group 658@group
@@ -662,10 +661,11 @@ foobar
662@end group 661@end group
663@end example 662@end example
664 663
665 The other way to do this sort of job is to make the command take an 664 If you want to test @emph{only} whether the function was called
666argument @code{print-message} which should be non-@code{nil} in an 665using @code{call-interactively}, add an optional argument
667interactive call, and use the @code{interactive} spec to make sure it is 666@code{print-message} which should be non-@code{nil} in an interactive
668non-@code{nil}. Here's how: 667call, and use the @code{interactive} spec to make sure it is
668non-@code{nil}. Here's an example:
669 669
670@example 670@example
671(defun foo (&optional print-message) 671(defun foo (&optional print-message)
@@ -675,10 +675,18 @@ non-@code{nil}. Here's how:
675@end example 675@end example
676 676
677@noindent 677@noindent
678Defined in this way, the function does display the message when 678Defined in this way, the function does display the message when called
679called from a keyboard macro. 679from a keyboard macro. We use @code{"p"} because the numeric prefix
680argument is never @code{nil}.
680 681
681 The numeric prefix argument, provided by @samp{p}, is never @code{nil}. 682@defun called-interactively-p
683This function returns @code{t} when the calling function was called
684using @code{call-interactively}.
685
686When possible, instead of using this function, you should use the
687method in the example above; that method makes it possible for a
688caller to ``pretend'' that the function was called interactively.
689@end defun
682 690
683@node Command Loop Info 691@node Command Loop Info
684@comment node-name, next, previous, up 692@comment node-name, next, previous, up
@@ -1513,16 +1521,17 @@ frame has already been made visible, Emacs has no work to do.
1513@cindex @code{wheel-down} event 1521@cindex @code{wheel-down} event
1514@item (wheel-up @var{position}) 1522@item (wheel-up @var{position})
1515@item (wheel-down @var{position}) 1523@item (wheel-down @var{position})
1516This kind of event is generated by moving a wheel on a mouse. Its 1524These kinds of event are generated by moving a mouse wheel. Their
1517effect is typically a kind of scroll or zoom. 1525usual meaning is a kind of scroll or zoom.
1518 1526
1519The element @var{position} is a list describing the position of the 1527The element @var{position} is a list describing the position of the
1520event, in the same format as used in a mouse-click event. 1528event, in the same format as used in a mouse-click event.
1521 1529
1522This kind of event is generated only on some kinds of systems. On 1530This kind of event is generated only on some kinds of systems. On some
1523other systems, mouse-4 and mouse-5 may be used instead. For portable 1531systems, @code{mouse-4} and @code{mouse-5} are used instead. For
1524code, the variables @code{mouse-wheel-up-event} and 1532portable code, use the variables @code{mouse-wheel-up-event} and
1525@code{mouse-wheel-down-event} defined in @file{mwheel.el} can be used. 1533@code{mouse-wheel-down-event} defined in @file{mwheel.el} to determine
1534what event types to expect for the mouse wheel.
1526 1535
1527@cindex @code{drag-n-drop} event 1536@cindex @code{drag-n-drop} event
1528@item (drag-n-drop @var{position} @var{files}) 1537@item (drag-n-drop @var{position} @var{files})
diff --git a/lispref/frames.texi b/lispref/frames.texi
index c2c488873a4..736115ef11e 100644
--- a/lispref/frames.texi
+++ b/lispref/frames.texi
@@ -1980,12 +1980,18 @@ about X displays.
1980@defun x-server-version &optional display 1980@defun x-server-version &optional display
1981This function returns the list of version numbers of the X server 1981This function returns the list of version numbers of the X server
1982running the display. The value is a list of three integers: the major 1982running the display. The value is a list of three integers: the major
1983and minor version numbers, and the vendor-specific release number. 1983and minor version numbers of the X protocol, and the
1984distributor-specific release number of the X server software itself.
1984@end defun 1985@end defun
1985 1986
1986@defun x-server-vendor &optional display 1987@defun x-server-vendor &optional display
1987This function returns the ``vendor'' that provided the X server software 1988This function returns the ``vendor'' that provided the X server
1988(as a string). 1989software (as a string). Really this means whoever distributes the X
1990server.
1991
1992When the developers of X labelled software distributors as
1993``vendors'', they showed their false assumption that no system could
1994ever be developed and distributed noncommercially.
1989@end defun 1995@end defun
1990 1996
1991@ignore 1997@ignore
diff --git a/lispref/minibuf.texi b/lispref/minibuf.texi
index 08e156b327e..1b076c5837d 100644
--- a/lispref/minibuf.texi
+++ b/lispref/minibuf.texi
@@ -1660,32 +1660,6 @@ The return value of @code{map-y-or-n-p} is the number of objects acted on.
1660 To read a password to pass to another program, you can use the 1660 To read a password to pass to another program, you can use the
1661function @code{read-passwd}. 1661function @code{read-passwd}.
1662 1662
1663@cindex password cache
1664 Passwords are sometimes needed several times throughout an Emacs
1665session. Then it can be useful to avoid having to ask for a password
1666more than once. Passwords are entered into the password cache using
1667the function @code{password-cache-add}. To read a password, possibly
1668retrieving the password from the cache without querying the user, you
1669can use the function @code{password-read}. The two calls can be
1670combined into the function @code{password-read-and-add} that read a
1671password and store it in the cache.
1672
1673 Typically users do not use the same password for all services. The
1674password cache mechanism use a @samp{key} string to differentiate
1675among the passwords. The @samp{key} string is typically a fixed
1676string chosen to be related to what the password is used for. For
1677example, a password used when connecting to a @acronym{IMAP} mail
1678server called @samp{mail.example.org}, could use a @samp{key} string
1679of @samp{imap:mail.example.org}. You can use any string, as long as
1680it is reasonably unique.
1681
1682@cindex password expiry
1683Passwords in the cache typically expire after a while (controlled by
1684the variable @code{password-cache-expiry}), but you can force removal
1685of a password using the function @code{password-cache-remove}. This
1686is useful when there is a problem with the password, to avoid using
1687the same incorrect password from the cache in the future.
1688
1689@defun read-passwd prompt &optional confirm default 1663@defun read-passwd prompt &optional confirm default
1690This function reads a password, prompting with @var{prompt}. It does 1664This function reads a password, prompting with @var{prompt}. It does
1691not echo the password as the user types it; instead, it echoes @samp{.} 1665not echo the password as the user types it; instead, it echoes @samp{.}
@@ -1701,41 +1675,6 @@ return if the user enters empty input. If @var{default} is @code{nil},
1701then @code{read-passwd} returns the null string in that case. 1675then @code{read-passwd} returns the null string in that case.
1702@end defun 1676@end defun
1703 1677
1704@defun password-read prompt key
1705Read a password from the user, using @code{read-passwd}, prompting
1706with @var{prompt}. If a password has been stored in the password
1707cache, using @code{password-cache-add} on the same @var{key}, it is
1708returned directly, without querying the user.
1709@end defun
1710
1711@defun password-cache-add key password
1712Add a password to the password cache, indexed under the given
1713@var{key}. The password is later retrieved using @code{password-read}
1714called with the same @var{key}.
1715@end defun
1716
1717@defun password-cache-remove key
1718Remove a password from the cache, indexed under the given @var{key}.
1719@end defun
1720
1721@defun password-read-and-add prompt &optional key
1722Read a password, prompting with @var{prompt}, and possibly add it to
1723the cache, indexed using the @var{key} string. This is one-call
1724interface to @code{password-read} and @code{password-cache-add}.
1725@end defun
1726
1727@defvar password-cache-expiry
1728This variable specify for how many seconds passwords are retained in
1729the password cache before they are expired. For high security, use a
1730low value (below a minute). For more lax security, use a setting of
1731@samp{14400} corresponding to half a work day (4 hours).
1732@end defvar
1733
1734@defvar password-cache
1735This variable toggle whether or not the password cache is used at all.
1736The default is non-@code{nil}, i.e., to use the cache.
1737@end defvar
1738
1739@node Minibuffer Misc 1678@node Minibuffer Misc
1740@section Minibuffer Miscellany 1679@section Minibuffer Miscellany
1741 1680
diff --git a/lwlib/ChangeLog b/lwlib/ChangeLog
index 923f52debdd..eb2dd13432a 100644
--- a/lwlib/ChangeLog
+++ b/lwlib/ChangeLog
@@ -1,3 +1,10 @@
12004-11-01 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
2
3 * xlwmenu.c (find_first_selectable, find_next_selectable)
4 (find_prev_selectable): Rename parameter skip_no_call_data to
5 skip_titles. Recognize titles as having no call_data and no contents.
6 (Down, Up): Comment update.
7
12004-08-30 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> 82004-08-30 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
2 9
3 * lwlib.h (_widget_value): Added lname and lkey. 10 * lwlib.h (_widget_value): Added lname and lkey.
diff --git a/lwlib/xlwmenu.c b/lwlib/xlwmenu.c
index 973fc6ec5d5..d4eeeaa3eb4 100644
--- a/lwlib/xlwmenu.c
+++ b/lwlib/xlwmenu.c
@@ -2054,26 +2054,26 @@ Nothing (w, ev, params, num_params)
2054} 2054}
2055 2055
2056static widget_value * 2056static widget_value *
2057find_first_selectable (mw, item, skip_no_call_data) 2057find_first_selectable (mw, item, skip_titles)
2058 XlwMenuWidget mw; 2058 XlwMenuWidget mw;
2059 widget_value *item; 2059 widget_value *item;
2060 int skip_no_call_data; 2060 int skip_titles;
2061{ 2061{
2062 widget_value *current = item; 2062 widget_value *current = item;
2063 enum menu_separator separator; 2063 enum menu_separator separator;
2064 2064
2065 while (lw_separator_p (current->name, &separator, 0) || !current->enabled 2065 while (lw_separator_p (current->name, &separator, 0) || !current->enabled
2066 || (skip_no_call_data && !current->call_data)) 2066 || (skip_titles && !current->call_data && !current->contents))
2067 if (current->next) 2067 if (current->next)
2068 current=current->next; 2068 current=current->next;
2069 else 2069 else
2070 return NULL; 2070 return NULL;
2071 2071
2072 return current; 2072 return current;
2073} 2073}
2074 2074
2075static widget_value * 2075static widget_value *
2076find_next_selectable (mw, item, skip_no_call_data) 2076find_next_selectable (mw, item, skip_titles)
2077 XlwMenuWidget mw; 2077 XlwMenuWidget mw;
2078 widget_value *item; 2078 widget_value *item;
2079{ 2079{
@@ -2082,7 +2082,7 @@ find_next_selectable (mw, item, skip_no_call_data)
2082 2082
2083 while (current->next && (current=current->next) && 2083 while (current->next && (current=current->next) &&
2084 (lw_separator_p (current->name, &separator, 0) || !current->enabled 2084 (lw_separator_p (current->name, &separator, 0) || !current->enabled
2085 || (skip_no_call_data && !current->call_data))) 2085 || (skip_titles && !current->call_data && !current->contents)))
2086 ; 2086 ;
2087 2087
2088 if (current == item) 2088 if (current == item)
@@ -2093,7 +2093,8 @@ find_next_selectable (mw, item, skip_no_call_data)
2093 2093
2094 while (lw_separator_p (current->name, &separator, 0) 2094 while (lw_separator_p (current->name, &separator, 0)
2095 || !current->enabled 2095 || !current->enabled
2096 || (skip_no_call_data && !current->call_data)) 2096 || (skip_titles && !current->call_data
2097 && !current->contents))
2097 { 2098 {
2098 if (current->next) 2099 if (current->next)
2099 current=current->next; 2100 current=current->next;
@@ -2108,14 +2109,14 @@ find_next_selectable (mw, item, skip_no_call_data)
2108} 2109}
2109 2110
2110static widget_value * 2111static widget_value *
2111find_prev_selectable (mw, item, skip_no_call_data) 2112find_prev_selectable (mw, item, skip_titles)
2112 XlwMenuWidget mw; 2113 XlwMenuWidget mw;
2113 widget_value *item; 2114 widget_value *item;
2114{ 2115{
2115 widget_value *current = item; 2116 widget_value *current = item;
2116 widget_value *prev = item; 2117 widget_value *prev = item;
2117 2118
2118 while ((current=find_next_selectable (mw, current, skip_no_call_data)) 2119 while ((current=find_next_selectable (mw, current, skip_titles))
2119 != item) 2120 != item)
2120 { 2121 {
2121 if (prev == current) 2122 if (prev == current)
@@ -2141,8 +2142,7 @@ Down (w, ev, params, num_params)
2141 if (mw->menu.old_depth == mw->menu.top_depth) 2142 if (mw->menu.old_depth == mw->menu.top_depth)
2142 /* When <down> in the menu-bar is pressed, display the corresponding 2143 /* When <down> in the menu-bar is pressed, display the corresponding
2143 sub-menu and select the first selectable menu item there. 2144 sub-menu and select the first selectable menu item there.
2144 If this is a popup menu, skip items with zero call data (title of 2145 If this is a popup menu, skip title item of the popup. */
2145 the popup). */
2146 set_new_state (mw, 2146 set_new_state (mw,
2147 find_first_selectable (mw, 2147 find_first_selectable (mw,
2148 selected_item->contents, 2148 selected_item->contents,
@@ -2174,8 +2174,7 @@ Up (w, ev, params, num_params)
2174 last selectable item in the list. So we select the first 2174 last selectable item in the list. So we select the first
2175 selectable one and find the previous selectable item. Is there 2175 selectable one and find the previous selectable item. Is there
2176 a better way? */ 2176 a better way? */
2177 /* If this is a popup menu, skip items with zero call data (title of 2177 /* If this is a popup menu, skip title item of the popup. */
2178 the popup). */
2179 set_new_state (mw, 2178 set_new_state (mw,
2180 find_first_selectable (mw, 2179 find_first_selectable (mw,
2181 selected_item->contents, 2180 selected_item->contents,
diff --git a/man/ChangeLog b/man/ChangeLog
index d91fbf0267c..22ac03e8677 100644
--- a/man/ChangeLog
+++ b/man/ChangeLog
@@ -1,3 +1,21 @@
12004-11-02 Katsumi Yamaoka <yamaoka@jpl.org>
2
3 * emacs-mime.texi (Encoding Customization): Fix
4 mm-coding-system-priorities entry.
5
62004-11-03 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
7
8 * frames.texi (Dialog Boxes):
9 * idlwave.texi (Continued Statement Indentation):
10 * reftex.texi (Options (Index Support)):
11 (Displaying and Editing the Index, Table of Contents):
12 * speedbar.texi (Creating a display, Major Display Modes): Replace
13 non-nil with non-@code{nil}.
14
152004-11-02 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
16
17 * frames.texi (Dialog Boxes): Document use-old-gtk-file-dialog.
18
12004-10-23 Eli Zaretskii <eliz@gnu.org> 192004-10-23 Eli Zaretskii <eliz@gnu.org>
2 20
3 * text.texi (Text Based Tables, Table Definition) 21 * text.texi (Text Based Tables, Table Definition)
diff --git a/man/emacs-mime.texi b/man/emacs-mime.texi
index d60e40ebbd0..c128ed096c3 100644
--- a/man/emacs-mime.texi
+++ b/man/emacs-mime.texi
@@ -814,12 +814,12 @@ by using the @code{encoding} @acronym{MML} tag (@pxref{MML Definition}).
814@vindex mm-coding-system-priorities 814@vindex mm-coding-system-priorities
815Prioritize coding systems to use for outgoing messages. The default 815Prioritize coding systems to use for outgoing messages. The default
816is @code{nil}, which means to use the defaults in Emacs. It is a list of 816is @code{nil}, which means to use the defaults in Emacs. It is a list of
817coding system symbols (aliases of coding systems does not work, use 817coding system symbols (aliases of coding systems are also allowed, use
818@kbd{M-x describe-coding-system} to make sure you are not specifying 818@kbd{M-x describe-coding-system} to make sure you are specifying correct
819an alias in this variable). For example, if you have configured Emacs 819coding system names). For example, if you have configured Emacs
820to prefer UTF-8, but wish that outgoing messages should be sent in 820to prefer UTF-8, but wish that outgoing messages should be sent in
821ISO-8859-1 if possible, you can set this variable to 821ISO-8859-1 if possible, you can set this variable to
822@code{(iso-latin-1)}. You can override this setting on a per-message 822@code{(iso-8859-1)}. You can override this setting on a per-message
823basis by using the @code{charset} @acronym{MML} tag (@pxref{MML Definition}). 823basis by using the @code{charset} @acronym{MML} tag (@pxref{MML Definition}).
824 824
825@item mm-content-transfer-encoding-defaults 825@item mm-content-transfer-encoding-defaults
diff --git a/man/frames.texi b/man/frames.texi
index dee050922e6..cc8ae972567 100644
--- a/man/frames.texi
+++ b/man/frames.texi
@@ -910,6 +910,11 @@ use of file selection windows even if you still want other kinds
910of dialogs. This option has no effect if you have suppressed all dialog 910of dialogs. This option has no effect if you have suppressed all dialog
911boxes with the option @code{use-dialog-box}. 911boxes with the option @code{use-dialog-box}.
912 912
913@vindex use-old-gtk-file-dialog
914 For Gtk+ version 2.4, you can make Emacs use the old file dialog
915by setting the variable @code{use-old-gtk-file-dialog} to a non-@code{nil}
916value. If Emacs is built with a Gtk+ version that has only one file dialog,
917the setting of this variable has no effect.
913 918
914@node Tooltips 919@node Tooltips
915@section Tooltips (or ``Balloon Help'') 920@section Tooltips (or ``Balloon Help'')
diff --git a/man/idlwave.texi b/man/idlwave.texi
index fde5cd389d6..9c803790171 100644
--- a/man/idlwave.texi
+++ b/man/idlwave.texi
@@ -832,7 +832,7 @@ level can be somewhat dynamic in continued statements with special
832continuation indentation, especially if 832continuation indentation, especially if
833@code{idlwave-max-extra-continuation-indent} is small, the key 833@code{idlwave-max-extra-continuation-indent} is small, the key
834@kbd{C-u @key{TAB}} will re-indent all lines in the current statement. 834@kbd{C-u @key{TAB}} will re-indent all lines in the current statement.
835Note that @code{idlwave-indent-to-open-paren}, if non-nil, overrides 835Note that @code{idlwave-indent-to-open-paren}, if non-@code{nil}, overrides
836the @code{idlwave-max-extra-continuation-indent} limit, for 836the @code{idlwave-max-extra-continuation-indent} limit, for
837parentheses only, forcing them always to line up. 837parentheses only, forcing them always to line up.
838 838
diff --git a/man/reftex.texi b/man/reftex.texi
index 9108747af4f..c40dda36a2f 100644
--- a/man/reftex.texi
+++ b/man/reftex.texi
@@ -568,7 +568,7 @@ document.@refill
568@item r 568@item r
569@vindex reftex-enable-partial-scans 569@vindex reftex-enable-partial-scans
570Reparse the LaTeX document and rebuild the @file{*toc*} buffer. When 570Reparse the LaTeX document and rebuild the @file{*toc*} buffer. When
571@code{reftex-enable-partial-scans} is non-nil, rescan only the file this 571@code{reftex-enable-partial-scans} is non-@code{nil}, rescan only the file this
572location is defined in, not the entire document.@refill 572location is defined in, not the entire document.@refill
573 573
574@item C-u r 574@item C-u r
@@ -2355,7 +2355,7 @@ will move to the correct position.@refill
2355@item r 2355@item r
2356@vindex reftex-enable-partial-scans 2356@vindex reftex-enable-partial-scans
2357Reparse the LaTeX document and rebuild the @file{*Index*} buffer. When 2357Reparse the LaTeX document and rebuild the @file{*Index*} buffer. When
2358@code{reftex-enable-partial-scans} is non-nil, rescan only the file this 2358@code{reftex-enable-partial-scans} is non-@code{nil}, rescan only the file this
2359location is defined in, not the entire document.@refill 2359location is defined in, not the entire document.@refill
2360 2360
2361@item C-u r 2361@item C-u r
@@ -4348,7 +4348,7 @@ index entry. If you have a macro
4348should be @samp{Molecules!}.@refill 4348should be @samp{Molecules!}.@refill
4349 4349
4350@var{exclude} can be a function. If this function exists and returns a 4350@var{exclude} can be a function. If this function exists and returns a
4351non-nil value, the index entry at point is ignored. This was 4351non-@code{nil} value, the index entry at point is ignored. This was
4352implemented to support the (deprecated) @samp{^} and @samp{_} shortcuts 4352implemented to support the (deprecated) @samp{^} and @samp{_} shortcuts
4353in the LaTeX2e @code{index} package.@refill 4353in the LaTeX2e @code{index} package.@refill
4354 4354
diff --git a/man/speedbar.texi b/man/speedbar.texi
index 246aa1b7caf..62cce0024ae 100644
--- a/man/speedbar.texi
+++ b/man/speedbar.texi
@@ -1066,7 +1066,7 @@ summary to display in the minibuffer.
1066 1066
1067There are several helper functions you can use if you are going to use 1067There are several helper functions you can use if you are going to use
1068built in tagging. These functions can be @code{or}ed since each one 1068built in tagging. These functions can be @code{or}ed since each one
1069returns non-nil if it displays a message. They are: 1069returns non-@code{nil} if it displays a message. They are:
1070 1070
1071@table @code 1071@table @code
1072@cindex @code{speedbar-item-info-file-helper} 1072@cindex @code{speedbar-item-info-file-helper}
@@ -1165,7 +1165,7 @@ when the mouse passes over it. @var{function} is called whenever the
1165user clicks on the text. 1165user clicks on the text.
1166 1166
1167The optional argument @var{token} is extra data to associated with the 1167The optional argument @var{token} is extra data to associated with the
1168text. Lastly @var{prevline} should be non-nil if you want this line to 1168text. Lastly @var{prevline} should be non-@code{nil} if you want this line to
1169appear directly after the last button which was created instead of on 1169appear directly after the last button which was created instead of on
1170the next line. 1170the next line.
1171@end defun 1171@end defun
diff --git a/src/.gdbinit b/src/.gdbinit
index adf2ccbf5f1..1f179fb6d64 100644
--- a/src/.gdbinit
+++ b/src/.gdbinit
@@ -70,6 +70,34 @@ Print the argument as an emacs s-expression
70Works only when an inferior emacs is executing. 70Works only when an inferior emacs is executing.
71end 71end
72 72
73# Print out current buffer point and boundaries
74define ppt
75 set $b = current_buffer
76 set $t = $b->text
77 printf "BUF PT: %d", $b->pt
78 if ($b->pt != $b->pt_byte)
79 printf "[%d]", $b->pt_byte
80 end
81 printf " of 1..%d", $t->z
82 if ($t->z != $t->z_byte)
83 printf "[%d]", $t->z_byte
84 end
85 if ($b->begv != 1 || $b->zv != $t->z)
86 printf " NARROW=%d..%d", $b->begv, $b->zv
87 if ($b->begv != $b->begv_byte || $b->zv != $b->zv_byte)
88 printf " [%d..%d]", $b->begv_byte, $b->zv_byte
89 end
90 end
91 printf " GAP: %d", $t->gpt
92 if ($t->gpt != $t->gpt_byte)
93 printf "[%d]", $t->gpt_byte
94 end
95 printf " SZ=%d\n", $t->gap_size
96end
97document ppt
98Print point, beg, end, narrow, and gap for current buffer.
99end
100
73define xtype 101define xtype
74 xgettype $ 102 xgettype $
75 output $type 103 output $type
diff --git a/src/ChangeLog b/src/ChangeLog
index 8c0a7c0bcf1..e0ae2429fcd 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,166 @@
12004-11-04 Kenichi Handa <handa@m17n.org>
2
3 * fontset.c (fontset_pattern_regexp): If '*' is preceded by '\',
4 treat it as a literal character.
5
62004-11-03 Kim F. Storm <storm@cua.dk>
7
8 * .gdbinit (ppt): New function.
9
102004-11-02 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
11
12 * xterm.c (x_window_to_scroll_bar): Only call
13 xg_get_scroll_id_for_window if toolkit scroll bars are used.
14
15 * gtkutil.c (xg_get_file_with_chooser): Use GTK_STOCK_OK instead
16 of save.
17
182004-11-02 Andreas Schwab <schwab@suse.de>
19
20 * window.c (Fscroll_right): Fix last change.
21
222004-11-02 Kim F. Storm <storm@cua.dk>
23
24 * Makefile.in (callproc.o): Depend on blockinput.h atimer.h systime.h.
25
262004-11-02 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
27
28 * callproc.c (Fcall_process): Block input around vfork.
29
302004-11-02 Kim F. Storm <storm@cua.dk>
31
32 * eval.c (Fcalled_interactively_p): Rename from Fcall_interactive_p.
33 (syms_of_eval): Defsubr it.
34
352004-11-02 Richard M. Stallman <rms@gnu.org>
36
37 * insdel.c (replace_range_2): New function.
38
39 * casefiddle.c (casify_region): Handle changes in byte-length
40 using replace_range_2.
41
42 * emacs.c (USAGE3): Delete --horizontal-scroll-bars, -hb.
43
44 * xdisp.c (back_to_previous_visible_line_start):
45 Subtract 1 from pos when checking previous newline for invisibility.
46
47 * window.c (window_scroll_pixel_based): Update preserve_y
48 for header line if any.
49 (Fscroll_left, Fscroll_right): Don't call interactive_p;
50 use a new second argument instead.
51
52 * eval.c (Fcall_interactive_p): New function.
53 (interactive_p): Don't test INTERACTIVE here.
54 (Finteractive_p): Doc fix.
55
56 * eval.c (Feval): Abort if INPUT_BLOCKED_P.
57
582004-11-02 KOBAYASHI Yasuhiro <kobayays@otsukakj.co.jp>
59
60 * w32fns.c (w32_font_match): Use fast_string_match_ignore_case for
61 comparing font names.
62
632004-11-02 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
64
65 * fileio.c (Fread_file_name): Pass Qt as fifth parameter to
66 Fx_file_dialog if only directories should be read.
67
68 * lisp.h: Fx_file_dialog takes 5 parameters.
69
70 * xfns.c (Fx_file_dialog): Both Motif and GTK version: Add
71 parameter only_dir_p.
72 In Motif version, don't put DEFAULT_FILENAME in filter part of the
73 dialog, just text field part. Do not add DEFAULT_FILENAME
74 to list of files if it isn't there.
75 In GTK version, pass only_dir_p parameter to xg_get_file_name.
76
77 * macfns.c (Fx_file_dialog): Add parameter only_dir_p. Check
78 only_dir_p instead of comparing prompt to "Dired". When using
79 a save dialog, add option kNavDontConfirmReplacement, change title
80 to "Enter name", change text for save button to "Ok".
81
82 * w32fns.c (Fx_file_dialog): Add parameter only_dir_p. Check
83 only_dir_p instead of comparing prompt to "Dired".
84
85 * gtkutil.c (xg_get_file_with_chooser)
86 (xg_get_file_with_selection): New functions, only defined ifdef
87 HAVE_GTK_FILE_CHOOSER_DIALOG_NEW and HAVE_GTK_FILE_SELECTION_NEW
88 respectively.
89 (xg_get_file_name): Add parameter only_dir_p.
90 Call xg_get_file_with_chooser or xg_get_file_with_selection
91 depending on HAVE_GTK_FILE* and the value of use_old_gtk_file_dialog.
92 (xg_initialize): New DEFVAR_BOOL use_old_gtk_file_dialog.
93
94 * gtkutil.h (xg_get_file_name): Add parameter only_dir_p.
95
96 * config.in: Rebuild (added HAVE_GTK_FILE_*).
97
982004-11-01 Kim F. Storm <storm@cua.dk>
99
100 * process.c (connect_wait_mask, num_pending_connects): Only
101 declare and use them if NON_BLOCKING_CONNECT is defined.
102 (init_process): Initialize them if NON_BLOCKING_CONNECT defined.
103 (IF_NON_BLOCKING_CONNECT): New helper macro.
104 (wait_reading_process_output): Only declare and use local vars
105 Connecting and check_connect when NON_BLOCKING_CONNECT is defined.
106
1072004-11-01 Andy Petrusenco <Igrek@star-sw.com> (tiny change)
108
109 * w32term.c (x_scroll_run): Delete region objects after use.
110
1112004-10-31 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
112
113 * xmenu.c: Add prototypes for forward function declarations.
114 (popup_get_selection): Remove parameter do_timers, remove call to
115 timer_check.
116 (create_and_show_popup_menu, create_and_show_dialog): Remove
117 parameter do_timers from call to popup_get_selection.
118
119 * xdisp.c (update_tool_bar): Pass a copy of f->tool_bar_items to
120 tool_bar_items and assign the result to f->tool_bar_items if
121 not equal. Move BLOCK/UNBLOCK_INPUT from around call to
122 tool_bar_items to assignment of result.
123
124 * atimer.c (alarm_signal_handler): Do not call set_alarm if
125 pending_atmers is non-zero.
126
1272004-10-31 Kim F. Storm <storm@cua.dk>
128
129 * dispnew.c (margin_glyphs_to_reserve): Don't use ncols_scale_factor.
130
1312004-10-28 Will <will@glozer.net>
132
133 * macterm.c: allow user to assign key modifiers to the Mac Option
134 key via a 'mac-option-modifier' variable.
135
1362004-10-28 Stefan <monnier@iro.umontreal.ca>
137
138 * xselect.c (Vx_lost_selection_functions, Vx_sent_selection_functions):
139 Rename from Vx_lost_selection_hooks and Vx_sent_selection_hooks.
140 (x_handle_selection_request, x_handle_selection_clear)
141 (x_clear_frame_selections, syms_of_xselect): Adjust accordingly.
142
1432004-10-28 Richard M. Stallman <rms@gnu.org>
144
145 * w32fns.c (Fx_server_vendor, Fx_server_version): Doc fixes.
146
147 * xfns.c (Fx_server_vendor, Fx_server_version): Doc fixes.
148
1492004-10-27 Stefan Monnier <monnier@iro.umontreal.ca>
150
151 * syntax.c (scan_sexps_forward): Give precedence to a 2-char
152 comment-starter over a 1-char one.
153
1542004-10-27 Richard M. Stallman <rms@gnu.org>
155
156 * xdisp.c (get_next_display_element): In mode lines,
157 treat newline and tab like other control characters.
158
159 * editfns.c (Fmessage): Doc fix.
160
161 * indent.c (vmotion): When moving up, check the newline before.
162 Make prevline an int, not a Lisp_Object.
163
12004-10-27 Kim F. Storm <storm@cua.dk> 1642004-10-27 Kim F. Storm <storm@cua.dk>
2 165
3 * editfns.c (Fformat): Allocate discarded table with SAFE_ALLOCA. 166 * editfns.c (Fformat): Allocate discarded table with SAFE_ALLOCA.
@@ -12,8 +175,8 @@
122004-10-26 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> 1752004-10-26 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
13 176
14 * gtkutil.c: Put empty line between comment and function body. 177 * gtkutil.c: Put empty line between comment and function body.
15 (xg_destroy_widgets): Renamed from remove_from_container. Just 178 (xg_destroy_widgets): Rename from remove_from_container.
16 destroy all widgets in list. Argument wcont removed. 179 Just destroy all widgets in list. Argument wcont removed.
17 (xg_update_menubar, xg_update_submenu): Call xg_destroy_widgets 180 (xg_update_menubar, xg_update_submenu): Call xg_destroy_widgets
18 instead of remove_from_container. 181 instead of remove_from_container.
19 (xg_display_close, xg_create_tool_bar, update_frame_tool_bar) 182 (xg_display_close, xg_create_tool_bar, update_frame_tool_bar)
@@ -54,17 +217,17 @@
54 217
552004-10-21 K,Aa(Broly L$,1 q(Brentey <lorentey@elte.hu> 2182004-10-21 K,Aa(Broly L$,1 q(Brentey <lorentey@elte.hu>
56 219
57 * xterm.h (x_output): New member `xic_base_fontname'. 220 * xterm.h (x_output): New member `xic_base_fontname'.
58 (FRAME_XIC_BASE_FONTNAME): New macro. 221 (FRAME_XIC_BASE_FONTNAME): New macro.
59 (xic_free_xfontset): Declare. 222 (xic_free_xfontset): Declare.
60 223
61 * xfns.c (xic_create_xfontset): Share fontsets between frames 224 * xfns.c (xic_create_xfontset): Share fontsets between frames
62 based on base_fontname. 225 based on base_fontname.
63 (xic_free_xfontset): New function. 226 (xic_free_xfontset): New function.
64 (free_frame_xic): Use it. 227 (free_frame_xic): Use it.
65 (xic_set_xfontset): Ditto. 228 (xic_set_xfontset): Ditto.
66 229
67 * xterm.c (xim_destroy_callback): Ditto. 230 * xterm.c (xim_destroy_callback): Ditto.
68 231
69 232
702004-10-20 B. Anyos <banyos@freemail.hu> (tiny change) 2332004-10-20 B. Anyos <banyos@freemail.hu> (tiny change)
@@ -108,10 +271,10 @@
108 271
109 * gtkutil.h (xg_update_scrollbar_pos): Remove arguments real_left 272 * gtkutil.h (xg_update_scrollbar_pos): Remove arguments real_left
110 and canon_width. 273 and canon_width.
111 (xg_frame_cleared): Removed. 274 (xg_frame_cleared): Remove.
112 275
113 * gtkutil.c (xg_frame_cleared, xg_fixed_handle_expose, 276 * gtkutil.c (xg_frame_cleared, xg_fixed_handle_expose)
114 xg_find_top_left_in_fixed): Removed. 277 (xg_find_top_left_in_fixed): Remove.
115 (xg_create_scroll_bar): Put an event box widget between 278 (xg_create_scroll_bar): Put an event box widget between
116 the scroll bar widget and the edit widget. 279 the scroll bar widget and the edit widget.
117 (xg_show_scroll_bar): Show the parent widget (the event box). 280 (xg_show_scroll_bar): Show the parent widget (the event box).
@@ -120,11 +283,11 @@
120 Move the parent (the event box) widget inside the fixed widget. 283 Move the parent (the event box) widget inside the fixed widget.
121 Move window clear to xterm.c. 284 Move window clear to xterm.c.
122 285
123 * gtkutil.h (xg_frame_cleared): Removed. 286 * gtkutil.h (xg_frame_cleared): Remove.
124 287
125 * xterm.c (x_clear_frame): Remove call to xg_frame_cleared 288 * xterm.c (x_clear_frame): Remove call to xg_frame_cleared
126 (x_scroll_bar_create, XTset_vertical_scroll_bar): Remove 289 (x_scroll_bar_create, XTset_vertical_scroll_bar):
127 arguments left and width to xg_update_scrollbar_pos. 290 Remove arguments left and width to xg_update_scrollbar_pos.
128 (XTset_vertical_scroll_bar): Do x_clear_area for USE_GTK also. 291 (XTset_vertical_scroll_bar): Do x_clear_area for USE_GTK also.
129 292
1302004-10-19 Kenichi Handa <handa@m17n.org> 2932004-10-19 Kenichi Handa <handa@m17n.org>
@@ -349,7 +512,7 @@
349 compositions to encode. 512 compositions to encode.
350 (encode_coding_string): Likewise. Free composition data. 513 (encode_coding_string): Likewise. Free composition data.
351 514
3522004-09-30 Florian Weimer <fw@deneb.enyo.de> (tiny change) 5152004-09-30 Florian Weimer <fw@deneb.enyo.de>
353 516
354 * coding.c (code_convert_region): Free composition data. 517 * coding.c (code_convert_region): Free composition data.
355 518
@@ -923,7 +1086,7 @@
923 (Fsave_window_excursion, Fset_window_vscroll) 1086 (Fsave_window_excursion, Fset_window_vscroll)
924 (syms_of_window) <window-size-fixed>: Doc fixes. 1087 (syms_of_window) <window-size-fixed>: Doc fixes.
925 1088
9262004-07-19 KOBAYASHI Yasuhiro <kobayays@otsukakj.co.jp> (tiny change) 10892004-07-19 KOBAYASHI Yasuhiro <kobayays@otsukakj.co.jp>
927 1090
928 * w32fns.c (Fx_file_dialog): Use ENCODE_FILE instead of 1091 * w32fns.c (Fx_file_dialog): Use ENCODE_FILE instead of
929 ENCODE_SYSTEM for filenames. 1092 ENCODE_SYSTEM for filenames.
@@ -982,7 +1145,7 @@
982 1145
983 * buffer.c (syms_of_buffer) <transient-mark-mode>: Doc fix. 1146 * buffer.c (syms_of_buffer) <transient-mark-mode>: Doc fix.
984 1147
9852004-07-15 KOBAYASHI Yasuhiro <kobayays@otsukakj.co.jp> (tiny change) 11482004-07-15 KOBAYASHI Yasuhiro <kobayays@otsukakj.co.jp>
986 1149
987 * w32fns.c (Fx_file_dialog): Encode strings in system coding 1150 * w32fns.c (Fx_file_dialog): Encode strings in system coding
988 system before passing them to OS functions for display. 1151 system before passing them to OS functions for display.
@@ -1646,7 +1809,7 @@
1646 before actually accepting connection in case it has already been 1809 before actually accepting connection in case it has already been
1647 accepted due to recursion. 1810 accepted due to recursion.
1648 1811
16492004-05-23 K,Ba(Broly L,Bu(Brentey <lorentey@elte.hu> (tiny change) 18122004-05-23 K,Ba(Broly L,Bu(Brentey <lorentey@elte.hu>
1650 1813
1651 * coding.c (Fset_safe_terminal_coding_system_internal): 1814 * coding.c (Fset_safe_terminal_coding_system_internal):
1652 Set suppress_error in safe_terminal_coding, not terminal_coding. 1815 Set suppress_error in safe_terminal_coding, not terminal_coding.
@@ -1960,7 +2123,7 @@
1960 * w32fns.c (Vw32_ansi_code_page): New Lisp variable. 2123 * w32fns.c (Vw32_ansi_code_page): New Lisp variable.
1961 (globals_of_w32fns): Set it. 2124 (globals_of_w32fns): Set it.
1962 2125
19632004-05-09 Piet van Oostrum <piet@cs.uu.nl> (tiny change) 21262004-05-09 Piet van Oostrum <piet@cs.uu.nl>
1964 2127
1965 * data.c (Fquo): Simplify. 2128 * data.c (Fquo): Simplify.
1966 2129
@@ -2009,7 +2172,7 @@
2009 2172
2010 * emacs.c (main) [VMS]: Fix var ref. 2173 * emacs.c (main) [VMS]: Fix var ref.
2011 2174
20122004-05-06 Romain Francoise <romain@orebokech.com> (tiny change) 21752004-05-06 Romain Francoise <romain@orebokech.com>
2013 2176
2014 * data.c (Fsetq_default): Fix docstring. 2177 * data.c (Fsetq_default): Fix docstring.
2015 2178
@@ -2049,7 +2212,7 @@
2049 2212
2050 * Makefile.in (region-cache.o): Depend on config.h. 2213 * Makefile.in (region-cache.o): Depend on config.h.
2051 2214
20522004-05-02 Romain Francoise <romain@orebokech.com> (tiny change) 22152004-05-02 Romain Francoise <romain@orebokech.com>
2053 2216
2054 * indent.c (compute_motion): Save vpos in prev_vpos when dealing 2217 * indent.c (compute_motion): Save vpos in prev_vpos when dealing
2055 with continuation lines, too. 2218 with continuation lines, too.
@@ -3292,7 +3455,7 @@
3292 entries that were used before we return. 3455 entries that were used before we return.
3293 (init_keyboard): Initialize read_avail_input_buf here. 3456 (init_keyboard): Initialize read_avail_input_buf here.
3294 3457
32952004-02-16 Jesper Harder <harder@ifa.au.dk> (tiny change) 34582004-02-16 Jesper Harder <harder@ifa.au.dk>
3296 3459
3297 * cmds.c (Fend_of_line): Doc fix. 3460 * cmds.c (Fend_of_line): Doc fix.
3298 3461
@@ -3960,7 +4123,7 @@
3960 to the definition of `signal' in the Elisp manual. 4123 to the definition of `signal' in the Elisp manual.
3961 * eval.c (Fsignal): Ditto. 4124 * eval.c (Fsignal): Ditto.
3962 4125
39632003-12-29 James Clark <jjc@jclark.com> (tiny change) 41262003-12-29 James Clark <jjc@jclark.com>
3964 4127
3965 * fns.c (internal_equal): Return t for two NaN arguments. 4128 * fns.c (internal_equal): Return t for two NaN arguments.
3966 4129
@@ -5020,7 +5183,7 @@
5020 * fileio.c (Fwrite_region): Fix conditional expression to issue 5183 * fileio.c (Fwrite_region): Fix conditional expression to issue
5021 the right message. 5184 the right message.
5022 5185
50232003-08-16 Juri Linkov <juri@jurta.org> (tiny change) 51862003-08-16 Juri Linkov <juri@jurta.org>
5024 5187
5025 * syntax.c (Fforward_word): Argument changed to optional. 5188 * syntax.c (Fforward_word): Argument changed to optional.
5026 Set default value to 1. 5189 Set default value to 1.
@@ -5079,7 +5242,7 @@
5079 * fns.c (Fclear_string): New function. 5242 * fns.c (Fclear_string): New function.
5080 (syms_of_fns): defsubr it. 5243 (syms_of_fns): defsubr it.
5081 5244
50822003-07-28 KOBAYASHI Yasuhiro <kobayays@otsukakj.co.jp> (tiny change) 52452003-07-28 KOBAYASHI Yasuhiro <kobayays@otsukakj.co.jp>
5083 5246
5084 * xfns.c (xic_set_preeditarea): Add the left fringe width to spot.x. 5247 * xfns.c (xic_set_preeditarea): Add the left fringe width to spot.x.
5085 5248
@@ -5307,7 +5470,7 @@
5307 5470
5308 * alloc.c (Fgarbage_collect): Doc fix. 5471 * alloc.c (Fgarbage_collect): Doc fix.
5309 5472
53102003-07-07 Nozomu Ando <nand@mac.com> (tiny change) 54732003-07-07 Nozomu Ando <nand@mac.com>
5311 5474
5312 * buffer.c (Fkill_buffer): Clear charpos cache if necessary. 5475 * buffer.c (Fkill_buffer): Clear charpos cache if necessary.
5313 5476
@@ -6517,7 +6680,7 @@
6517 * alloc.c (Fgarbage_collect): Cast pointers into specpdl 6680 * alloc.c (Fgarbage_collect): Cast pointers into specpdl
6518 to avoid GCC warning. 6681 to avoid GCC warning.
6519 6682
65202003-05-16 Ralph Schleicher <rs@nunatak.allgaeu.org> (tiny change) 66832003-05-16 Ralph Schleicher <rs@nunatak.allgaeu.org>
6521 6684
6522 * fileio.c (Fdelete_file): Handle symlinks pointing to directories. 6685 * fileio.c (Fdelete_file): Handle symlinks pointing to directories.
6523 6686
@@ -8240,7 +8403,7 @@
8240 (w32_init_class): Use it. 8403 (w32_init_class): Use it.
8241 (x_put_x_image): Declare all args. 8404 (x_put_x_image): Declare all args.
8242 8405
82432003-01-21 Richard Dawe <rich@phekda.freeserve.co.uk> (tiny change) 84062003-01-21 Richard Dawe <rich@phekda.freeserve.co.uk>
8244 8407
8245 * Makefile.in (ALL_CFLAGS): Include MYCPPFLAGS, not MYCPPFLAG. 8408 * Makefile.in (ALL_CFLAGS): Include MYCPPFLAGS, not MYCPPFLAG.
8246 8409
@@ -8612,7 +8775,7 @@
8612 in direct action cases for Qforward_char and Qbackward_char. 8775 in direct action cases for Qforward_char and Qbackward_char.
8613 Set already_adjusted so it won't be done twice. 8776 Set already_adjusted so it won't be done twice.
8614 8777
86152002-12-30 Richard Dawe <rich@phekda.freeserve.co.uk> (tiny change) 87782002-12-30 Richard Dawe <rich@phekda.freeserve.co.uk>
8616 8779
8617 * src/config.in (!HAVE_SIZE_T): Fix order of arguments in 8780 * src/config.in (!HAVE_SIZE_T): Fix order of arguments in
8618 type definition of size_t. 8781 type definition of size_t.
@@ -8710,7 +8873,7 @@
8710 * dired.c (file_name_completion): Fix that change. 8873 * dired.c (file_name_completion): Fix that change.
8711 Delete special quit-handling code; just use QUIT. 8874 Delete special quit-handling code; just use QUIT.
8712 8875
87132002-12-21 Tak Ota <Takaaki.Ota@am.sony.com> (tiny change) 88762002-12-21 Tak Ota <Takaaki.Ota@am.sony.com>
8714 8877
8715 * dired.c (file_name_completion): Close directory on error 8878 * dired.c (file_name_completion): Close directory on error
8716 just as in directory_files_internal. 8879 just as in directory_files_internal.
@@ -10050,8 +10213,8 @@
10050 10213
100512002-08-26 Kim F. Storm <storm@cua.dk> 102142002-08-26 Kim F. Storm <storm@cua.dk>
10052 10215
10053 * frame.c (make_terminal_frame) [CANNOT_DUMP]: Initialize foreground 10216 * frame.c (make_terminal_frame) [CANNOT_DUMP]: Initialize
10054 and background colors. From Joe Buehler (tiny change). 10217 foreground and background colors. From Joe Buehler.
10055 10218
100562002-08-26 Miles Bader <miles@gnu.org> 102192002-08-26 Miles Bader <miles@gnu.org>
10057 10220
diff --git a/src/ChangeLog.8 b/src/ChangeLog.8
index 91fcdd1c899..a9465058194 100644
--- a/src/ChangeLog.8
+++ b/src/ChangeLog.8
@@ -6,25 +6,25 @@
6 6
71999-12-31 William M. Perry <wmperry@aventail.com> 71999-12-31 William M. Perry <wmperry@aventail.com>
8 8
9 * xfns.c (jpeg_format): Added the :data keyword 9 * xfns.c (jpeg_format): Add the :data keyword
10 (jpeg_image_p): JPEG is valid with :file _or_ :data 10 (jpeg_image_p): JPEG is valid with :file _or_ :data
11 (jpeg_memory_src): Defined new JPEG image source to read from a 11 (jpeg_memory_src): Define new JPEG image source to read from a
12 memory buffer. 12 memory buffer.
13 (jpeg_load): Pay attention to the :data keyword if specified. 13 (jpeg_load): Pay attention to the :data keyword if specified.
14 Instantiates a jpeg_memory_src instead of jpeg_stdio_src if found. 14 Instantiates a jpeg_memory_src instead of jpeg_stdio_src if found.
15 (png_format): Added the :data keyword 15 (png_format): Add the :data keyword
16 (png_image_p): PNG is valid with :file _or_ :data 16 (png_image_p): PNG is valid with :file _or_ :data
17 (png_read_from_memory): New PNG read function to read from a 17 (png_read_from_memory): New PNG read function to read from a
18 memory buffer. 18 memory buffer.
19 (png_load): Pay attention to the :data keyword if specified. 19 (png_load): Pay attention to the :data keyword if specified.
20 Use png_set_read_fn() instead of png_init_io() if specified. 20 Use png_set_read_fn() instead of png_init_io() if specified.
21 (tiff_format): Added the :data keyword for TIFF images. 21 (tiff_format): Add the :data keyword for TIFF images.
22 (tiff_image_p): TIFF is valid with :file _or_ :data 22 (tiff_image_p): TIFF is valid with :file _or_ :data
23 (tiff_read_from_memory): Defined new TIFF I/O functions to read 23 (tiff_read_from_memory): Define new TIFF I/O functions to read
24 from a memory buffer. 24 from a memory buffer.
25 (tiff_load): Pay attention to the :data keyword if specified. 25 (tiff_load): Pay attention to the :data keyword if specified.
26 Uses TIFFClientOpen() instead of TIFFOpen() if specified. 26 Uses TIFFClientOpen() instead of TIFFOpen() if specified.
27 (gif_format): Added the :data keyword 27 (gif_format): Add the :data keyword
28 (gif_image_p): GIF is valid with :file _or_ :data 28 (gif_image_p): GIF is valid with :file _or_ :data
29 (gif_read_from_memory): New GIF input function to read from a 29 (gif_read_from_memory): New GIF input function to read from a
30 memory buffer. 30 memory buffer.
diff --git a/src/Makefile.in b/src/Makefile.in
index 80789a99e39..5d6112c8fec 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -1034,7 +1034,7 @@ callint.o: callint.c window.h commands.h buffer.h keymap.h \
1034 keyboard.h dispextern.h $(config_h) 1034 keyboard.h dispextern.h $(config_h)
1035callproc.o: callproc.c epaths.h buffer.h commands.h $(config_h) \ 1035callproc.o: callproc.c epaths.h buffer.h commands.h $(config_h) \
1036 process.h systty.h syssignal.h character.h coding.h ccl.h msdos.h \ 1036 process.h systty.h syssignal.h character.h coding.h ccl.h msdos.h \
1037 composite.h w32.h 1037 composite.h w32.h blockinput.h atimer.h systime.h
1038casefiddle.o: casefiddle.c syntax.h commands.h buffer.h character.h \ 1038casefiddle.o: casefiddle.c syntax.h commands.h buffer.h character.h \
1039 composite.h \ 1039 composite.h \
1040 charset.h keymap.h $(config_h) 1040 charset.h keymap.h $(config_h)
diff --git a/src/atimer.c b/src/atimer.c
index 9ec0238ff28..7410cad0244 100644
--- a/src/atimer.c
+++ b/src/atimer.c
@@ -397,7 +397,8 @@ alarm_signal_handler (signo)
397 EMACS_GET_TIME (now); 397 EMACS_GET_TIME (now);
398 } 398 }
399 399
400 set_alarm (); 400 if (! pending_atimers)
401 set_alarm ();
401} 402}
402 403
403 404
diff --git a/src/callproc.c b/src/callproc.c
index ba81f426dae..623509ce199 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -83,6 +83,7 @@ extern int errno;
83#include "process.h" 83#include "process.h"
84#include "syssignal.h" 84#include "syssignal.h"
85#include "systty.h" 85#include "systty.h"
86#include "blockinput.h"
86 87
87#ifdef MSDOS 88#ifdef MSDOS
88#include "msdos.h" 89#include "msdos.h"
@@ -620,6 +621,8 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
620 pid = child_setup (filefd, fd1, fd_error, (char **) new_argv, 621 pid = child_setup (filefd, fd1, fd_error, (char **) new_argv,
621 0, current_dir); 622 0, current_dir);
622#else /* not WINDOWSNT */ 623#else /* not WINDOWSNT */
624 BLOCK_INPUT;
625
623 pid = vfork (); 626 pid = vfork ();
624 627
625 if (pid == 0) 628 if (pid == 0)
@@ -637,6 +640,8 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
637 child_setup (filefd, fd1, fd_error, (char **) new_argv, 640 child_setup (filefd, fd1, fd_error, (char **) new_argv,
638 0, current_dir); 641 0, current_dir);
639 } 642 }
643
644 UNBLOCK_INPUT;
640#endif /* not WINDOWSNT */ 645#endif /* not WINDOWSNT */
641 646
642 /* The MSDOS case did this already. */ 647 /* The MSDOS case did this already. */
diff --git a/src/config.in b/src/config.in
index 136f4ecd55d..0fb9126b470 100644
--- a/src/config.in
+++ b/src/config.in
@@ -217,6 +217,15 @@ Boston, MA 02111-1307, USA. */
217/* Define to 1 if using GTK. */ 217/* Define to 1 if using GTK. */
218#undef HAVE_GTK 218#undef HAVE_GTK
219 219
220/* Define to 1 if GTK has both file selection and chooser dialog. */
221#undef HAVE_GTK_FILE_BOTH
222
223/* Define to 1 if you have the `gtk_file_chooser_dialog_new' function. */
224#undef HAVE_GTK_FILE_CHOOSER_DIALOG_NEW
225
226/* Define to 1 if you have the `gtk_file_selection_new' function. */
227#undef HAVE_GTK_FILE_SELECTION_NEW
228
220/* Define to 1 if GTK can handle more than one display. */ 229/* Define to 1 if GTK can handle more than one display. */
221#undef HAVE_GTK_MULTIDISPLAY 230#undef HAVE_GTK_MULTIDISPLAY
222 231
diff --git a/src/dispnew.c b/src/dispnew.c
index 657a8e87b95..814a3095ddf 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -579,7 +579,7 @@ margin_glyphs_to_reserve (w, total_glyphs, margin)
579 int width = XFASTINT (w->total_cols); 579 int width = XFASTINT (w->total_cols);
580 double d = max (0, XFLOATINT (margin)); 580 double d = max (0, XFLOATINT (margin));
581 d = min (width / 2 - 1, d); 581 d = min (width / 2 - 1, d);
582 n = (int) ((double) total_glyphs / width * d) * w->ncols_scale_factor; 582 n = (int) ((double) total_glyphs / width * d);
583 } 583 }
584 else 584 else
585 n = 0; 585 n = 0;
diff --git a/src/editfns.c b/src/editfns.c
index e1482936fe5..f6e3a4bb357 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -3168,11 +3168,14 @@ static int message_length;
3168 3168
3169DEFUN ("message", Fmessage, Smessage, 1, MANY, 0, 3169DEFUN ("message", Fmessage, Smessage, 1, MANY, 0,
3170 doc: /* Print a one-line message at the bottom of the screen. 3170 doc: /* Print a one-line message at the bottom of the screen.
3171The message also goes into the `*Messages*' buffer.
3172\(In keyboard macros, that's all it does.)
3173
3171The first argument is a format control string, and the rest are data 3174The first argument is a format control string, and the rest are data
3172to be formatted under control of the string. See `format' for details. 3175to be formatted under control of the string. See `format' for details.
3173 3176
3174If the first argument is nil, clear any existing message; let the 3177If the first argument is nil, the function clears any existing message;
3175minibuffer contents show. 3178this lets the minibuffer contents show. See also `current-message'.
3176 3179
3177usage: (message STRING &rest ARGS) */) 3180usage: (message STRING &rest ARGS) */)
3178 (nargs, args) 3181 (nargs, args)
diff --git a/src/emacs.c b/src/emacs.c
index 98572d7e6dc..5e583137dae 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -305,7 +305,6 @@ Display options:\n\
305--fullscreen, -fs make first frame fullscreen\n\ 305--fullscreen, -fs make first frame fullscreen\n\
306--fullwidth, -fw make the first frame wide as the screen\n\ 306--fullwidth, -fw make the first frame wide as the screen\n\
307--geometry, -g GEOMETRY window geometry\n\ 307--geometry, -g GEOMETRY window geometry\n\
308--horizontal-scroll-bars, -hb enable horizontal scroll bars\n\
309--icon-type, -i use picture of gnu for Emacs icon\n\ 308--icon-type, -i use picture of gnu for Emacs icon\n\
310--iconic start Emacs in iconified state\n\ 309--iconic start Emacs in iconified state\n\
311--internal-border, -ib WIDTH width between text and main border\n\ 310--internal-border, -ib WIDTH width between text and main border\n\
diff --git a/src/eval.c b/src/eval.c
index ee74215b2ee..5fb35cee58b 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -540,21 +540,45 @@ usage: (function ARG) */)
540 540
541 541
542DEFUN ("interactive-p", Finteractive_p, Sinteractive_p, 0, 0, 0, 542DEFUN ("interactive-p", Finteractive_p, Sinteractive_p, 0, 0, 0,
543 doc: /* Return t if function in which this appears was called interactively. 543 doc: /* Return t if the function was run directly by user input.
544This means that the function was called with call-interactively (which 544This means that the function was called with call-interactively (which
545includes being called as the binding of a key) 545includes being called as the binding of a key)
546and input is currently coming from the keyboard (not in keyboard macro). */) 546and input is currently coming from the keyboard (not in keyboard macro),
547and Emacs is not running in batch mode (`noninteractive' is nil).
548
549The only known proper use of `interactive-p' is in deciding whether to
550display a helpful message, or how to display it. If you're thinking
551of using it for any other purpose, it is quite likely that you're
552making a mistake. Think: what do you want to do when the command is
553called from a keyboard macro?
554
555If you want to test whether your function was called with
556`call-interactively', the way to do that is by adding an extra
557optional argument, and making the `interactive' spec specify non-nil
558unconditionally for that argument. (`p' is a good way to do this.) */)
547 () 559 ()
548{ 560{
549 return interactive_p (1) ? Qt : Qnil; 561 return (INTERACTIVE && interactive_p (1)) ? Qt : Qnil;
550} 562}
551 563
552 564
553/* Return 1 if function in which this appears was called 565DEFUN ("called-interactively-p", Fcalled_interactively_p, Scalled_interactively_p, 0, 0, 0,
554 interactively. This means that the function was called with 566 doc: /* Return t if the function using this was called with call-interactively.
555 call-interactively (which includes being called as the binding of 567This is used for implementing advice and other function-modifying
556 a key) and input is currently coming from the keyboard (not in 568features of Emacs.
557 keyboard macro). 569
570The cleanest way to test whether your function was called with
571`call-interactively', the way to do that is by adding an extra
572optional argument, and making the `interactive' spec specify non-nil
573unconditionally for that argument. (`p' is a good way to do this.) */)
574 ()
575{
576 return (INTERACTIVE && interactive_p (1)) ? Qt : Qnil;
577}
578
579
580/* Return 1 if function in which this appears was called using
581 call-interactively.
558 582
559 EXCLUDE_SUBRS_P non-zero means always return 0 if the function 583 EXCLUDE_SUBRS_P non-zero means always return 0 if the function
560 called is a built-in. */ 584 called is a built-in. */
@@ -566,9 +590,6 @@ interactive_p (exclude_subrs_p)
566 struct backtrace *btp; 590 struct backtrace *btp;
567 Lisp_Object fun; 591 Lisp_Object fun;
568 592
569 if (!INTERACTIVE)
570 return 0;
571
572 btp = backtrace_list; 593 btp = backtrace_list;
573 594
574 /* If this isn't a byte-compiled function, there may be a frame at 595 /* If this isn't a byte-compiled function, there may be a frame at
@@ -1975,7 +1996,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
1975 struct backtrace backtrace; 1996 struct backtrace backtrace;
1976 struct gcpro gcpro1, gcpro2, gcpro3; 1997 struct gcpro gcpro1, gcpro2, gcpro3;
1977 1998
1978 if (handling_signal) 1999 if (handling_signal || INPUT_BLOCKED_P)
1979 abort (); 2000 abort ();
1980 2001
1981 if (SYMBOLP (form)) 2002 if (SYMBOLP (form))
@@ -3449,6 +3470,7 @@ The value the function returns is not used. */);
3449 defsubr (&Scondition_case); 3470 defsubr (&Scondition_case);
3450 defsubr (&Ssignal); 3471 defsubr (&Ssignal);
3451 defsubr (&Sinteractive_p); 3472 defsubr (&Sinteractive_p);
3473 defsubr (&Scalled_interactively_p);
3452 defsubr (&Scommandp); 3474 defsubr (&Scommandp);
3453 defsubr (&Sautoload); 3475 defsubr (&Sautoload);
3454 defsubr (&Seval); 3476 defsubr (&Seval);
diff --git a/src/fileio.c b/src/fileio.c
index ce05ef1a5ea..83c0866cf06 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -6237,7 +6237,8 @@ and `read-file-name-function'. */)
6237 } 6237 }
6238 if (!NILP(default_filename)) 6238 if (!NILP(default_filename))
6239 default_filename = Fexpand_file_name (default_filename, dir); 6239 default_filename = Fexpand_file_name (default_filename, dir);
6240 val = Fx_file_dialog (prompt, dir, default_filename, mustmatch); 6240 val = Fx_file_dialog (prompt, dir, default_filename, mustmatch,
6241 EQ (predicate, Qfile_directory_p) ? Qt : Qnil);
6241 add_to_history = 1; 6242 add_to_history = 1;
6242 } 6243 }
6243 else 6244 else
diff --git a/src/fontset.c b/src/fontset.c
index a8bab6897d6..52d3cc555c5 100644
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -1076,7 +1076,7 @@ fontset_pattern_regexp (pattern)
1076 { 1076 {
1077 if (*p0 == '-') 1077 if (*p0 == '-')
1078 ndashes++; 1078 ndashes++;
1079 else if (*p0 == '*') 1079 else if (*p0 == '*' && p0 > SDATA (pattern) && p0[-1] != '\\')
1080 nstars++; 1080 nstars++;
1081 } 1081 }
1082 1082
@@ -1091,7 +1091,7 @@ fontset_pattern_regexp (pattern)
1091 *p1++ = '^'; 1091 *p1++ = '^';
1092 for (p0 = (char *) SDATA (pattern); *p0; p0++) 1092 for (p0 = (char *) SDATA (pattern); *p0; p0++)
1093 { 1093 {
1094 if (*p0 == '*') 1094 if (*p0 == '*' && p0 > SDATA (pattern) && p0[-1] != '\\')
1095 { 1095 {
1096 if (ndashes < 14) 1096 if (ndashes < 14)
1097 *p1++ = '.'; 1097 *p1++ = '.';
diff --git a/src/gtkutil.c b/src/gtkutil.c
index dc091c1a09b..e1331891140 100644
--- a/src/gtkutil.c
+++ b/src/gtkutil.c
@@ -1118,6 +1118,10 @@ create_dialog (wv, select_cb, deactivate_cb)
1118} 1118}
1119 1119
1120 1120
1121
1122/***********************************************************************
1123 File dialog functions
1124 ***********************************************************************/
1121enum 1125enum
1122{ 1126{
1123 XG_FILE_NOT_DONE, 1127 XG_FILE_NOT_DONE,
@@ -1126,6 +1130,69 @@ enum
1126 XG_FILE_DESTROYED, 1130 XG_FILE_DESTROYED,
1127}; 1131};
1128 1132
1133#ifdef HAVE_GTK_FILE_BOTH
1134static int use_old_gtk_file_dialog;
1135#endif
1136
1137
1138#ifdef HAVE_GTK_FILE_CHOOSER_DIALOG_NEW
1139/* Read a file name from the user using a file chooser dialog.
1140 F is the current frame.
1141 PROMPT is a prompt to show to the user. May not be NULL.
1142 DEFAULT_FILENAME is a default selection to be displayed. May be NULL.
1143 If MUSTMATCH_P is non-zero, the returned file name must be an existing
1144 file.
1145
1146 Returns a file name or NULL if no file was selected.
1147 The returned string must be freed by the caller. */
1148
1149static char *
1150xg_get_file_with_chooser (f, prompt, default_filename, mustmatch_p, only_dir_p)
1151 FRAME_PTR f;
1152 char *prompt;
1153 char *default_filename;
1154 int mustmatch_p, only_dir_p;
1155{
1156 GtkWidget *filewin;
1157 GtkWindow *gwin = GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f));
1158
1159 char *fn = 0;
1160 GtkFileChooserAction action = (mustmatch_p ?
1161 GTK_FILE_CHOOSER_ACTION_OPEN :
1162 GTK_FILE_CHOOSER_ACTION_SAVE);
1163
1164 if (only_dir_p)
1165 action = GTK_FILE_CHOOSER_ACTION_SELECT_FOLDER;
1166
1167 filewin = gtk_file_chooser_dialog_new (prompt, gwin, action,
1168 GTK_STOCK_CANCEL, GTK_RESPONSE_CANCEL,
1169 (mustmatch_p || only_dir_p ?
1170 GTK_STOCK_OPEN : GTK_STOCK_OK),
1171 GTK_RESPONSE_OK,
1172 NULL);
1173
1174 xg_set_screen (filewin, f);
1175 gtk_widget_set_name (filewin, "emacs-filedialog");
1176 gtk_window_set_transient_for (GTK_WINDOW (filewin), gwin);
1177 gtk_window_set_destroy_with_parent (GTK_WINDOW (filewin), TRUE);
1178
1179
1180 if (default_filename)
1181 gtk_file_chooser_set_filename (GTK_FILE_CHOOSER (filewin),
1182 default_filename);
1183
1184 gtk_widget_show (filewin);
1185
1186 if (gtk_dialog_run (GTK_DIALOG (filewin)) == GTK_RESPONSE_OK)
1187 fn = gtk_file_chooser_get_filename (GTK_FILE_CHOOSER (filewin));
1188
1189 gtk_widget_destroy (filewin);
1190
1191 return fn;
1192}
1193#endif /* HAVE_GTK_FILE_CHOOSER_DIALOG_NEW */
1194
1195#ifdef HAVE_GTK_FILE_SELECTION_NEW
1129/* Callback function invoked when the Ok button is pressed in 1196/* Callback function invoked when the Ok button is pressed in
1130 a file dialog. 1197 a file dialog.
1131 W is the file dialog widget, 1198 W is the file dialog widget,
@@ -1167,7 +1234,7 @@ xg_file_sel_destroy (w, arg)
1167 *(int*)arg = XG_FILE_DESTROYED; 1234 *(int*)arg = XG_FILE_DESTROYED;
1168} 1235}
1169 1236
1170/* Read a file name from the user using a file dialog. 1237/* Read a file name from the user using a file selection dialog.
1171 F is the current frame. 1238 F is the current frame.
1172 PROMPT is a prompt to show to the user. May not be NULL. 1239 PROMPT is a prompt to show to the user. May not be NULL.
1173 DEFAULT_FILENAME is a default selection to be displayed. May be NULL. 1240 DEFAULT_FILENAME is a default selection to be displayed. May be NULL.
@@ -1177,12 +1244,13 @@ xg_file_sel_destroy (w, arg)
1177 Returns a file name or NULL if no file was selected. 1244 Returns a file name or NULL if no file was selected.
1178 The returned string must be freed by the caller. */ 1245 The returned string must be freed by the caller. */
1179 1246
1180char * 1247static char *
1181xg_get_file_name (f, prompt, default_filename, mustmatch_p) 1248xg_get_file_with_selection (f, prompt, default_filename,
1249 mustmatch_p, only_dir_p)
1182 FRAME_PTR f; 1250 FRAME_PTR f;
1183 char *prompt; 1251 char *prompt;
1184 char *default_filename; 1252 char *default_filename;
1185 int mustmatch_p; 1253 int mustmatch_p, only_dir_p;
1186{ 1254{
1187 GtkWidget *filewin; 1255 GtkWidget *filewin;
1188 GtkFileSelection *filesel; 1256 GtkFileSelection *filesel;
@@ -1193,9 +1261,7 @@ xg_get_file_name (f, prompt, default_filename, mustmatch_p)
1193 filesel = GTK_FILE_SELECTION (filewin); 1261 filesel = GTK_FILE_SELECTION (filewin);
1194 1262
1195 xg_set_screen (filewin, f); 1263 xg_set_screen (filewin, f);
1196
1197 gtk_widget_set_name (filewin, "emacs-filedialog"); 1264 gtk_widget_set_name (filewin, "emacs-filedialog");
1198
1199 gtk_window_set_transient_for (GTK_WINDOW (filewin), 1265 gtk_window_set_transient_for (GTK_WINDOW (filewin),
1200 GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f))); 1266 GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)));
1201 gtk_window_set_destroy_with_parent (GTK_WINDOW (filewin), TRUE); 1267 gtk_window_set_destroy_with_parent (GTK_WINDOW (filewin), TRUE);
@@ -1237,6 +1303,49 @@ xg_get_file_name (f, prompt, default_filename, mustmatch_p)
1237 1303
1238 return fn; 1304 return fn;
1239} 1305}
1306#endif /* HAVE_GTK_FILE_SELECTION_NEW */
1307
1308/* Read a file name from the user using a file dialog, either the old
1309 file selection dialog, or the new file chooser dialog. Which to use
1310 depends on what the GTK version used has, and what the value of
1311 gtk-use-old-file-dialog.
1312 F is the current frame.
1313 PROMPT is a prompt to show to the user. May not be NULL.
1314 DEFAULT_FILENAME is a default selection to be displayed. May be NULL.
1315 If MUSTMATCH_P is non-zero, the returned file name must be an existing
1316 file.
1317
1318 Returns a file name or NULL if no file was selected.
1319 The returned string must be freed by the caller. */
1320
1321char *
1322xg_get_file_name (f, prompt, default_filename, mustmatch_p, only_dir_p)
1323 FRAME_PTR f;
1324 char *prompt;
1325 char *default_filename;
1326 int mustmatch_p, only_dir_p;
1327{
1328#ifdef HAVE_GTK_FILE_BOTH
1329 if (use_old_gtk_file_dialog)
1330 return xg_get_file_with_selection (f, prompt, default_filename,
1331 mustmatch_p, only_dir_p);
1332 return xg_get_file_with_chooser (f, prompt, default_filename,
1333 mustmatch_p, only_dir_p);
1334
1335#else /* not HAVE_GTK_FILE_BOTH */
1336
1337#ifdef HAVE_GTK_FILE_SELECTION_DIALOG_NEW
1338 return xg_get_file_with_selection (f, prompt, default_filename,
1339 mustmatch_p, only_dir_p);
1340#endif
1341#ifdef HAVE_GTK_FILE_CHOOSER_DIALOG_NEW
1342 return xg_get_file_with_chooser (f, prompt, default_filename,
1343 mustmatch_p, only_dir_p);
1344#endif
1345
1346#endif /* HAVE_GTK_FILE_BOTH */
1347 return 0;
1348}
1240 1349
1241 1350
1242/*********************************************************************** 1351/***********************************************************************
@@ -3429,6 +3538,14 @@ xg_initialize ()
3429 "gtk-key-theme-name", 3538 "gtk-key-theme-name",
3430 "Emacs", 3539 "Emacs",
3431 EMACS_CLASS); 3540 EMACS_CLASS);
3541
3542#ifdef HAVE_GTK_FILE_BOTH
3543 DEFVAR_BOOL ("use-old-gtk-file-dialog", &use_old_gtk_file_dialog,
3544 doc: /* *Non-nil means that the old GTK file selection dialog is used.
3545 If nil the new GTK file chooser is used instead. To turn off
3546 all file dialogs set the variable `use-file-dialog'. */);
3547 use_old_gtk_file_dialog = 0;
3548#endif
3432} 3549}
3433 3550
3434#endif /* USE_GTK */ 3551#endif /* USE_GTK */
diff --git a/src/gtkutil.h b/src/gtkutil.h
index c0055f361cc..b2e2c5f2fff 100644
--- a/src/gtkutil.h
+++ b/src/gtkutil.h
@@ -132,7 +132,8 @@ extern void free_widget_value P_ ((widget_value *));
132extern char *xg_get_file_name P_ ((FRAME_PTR f, 132extern char *xg_get_file_name P_ ((FRAME_PTR f,
133 char *prompt, 133 char *prompt,
134 char *default_filename, 134 char *default_filename,
135 int mustmatch_p)); 135 int mustmatch_p,
136 int only_dir_p));
136 137
137extern GtkWidget *xg_create_widget P_ ((char *type, 138extern GtkWidget *xg_create_widget P_ ((char *type,
138 char *name, 139 char *name,
diff --git a/src/indent.c b/src/indent.c
index 9ac4027af36..874662cc47c 100644
--- a/src/indent.c
+++ b/src/indent.c
@@ -1883,7 +1883,7 @@ vmotion (from, vtarget, w)
1883 struct position pos; 1883 struct position pos;
1884 /* vpos is cumulative vertical position, changed as from is changed */ 1884 /* vpos is cumulative vertical position, changed as from is changed */
1885 register int vpos = 0; 1885 register int vpos = 0;
1886 Lisp_Object prevline; 1886 int prevline;
1887 register int first; 1887 register int first;
1888 int from_byte; 1888 int from_byte;
1889 int lmargin = hscroll > 0 ? 1 - hscroll : 0; 1889 int lmargin = hscroll > 0 ? 1 - hscroll : 0;
@@ -1917,23 +1917,21 @@ vmotion (from, vtarget, w)
1917 { 1917 {
1918 Lisp_Object propval; 1918 Lisp_Object propval;
1919 1919
1920 XSETFASTINT (prevline, find_next_newline_no_quit (from - 1, -1)); 1920 prevline = find_next_newline_no_quit (from - 1, -1);
1921 while (XFASTINT (prevline) > BEGV 1921 while (prevline > BEGV
1922 && ((selective > 0 1922 && ((selective > 0
1923 && indented_beyond_p (XFASTINT (prevline), 1923 && indented_beyond_p (prevline,
1924 CHAR_TO_BYTE (XFASTINT (prevline)), 1924 CHAR_TO_BYTE (prevline),
1925 (double) selective)) /* iftc */ 1925 (double) selective)) /* iftc */
1926 /* watch out for newlines with `invisible' property */ 1926 /* Watch out for newlines with `invisible' property.
1927 || (propval = Fget_char_property (prevline, 1927 When moving upward, check the newline before. */
1928 || (propval = Fget_char_property (make_number (prevline - 1),
1928 Qinvisible, 1929 Qinvisible,
1929 text_prop_object), 1930 text_prop_object),
1930 TEXT_PROP_MEANS_INVISIBLE (propval)))) 1931 TEXT_PROP_MEANS_INVISIBLE (propval))))
1931 XSETFASTINT (prevline, 1932 prevline = find_next_newline_no_quit (prevline - 1, -1);
1932 find_next_newline_no_quit (XFASTINT (prevline) - 1, 1933 pos = *compute_motion (prevline, 0,
1933 -1)); 1934 lmargin + (prevline == BEG ? start_hpos : 0),
1934 pos = *compute_motion (XFASTINT (prevline), 0,
1935 lmargin + (XFASTINT (prevline) == BEG
1936 ? start_hpos : 0),
1937 0, 1935 0,
1938 from, 1936 from,
1939 /* Don't care for VPOS... */ 1937 /* Don't care for VPOS... */
@@ -1944,12 +1942,11 @@ vmotion (from, vtarget, w)
1944 /* This compensates for start_hpos 1942 /* This compensates for start_hpos
1945 so that a tab as first character 1943 so that a tab as first character
1946 still occupies 8 columns. */ 1944 still occupies 8 columns. */
1947 (XFASTINT (prevline) == BEG 1945 (prevline == BEG ? -start_hpos : 0),
1948 ? -start_hpos : 0),
1949 w); 1946 w);
1950 vpos -= pos.vpos; 1947 vpos -= pos.vpos;
1951 first = 0; 1948 first = 0;
1952 from = XFASTINT (prevline); 1949 from = prevline;
1953 } 1950 }
1954 1951
1955 /* If we made exactly the desired vertical distance, 1952 /* If we made exactly the desired vertical distance,
@@ -1977,21 +1974,21 @@ vmotion (from, vtarget, w)
1977 { 1974 {
1978 Lisp_Object propval; 1975 Lisp_Object propval;
1979 1976
1980 XSETFASTINT (prevline, find_next_newline_no_quit (from, -1)); 1977 prevline = find_next_newline_no_quit (from, -1);
1981 while (XFASTINT (prevline) > BEGV 1978 while (prevline > BEGV
1982 && ((selective > 0 1979 && ((selective > 0
1983 && indented_beyond_p (XFASTINT (prevline), 1980 && indented_beyond_p (prevline,
1984 CHAR_TO_BYTE (XFASTINT (prevline)), 1981 CHAR_TO_BYTE (prevline),
1985 (double) selective)) /* iftc */ 1982 (double) selective)) /* iftc */
1986 /* watch out for newlines with `invisible' property */ 1983 /* Watch out for newlines with `invisible' property.
1987 || (propval = Fget_char_property (prevline, Qinvisible, 1984 When moving downward, check the newline after. */
1985 || (propval = Fget_char_property (make_number (prevline),
1986 Qinvisible,
1988 text_prop_object), 1987 text_prop_object),
1989 TEXT_PROP_MEANS_INVISIBLE (propval)))) 1988 TEXT_PROP_MEANS_INVISIBLE (propval))))
1990 XSETFASTINT (prevline, 1989 prevline = find_next_newline_no_quit (prevline - 1, -1);
1991 find_next_newline_no_quit (XFASTINT (prevline) - 1, 1990 pos = *compute_motion (prevline, 0,
1992 -1)); 1991 lmargin + (prevline == BEG
1993 pos = *compute_motion (XFASTINT (prevline), 0,
1994 lmargin + (XFASTINT (prevline) == BEG
1995 ? start_hpos : 0), 1992 ? start_hpos : 0),
1996 0, 1993 0,
1997 from, 1994 from,
@@ -2000,7 +1997,7 @@ vmotion (from, vtarget, w)
2000 /* ... nor HPOS. */ 1997 /* ... nor HPOS. */
2001 1 << (BITS_PER_SHORT - 1), 1998 1 << (BITS_PER_SHORT - 1),
2002 -1, hscroll, 1999 -1, hscroll,
2003 (XFASTINT (prevline) == BEG ? -start_hpos : 0), 2000 (prevline == BEG ? -start_hpos : 0),
2004 w); 2001 w);
2005 did_motion = 1; 2002 did_motion = 1;
2006 } 2003 }
diff --git a/src/insdel.c b/src/insdel.c
index 5a4dc5b64a8..4a97eab79ef 100644
--- a/src/insdel.c
+++ b/src/insdel.c
@@ -1497,7 +1497,7 @@ adjust_after_insert (from, from_byte, to, to_byte, newlen)
1497 Z -= len; Z_BYTE -= len_byte; 1497 Z -= len; Z_BYTE -= len_byte;
1498 adjust_after_replace (from, from_byte, Qnil, newlen, len_byte); 1498 adjust_after_replace (from, from_byte, Qnil, newlen, len_byte);
1499} 1499}
1500 1500
1501/* Replace the text from character positions FROM to TO with NEW, 1501/* Replace the text from character positions FROM to TO with NEW,
1502 If PREPARE is nonzero, call prepare_to_modify_buffer. 1502 If PREPARE is nonzero, call prepare_to_modify_buffer.
1503 If INHERIT, the newly inserted text should inherit text properties 1503 If INHERIT, the newly inserted text should inherit text properties
@@ -1674,6 +1674,122 @@ replace_range (from, to, new, prepare, inherit, markers)
1674 update_compositions (from, GPT, CHECK_BORDER); 1674 update_compositions (from, GPT, CHECK_BORDER);
1675} 1675}
1676 1676
1677/* Replace the text from character positions FROM to TO with
1678 the text in INS of length INSCHARS.
1679 Keep the text properties that applied to the old characters
1680 (extending them to all the new chars if there are more new chars).
1681
1682 Note that this does not yet handle markers quite right.
1683
1684 If MARKERS is nonzero, relocate markers.
1685
1686 Unlike most functions at this level, never call
1687 prepare_to_modify_buffer and never call signal_after_change. */
1688
1689void
1690replace_range_2 (from, from_byte, to, to_byte, ins, inschars, insbytes, markers)
1691 int from, from_byte, to, to_byte;
1692 char *ins;
1693 int inschars, insbytes, markers;
1694{
1695 int nbytes_del, nchars_del;
1696 Lisp_Object temp;
1697
1698 CHECK_MARKERS ();
1699
1700 nchars_del = to - from;
1701 nbytes_del = to_byte - from_byte;
1702
1703 if (nbytes_del <= 0 && insbytes == 0)
1704 return;
1705
1706 /* Make sure point-max won't overflow after this insertion. */
1707 XSETINT (temp, Z_BYTE - nbytes_del + insbytes);
1708 if (Z_BYTE - nbytes_del + insbytes != XINT (temp))
1709 error ("Maximum buffer size exceeded");
1710
1711 /* Make sure the gap is somewhere in or next to what we are deleting. */
1712 if (from > GPT)
1713 gap_right (from, from_byte);
1714 if (to < GPT)
1715 gap_left (to, to_byte, 0);
1716
1717 GAP_SIZE += nbytes_del;
1718 ZV -= nchars_del;
1719 Z -= nchars_del;
1720 ZV_BYTE -= nbytes_del;
1721 Z_BYTE -= nbytes_del;
1722 GPT = from;
1723 GPT_BYTE = from_byte;
1724 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
1725
1726 if (GPT_BYTE < GPT)
1727 abort ();
1728
1729 if (GPT - BEG < BEG_UNCHANGED)
1730 BEG_UNCHANGED = GPT - BEG;
1731 if (Z - GPT < END_UNCHANGED)
1732 END_UNCHANGED = Z - GPT;
1733
1734 if (GAP_SIZE < insbytes)
1735 make_gap (insbytes - GAP_SIZE);
1736
1737 /* Copy the replacement text into the buffer. */
1738 bcopy (ins, GPT_ADDR, insbytes);
1739
1740#ifdef BYTE_COMBINING_DEBUG
1741 /* We have copied text into the gap, but we have not marked
1742 it as part of the buffer. So we can use the old FROM and FROM_BYTE
1743 here, for both the previous text and the following text.
1744 Meanwhile, GPT_ADDR does point to
1745 the text that has been stored by copy_text. */
1746 if (count_combining_before (GPT_ADDR, insbytes, from, from_byte)
1747 || count_combining_after (GPT_ADDR, insbytes, from, from_byte))
1748 abort ();
1749#endif
1750
1751 GAP_SIZE -= insbytes;
1752 GPT += inschars;
1753 ZV += inschars;
1754 Z += inschars;
1755 GPT_BYTE += insbytes;
1756 ZV_BYTE += insbytes;
1757 Z_BYTE += insbytes;
1758 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
1759
1760 if (GPT_BYTE < GPT)
1761 abort ();
1762
1763 /* Adjust the overlay center as needed. This must be done after
1764 adjusting the markers that bound the overlays. */
1765 if (nchars_del != inschars)
1766 {
1767 adjust_overlays_for_insert (from, inschars);
1768 adjust_overlays_for_delete (from + inschars, nchars_del);
1769 }
1770
1771 /* Adjust markers for the deletion and the insertion. */
1772 if (markers
1773 && ! (nchars_del == 1 && inschars == 1))
1774 adjust_markers_for_replace (from, from_byte, nchars_del, nbytes_del,
1775 inschars, insbytes);
1776
1777 offset_intervals (current_buffer, from, inschars - nchars_del);
1778
1779 /* Relocate point as if it were a marker. */
1780 if (from < PT && nchars_del != inschars)
1781 adjust_point ((from + inschars - (PT < to ? PT : to)),
1782 (from_byte + insbytes
1783 - (PT_BYTE < to_byte ? PT_BYTE : to_byte)));
1784
1785 if (insbytes == 0)
1786 evaporate_overlays (from);
1787
1788 CHECK_MARKERS ();
1789
1790 MODIFF++;
1791}
1792
1677/* Delete characters in current buffer 1793/* Delete characters in current buffer
1678 from FROM up to (but not including) TO. 1794 from FROM up to (but not including) TO.
1679 If TO comes before FROM, we delete nothing. */ 1795 If TO comes before FROM, we delete nothing. */
diff --git a/src/lisp.h b/src/lisp.h
index 0ab02941c9b..19995c58f54 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3165,7 +3165,7 @@ extern void syms_of_xfns P_ ((void));
3165#ifdef HAVE_WINDOW_SYSTEM 3165#ifdef HAVE_WINDOW_SYSTEM
3166/* Defined in xfns.c, w32fns.c, or macfns.c */ 3166/* Defined in xfns.c, w32fns.c, or macfns.c */
3167EXFUN (Fxw_display_color_p, 1); 3167EXFUN (Fxw_display_color_p, 1);
3168EXFUN (Fx_file_dialog, 4); 3168EXFUN (Fx_file_dialog, 5);
3169#endif /* HAVE_WINDOW_SYSTEM */ 3169#endif /* HAVE_WINDOW_SYSTEM */
3170 3170
3171/* Defined in xsmfns.c */ 3171/* Defined in xsmfns.c */
diff --git a/src/macfns.c b/src/macfns.c
index 88f975a65c8..401c7011fea 100644
--- a/src/macfns.c
+++ b/src/macfns.c
@@ -4216,22 +4216,23 @@ Value is t if tooltip was open, nil otherwise. */)
4216 4216
4217extern Lisp_Object Qfile_name_history; 4217extern Lisp_Object Qfile_name_history;
4218 4218
4219DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0, 4219DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0,
4220 doc: /* Read file name, prompting with PROMPT in directory DIR. 4220 doc: /* Read file name, prompting with PROMPT in directory DIR.
4221Use a file selection dialog. 4221Use a file selection dialog.
4222Select DEFAULT-FILENAME in the dialog's file selection box, if 4222Select DEFAULT-FILENAME in the dialog's file selection box, if
4223specified. Ensure that file exists if MUSTMATCH is non-nil. */) 4223specified. Ensure that file exists if MUSTMATCH is non-nil.
4224 (prompt, dir, default_filename, mustmatch) 4224If ONLY-DIR-P is non-nil, the user can only select directories. */)
4225 Lisp_Object prompt, dir, default_filename, mustmatch; 4225 (prompt, dir, default_filename, mustmatch, only_dir_p)
4226 Lisp_Object prompt, dir, default_filename, mustmatch, only_dir_p;
4226{ 4227{
4227 struct frame *f = SELECTED_FRAME (); 4228 struct frame *f = SELECTED_FRAME ();
4228 Lisp_Object file = Qnil; 4229 Lisp_Object file = Qnil;
4229 int count = SPECPDL_INDEX (); 4230 int count = SPECPDL_INDEX ();
4230 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; 4231 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
4231 char filename[1001]; 4232 char filename[1001];
4232 int default_filter_index = 1; /* 1: All Files, 2: Directories only */ 4233 int default_filter_index = 1; /* 1: All Files, 2: Directories only */
4233 4234
4234 GCPRO5 (prompt, dir, default_filename, mustmatch, file); 4235 GCPRO6 (prompt, dir, default_filename, mustmatch, file, only_dir_p);
4235 CHECK_STRING (prompt); 4236 CHECK_STRING (prompt);
4236 CHECK_STRING (dir); 4237 CHECK_STRING (dir);
4237 4238
@@ -4245,7 +4246,8 @@ specified. Ensure that file exists if MUSTMATCH is non-nil. */)
4245 NavDialogRef dialogRef; 4246 NavDialogRef dialogRef;
4246 NavTypeListHandle fileTypes = NULL; 4247 NavTypeListHandle fileTypes = NULL;
4247 NavUserAction userAction; 4248 NavUserAction userAction;
4248 CFStringRef message=NULL, client=NULL, saveName = NULL; 4249 CFStringRef message=NULL, client=NULL, saveName = NULL, ok = NULL;
4250 CFStringRef title = NULL;
4249 4251
4250 BLOCK_INPUT; 4252 BLOCK_INPUT;
4251 /* No need for a callback function because we are modal */ 4253 /* No need for a callback function because we are modal */
@@ -4268,13 +4270,19 @@ specified. Ensure that file exists if MUSTMATCH is non-nil. */)
4268 options.clientName = client; 4270 options.clientName = client;
4269 */ 4271 */
4270 4272
4271 /* Do Dired hack copied from w32fns.c */ 4273 if (!NILP (only_dir_p))
4272 if (!NILP(prompt) && strncmp (SDATA(prompt), "Dired", 5) == 0)
4273 status = NavCreateChooseFolderDialog(&options, NULL, NULL, NULL, 4274 status = NavCreateChooseFolderDialog(&options, NULL, NULL, NULL,
4274 &dialogRef); 4275 &dialogRef);
4275 else if (NILP (mustmatch)) 4276 else if (NILP (mustmatch))
4276 { 4277 {
4277 /* This is a save dialog */ 4278 /* This is a save dialog */
4279 ok = CFStringCreateWithCString (NULL, "Ok", kCFStringEncodingUTF8);
4280 title = CFStringCreateWithCString (NULL, "Enter name",
4281 kCFStringEncodingUTF8);
4282 options.optionFlags |= kNavDontConfirmReplacement;
4283 options.actionButtonLabel = ok;
4284 options.windowTitle = title;
4285
4278 if (!NILP(default_filename)) 4286 if (!NILP(default_filename))
4279 { 4287 {
4280 saveName = CFStringCreateWithCString(NULL, SDATA(default_filename), 4288 saveName = CFStringCreateWithCString(NULL, SDATA(default_filename),
@@ -4282,20 +4290,10 @@ specified. Ensure that file exists if MUSTMATCH is non-nil. */)
4282 options.saveFileName = saveName; 4290 options.saveFileName = saveName;
4283 options.optionFlags |= kNavSelectDefaultLocation; 4291 options.optionFlags |= kNavSelectDefaultLocation;
4284 } 4292 }
4285 /* MAC_TODO: Find a better way to determine if this is a save
4286 or load dialog than comparing dir with default_filename */
4287 if (EQ(dir, default_filename))
4288 {
4289 status = NavCreateChooseFileDialog(&options, fileTypes,
4290 NULL, NULL, NULL, NULL,
4291 &dialogRef);
4292 }
4293 else {
4294 status = NavCreatePutFileDialog(&options, 4293 status = NavCreatePutFileDialog(&options,
4295 'TEXT', kNavGenericSignature, 4294 'TEXT', kNavGenericSignature,
4296 NULL, NULL, &dialogRef); 4295 NULL, NULL, &dialogRef);
4297 } 4296 }
4298 }
4299 else 4297 else
4300 { 4298 {
4301 /* This is an open dialog*/ 4299 /* This is an open dialog*/
@@ -4324,6 +4322,8 @@ specified. Ensure that file exists if MUSTMATCH is non-nil. */)
4324 if (saveName) CFRelease(saveName); 4322 if (saveName) CFRelease(saveName);
4325 if (client) CFRelease(client); 4323 if (client) CFRelease(client);
4326 if (message) CFRelease(message); 4324 if (message) CFRelease(message);
4325 if (ok) CFRelease(ok);
4326 if (title) CFRelease(title);
4327 4327
4328 if (status == noErr) { 4328 if (status == noErr) {
4329 userAction = NavDialogGetUserAction(dialogRef); 4329 userAction = NavDialogGetUserAction(dialogRef);
diff --git a/src/macterm.c b/src/macterm.c
index 2d09a2e93e9..bc35ab21547 100644
--- a/src/macterm.c
+++ b/src/macterm.c
@@ -230,6 +230,10 @@ extern int errno;
230 230
231extern int extra_keyboard_modifiers; 231extern int extra_keyboard_modifiers;
232 232
233/* The keysyms to use for the various modifiers. */
234
235static Lisp_Object Qalt, Qhyper, Qsuper, Qmodifier_value;
236
233static Lisp_Object Qvendor_specific_keysyms; 237static Lisp_Object Qvendor_specific_keysyms;
234 238
235#if 0 239#if 0
@@ -7014,6 +7018,9 @@ Lisp_Object Qreverse;
7014/* True if using command key as meta key. */ 7018/* True if using command key as meta key. */
7015Lisp_Object Vmac_command_key_is_meta; 7019Lisp_Object Vmac_command_key_is_meta;
7016 7020
7021/* Modifier associated with the option key, or nil for normal behavior. */
7022Lisp_Object Vmac_option_modifier;
7023
7017/* True if the ctrl and meta keys should be reversed. */ 7024/* True if the ctrl and meta keys should be reversed. */
7018Lisp_Object Vmac_reverse_ctrl_meta; 7025Lisp_Object Vmac_reverse_ctrl_meta;
7019 7026
@@ -7095,6 +7102,12 @@ mac_to_emacs_modifiers (EventModifiers mods)
7095 result |= meta_modifier; 7102 result |= meta_modifier;
7096 if (NILP (Vmac_command_key_is_meta) && (mods & macAltKey)) 7103 if (NILP (Vmac_command_key_is_meta) && (mods & macAltKey))
7097 result |= alt_modifier; 7104 result |= alt_modifier;
7105 if (!NILP (Vmac_option_modifier) && (mods & optionKey)) {
7106 Lisp_Object val = Fget(Vmac_option_modifier, Qmodifier_value);
7107 if (!NILP(val))
7108 result |= XUINT(val);
7109 }
7110
7098 return result; 7111 return result;
7099} 7112}
7100 7113
@@ -8575,7 +8588,18 @@ XTread_socket (sd, expected, hold_quit)
8575 unsigned long some_state = 0; 8588 unsigned long some_state = 0;
8576 inev.code = KeyTranslate (kchr_ptr, new_keycode, 8589 inev.code = KeyTranslate (kchr_ptr, new_keycode,
8577 &some_state) & 0xff; 8590 &some_state) & 0xff;
8578 } 8591 } else if (!NILP(Vmac_option_modifier) && (er.modifiers & optionKey))
8592 {
8593 /* When using the option key as an emacs modifier, convert
8594 the pressed key code back to one without the Mac option
8595 modifier applied. */
8596 int new_modifiers = er.modifiers & ~optionKey;
8597 int new_keycode = keycode | new_modifiers;
8598 Ptr kchr_ptr = (Ptr) GetScriptManagerVariable (smKCHRCache);
8599 unsigned long some_state = 0;
8600 inev.code = KeyTranslate (kchr_ptr, new_keycode,
8601 &some_state) & 0xff;
8602 }
8579 else 8603 else
8580 inev.code = er.message & charCodeMask; 8604 inev.code = er.message & charCodeMask;
8581 inev.kind = ASCII_KEYSTROKE_EVENT; 8605 inev.kind = ASCII_KEYSTROKE_EVENT;
@@ -9274,6 +9298,14 @@ syms_of_macterm ()
9274 x_error_message_string = Qnil; 9298 x_error_message_string = Qnil;
9275#endif 9299#endif
9276 9300
9301 Qmodifier_value = intern ("modifier-value");
9302 Qalt = intern ("alt");
9303 Fput (Qalt, Qmodifier_value, make_number (alt_modifier));
9304 Qhyper = intern ("hyper");
9305 Fput (Qhyper, Qmodifier_value, make_number (hyper_modifier));
9306 Qsuper = intern ("super");
9307 Fput (Qsuper, Qmodifier_value, make_number (super_modifier));
9308
9277 Fprovide (intern ("mac-carbon"), Qnil); 9309 Fprovide (intern ("mac-carbon"), Qnil);
9278 9310
9279 staticpro (&Qreverse); 9311 staticpro (&Qreverse);
@@ -9330,6 +9362,12 @@ to 4.1, set this to nil. */);
9330Otherwise the option key is used. */); 9362Otherwise the option key is used. */);
9331 Vmac_command_key_is_meta = Qt; 9363 Vmac_command_key_is_meta = Qt;
9332 9364
9365 DEFVAR_LISP ("mac-option-modifier", &Vmac_option_modifier,
9366 doc: /* Modifier to use for the Mac alt/option key. The value can
9367be alt, hyper, or super for the respective modifier. If the value is
9368nil then the key will act as the normal Mac option modifier. */);
9369 Vmac_option_modifier = Qnil;
9370
9333 DEFVAR_LISP ("mac-reverse-ctrl-meta", &Vmac_reverse_ctrl_meta, 9371 DEFVAR_LISP ("mac-reverse-ctrl-meta", &Vmac_reverse_ctrl_meta,
9334 doc: /* Non-nil means that the control and meta keys are reversed. This is 9372 doc: /* Non-nil means that the control and meta keys are reversed. This is
9335 useful for non-standard keyboard layouts. */); 9373 useful for non-standard keyboard layouts. */);
diff --git a/src/process.c b/src/process.c
index 688f97dc199..76967cd7ac2 100644
--- a/src/process.c
+++ b/src/process.c
@@ -310,6 +310,7 @@ static SELECT_TYPE non_keyboard_wait_mask;
310 310
311static SELECT_TYPE non_process_wait_mask; 311static SELECT_TYPE non_process_wait_mask;
312 312
313#ifdef NON_BLOCKING_CONNECT
313/* Mask of bits indicating the descriptors that we wait for connect to 314/* Mask of bits indicating the descriptors that we wait for connect to
314 complete on. Once they complete, they are removed from this mask 315 complete on. Once they complete, they are removed from this mask
315 and added to the input_wait_mask and non_keyboard_wait_mask. */ 316 and added to the input_wait_mask and non_keyboard_wait_mask. */
@@ -319,6 +320,11 @@ static SELECT_TYPE connect_wait_mask;
319/* Number of bits set in connect_wait_mask. */ 320/* Number of bits set in connect_wait_mask. */
320static int num_pending_connects; 321static int num_pending_connects;
321 322
323#define IF_NON_BLOCKING_CONNECT(s) s
324#else
325#define IF_NON_BLOCKING_CONNECT(s)
326#endif
327
322/* The largest descriptor currently in use for a process object. */ 328/* The largest descriptor currently in use for a process object. */
323static int max_process_desc; 329static int max_process_desc;
324 330
@@ -3673,12 +3679,14 @@ deactivate_process (proc)
3673 chan_process[inchannel] = Qnil; 3679 chan_process[inchannel] = Qnil;
3674 FD_CLR (inchannel, &input_wait_mask); 3680 FD_CLR (inchannel, &input_wait_mask);
3675 FD_CLR (inchannel, &non_keyboard_wait_mask); 3681 FD_CLR (inchannel, &non_keyboard_wait_mask);
3682#ifdef NON_BLOCKING_CONNECT
3676 if (FD_ISSET (inchannel, &connect_wait_mask)) 3683 if (FD_ISSET (inchannel, &connect_wait_mask))
3677 { 3684 {
3678 FD_CLR (inchannel, &connect_wait_mask); 3685 FD_CLR (inchannel, &connect_wait_mask);
3679 if (--num_pending_connects < 0) 3686 if (--num_pending_connects < 0)
3680 abort (); 3687 abort ();
3681 } 3688 }
3689#endif
3682 if (inchannel == max_process_desc) 3690 if (inchannel == max_process_desc)
3683 { 3691 {
3684 int i; 3692 int i;
@@ -4039,8 +4047,11 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
4039{ 4047{
4040 register int channel, nfds; 4048 register int channel, nfds;
4041 SELECT_TYPE Available; 4049 SELECT_TYPE Available;
4050#ifdef NON_BLOCKING_CONNECT
4042 SELECT_TYPE Connecting; 4051 SELECT_TYPE Connecting;
4043 int check_connect, check_delay, no_avail; 4052 int check_connect;
4053#endif
4054 int check_delay, no_avail;
4044 int xerrno; 4055 int xerrno;
4045 Lisp_Object proc; 4056 Lisp_Object proc;
4046 EMACS_TIME timeout, end_time; 4057 EMACS_TIME timeout, end_time;
@@ -4051,7 +4062,9 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
4051 int saved_waiting_for_user_input_p = waiting_for_user_input_p; 4062 int saved_waiting_for_user_input_p = waiting_for_user_input_p;
4052 4063
4053 FD_ZERO (&Available); 4064 FD_ZERO (&Available);
4065#ifdef NON_BLOCKING_CONNECT
4054 FD_ZERO (&Connecting); 4066 FD_ZERO (&Connecting);
4067#endif
4055 4068
4056 /* If wait_proc is a process to watch, set wait_channel accordingly. */ 4069 /* If wait_proc is a process to watch, set wait_channel accordingly. */
4057 if (wait_proc != NULL) 4070 if (wait_proc != NULL)
@@ -4188,7 +4201,10 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
4188 timeout to get our attention. */ 4201 timeout to get our attention. */
4189 if (update_tick != process_tick && do_display) 4202 if (update_tick != process_tick && do_display)
4190 { 4203 {
4191 SELECT_TYPE Atemp, Ctemp; 4204 SELECT_TYPE Atemp;
4205#ifdef NON_BLOCKING_CONNECT
4206 SELECT_TYPE Ctemp;
4207#endif
4192 4208
4193 Atemp = input_wait_mask; 4209 Atemp = input_wait_mask;
4194#if 0 4210#if 0
@@ -4200,11 +4216,16 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
4200 */ 4216 */
4201 FD_CLR (0, &Atemp); 4217 FD_CLR (0, &Atemp);
4202#endif 4218#endif
4203 Ctemp = connect_wait_mask; 4219 IF_NON_BLOCKING_CONNECT (Ctemp = connect_wait_mask);
4220
4204 EMACS_SET_SECS_USECS (timeout, 0, 0); 4221 EMACS_SET_SECS_USECS (timeout, 0, 0);
4205 if ((select (max (max_process_desc, max_keyboard_desc) + 1, 4222 if ((select (max (max_process_desc, max_keyboard_desc) + 1,
4206 &Atemp, 4223 &Atemp,
4224#ifdef NON_BLOCKING_CONNECT
4207 (num_pending_connects > 0 ? &Ctemp : (SELECT_TYPE *)0), 4225 (num_pending_connects > 0 ? &Ctemp : (SELECT_TYPE *)0),
4226#else
4227 (SELECT_TYPE *)0,
4228#endif
4208 (SELECT_TYPE *)0, &timeout) 4229 (SELECT_TYPE *)0, &timeout)
4209 <= 0)) 4230 <= 0))
4210 { 4231 {
@@ -4264,12 +4285,14 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
4264 if (XINT (wait_proc->infd) < 0) /* Terminated */ 4285 if (XINT (wait_proc->infd) < 0) /* Terminated */
4265 break; 4286 break;
4266 FD_SET (XINT (wait_proc->infd), &Available); 4287 FD_SET (XINT (wait_proc->infd), &Available);
4267 check_connect = check_delay = 0; 4288 check_delay = 0;
4289 IF_NON_BLOCKING_CONNECT (check_connect = 0);
4268 } 4290 }
4269 else if (!NILP (wait_for_cell)) 4291 else if (!NILP (wait_for_cell))
4270 { 4292 {
4271 Available = non_process_wait_mask; 4293 Available = non_process_wait_mask;
4272 check_connect = check_delay = 0; 4294 check_delay = 0;
4295 IF_NON_BLOCKING_CONNECT (check_connect = 0);
4273 } 4296 }
4274 else 4297 else
4275 { 4298 {
@@ -4277,7 +4300,7 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
4277 Available = non_keyboard_wait_mask; 4300 Available = non_keyboard_wait_mask;
4278 else 4301 else
4279 Available = input_wait_mask; 4302 Available = input_wait_mask;
4280 check_connect = (num_pending_connects > 0); 4303 IF_NON_BLOCKING_CONNECT (check_connect = (num_pending_connects > 0));
4281 check_delay = wait_channel >= 0 ? 0 : process_output_delay_count; 4304 check_delay = wait_channel >= 0 ? 0 : process_output_delay_count;
4282 } 4305 }
4283 4306
@@ -4302,8 +4325,10 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
4302 } 4325 }
4303 else 4326 else
4304 { 4327 {
4328#ifdef NON_BLOCKING_CONNECT
4305 if (check_connect) 4329 if (check_connect)
4306 Connecting = connect_wait_mask; 4330 Connecting = connect_wait_mask;
4331#endif
4307 4332
4308#ifdef ADAPTIVE_READ_BUFFERING 4333#ifdef ADAPTIVE_READ_BUFFERING
4309 if (process_output_skip && check_delay > 0) 4334 if (process_output_skip && check_delay > 0)
@@ -4334,7 +4359,11 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
4334 4359
4335 nfds = select (max (max_process_desc, max_keyboard_desc) + 1, 4360 nfds = select (max (max_process_desc, max_keyboard_desc) + 1,
4336 &Available, 4361 &Available,
4362#ifdef NON_BLOCKING_CONNECT
4337 (check_connect ? &Connecting : (SELECT_TYPE *)0), 4363 (check_connect ? &Connecting : (SELECT_TYPE *)0),
4364#else
4365 (SELECT_TYPE *)0,
4366#endif
4338 (SELECT_TYPE *)0, &timeout); 4367 (SELECT_TYPE *)0, &timeout);
4339 } 4368 }
4340 4369
@@ -4390,7 +4419,7 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
4390 if (no_avail) 4419 if (no_avail)
4391 { 4420 {
4392 FD_ZERO (&Available); 4421 FD_ZERO (&Available);
4393 check_connect = 0; 4422 IF_NON_BLOCKING_CONNECT (check_connect = 0);
4394 } 4423 }
4395 4424
4396#if defined(sun) && !defined(USG5_4) 4425#if defined(sun) && !defined(USG5_4)
@@ -6626,6 +6655,11 @@ init_process ()
6626 FD_ZERO (&non_process_wait_mask); 6655 FD_ZERO (&non_process_wait_mask);
6627 max_process_desc = 0; 6656 max_process_desc = 0;
6628 6657
6658#ifdef NON_BLOCKING_CONNECT
6659 FD_ZERO (&connect_wait_mask);
6660 num_pending_connects = 0;
6661#endif
6662
6629#ifdef ADAPTIVE_READ_BUFFERING 6663#ifdef ADAPTIVE_READ_BUFFERING
6630 process_output_delay_count = 0; 6664 process_output_delay_count = 0;
6631 process_output_skip = 0; 6665 process_output_skip = 0;
diff --git a/src/search.c b/src/search.c
index be2ea2bcd89..59539de8768 100644
--- a/src/search.c
+++ b/src/search.c
@@ -521,7 +521,7 @@ newline_cache_on_off (buf)
521 direction indicated by COUNT. 521 direction indicated by COUNT.
522 522
523 If we find COUNT instances, set *SHORTAGE to zero, and return the 523 If we find COUNT instances, set *SHORTAGE to zero, and return the
524 position after the COUNTth match. Note that for reverse motion 524 position past the COUNTth match. Note that for reverse motion
525 this is not the same as the usual convention for Emacs motion commands. 525 this is not the same as the usual convention for Emacs motion commands.
526 526
527 If we don't find COUNT instances before reaching END, set *SHORTAGE 527 If we don't find COUNT instances before reaching END, set *SHORTAGE
diff --git a/src/syntax.c b/src/syntax.c
index d68628b181c..b062264ac24 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -3023,12 +3023,23 @@ do { prev_from = from; \
3023 INC_FROM; 3023 INC_FROM;
3024 code = prev_from_syntax & 0xff; 3024 code = prev_from_syntax & 0xff;
3025 3025
3026 if (code == Scomment) 3026 if (from < end
3027 && SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax)
3028 && (c1 = FETCH_CHAR (from_byte),
3029 SYNTAX_COMSTART_SECOND (c1)))
3030 /* Duplicate code to avoid a complex if-expression
3031 which causes trouble for the SGI compiler. */
3027 { 3032 {
3028 state.comstyle = SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax); 3033 /* Record the comment style we have entered so that only
3029 state.incomment = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) ? 3034 the comment-end sequence of the same style actually
3030 1 : -1); 3035 terminates the comment section. */
3036 state.comstyle = SYNTAX_COMMENT_STYLE (c1);
3037 comnested = SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax);
3038 comnested = comnested || SYNTAX_COMMENT_NESTED (c1);
3039 state.incomment = comnested ? 1 : -1;
3031 state.comstr_start = prev_from; 3040 state.comstr_start = prev_from;
3041 INC_FROM;
3042 code = Scomment;
3032 } 3043 }
3033 else if (code == Scomment_fence) 3044 else if (code == Scomment_fence)
3034 { 3045 {
@@ -3040,24 +3051,13 @@ do { prev_from = from; \
3040 state.comstr_start = prev_from; 3051 state.comstr_start = prev_from;
3041 code = Scomment; 3052 code = Scomment;
3042 } 3053 }
3043 else if (from < end) 3054 else if (code == Scomment)
3044 if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax)) 3055 {
3045 if (c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte), 3056 state.comstyle = SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax);
3046 SYNTAX_COMSTART_SECOND (c1)) 3057 state.incomment = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) ?
3047 /* Duplicate code to avoid a complex if-expression 3058 1 : -1);
3048 which causes trouble for the SGI compiler. */ 3059 state.comstr_start = prev_from;
3049 { 3060 }
3050 /* Record the comment style we have entered so that only
3051 the comment-end sequence of the same style actually
3052 terminates the comment section. */
3053 state.comstyle = SYNTAX_COMMENT_STYLE (c1);
3054 comnested = SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax);
3055 comnested = comnested || SYNTAX_COMMENT_NESTED (c1);
3056 state.incomment = comnested ? 1 : -1;
3057 state.comstr_start = prev_from;
3058 INC_FROM;
3059 code = Scomment;
3060 }
3061 3061
3062 if (SYNTAX_FLAGS_PREFIX (prev_from_syntax)) 3062 if (SYNTAX_FLAGS_PREFIX (prev_from_syntax))
3063 continue; 3063 continue;
diff --git a/src/w32fns.c b/src/w32fns.c
index e5a1ca00cc3..df6228b09b1 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -5667,14 +5667,12 @@ w32_font_match (fontname, pattern)
5667 char * fontname; 5667 char * fontname;
5668 char * pattern; 5668 char * pattern;
5669{ 5669{
5670 char *font_name_copy;
5671 char *ptr; 5670 char *ptr;
5672 Lisp_Object encoded_font_name; 5671 char *font_name_copy;
5673 char *regex = alloca (strlen (pattern) * 2 + 3); 5672 char *regex = alloca (strlen (pattern) * 2 + 3);
5674 5673
5675 /* Convert fontname to unibyte for match. */ 5674 font_name_copy = alloca (strlen (fontname) + 1);
5676 encoded_font_name = string_make_unibyte (build_string (fontname)); 5675 strcpy (font_name_copy, fontname);
5677 font_name_copy = SDATA (encoded_font_name);
5678 5676
5679 ptr = regex; 5677 ptr = regex;
5680 *ptr++ = '^'; 5678 *ptr++ = '^';
@@ -5712,8 +5710,8 @@ w32_font_match (fontname, pattern)
5712 return FALSE; 5710 return FALSE;
5713 } 5711 }
5714 5712
5715 return (fast_c_string_match_ignore_case (build_string (regex), 5713 return (fast_string_match_ignore_case (build_string (regex),
5716 font_name_copy) >= 0); 5714 build_string(font_name_copy)) >= 0);
5717} 5715}
5718 5716
5719/* Callback functions, and a structure holding info they need, for 5717/* Callback functions, and a structure holding info they need, for
@@ -6459,7 +6457,7 @@ If omitted or nil, that stands for the selected frame's display. */)
6459} 6457}
6460 6458
6461DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0, 6459DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
6462 doc: /* Returns the vendor ID string of the W32 system (Microsoft). 6460 doc: /* Returns the "vendor ID" string of the W32 system (Microsoft).
6463The optional argument DISPLAY specifies which display to ask about. 6461The optional argument DISPLAY specifies which display to ask about.
6464DISPLAY should be either a frame or a display name (a string). 6462DISPLAY should be either a frame or a display name (a string).
6465If omitted or nil, that stands for the selected frame's display. */) 6463If omitted or nil, that stands for the selected frame's display. */)
@@ -6472,7 +6470,7 @@ If omitted or nil, that stands for the selected frame's display. */)
6472DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0, 6470DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
6473 doc: /* Returns the version numbers of the server of DISPLAY. 6471 doc: /* Returns the version numbers of the server of DISPLAY.
6474The value is a list of three integers: the major and minor 6472The value is a list of three integers: the major and minor
6475version numbers, and the vendor-specific release 6473version numbers of the X Protocol in use, and the distributor-specific release
6476number. See also the function `x-server-vendor'. 6474number. See also the function `x-server-vendor'.
6477 6475
6478The optional argument DISPLAY specifies which display to ask about. 6476The optional argument DISPLAY specifies which display to ask about.
@@ -7803,23 +7801,24 @@ file_dialog_callback (hwnd, msg, wParam, lParam)
7803 return 0; 7801 return 0;
7804} 7802}
7805 7803
7806DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0, 7804DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0,
7807 doc: /* Read file name, prompting with PROMPT in directory DIR. 7805 doc: /* Read file name, prompting with PROMPT in directory DIR.
7808Use a file selection dialog. 7806Use a file selection dialog.
7809Select DEFAULT-FILENAME in the dialog's file selection box, if 7807Select DEFAULT-FILENAME in the dialog's file selection box, if
7810specified. Ensure that file exists if MUSTMATCH is non-nil. */) 7808specified. Ensure that file exists if MUSTMATCH is non-nil.
7811 (prompt, dir, default_filename, mustmatch) 7809If ONLY-DIR-P is non-nil, the user can only select directories. */)
7812 Lisp_Object prompt, dir, default_filename, mustmatch; 7810 (prompt, dir, default_filename, mustmatch, only_dir_p)
7811 Lisp_Object prompt, dir, default_filename, mustmatch, only_dir_p;
7813{ 7812{
7814 struct frame *f = SELECTED_FRAME (); 7813 struct frame *f = SELECTED_FRAME ();
7815 Lisp_Object file = Qnil; 7814 Lisp_Object file = Qnil;
7816 int count = SPECPDL_INDEX (); 7815 int count = SPECPDL_INDEX ();
7817 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; 7816 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
7818 char filename[MAX_PATH + 1]; 7817 char filename[MAX_PATH + 1];
7819 char init_dir[MAX_PATH + 1]; 7818 char init_dir[MAX_PATH + 1];
7820 int default_filter_index = 1; /* 1: All Files, 2: Directories only */ 7819 int default_filter_index = 1; /* 1: All Files, 2: Directories only */
7821 7820
7822 GCPRO5 (prompt, dir, default_filename, mustmatch, file); 7821 GCPRO6 (prompt, dir, default_filename, mustmatch, only_dir_p, file);
7823 CHECK_STRING (prompt); 7822 CHECK_STRING (prompt);
7824 CHECK_STRING (dir); 7823 CHECK_STRING (dir);
7825 7824
@@ -7867,10 +7866,7 @@ specified. Ensure that file exists if MUSTMATCH is non-nil. */)
7867 file_details.lpstrInitialDir = init_dir; 7866 file_details.lpstrInitialDir = init_dir;
7868 file_details.lpstrTitle = SDATA (prompt); 7867 file_details.lpstrTitle = SDATA (prompt);
7869 7868
7870 /* If prompt starts with Dired, default to directories only. */ 7869 if (! NILP (only_dir_p))
7871 /* A bit hacky, but there doesn't seem to be a better way to
7872 DTRT for dired. */
7873 if (strncmp (file_details.lpstrTitle, "Dired", 5) == 0)
7874 default_filter_index = 2; 7870 default_filter_index = 2;
7875 7871
7876 file_details.nFilterIndex = default_filter_index; 7872 file_details.nFilterIndex = default_filter_index;
diff --git a/src/w32term.c b/src/w32term.c
index a69552a2812..f50f5a49e8a 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -2914,9 +2914,13 @@ x_scroll_run (w, run)
2914 /* If the dirty region is not what we expected, redraw the entire frame. */ 2914 /* If the dirty region is not what we expected, redraw the entire frame. */
2915 if (!EqualRgn (combined, expect_dirty)) 2915 if (!EqualRgn (combined, expect_dirty))
2916 SET_FRAME_GARBAGED (f); 2916 SET_FRAME_GARBAGED (f);
2917
2918 DeleteObject (dirty);
2919 DeleteObject (combined);
2917 } 2920 }
2918 2921
2919 UNBLOCK_INPUT; 2922 UNBLOCK_INPUT;
2923 DeleteObject (expect_dirty);
2920} 2924}
2921 2925
2922 2926
diff --git a/src/window.c b/src/window.c
index 2aa8bed7dbc..b6738457de4 100644
--- a/src/window.c
+++ b/src/window.c
@@ -4625,17 +4625,25 @@ window_scroll_pixel_based (window, n, whole, noerror)
4625 w->force_start = Qt; 4625 w->force_start = Qt;
4626 } 4626 }
4627 4627
4628 /* The rest of this function uses current_y in a nonstandard way,
4629 not including the height of the header line if any. */
4628 it.current_y = it.vpos = 0; 4630 it.current_y = it.vpos = 0;
4629 4631
4630 /* Preserve the screen position if we must. */ 4632 /* Preserve the screen position if we should. */
4631 if (preserve_y >= 0) 4633 if (preserve_y >= 0)
4632 { 4634 {
4635 /* If we have a header line, take account of it. */
4636 if (WINDOW_WANTS_HEADER_LINE_P (w))
4637 preserve_y -= CURRENT_HEADER_LINE_HEIGHT (w);
4638
4633 move_it_to (&it, -1, -1, preserve_y, -1, MOVE_TO_Y); 4639 move_it_to (&it, -1, -1, preserve_y, -1, MOVE_TO_Y);
4634 SET_PT_BOTH (IT_CHARPOS (it), IT_BYTEPOS (it)); 4640 SET_PT_BOTH (IT_CHARPOS (it), IT_BYTEPOS (it));
4635 } 4641 }
4636 else 4642 else
4637 { 4643 {
4638 /* Move PT out of scroll margins. */ 4644 /* Move PT out of scroll margins.
4645 This code wants current_y to be zero at the window start position
4646 even if there is a header line. */
4639 this_scroll_margin = max (0, scroll_margin); 4647 this_scroll_margin = max (0, scroll_margin);
4640 this_scroll_margin = min (this_scroll_margin, XFASTINT (w->total_lines) / 4); 4648 this_scroll_margin = min (this_scroll_margin, XFASTINT (w->total_lines) / 4);
4641 this_scroll_margin *= FRAME_LINE_HEIGHT (it.f); 4649 this_scroll_margin *= FRAME_LINE_HEIGHT (it.f);
@@ -4990,17 +4998,17 @@ specifies the window to scroll. This takes precedence over
4990 return Qnil; 4998 return Qnil;
4991} 4999}
4992 5000
4993DEFUN ("scroll-left", Fscroll_left, Sscroll_left, 0, 1, "P", 5001DEFUN ("scroll-left", Fscroll_left, Sscroll_left, 0, 2, "P\np",
4994 doc: /* Scroll selected window display ARG columns left. 5002 doc: /* Scroll selected window display ARG columns left.
4995Default for ARG is window width minus 2. 5003Default for ARG is window width minus 2.
4996Value is the total amount of leftward horizontal scrolling in 5004Value is the total amount of leftward horizontal scrolling in
4997effect after the change. 5005effect after the change.
4998If `automatic-hscrolling' is non-nil, the argument ARG modifies 5006If SET_MINIMUM is non-nil, the new scroll amount becomes the
4999a lower bound for automatic scrolling, i.e. automatic scrolling 5007lower bound for automatic scrolling, i.e. automatic scrolling
5000will not scroll a window to a column less than the value returned 5008will not scroll a window to a column less than the value returned
5001by this function. */) 5009by this function. This happens in an interactive call. */)
5002 (arg) 5010 (arg, set_minimum)
5003 register Lisp_Object arg; 5011 register Lisp_Object arg, set_minimum;
5004{ 5012{
5005 Lisp_Object result; 5013 Lisp_Object result;
5006 int hscroll; 5014 int hscroll;
@@ -5014,23 +5022,23 @@ by this function. */)
5014 hscroll = XINT (w->hscroll) + XINT (arg); 5022 hscroll = XINT (w->hscroll) + XINT (arg);
5015 result = Fset_window_hscroll (selected_window, make_number (hscroll)); 5023 result = Fset_window_hscroll (selected_window, make_number (hscroll));
5016 5024
5017 if (interactive_p (0)) 5025 if (!NILP (set_minimum))
5018 w->min_hscroll = w->hscroll; 5026 w->min_hscroll = w->hscroll;
5019 5027
5020 return result; 5028 return result;
5021} 5029}
5022 5030
5023DEFUN ("scroll-right", Fscroll_right, Sscroll_right, 0, 1, "P", 5031DEFUN ("scroll-right", Fscroll_right, Sscroll_right, 0, 2, "P\np",
5024 doc: /* Scroll selected window display ARG columns right. 5032 doc: /* Scroll selected window display ARG columns right.
5025Default for ARG is window width minus 2. 5033Default for ARG is window width minus 2.
5026Value is the total amount of leftward horizontal scrolling in 5034Value is the total amount of leftward horizontal scrolling in
5027effect after the change. 5035effect after the change.
5028If `automatic-hscrolling' is non-nil, the argument ARG modifies 5036If SET_MINIMUM is non-nil, the new scroll amount becomes the
5029a lower bound for automatic scrolling, i.e. automatic scrolling 5037lower bound for automatic scrolling, i.e. automatic scrolling
5030will not scroll a window to a column less than the value returned 5038will not scroll a window to a column less than the value returned
5031by this function. */) 5039by this function. This happens in an interactive call. */)
5032 (arg) 5040 (arg, set_minimum)
5033 register Lisp_Object arg; 5041 register Lisp_Object arg, set_minimum;
5034{ 5042{
5035 Lisp_Object result; 5043 Lisp_Object result;
5036 int hscroll; 5044 int hscroll;
@@ -5044,7 +5052,7 @@ by this function. */)
5044 hscroll = XINT (w->hscroll) - XINT (arg); 5052 hscroll = XINT (w->hscroll) - XINT (arg);
5045 result = Fset_window_hscroll (selected_window, make_number (hscroll)); 5053 result = Fset_window_hscroll (selected_window, make_number (hscroll));
5046 5054
5047 if (interactive_p (0)) 5055 if (!NILP (set_minimum))
5048 w->min_hscroll = w->hscroll; 5056 w->min_hscroll = w->hscroll;
5049 5057
5050 return result; 5058 return result;
diff --git a/src/xdisp.c b/src/xdisp.c
index 799f435c7fb..22f870d16ef 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -4651,7 +4651,8 @@ back_to_previous_visible_line_start (it)
4651 { 4651 {
4652 Lisp_Object prop; 4652 Lisp_Object prop;
4653 4653
4654 prop = Fget_char_property (make_number (IT_CHARPOS (*it)), 4654 /* Check the newline before point for invisibility. */
4655 prop = Fget_char_property (make_number (IT_CHARPOS (*it) - 1),
4655 Qinvisible, it->window); 4656 Qinvisible, it->window);
4656 if (TEXT_PROP_MEANS_INVISIBLE (prop)) 4657 if (TEXT_PROP_MEANS_INVISIBLE (prop))
4657 visible_p = 0; 4658 visible_p = 0;
@@ -4984,8 +4985,11 @@ get_next_display_element (it)
4984 If it->multibyte_p is zero, eight-bit characters that 4985 If it->multibyte_p is zero, eight-bit characters that
4985 don't have corresponding multibyte char code are also 4986 don't have corresponding multibyte char code are also
4986 translated to octal form. */ 4987 translated to octal form. */
4987 else if ((it->c < ' ' ? (it->area != TEXT_AREA 4988 else if ((it->c < ' '
4988 || (it->c != '\n' && it->c != '\t')) 4989 ? (it->area != TEXT_AREA
4990 /* In mode line, treat \n, \t like other crl chars. */
4991 || (it->glyph_row && it->glyph_row->mode_line_p)
4992 || (it->c != '\n' && it->c != '\t'))
4989 : it->multibyte_p ? !CHAR_PRINTABLE_P (it->c) 4993 : it->multibyte_p ? !CHAR_PRINTABLE_P (it->c)
4990 : (it->c >= 127 4994 : (it->c >= 127
4991 && (! unibyte_display_via_language_environment 4995 && (! unibyte_display_via_language_environment
@@ -8525,7 +8529,8 @@ update_tool_bar (f, save_match_data)
8525 { 8529 {
8526 struct buffer *prev = current_buffer; 8530 struct buffer *prev = current_buffer;
8527 int count = SPECPDL_INDEX (); 8531 int count = SPECPDL_INDEX ();
8528 Lisp_Object old_tool_bar; 8532 Lisp_Object new_tool_bar;
8533 int new_n_tool_bar;
8529 struct gcpro gcpro1; 8534 struct gcpro gcpro1;
8530 8535
8531 /* Set current_buffer to the buffer of the selected 8536 /* Set current_buffer to the buffer of the selected
@@ -8544,18 +8549,24 @@ update_tool_bar (f, save_match_data)
8544 specbind (Qoverriding_local_map, Qnil); 8549 specbind (Qoverriding_local_map, Qnil);
8545 } 8550 }
8546 8551
8547 old_tool_bar = f->tool_bar_items; 8552 GCPRO1 (new_tool_bar);
8548 GCPRO1 (old_tool_bar);
8549 8553
8550 /* Build desired tool-bar items from keymaps. */ 8554 /* Build desired tool-bar items from keymaps. */
8551 BLOCK_INPUT; 8555 new_tool_bar = tool_bar_items (Fcopy_sequence (f->tool_bar_items),
8552 f->tool_bar_items 8556 &new_n_tool_bar);
8553 = tool_bar_items (f->tool_bar_items, &f->n_tool_bar_items);
8554 UNBLOCK_INPUT;
8555 8557
8556 /* Redisplay the tool-bar if we changed it. */ 8558 /* Redisplay the tool-bar if we changed it. */
8557 if (! NILP (Fequal (old_tool_bar, f->tool_bar_items))) 8559 if (NILP (Fequal (new_tool_bar, f->tool_bar_items)))
8558 w->update_mode_line = Qt; 8560 {
8561 /* Redisplay that happens asynchronously due to an expose event
8562 may access f->tool_bar_items. Make sure we update both
8563 variables within BLOCK_INPUT so no such event interrupts. */
8564 BLOCK_INPUT;
8565 f->tool_bar_items = new_tool_bar;
8566 f->n_tool_bar_items = new_n_tool_bar;
8567 w->update_mode_line = Qt;
8568 UNBLOCK_INPUT;
8569 }
8559 8570
8560 UNGCPRO; 8571 UNGCPRO;
8561 8572
diff --git a/src/xfns.c b/src/xfns.c
index 39262235e8b..8ddb29310df 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -3483,7 +3483,9 @@ If omitted or nil, that stands for the selected frame's display. */)
3483} 3483}
3484 3484
3485DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0, 3485DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
3486 doc: /* Returns the vendor ID string of the X server of display DISPLAY. 3486 doc: /* Returns the "vendor ID" string of the X server of display DISPLAY.
3487\(Labelling every distributor as a "vendor" embodies the false assumption
3488that operating systems cannot be developed and distributed noncommercially.)
3487The optional argument DISPLAY specifies which display to ask about. 3489The optional argument DISPLAY specifies which display to ask about.
3488DISPLAY should be either a frame or a display name (a string). 3490DISPLAY should be either a frame or a display name (a string).
3489If omitted or nil, that stands for the selected frame's display. */) 3491If omitted or nil, that stands for the selected frame's display. */)
@@ -3500,7 +3502,7 @@ If omitted or nil, that stands for the selected frame's display. */)
3500DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0, 3502DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
3501 doc: /* Returns the version numbers of the X server of display DISPLAY. 3503 doc: /* Returns the version numbers of the X server of display DISPLAY.
3502The value is a list of three integers: the major and minor 3504The value is a list of three integers: the major and minor
3503version numbers of the X Protocol in use, and the vendor-specific release 3505version numbers of the X Protocol in use, and the distributor-specific release
3504number. See also the function `x-server-vendor'. 3506number. See also the function `x-server-vendor'.
3505 3507
3506The optional argument DISPLAY specifies which display to ask about. 3508The optional argument DISPLAY specifies which display to ask about.
@@ -5088,27 +5090,26 @@ file_dialog_unmap_cb (widget, client_data, call_data)
5088} 5090}
5089 5091
5090 5092
5091DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0, 5093DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0,
5092 doc: /* Read file name, prompting with PROMPT in directory DIR. 5094 doc: /* Read file name, prompting with PROMPT in directory DIR.
5093Use a file selection dialog. 5095Use a file selection dialog. Select DEFAULT-FILENAME in the dialog's file
5094Select DEFAULT-FILENAME in the dialog's file selection box, if 5096selection box, if specified. If MUSTMATCH is non-nil, the returned file
5095specified. Don't let the user enter a file name in the file 5097or directory must exist. ONLY-DIR-P is ignored." */)
5096selection dialog's entry field, if MUSTMATCH is non-nil. */) 5098 (prompt, dir, default_filename, mustmatch, only_dir_p)
5097 (prompt, dir, default_filename, mustmatch) 5099 Lisp_Object prompt, dir, default_filename, mustmatch, only_dir_p;
5098 Lisp_Object prompt, dir, default_filename, mustmatch;
5099{ 5100{
5100 int result; 5101 int result;
5101 struct frame *f = SELECTED_FRAME (); 5102 struct frame *f = SELECTED_FRAME ();
5102 Lisp_Object file = Qnil; 5103 Lisp_Object file = Qnil;
5103 Widget dialog, text, list, help; 5104 Widget dialog, text, help;
5104 Arg al[10]; 5105 Arg al[10];
5105 int ac = 0; 5106 int ac = 0;
5106 extern XtAppContext Xt_app_con; 5107 extern XtAppContext Xt_app_con;
5107 XmString dir_xmstring, pattern_xmstring; 5108 XmString dir_xmstring, pattern_xmstring;
5108 int count = SPECPDL_INDEX (); 5109 int count = SPECPDL_INDEX ();
5109 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; 5110 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
5110 5111
5111 GCPRO5 (prompt, dir, default_filename, mustmatch, file); 5112 GCPRO6 (prompt, dir, default_filename, mustmatch, only_dir_p, file);
5112 CHECK_STRING (prompt); 5113 CHECK_STRING (prompt);
5113 CHECK_STRING (dir); 5114 CHECK_STRING (dir);
5114 5115
@@ -5141,9 +5142,9 @@ selection dialog's entry field, if MUSTMATCH is non-nil. */)
5141 XtAddCallback (dialog, XmNunmapCallback, file_dialog_unmap_cb, 5142 XtAddCallback (dialog, XmNunmapCallback, file_dialog_unmap_cb,
5142 (XtPointer) &result); 5143 (XtPointer) &result);
5143 5144
5144 /* Disable the help button since we can't display help. */ 5145 /* Remove the help button since we can't display help. */
5145 help = XmFileSelectionBoxGetChild (dialog, XmDIALOG_HELP_BUTTON); 5146 help = XmFileSelectionBoxGetChild (dialog, XmDIALOG_HELP_BUTTON);
5146 XtSetSensitive (help, False); 5147 XtUnmanageChild (help);
5147 5148
5148 /* Mark OK button as default. */ 5149 /* Mark OK button as default. */
5149 XtVaSetValues (XmFileSelectionBoxGetChild (dialog, XmDIALOG_OK_BUTTON), 5150 XtVaSetValues (XmFileSelectionBoxGetChild (dialog, XmDIALOG_OK_BUTTON),
@@ -5165,30 +5166,30 @@ selection dialog's entry field, if MUSTMATCH is non-nil. */)
5165 /* Manage the dialog, so that list boxes get filled. */ 5166 /* Manage the dialog, so that list boxes get filled. */
5166 XtManageChild (dialog); 5167 XtManageChild (dialog);
5167 5168
5168 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
5169 must include the path for this to work. */
5170 list = XmFileSelectionBoxGetChild (dialog, XmDIALOG_LIST);
5171 if (STRINGP (default_filename)) 5169 if (STRINGP (default_filename))
5172 { 5170 {
5173 XmString default_xmstring; 5171 XmString default_xmstring;
5174 int item_pos; 5172 Widget wtext = XmFileSelectionBoxGetChild (dialog, XmDIALOG_TEXT);
5173 Widget list = XmFileSelectionBoxGetChild (dialog, XmDIALOG_LIST);
5175 5174
5176 default_xmstring 5175 XmTextPosition last_pos = XmTextFieldGetLastPosition (wtext);
5177 = XmStringCreateLocalized (SDATA (default_filename)); 5176 XmTextFieldReplace (wtext, 0, last_pos,
5177 (SDATA (Ffile_name_nondirectory (default_filename))));
5178 5178
5179 if (!XmListItemExists (list, default_xmstring)) 5179 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
5180 { 5180 must include the path for this to work. */
5181 /* Add a new item if DEFAULT_FILENAME is not in the list. */ 5181
5182 XmListAddItem (list, default_xmstring, 0); 5182 default_xmstring = XmStringCreateLocalized (SDATA (default_filename));
5183 item_pos = 0;
5184 }
5185 else
5186 item_pos = XmListItemPos (list, default_xmstring);
5187 XmStringFree (default_xmstring);
5188 5183
5189 /* Select the item and scroll it into view. */ 5184 if (XmListItemExists (list, default_xmstring))
5190 XmListSelectPos (list, item_pos, True); 5185 {
5191 XmListSetPos (list, item_pos); 5186 int item_pos = XmListItemPos (list, default_xmstring);
5187 /* Select the item and scroll it into view. */
5188 XmListSelectPos (list, item_pos, True);
5189 XmListSetPos (list, item_pos);
5190 }
5191
5192 XmStringFree (default_xmstring);
5192 } 5193 }
5193 5194
5194 /* Process events until the user presses Cancel or OK. */ 5195 /* Process events until the user presses Cancel or OK. */
@@ -5232,23 +5233,23 @@ selection dialog's entry field, if MUSTMATCH is non-nil. */)
5232 5233
5233#ifdef USE_GTK 5234#ifdef USE_GTK
5234 5235
5235DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0, 5236DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0,
5236 "Read file name, prompting with PROMPT in directory DIR.\n\ 5237 doc: /* Read file name, prompting with PROMPT in directory DIR.
5237Use a file selection dialog.\n\ 5238Use a file selection dialog. Select DEFAULT-FILENAME in the dialog's file
5238Select DEFAULT-FILENAME in the dialog's file selection box, if\n\ 5239selection box, if specified. If MUSTMATCH is non-nil, the returned file
5239specified. Don't let the user enter a file name in the file\n\ 5240or directory must exist. If ONLY-DIR-P is non-nil, the user can only select
5240selection dialog's entry field, if MUSTMATCH is non-nil.") 5241directories. */)
5241 (prompt, dir, default_filename, mustmatch) 5242 (prompt, dir, default_filename, mustmatch, only_dir_p)
5242 Lisp_Object prompt, dir, default_filename, mustmatch; 5243 Lisp_Object prompt, dir, default_filename, mustmatch, only_dir_p;
5243{ 5244{
5244 FRAME_PTR f = SELECTED_FRAME (); 5245 FRAME_PTR f = SELECTED_FRAME ();
5245 char *fn; 5246 char *fn;
5246 Lisp_Object file = Qnil; 5247 Lisp_Object file = Qnil;
5247 int count = specpdl_ptr - specpdl; 5248 int count = specpdl_ptr - specpdl;
5248 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; 5249 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
5249 char *cdef_file; 5250 char *cdef_file;
5250 5251
5251 GCPRO5 (prompt, dir, default_filename, mustmatch, file); 5252 GCPRO6 (prompt, dir, default_filename, mustmatch, only_dir_p, file);
5252 CHECK_STRING (prompt); 5253 CHECK_STRING (prompt);
5253 CHECK_STRING (dir); 5254 CHECK_STRING (dir);
5254 5255
@@ -5262,7 +5263,9 @@ selection dialog's entry field, if MUSTMATCH is non-nil.")
5262 else 5263 else
5263 cdef_file = SDATA (dir); 5264 cdef_file = SDATA (dir);
5264 5265
5265 fn = xg_get_file_name (f, SDATA (prompt), cdef_file, ! NILP (mustmatch)); 5266 fn = xg_get_file_name (f, SDATA (prompt), cdef_file,
5267 ! NILP (mustmatch),
5268 ! NILP (only_dir_p));
5266 5269
5267 if (fn) 5270 if (fn)
5268 { 5271 {
diff --git a/src/xmenu.c b/src/xmenu.c
index 040bb6df622..0da826e4cb0 100644
--- a/src/xmenu.c
+++ b/src/xmenu.c
@@ -110,11 +110,12 @@ extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
110extern Lisp_Object Qmenu_bar_update_hook; 110extern Lisp_Object Qmenu_bar_update_hook;
111 111
112#ifdef USE_X_TOOLKIT 112#ifdef USE_X_TOOLKIT
113extern void set_frame_menubar (); 113extern void set_frame_menubar P_ ((FRAME_PTR, int, int));
114extern XtAppContext Xt_app_con; 114extern XtAppContext Xt_app_con;
115 115
116static Lisp_Object xdialog_show (); 116static Lisp_Object xdialog_show P_ ((FRAME_PTR, int, Lisp_Object, char **));
117static void popup_get_selection (); 117static void popup_get_selection P_ ((XEvent *, struct x_display_info *,
118 LWLIB_ID, int));
118 119
119/* Define HAVE_BOXES if menus can handle radio and toggle buttons. */ 120/* Define HAVE_BOXES if menus can handle radio and toggle buttons. */
120 121
@@ -124,8 +125,8 @@ static void popup_get_selection ();
124#ifdef USE_GTK 125#ifdef USE_GTK
125#include "gtkutil.h" 126#include "gtkutil.h"
126#define HAVE_BOXES 1 127#define HAVE_BOXES 1
127extern void set_frame_menubar (); 128extern void set_frame_menubar P_ ((FRAME_PTR, int, int));
128static Lisp_Object xdialog_show (); 129static Lisp_Object xdialog_show P_ ((FRAME_PTR, int, Lisp_Object, char **));
129#endif 130#endif
130 131
131/* This is how to deal with multibyte text if HAVE_MULTILINGUAL_MENU 132/* This is how to deal with multibyte text if HAVE_MULTILINGUAL_MENU
@@ -156,7 +157,6 @@ static void single_keymap_panes P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
156static void list_of_panes P_ ((Lisp_Object)); 157static void list_of_panes P_ ((Lisp_Object));
157static void list_of_items P_ ((Lisp_Object)); 158static void list_of_items P_ ((Lisp_Object));
158 159
159extern EMACS_TIME timer_check P_ ((int));
160 160
161/* This holds a Lisp vector that holds the results of decoding 161/* This holds a Lisp vector that holds the results of decoding
162 the keymaps or alist-of-alists that specify a menu. 162 the keymaps or alist-of-alists that specify a menu.
@@ -1128,21 +1128,16 @@ on the left of the dialog box and all following items on the right.
1128 1128
1129#ifdef USE_X_TOOLKIT 1129#ifdef USE_X_TOOLKIT
1130static void 1130static void
1131popup_get_selection (initial_event, dpyinfo, id, do_timers, down_on_keypress) 1131popup_get_selection (initial_event, dpyinfo, id, down_on_keypress)
1132 XEvent *initial_event; 1132 XEvent *initial_event;
1133 struct x_display_info *dpyinfo; 1133 struct x_display_info *dpyinfo;
1134 LWLIB_ID id; 1134 LWLIB_ID id;
1135 int do_timers;
1136 int down_on_keypress; 1135 int down_on_keypress;
1137{ 1136{
1138 XEvent event; 1137 XEvent event;
1139 1138
1140 while (popup_activated_flag) 1139 while (popup_activated_flag)
1141 { 1140 {
1142 /* If we have no events to run, consider timers. */
1143 if (do_timers && !XtAppPending (Xt_app_con))
1144 timer_check (1);
1145
1146 if (initial_event) 1141 if (initial_event)
1147 { 1142 {
1148 event = *initial_event; 1143 event = *initial_event;
@@ -2489,7 +2484,7 @@ create_and_show_popup_menu (f, first_wv, x, y, for_click)
2489 popup_activated_flag = 1; 2484 popup_activated_flag = 1;
2490 2485
2491 /* Process events that apply to the menu. */ 2486 /* Process events that apply to the menu. */
2492 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), menu_id, 0, 0); 2487 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), menu_id, 0);
2493 2488
2494 /* fp turned off the following statement and wrote a comment 2489 /* fp turned off the following statement and wrote a comment
2495 that it is unnecessary--that the menu has already disappeared. 2490 that it is unnecessary--that the menu has already disappeared.
@@ -2883,8 +2878,7 @@ create_and_show_dialog (f, first_wv)
2883 Fcons (make_number (dialog_id >> (fact)), 2878 Fcons (make_number (dialog_id >> (fact)),
2884 make_number (dialog_id & ~(-1 << (fact))))); 2879 make_number (dialog_id & ~(-1 << (fact)))));
2885 2880
2886 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), 2881 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id, 1);
2887 dialog_id, 1, 1);
2888 2882
2889 unbind_to (count, Qnil); 2883 unbind_to (count, Qnil);
2890 } 2884 }
diff --git a/src/xselect.c b/src/xselect.c
index 1e3efd2bf54..35f4586b754 100644
--- a/src/xselect.c
+++ b/src/xselect.c
@@ -108,8 +108,8 @@ Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3,
108 QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7; 108 QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7;
109#endif 109#endif
110 110
111static Lisp_Object Vx_lost_selection_hooks; 111static Lisp_Object Vx_lost_selection_functions;
112static Lisp_Object Vx_sent_selection_hooks; 112static Lisp_Object Vx_sent_selection_functions;
113/* Coding system for communicating with other X clients via cutbuffer, 113/* Coding system for communicating with other X clients via cutbuffer,
114 selection, and clipboard. */ 114 selection, and clipboard. */
115static Lisp_Object Vselection_coding_system; 115static Lisp_Object Vselection_coding_system;
@@ -856,7 +856,7 @@ x_handle_selection_request (event)
856 /* Let random lisp code notice that the selection has been asked for. */ 856 /* Let random lisp code notice that the selection has been asked for. */
857 { 857 {
858 Lisp_Object rest; 858 Lisp_Object rest;
859 rest = Vx_sent_selection_hooks; 859 rest = Vx_sent_selection_functions;
860 if (!EQ (rest, Qunbound)) 860 if (!EQ (rest, Qunbound))
861 for (; CONSP (rest); rest = Fcdr (rest)) 861 for (; CONSP (rest); rest = Fcdr (rest))
862 call3 (Fcar (rest), selection_symbol, target_symbol, successful_p); 862 call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
@@ -939,7 +939,7 @@ x_handle_selection_clear (event)
939 939
940 { 940 {
941 Lisp_Object rest; 941 Lisp_Object rest;
942 rest = Vx_lost_selection_hooks; 942 rest = Vx_lost_selection_functions;
943 if (!EQ (rest, Qunbound)) 943 if (!EQ (rest, Qunbound))
944 { 944 {
945 for (; CONSP (rest); rest = Fcdr (rest)) 945 for (; CONSP (rest); rest = Fcdr (rest))
@@ -972,7 +972,7 @@ x_clear_frame_selections (f)
972 /* Let random Lisp code notice that the selection has been stolen. */ 972 /* Let random Lisp code notice that the selection has been stolen. */
973 Lisp_Object hooks, selection_symbol; 973 Lisp_Object hooks, selection_symbol;
974 974
975 hooks = Vx_lost_selection_hooks; 975 hooks = Vx_lost_selection_functions;
976 selection_symbol = Fcar (Fcar (Vselection_alist)); 976 selection_symbol = Fcar (Fcar (Vselection_alist));
977 977
978 if (!EQ (hooks, Qunbound)) 978 if (!EQ (hooks, Qunbound))
@@ -996,7 +996,7 @@ x_clear_frame_selections (f)
996 /* Let random Lisp code notice that the selection has been stolen. */ 996 /* Let random Lisp code notice that the selection has been stolen. */
997 Lisp_Object hooks, selection_symbol; 997 Lisp_Object hooks, selection_symbol;
998 998
999 hooks = Vx_lost_selection_hooks; 999 hooks = Vx_lost_selection_functions;
1000 selection_symbol = Fcar (Fcar (XCDR (rest))); 1000 selection_symbol = Fcar (Fcar (XCDR (rest)));
1001 1001
1002 if (!EQ (hooks, Qunbound)) 1002 if (!EQ (hooks, Qunbound))
@@ -2699,15 +2699,15 @@ means that a side-effect was executed,
2699and there is no meaningful selection value. */); 2699and there is no meaningful selection value. */);
2700 Vselection_converter_alist = Qnil; 2700 Vselection_converter_alist = Qnil;
2701 2701
2702 DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks, 2702 DEFVAR_LISP ("x-lost-selection-functions", &Vx_lost_selection_functions,
2703 doc: /* A list of functions to be called when Emacs loses an X selection. 2703 doc: /* A list of functions to be called when Emacs loses an X selection.
2704\(This happens when some other X client makes its own selection 2704\(This happens when some other X client makes its own selection
2705or when a Lisp program explicitly clears the selection.) 2705or when a Lisp program explicitly clears the selection.)
2706The functions are called with one argument, the selection type 2706The functions are called with one argument, the selection type
2707\(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */); 2707\(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2708 Vx_lost_selection_hooks = Qnil; 2708 Vx_lost_selection_functions = Qnil;
2709 2709
2710 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks, 2710 DEFVAR_LISP ("x-sent-selection-functions", &Vx_sent_selection_functions,
2711 doc: /* A list of functions to be called when Emacs answers a selection request. 2711 doc: /* A list of functions to be called when Emacs answers a selection request.
2712The functions are called with four arguments: 2712The functions are called with four arguments:
2713 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD'); 2713 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
@@ -2719,7 +2719,7 @@ including being asked for a selection that we no longer own, or being asked
2719to convert into a type that we don't know about or that is inappropriate. 2719to convert into a type that we don't know about or that is inappropriate.
2720This hook doesn't let you change the behavior of Emacs's selection replies, 2720This hook doesn't let you change the behavior of Emacs's selection replies,
2721it merely informs you that they have happened. */); 2721it merely informs you that they have happened. */);
2722 Vx_sent_selection_hooks = Qnil; 2722 Vx_sent_selection_functions = Qnil;
2723 2723
2724 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system, 2724 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system,
2725 doc: /* Coding system for communicating with other X clients. 2725 doc: /* Coding system for communicating with other X clients.
diff --git a/src/xterm.c b/src/xterm.c
index 603df429dce..9b5d768b2af 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -3930,9 +3930,9 @@ x_window_to_scroll_bar (display, window_id)
3930{ 3930{
3931 Lisp_Object tail; 3931 Lisp_Object tail;
3932 3932
3933#ifdef USE_GTK 3933#if defined (USE_GTK) && defined (USE_TOOLKIT_SCROLL_BARS)
3934 window_id = (Window) xg_get_scroll_id_for_window (display, window_id); 3934 window_id = (Window) xg_get_scroll_id_for_window (display, window_id);
3935#endif /* USE_GTK */ 3935#endif /* USE_GTK && USE_TOOLKIT_SCROLL_BARS */
3936 3936
3937 for (tail = Vframe_list; 3937 for (tail = Vframe_list;
3938 XGCTYPE (tail) == Lisp_Cons; 3938 XGCTYPE (tail) == Lisp_Cons;