aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-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/NEWS46
-rw-r--r--etc/TODO2
-rw-r--r--lisp/ChangeLog351
-rw-r--r--lisp/allout.el61
-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.el10
-rw-r--r--lisp/ehelp.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/edebug.el6
-rw-r--r--lisp/emacs-lisp/elp.el2
-rw-r--r--lisp/emulation/cua-base.el2
-rw-r--r--lisp/eshell/esh-mode.el11
-rw-r--r--lisp/fast-lock.el2
-rw-r--r--lisp/files.el101
-rw-r--r--lisp/filesets.el3
-rw-r--r--lisp/gnus/ChangeLog135
-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-msg.el6
-rw-r--r--lisp/gnus/gnus-registry.el1
-rw-r--r--lisp/gnus/gnus-spec.el2
-rw-r--r--lisp/gnus/gnus-srvr.el4
-rw-r--r--lisp/gnus/gnus-start.el2
-rw-r--r--lisp/gnus/gnus-sum.el7
-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.el106
-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/pgg-def.el3
-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/spam.el3
-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.el4
-rw-r--r--lisp/info.el26
-rw-r--r--lisp/international/mule-cmds.el20
-rw-r--r--lisp/kmacro.el15
-rw-r--r--lisp/mail/supercite.el24
-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.el7
-rw-r--r--lisp/net/browse-url.el7
-rw-r--r--lisp/net/eudc.el142
-rw-r--r--lisp/net/tls.el3
-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/cperl-mode.el6
-rw-r--r--lisp/progmodes/f90.el8
-rw-r--r--lisp/progmodes/flymake.el49
-rw-r--r--lisp/progmodes/gdb-ui.el18
-rw-r--r--lisp/progmodes/grep.el10
-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/simple.el4
-rw-r--r--lisp/textmodes/bibtex.el1187
-rw-r--r--lisp/textmodes/flyspell.el4
-rw-r--r--lisp/textmodes/ispell.el5
-rw-r--r--lisp/textmodes/table.el3
-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/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.el75
-rw-r--r--lisp/vc-mcvs.el10
-rw-r--r--lisp/vc.el8
-rw-r--r--lisp/x-dnd.el5
-rw-r--r--lispref/ChangeLog4
-rw-r--r--lispref/commands.texi11
-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/ChangeLog239
-rw-r--r--src/Makefile.in2
-rw-r--r--src/atimer.c3
-rw-r--r--src/callproc.c5
-rw-r--r--src/casefiddle.c23
-rw-r--r--src/config.in9
-rw-r--r--src/dispnew.c2
-rw-r--r--src/emacs.c1
-rw-r--r--src/eval.c46
-rw-r--r--src/fileio.c51
-rw-r--r--src/fontset.c14
-rw-r--r--src/gtkutil.c137
-rw-r--r--src/gtkutil.h7
-rw-r--r--src/insdel.c118
-rw-r--r--src/keyboard.c91
-rw-r--r--src/keyboard.h1
-rw-r--r--src/lisp.h2
-rw-r--r--src/macfns.c38
-rw-r--r--src/process.c48
-rw-r--r--src/w32fns.c30
-rw-r--r--src/w32term.c4
-rw-r--r--src/window.c40
-rw-r--r--src/xdisp.c28
-rw-r--r--src/xfns.c91
-rw-r--r--src/xmenu.c30
-rw-r--r--src/xselect.c176
-rw-r--r--src/xterm.c85
-rw-r--r--src/xterm.h7
148 files changed, 4158 insertions, 1819 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 27e3d815f3c..5d08bd4d030 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -643,14 +643,17 @@ version 4.7 or newer, compiles to Info pages with embedded images.
643 643
644** BibTeX mode: 644** BibTeX mode:
645*** The new command bibtex-url browses a URL for the BibTeX entry at 645*** The new command bibtex-url browses a URL for the BibTeX entry at
646point (bound to C-c C-l and mouse-2 on clickable fields). 646point (bound to C-c C-l and mouse-2, RET on clickable fields).
647
647*** The new command bibtex-entry-update (bound to C-c C-u) updates 648*** The new command bibtex-entry-update (bound to C-c C-u) updates
648an existing BibTeX entry. 649an existing BibTeX entry.
650
649*** New `bibtex-entry-format' option `required-fields', enabled by default. 651*** New `bibtex-entry-format' option `required-fields', enabled by default.
652
650*** bibtex-maintain-sorted-entries can take values `plain', 653*** bibtex-maintain-sorted-entries can take values `plain',
651`crossref', and `entry-class' which control the sorting scheme used 654`crossref', and `entry-class' which control the sorting scheme used
652for BibTeX entries. `bibtex-sort-entry-class' controls the sorting 655for BibTeX entries. `bibtex-sort-entry-class' controls the sorting
653scheme `entry-class'. TAB completion for reference keys and 656scheme `entry-class'. TAB completion for reference keys and
654automatic detection of duplicates does not require anymore that 657automatic detection of duplicates does not require anymore that
655bibtex-maintain-sorted-entries is non-nil. 658bibtex-maintain-sorted-entries is non-nil.
656 659
@@ -667,11 +670,22 @@ types for which fields are filled automatically (if possible).
667point according to context (bound to M-tab). 670point according to context (bound to M-tab).
668 671
669*** The new commands bibtex-find-entry and bibtex-find-crossref 672*** The new commands bibtex-find-entry and bibtex-find-crossref
670locate entries and crossref'd entries. 673locate entries and crossref'd entries. Crossref fields are clickable
674(bound to mouse-2, RET).
671 675
672*** In BibTeX mode the command fill-paragraph (bound to M-q) fills 676*** In BibTeX mode the command fill-paragraph (bound to M-q) fills
673individual fields of a BibTeX entry. 677individual fields of a BibTeX entry.
674 678
679*** The new command bibtex-validate-globally checks for duplicate keys
680in multiple BibTeX files. See also the new variables bibtex-files
681and bibtex-file-path.
682
683*** The new command bibtex-find-entry-globally searches BibTeX entries
684in multiple BibTeX files.
685
686*** The new command bibtex-copy-summary-as-kill pushes summary
687of BibTeX entry to kill ring (bound to C-c C-t).
688
675** When display margins are present in a window, the fringes are now 689** When display margins are present in a window, the fringes are now
676displayed between the margins and the buffer's text area, rather than 690displayed between the margins and the buffer's text area, rather than
677at the edges of the window. 691at the edges of the window.
@@ -917,16 +931,27 @@ amount of text shown any more (only a crude approximation of it).
917 931
918--- 932---
919** The pop up menus for Lucid now stay up if you do a fast click and can 933** The pop up menus for Lucid now stay up if you do a fast click and can
920be navigated with the arrow keys (like Gtk+ and W32). 934be navigated with the arrow keys (like Gtk+, Mac and W32).
921 935
922--- 936---
923** Dialogs for Lucid/Athena and Lesstif/Motif pops down when pressing ESC. 937** Dialogs for Lucid/Athena and Lesstif/Motif now pops down when pressing
938ESC, like they do for Gtk+, Mac and W32.
939
940---
941** The menu item "Open File..." has been split into two items, "New File..."
942and "Open File...". "Open File..." now opens only existing files. This is
943to support existing GUI file selection dialogs better.
924 944
925+++ 945+++
926** The file selection dialog for Gtk+, W32 and Motif/Lesstif can be 946** The file selection dialog for Gtk+, Mac, W32 and Motif/Lesstif can be
927disabled by customizing the variable `use-file-dialog'. 947disabled by customizing the variable `use-file-dialog'.
928 948
929+++ 949+++
950** For Gtk+ version 2.4, you can make Emacs use the old file dialog
951by setting the variable `use-old-gtk-file-dialog' to t. Default is to use
952the new dialog.
953
954+++
930** Emacs can produce an underscore-like (horizontal bar) cursor. 955** Emacs can produce an underscore-like (horizontal bar) cursor.
931The underscore cursor is set by putting `(cursor-type . hbar)' in 956The underscore cursor is set by putting `(cursor-type . hbar)' in
932default-frame-alist. It supports variable heights, like the `bar' 957default-frame-alist. It supports variable heights, like the `bar'
@@ -2299,6 +2324,13 @@ configuration files.
2299* Lisp Changes in Emacs 21.4 2324* Lisp Changes in Emacs 21.4
2300 2325
2301+++ 2326+++
2327** The new function `called-interactively-p' does what many people
2328have mistakenly believed `interactively-p' did: it returns t if the
2329calling function was called through `call-interactively'.
2330This should only be used when you cannot add a new "interactively"
2331argument to the command.
2332
2333+++
2302** An interactive specification may now use the code letter 'U' to get 2334** An interactive specification may now use the code letter 'U' to get
2303the up-event that was discarded in case the last key sequence read for a 2335the up-event that was discarded in case the last key sequence read for a
2304previous 'k' or 'K' argument was a down-event; otherwise nil is used. 2336previous 'k' or 'K' argument was a down-event; otherwise nil is used.
diff --git a/etc/TODO b/etc/TODO
index 69a26362652..847a9ad3fac 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/lisp/ChangeLog b/lisp/ChangeLog
index c22ab994eff..8e55dcd6270 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,7 +1,346 @@
12004-11-05 Juri Linkov <juri@jurta.org>
2
3 * info.el (Info-search): Don't search in node header lines
4 and file headers.
5
6 * emacs-lisp/edebug.el (edebug-next-token-class): Allow all
7 symbol-constituent characters after dot, not only digits.
8
92004-11-04 Daniel Pfeiffer <occitan@esperanto.org>
10
11 * files.el (set-auto-mode): Don't get error after setting
12 -*-mode-*-.
13
142004-11-04 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
15
16 * dired.el (dired-read-dir-and-switches): Call read-directory-name
17 if a dialog will be used, read-file-name otherwise.
18
192004-11-04 Richard M. Stallman <rms@gnu.org>
20
21 * textmodes/table.el (table group): Add :version.
22
23 * textmodes/ispell.el (ispell-word):
24 Don't alter args; set them only thru `interactive' spec.
25
26 * textmodes/flyspell.el (flyspell-word):
27 Don't alter FOLLOWING; set it only thru `interactive' spec.
28
29 * progmodes/f90.el (f90-end-of-block): Don't use interactive-p.
30
31 * net/browse-url.el (browse-url-maybe-new-window):
32 Use called-interactively-p.
33
34 * mail/supercite.el (sc-cite-region):
35 Don't use interactive-p. Add arg INTERACTIVE.
36 (sc-version): Don't use interactive-p. Rename arg to MESSAGE.
37
38 * international/mule-cmds.el (set-input-method, toggle-input-method):
39 Don't use interactive-p. Add arg INTERACTIVE.
40
41 * eshell/esh-mode.el (eshell-show-maximum-output):
42 Don't use interactive-p.
43 (eshell-truncate-buffer): Just message, no error, if buffer is short.
44
45 * mouse.el (mouse-show-mark): Get positions to delete from mark
46 and point, not from mouse-drag-overlay.
47
48 * imenu.el (imenu-eager-completion-buffer): Add :version.
49
50 * filesets.el (filesets group): Add :version.
51
522004-11-03 Daniel Pfeiffer <occitan@esperanto.org>
53
54 * files.el (xml-based-modes): Delete var.
55 (magic-mode-alist): New more general var.
56 (set-auto-mode): Use it.
57
58 * buff-menu.el (Buffer-menu-make-sort-button): Preserve point even
59 when clicking from another window.
60
612004-11-03 Thien-Thi Nguyen <ttn@gnu.org>
62
63 * vc-cvs.el (vc-cvs-local-month-numbers): Delete var.
64 (vc-cvs-annotate-time): Incorporate value of deleted var.
65 Remove special-case handling of beginning-of-buffer cruft.
66 Cache ending position (point) and return value in text property
67 `vc-cvs-annotate-time', and consult it on subsequent invocations.
68
69 * vc-cvs.el (vc-cvs-annotate-command):
70 Delete extraneous lines from beginning of buffer.
71 * vc-mcvs.el (vc-mcvs-annotate-command): Likewise.
72
73 * progmodes/grep.el (grep-default-command): Take empty string
74 for tag if all other methods yield nil. Shell-quote the tag.
75
76 * vc.el (vc-annotate-display-autoscale): Add prefix-arg
77 spec in `interactive' form, and mention it in the docstring.
78 Also, make sure point is at bol after calling `annotate-time'.
79
802004-11-02 Richard M. Stallman <rms@gnu.org>
81
82 * cus-edit.el (customize-group-other-window):
83 Select the window that displays the custom buffer.
84 (custom-buffer-create-other-window): Likewise.
85
86 * comint.el (comint-insert-input): Fix previous change.
87
88 * emacs-lisp/elp.el (elp-instrument-function):
89 Use called-interactively-p.
90
91 * emacs-lisp/easymenu.el (easy-menu-intern):
92 Don't downcase; rather, case-flip the first letter of each word.
93
94 * emacs-lisp/easy-mmode.el (define-minor-mode):
95 Use called-interactively-p.
96
97 * emacs-lisp/bytecomp.el (byte-compile-warning-types):
98 Add interactive-only.
99 (byte-compile-warnings): Add interactive-only as option.
100 (byte-compile-interactive-only-functions): New variable.
101 (byte-compile-form): Warn about calls to functions
102 in byte-compile-interactive-only-functions.
103
104 * emacs-lisp/autoload.el (update-file-autoloads):
105 Don't use interactive-p; take new arg SAVE-AFTER.
106
107 * emacs-lisp/advice.el (ad-make-advised-definition):
108 Use called-interactively-p.
109
1102004-11-02 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
111
112 * files.el (find-file-existing): New function.
113
114 * menu-bar.el (menu-bar-files-menu): Make "Open File..." call
115 find-file-existing. Add "New File..." that calls find-file.
116
117 * diropen.pbm diropen.xpm: New files.
118
119 * toolbar/tool-bar.el (tool-bar-setup): Tool bar item dired uses
120 icon diropen. New tool bar item find-file-existing uses icon open.
121
122 * dired.el (dired-read-dir-and-switches): Call read-driectory-name
123 instead of read-file-name.
124
1252004-11-02 Ulf Jasper <ulf.jasper@web.de>
126
127 * calendar/icalendar.el (icalendar-version): Increase to 0.08.
128 (icalendar--split-value): Change name of work buffer.
129 (icalendar--get-weekday-abbrev): Return nil on error.
130 (icalendar--date-to-isodate): New function.
131 (icalendar-convert-diary-to-ical)
132 (icalendar-extract-ical-from-buffer): Use only two args for
133 make-obsolete (XEmacs compatibility).
134 (icalendar-export-file, icalendar-import-file): Blank at end of
135 prompt.
136 (icalendar-export-region): Doc fix.
137 If error, return non-nil and write errors to a buffer.
138 Use correct weekday for weekly recurring events.
139 Check whether date has been parsed for ordinary events.
140 Make weekly events start in the year 2000.
141 DTEND is non-inclusive, shift end date by one day if
142 necessary (not for entries that have date and time).
143 Rename local let variables: oops -> found-error, datestring ->
144 startdatestring.
145
1462004-11-02 Kim F. Storm <storm@cua.dk>
147
148 * files.el (set-auto-mode-0): Don't rely on dynamic binding of
149 keep-mode-if-same variable. Add it as optional arg instead.
150 (set-auto-mode): Call set-auto-mode-0 with keep-mode-if-same.
151
152 * ehelp.el (electric-help-map): Reorder Q/q and R/r entries so
153 substitute-command-keys will select lower-case bindings like those
154 used in the static help texts.
155
156 * descr-text.el (describe-text-properties): Don't err if called in
157 the *Help* buffer; output to *Help-2* buffer instead.
158
159 * kmacro.el (group kmacro): Add :version.
160 (kmacro-keyboard-quit): New function to cleanup on C-g.
161 (kmacro-start-macro): Set defining-kbd-macro to append when
162 appending to last macro.
163
164 * simple.el (keyboard-quit): Call kmacro-keyboard-quit.
165
1662004-11-02 Nick Roberts <nickrob@snap.net.nz>
167
168 * progmodes/gdb-ui.el (gdb-enable-debug-log)
169 (gdb-use-inferior-io-buffer, gdb-use-colon-colon-notation)
170 (gud-gdba-command-name, gdb-show-main, gdb-many-windows):
171 Add :version keyword.
172
1732004-11-02 Pavel Kobiakov <pk_at_work@yahoo.com>
174
175 * progmodes/flymake.el (flymake-err-line-patterns): Use
176 `flymake-reformat-err-line-patterns-from-compile-el' to convert
177 `compilation-error-regexp-alist-alist' to internal Flymake format.
178
179 * progmodes/flymake.el: eliminated byte-compiler warnings.
180
1812004-11-01 Jay Belanger <belanger@truman.edu>
182
183 * calc/calc-frac.el (calc-over-notation): Replaced
184 `completing-read' with `interactive "s"'.
185
1862004-11-01 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
187
188 * mouse.el (mouse-yank-at-click, mouse-yank-secondary):
189 Revert change from 2004-10-16. '*' checks the current buffer, but the
190 mouse click may be in another buffer.
191
1922004-11-01 John Paul Wallington <jpw@gnu.org>
193
194 * files.el (large-file-warning-threshold): Add :version keyword.
195 (kill-some-buffers): Doc fix.
196
197 * thumbs.el (group thumbs): Add :version keyword.
198
199 * textmodes/bibtex.el (bibtex-make-field): Fix typo.
200
2012004-11-01 Richard M. Stallman <rms@gnu.org>
202
203 * textmodes/ispell.el (ispell-word): Don't use interactive-p.
204
205 * textmodes/flyspell.el (flyspell-word): Don't use interactive-p.
206
207 * allout.el (allout group): Add :version.
208 (allout-init): Don't use interactive-p.
209 (allout-ascend-to-depth, allout-ascend, allout-end-of-level)
210 (allout-forward-current-level, allout-backward-current-level):
211 Don't use interactive-p.
212
213 * textmodes/bibtex.el (bibtex-make-field): Don't use interactive-p.
214 (bibtex-find-text): Likewise.
215
216 * progmodes/vhdl-mode.el (vhdl-fill-region)
217 (vhdl-beginning-of-statement): Don't use interactive-p.
218
219 * progmodes/idlwave.el (idlwave-update-routine-info):
220 Don't use interactive-p.
221
222 * progmodes/idlw-shell.el (idlwave-shell-send-char):
223 Don't use interactive-p.
224
225 * progmodes/cperl-mode.el (cperl-switch-to-doc-buffer):
226 Don't use interactive-p.
227
228 * progmodes/ada-xref.el (ada-make-body-gnatstub):
229 Don't use interactive-p.
230
231 * play/fortune.el (fortune-to-signature): Don't use interactive-p.
232 (fortune-in-buffer): Doc fix.
233
234 * play/5x5.el (5x5-new-game): Set up the buffer even if not interactive.
235
236 * net/eudc.el (eudc-display-records): Use with-output-to-temp-buffer;
237 don't select the temporary buffer.
238 (eudc-get-email): New optional arg ERROR; don't use interactive-p.
239 (eudc-get-phone): Likewise.
240
2412004-11-01 Kim F. Storm <storm@cua.dk>
242
243 * man.el (Man-xref-normal-file): Fix help-echo.
244
2452004-10-31 Stefan Monnier <monnier@iro.umontreal.ca>
246
247 * reveal.el (reveal-last-tick): New var.
248 (reveal-post-command): Use it to avoid closing overlays when we're
249 appending text to them.
250
2512004-10-31 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de>
252
253 * textmodes/bibtex.el: Require button.
254 (bibtex-autokey-transcriptions): Translate TeX `\ ' to space.
255 (bibtex-reference-keys): Distinguish between header keys and
256 crossref keys.
257 (bibtex-beginning-of-field): New function.
258 (bibtex-url-map): Remove.
259 (bibtex-font-lock-keywords): Use bibtex-font-lock-crossref.
260 (bibtex-font-lock-url-regexp): Assume that field names begin at
261 the beginning of a line.
262 (bibtex-font-lock-url): Simplify. Do not use bibtex-enclosing-field.
263 Remove field delimiters. Use bibtex-beginning-of-field.
264 Bugfix, point can be inside a field with a url.
265 (bibtex-font-lock-crossref, bibtex-button-action, bibtex-button):
266 New functions.
267 (bibtex-mark-active, bibtex-run-with-idle-timer): Remove.
268 (bibtex-key-in-head): Simplify.
269 (bibtex-current-line): Use bolp.
270 (bibtex-parse-keys): Remove unused arg `add'.
271 Use bibtex-type-in-head and bibtex-key-in-head.
272 (bibtex-parse-entry, bibtex-autofill-entry):
273 Use bibtex-type-in-head and bibtex-key-in-head.
274 (bibtex-autokey-get-field): Do not alter case of replacement text.
275 (bibtex-autokey-get-names): Do all processing of name list.
276 (bibtex-autokey-get-year): New function.
277 (bibtex-autokey-get-title): Do all processing of title words.
278 (bibtex-generate-autokey): Simplify.
279 (bibtex-string-files-init): Use default-directory.
280 Allow for absolute file names in bibtex-string-files.
281 (bibtex-files, bibtex-file-path): New variables.
282 (bibtex-files-expand): New function.
283 (bibtex-find-entry-globally): New command.
284 (bibtex-summary-function): New variable.
285 (bibtex-summary): Default value of bibtex-summary-function.
286 (bibtex-find-crossref): New optional args pnt and split.
287 (bibtex-complete-key-cleanup): Call bibtex-summary-function.
288 (bibtex-copy-summary-as-kill): New command bound to C-cC-t.
289 (bibtex-validate): Fix docstring. Check only abbreviated month fields.
290 Fix handling of required and alternative fields.
291 Identify duplicate keys even if bibtex-maintain-sorted-entries is nil.
292 Use cons and display-buffer.
293 (bibtex-validate-globally): New command.
294 (bibtex-clean-entry): Use bibtex-files-expand. Do not call
295 bibtex-parse-keys and bibtex-parse-strings for updating
296 bibtex-reference-keys and bibtex-strings.
297 (bibtex-realign): Remove blank lines past the last entry.
298 (bibtex-reformat): Use bibtex-entry-format as default.
299 (bibtex-choose-completion-string): Remove.
300 (bibtex-complete): Do not use bibtex-choose-completion-string.
301 (bibtex-url): Simplify.
302
3032004-10-31 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
304
305 * x-dnd.el (x-dnd-test-function, x-dnd-protocol-alist)
306 (x-dnd-types-alist, x-dnd-open-file-other-window)
307 (x-dnd-known-types): Add :version.
308
3092004-10-31 John Paul Wallington <jpw@gnu.org>
310
311 * ibuffer.el (group ibuffer): Add :version keyword.
312
3132004-10-31 Kim F. Storm <storm@cua.dk>
314
315 * ido.el (group ido): Add :version keyword.
316 (ido-mode): Remove :version keyword.
317
318 * emulation/cua-base.el (group cua): Add :version keyword.
319 (cua-mode): Remove :version keyword.
320
3212004-10-30 Luc Teirlinck <teirllm@auburn.edu>
322
323 * autorevert.el (auto-revert-tail-mode-text): Add :version keyword.
324
325 * help-at-pt.el (help-at-pt-timer): Move defvar up to avoid
326 compiler warning.
327 (help-at-pt-timer-delay): Add :initialize keyword. Simplify :set
328 function.
329 (help-at-pt-display-when-idle): Remove autoload.
330
3312004-10-30 Stefan Monnier <monnier@iro.umontreal.ca>
332
333 * makefile.w32-in (custom-deps, autoloads): Fix *-hooks -> *-hook.
334
3352004-10-30 Juri Linkov <juri@jurta.org>
336
337 * help.el (function-called-at-point):
338 * help-fns.el (variable-at-point): Read -> intern.
339
12004-10-30 Simon Josefsson <jas@extundo.com> 3402004-10-30 Simon Josefsson <jas@extundo.com>
2 341
3 * progmodes/autoconf.el (autoconf-font-lock-keywords): Recognize 342 * progmodes/autoconf.el (autoconf-font-lock-keywords):
4 AS_* too. 343 Recognize AS_* too.
5 344
62004-10-29 Simon Josefsson <jas@extundo.com> 3452004-10-29 Simon Josefsson <jas@extundo.com>
7 346
@@ -18,7 +357,7 @@
18 * mouse.el (mouse-show-mark): Replace the last occurrence of 357 * mouse.el (mouse-show-mark): Replace the last occurrence of
19 x-lost-selection-hooks with x-lost-selection-functions. 358 x-lost-selection-hooks with x-lost-selection-functions.
20 359
212004-10-28 Stefan <monnier@iro.umontreal.ca> 3602004-10-28 Stefan Monnier <monnier@iro.umontreal.ca>
22 361
23 * mouse.el (mouse-show-mark): Adjust to new name and don't assume 362 * mouse.el (mouse-show-mark): Adjust to new name and don't assume
24 x-lost-selection-functions is bound. 363 x-lost-selection-functions is bound.
@@ -70,8 +409,8 @@
70 409
712004-10-28 Kenichi Handa <handa@m17n.org> 4102004-10-28 Kenichi Handa <handa@m17n.org>
72 411
73 * international/utf-8.el (utf-translate-cjk-charsets): Add 412 * international/utf-8.el (utf-translate-cjk-charsets):
74 katakana-jisx0201. 413 Add katakana-jisx0201.
75 414
76 * international/subst-jis.el: Add data for JISX0201. 415 * international/subst-jis.el: Add data for JISX0201.
77 416
@@ -1126,7 +1465,7 @@
1126 1465
11272004-09-17 Jay Belanger <belanger@truman.edu> 14662004-09-17 Jay Belanger <belanger@truman.edu>
1128 1467
1129 * calc/calc.el (calc-mode-var-list): Fixed the value of 1468 * calc/calc.el (calc-mode-var-list): Fix the value of
1130 `calc-matrix-brackets'. 1469 `calc-matrix-brackets'.
1131 1470
11322004-09-17 Romain Francoise <romain@orebokech.com> 14712004-09-17 Romain Francoise <romain@orebokech.com>
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/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 8ac2d36334b..72ddde7c8cb 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..4553683b181 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -546,8 +546,14 @@ 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 ;; If a dialog is about to be used, call read-directory-name so
550 nil default-directory nil)))) 550 ;; the dialog code knows we want directories. Some dialogs can
551 ;; only select directories or files when popped up, not both.
552 (if (next-read-file-uses-dialog-p)
553 (read-directory-name (format "Dired %s(directory): " str)
554 nil default-directory nil)
555 (read-file-name (format "Dired %s(directory): " str)
556 nil default-directory nil)))))
551 557
552;;;###autoload (define-key ctl-x-map "d" 'dired) 558;;;###autoload (define-key ctl-x-map "d" 'dired)
553;;;###autoload 559;;;###autoload
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/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 118352937bd..2116cc33b34 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/edebug.el b/lisp/emacs-lisp/edebug.el
index 9a7b9efc333..0a6e3fed349 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -714,8 +714,10 @@ already is one.)"
714 (if (and (eq (following-char) ?.) 714 (if (and (eq (following-char) ?.)
715 (save-excursion 715 (save-excursion
716 (forward-char 1) 716 (forward-char 1)
717 (and (>= (following-char) ?0) 717 (or (and (eq (aref edebug-read-syntax-table (following-char))
718 (<= (following-char) ?9)))) 718 'symbol)
719 (not (= (following-char) ?\;)))
720 (memq (following-char) '(?\, ?\.)))))
719 'symbol 721 'symbol
720 (aref edebug-read-syntax-table (following-char)))) 722 (aref edebug-read-syntax-table (following-char))))
721 723
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/emulation/cua-base.el b/lisp/emulation/cua-base.el
index 00411c8ca4c..523a07d26de 100644
--- a/lisp/emulation/cua-base.el
+++ b/lisp/emulation/cua-base.el
@@ -267,6 +267,7 @@
267 :group 'editing-basics 267 :group 'editing-basics
268 :group 'convenience 268 :group 'convenience
269 :group 'emulations 269 :group 'emulations
270 :version "21.4"
270 :link '(emacs-commentary-link :tag "Commentary" "cua-base.el") 271 :link '(emacs-commentary-link :tag "Commentary" "cua-base.el")
271 :link '(emacs-library-link :tag "Lisp File" "cua-base.el")) 272 :link '(emacs-library-link :tag "Lisp File" "cua-base.el"))
272 273
@@ -1338,7 +1339,6 @@ paste (in addition to the normal emacs bindings)."
1338 :set-after '(cua-enable-modeline-indications cua-use-hyper-key) 1339 :set-after '(cua-enable-modeline-indications cua-use-hyper-key)
1339 :require 'cua-base 1340 :require 'cua-base
1340 :link '(emacs-commentary-link "cua-base.el") 1341 :link '(emacs-commentary-link "cua-base.el")
1341 :version "21.4"
1342 (setq mark-even-if-inactive t) 1342 (setq mark-even-if-inactive t)
1343 (setq highlight-nonselected-windows nil) 1343 (setq highlight-nonselected-windows nil)
1344 (make-variable-buffer-local 'cua--explicit-region-start) 1344 (make-variable-buffer-local 'cua--explicit-region-start)
diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el
index f76900bf482..ea9ae01a2f4 100644
--- a/lisp/eshell/esh-mode.el
+++ b/lisp/eshell/esh-mode.el
@@ -943,10 +943,11 @@ With a prefix argument, narrows region to last command output."
943 (eshell-bol) 943 (eshell-bol)
944 (kill-region (point) here)))) 944 (kill-region (point) here))))
945 945
946(defun eshell-show-maximum-output () 946(defun eshell-show-maximum-output (&optional interactive)
947 "Put the end of the buffer at the bottom of the window." 947 "Put the end of the buffer at the bottom of the window.
948 (interactive) 948When run interactively, widen the buffer first."
949 (if (interactive-p) 949 (interactive "p")
950 (if interactive
950 (widen)) 951 (widen))
951 (goto-char (point-max)) 952 (goto-char (point-max))
952 (recenter -1)) 953 (recenter -1))
@@ -1002,7 +1003,7 @@ a key."
1002 (let ((pos (point))) 1003 (let ((pos (point)))
1003 (if (bobp) 1004 (if (bobp)
1004 (if (interactive-p) 1005 (if (interactive-p)
1005 (error "Buffer too short to truncate")) 1006 (message "Buffer too short to truncate"))
1006 (delete-region (point-min) (point)) 1007 (delete-region (point-min) (point))
1007 (if (interactive-p) 1008 (if (interactive-p)
1008 (message "Truncated buffer from %d to %d lines (%.1fk freed)" 1009 (message "Truncated buffer from %d to %d lines (%.1fk freed)"
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 26f0ed608a2..75d9965133c 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -676,7 +676,7 @@ The truename of a file name is found by chasing symbolic links
676both at the level of the file and at the level of the directories 676both at the level of the file and at the level of the directories
677containing it, until no links are left at any level. 677containing it, until no links are left at any level.
678 678
679\(fn FILENAME)" 679\(fn FILENAME)" ;; Don't document the optional arguments.
680 ;; COUNTER and PREV-DIRS are only used in recursive calls. 680 ;; COUNTER and PREV-DIRS are only used in recursive calls.
681 ;; COUNTER can be a cons cell whose car is the count of how many 681 ;; COUNTER can be a cons cell whose car is the count of how many
682 ;; more links to chase before getting an error. 682 ;; more links to chase before getting an error.
@@ -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)
@@ -1836,20 +1845,27 @@ be interpreted by the interpreter matched by the second group of the
1836regular expression. The mode is then determined as the mode associated 1845regular expression. The mode is then determined as the mode associated
1837with that interpreter in `interpreter-mode-alist'.") 1846with that interpreter in `interpreter-mode-alist'.")
1838 1847
1839(defvar xml-based-modes '(html-mode) 1848(defvar magic-mode-alist
1840 "Modes that override an XML declaration. 1849 '(;; The < comes before the groups (but the first) to reduce backtracking.
1841When `set-auto-mode' sees an <?xml or <!DOCTYPE declaration, that 1850 ;; Is there a nicer way of getting . including \n?
1842buffer 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.
1843the 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)
1844used. Else `xml-mode' or `sgml-mode' is used.") 1853 ;; These two must come after html, because they are more general:
1854 ("<\\?xml " . xml-mode)
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.")
1845 1860
1846(defun set-auto-mode (&optional keep-mode-if-same) 1861(defun set-auto-mode (&optional keep-mode-if-same)
1847 "Select major mode appropriate for current buffer. 1862 "Select major mode appropriate for current buffer.
1863
1848This 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
1849interpreter that runs this file against `interpreter-mode-alist', 1865interpreter that runs this file against `interpreter-mode-alist',
1850looks for an <?xml or <!DOCTYPE declaration (see 1866compares the buffer beginning against `magic-mode-alist',
1851`xml-based-modes'), or compares the filename against the entries 1867or compares the filename against the entries in
1852in `auto-mode-alist'. 1868`auto-mode-alist'.
1853 1869
1854It does not check for the `mode:' local variable in the 1870It does not check for the `mode:' local variable in the
1855Local Variables section of the file; for that, use `hack-local-variables'. 1871Local Variables section of the file; for that, use `hack-local-variables'.
@@ -1895,7 +1911,8 @@ only set the major mode, if that would change it."
1895 (if (not (functionp mode)) 1911 (if (not (functionp mode))
1896 (message "Ignoring unknown mode `%s'" mode) 1912 (message "Ignoring unknown mode `%s'" mode)
1897 (setq done t) 1913 (setq done t)
1898 (or (set-auto-mode-0 mode) 1914 (or (set-auto-mode-0 mode keep-mode-if-same)
1915 ;; continuing would call minor modes again, toggling them off
1899 (throw 'nop nil))))) 1916 (throw 'nop nil)))))
1900 ;; If we didn't, look for an interpreter specified in the first line. 1917 ;; If we didn't, look for an interpreter specified in the first line.
1901 ;; As a special case, allow for things like "#!/bin/env perl", which 1918 ;; As a special case, allow for things like "#!/bin/env perl", which
@@ -1909,47 +1926,49 @@ only set the major mode, if that would change it."
1909 ;; same time. 1926 ;; same time.
1910 done (assoc (file-name-nondirectory mode) 1927 done (assoc (file-name-nondirectory mode)
1911 interpreter-mode-alist)) 1928 interpreter-mode-alist))
1912 ;; If we found an interpreter mode to use, invoke it now. 1929 (if done
1913 (if done (set-auto-mode-0 (cdr done)))) 1930 (set-auto-mode-0 (cdr done) keep-mode-if-same)))
1914 (if (and (not done) buffer-file-name) 1931 ;; If we found an interpreter mode to use, invoke it now.
1915 (let ((name buffer-file-name)) 1932 (unless done
1916 ;; Remove backup-suffixes from file name. 1933 (if (setq done (save-excursion
1917 (setq name (file-name-sans-versions name)) 1934 (goto-char (point-min))
1918 (while name 1935 (assoc-default nil magic-mode-alist
1919 ;; Find first matching alist entry. 1936 (lambda (re dummy)
1920 (let ((case-fold-search 1937 (looking-at re)))))
1921 (memq system-type '(vax-vms windows-nt cygwin)))) 1938 (set-auto-mode-0 done keep-mode-if-same)
1922 (if (and (setq mode (assoc-default name auto-mode-alist 1939 (if buffer-file-name
1940 (let ((name buffer-file-name))
1941 ;; Remove backup-suffixes from file name.
1942 (setq name (file-name-sans-versions name))
1943 (while name
1944 ;; Find first matching alist entry.
1945 (let ((case-fold-search
1946 (memq system-type '(vax-vms windows-nt cygwin))))
1947 (if (and (setq mode (assoc-default name auto-mode-alist
1923 'string-match)) 1948 'string-match))
1924 (consp mode) 1949 (consp mode)
1925 (cadr mode)) 1950 (cadr mode))
1926 (setq mode (car mode) 1951 (setq mode (car mode)
1927 name (substring name 0 (match-beginning 0))) 1952 name (substring name 0 (match-beginning 0)))
1928 (setq name))) 1953 (setq name)))
1929 (when mode 1954 (when mode
1930 (if xml (or (memq mode xml-based-modes) 1955 (set-auto-mode-0 mode keep-mode-if-same)))))))))
1931 (setq mode 'xml-mode)))
1932 (set-auto-mode-0 mode)
1933 (setq done t)))))
1934 (and xml
1935 (not done)
1936 (set-auto-mode-0 'xml-mode))))
1937 1956
1938 1957
1939;; When `keep-mode-if-same' is set, we are working on behalf of 1958;; When `keep-mode-if-same' is set, we are working on behalf of
1940;; set-visited-file-name. In that case, if the major mode specified is the 1959;; set-visited-file-name. In that case, if the major mode specified is the
1941;; same one we already have, don't actually reset it. We don't want to lose 1960;; same one we already have, don't actually reset it. We don't want to lose
1942;; minor modes such as Font Lock. 1961;; minor modes such as Font Lock.
1943(defun set-auto-mode-0 (mode) 1962(defun set-auto-mode-0 (mode &optional keep-mode-if-same)
1944 "Apply MODE and return it. 1963 "Apply MODE and return it.
1945If `keep-mode-if-same' is non-nil MODE is chased of any aliases and 1964If optional arg KEEP-MODE-IF-SAME is non-nil, MODE is chased of
1946compared to current major mode. If they are the same, do nothing 1965any aliases and compared to current major mode. If they are the
1947and return nil." 1966same, do nothing and return nil."
1948 (when keep-mode-if-same 1967 (when keep-mode-if-same
1949 (while (symbolp (symbol-function mode)) 1968 (while (symbolp (symbol-function mode))
1950 (setq mode (symbol-function mode))) 1969 (setq mode (symbol-function mode)))
1951 (if (eq mode major-mode) 1970 (if (eq mode major-mode)
1952 (setq mode))) 1971 (setq mode nil)))
1953 (when mode 1972 (when mode
1954 (funcall mode) 1973 (funcall mode)
1955 mode)) 1974 mode))
@@ -3813,7 +3832,7 @@ This command is used in the special Dired buffer created by
3813 3832
3814(defun kill-some-buffers (&optional list) 3833(defun kill-some-buffers (&optional list)
3815 "Kill some buffers. Asks the user whether to kill each one of them. 3834 "Kill some buffers. Asks the user whether to kill each one of them.
3816Non-interactively, if optional argument LIST is non-`nil', it 3835Non-interactively, if optional argument LIST is non-nil, it
3817specifies the list of buffers to kill, asking for approval for each one." 3836specifies the list of buffers to kill, asking for approval for each one."
3818 (interactive) 3837 (interactive)
3819 (if (null list) 3838 (if (null list)
diff --git a/lisp/filesets.el b/lisp/filesets.el
index cd42be63738..74a2a72bb34 100644
--- a/lisp/filesets.el
+++ b/lisp/filesets.el
@@ -295,7 +295,8 @@ key is supported."
295(defgroup filesets nil 295(defgroup filesets nil
296 "The fileset swapper." 296 "The fileset swapper."
297 :prefix "filesets-" 297 :prefix "filesets-"
298 :group 'convenience) 298 :group 'convenience
299 :version "21.4")
299 300
300(defcustom filesets-menu-name "Filesets" 301(defcustom filesets-menu-name "Filesets"
301 "*Filesets' menu name." 302 "*Filesets' menu name."
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 2c658a4c562..d7ebedc53f8 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,5 +1,140 @@
12004-11-04 Richard M. Stallman <rms@gnu.org>
2
3 * spam.el (spam group): Add :version.
4
5 * pgg-def.el (pgg group): Add :version.
6
72004-11-04 Katsumi Yamaoka <yamaoka@jpl.org>
8
9 * gnus-art. (gnus-article-edit-article): Don't associate the
10 article buffer with a draft file. This is a temporary measure
11 against the 2004-08-22 change to gnus-article-edit-mode.
12
132004-11-02 Katsumi Yamaoka <yamaoka@jpl.org>
14
15 * html2text.el (html2text-get-attr): Remove unused argument `tag'.
16 (html2text-format-tags): Remove unused variable `attr'.
17
18 * mm-util.el (mm-enrich-utf-8-by-mule-ucs): Fix cleaning of
19 after-load-alist.
20
21 * mm-util.el (mm-mime-mule-charset-alist): Add the windows-1251
22 entry. From Ilya N. Golubev <gin@mo.msk.ru>.
23 (mm-enrich-utf-8-by-mule-ucs): New function run when Mule-UCS is
24 loaded under XEmacs.
25 (): Don't make duplicated entries in mm-mime-mule-charset-alist.
26
27 * mm-util.el (mm-coding-system-p): Return a coding-system.
28 (mm-mime-mule-charset-alist): Use shift_jis instead of
29 iso-2022-jp-2 for the katakana-jisx0201 mule charset; add new
30 entries for the mime charsets iso-2022-jp-3 and shift_jis.
31 (mm-coding-system-priorities): Use shift_jis and iso-8859-1
32 instead of japanese-shift-jis and iso-latin-1 respectively in
33 order to share the default value with both Emacs and XEmacs-mule.
34 (mm-mule-charset-to-mime-charset): Make
35 mm-coding-system-priorities effective.
36 (mm-sort-coding-systems-predicate): Canonicalize coding-systems
37 while predicating of candidates upon the priorities.
38
392004-11-01 Reiner Steib <Reiner.Steib@gmx.de>
40
41 * gnus-msg.el (gnus-summary-resend-default-address): Add :version.
42
43 * tls.el (tls-process-connection-type, tls-success)
44 (tls-certtool-program): Add :version.
45
46 * starttls.el (starttls-gnutls-program, starttls-use-gnutls)
47 (starttls-extra-arguments, starttls-process-connection-type)
48 (starttls-connect, starttls-failure, starttls-success):
49
50 * spam-stat.el (spam-stat): Add :version.
51
52 * sieve.el (sieve): Add :version.
53
54 * sha1.el (sha1): Added :version.
55 (sha1-use-external): Removed redundant version.
56
57 * nnmail.el (nnmail-split-fancy-with-parent-ignore-groups)
58 (nnmail-cache-ignore-groups, nnmail-spool-hook)
59 (nnmail-split-fancy-match-partial-words)
60 (nnmail-split-lowercase-expanded):
61
62 * nndiary.el (nndiary): Add :version.
63
64 * mml2015.el (mml2015-unabbrev-trust-alist): Add :version.
65
66 * mml-sec.el (mml-default-sign-method)
67 (mml-default-encrypt-method, mml-signencrypt-style-alist): Add
68 :version.
69
70 * mm-uu.el (mm-uu-diff-groups-regexp): Add :version.
71
72 * mm-url.el (mm-url-use-external, mm-url-program)
73 (mm-url-arguments): Add :version.
74
75 * mm-decode.el (mm-inline-text-html-with-w3m-keymap)
76 (mm-attachment-file-modes, mm-decrypt-option)
77 (mm-w3m-safe-url-regexp): Add :version.
78
79 * message.el (message-cite-prefix-regexp)
80 (message-sendmail-envelope-from, message-minibuffer-local-map)
81 (message-user-fqdn, message-completion-alist): Add :version.
82
83 * gnus-win.el (gnus-configure-windows-hook)
84 (gnus-use-frames-on-any-display): Add :version.
85
86 * gnus-art.el (gnus-article-address-banner-alist)
87 (gnus-treat-unsplit-urls, gnus-treat-unfold-headers)
88 (gnus-treat-from-picon, gnus-treat-mail-picon)
89 (gnus-treat-x-pgp-sig): Add :version.
90
91 * gnus-sum.el (gnus-spam-mark, gnus-recent-mark)
92 (gnus-undownloaded-mark, gnus-summary-article-move-hook)
93 (gnus-summary-article-delete-hook)
94 (gnus-summary-display-while-building): Add :version.
95
96 * gnus-start.el (gnus-subscribe-newsgroup-hooks)
97 (gnus-get-top-new-news-hook):Add :version.
98
99 * gnus-srvr.el (gnus-server-agent-face, gnus-server-opened-face)
100 (gnus-server-closed-face, gnus-server-denied-face): Add :version.
101
102 * gnus-registry.el (gnus-registry): Add :version.
103
104 * gnus-spec.el (gnus-use-correct-string-widths)
105 (gnus-make-format-preserve-properties): Add :version.
106
107 * gnus.el (gnus-group-charter-alist)
108 (gnus-group-fetch-control-use-browse-url)
109 (gnus-install-group-spam-parameters): Add :version.
110
111 * gnus-diary.el (gnus-diary): Add :version.
112
113 * gnus-delay.el (gnus-delay): Add :version.
114
115 * gnus-cite.el (gnus-cite-unsightly-citation-regexp)
116 (gnus-cite-ignore-quoted-from, gnus-cite-attribution-face)
117 (gnus-cite-blank-line-after-header, gnus-article-boring-faces):
118 Add :version.
119
120 * gnus-agent.el (gnus-agent-max-fetch-size)
121 (gnus-agent-enable-expiration, gnus-agent-queue-mail)
122 (gnus-agent-prompt-send-queue): Add :version.
123
124 * deuglify.el (gnus-outlook-deuglify): Add :version.
125
126 * html2text.el: Beautify code. Improve doc strings. Some checkdoc
127 cleanup.
128 (html2text-get-attr, html2text-fix-paragraph): Simplify code.
129 (html2text-format-tag-list): Added "strong" and "em". From
130 "Alfred M. Szmidt" <ams@kemisten.nu> (tiny change).
131
12004-10-29 Katsumi Yamaoka <yamaoka@jpl.org> 1322004-10-29 Katsumi Yamaoka <yamaoka@jpl.org>
2 133
134 * gnus-msg.el (gnus-configure-posting-styles): Work with empty
135 signature file. Suggested by Manoj Srivastava
136 <srivasta@golden-gryphon.com>.
137
3 * mm-util.el (mm-coding-system-priorities): Prefer iso-8859-1 than 138 * mm-util.el (mm-coding-system-priorities): Prefer iso-8859-1 than
4 iso-2022-jp even in the Japanese language environment. Suggested 139 iso-2022-jp even in the Japanese language environment. Suggested
5 by Jason Rumney <jasonr@gnu.org>. 140 by Jason Rumney <jasonr@gnu.org>.
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-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 dc93fef5176..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
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 971124ba831..81ca22a87ad 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 6ce2f55e2b7..5f2c2d7aeb1 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
@@ -9178,6 +9184,7 @@ If nil, use to the current newsgroup method."
9178 "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.
9179If 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
9180the 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"
9181 :group 'gnus-thread 9188 :group 'gnus-thread
9182 :type '(choice (const :tag "off" nil) 9189 :type '(choice (const :tag "off" nil)
9183 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 b68b4ec584c..382133a027e 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,24 +255,47 @@ 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(defvar mm-hack-charsets '(iso-8859-15 iso-2022-jp-2) 300(defvar mm-hack-charsets '(iso-8859-15 iso-2022-jp-2)
272 "A list of special charsets. 301 "A list of special charsets.
@@ -332,16 +361,20 @@ mail with multiple parts is preferred to sending a Unicode one.")
332 "Return the MIME charset corresponding to the given Mule CHARSET." 361 "Return the MIME charset corresponding to the given Mule CHARSET."
333 (if (and (fboundp 'find-coding-systems-for-charsets) 362 (if (and (fboundp 'find-coding-systems-for-charsets)
334 (fboundp 'sort-coding-systems)) 363 (fboundp 'sort-coding-systems))
335 (let (mime) 364 (let ((css (sort (sort-coding-systems
336 (dolist (cs (sort-coding-systems 365 (find-coding-systems-for-charsets (list charset)))
337 (copy-sequence 366 'mm-sort-coding-systems-predicate))
338 (find-coding-systems-for-charsets (list charset))))) 367 cs mime)
339 (unless mime 368 (while (and (not mime)
340 (when cs 369 css)
341 (setq mime (or (coding-system-get cs :mime-charset) 370 (when (setq cs (pop css))
342 (coding-system-get cs 'mime-charset)))))) 371 (setq mime (or (coding-system-get cs :mime-charset)
372 (coding-system-get cs 'mime-charset)))))
343 mime) 373 mime)
344 (let ((alist mm-mime-mule-charset-alist) 374 (let ((alist (mapcar (lambda (cs)
375 (assq cs mm-mime-mule-charset-alist))
376 (sort (mapcar 'car mm-mime-mule-charset-alist)
377 'mm-sort-coding-systems-predicate)))
345 out) 378 out)
346 (while alist 379 (while alist
347 (when (memq charset (cdar alist)) 380 (when (memq charset (cdar alist))
@@ -534,11 +567,14 @@ This affects whether coding conversion should be attempted generally."
534 (let ((priorities 567 (let ((priorities
535 (mapcar (lambda (cs) 568 (mapcar (lambda (cs)
536 ;; Note: invalid entries are dropped silently 569 ;; Note: invalid entries are dropped silently
537 (and (coding-system-p cs) 570 (and (setq cs (mm-coding-system-p cs))
538 (coding-system-base cs))) 571 (coding-system-base cs)))
539 mm-coding-system-priorities))) 572 mm-coding-system-priorities)))
540 (> (length (memq a priorities)) 573 (and (setq a (mm-coding-system-p a))
541 (length (memq b priorities))))) 574 (if (setq b (mm-coding-system-p b))
575 (> (length (memq (coding-system-base a) priorities))
576 (length (memq (coding-system-base b) priorities)))
577 t))))
542 578
543(defun mm-find-mime-charset-region (b e &optional hack-charsets) 579(defun mm-find-mime-charset-region (b e &optional hack-charsets)
544 "Return the MIME charsets needed to encode the region between B and E. 580 "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/pgg-def.el b/lisp/gnus/pgg-def.el
index b8d9cbec807..046f57dbbfe 100644
--- a/lisp/gnus/pgg-def.el
+++ b/lisp/gnus/pgg-def.el
@@ -29,7 +29,8 @@
29 29
30(defgroup pgg () 30(defgroup pgg ()
31 "Glue for the various PGP implementations." 31 "Glue for the various PGP implementations."
32 :group 'mime) 32 :group 'mime
33 :version "21.4")
33 34
34(defcustom pgg-default-scheme 'gpg 35(defcustom pgg-default-scheme 'gpg
35 "Default PGP scheme." 36 "Default PGP scheme."
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/spam.el b/lisp/gnus/spam.el
index 1dc9058dd1f..075408b8fc7 100644
--- a/lisp/gnus/spam.el
+++ b/lisp/gnus/spam.el
@@ -76,7 +76,8 @@
76;;; Main parameters. 76;;; Main parameters.
77 77
78(defgroup spam nil 78(defgroup spam nil
79 "Spam configuration.") 79 "Spam configuration."
80 :version "21.4")
80 81
81(defcustom spam-directory (nnheader-concat gnus-directory "spam/") 82(defcustom spam-directory (nnheader-concat gnus-directory "spam/")
82 "Directory for spam whitelists and blacklists." 83 "Directory for spam whitelists and blacklists."
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 7c775dc6337..16116025fb8 100644
--- a/lisp/imenu.el
+++ b/lisp/imenu.el
@@ -126,7 +126,9 @@ If `on-mouse' use a popup menu when `imenu' was invoked with the mouse."
126(defcustom imenu-eager-completion-buffer 126(defcustom imenu-eager-completion-buffer
127 (not (eq imenu-always-use-completion-buffer-p 'never)) 127 (not (eq imenu-always-use-completion-buffer-p 'never))
128 "If non-nil, eagerly popup the completion buffer." 128 "If non-nil, eagerly popup the completion buffer."
129 :type 'boolean) 129 :type 'boolean
130 :group 'imenu
131 :version "21.4")
130 132
131(defcustom imenu-after-jump-hook nil 133(defcustom imenu-after-jump-hook nil
132 "*Hooks called after jumping to a place in the buffer. 134 "*Hooks called after jumping to a place in the buffer.
diff --git a/lisp/info.el b/lisp/info.el
index 2e0ddd0fb02..8aaf7755df2 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -1476,11 +1476,21 @@ If DIRECTION is `backward', search in the reverse direction."
1476 (save-excursion 1476 (save-excursion
1477 (save-restriction 1477 (save-restriction
1478 (widen) 1478 (widen)
1479 (when backward
1480 ;; Hide Info file header for backward search
1481 (narrow-to-region (save-excursion
1482 (goto-char (point-min))
1483 (search-forward "\n\^_")
1484 (1- (point)))
1485 (point-max)))
1479 (while (and (not give-up) 1486 (while (and (not give-up)
1480 (or (null found) 1487 (or (null found)
1481 (if backward 1488 (if backward
1482 (isearch-range-invisible found beg-found) 1489 (isearch-range-invisible found beg-found)
1483 (isearch-range-invisible beg-found found)))) 1490 (isearch-range-invisible beg-found found))
1491 ;; Skip node header line
1492 (save-excursion (forward-line -1)
1493 (looking-at "\^_"))))
1484 (if (if backward 1494 (if (if backward
1485 (re-search-backward regexp bound t) 1495 (re-search-backward regexp bound t)
1486 (re-search-forward regexp bound t)) 1496 (re-search-forward regexp bound t))
@@ -1531,14 +1541,24 @@ If DIRECTION is `backward', search in the reverse direction."
1531 (while list 1541 (while list
1532 (message "Searching subfile %s..." (cdr (car list))) 1542 (message "Searching subfile %s..." (cdr (car list)))
1533 (Info-read-subfile (car (car list))) 1543 (Info-read-subfile (car (car list)))
1534 (if backward (goto-char (point-max))) 1544 (when backward
1545 ;; Hide Info file header for backward search
1546 (narrow-to-region (save-excursion
1547 (goto-char (point-min))
1548 (search-forward "\n\^_")
1549 (1- (point)))
1550 (point-max))
1551 (goto-char (point-max)))
1535 (setq list (cdr list)) 1552 (setq list (cdr list))
1536 (setq give-up nil found nil) 1553 (setq give-up nil found nil)
1537 (while (and (not give-up) 1554 (while (and (not give-up)
1538 (or (null found) 1555 (or (null found)
1539 (if backward 1556 (if backward
1540 (isearch-range-invisible found beg-found) 1557 (isearch-range-invisible found beg-found)
1541 (isearch-range-invisible beg-found found)))) 1558 (isearch-range-invisible beg-found found))
1559 ;; Skip node header line
1560 (save-excursion (forward-line -1)
1561 (looking-at "\^_"))))
1542 (if (if backward 1562 (if (if backward
1543 (re-search-backward regexp nil t) 1563 (re-search-backward regexp nil t)
1544 (re-search-forward regexp nil t)) 1564 (re-search-forward regexp nil t))
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 95177fdb954..510a3c9358d 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -1368,12 +1368,14 @@ If INPUT-METHOD is nil, deactivate any current input method."
1368 current-input-method-title nil) 1368 current-input-method-title nil)
1369 (force-mode-line-update))))) 1369 (force-mode-line-update)))))
1370 1370
1371(defun set-input-method (input-method) 1371(defun set-input-method (input-method &optional interactive)
1372 "Select and activate input method INPUT-METHOD for the current buffer. 1372 "Select and activate input method INPUT-METHOD for the current buffer.
1373This also sets the default input method to the one you specify. 1373This also sets the default input method to the one you specify.
1374If INPUT-METHOD is nil, this function turns off the input method, and 1374If INPUT-METHOD is nil, this function turns off the input method, and
1375also causes you to be prompted for a name of an input method the next 1375also causes you to be prompted for a name of an input method the next
1376time you invoke \\[toggle-input-method]. 1376time you invoke \\[toggle-input-method].
1377When called interactively, the optional arg INTERACTIVE is non-nil,
1378which marks the variable `default-input-method' as set for Custom buffers.
1377 1379
1378To deactivate the input method interactively, use \\[toggle-input-method]. 1380To deactivate the input method interactively, use \\[toggle-input-method].
1379To deactivate it programmatically, use \\[inactivate-input-method]." 1381To deactivate it programmatically, use \\[inactivate-input-method]."
@@ -1381,14 +1383,15 @@ To deactivate it programmatically, use \\[inactivate-input-method]."
1381 (let* ((default (or (car input-method-history) default-input-method))) 1383 (let* ((default (or (car input-method-history) default-input-method)))
1382 (list (read-input-method-name 1384 (list (read-input-method-name
1383 (if default "Select input method (default %s): " "Select input method: ") 1385 (if default "Select input method (default %s): " "Select input method: ")
1384 default t)))) 1386 default t)
1387 t)))
1385 (activate-input-method input-method) 1388 (activate-input-method input-method)
1386 (setq default-input-method input-method) 1389 (setq default-input-method input-method)
1387 (when (interactive-p) 1390 (when interactive
1388 (customize-mark-as-set 'default-input-method)) 1391 (customize-mark-as-set 'default-input-method))
1389 default-input-method) 1392 default-input-method)
1390 1393
1391(defun toggle-input-method (&optional arg) 1394(defun toggle-input-method (&optional arg interactive)
1392 "Enable or disable multilingual text input method for the current buffer. 1395 "Enable or disable multilingual text input method for the current buffer.
1393Only one input method can be enabled at any time in a given buffer. 1396Only one input method can be enabled at any time in a given buffer.
1394 1397
@@ -1401,9 +1404,12 @@ minibuffer.
1401 1404
1402With a prefix argument, read an input method name with the minibuffer 1405With a prefix argument, read an input method name with the minibuffer
1403and enable that one. The default is the most recent input method specified 1406and enable that one. The default is the most recent input method specified
1404\(not including the currently active input method, if any)." 1407\(not including the currently active input method, if any).
1405 1408
1406 (interactive "P") 1409When called interactively, the optional arg INTERACTIVE is non-nil,
1410which marks the variable `default-input-method' as set for Custom buffers."
1411
1412 (interactive "P\np")
1407 (if (and current-input-method (not arg)) 1413 (if (and current-input-method (not arg))
1408 (inactivate-input-method) 1414 (inactivate-input-method)
1409 (let ((default (or (car input-method-history) default-input-method))) 1415 (let ((default (or (car input-method-history) default-input-method)))
@@ -1420,7 +1426,7 @@ and enable that one. The default is the most recent input method specified
1420 (unless default-input-method 1426 (unless default-input-method
1421 (prog1 1427 (prog1
1422 (setq default-input-method current-input-method) 1428 (setq default-input-method current-input-method)
1423 (when (interactive-p) 1429 (when interactive
1424 (customize-mark-as-set 'default-input-method))))))) 1430 (customize-mark-as-set 'default-input-method)))))))
1425 1431
1426(defun describe-input-method (input-method) 1432(defun describe-input-method (input-method)
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/supercite.el b/lisp/mail/supercite.el
index af7f8b62e03..0f5925021e8 100644
--- a/lisp/mail/supercite.el
+++ b/lisp/mail/supercite.el
@@ -1424,18 +1424,21 @@ Optional CITATION overrides any citation automatically selected."
1424 nil) 1424 nil)
1425 1425
1426;; interactive functions 1426;; interactive functions
1427(defun sc-cite-region (start end &optional confirm-p) 1427(defun sc-cite-region (start end &optional confirm-p interactive)
1428 "Cite a region delineated by START and END. 1428 "Cite a region delineated by START and END.
1429If optional CONFIRM-P is non-nil, the attribution is confirmed before 1429If optional CONFIRM-P is non-nil, the attribution is confirmed before
1430its use in the citation string. This function first runs 1430its use in the citation string. This function first runs
1431`sc-pre-cite-hook'." 1431`sc-pre-cite-hook'.
1432 (interactive "r\nP") 1432
1433When called interactively, the optional arg INTERACTIVE is non-nil,
1434and that means call `sc-select-attribution' too."
1435 (interactive "r\nP\np")
1433 (undo-boundary) 1436 (undo-boundary)
1434 (let ((frame (or (sc-scan-info-alist sc-cite-frame-alist) 1437 (let ((frame (or (sc-scan-info-alist sc-cite-frame-alist)
1435 sc-default-cite-frame)) 1438 sc-default-cite-frame))
1436 (sc-confirm-always-p (if confirm-p t sc-confirm-always-p))) 1439 (sc-confirm-always-p (if confirm-p t sc-confirm-always-p)))
1437 (run-hooks 'sc-pre-cite-hook) 1440 (run-hooks 'sc-pre-cite-hook)
1438 (if (interactive-p) 1441 (if interactive
1439 (sc-select-attribution)) 1442 (sc-select-attribution))
1440 (regi-interpret frame start end))) 1443 (regi-interpret frame start end)))
1441 1444
@@ -1978,16 +1981,15 @@ cited."
1978 (insert (sc-mail-field "sc-citation")) 1981 (insert (sc-mail-field "sc-citation"))
1979 (error "Line is already cited")))) 1982 (error "Line is already cited"))))
1980 1983
1981(defun sc-version (arg) 1984(defun sc-version (message)
1982 "Echo the current version of Supercite in the minibuffer. 1985 "Echo the current version of Supercite in the minibuffer.
1983With \\[universal-argument] (universal-argument), or if run non-interactively, 1986If MESSAGE is non-nil (interactively, with no prefix argument),
1984inserts the version string in the current buffer instead." 1987inserts the version string in the current buffer instead."
1985 (interactive "P") 1988 (interactive (not current-prefix-arg))
1986 (let ((verstr (format "Using Supercite.el %s" sc-version))) 1989 (let ((verstr (format "Using Supercite.el %s" sc-version)))
1987 (if (or (consp arg) 1990 (if message
1988 (not (interactive-p))) 1991 (message verstr)
1989 (insert "`sc-version' says: " verstr) 1992 (insert "`sc-version' says: " verstr))))
1990 (message verstr))))
1991 1993
1992(defun sc-describe () 1994(defun sc-describe ()
1993 " 1995 "
diff --git a/lisp/makefile.w32-in b/lisp/makefile.w32-in
index b2694bc2b78..76a63a78b52 100644
--- a/lisp/makefile.w32-in
+++ b/lisp/makefile.w32-in
@@ -170,7 +170,7 @@ cus-load.el:
170 touch $@ 170 touch $@
171custom-deps: cus-load.el doit 171custom-deps: cus-load.el doit
172 @echo Directories: $(WINS) 172 @echo Directories: $(WINS)
173 -$(emacs) -l cus-dep --eval $(ARGQUOTE)(setq find-file-hooks nil)$(ARGQUOTE) -f custom-make-dependencies $(lisp) $(WINS) 173 -$(emacs) -l cus-dep --eval $(ARGQUOTE)(setq find-file-hook nil)$(ARGQUOTE) -f custom-make-dependencies $(lisp) $(WINS)
174 174
175finder-data: doit 175finder-data: doit
176 @echo Directories: $(WINS) 176 @echo Directories: $(WINS)
@@ -220,7 +220,7 @@ loaddefs.el-CMD:
220autoloads: loaddefs.el doit 220autoloads: loaddefs.el doit
221 @echo Directories: $(WINS) 221 @echo Directories: $(WINS)
222 $(emacs) -l autoload \ 222 $(emacs) -l autoload \
223 --eval $(ARGQUOTE)(setq find-file-hooks nil \ 223 --eval $(ARGQUOTE)(setq find-file-hook nil \
224 find-file-suppress-same-file-warnings t \ 224 find-file-suppress-same-file-warnings t \
225 generated-autoload-file \ 225 generated-autoload-file \
226 $(DQUOTE)$(lisp)/loaddefs.el$(DQUOTE))$(ARGQUOTE) \ 226 $(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.el b/lisp/mouse.el
index 8f05324d84d..865b5e96297 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -1068,8 +1068,7 @@ If MODE is 2 then do the same for lines."
1068 (unless ignore 1068 (unless ignore
1069 ;; For certain special keys, delete the region. 1069 ;; For certain special keys, delete the region.
1070 (if (member key mouse-region-delete-keys) 1070 (if (member key mouse-region-delete-keys)
1071 (delete-region (overlay-start mouse-drag-overlay) 1071 (delete-region (mark t) (point))
1072 (overlay-end mouse-drag-overlay))
1073 ;; Otherwise, unread the key so it gets executed normally. 1072 ;; Otherwise, unread the key so it gets executed normally.
1074 (setq unread-command-events 1073 (setq unread-command-events
1075 (nconc events unread-command-events)))) 1074 (nconc events unread-command-events))))
@@ -1112,7 +1111,7 @@ and set mark at the beginning.
1112Prefix arguments are interpreted as with \\[yank]. 1111Prefix arguments are interpreted as with \\[yank].
1113If `mouse-yank-at-point' is non-nil, insert at point 1112If `mouse-yank-at-point' is non-nil, insert at point
1114regardless of where you click." 1113regardless of where you click."
1115 (interactive "*e\nP") 1114 (interactive "e\nP")
1116 ;; Give temporary modes such as isearch a chance to turn off. 1115 ;; Give temporary modes such as isearch a chance to turn off.
1117 (run-hooks 'mouse-leave-buffer-hook) 1116 (run-hooks 'mouse-leave-buffer-hook)
1118 (or mouse-yank-at-point (mouse-set-point click)) 1117 (or mouse-yank-at-point (mouse-set-point click))
@@ -1414,7 +1413,7 @@ The function returns a non-nil value if it creates a secondary selection."
1414Move point to the end of the inserted text. 1413Move point to the end of the inserted text.
1415If `mouse-yank-at-point' is non-nil, insert at point 1414If `mouse-yank-at-point' is non-nil, insert at point
1416regardless of where you click." 1415regardless of where you click."
1417 (interactive "*e") 1416 (interactive "e")
1418 ;; Give temporary modes such as isearch a chance to turn off. 1417 ;; Give temporary modes such as isearch a chance to turn off.
1419 (run-hooks 'mouse-leave-buffer-hook) 1418 (run-hooks 'mouse-leave-buffer-hook)
1420 (or mouse-yank-at-point (mouse-set-point click)) 1419 (or mouse-yank-at-point (mouse-set-point click))
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 1dbd97f0073..c5a2218e36e 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -596,10 +596,11 @@ for use in `interactive'."
596 (not (eq (null browse-url-new-window-flag) 596 (not (eq (null browse-url-new-window-flag)
597 (null current-prefix-arg))))) 597 (null current-prefix-arg)))))
598 598
599;; interactive-p needs to be called at a function's top-level, hence 599;; called-interactive-p needs to be called at a function's top-level, hence
600;; the macro. 600;; this macro. We use that rather than interactive-p because
601;; use in a keyboard macro should not change this behavior.
601(defmacro browse-url-maybe-new-window (arg) 602(defmacro browse-url-maybe-new-window (arg)
602 `(if (not (interactive-p)) 603 `(if (or noninteractive (not (called-interactively-p)))
603 ,arg 604 ,arg
604 browse-url-new-window-flag)) 605 browse-url-new-window-flag))
605 606
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/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/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/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/f90.el b/lisp/progmodes/f90.el
index 53165fbecb7..a1c4d539dd7 100644
--- a/lisp/progmodes/f90.el
+++ b/lisp/progmodes/f90.el
@@ -1223,14 +1223,16 @@ Return (TYPE NAME), or nil if not found."
1223With optional argument NUM, go forward that many balanced blocks. 1223With optional argument NUM, go forward that many balanced blocks.
1224If NUM is negative, go backward to the start of a block. 1224If NUM is negative, go backward to the start of a block.
1225Checks for consistency of block types and labels (if present), 1225Checks for consistency of block types and labels (if present),
1226and completes outermost block if necessary." 1226and completes outermost block if necessary.
1227Some of these things (which?) are not done if NUM is nil,
1228which only happens in a noninteractive call."
1227 (interactive "p") 1229 (interactive "p")
1228 (if (and num (< num 0)) (f90-beginning-of-block (- num))) 1230 (if (and num (< num 0)) (f90-beginning-of-block (- num)))
1229 (let ((f90-smart-end nil) ; for the final `f90-match-end' 1231 (let ((f90-smart-end nil) ; for the final `f90-match-end'
1230 (case-fold-search t) 1232 (case-fold-search t)
1231 (count (or num 1)) 1233 (count (or num 1))
1232 start-list start-this start-type start-label end-type end-label) 1234 start-list start-this start-type start-label end-type end-label)
1233 (if (interactive-p) (push-mark (point) t)) 1235 (if num (push-mark (point) t))
1234 (end-of-line) ; probably want this 1236 (end-of-line) ; probably want this
1235 (while (and (> count 0) (re-search-forward f90-blocks-re nil 'move)) 1237 (while (and (> count 0) (re-search-forward f90-blocks-re nil 'move))
1236 (beginning-of-line) 1238 (beginning-of-line)
@@ -1266,7 +1268,7 @@ and completes outermost block if necessary."
1266 (end-of-line)) 1268 (end-of-line))
1267 (if (> count 0) (error "Missing block end")) 1269 (if (> count 0) (error "Missing block end"))
1268 ;; Check outermost block. 1270 ;; Check outermost block.
1269 (if (interactive-p) 1271 (if num
1270 (save-excursion 1272 (save-excursion
1271 (beginning-of-line) 1273 (beginning-of-line)
1272 (skip-chars-forward " \t0-9") 1274 (skip-chars-forward " \t0-9")
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 1486ec7e5cf..90c0a50c7dc 100644
--- a/lisp/progmodes/gdb-ui.el
+++ b/lisp/progmodes/gdb-ui.el
@@ -133,12 +133,14 @@ detailed description of this mode.
133(defcustom gdb-enable-debug-log nil 133(defcustom gdb-enable-debug-log nil
134 "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'."
135 :type 'boolean 135 :type 'boolean
136 :group 'gud) 136 :group 'gud
137 :version "21.4")
137 138
138(defcustom gdb-use-inferior-io-buffer nil 139(defcustom gdb-use-inferior-io-buffer nil
139 "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."
140 :type 'boolean 141 :type 'boolean
141 :group 'gud) 142 :group 'gud
143 :version "21.4")
142 144
143(defun gdb-ann3 () 145(defun gdb-ann3 ()
144 (setq gdb-debug-log nil) 146 (setq gdb-debug-log nil)
@@ -211,7 +213,8 @@ detailed description of this mode.
211(defcustom gdb-use-colon-colon-notation nil 213(defcustom gdb-use-colon-colon-notation nil
212 "If non-nil use FUN::VAR format to display variables in the speedbar." ; 214 "If non-nil use FUN::VAR format to display variables in the speedbar." ;
213 :type 'boolean 215 :type 'boolean
214 :group 'gud) 216 :group 'gud
217 :version "21.4")
215 218
216(defun gud-watch () 219(defun gud-watch ()
217 "Watch expression at point." 220 "Watch expression at point."
@@ -658,7 +661,8 @@ This filter may simply queue input for a later time."
658(defcustom gud-gdba-command-name "gdb -annotate=3" 661(defcustom gud-gdba-command-name "gdb -annotate=3"
659 "Default command to execute an executable under the GDB-UI debugger." 662 "Default command to execute an executable under the GDB-UI debugger."
660 :type 'string 663 :type 'string
661 :group 'gud) 664 :group 'gud
665 :version "21.4")
662 666
663(defvar gdb-annotation-rules 667(defvar gdb-annotation-rules
664 '(("pre-prompt" gdb-pre-prompt) 668 '(("pre-prompt" gdb-pre-prompt)
@@ -1685,7 +1689,8 @@ static char *magick[] = {
1685(defcustom gdb-show-main nil 1689(defcustom gdb-show-main nil
1686 "Nil means don't display source file containing the main routine." 1690 "Nil means don't display source file containing the main routine."
1687 :type 'boolean 1691 :type 'boolean
1688 :group 'gud) 1692 :group 'gud
1693 :version "21.4")
1689 1694
1690(defun gdb-setup-windows () 1695(defun gdb-setup-windows ()
1691 "Layout the window pattern for gdb-many-windows." 1696 "Layout the window pattern for gdb-many-windows."
@@ -1726,7 +1731,8 @@ buffer and the other with the source file with the main routine
1726of the inferior. Non-nil means display the layout shown for 1731of the inferior. Non-nil means display the layout shown for
1727`gdba'." 1732`gdba'."
1728 :type 'boolean 1733 :type 'boolean
1729 :group 'gud) 1734 :group 'gud
1735 :version "21.4")
1730 1736
1731(defun gdb-many-windows (arg) 1737(defun gdb-many-windows (arg)
1732"Toggle the number of windows in the basic arrangement." 1738"Toggle the number of windows in the basic arrangement."
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index 71927642a96..7a13ddba6ed 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -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/simple.el b/lisp/simple.el
index 2ce0cc57b15..b45d9eee348 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
@@ -3920,6 +3920,8 @@ During execution of Lisp code, this character causes a quit directly.
3920At top-level, as an editor command, this simply beeps." 3920At top-level, as an editor command, this simply beeps."
3921 (interactive) 3921 (interactive)
3922 (deactivate-mark) 3922 (deactivate-mark)
3923 (if (fboundp 'kmacro-keyboard-quit)
3924 (kmacro-keyboard-quit))
3923 (setq defining-kbd-macro nil) 3925 (setq defining-kbd-macro nil)
3924 (signal 'quit nil)) 3926 (signal 'quit nil))
3925 3927
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/flyspell.el b/lisp/textmodes/flyspell.el
index 93a7ebd52e4..556369077d8 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -956,9 +956,7 @@ Mostly we check word delimiters."
956;*---------------------------------------------------------------------*/ 956;*---------------------------------------------------------------------*/
957(defun flyspell-word (&optional following) 957(defun flyspell-word (&optional following)
958 "Spell check a word." 958 "Spell check a word."
959 (interactive (list current-prefix-arg)) 959 (interactive (list ispell-following-word))
960 (if (interactive-p)
961 (setq following ispell-following-word))
962 (save-excursion 960 (save-excursion
963 ;; use the correct dictionary 961 ;; use the correct dictionary
964 (flyspell-accept-buffer-local-defs) 962 (flyspell-accept-buffer-local-defs)
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index f0547d6d596..d221d39180f 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -1410,12 +1410,9 @@ nil word is correct or spelling is accepted.
1410\(\"word\" arg\) word is hand entered. 1410\(\"word\" arg\) word is hand entered.
1411quit spell session exited." 1411quit spell session exited."
1412 1412
1413 (interactive (list nil nil current-prefix-arg)) 1413 (interactive (list ispell-following-word ispell-quietly current-prefix-arg))
1414 (if continue 1414 (if continue
1415 (ispell-continue) 1415 (ispell-continue)
1416 (if (interactive-p)
1417 (setq following ispell-following-word
1418 quietly ispell-quietly))
1419 (ispell-accept-buffer-local-defs) ; use the correct dictionary 1416 (ispell-accept-buffer-local-defs) ; use the correct dictionary
1420 (let ((cursor-location (point)) ; retain cursor location 1417 (let ((cursor-location (point)) ; retain cursor location
1421 (word (ispell-get-word following)) 1418 (word (ispell-get-word following))
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index 7b13d498b2e..f064dd4dee0 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -645,7 +645,8 @@ See `table-insert' for examples about how to use."
645 :group 'editing 645 :group 'editing
646 :group 'wp 646 :group 'wp
647 :group 'paragraphs 647 :group 'paragraphs
648 :group 'fill) 648 :group 'fill
649 :version "21.4")
649 650
650(defgroup table-hooks nil 651(defgroup table-hooks nil
651 "Hooks for table manipulation utilities" 652 "Hooks for table manipulation utilities"
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/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 87582f57683..45ff233eb86 100644
--- a/lisp/vc-cvs.el
+++ b/lisp/vc-cvs.el
@@ -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 df902e78c9f..66406d8821d 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 c47ad2f889d..d1bb65d3358 100644
--- a/lispref/ChangeLog
+++ b/lispref/ChangeLog
@@ -1,3 +1,7 @@
12004-11-01 Richard M. Stallman <rms@gnu.org>
2
3 * commands.texi (Interactive Call): Add called-interactively-p.
4
12004-10-29 Simon Josefsson <jas@extundo.com> 52004-10-29 Simon Josefsson <jas@extundo.com>
2 6
3 * minibuf.texi (Reading a Password): Revert. 7 * minibuf.texi (Reading a Password): Revert.
diff --git a/lispref/commands.texi b/lispref/commands.texi
index f1f94e11838..3c9612e5186 100644
--- a/lispref/commands.texi
+++ b/lispref/commands.texi
@@ -617,7 +617,7 @@ This function returns @code{t} if the containing function (the one
617whose code includes the call to @code{interactive-p}) was called in 617whose code includes the call to @code{interactive-p}) was called in
618direct response to user input. This means that it was called with the 618direct response to user input. This means that it was called with the
619function @code{call-interactively}, and that a keyboard macro is 619function @code{call-interactively}, and that a keyboard macro is
620not running. 620not running, and that Emacs is not running in batch mode.
621 621
622If the containing function was called by Lisp evaluation (or with 622If the containing function was called by Lisp evaluation (or with
623@code{apply} or @code{funcall}), then it was not called interactively. 623@code{apply} or @code{funcall}), then it was not called interactively.
@@ -679,6 +679,15 @@ Defined in this way, the function does display the message when called
679from a keyboard macro. We use @code{"p"} because the numeric prefix 679from a keyboard macro. We use @code{"p"} because the numeric prefix
680argument is never @code{nil}. 680argument is never @code{nil}.
681 681
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
690
682@node Command Loop Info 691@node Command Loop Info
683@comment node-name, next, previous, up 692@comment node-name, next, previous, up
684@section Information from the Command Loop 693@section Information from the Command Loop
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 b7716f0e904..ad6be09ec46 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 8479a0f94ce..a38c3f7baeb 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,206 @@
12004-11-05 Kim F. Storm <storm@cua.dk>
2
3 * fileio.c (Ffile_modes): Doc fix.
4 (auto_save_1): Check for Ffile_modes nil value.
5
62004-11-05 Kim F. Storm <storm@cua.dk>
7
8 * xselect.c (struct selection_event_queue, selection_queue)
9 (x_queue_selection_requests, x_queue_event)
10 (x_start_queuing_selection_requests)
11 (x_stop_queuing_selection_requests): Add new queue for selection
12 input events to replace previous XEvent queue in xterm.c.
13 (queue_selection_requests_unwind): Adapt to new queue.
14 (x_reply_selection_request): Adapt to new queue. Unexpect
15 wait_object in case of x errors (memory leak).
16 (x_handle_selection_request, x_handle_selection_clear): Make static.
17 (x_handle_selection_event): New function. May queue selection events.
18 (wait_for_property_change_unwind): Use save_value instead of cons.
19 Clear property_change_reply_object.
20 (wait_for_property_change): Abort if already waiting.
21 Use save_value instead of cons for unwind data.
22 (x_handle_property_notify): Skip events already arrived, but don't
23 free them, as "arrived" field is checked by wait_for_property_change,
24 and it will be freed by unwind or explicit unexpect_property_change.
25 (x_get_foreign_selection): Add to new queue.
26 (receive_incremental_selection): Don't unexpect wait_object when done
27 as it has already been freed by previous wait_for_property_change.
28
29 * xterm.h (x_start_queuing_selection_requests)
30 (x_stop_queuing_selection_requests, x_handle_selection_request)
31 (x_handle_selection_clear): Remove prototypes.
32 (x_handle_selection_event): Add prototype.
33
34 * xterm.c (handle_one_xevent): Don't queue X selection events
35 here, it may be too late if we start queuing after we have already
36 stored some selection events into the kbd buffer.
37 (struct selection_event_queue, queue, x_queue_selection_requests)
38 (x_queue_event, x_unqueue_events, x_start_queuing_selection_requests)
39 (x_stop_queuing_selection_requests): Remove/move to xselect.c.
40 (x_catch_errors_unwind): Block input around final XSync.
41
42 * keyboard.h (kbd_buffer_unget_event): Add prototype.
43
44 * keyboard.c (kbd_buffer_store_event_hold): Remove obsolete code.
45 (kbd_buffer_unget_event): New function.
46 (kbd_buffer_get_event, swallow_events): Combine SELECTION events
47 and use x_handle_selection_event.
48 (mark_kboards): Don't mark x and y of SELECTION_CLEAR_EVENT.
49
502004-11-05 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
51
52 * xselect.c (TRACE3): New debug macro.
53 (x_reply_selection_request): Use it.
54 (receive_incremental_selection): In call to TRACE0, the name of
55 a symbol is in xname.
56
572004-11-05 Kim F. Storm <storm@cua.dk>
58
59 * fontset.c (fontset_pattern_regexp): Use unsigned char.
60
612004-11-04 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
62
63 * fileio.c (Fnext_read_file_uses_dialog_p): New function.
64
65 * gtkutil.h: Declare use_old_gtk_file_dialog.
66
67 * gtkutil.c: Make use_old_gtk_file_dialog non-static.
68 (xg_initialize): Moved DEFVAR_BOOL for use_old_gtk_file_dialog ...
69 * xfns.c (syms_of_xfns): ... to here.
70
71 * gtkutil.c (xg_get_file_with_chooser): Expand DEFAULT_FILENAME if
72 it doesn't start with /.
73
742004-11-04 Kenichi Handa <handa@m17n.org>
75
76 * fontset.c (fontset_pattern_regexp): If '*' is preceded by '\',
77 treat it as a literal character.
78
792004-11-03 Kim F. Storm <storm@cua.dk>
80
81 * .gdbinit (ppt): New function.
82
832004-11-02 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
84
85 * xterm.c (x_window_to_scroll_bar): Only call
86 xg_get_scroll_id_for_window if toolkit scroll bars are used.
87
88 * gtkutil.c (xg_get_file_with_chooser): Use GTK_STOCK_OK instead
89 of save.
90
912004-11-02 Andreas Schwab <schwab@suse.de>
92
93 * window.c (Fscroll_right): Fix last change.
94
952004-11-02 Kim F. Storm <storm@cua.dk>
96
97 * Makefile.in (callproc.o): Depend on blockinput.h atimer.h systime.h.
98
992004-11-02 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
100
101 * callproc.c (Fcall_process): Block input around vfork.
102
1032004-11-02 Kim F. Storm <storm@cua.dk>
104
105 * eval.c (Fcalled_interactively_p): Rename from Fcall_interactive_p.
106 (syms_of_eval): Defsubr it.
107
1082004-11-02 Richard M. Stallman <rms@gnu.org>
109
110 * insdel.c (replace_range_2): New function.
111
112 * casefiddle.c (casify_region): Handle changes in byte-length
113 using replace_range_2.
114
115 * emacs.c (USAGE3): Delete --horizontal-scroll-bars, -hb.
116
117 * xdisp.c (back_to_previous_visible_line_start):
118 Subtract 1 from pos when checking previous newline for invisibility.
119
120 * window.c (window_scroll_pixel_based): Update preserve_y
121 for header line if any.
122 (Fscroll_left, Fscroll_right): Don't call interactive_p;
123 use a new second argument instead.
124
125 * eval.c (Fcall_interactive_p): New function.
126 (interactive_p): Don't test INTERACTIVE here.
127 (Finteractive_p): Doc fix.
128
129 * eval.c (Feval): Abort if INPUT_BLOCKED_P.
130
1312004-11-02 KOBAYASHI Yasuhiro <kobayays@otsukakj.co.jp>
132
133 * w32fns.c (w32_font_match): Use fast_string_match_ignore_case for
134 comparing font names.
135
1362004-11-02 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
137
138 * fileio.c (Fread_file_name): Pass Qt as fifth parameter to
139 Fx_file_dialog if only directories should be read.
140
141 * lisp.h: Fx_file_dialog takes 5 parameters.
142
143 * xfns.c (Fx_file_dialog): Both Motif and GTK version: Add
144 parameter only_dir_p.
145 In Motif version, don't put DEFAULT_FILENAME in filter part of the
146 dialog, just text field part. Do not add DEFAULT_FILENAME
147 to list of files if it isn't there.
148 In GTK version, pass only_dir_p parameter to xg_get_file_name.
149
150 * macfns.c (Fx_file_dialog): Add parameter only_dir_p. Check
151 only_dir_p instead of comparing prompt to "Dired". When using
152 a save dialog, add option kNavDontConfirmReplacement, change title
153 to "Enter name", change text for save button to "Ok".
154
155 * w32fns.c (Fx_file_dialog): Add parameter only_dir_p. Check
156 only_dir_p instead of comparing prompt to "Dired".
157
158 * gtkutil.c (xg_get_file_with_chooser)
159 (xg_get_file_with_selection): New functions, only defined ifdef
160 HAVE_GTK_FILE_CHOOSER_DIALOG_NEW and HAVE_GTK_FILE_SELECTION_NEW
161 respectively.
162 (xg_get_file_name): Add parameter only_dir_p.
163 Call xg_get_file_with_chooser or xg_get_file_with_selection
164 depending on HAVE_GTK_FILE* and the value of use_old_gtk_file_dialog.
165 (xg_initialize): New DEFVAR_BOOL use_old_gtk_file_dialog.
166
167 * gtkutil.h (xg_get_file_name): Add parameter only_dir_p.
168
169 * config.in: Rebuild (added HAVE_GTK_FILE_*).
170
1712004-11-01 Kim F. Storm <storm@cua.dk>
172
173 * process.c (connect_wait_mask, num_pending_connects): Only
174 declare and use them if NON_BLOCKING_CONNECT is defined.
175 (init_process): Initialize them if NON_BLOCKING_CONNECT defined.
176 (IF_NON_BLOCKING_CONNECT): New helper macro.
177 (wait_reading_process_output): Only declare and use local vars
178 Connecting and check_connect when NON_BLOCKING_CONNECT is defined.
179
1802004-11-01 Andy Petrusenco <Igrek@star-sw.com> (tiny change)
181
182 * w32term.c (x_scroll_run): Delete region objects after use.
183
1842004-10-31 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
185
186 * xmenu.c: Add prototypes for forward function declarations.
187 (popup_get_selection): Remove parameter do_timers, remove call to
188 timer_check.
189 (create_and_show_popup_menu, create_and_show_dialog): Remove
190 parameter do_timers from call to popup_get_selection.
191
192 * xdisp.c (update_tool_bar): Pass a copy of f->tool_bar_items to
193 tool_bar_items and assign the result to f->tool_bar_items if
194 not equal. Move BLOCK/UNBLOCK_INPUT from around call to
195 tool_bar_items to assignment of result.
196
197 * atimer.c (alarm_signal_handler): Do not call set_alarm if
198 pending_atmers is non-zero.
199
2002004-10-31 Kim F. Storm <storm@cua.dk>
201
202 * dispnew.c (margin_glyphs_to_reserve): Don't use ncols_scale_factor.
203
12004-10-28 Will <will@glozer.net> 2042004-10-28 Will <will@glozer.net>
2 205
3 * macterm.c: allow user to assign key modifiers to the Mac Option 206 * macterm.c: allow user to assign key modifiers to the Mac Option
@@ -387,7 +590,7 @@
387 compositions to encode. 590 compositions to encode.
388 (encode_coding_string): Likewise. Free composition data. 591 (encode_coding_string): Likewise. Free composition data.
389 592
3902004-09-30 Florian Weimer <fw@deneb.enyo.de> (tiny change) 5932004-09-30 Florian Weimer <fw@deneb.enyo.de>
391 594
392 * coding.c (code_convert_region): Free composition data. 595 * coding.c (code_convert_region): Free composition data.
393 596
@@ -961,7 +1164,7 @@
961 (Fsave_window_excursion, Fset_window_vscroll) 1164 (Fsave_window_excursion, Fset_window_vscroll)
962 (syms_of_window) <window-size-fixed>: Doc fixes. 1165 (syms_of_window) <window-size-fixed>: Doc fixes.
963 1166
9642004-07-19 KOBAYASHI Yasuhiro <kobayays@otsukakj.co.jp> (tiny change) 11672004-07-19 KOBAYASHI Yasuhiro <kobayays@otsukakj.co.jp>
965 1168
966 * w32fns.c (Fx_file_dialog): Use ENCODE_FILE instead of 1169 * w32fns.c (Fx_file_dialog): Use ENCODE_FILE instead of
967 ENCODE_SYSTEM for filenames. 1170 ENCODE_SYSTEM for filenames.
@@ -1020,7 +1223,7 @@
1020 1223
1021 * buffer.c (syms_of_buffer) <transient-mark-mode>: Doc fix. 1224 * buffer.c (syms_of_buffer) <transient-mark-mode>: Doc fix.
1022 1225
10232004-07-15 KOBAYASHI Yasuhiro <kobayays@otsukakj.co.jp> (tiny change) 12262004-07-15 KOBAYASHI Yasuhiro <kobayays@otsukakj.co.jp>
1024 1227
1025 * w32fns.c (Fx_file_dialog): Encode strings in system coding 1228 * w32fns.c (Fx_file_dialog): Encode strings in system coding
1026 system before passing them to OS functions for display. 1229 system before passing them to OS functions for display.
@@ -1684,7 +1887,7 @@
1684 before actually accepting connection in case it has already been 1887 before actually accepting connection in case it has already been
1685 accepted due to recursion. 1888 accepted due to recursion.
1686 1889
16872004-05-23 K,Ba(Broly L,Bu(Brentey <lorentey@elte.hu> (tiny change) 18902004-05-23 K,Ba(Broly L,Bu(Brentey <lorentey@elte.hu>
1688 1891
1689 * coding.c (Fset_safe_terminal_coding_system_internal): 1892 * coding.c (Fset_safe_terminal_coding_system_internal):
1690 Set suppress_error in safe_terminal_coding, not terminal_coding. 1893 Set suppress_error in safe_terminal_coding, not terminal_coding.
@@ -1998,7 +2201,7 @@
1998 * w32fns.c (Vw32_ansi_code_page): New Lisp variable. 2201 * w32fns.c (Vw32_ansi_code_page): New Lisp variable.
1999 (globals_of_w32fns): Set it. 2202 (globals_of_w32fns): Set it.
2000 2203
20012004-05-09 Piet van Oostrum <piet@cs.uu.nl> (tiny change) 22042004-05-09 Piet van Oostrum <piet@cs.uu.nl>
2002 2205
2003 * data.c (Fquo): Simplify. 2206 * data.c (Fquo): Simplify.
2004 2207
@@ -2047,7 +2250,7 @@
2047 2250
2048 * emacs.c (main) [VMS]: Fix var ref. 2251 * emacs.c (main) [VMS]: Fix var ref.
2049 2252
20502004-05-06 Romain Francoise <romain@orebokech.com> (tiny change) 22532004-05-06 Romain Francoise <romain@orebokech.com>
2051 2254
2052 * data.c (Fsetq_default): Fix docstring. 2255 * data.c (Fsetq_default): Fix docstring.
2053 2256
@@ -2087,7 +2290,7 @@
2087 2290
2088 * Makefile.in (region-cache.o): Depend on config.h. 2291 * Makefile.in (region-cache.o): Depend on config.h.
2089 2292
20902004-05-02 Romain Francoise <romain@orebokech.com> (tiny change) 22932004-05-02 Romain Francoise <romain@orebokech.com>
2091 2294
2092 * indent.c (compute_motion): Save vpos in prev_vpos when dealing 2295 * indent.c (compute_motion): Save vpos in prev_vpos when dealing
2093 with continuation lines, too. 2296 with continuation lines, too.
@@ -3330,7 +3533,7 @@
3330 entries that were used before we return. 3533 entries that were used before we return.
3331 (init_keyboard): Initialize read_avail_input_buf here. 3534 (init_keyboard): Initialize read_avail_input_buf here.
3332 3535
33332004-02-16 Jesper Harder <harder@ifa.au.dk> (tiny change) 35362004-02-16 Jesper Harder <harder@ifa.au.dk>
3334 3537
3335 * cmds.c (Fend_of_line): Doc fix. 3538 * cmds.c (Fend_of_line): Doc fix.
3336 3539
@@ -3998,7 +4201,7 @@
3998 to the definition of `signal' in the Elisp manual. 4201 to the definition of `signal' in the Elisp manual.
3999 * eval.c (Fsignal): Ditto. 4202 * eval.c (Fsignal): Ditto.
4000 4203
40012003-12-29 James Clark <jjc@jclark.com> (tiny change) 42042003-12-29 James Clark <jjc@jclark.com>
4002 4205
4003 * fns.c (internal_equal): Return t for two NaN arguments. 4206 * fns.c (internal_equal): Return t for two NaN arguments.
4004 4207
@@ -5058,7 +5261,7 @@
5058 * fileio.c (Fwrite_region): Fix conditional expression to issue 5261 * fileio.c (Fwrite_region): Fix conditional expression to issue
5059 the right message. 5262 the right message.
5060 5263
50612003-08-16 Juri Linkov <juri@jurta.org> (tiny change) 52642003-08-16 Juri Linkov <juri@jurta.org>
5062 5265
5063 * syntax.c (Fforward_word): Argument changed to optional. 5266 * syntax.c (Fforward_word): Argument changed to optional.
5064 Set default value to 1. 5267 Set default value to 1.
@@ -5117,7 +5320,7 @@
5117 * fns.c (Fclear_string): New function. 5320 * fns.c (Fclear_string): New function.
5118 (syms_of_fns): defsubr it. 5321 (syms_of_fns): defsubr it.
5119 5322
51202003-07-28 KOBAYASHI Yasuhiro <kobayays@otsukakj.co.jp> (tiny change) 53232003-07-28 KOBAYASHI Yasuhiro <kobayays@otsukakj.co.jp>
5121 5324
5122 * xfns.c (xic_set_preeditarea): Add the left fringe width to spot.x. 5325 * xfns.c (xic_set_preeditarea): Add the left fringe width to spot.x.
5123 5326
@@ -5345,7 +5548,7 @@
5345 5548
5346 * alloc.c (Fgarbage_collect): Doc fix. 5549 * alloc.c (Fgarbage_collect): Doc fix.
5347 5550
53482003-07-07 Nozomu Ando <nand@mac.com> (tiny change) 55512003-07-07 Nozomu Ando <nand@mac.com>
5349 5552
5350 * buffer.c (Fkill_buffer): Clear charpos cache if necessary. 5553 * buffer.c (Fkill_buffer): Clear charpos cache if necessary.
5351 5554
@@ -6555,7 +6758,7 @@
6555 * alloc.c (Fgarbage_collect): Cast pointers into specpdl 6758 * alloc.c (Fgarbage_collect): Cast pointers into specpdl
6556 to avoid GCC warning. 6759 to avoid GCC warning.
6557 6760
65582003-05-16 Ralph Schleicher <rs@nunatak.allgaeu.org> (tiny change) 67612003-05-16 Ralph Schleicher <rs@nunatak.allgaeu.org>
6559 6762
6560 * fileio.c (Fdelete_file): Handle symlinks pointing to directories. 6763 * fileio.c (Fdelete_file): Handle symlinks pointing to directories.
6561 6764
@@ -8278,7 +8481,7 @@
8278 (w32_init_class): Use it. 8481 (w32_init_class): Use it.
8279 (x_put_x_image): Declare all args. 8482 (x_put_x_image): Declare all args.
8280 8483
82812003-01-21 Richard Dawe <rich@phekda.freeserve.co.uk> (tiny change) 84842003-01-21 Richard Dawe <rich@phekda.freeserve.co.uk>
8282 8485
8283 * Makefile.in (ALL_CFLAGS): Include MYCPPFLAGS, not MYCPPFLAG. 8486 * Makefile.in (ALL_CFLAGS): Include MYCPPFLAGS, not MYCPPFLAG.
8284 8487
@@ -8650,7 +8853,7 @@
8650 in direct action cases for Qforward_char and Qbackward_char. 8853 in direct action cases for Qforward_char and Qbackward_char.
8651 Set already_adjusted so it won't be done twice. 8854 Set already_adjusted so it won't be done twice.
8652 8855
86532002-12-30 Richard Dawe <rich@phekda.freeserve.co.uk> (tiny change) 88562002-12-30 Richard Dawe <rich@phekda.freeserve.co.uk>
8654 8857
8655 * src/config.in (!HAVE_SIZE_T): Fix order of arguments in 8858 * src/config.in (!HAVE_SIZE_T): Fix order of arguments in
8656 type definition of size_t. 8859 type definition of size_t.
@@ -8748,7 +8951,7 @@
8748 * dired.c (file_name_completion): Fix that change. 8951 * dired.c (file_name_completion): Fix that change.
8749 Delete special quit-handling code; just use QUIT. 8952 Delete special quit-handling code; just use QUIT.
8750 8953
87512002-12-21 Tak Ota <Takaaki.Ota@am.sony.com> (tiny change) 89542002-12-21 Tak Ota <Takaaki.Ota@am.sony.com>
8752 8955
8753 * dired.c (file_name_completion): Close directory on error 8956 * dired.c (file_name_completion): Close directory on error
8754 just as in directory_files_internal. 8957 just as in directory_files_internal.
@@ -10088,8 +10291,8 @@
10088 10291
100892002-08-26 Kim F. Storm <storm@cua.dk> 102922002-08-26 Kim F. Storm <storm@cua.dk>
10090 10293
10091 * frame.c (make_terminal_frame) [CANNOT_DUMP]: Initialize foreground 10294 * frame.c (make_terminal_frame) [CANNOT_DUMP]: Initialize
10092 and background colors. From Joe Buehler (tiny change). 10295 foreground and background colors. From Joe Buehler.
10093 10296
100942002-08-26 Miles Bader <miles@gnu.org> 102972002-08-26 Miles Bader <miles@gnu.org>
10095 10298
diff --git a/src/Makefile.in b/src/Makefile.in
index 9d169cd4bdc..ebbc4f45d61 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -1056,7 +1056,7 @@ callint.o: callint.c window.h commands.h buffer.h keymap.h \
1056 keyboard.h dispextern.h $(config_h) 1056 keyboard.h dispextern.h $(config_h)
1057callproc.o: callproc.c epaths.h buffer.h commands.h $(config_h) \ 1057callproc.o: callproc.c epaths.h buffer.h commands.h $(config_h) \
1058 process.h systty.h syssignal.h charset.h coding.h ccl.h msdos.h \ 1058 process.h systty.h syssignal.h charset.h coding.h ccl.h msdos.h \
1059 composite.h 1059 composite.h w32.h blockinput.h atimer.h systime.h
1060casefiddle.o: casefiddle.c syntax.h commands.h buffer.h composite.h \ 1060casefiddle.o: casefiddle.c syntax.h commands.h buffer.h composite.h \
1061 charset.h keymap.h $(config_h) 1061 charset.h keymap.h $(config_h)
1062casetab.o: casetab.c buffer.h $(config_h) 1062casetab.o: casetab.c buffer.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 5d7447d94f2..e251fc65941 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"
@@ -624,6 +625,8 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
624 pid = child_setup (filefd, fd1, fd_error, (char **) new_argv, 625 pid = child_setup (filefd, fd1, fd_error, (char **) new_argv,
625 0, current_dir); 626 0, current_dir);
626#else /* not WINDOWSNT */ 627#else /* not WINDOWSNT */
628 BLOCK_INPUT;
629
627 pid = vfork (); 630 pid = vfork ();
628 631
629 if (pid == 0) 632 if (pid == 0)
@@ -641,6 +644,8 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
641 child_setup (filefd, fd1, fd_error, (char **) new_argv, 644 child_setup (filefd, fd1, fd_error, (char **) new_argv,
642 0, current_dir); 645 0, current_dir);
643 } 646 }
647
648 UNBLOCK_INPUT;
644#endif /* not WINDOWSNT */ 649#endif /* not WINDOWSNT */
645 650
646 /* The MSDOS case did this already. */ 651 /* The MSDOS case did this already. */
diff --git a/src/casefiddle.c b/src/casefiddle.c
index 51fc6444f49..ae4888088bd 100644
--- a/src/casefiddle.c
+++ b/src/casefiddle.c
@@ -235,6 +235,10 @@ casify_region (flag, b, e)
235 else if (!UPPERCASEP (c) 235 else if (!UPPERCASEP (c)
236 && (!inword || flag != CASE_CAPITALIZE_UP)) 236 && (!inword || flag != CASE_CAPITALIZE_UP))
237 c = UPCASE1 (c); 237 c = UPCASE1 (c);
238 if (multibyte && c >= 0x80)
239 /* A multibyte result character can't be handled in this
240 simple loop. */
241 break;
238 FETCH_BYTE (i) = c; 242 FETCH_BYTE (i) = c;
239 if (c != c2) 243 if (c != c2)
240 changed = 1; 244 changed = 1;
@@ -272,22 +276,17 @@ casify_region (flag, b, e)
272 tolen = CHAR_STRING (c2, str), 276 tolen = CHAR_STRING (c2, str),
273 fromlen == tolen) 277 fromlen == tolen)
274 { 278 {
279 /* Length is unchanged. */
275 for (j = 0; j < tolen; ++j) 280 for (j = 0; j < tolen; ++j)
276 FETCH_BYTE (i + j) = str[j]; 281 FETCH_BYTE (i + j) = str[j];
277 } 282 }
278 else 283 else
279 { 284 /* Replace one character with the other,
280 error ("Can't casify letters that change length"); 285 keeping text properties the same. */
281#if 0 /* This is approximately what we'd like to be able to do here */ 286 replace_range_2 (start + 1, i + tolen,
282 if (tolen < fromlen) 287 start + 2, i + tolen + fromlen,
283 del_range_1 (i + tolen, i + fromlen, 0, 0); 288 str, 1, tolen,
284 else if (tolen > fromlen) 289 0);
285 {
286 TEMP_SET_PT (i + fromlen);
287 insert_1 (str + fromlen, tolen - fromlen, 1, 0, 0);
288 }
289#endif
290 }
291 } 290 }
292 if ((int) flag >= (int) CASE_CAPITALIZE) 291 if ((int) flag >= (int) CASE_CAPITALIZE)
293 inword = SYNTAX (c2) == Sword; 292 inword = SYNTAX (c2) == Sword;
diff --git a/src/config.in b/src/config.in
index a559a35885f..a2087b98b1f 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 070c9648d1d..a148f27a1ef 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -566,7 +566,7 @@ margin_glyphs_to_reserve (w, total_glyphs, margin)
566 int width = XFASTINT (w->total_cols); 566 int width = XFASTINT (w->total_cols);
567 double d = max (0, XFLOATINT (margin)); 567 double d = max (0, XFLOATINT (margin));
568 d = min (width / 2 - 1, d); 568 d = min (width / 2 - 1, d);
569 n = (int) ((double) total_glyphs / width * d) * w->ncols_scale_factor; 569 n = (int) ((double) total_glyphs / width * d);
570 } 570 }
571 else 571 else
572 n = 0; 572 n = 0;
diff --git a/src/emacs.c b/src/emacs.c
index 96e858d943a..ab60df39e27 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -306,7 +306,6 @@ Display options:\n\
306--fullscreen, -fs make first frame fullscreen\n\ 306--fullscreen, -fs make first frame fullscreen\n\
307--fullwidth, -fw make the first frame wide as the screen\n\ 307--fullwidth, -fw make the first frame wide as the screen\n\
308--geometry, -g GEOMETRY window geometry\n\ 308--geometry, -g GEOMETRY window geometry\n\
309--horizontal-scroll-bars, -hb enable horizontal scroll bars\n\
310--icon-type, -i use picture of gnu for Emacs icon\n\ 309--icon-type, -i use picture of gnu for Emacs icon\n\
311--iconic start Emacs in iconified state\n\ 310--iconic start Emacs in iconified state\n\
312--internal-border, -ib WIDTH width between text and main border\n\ 311--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 ece909ea8b3..587f36d537d 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -3368,7 +3368,8 @@ This is the sort of file that holds an ordinary stream of data bytes. */)
3368} 3368}
3369 3369
3370DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0, 3370DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
3371 doc: /* Return mode bits of file named FILENAME, as an integer. */) 3371 doc: /* Return mode bits of file named FILENAME, as an integer.
3372Return nil, if file does not exist or is not accessible. */)
3372 (filename) 3373 (filename)
3373 Lisp_Object filename; 3374 Lisp_Object filename;
3374{ 3375{
@@ -5714,17 +5715,21 @@ Lisp_Object
5714auto_save_1 () 5715auto_save_1 ()
5715{ 5716{
5716 struct stat st; 5717 struct stat st;
5718 Lisp_Object modes;
5719
5720 auto_save_mode_bits = 0666;
5717 5721
5718 /* Get visited file's mode to become the auto save file's mode. */ 5722 /* Get visited file's mode to become the auto save file's mode. */
5719 if (! NILP (current_buffer->filename) 5723 if (! NILP (current_buffer->filename))
5720 && stat (SDATA (current_buffer->filename), &st) >= 0) 5724 {
5721 /* But make sure we can overwrite it later! */ 5725 if (stat (SDATA (current_buffer->filename), &st) >= 0)
5722 auto_save_mode_bits = st.st_mode | 0600; 5726 /* But make sure we can overwrite it later! */
5723 else if (! NILP (current_buffer->filename)) 5727 auto_save_mode_bits = st.st_mode | 0600;
5724 /* Remote files don't cooperate with stat. */ 5728 else if ((modes = Ffile_modes (current_buffer->filename),
5725 auto_save_mode_bits = XINT (Ffile_modes (current_buffer->filename)) | 0600; 5729 INTEGERP (modes)))
5726 else 5730 /* Remote files don't cooperate with stat. */
5727 auto_save_mode_bits = 0666; 5731 auto_save_mode_bits = XINT (modes) | 0600;
5732 }
5728 5733
5729 return 5734 return
5730 Fwrite_region (Qnil, Qnil, 5735 Fwrite_region (Qnil, Qnil,
@@ -6176,6 +6181,23 @@ DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_inte
6176 return Ffile_exists_p (string); 6181 return Ffile_exists_p (string);
6177} 6182}
6178 6183
6184DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p,
6185 Snext_read_file_uses_dialog_p, 0, 0, 0,
6186 doc: /* Return t if a call to `read-file-name' will use a dialog.
6187The return value is only relevant for a call to `read-file-name' that happens
6188before any other event (mouse or keypress) is handeled. */)
6189 ()
6190{
6191#if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (TARGET_API_MAC_CARBON)
6192 if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
6193 && use_dialog_box
6194 && use_file_dialog
6195 && have_menus_p ())
6196 return Qt;
6197#endif
6198 return Qnil;
6199}
6200
6179DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 6, 0, 6201DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 6, 0,
6180 doc: /* Read file name, prompting with PROMPT and completing in directory DIR. 6202 doc: /* Read file name, prompting with PROMPT and completing in directory DIR.
6181Value is not expanded---you must call `expand-file-name' yourself. 6203Value is not expanded---you must call `expand-file-name' yourself.
@@ -6308,10 +6330,7 @@ and `read-file-name-function'. */)
6308 GCPRO2 (insdef, default_filename); 6330 GCPRO2 (insdef, default_filename);
6309 6331
6310#if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (TARGET_API_MAC_CARBON) 6332#if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (TARGET_API_MAC_CARBON)
6311 if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event)) 6333 if (! NILP (Fnext_read_file_uses_dialog_p ()))
6312 && use_dialog_box
6313 && use_file_dialog
6314 && have_menus_p ())
6315 { 6334 {
6316 /* If DIR contains a file name, split it. */ 6335 /* If DIR contains a file name, split it. */
6317 Lisp_Object file; 6336 Lisp_Object file;
@@ -6323,7 +6342,8 @@ and `read-file-name-function'. */)
6323 } 6342 }
6324 if (!NILP(default_filename)) 6343 if (!NILP(default_filename))
6325 default_filename = Fexpand_file_name (default_filename, dir); 6344 default_filename = Fexpand_file_name (default_filename, dir);
6326 val = Fx_file_dialog (prompt, dir, default_filename, mustmatch); 6345 val = Fx_file_dialog (prompt, dir, default_filename, mustmatch,
6346 EQ (predicate, Qfile_directory_p) ? Qt : Qnil);
6327 add_to_history = 1; 6347 add_to_history = 1;
6328 } 6348 }
6329 else 6349 else
@@ -6695,6 +6715,7 @@ a non-nil value. */);
6695 6715
6696 defsubr (&Sread_file_name_internal); 6716 defsubr (&Sread_file_name_internal);
6697 defsubr (&Sread_file_name); 6717 defsubr (&Sread_file_name);
6718 defsubr (&Snext_read_file_uses_dialog_p);
6698 6719
6699#ifdef unix 6720#ifdef unix
6700 defsubr (&Sunix_sync); 6721 defsubr (&Sunix_sync);
diff --git a/src/fontset.c b/src/fontset.c
index 0c50be2d21e..f370f2ae981 100644
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -790,14 +790,14 @@ fontset_pattern_regexp (pattern)
790 || strcmp (SDATA (pattern), CACHED_FONTSET_NAME)) 790 || strcmp (SDATA (pattern), CACHED_FONTSET_NAME))
791 { 791 {
792 /* We must at first update the cached data. */ 792 /* We must at first update the cached data. */
793 char *regex, *p0, *p1; 793 unsigned char *regex, *p0, *p1;
794 int ndashes = 0, nstars = 0; 794 int ndashes = 0, nstars = 0;
795 795
796 for (p0 = SDATA (pattern); *p0; p0++) 796 for (p0 = SDATA (pattern); *p0; p0++)
797 { 797 {
798 if (*p0 == '-') 798 if (*p0 == '-')
799 ndashes++; 799 ndashes++;
800 else if (*p0 == '*') 800 else if (*p0 == '*' && p0 > SDATA (pattern) && p0[-1] != '\\')
801 nstars++; 801 nstars++;
802 } 802 }
803 803
@@ -805,14 +805,14 @@ fontset_pattern_regexp (pattern)
805 we convert "*" to "[^-]*" which is much faster in regular 805 we convert "*" to "[^-]*" which is much faster in regular
806 expression matching. */ 806 expression matching. */
807 if (ndashes < 14) 807 if (ndashes < 14)
808 p1 = regex = (char *) alloca (SBYTES (pattern) + 2 * nstars + 1); 808 p1 = regex = (unsigned char *) alloca (SBYTES (pattern) + 2 * nstars + 1);
809 else 809 else
810 p1 = regex = (char *) alloca (SBYTES (pattern) + 5 * nstars + 1); 810 p1 = regex = (unsigned char *) alloca (SBYTES (pattern) + 5 * nstars + 1);
811 811
812 *p1++ = '^'; 812 *p1++ = '^';
813 for (p0 = (char *) SDATA (pattern); *p0; p0++) 813 for (p0 = SDATA (pattern); *p0; p0++)
814 { 814 {
815 if (*p0 == '*') 815 if (*p0 == '*' && p0 > SDATA (pattern) && p0[-1] != '\\')
816 { 816 {
817 if (ndashes < 14) 817 if (ndashes < 14)
818 *p1++ = '.'; 818 *p1++ = '.';
diff --git a/src/gtkutil.c b/src/gtkutil.c
index dc091c1a09b..f5f05709e48 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,85 @@ enum
1126 XG_FILE_DESTROYED, 1130 XG_FILE_DESTROYED,
1127}; 1131};
1128 1132
1133#ifdef HAVE_GTK_FILE_BOTH
1134int 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 {
1182 Lisp_Object file;
1183 struct gcpro gcpro1;
1184 GCPRO1 (file);
1185
1186 /* File chooser does not understand ~/... in the file name. It must be
1187 an absolute name starting with /. */
1188 if (default_filename[0] != '/')
1189 {
1190 file = Fexpand_file_name (build_string (default_filename), Qnil);
1191 default_filename = SDATA (file);
1192 }
1193
1194 gtk_file_chooser_set_filename (GTK_FILE_CHOOSER (filewin),
1195 default_filename);
1196
1197 UNGCPRO;
1198 }
1199
1200 gtk_widget_show (filewin);
1201
1202 if (gtk_dialog_run (GTK_DIALOG (filewin)) == GTK_RESPONSE_OK)
1203 fn = gtk_file_chooser_get_filename (GTK_FILE_CHOOSER (filewin));
1204
1205 gtk_widget_destroy (filewin);
1206
1207 return fn;
1208}
1209#endif /* HAVE_GTK_FILE_CHOOSER_DIALOG_NEW */
1210
1211#ifdef HAVE_GTK_FILE_SELECTION_NEW
1129/* Callback function invoked when the Ok button is pressed in 1212/* Callback function invoked when the Ok button is pressed in
1130 a file dialog. 1213 a file dialog.
1131 W is the file dialog widget, 1214 W is the file dialog widget,
@@ -1167,7 +1250,7 @@ xg_file_sel_destroy (w, arg)
1167 *(int*)arg = XG_FILE_DESTROYED; 1250 *(int*)arg = XG_FILE_DESTROYED;
1168} 1251}
1169 1252
1170/* Read a file name from the user using a file dialog. 1253/* Read a file name from the user using a file selection dialog.
1171 F is the current frame. 1254 F is the current frame.
1172 PROMPT is a prompt to show to the user. May not be NULL. 1255 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. 1256 DEFAULT_FILENAME is a default selection to be displayed. May be NULL.
@@ -1177,12 +1260,13 @@ xg_file_sel_destroy (w, arg)
1177 Returns a file name or NULL if no file was selected. 1260 Returns a file name or NULL if no file was selected.
1178 The returned string must be freed by the caller. */ 1261 The returned string must be freed by the caller. */
1179 1262
1180char * 1263static char *
1181xg_get_file_name (f, prompt, default_filename, mustmatch_p) 1264xg_get_file_with_selection (f, prompt, default_filename,
1265 mustmatch_p, only_dir_p)
1182 FRAME_PTR f; 1266 FRAME_PTR f;
1183 char *prompt; 1267 char *prompt;
1184 char *default_filename; 1268 char *default_filename;
1185 int mustmatch_p; 1269 int mustmatch_p, only_dir_p;
1186{ 1270{
1187 GtkWidget *filewin; 1271 GtkWidget *filewin;
1188 GtkFileSelection *filesel; 1272 GtkFileSelection *filesel;
@@ -1193,9 +1277,7 @@ xg_get_file_name (f, prompt, default_filename, mustmatch_p)
1193 filesel = GTK_FILE_SELECTION (filewin); 1277 filesel = GTK_FILE_SELECTION (filewin);
1194 1278
1195 xg_set_screen (filewin, f); 1279 xg_set_screen (filewin, f);
1196
1197 gtk_widget_set_name (filewin, "emacs-filedialog"); 1280 gtk_widget_set_name (filewin, "emacs-filedialog");
1198
1199 gtk_window_set_transient_for (GTK_WINDOW (filewin), 1281 gtk_window_set_transient_for (GTK_WINDOW (filewin),
1200 GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f))); 1282 GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)));
1201 gtk_window_set_destroy_with_parent (GTK_WINDOW (filewin), TRUE); 1283 gtk_window_set_destroy_with_parent (GTK_WINDOW (filewin), TRUE);
@@ -1237,6 +1319,49 @@ xg_get_file_name (f, prompt, default_filename, mustmatch_p)
1237 1319
1238 return fn; 1320 return fn;
1239} 1321}
1322#endif /* HAVE_GTK_FILE_SELECTION_NEW */
1323
1324/* Read a file name from the user using a file dialog, either the old
1325 file selection dialog, or the new file chooser dialog. Which to use
1326 depends on what the GTK version used has, and what the value of
1327 gtk-use-old-file-dialog.
1328 F is the current frame.
1329 PROMPT is a prompt to show to the user. May not be NULL.
1330 DEFAULT_FILENAME is a default selection to be displayed. May be NULL.
1331 If MUSTMATCH_P is non-zero, the returned file name must be an existing
1332 file.
1333
1334 Returns a file name or NULL if no file was selected.
1335 The returned string must be freed by the caller. */
1336
1337char *
1338xg_get_file_name (f, prompt, default_filename, mustmatch_p, only_dir_p)
1339 FRAME_PTR f;
1340 char *prompt;
1341 char *default_filename;
1342 int mustmatch_p, only_dir_p;
1343{
1344#ifdef HAVE_GTK_FILE_BOTH
1345 if (use_old_gtk_file_dialog)
1346 return xg_get_file_with_selection (f, prompt, default_filename,
1347 mustmatch_p, only_dir_p);
1348 return xg_get_file_with_chooser (f, prompt, default_filename,
1349 mustmatch_p, only_dir_p);
1350
1351#else /* not HAVE_GTK_FILE_BOTH */
1352
1353#ifdef HAVE_GTK_FILE_SELECTION_DIALOG_NEW
1354 return xg_get_file_with_selection (f, prompt, default_filename,
1355 mustmatch_p, only_dir_p);
1356#endif
1357#ifdef HAVE_GTK_FILE_CHOOSER_DIALOG_NEW
1358 return xg_get_file_with_chooser (f, prompt, default_filename,
1359 mustmatch_p, only_dir_p);
1360#endif
1361
1362#endif /* HAVE_GTK_FILE_BOTH */
1363 return 0;
1364}
1240 1365
1241 1366
1242/*********************************************************************** 1367/***********************************************************************
diff --git a/src/gtkutil.h b/src/gtkutil.h
index c0055f361cc..44e82885d7f 100644
--- a/src/gtkutil.h
+++ b/src/gtkutil.h
@@ -126,13 +126,18 @@ typedef struct _widget_value
126 struct _widget_value *free_list; 126 struct _widget_value *free_list;
127} widget_value; 127} widget_value;
128 128
129#ifdef HAVE_GTK_FILE_BOTH
130extern int use_old_gtk_file_dialog;
131#endif
132
129extern widget_value *malloc_widget_value P_ ((void)); 133extern widget_value *malloc_widget_value P_ ((void));
130extern void free_widget_value P_ ((widget_value *)); 134extern void free_widget_value P_ ((widget_value *));
131 135
132extern char *xg_get_file_name P_ ((FRAME_PTR f, 136extern char *xg_get_file_name P_ ((FRAME_PTR f,
133 char *prompt, 137 char *prompt,
134 char *default_filename, 138 char *default_filename,
135 int mustmatch_p)); 139 int mustmatch_p,
140 int only_dir_p));
136 141
137extern GtkWidget *xg_create_widget P_ ((char *type, 142extern GtkWidget *xg_create_widget P_ ((char *type,
138 char *name, 143 char *name,
diff --git a/src/insdel.c b/src/insdel.c
index ffe7006a45b..f5f56f0371f 100644
--- a/src/insdel.c
+++ b/src/insdel.c
@@ -1464,7 +1464,7 @@ adjust_after_insert (from, from_byte, to, to_byte, newlen)
1464 Z -= len; Z_BYTE -= len_byte; 1464 Z -= len; Z_BYTE -= len_byte;
1465 adjust_after_replace (from, from_byte, Qnil, newlen, len_byte); 1465 adjust_after_replace (from, from_byte, Qnil, newlen, len_byte);
1466} 1466}
1467 1467
1468/* Replace the text from character positions FROM to TO with NEW, 1468/* Replace the text from character positions FROM to TO with NEW,
1469 If PREPARE is nonzero, call prepare_to_modify_buffer. 1469 If PREPARE is nonzero, call prepare_to_modify_buffer.
1470 If INHERIT, the newly inserted text should inherit text properties 1470 If INHERIT, the newly inserted text should inherit text properties
@@ -1641,6 +1641,122 @@ replace_range (from, to, new, prepare, inherit, markers)
1641 update_compositions (from, GPT, CHECK_BORDER); 1641 update_compositions (from, GPT, CHECK_BORDER);
1642} 1642}
1643 1643
1644/* Replace the text from character positions FROM to TO with
1645 the text in INS of length INSCHARS.
1646 Keep the text properties that applied to the old characters
1647 (extending them to all the new chars if there are more new chars).
1648
1649 Note that this does not yet handle markers quite right.
1650
1651 If MARKERS is nonzero, relocate markers.
1652
1653 Unlike most functions at this level, never call
1654 prepare_to_modify_buffer and never call signal_after_change. */
1655
1656void
1657replace_range_2 (from, from_byte, to, to_byte, ins, inschars, insbytes, markers)
1658 int from, from_byte, to, to_byte;
1659 char *ins;
1660 int inschars, insbytes, markers;
1661{
1662 int nbytes_del, nchars_del;
1663 Lisp_Object temp;
1664
1665 CHECK_MARKERS ();
1666
1667 nchars_del = to - from;
1668 nbytes_del = to_byte - from_byte;
1669
1670 if (nbytes_del <= 0 && insbytes == 0)
1671 return;
1672
1673 /* Make sure point-max won't overflow after this insertion. */
1674 XSETINT (temp, Z_BYTE - nbytes_del + insbytes);
1675 if (Z_BYTE - nbytes_del + insbytes != XINT (temp))
1676 error ("Maximum buffer size exceeded");
1677
1678 /* Make sure the gap is somewhere in or next to what we are deleting. */
1679 if (from > GPT)
1680 gap_right (from, from_byte);
1681 if (to < GPT)
1682 gap_left (to, to_byte, 0);
1683
1684 GAP_SIZE += nbytes_del;
1685 ZV -= nchars_del;
1686 Z -= nchars_del;
1687 ZV_BYTE -= nbytes_del;
1688 Z_BYTE -= nbytes_del;
1689 GPT = from;
1690 GPT_BYTE = from_byte;
1691 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
1692
1693 if (GPT_BYTE < GPT)
1694 abort ();
1695
1696 if (GPT - BEG < BEG_UNCHANGED)
1697 BEG_UNCHANGED = GPT - BEG;
1698 if (Z - GPT < END_UNCHANGED)
1699 END_UNCHANGED = Z - GPT;
1700
1701 if (GAP_SIZE < insbytes)
1702 make_gap (insbytes - GAP_SIZE);
1703
1704 /* Copy the replacement text into the buffer. */
1705 bcopy (ins, GPT_ADDR, insbytes);
1706
1707#ifdef BYTE_COMBINING_DEBUG
1708 /* We have copied text into the gap, but we have not marked
1709 it as part of the buffer. So we can use the old FROM and FROM_BYTE
1710 here, for both the previous text and the following text.
1711 Meanwhile, GPT_ADDR does point to
1712 the text that has been stored by copy_text. */
1713 if (count_combining_before (GPT_ADDR, insbytes, from, from_byte)
1714 || count_combining_after (GPT_ADDR, insbytes, from, from_byte))
1715 abort ();
1716#endif
1717
1718 GAP_SIZE -= insbytes;
1719 GPT += inschars;
1720 ZV += inschars;
1721 Z += inschars;
1722 GPT_BYTE += insbytes;
1723 ZV_BYTE += insbytes;
1724 Z_BYTE += insbytes;
1725 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
1726
1727 if (GPT_BYTE < GPT)
1728 abort ();
1729
1730 /* Adjust the overlay center as needed. This must be done after
1731 adjusting the markers that bound the overlays. */
1732 if (nchars_del != inschars)
1733 {
1734 adjust_overlays_for_insert (from, inschars);
1735 adjust_overlays_for_delete (from + inschars, nchars_del);
1736 }
1737
1738 /* Adjust markers for the deletion and the insertion. */
1739 if (markers
1740 && ! (nchars_del == 1 && inschars == 1))
1741 adjust_markers_for_replace (from, from_byte, nchars_del, nbytes_del,
1742 inschars, insbytes);
1743
1744 offset_intervals (current_buffer, from, inschars - nchars_del);
1745
1746 /* Relocate point as if it were a marker. */
1747 if (from < PT && nchars_del != inschars)
1748 adjust_point ((from + inschars - (PT < to ? PT : to)),
1749 (from_byte + insbytes
1750 - (PT_BYTE < to_byte ? PT_BYTE : to_byte)));
1751
1752 if (insbytes == 0)
1753 evaporate_overlays (from);
1754
1755 CHECK_MARKERS ();
1756
1757 MODIFF++;
1758}
1759
1644/* Delete characters in current buffer 1760/* Delete characters in current buffer
1645 from FROM up to (but not including) TO. 1761 from FROM up to (but not including) TO.
1646 If TO comes before FROM, we delete nothing. */ 1762 If TO comes before FROM, we delete nothing. */
diff --git a/src/keyboard.c b/src/keyboard.c
index 475479b66a3..35bfd1402c9 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -3694,36 +3694,26 @@ kbd_buffer_store_event_hold (event, hold_quit)
3694 Discard the event if it would fill the last slot. */ 3694 Discard the event if it would fill the last slot. */
3695 if (kbd_fetch_ptr - 1 != kbd_store_ptr) 3695 if (kbd_fetch_ptr - 1 != kbd_store_ptr)
3696 { 3696 {
3697 *kbd_store_ptr = *event;
3698 ++kbd_store_ptr;
3699 }
3700}
3697 3701
3698#if 0 /* The SELECTION_REQUEST_EVENT case looks bogus, and it's error
3699 prone to assign individual members for other events, in case
3700 the input_event structure is changed. --2000-07-13, gerd. */
3701 struct input_event *sp = kbd_store_ptr;
3702 sp->kind = event->kind;
3703 if (event->kind == SELECTION_REQUEST_EVENT)
3704 {
3705 /* We must not use the ordinary copying code for this case,
3706 since `part' is an enum and copying it might not copy enough
3707 in this case. */
3708 bcopy (event, (char *) sp, sizeof (*event));
3709 }
3710 else
3711 3702
3712 { 3703/* Put an input event back in the head of the event queue. */
3713 sp->code = event->code;
3714 sp->part = event->part;
3715 sp->frame_or_window = event->frame_or_window;
3716 sp->arg = event->arg;
3717 sp->modifiers = event->modifiers;
3718 sp->x = event->x;
3719 sp->y = event->y;
3720 sp->timestamp = event->timestamp;
3721 }
3722#else
3723 *kbd_store_ptr = *event;
3724#endif
3725 3704
3726 ++kbd_store_ptr; 3705void
3706kbd_buffer_unget_event (event)
3707 register struct input_event *event;
3708{
3709 if (kbd_fetch_ptr == kbd_buffer)
3710 kbd_fetch_ptr = kbd_buffer + KBD_BUFFER_SIZE;
3711
3712 /* Don't let the very last slot in the buffer become full, */
3713 if (kbd_fetch_ptr - 1 != kbd_store_ptr)
3714 {
3715 --kbd_fetch_ptr;
3716 *kbd_fetch_ptr = *event;
3727 } 3717 }
3728} 3718}
3729 3719
@@ -3938,7 +3928,8 @@ kbd_buffer_get_event (kbp, used_mouse_menu)
3938 /* These two kinds of events get special handling 3928 /* These two kinds of events get special handling
3939 and don't actually appear to the command loop. 3929 and don't actually appear to the command loop.
3940 We return nil for them. */ 3930 We return nil for them. */
3941 if (event->kind == SELECTION_REQUEST_EVENT) 3931 if (event->kind == SELECTION_REQUEST_EVENT
3932 || event->kind == SELECTION_CLEAR_EVENT)
3942 { 3933 {
3943#ifdef HAVE_X11 3934#ifdef HAVE_X11
3944 struct input_event copy; 3935 struct input_event copy;
@@ -3949,7 +3940,7 @@ kbd_buffer_get_event (kbp, used_mouse_menu)
3949 copy = *event; 3940 copy = *event;
3950 kbd_fetch_ptr = event + 1; 3941 kbd_fetch_ptr = event + 1;
3951 input_pending = readable_events (0); 3942 input_pending = readable_events (0);
3952 x_handle_selection_request (&copy); 3943 x_handle_selection_event (&copy);
3953#else 3944#else
3954 /* We're getting selection request events, but we don't have 3945 /* We're getting selection request events, but we don't have
3955 a window system. */ 3946 a window system. */
@@ -3957,22 +3948,6 @@ kbd_buffer_get_event (kbp, used_mouse_menu)
3957#endif 3948#endif
3958 } 3949 }
3959 3950
3960 else if (event->kind == SELECTION_CLEAR_EVENT)
3961 {
3962#ifdef HAVE_X11
3963 struct input_event copy;
3964
3965 /* Remove it from the buffer before processing it. */
3966 copy = *event;
3967 kbd_fetch_ptr = event + 1;
3968 input_pending = readable_events (0);
3969 x_handle_selection_clear (&copy);
3970#else
3971 /* We're getting selection request events, but we don't have
3972 a window system. */
3973 abort ();
3974#endif
3975 }
3976#if defined (HAVE_X11) || defined (HAVE_NTGUI) || defined (MAC_OS) 3951#if defined (HAVE_X11) || defined (HAVE_NTGUI) || defined (MAC_OS)
3977 else if (event->kind == DELETE_WINDOW_EVENT) 3952 else if (event->kind == DELETE_WINDOW_EVENT)
3978 { 3953 {
@@ -4201,7 +4176,8 @@ swallow_events (do_display)
4201 4176
4202 /* These two kinds of events get special handling 4177 /* These two kinds of events get special handling
4203 and don't actually appear to the command loop. */ 4178 and don't actually appear to the command loop. */
4204 if (event->kind == SELECTION_REQUEST_EVENT) 4179 if (event->kind == SELECTION_REQUEST_EVENT
4180 || event->kind == SELECTION_CLEAR_EVENT)
4205 { 4181 {
4206#ifdef HAVE_X11 4182#ifdef HAVE_X11
4207 struct input_event copy; 4183 struct input_event copy;
@@ -4212,25 +4188,7 @@ swallow_events (do_display)
4212 copy = *event; 4188 copy = *event;
4213 kbd_fetch_ptr = event + 1; 4189 kbd_fetch_ptr = event + 1;
4214 input_pending = readable_events (0); 4190 input_pending = readable_events (0);
4215 x_handle_selection_request (&copy); 4191 x_handle_selection_event (&copy);
4216#else
4217 /* We're getting selection request events, but we don't have
4218 a window system. */
4219 abort ();
4220#endif
4221 }
4222
4223 else if (event->kind == SELECTION_CLEAR_EVENT)
4224 {
4225#ifdef HAVE_X11
4226 struct input_event copy;
4227
4228 /* Remove it from the buffer before processing it, */
4229 copy = *event;
4230
4231 kbd_fetch_ptr = event + 1;
4232 input_pending = readable_events (0);
4233 x_handle_selection_clear (&copy);
4234#else 4192#else
4235 /* We're getting selection request events, but we don't have 4193 /* We're getting selection request events, but we don't have
4236 a window system. */ 4194 a window system. */
@@ -11590,7 +11548,8 @@ mark_kboards ()
11590 { 11548 {
11591 if (event == kbd_buffer + KBD_BUFFER_SIZE) 11549 if (event == kbd_buffer + KBD_BUFFER_SIZE)
11592 event = kbd_buffer; 11550 event = kbd_buffer;
11593 if (event->kind != SELECTION_REQUEST_EVENT) 11551 if (event->kind != SELECTION_REQUEST_EVENT
11552 && event->kind != SELECTION_CLEAR_EVENT)
11594 { 11553 {
11595 mark_object (event->x); 11554 mark_object (event->x);
11596 mark_object (event->y); 11555 mark_object (event->y);
diff --git a/src/keyboard.h b/src/keyboard.h
index 3039f028bbb..8ff1543d92e 100644
--- a/src/keyboard.h
+++ b/src/keyboard.h
@@ -330,6 +330,7 @@ extern int lucid_event_type_list_p P_ ((Lisp_Object));
330extern void kbd_buffer_store_event P_ ((struct input_event *)); 330extern void kbd_buffer_store_event P_ ((struct input_event *));
331extern void kbd_buffer_store_event_hold P_ ((struct input_event *, 331extern void kbd_buffer_store_event_hold P_ ((struct input_event *,
332 struct input_event *)); 332 struct input_event *));
333extern void kbd_buffer_unget_event P_ ((struct input_event *));
333#ifdef POLL_FOR_INPUT 334#ifdef POLL_FOR_INPUT
334extern void poll_for_input_1 P_ ((void)); 335extern void poll_for_input_1 P_ ((void));
335#endif 336#endif
diff --git a/src/lisp.h b/src/lisp.h
index 55664cb8ca3..7b9b0427da6 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3123,7 +3123,7 @@ extern void syms_of_xfns P_ ((void));
3123#ifdef HAVE_WINDOW_SYSTEM 3123#ifdef HAVE_WINDOW_SYSTEM
3124/* Defined in xfns.c, w32fns.c, or macfns.c */ 3124/* Defined in xfns.c, w32fns.c, or macfns.c */
3125EXFUN (Fxw_display_color_p, 1); 3125EXFUN (Fxw_display_color_p, 1);
3126EXFUN (Fx_file_dialog, 4); 3126EXFUN (Fx_file_dialog, 5);
3127#endif /* HAVE_WINDOW_SYSTEM */ 3127#endif /* HAVE_WINDOW_SYSTEM */
3128 3128
3129/* Defined in xsmfns.c */ 3129/* 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/process.c b/src/process.c
index 9638c2875da..db6e85c0fb3 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
@@ -3672,12 +3678,14 @@ deactivate_process (proc)
3672 chan_process[inchannel] = Qnil; 3678 chan_process[inchannel] = Qnil;
3673 FD_CLR (inchannel, &input_wait_mask); 3679 FD_CLR (inchannel, &input_wait_mask);
3674 FD_CLR (inchannel, &non_keyboard_wait_mask); 3680 FD_CLR (inchannel, &non_keyboard_wait_mask);
3681#ifdef NON_BLOCKING_CONNECT
3675 if (FD_ISSET (inchannel, &connect_wait_mask)) 3682 if (FD_ISSET (inchannel, &connect_wait_mask))
3676 { 3683 {
3677 FD_CLR (inchannel, &connect_wait_mask); 3684 FD_CLR (inchannel, &connect_wait_mask);
3678 if (--num_pending_connects < 0) 3685 if (--num_pending_connects < 0)
3679 abort (); 3686 abort ();
3680 } 3687 }
3688#endif
3681 if (inchannel == max_process_desc) 3689 if (inchannel == max_process_desc)
3682 { 3690 {
3683 int i; 3691 int i;
@@ -4038,8 +4046,11 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
4038{ 4046{
4039 register int channel, nfds; 4047 register int channel, nfds;
4040 SELECT_TYPE Available; 4048 SELECT_TYPE Available;
4049#ifdef NON_BLOCKING_CONNECT
4041 SELECT_TYPE Connecting; 4050 SELECT_TYPE Connecting;
4042 int check_connect, check_delay, no_avail; 4051 int check_connect;
4052#endif
4053 int check_delay, no_avail;
4043 int xerrno; 4054 int xerrno;
4044 Lisp_Object proc; 4055 Lisp_Object proc;
4045 EMACS_TIME timeout, end_time; 4056 EMACS_TIME timeout, end_time;
@@ -4050,7 +4061,9 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
4050 int saved_waiting_for_user_input_p = waiting_for_user_input_p; 4061 int saved_waiting_for_user_input_p = waiting_for_user_input_p;
4051 4062
4052 FD_ZERO (&Available); 4063 FD_ZERO (&Available);
4064#ifdef NON_BLOCKING_CONNECT
4053 FD_ZERO (&Connecting); 4065 FD_ZERO (&Connecting);
4066#endif
4054 4067
4055 /* If wait_proc is a process to watch, set wait_channel accordingly. */ 4068 /* If wait_proc is a process to watch, set wait_channel accordingly. */
4056 if (wait_proc != NULL) 4069 if (wait_proc != NULL)
@@ -4187,7 +4200,10 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
4187 timeout to get our attention. */ 4200 timeout to get our attention. */
4188 if (update_tick != process_tick && do_display) 4201 if (update_tick != process_tick && do_display)
4189 { 4202 {
4190 SELECT_TYPE Atemp, Ctemp; 4203 SELECT_TYPE Atemp;
4204#ifdef NON_BLOCKING_CONNECT
4205 SELECT_TYPE Ctemp;
4206#endif
4191 4207
4192 Atemp = input_wait_mask; 4208 Atemp = input_wait_mask;
4193#if 0 4209#if 0
@@ -4199,11 +4215,16 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
4199 */ 4215 */
4200 FD_CLR (0, &Atemp); 4216 FD_CLR (0, &Atemp);
4201#endif 4217#endif
4202 Ctemp = connect_wait_mask; 4218 IF_NON_BLOCKING_CONNECT (Ctemp = connect_wait_mask);
4219
4203 EMACS_SET_SECS_USECS (timeout, 0, 0); 4220 EMACS_SET_SECS_USECS (timeout, 0, 0);
4204 if ((select (max (max_process_desc, max_keyboard_desc) + 1, 4221 if ((select (max (max_process_desc, max_keyboard_desc) + 1,
4205 &Atemp, 4222 &Atemp,
4223#ifdef NON_BLOCKING_CONNECT
4206 (num_pending_connects > 0 ? &Ctemp : (SELECT_TYPE *)0), 4224 (num_pending_connects > 0 ? &Ctemp : (SELECT_TYPE *)0),
4225#else
4226 (SELECT_TYPE *)0,
4227#endif
4207 (SELECT_TYPE *)0, &timeout) 4228 (SELECT_TYPE *)0, &timeout)
4208 <= 0)) 4229 <= 0))
4209 { 4230 {
@@ -4263,12 +4284,14 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
4263 if (XINT (wait_proc->infd) < 0) /* Terminated */ 4284 if (XINT (wait_proc->infd) < 0) /* Terminated */
4264 break; 4285 break;
4265 FD_SET (XINT (wait_proc->infd), &Available); 4286 FD_SET (XINT (wait_proc->infd), &Available);
4266 check_connect = check_delay = 0; 4287 check_delay = 0;
4288 IF_NON_BLOCKING_CONNECT (check_connect = 0);
4267 } 4289 }
4268 else if (!NILP (wait_for_cell)) 4290 else if (!NILP (wait_for_cell))
4269 { 4291 {
4270 Available = non_process_wait_mask; 4292 Available = non_process_wait_mask;
4271 check_connect = check_delay = 0; 4293 check_delay = 0;
4294 IF_NON_BLOCKING_CONNECT (check_connect = 0);
4272 } 4295 }
4273 else 4296 else
4274 { 4297 {
@@ -4276,7 +4299,7 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
4276 Available = non_keyboard_wait_mask; 4299 Available = non_keyboard_wait_mask;
4277 else 4300 else
4278 Available = input_wait_mask; 4301 Available = input_wait_mask;
4279 check_connect = (num_pending_connects > 0); 4302 IF_NON_BLOCKING_CONNECT (check_connect = (num_pending_connects > 0));
4280 check_delay = wait_channel >= 0 ? 0 : process_output_delay_count; 4303 check_delay = wait_channel >= 0 ? 0 : process_output_delay_count;
4281 } 4304 }
4282 4305
@@ -4301,8 +4324,10 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
4301 } 4324 }
4302 else 4325 else
4303 { 4326 {
4327#ifdef NON_BLOCKING_CONNECT
4304 if (check_connect) 4328 if (check_connect)
4305 Connecting = connect_wait_mask; 4329 Connecting = connect_wait_mask;
4330#endif
4306 4331
4307#ifdef ADAPTIVE_READ_BUFFERING 4332#ifdef ADAPTIVE_READ_BUFFERING
4308 if (process_output_skip && check_delay > 0) 4333 if (process_output_skip && check_delay > 0)
@@ -4333,7 +4358,11 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
4333 4358
4334 nfds = select (max (max_process_desc, max_keyboard_desc) + 1, 4359 nfds = select (max (max_process_desc, max_keyboard_desc) + 1,
4335 &Available, 4360 &Available,
4361#ifdef NON_BLOCKING_CONNECT
4336 (check_connect ? &Connecting : (SELECT_TYPE *)0), 4362 (check_connect ? &Connecting : (SELECT_TYPE *)0),
4363#else
4364 (SELECT_TYPE *)0,
4365#endif
4337 (SELECT_TYPE *)0, &timeout); 4366 (SELECT_TYPE *)0, &timeout);
4338 } 4367 }
4339 4368
@@ -4389,7 +4418,7 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
4389 if (no_avail) 4418 if (no_avail)
4390 { 4419 {
4391 FD_ZERO (&Available); 4420 FD_ZERO (&Available);
4392 check_connect = 0; 4421 IF_NON_BLOCKING_CONNECT (check_connect = 0);
4393 } 4422 }
4394 4423
4395#if defined(sun) && !defined(USG5_4) 4424#if defined(sun) && !defined(USG5_4)
@@ -6620,6 +6649,11 @@ init_process ()
6620 FD_ZERO (&non_process_wait_mask); 6649 FD_ZERO (&non_process_wait_mask);
6621 max_process_desc = 0; 6650 max_process_desc = 0;
6622 6651
6652#ifdef NON_BLOCKING_CONNECT
6653 FD_ZERO (&connect_wait_mask);
6654 num_pending_connects = 0;
6655#endif
6656
6623#ifdef ADAPTIVE_READ_BUFFERING 6657#ifdef ADAPTIVE_READ_BUFFERING
6624 process_output_delay_count = 0; 6658 process_output_delay_count = 0;
6625 process_output_skip = 0; 6659 process_output_skip = 0;
diff --git a/src/w32fns.c b/src/w32fns.c
index 38faa7c3199..08780e05b1f 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -5607,14 +5607,12 @@ w32_font_match (fontname, pattern)
5607 char * fontname; 5607 char * fontname;
5608 char * pattern; 5608 char * pattern;
5609{ 5609{
5610 char *font_name_copy;
5611 char *ptr; 5610 char *ptr;
5612 Lisp_Object encoded_font_name; 5611 char *font_name_copy;
5613 char *regex = alloca (strlen (pattern) * 2 + 3); 5612 char *regex = alloca (strlen (pattern) * 2 + 3);
5614 5613
5615 /* Convert fontname to unibyte for match. */ 5614 font_name_copy = alloca (strlen (fontname) + 1);
5616 encoded_font_name = string_make_unibyte (build_string (fontname)); 5615 strcpy (font_name_copy, fontname);
5617 font_name_copy = SDATA (encoded_font_name);
5618 5616
5619 ptr = regex; 5617 ptr = regex;
5620 *ptr++ = '^'; 5618 *ptr++ = '^';
@@ -5652,8 +5650,8 @@ w32_font_match (fontname, pattern)
5652 return FALSE; 5650 return FALSE;
5653 } 5651 }
5654 5652
5655 return (fast_c_string_match_ignore_case (build_string (regex), 5653 return (fast_string_match_ignore_case (build_string (regex),
5656 font_name_copy) >= 0); 5654 build_string(font_name_copy)) >= 0);
5657} 5655}
5658 5656
5659/* Callback functions, and a structure holding info they need, for 5657/* Callback functions, and a structure holding info they need, for
@@ -7742,23 +7740,24 @@ file_dialog_callback (hwnd, msg, wParam, lParam)
7742 return 0; 7740 return 0;
7743} 7741}
7744 7742
7745DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0, 7743DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0,
7746 doc: /* Read file name, prompting with PROMPT in directory DIR. 7744 doc: /* Read file name, prompting with PROMPT in directory DIR.
7747Use a file selection dialog. 7745Use a file selection dialog.
7748Select DEFAULT-FILENAME in the dialog's file selection box, if 7746Select DEFAULT-FILENAME in the dialog's file selection box, if
7749specified. Ensure that file exists if MUSTMATCH is non-nil. */) 7747specified. Ensure that file exists if MUSTMATCH is non-nil.
7750 (prompt, dir, default_filename, mustmatch) 7748If ONLY-DIR-P is non-nil, the user can only select directories. */)
7751 Lisp_Object prompt, dir, default_filename, mustmatch; 7749 (prompt, dir, default_filename, mustmatch, only_dir_p)
7750 Lisp_Object prompt, dir, default_filename, mustmatch, only_dir_p;
7752{ 7751{
7753 struct frame *f = SELECTED_FRAME (); 7752 struct frame *f = SELECTED_FRAME ();
7754 Lisp_Object file = Qnil; 7753 Lisp_Object file = Qnil;
7755 int count = SPECPDL_INDEX (); 7754 int count = SPECPDL_INDEX ();
7756 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; 7755 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
7757 char filename[MAX_PATH + 1]; 7756 char filename[MAX_PATH + 1];
7758 char init_dir[MAX_PATH + 1]; 7757 char init_dir[MAX_PATH + 1];
7759 int default_filter_index = 1; /* 1: All Files, 2: Directories only */ 7758 int default_filter_index = 1; /* 1: All Files, 2: Directories only */
7760 7759
7761 GCPRO5 (prompt, dir, default_filename, mustmatch, file); 7760 GCPRO6 (prompt, dir, default_filename, mustmatch, only_dir_p, file);
7762 CHECK_STRING (prompt); 7761 CHECK_STRING (prompt);
7763 CHECK_STRING (dir); 7762 CHECK_STRING (dir);
7764 7763
@@ -7806,10 +7805,7 @@ specified. Ensure that file exists if MUSTMATCH is non-nil. */)
7806 file_details.lpstrInitialDir = init_dir; 7805 file_details.lpstrInitialDir = init_dir;
7807 file_details.lpstrTitle = SDATA (prompt); 7806 file_details.lpstrTitle = SDATA (prompt);
7808 7807
7809 /* If prompt starts with Dired, default to directories only. */ 7808 if (! NILP (only_dir_p))
7810 /* A bit hacky, but there doesn't seem to be a better way to
7811 DTRT for dired. */
7812 if (strncmp (file_details.lpstrTitle, "Dired", 5) == 0)
7813 default_filter_index = 2; 7809 default_filter_index = 2;
7814 7810
7815 file_details.nFilterIndex = default_filter_index; 7811 file_details.nFilterIndex = default_filter_index;
diff --git a/src/w32term.c b/src/w32term.c
index 8db94ceb759..aa9c0b96e92 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -2763,9 +2763,13 @@ x_scroll_run (w, run)
2763 /* If the dirty region is not what we expected, redraw the entire frame. */ 2763 /* If the dirty region is not what we expected, redraw the entire frame. */
2764 if (!EqualRgn (combined, expect_dirty)) 2764 if (!EqualRgn (combined, expect_dirty))
2765 SET_FRAME_GARBAGED (f); 2765 SET_FRAME_GARBAGED (f);
2766
2767 DeleteObject (dirty);
2768 DeleteObject (combined);
2766 } 2769 }
2767 2770
2768 UNBLOCK_INPUT; 2771 UNBLOCK_INPUT;
2772 DeleteObject (expect_dirty);
2769} 2773}
2770 2774
2771 2775
diff --git a/src/window.c b/src/window.c
index 6b244ca5353..d9ac2eb62bd 100644
--- a/src/window.c
+++ b/src/window.c
@@ -4627,17 +4627,25 @@ window_scroll_pixel_based (window, n, whole, noerror)
4627 w->force_start = Qt; 4627 w->force_start = Qt;
4628 } 4628 }
4629 4629
4630 /* The rest of this function uses current_y in a nonstandard way,
4631 not including the height of the header line if any. */
4630 it.current_y = it.vpos = 0; 4632 it.current_y = it.vpos = 0;
4631 4633
4632 /* Preserve the screen position if we must. */ 4634 /* Preserve the screen position if we should. */
4633 if (preserve_y >= 0) 4635 if (preserve_y >= 0)
4634 { 4636 {
4637 /* If we have a header line, take account of it. */
4638 if (WINDOW_WANTS_HEADER_LINE_P (w))
4639 preserve_y -= CURRENT_HEADER_LINE_HEIGHT (w);
4640
4635 move_it_to (&it, -1, -1, preserve_y, -1, MOVE_TO_Y); 4641 move_it_to (&it, -1, -1, preserve_y, -1, MOVE_TO_Y);
4636 SET_PT_BOTH (IT_CHARPOS (it), IT_BYTEPOS (it)); 4642 SET_PT_BOTH (IT_CHARPOS (it), IT_BYTEPOS (it));
4637 } 4643 }
4638 else 4644 else
4639 { 4645 {
4640 /* Move PT out of scroll margins. */ 4646 /* Move PT out of scroll margins.
4647 This code wants current_y to be zero at the window start position
4648 even if there is a header line. */
4641 this_scroll_margin = max (0, scroll_margin); 4649 this_scroll_margin = max (0, scroll_margin);
4642 this_scroll_margin = min (this_scroll_margin, XFASTINT (w->total_lines) / 4); 4650 this_scroll_margin = min (this_scroll_margin, XFASTINT (w->total_lines) / 4);
4643 this_scroll_margin *= FRAME_LINE_HEIGHT (it.f); 4651 this_scroll_margin *= FRAME_LINE_HEIGHT (it.f);
@@ -4992,17 +5000,17 @@ specifies the window to scroll. This takes precedence over
4992 return Qnil; 5000 return Qnil;
4993} 5001}
4994 5002
4995DEFUN ("scroll-left", Fscroll_left, Sscroll_left, 0, 1, "P", 5003DEFUN ("scroll-left", Fscroll_left, Sscroll_left, 0, 2, "P\np",
4996 doc: /* Scroll selected window display ARG columns left. 5004 doc: /* Scroll selected window display ARG columns left.
4997Default for ARG is window width minus 2. 5005Default for ARG is window width minus 2.
4998Value is the total amount of leftward horizontal scrolling in 5006Value is the total amount of leftward horizontal scrolling in
4999effect after the change. 5007effect after the change.
5000If `automatic-hscrolling' is non-nil, the argument ARG modifies 5008If SET_MINIMUM is non-nil, the new scroll amount becomes the
5001a lower bound for automatic scrolling, i.e. automatic scrolling 5009lower bound for automatic scrolling, i.e. automatic scrolling
5002will not scroll a window to a column less than the value returned 5010will not scroll a window to a column less than the value returned
5003by this function. */) 5011by this function. This happens in an interactive call. */)
5004 (arg) 5012 (arg, set_minimum)
5005 register Lisp_Object arg; 5013 register Lisp_Object arg, set_minimum;
5006{ 5014{
5007 Lisp_Object result; 5015 Lisp_Object result;
5008 int hscroll; 5016 int hscroll;
@@ -5016,23 +5024,23 @@ by this function. */)
5016 hscroll = XINT (w->hscroll) + XINT (arg); 5024 hscroll = XINT (w->hscroll) + XINT (arg);
5017 result = Fset_window_hscroll (selected_window, make_number (hscroll)); 5025 result = Fset_window_hscroll (selected_window, make_number (hscroll));
5018 5026
5019 if (interactive_p (0)) 5027 if (!NILP (set_minimum))
5020 w->min_hscroll = w->hscroll; 5028 w->min_hscroll = w->hscroll;
5021 5029
5022 return result; 5030 return result;
5023} 5031}
5024 5032
5025DEFUN ("scroll-right", Fscroll_right, Sscroll_right, 0, 1, "P", 5033DEFUN ("scroll-right", Fscroll_right, Sscroll_right, 0, 2, "P\np",
5026 doc: /* Scroll selected window display ARG columns right. 5034 doc: /* Scroll selected window display ARG columns right.
5027Default for ARG is window width minus 2. 5035Default for ARG is window width minus 2.
5028Value is the total amount of leftward horizontal scrolling in 5036Value is the total amount of leftward horizontal scrolling in
5029effect after the change. 5037effect after the change.
5030If `automatic-hscrolling' is non-nil, the argument ARG modifies 5038If SET_MINIMUM is non-nil, the new scroll amount becomes the
5031a lower bound for automatic scrolling, i.e. automatic scrolling 5039lower bound for automatic scrolling, i.e. automatic scrolling
5032will not scroll a window to a column less than the value returned 5040will not scroll a window to a column less than the value returned
5033by this function. */) 5041by this function. This happens in an interactive call. */)
5034 (arg) 5042 (arg, set_minimum)
5035 register Lisp_Object arg; 5043 register Lisp_Object arg, set_minimum;
5036{ 5044{
5037 Lisp_Object result; 5045 Lisp_Object result;
5038 int hscroll; 5046 int hscroll;
@@ -5046,7 +5054,7 @@ by this function. */)
5046 hscroll = XINT (w->hscroll) - XINT (arg); 5054 hscroll = XINT (w->hscroll) - XINT (arg);
5047 result = Fset_window_hscroll (selected_window, make_number (hscroll)); 5055 result = Fset_window_hscroll (selected_window, make_number (hscroll));
5048 5056
5049 if (interactive_p (0)) 5057 if (!NILP (set_minimum))
5050 w->min_hscroll = w->hscroll; 5058 w->min_hscroll = w->hscroll;
5051 5059
5052 return result; 5060 return result;
diff --git a/src/xdisp.c b/src/xdisp.c
index a5449c4db7c..4b0865aa4f0 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -4554,7 +4554,8 @@ back_to_previous_visible_line_start (it)
4554 { 4554 {
4555 Lisp_Object prop; 4555 Lisp_Object prop;
4556 4556
4557 prop = Fget_char_property (make_number (IT_CHARPOS (*it)), 4557 /* Check the newline before point for invisibility. */
4558 prop = Fget_char_property (make_number (IT_CHARPOS (*it) - 1),
4558 Qinvisible, it->window); 4559 Qinvisible, it->window);
4559 if (TEXT_PROP_MEANS_INVISIBLE (prop)) 4560 if (TEXT_PROP_MEANS_INVISIBLE (prop))
4560 visible_p = 0; 4561 visible_p = 0;
@@ -8414,7 +8415,8 @@ update_tool_bar (f, save_match_data)
8414 { 8415 {
8415 struct buffer *prev = current_buffer; 8416 struct buffer *prev = current_buffer;
8416 int count = SPECPDL_INDEX (); 8417 int count = SPECPDL_INDEX ();
8417 Lisp_Object old_tool_bar; 8418 Lisp_Object new_tool_bar;
8419 int new_n_tool_bar;
8418 struct gcpro gcpro1; 8420 struct gcpro gcpro1;
8419 8421
8420 /* Set current_buffer to the buffer of the selected 8422 /* Set current_buffer to the buffer of the selected
@@ -8433,18 +8435,24 @@ update_tool_bar (f, save_match_data)
8433 specbind (Qoverriding_local_map, Qnil); 8435 specbind (Qoverriding_local_map, Qnil);
8434 } 8436 }
8435 8437
8436 old_tool_bar = f->tool_bar_items; 8438 GCPRO1 (new_tool_bar);
8437 GCPRO1 (old_tool_bar);
8438 8439
8439 /* Build desired tool-bar items from keymaps. */ 8440 /* Build desired tool-bar items from keymaps. */
8440 BLOCK_INPUT; 8441 new_tool_bar = tool_bar_items (Fcopy_sequence (f->tool_bar_items),
8441 f->tool_bar_items 8442 &new_n_tool_bar);
8442 = tool_bar_items (f->tool_bar_items, &f->n_tool_bar_items);
8443 UNBLOCK_INPUT;
8444 8443
8445 /* Redisplay the tool-bar if we changed it. */ 8444 /* Redisplay the tool-bar if we changed it. */
8446 if (! NILP (Fequal (old_tool_bar, f->tool_bar_items))) 8445 if (NILP (Fequal (new_tool_bar, f->tool_bar_items)))
8447 w->update_mode_line = Qt; 8446 {
8447 /* Redisplay that happens asynchronously due to an expose event
8448 may access f->tool_bar_items. Make sure we update both
8449 variables within BLOCK_INPUT so no such event interrupts. */
8450 BLOCK_INPUT;
8451 f->tool_bar_items = new_tool_bar;
8452 f->n_tool_bar_items = new_n_tool_bar;
8453 w->update_mode_line = Qt;
8454 UNBLOCK_INPUT;
8455 }
8448 8456
8449 UNGCPRO; 8457 UNGCPRO;
8450 8458
diff --git a/src/xfns.c b/src/xfns.c
index b11779da185..cdce77f158f 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -5130,27 +5130,26 @@ file_dialog_unmap_cb (widget, client_data, call_data)
5130} 5130}
5131 5131
5132 5132
5133DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0, 5133DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0,
5134 doc: /* Read file name, prompting with PROMPT in directory DIR. 5134 doc: /* Read file name, prompting with PROMPT in directory DIR.
5135Use a file selection dialog. 5135Use a file selection dialog. Select DEFAULT-FILENAME in the dialog's file
5136Select DEFAULT-FILENAME in the dialog's file selection box, if 5136selection box, if specified. If MUSTMATCH is non-nil, the returned file
5137specified. Don't let the user enter a file name in the file 5137or directory must exist. ONLY-DIR-P is ignored." */)
5138selection dialog's entry field, if MUSTMATCH is non-nil. */) 5138 (prompt, dir, default_filename, mustmatch, only_dir_p)
5139 (prompt, dir, default_filename, mustmatch) 5139 Lisp_Object prompt, dir, default_filename, mustmatch, only_dir_p;
5140 Lisp_Object prompt, dir, default_filename, mustmatch;
5141{ 5140{
5142 int result; 5141 int result;
5143 struct frame *f = SELECTED_FRAME (); 5142 struct frame *f = SELECTED_FRAME ();
5144 Lisp_Object file = Qnil; 5143 Lisp_Object file = Qnil;
5145 Widget dialog, text, list, help; 5144 Widget dialog, text, help;
5146 Arg al[10]; 5145 Arg al[10];
5147 int ac = 0; 5146 int ac = 0;
5148 extern XtAppContext Xt_app_con; 5147 extern XtAppContext Xt_app_con;
5149 XmString dir_xmstring, pattern_xmstring; 5148 XmString dir_xmstring, pattern_xmstring;
5150 int count = SPECPDL_INDEX (); 5149 int count = SPECPDL_INDEX ();
5151 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; 5150 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
5152 5151
5153 GCPRO5 (prompt, dir, default_filename, mustmatch, file); 5152 GCPRO6 (prompt, dir, default_filename, mustmatch, only_dir_p, file);
5154 CHECK_STRING (prompt); 5153 CHECK_STRING (prompt);
5155 CHECK_STRING (dir); 5154 CHECK_STRING (dir);
5156 5155
@@ -5183,9 +5182,9 @@ selection dialog's entry field, if MUSTMATCH is non-nil. */)
5183 XtAddCallback (dialog, XmNunmapCallback, file_dialog_unmap_cb, 5182 XtAddCallback (dialog, XmNunmapCallback, file_dialog_unmap_cb,
5184 (XtPointer) &result); 5183 (XtPointer) &result);
5185 5184
5186 /* Disable the help button since we can't display help. */ 5185 /* Remove the help button since we can't display help. */
5187 help = XmFileSelectionBoxGetChild (dialog, XmDIALOG_HELP_BUTTON); 5186 help = XmFileSelectionBoxGetChild (dialog, XmDIALOG_HELP_BUTTON);
5188 XtSetSensitive (help, False); 5187 XtUnmanageChild (help);
5189 5188
5190 /* Mark OK button as default. */ 5189 /* Mark OK button as default. */
5191 XtVaSetValues (XmFileSelectionBoxGetChild (dialog, XmDIALOG_OK_BUTTON), 5190 XtVaSetValues (XmFileSelectionBoxGetChild (dialog, XmDIALOG_OK_BUTTON),
@@ -5207,30 +5206,30 @@ selection dialog's entry field, if MUSTMATCH is non-nil. */)
5207 /* Manage the dialog, so that list boxes get filled. */ 5206 /* Manage the dialog, so that list boxes get filled. */
5208 XtManageChild (dialog); 5207 XtManageChild (dialog);
5209 5208
5210 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
5211 must include the path for this to work. */
5212 list = XmFileSelectionBoxGetChild (dialog, XmDIALOG_LIST);
5213 if (STRINGP (default_filename)) 5209 if (STRINGP (default_filename))
5214 { 5210 {
5215 XmString default_xmstring; 5211 XmString default_xmstring;
5216 int item_pos; 5212 Widget wtext = XmFileSelectionBoxGetChild (dialog, XmDIALOG_TEXT);
5213 Widget list = XmFileSelectionBoxGetChild (dialog, XmDIALOG_LIST);
5217 5214
5218 default_xmstring 5215 XmTextPosition last_pos = XmTextFieldGetLastPosition (wtext);
5219 = XmStringCreateLocalized (SDATA (default_filename)); 5216 XmTextFieldReplace (wtext, 0, last_pos,
5217 (SDATA (Ffile_name_nondirectory (default_filename))));
5220 5218
5221 if (!XmListItemExists (list, default_xmstring)) 5219 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
5222 { 5220 must include the path for this to work. */
5223 /* Add a new item if DEFAULT_FILENAME is not in the list. */ 5221
5224 XmListAddItem (list, default_xmstring, 0); 5222 default_xmstring = XmStringCreateLocalized (SDATA (default_filename));
5225 item_pos = 0; 5223
5226 } 5224 if (XmListItemExists (list, default_xmstring))
5227 else 5225 {
5228 item_pos = XmListItemPos (list, default_xmstring); 5226 int item_pos = XmListItemPos (list, default_xmstring);
5229 XmStringFree (default_xmstring); 5227 /* Select the item and scroll it into view. */
5228 XmListSelectPos (list, item_pos, True);
5229 XmListSetPos (list, item_pos);
5230 }
5230 5231
5231 /* Select the item and scroll it into view. */ 5232 XmStringFree (default_xmstring);
5232 XmListSelectPos (list, item_pos, True);
5233 XmListSetPos (list, item_pos);
5234 } 5233 }
5235 5234
5236 /* Process events until the user presses Cancel or OK. */ 5235 /* Process events until the user presses Cancel or OK. */
@@ -5274,23 +5273,23 @@ selection dialog's entry field, if MUSTMATCH is non-nil. */)
5274 5273
5275#ifdef USE_GTK 5274#ifdef USE_GTK
5276 5275
5277DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0, 5276DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0,
5278 "Read file name, prompting with PROMPT in directory DIR.\n\ 5277 doc: /* Read file name, prompting with PROMPT in directory DIR.
5279Use a file selection dialog.\n\ 5278Use a file selection dialog. Select DEFAULT-FILENAME in the dialog's file
5280Select DEFAULT-FILENAME in the dialog's file selection box, if\n\ 5279selection box, if specified. If MUSTMATCH is non-nil, the returned file
5281specified. Don't let the user enter a file name in the file\n\ 5280or directory must exist. If ONLY-DIR-P is non-nil, the user can only select
5282selection dialog's entry field, if MUSTMATCH is non-nil.") 5281directories. */)
5283 (prompt, dir, default_filename, mustmatch) 5282 (prompt, dir, default_filename, mustmatch, only_dir_p)
5284 Lisp_Object prompt, dir, default_filename, mustmatch; 5283 Lisp_Object prompt, dir, default_filename, mustmatch, only_dir_p;
5285{ 5284{
5286 FRAME_PTR f = SELECTED_FRAME (); 5285 FRAME_PTR f = SELECTED_FRAME ();
5287 char *fn; 5286 char *fn;
5288 Lisp_Object file = Qnil; 5287 Lisp_Object file = Qnil;
5289 int count = specpdl_ptr - specpdl; 5288 int count = specpdl_ptr - specpdl;
5290 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; 5289 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
5291 char *cdef_file; 5290 char *cdef_file;
5292 5291
5293 GCPRO5 (prompt, dir, default_filename, mustmatch, file); 5292 GCPRO6 (prompt, dir, default_filename, mustmatch, only_dir_p, file);
5294 CHECK_STRING (prompt); 5293 CHECK_STRING (prompt);
5295 CHECK_STRING (dir); 5294 CHECK_STRING (dir);
5296 5295
@@ -5304,7 +5303,9 @@ selection dialog's entry field, if MUSTMATCH is non-nil.")
5304 else 5303 else
5305 cdef_file = SDATA (dir); 5304 cdef_file = SDATA (dir);
5306 5305
5307 fn = xg_get_file_name (f, SDATA (prompt), cdef_file, ! NILP (mustmatch)); 5306 fn = xg_get_file_name (f, SDATA (prompt), cdef_file,
5307 ! NILP (mustmatch),
5308 ! NILP (only_dir_p));
5308 5309
5309 if (fn) 5310 if (fn)
5310 { 5311 {
@@ -5580,6 +5581,14 @@ Chinese, Japanese, and Korean. */);
5580 Fprovide (intern ("x-toolkit"), Qnil); 5581 Fprovide (intern ("x-toolkit"), Qnil);
5581 Fprovide (intern ("gtk"), Qnil); 5582 Fprovide (intern ("gtk"), Qnil);
5582 5583
5584#ifdef HAVE_GTK_FILE_BOTH
5585 DEFVAR_BOOL ("use-old-gtk-file-dialog", &use_old_gtk_file_dialog,
5586 doc: /* *Non-nil means that the old GTK file selection dialog is used.
5587If nil the new GTK file chooser is used instead. To turn off
5588all file dialogs set the variable `use-file-dialog'. */);
5589 use_old_gtk_file_dialog = 0;
5590#endif
5591
5583 DEFVAR_LISP ("gtk-version-string", &Vgtk_version_string, 5592 DEFVAR_LISP ("gtk-version-string", &Vgtk_version_string,
5584 doc: /* Version info for GTK+. */); 5593 doc: /* Version info for GTK+. */);
5585 { 5594 {
diff --git a/src/xmenu.c b/src/xmenu.c
index 5c3d5804355..145e4f70b9c 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.
@@ -1120,29 +1120,28 @@ on the left of the dialog box and all following items on the right.
1120 popped down (deactivated). This is used for x-popup-menu 1120 popped down (deactivated). This is used for x-popup-menu
1121 and x-popup-dialog; it is not used for the menu bar. 1121 and x-popup-dialog; it is not used for the menu bar.
1122 1122
1123 If DO_TIMERS is nonzero, run timers.
1124 If DOWN_ON_KEYPRESS is nonzero, pop down if a key is pressed. 1123 If DOWN_ON_KEYPRESS is nonzero, pop down if a key is pressed.
1125 1124
1125 This function used to have a DO_TIMERS argument which was
1126 1 in the dialog case, and caused it to run Lisp-level timers.
1127 That was unsafe so we removed it, but does anyone remember
1128 why menus and dialogs were treated differently?
1129
1126 NOTE: All calls to popup_get_selection should be protected 1130 NOTE: All calls to popup_get_selection should be protected
1127 with BLOCK_INPUT, UNBLOCK_INPUT wrappers. */ 1131 with BLOCK_INPUT, UNBLOCK_INPUT wrappers. */
1128 1132
1129#ifdef USE_X_TOOLKIT 1133#ifdef USE_X_TOOLKIT
1130static void 1134static void
1131popup_get_selection (initial_event, dpyinfo, id, do_timers, down_on_keypress) 1135popup_get_selection (initial_event, dpyinfo, id, down_on_keypress)
1132 XEvent *initial_event; 1136 XEvent *initial_event;
1133 struct x_display_info *dpyinfo; 1137 struct x_display_info *dpyinfo;
1134 LWLIB_ID id; 1138 LWLIB_ID id;
1135 int do_timers;
1136 int down_on_keypress; 1139 int down_on_keypress;
1137{ 1140{
1138 XEvent event; 1141 XEvent event;
1139 1142
1140 while (popup_activated_flag) 1143 while (popup_activated_flag)
1141 { 1144 {
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) 1145 if (initial_event)
1147 { 1146 {
1148 event = *initial_event; 1147 event = *initial_event;
@@ -2489,7 +2488,7 @@ create_and_show_popup_menu (f, first_wv, x, y, for_click)
2489 popup_activated_flag = 1; 2488 popup_activated_flag = 1;
2490 2489
2491 /* Process events that apply to the menu. */ 2490 /* Process events that apply to the menu. */
2492 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), menu_id, 0, 0); 2491 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), menu_id, 0);
2493 2492
2494 /* fp turned off the following statement and wrote a comment 2493 /* fp turned off the following statement and wrote a comment
2495 that it is unnecessary--that the menu has already disappeared. 2494 that it is unnecessary--that the menu has already disappeared.
@@ -2883,8 +2882,7 @@ create_and_show_dialog (f, first_wv)
2883 Fcons (make_number (dialog_id >> (fact)), 2882 Fcons (make_number (dialog_id >> (fact)),
2884 make_number (dialog_id & ~(-1 << (fact))))); 2883 make_number (dialog_id & ~(-1 << (fact)))));
2885 2884
2886 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), 2885 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id, 1);
2887 dialog_id, 1, 1);
2888 2886
2889 unbind_to (count, Qnil); 2887 unbind_to (count, Qnil);
2890 } 2888 }
diff --git a/src/xselect.c b/src/xselect.c
index 65cb584410e..06f4bfbd2a1 100644
--- a/src/xselect.c
+++ b/src/xselect.c
@@ -32,6 +32,7 @@ Boston, MA 02111-1307, USA. */
32#include "buffer.h" 32#include "buffer.h"
33#include "process.h" 33#include "process.h"
34#include "termhooks.h" 34#include "termhooks.h"
35#include "keyboard.h"
35 36
36#include <X11/Xproto.h> 37#include <X11/Xproto.h>
37 38
@@ -85,10 +86,13 @@ static void initialize_cut_buffers P_ ((Display *, Window));
85 fprintf (stderr, "%d: " fmt "\n", getpid (), a0) 86 fprintf (stderr, "%d: " fmt "\n", getpid (), a0)
86#define TRACE2(fmt, a0, a1) \ 87#define TRACE2(fmt, a0, a1) \
87 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1) 88 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1)
89#define TRACE3(fmt, a0, a1, a2) \
90 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1, a2)
88#else 91#else
89#define TRACE0(fmt) (void) 0 92#define TRACE0(fmt) (void) 0
90#define TRACE1(fmt, a0) (void) 0 93#define TRACE1(fmt, a0) (void) 0
91#define TRACE2(fmt, a0, a1) (void) 0 94#define TRACE2(fmt, a0, a1) (void) 0
95#define TRACE3(fmt, a0, a1) (void) 0
92#endif 96#endif
93 97
94 98
@@ -168,6 +172,86 @@ static void lisp_data_to_selection_data ();
168static Lisp_Object selection_data_to_lisp_data (); 172static Lisp_Object selection_data_to_lisp_data ();
169static Lisp_Object x_get_window_property_as_lisp_data (); 173static Lisp_Object x_get_window_property_as_lisp_data ();
170 174
175
176
177/* Define a queue to save up SelectionRequest events for later handling. */
178
179struct selection_event_queue
180 {
181 struct input_event event;
182 struct selection_event_queue *next;
183 };
184
185static struct selection_event_queue *selection_queue;
186
187/* Nonzero means queue up certain events--don't process them yet. */
188
189static int x_queue_selection_requests;
190
191/* Queue up an X event *EVENT, to be processed later. */
192
193static void
194x_queue_event (event)
195 struct input_event *event;
196{
197 struct selection_event_queue *queue_tmp;
198
199 /* Don't queue repeated requests */
200 for (queue_tmp = selection_queue; queue_tmp; queue_tmp = queue_tmp->next)
201 {
202 if (!bcmp (&queue_tmp->event, event, sizeof (*event)))
203 {
204 TRACE1 ("IGNORE DUP SELECTION EVENT %08x", (unsigned long)queue_tmp);
205 return;
206 }
207 }
208
209 queue_tmp
210 = (struct selection_event_queue *) xmalloc (sizeof (struct selection_event_queue));
211
212 if (queue_tmp != NULL)
213 {
214 TRACE1 ("QUEUE SELECTION EVENT %08x", (unsigned long)queue_tmp);
215 queue_tmp->event = *event;
216 queue_tmp->next = selection_queue;
217 selection_queue = queue_tmp;
218 }
219}
220
221/* Start queuing SelectionRequest events. */
222
223static void
224x_start_queuing_selection_requests ()
225{
226 if (x_queue_selection_requests)
227 abort ();
228
229 x_queue_selection_requests++;
230 TRACE1 ("x_start_queuing_selection_requests %d", x_queue_selection_requests);
231}
232
233/* Stop queuing SelectionRequest events. */
234
235static void
236x_stop_queuing_selection_requests ()
237{
238 TRACE1 ("x_stop_queuing_selection_requests %d", x_queue_selection_requests);
239 --x_queue_selection_requests;
240
241 /* Take all the queued events and put them back
242 so that they get processed afresh. */
243
244 while (selection_queue != NULL)
245 {
246 struct selection_event_queue *queue_tmp = selection_queue;
247 TRACE1 ("RESTORE SELECTION EVENT %08x", (unsigned long)queue_tmp);
248 kbd_buffer_unget_event (&queue_tmp->event);
249 selection_queue = queue_tmp->next;
250 xfree ((char *)queue_tmp);
251 }
252}
253
254
171/* This converts a Lisp symbol to a server Atom, avoiding a server 255/* This converts a Lisp symbol to a server Atom, avoiding a server
172 roundtrip whenever possible. */ 256 roundtrip whenever possible. */
173 257
@@ -564,13 +648,10 @@ static struct prop_location *property_change_reply_object;
564static struct prop_location *property_change_wait_list; 648static struct prop_location *property_change_wait_list;
565 649
566static Lisp_Object 650static Lisp_Object
567queue_selection_requests_unwind (frame) 651queue_selection_requests_unwind (tem)
568 Lisp_Object frame; 652 Lisp_Object tem;
569{ 653{
570 FRAME_PTR f = XFRAME (frame); 654 x_stop_queuing_selection_requests ();
571
572 if (! NILP (frame))
573 x_stop_queuing_selection_requests (FRAME_X_DISPLAY (f));
574 return Qnil; 655 return Qnil;
575} 656}
576 657
@@ -631,6 +712,17 @@ x_reply_selection_request (event, format, data, size, type)
631 BLOCK_INPUT; 712 BLOCK_INPUT;
632 count = x_catch_errors (display); 713 count = x_catch_errors (display);
633 714
715#ifdef TRACE_SELECTION
716 {
717 static int cnt;
718 char *sel = XGetAtomName (display, reply.selection);
719 char *tgt = XGetAtomName (display, reply.target);
720 TRACE3 ("%s, target %s (%d)", sel, tgt, ++cnt);
721 if (sel) XFree (sel);
722 if (tgt) XFree (tgt);
723 }
724#endif /* TRACE_SELECTION */
725
634 /* Store the data on the requested property. 726 /* Store the data on the requested property.
635 If the selection is large, only store the first N bytes of it. 727 If the selection is large, only store the first N bytes of it.
636 */ 728 */
@@ -658,10 +750,10 @@ x_reply_selection_request (event, format, data, size, type)
658 bother trying to queue them. */ 750 bother trying to queue them. */
659 if (!NILP (frame)) 751 if (!NILP (frame))
660 { 752 {
661 x_start_queuing_selection_requests (display); 753 x_start_queuing_selection_requests ();
662 754
663 record_unwind_protect (queue_selection_requests_unwind, 755 record_unwind_protect (queue_selection_requests_unwind,
664 frame); 756 Qnil);
665 } 757 }
666 758
667 if (x_window_to_frame (dpyinfo, window)) /* #### debug */ 759 if (x_window_to_frame (dpyinfo, window)) /* #### debug */
@@ -695,6 +787,8 @@ x_reply_selection_request (event, format, data, size, type)
695 XGetAtomName (display, reply.property)); 787 XGetAtomName (display, reply.property));
696 wait_for_property_change (wait_object); 788 wait_for_property_change (wait_object);
697 } 789 }
790 else
791 unexpect_property_change (wait_object);
698 792
699 TRACE0 ("Got ACK"); 793 TRACE0 ("Got ACK");
700 while (bytes_remaining) 794 while (bytes_remaining)
@@ -768,7 +862,7 @@ x_reply_selection_request (event, format, data, size, type)
768/* Handle a SelectionRequest event EVENT. 862/* Handle a SelectionRequest event EVENT.
769 This is called from keyboard.c when such an event is found in the queue. */ 863 This is called from keyboard.c when such an event is found in the queue. */
770 864
771void 865static void
772x_handle_selection_request (event) 866x_handle_selection_request (event)
773 struct input_event *event; 867 struct input_event *event;
774{ 868{
@@ -783,6 +877,8 @@ x_handle_selection_request (event)
783 struct x_display_info *dpyinfo 877 struct x_display_info *dpyinfo
784 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event)); 878 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event));
785 879
880 TRACE0 ("x_handle_selection_request");
881
786 local_selection_data = Qnil; 882 local_selection_data = Qnil;
787 target_symbol = Qnil; 883 target_symbol = Qnil;
788 converted_selection = Qnil; 884 converted_selection = Qnil;
@@ -877,7 +973,7 @@ x_handle_selection_request (event)
877 client cleared out our previously asserted selection. 973 client cleared out our previously asserted selection.
878 This is called from keyboard.c when such an event is found in the queue. */ 974 This is called from keyboard.c when such an event is found in the queue. */
879 975
880void 976static void
881x_handle_selection_clear (event) 977x_handle_selection_clear (event)
882 struct input_event *event; 978 struct input_event *event;
883{ 979{
@@ -890,6 +986,8 @@ x_handle_selection_clear (event)
890 struct x_display_info *dpyinfo = x_display_info_for_display (display); 986 struct x_display_info *dpyinfo = x_display_info_for_display (display);
891 struct x_display_info *t_dpyinfo; 987 struct x_display_info *t_dpyinfo;
892 988
989 TRACE0 ("x_handle_selection_clear");
990
893 /* If the new selection owner is also Emacs, 991 /* If the new selection owner is also Emacs,
894 don't clear the new selection. */ 992 don't clear the new selection. */
895 BLOCK_INPUT; 993 BLOCK_INPUT;
@@ -958,6 +1056,24 @@ x_handle_selection_clear (event)
958 } 1056 }
959} 1057}
960 1058
1059void
1060x_handle_selection_event (event)
1061 struct input_event *event;
1062{
1063 TRACE0 ("x_handle_selection_event");
1064
1065 if (event->kind == SELECTION_REQUEST_EVENT)
1066 {
1067 if (x_queue_selection_requests)
1068 x_queue_event (event);
1069 else
1070 x_handle_selection_request (event);
1071 }
1072 else
1073 x_handle_selection_clear (event);
1074}
1075
1076
961/* Clear all selections that were made from frame F. 1077/* Clear all selections that were made from frame F.
962 We do this when about to delete a frame. */ 1078 We do this when about to delete a frame. */
963 1079
@@ -1088,12 +1204,14 @@ unexpect_property_change (location)
1088/* Remove the property change expectation element for IDENTIFIER. */ 1204/* Remove the property change expectation element for IDENTIFIER. */
1089 1205
1090static Lisp_Object 1206static Lisp_Object
1091wait_for_property_change_unwind (identifierval) 1207wait_for_property_change_unwind (loc)
1092 Lisp_Object identifierval; 1208 Lisp_Object loc;
1093{ 1209{
1094 unexpect_property_change ((struct prop_location *) 1210 struct prop_location *location = XSAVE_VALUE (loc)->pointer;
1095 (XFASTINT (XCAR (identifierval)) << 16 1211
1096 | XFASTINT (XCDR (identifierval)))); 1212 unexpect_property_change (location);
1213 if (location == property_change_reply_object)
1214 property_change_reply_object = 0;
1097 return Qnil; 1215 return Qnil;
1098} 1216}
1099 1217
@@ -1106,18 +1224,17 @@ wait_for_property_change (location)
1106{ 1224{
1107 int secs, usecs; 1225 int secs, usecs;
1108 int count = SPECPDL_INDEX (); 1226 int count = SPECPDL_INDEX ();
1109 Lisp_Object tem;
1110 1227
1111 tem = Fcons (Qnil, Qnil); 1228 if (property_change_reply_object)
1112 XSETCARFASTINT (tem, (EMACS_UINT)location >> 16); 1229 abort ();
1113 XSETCDRFASTINT (tem, (EMACS_UINT)location & 0xffff);
1114 1230
1115 /* Make sure to do unexpect_property_change if we quit or err. */ 1231 /* Make sure to do unexpect_property_change if we quit or err. */
1116 record_unwind_protect (wait_for_property_change_unwind, tem); 1232 record_unwind_protect (wait_for_property_change_unwind,
1233 make_save_value (location, 0));
1117 1234
1118 XSETCAR (property_change_reply, Qnil); 1235 XSETCAR (property_change_reply, Qnil);
1119
1120 property_change_reply_object = location; 1236 property_change_reply_object = location;
1237
1121 /* If the event we are waiting for arrives beyond here, it will set 1238 /* If the event we are waiting for arrives beyond here, it will set
1122 property_change_reply, because property_change_reply_object says so. */ 1239 property_change_reply, because property_change_reply_object says so. */
1123 if (! location->arrived) 1240 if (! location->arrived)
@@ -1148,7 +1265,8 @@ x_handle_property_notify (event)
1148 1265
1149 while (rest) 1266 while (rest)
1150 { 1267 {
1151 if (rest->property == event->atom 1268 if (!rest->arrived
1269 && rest->property == event->atom
1152 && rest->window == event->window 1270 && rest->window == event->window
1153 && rest->display == event->display 1271 && rest->display == event->display
1154 && rest->desired_state == event->state) 1272 && rest->desired_state == event->state)
@@ -1164,11 +1282,6 @@ x_handle_property_notify (event)
1164 if (rest == property_change_reply_object) 1282 if (rest == property_change_reply_object)
1165 XSETCAR (property_change_reply, Qt); 1283 XSETCAR (property_change_reply, Qt);
1166 1284
1167 if (prev)
1168 prev->next = rest->next;
1169 else
1170 property_change_wait_list = rest->next;
1171 xfree (rest);
1172 return; 1285 return;
1173 } 1286 }
1174 1287
@@ -1303,10 +1416,10 @@ x_get_foreign_selection (selection_symbol, target_type, time_stamp)
1303 bother trying to queue them. */ 1416 bother trying to queue them. */
1304 if (!NILP (frame)) 1417 if (!NILP (frame))
1305 { 1418 {
1306 x_start_queuing_selection_requests (display); 1419 x_start_queuing_selection_requests ();
1307 1420
1308 record_unwind_protect (queue_selection_requests_unwind, 1421 record_unwind_protect (queue_selection_requests_unwind,
1309 frame); 1422 Qnil);
1310 } 1423 }
1311 UNBLOCK_INPUT; 1424 UNBLOCK_INPUT;
1312 1425
@@ -1462,10 +1575,10 @@ receive_incremental_selection (display, window, property, target_type,
1462 BLOCK_INPUT; 1575 BLOCK_INPUT;
1463 XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask); 1576 XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask);
1464 TRACE1 (" Delete property %s", 1577 TRACE1 (" Delete property %s",
1465 XSYMBOL (x_atom_to_symbol (display, property))->name->data); 1578 SDATA (SYMBOL_NAME (x_atom_to_symbol (display, property))));
1466 XDeleteProperty (display, window, property); 1579 XDeleteProperty (display, window, property);
1467 TRACE1 (" Expect new value of property %s", 1580 TRACE1 (" Expect new value of property %s",
1468 XSYMBOL (x_atom_to_symbol (display, property))->name->data); 1581 SDATA (SYMBOL_NAME (x_atom_to_symbol (display, property))));
1469 wait_object = expect_property_change (display, window, property, 1582 wait_object = expect_property_change (display, window, property,
1470 PropertyNewValue); 1583 PropertyNewValue);
1471 XFlush (display); 1584 XFlush (display);
@@ -1495,7 +1608,6 @@ receive_incremental_selection (display, window, property, target_type,
1495 1608
1496 if (! waiting_for_other_props_on_window (display, window)) 1609 if (! waiting_for_other_props_on_window (display, window))
1497 XSelectInput (display, window, STANDARD_EVENT_SET); 1610 XSelectInput (display, window, STANDARD_EVENT_SET);
1498 unexpect_property_change (wait_object);
1499 /* Use xfree, not XFree, because x_get_window_property 1611 /* Use xfree, not XFree, because x_get_window_property
1500 calls xmalloc itself. */ 1612 calls xmalloc itself. */
1501 if (tmp_data) xfree (tmp_data); 1613 if (tmp_data) xfree (tmp_data);
diff --git a/src/xterm.c b/src/xterm.c
index 492e8d00b52..a1fd1d5dcc2 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -3922,9 +3922,9 @@ x_window_to_scroll_bar (display, window_id)
3922{ 3922{
3923 Lisp_Object tail; 3923 Lisp_Object tail;
3924 3924
3925#ifdef USE_GTK 3925#if defined (USE_GTK) && defined (USE_TOOLKIT_SCROLL_BARS)
3926 window_id = (Window) xg_get_scroll_id_for_window (display, window_id); 3926 window_id = (Window) xg_get_scroll_id_for_window (display, window_id);
3927#endif /* USE_GTK */ 3927#endif /* USE_GTK && USE_TOOLKIT_SCROLL_BARS */
3928 3928
3929 for (tail = Vframe_list; 3929 for (tail = Vframe_list;
3930 XGCTYPE (tail) == Lisp_Cons; 3930 XGCTYPE (tail) == Lisp_Cons;
@@ -5579,73 +5579,6 @@ x_scroll_bar_clear (f)
5579} 5579}
5580 5580
5581 5581
5582/* Define a queue to save up SelectionRequest events for later handling. */
5583
5584struct selection_event_queue
5585 {
5586 XEvent event;
5587 struct selection_event_queue *next;
5588 };
5589
5590static struct selection_event_queue *queue;
5591
5592/* Nonzero means queue up certain events--don't process them yet. */
5593
5594static int x_queue_selection_requests;
5595
5596/* Queue up an X event *EVENT, to be processed later. */
5597
5598static void
5599x_queue_event (f, event)
5600 FRAME_PTR f;
5601 XEvent *event;
5602{
5603 struct selection_event_queue *queue_tmp
5604 = (struct selection_event_queue *) xmalloc (sizeof (struct selection_event_queue));
5605
5606 if (queue_tmp != NULL)
5607 {
5608 queue_tmp->event = *event;
5609 queue_tmp->next = queue;
5610 queue = queue_tmp;
5611 }
5612}
5613
5614/* Take all the queued events and put them back
5615 so that they get processed afresh. */
5616
5617static void
5618x_unqueue_events (display)
5619 Display *display;
5620{
5621 while (queue != NULL)
5622 {
5623 struct selection_event_queue *queue_tmp = queue;
5624 XPutBackEvent (display, &queue_tmp->event);
5625 queue = queue_tmp->next;
5626 xfree ((char *)queue_tmp);
5627 }
5628}
5629
5630/* Start queuing SelectionRequest events. */
5631
5632void
5633x_start_queuing_selection_requests (display)
5634 Display *display;
5635{
5636 x_queue_selection_requests++;
5637}
5638
5639/* Stop queuing SelectionRequest events. */
5640
5641void
5642x_stop_queuing_selection_requests (display)
5643 Display *display;
5644{
5645 x_queue_selection_requests--;
5646 x_unqueue_events (display);
5647}
5648
5649/* The main X event-reading loop - XTread_socket. */ 5582/* The main X event-reading loop - XTread_socket. */
5650 5583
5651#if 0 5584#if 0
@@ -6023,11 +5956,7 @@ handle_one_xevent (dpyinfo, eventp, finish, hold_quit)
6023 if (!x_window_to_frame (dpyinfo, event.xselectionrequest.owner)) 5956 if (!x_window_to_frame (dpyinfo, event.xselectionrequest.owner))
6024 goto OTHER; 5957 goto OTHER;
6025#endif /* USE_X_TOOLKIT */ 5958#endif /* USE_X_TOOLKIT */
6026 if (x_queue_selection_requests) 5959 {
6027 x_queue_event (x_window_to_frame (dpyinfo, event.xselectionrequest.owner),
6028 &event);
6029 else
6030 {
6031 XSelectionRequestEvent *eventp 5960 XSelectionRequestEvent *eventp
6032 = (XSelectionRequestEvent *) &event; 5961 = (XSelectionRequestEvent *) &event;
6033 5962
@@ -6039,7 +5968,7 @@ handle_one_xevent (dpyinfo, eventp, finish, hold_quit)
6039 SELECTION_EVENT_PROPERTY (&inev) = eventp->property; 5968 SELECTION_EVENT_PROPERTY (&inev) = eventp->property;
6040 SELECTION_EVENT_TIME (&inev) = eventp->time; 5969 SELECTION_EVENT_TIME (&inev) = eventp->time;
6041 inev.frame_or_window = Qnil; 5970 inev.frame_or_window = Qnil;
6042 } 5971 }
6043 break; 5972 break;
6044 5973
6045 case PropertyNotify: 5974 case PropertyNotify:
@@ -7623,7 +7552,11 @@ x_catch_errors_unwind (old_val)
7623 /* The display may have been closed before this function is called. 7552 /* The display may have been closed before this function is called.
7624 Check if it is still open before calling XSync. */ 7553 Check if it is still open before calling XSync. */
7625 if (x_display_info_for_display (dpy) != 0) 7554 if (x_display_info_for_display (dpy) != 0)
7626 XSync (dpy, False); 7555 {
7556 BLOCK_INPUT;
7557 XSync (dpy, False);
7558 UNBLOCK_INPUT;
7559 }
7627 7560
7628 x_error_message_string = XCDR (old_val); 7561 x_error_message_string = XCDR (old_val);
7629 return Qnil; 7562 return Qnil;
diff --git a/src/xterm.h b/src/xterm.h
index eebe4f10878..23f0e43d149 100644
--- a/src/xterm.h
+++ b/src/xterm.h
@@ -52,7 +52,7 @@ typedef GtkWidget *xt_or_gtk_widget;
52#undef XSync 52#undef XSync
53#define XSync(d, b) do { gdk_window_process_all_updates (); \ 53#define XSync(d, b) do { gdk_window_process_all_updates (); \
54 XSync (d, b); } while (0) 54 XSync (d, b); } while (0)
55 55
56 56
57#endif /* USE_GTK */ 57#endif /* USE_GTK */
58 58
@@ -976,8 +976,6 @@ int x_alloc_nearest_color P_ ((struct frame *, Colormap, XColor *));
976 976
977extern void cancel_mouse_face P_ ((struct frame *)); 977extern void cancel_mouse_face P_ ((struct frame *));
978extern void x_scroll_bar_clear P_ ((struct frame *)); 978extern void x_scroll_bar_clear P_ ((struct frame *));
979extern void x_start_queuing_selection_requests P_ ((Display *));
980extern void x_stop_queuing_selection_requests P_ ((Display *));
981extern int x_text_icon P_ ((struct frame *, char *)); 979extern int x_text_icon P_ ((struct frame *, char *));
982extern int x_bitmap_icon P_ ((struct frame *, Lisp_Object)); 980extern int x_bitmap_icon P_ ((struct frame *, Lisp_Object));
983extern int x_catch_errors P_ ((Display *)); 981extern int x_catch_errors P_ ((Display *));
@@ -1013,8 +1011,7 @@ extern int x_dispatch_event P_ ((XEvent *, Display *));
1013 1011
1014extern void x_handle_property_notify P_ ((XPropertyEvent *)); 1012extern void x_handle_property_notify P_ ((XPropertyEvent *));
1015extern void x_handle_selection_notify P_ ((XSelectionEvent *)); 1013extern void x_handle_selection_notify P_ ((XSelectionEvent *));
1016extern void x_handle_selection_request P_ ((struct input_event *)); 1014extern void x_handle_selection_event P_ ((struct input_event *));
1017extern void x_handle_selection_clear P_ ((struct input_event *));
1018extern void x_clear_frame_selections P_ ((struct frame *)); 1015extern void x_clear_frame_selections P_ ((struct frame *));
1019 1016
1020extern int x_handle_dnd_message P_ ((struct frame *, 1017extern int x_handle_dnd_message P_ ((struct frame *,