Mercurial > emacs
changeset 90043:e24e2e78deda
Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-69
Merge from emacs--cvs-trunk--0
Patches applied:
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-643
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-649
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-650
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-651
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-655
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-656
Update from CVS: lisp/man.el (Man-xref-normal-file): Fix help-echo.
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-657
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-658
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-659
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-660
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-661
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-667
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-668
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-61
- miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-68
Update from CVS
line wrap: on
line diff
--- a/ChangeLog Fri Oct 29 00:25:02 2004 +0000 +++ b/ChangeLog Thu Nov 04 08:55:40 2004 +0000 @@ -1,3 +1,12 @@ +2004-11-02 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * configure.in (HAVE_GTK_FILE_CHOOSER, $HAVE_GTK_FILE_SELECTION): New + tests for new and old GTK file dialogs. + (HAVE_GTK): Only set with_toolkit_scroll_bars if not explicitly set + to no. + + * configure: Rebuild + 2004-10-20 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> * configure.in (HAVE_PERSONALITY_LINUX32): New test if PER_LINUX32
--- a/admin/ChangeLog Fri Oct 29 00:25:02 2004 +0000 +++ b/admin/ChangeLog Thu Nov 04 08:55:40 2004 +0000 @@ -1,3 +1,7 @@ +2004-11-02 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * FOR-RELEASE (Indications): Remove two stage update for toolbar (Done). + 2004-09-20 Luc Teirlinck <teirllm@auburn.edu> * FOR-RELEASE (Indications): Rearrange checklists for Emacs and
--- a/admin/FOR-RELEASE Fri Oct 29 00:25:02 2004 +0000 +++ b/admin/FOR-RELEASE Thu Nov 04 08:55:40 2004 +0000 @@ -8,6 +8,8 @@ ** Face remapping. +** Let mouse-1 follow links. + * FATAL ERRORS @@ -18,12 +20,228 @@ which then returns a NULL pointer. Said to happen with isearch faces. +** Investigate reported crashes in compact_small_strings. + +** Investigate reported crashes related to using an +invalid pointer from string_free_list. + + +* LOSSAGE + +** Clean up flymake.el to follow Emacs Lisp conventions. + * GTK RELATED BUGS ** Make GTK scrollbars behave like others w.r.t. overscrolling. +* REDISPLAY RELATED BUGS + +** Avoid unbreakable loops in redisplay. + +Redisplay may loop if there is an error in some display property, e.g. + (space 'left-margin) + +A fix would be to somehow disable handling of display properties if an error +is encountered. + +** Problem with cursor border around images and window-margins: + +The border around the image when the cursor is on the image +flows into the right fringe and margin. + + (progn + (auto-image-file-mode 1) + (find-file (concat data-directory "splash.xpm")) + (set-window-margins (selected-window) 25 25)) + + +** Problem with modeline and window margins: + +The mode line's right "box" line is misplaced under the right margin, +rather than at the right window edge. + +emacs -Q +(set-window-margins nil 25 25) +C-x 2 + + +** custom mode-line face makes Emacs freeze up + +From: Stephen Berman <Stephen.Berman@gmx.net> +Date: Sun, 24 Oct 2004 02:08:56 +0200 + +1. Start Emacs with -q -no-site-file. + +2. Type `M-x customize-face' and at the prompt `mode-line'. + +3. In the Custom buffer for mode-line face + a. check width and give it the value `narrow'; + b. check height and give it the value 120 in 1/10 pt; + c. check underline and give it the value `on' (or `colored'); + d. check overline and give it the value `on' (or `colored'). + +4. Set for current session. + +5. Invoke Ediff on any two files. + +6. Now Emacs is frozen and consumes 95-99% of CPU. + +The customizations in step 3 appear to be the minimum necessary to +induce this bug. Leave out any one of them and Ediff runs without a +problem. Also if the 1/10 point value of height is 130 or greater +there's no bug (with the default font family; with e.g. Helvetica the +bug is induced only by a value of 100 or less). + +I've noticed this freeze up only when invoking Ediff. The only thing +I've been able to do is kill Emacs externally, via top or with kill +when run in gdb, after interrupting. When the freeze up happens +within a gdb session, there is no automatic debugging feedback. After +interrupting I can get a backtrace, here's an example: + +Update: Maybe only reveals itself when compiled with GTK+ + + +** Mouse-face overlay bleeds into header line + +From: Stephen Berman <Stephen.Berman@gmx.net> +Date: Thu, 21 Oct 2004 18:11:01 +0200 + +Mouse-face overlays bleed into the header line when the beginning of +the overlay is above (point-min). To reproduce: + +1. Start Emacs with -q -no-site-file. + +2. In *scratch* eval (setq ov (make-overlay 66 92)), (overlay-put ov +'mouse-face 'highlight), and (setq header-line-format "test"). + +3. Drag the mouse over the string "evaluation.\n;; If you want" and +notice the highlighting of only this string. + +4. Now click on the down arrow in the scroll bar until the line +beginning ";; If you want" is directly below the header line. + +5. Drag the mouse over ";; If you want" and notice that not only it +but also the header line are highlighted. + + +** scroll-preserve-screen-position doesn't work with a header-line-format + +From: jbyler+emacs-lists@anon41.eml.cc +Date: Tue, 17 Aug 2004 17:10:14 -0400 + +There seems to be an off-by-one error triggered by using a header line +together with scroll-preserve-screen-position. The symptom: instead of +staying in the same position on the screen when scrolling, the cursor +moves one screen line down each time the buffer is scrolled. Put +another way: repeatedly typing C-v M-v or using a mouse scroll wheel to +scroll up and down causes the cursor to migrate slowly down the screen +instead of staying put as it should. + +To reproduce: + +emacs -q --no-site-file +(setq scroll-preserve-screen-position t) +(setq header-line-format "") +C-v M-v C-v M-v C-v M-v etc. + + +** Clicking on partially visible lines fails + +From: David Kastrup <dak@gnu.org> +Date: 27 Apr 2004 16:42:58 +0200 + +I had gnus display a mouse-highlighted line (a URL from browse-url) +partially at the bottom of its window. If I click with middle mouse +key on it, the window gets recentered while I hold the mouse key +pressed. If I release it, the window returns into its old position +(cursor in top row) and nothing happens, presumably because the click +was not registered on the line itself, but on the magically +recentered version. + +That is a nuisance. Recentering of even partially visible click +targets should only happen if window-point moves there, but not at +the time of the click. From the moment I hold down a key until it +gets released, the displayed window portion should not change, with +the sole exception of scrolling when dragging at the edge of the +screen. + + +** Can't drag modeline when mouse-autoselect-window is set + +From: Klaus Zeitler <kzeitler@lucent.com> +Date: Mon, 11 Oct 2004 11:14:49 +0200 + +1. start emacs -q --no-site-file +2. set variable mouse-autoselect-window to t +3. split-window-vertically + +now I can drag the modeline only upwards but not downwards + + +** line-spacing and (recenter -1) + +From: SAITO Takuya <tabmore@rivo.mediatti.net> +Date: Mon, 31 May 2004 02:07:57 +0900 (JST) + +(recenter -1) does not show point at the bottom of the window +if line-spacing is set to positive integer. + +Start emacs -Q, and evaluate below: + +(progn + (setq line-spacing 1) + (dotimes (i (window-height)) + (insert "\n" (int-to-string i))) + (recenter -1)) + +Then, point is displayed at the center of the window. +But point should be displayed at the bottom of the window like Emacs-21.3. + + +** line-spacing and garbage in fringe + +From: SAITO Takuya <tabmore@rivo.mediatti.net> +Date: Mon, 31 May 2004 02:08:05 +0900 (JST) + +Start emacs -Q and evaluate below with C-xC-e: + +(let ((lines 2) + (spacing 1)) + (setq line-spacing spacing + indicate-buffer-boundaries t) + (insert (make-string (window-height) ?\n)) + (goto-char (point-min)) + (message (make-string (* (window-width) lines) ?.)) + (scroll-up 1)) + +then, garbage is displayed in right fringe. + +Above code reproduces this bug with +(frame-parameter nil 'font) +=> "-Adobe-Courier-Medium-R-Normal--12-120-75-75-M-70-ISO8859-1" + +If you use different font, you may need different value of +`lines' and/or `spacing'. + + +** line-spacing and Electric-pop-up-window + +From: SAITO Takuya <tabmore@rivo.mediatti.net> +Date: Mon, 31 May 2004 02:08:10 +0900 (JST) + +Electric-pop-up-window does not work well +if truncate long lines disabled and/or +`line-spacing' is set to positive integer. + +For example, start emacs -Q --line-spacing 1, and type M-` . +Then, the last line of *Completions* buffer is not visible. + +fit-window-to-buffer works well for me, so I guess +Electric-pop-up-window can use it. + + * DOCUMENTATION ** Finish updating the Emacs Lisp manual.
--- a/configure Fri Oct 29 00:25:02 2004 +0000 +++ b/configure Thu Nov 04 08:55:40 2004 +0000 @@ -9797,7 +9797,9 @@ USE_X_TOOLKIT=none - with_toolkit_scroll_bars=yes + if test "$with_toolkit_scroll_bars" != no; then + with_toolkit_scroll_bars=yes + fi HAVE_GTK_MULTIDISPLAY=no @@ -9909,6 +9911,222 @@ _ACEOF fi + HAVE_GTK_FILE_SELECTION=no + +for ac_func in gtk_file_selection_new +do +as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` +echo "$as_me:$LINENO: checking for $ac_func" >&5 +echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 +if eval "test \"\${$as_ac_var+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func. + For example, HP-UX 11i <limits.h> declares gettimeofday. */ +#define $ac_func innocuous_$ac_func + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $ac_func (); below. + Prefer <limits.h> to <assert.h> if __STDC__ is defined, since + <limits.h> exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include <limits.h> +#else +# include <assert.h> +#endif + +#undef $ac_func + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char $ac_func (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_$ac_func) || defined (__stub___$ac_func) +choke me +#else +char (*f) () = $ac_func; +#endif +#ifdef __cplusplus +} +#endif + +int +main () +{ +return f != $ac_func; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + eval "$as_ac_var=yes" +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +eval "$as_ac_var=no" +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 +if test `eval echo '${'$as_ac_var'}'` = yes; then + cat >>confdefs.h <<_ACEOF +#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + HAVE_GTK_FILE_SELECTION=yes +fi +done + + + HAVE_GTK_FILE_CHOOSER=no + +for ac_func in gtk_file_chooser_dialog_new +do +as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` +echo "$as_me:$LINENO: checking for $ac_func" >&5 +echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 +if eval "test \"\${$as_ac_var+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func. + For example, HP-UX 11i <limits.h> declares gettimeofday. */ +#define $ac_func innocuous_$ac_func + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $ac_func (); below. + Prefer <limits.h> to <assert.h> if __STDC__ is defined, since + <limits.h> exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include <limits.h> +#else +# include <assert.h> +#endif + +#undef $ac_func + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char $ac_func (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_$ac_func) || defined (__stub___$ac_func) +choke me +#else +char (*f) () = $ac_func; +#endif +#ifdef __cplusplus +} +#endif + +int +main () +{ +return f != $ac_func; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + eval "$as_ac_var=yes" +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +eval "$as_ac_var=no" +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 +if test `eval echo '${'$as_ac_var'}'` = yes; then + cat >>confdefs.h <<_ACEOF +#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + HAVE_GTK_FILE_CHOOSER=yes +fi +done + + + if test "$HAVE_GTK_FILE_SELECTION" = yes \ + && test "$HAVE_GTK_FILE_CHOOSER" = yes; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_GTK_FILE_BOTH 1 +_ACEOF + + fi fi if test x"${USE_X_TOOLKIT}" = xmaybe; then
--- a/configure.in Fri Oct 29 00:25:02 2004 +0000 +++ b/configure.in Thu Nov 04 08:55:40 2004 +0000 @@ -1967,7 +1967,9 @@ dnl GTK scrollbars resemble toolkit scrollbars a lot, so to avoid dnl a lot if #ifdef:s, say we have toolkit scrollbars. - with_toolkit_scroll_bars=yes + if test "$with_toolkit_scroll_bars" != no; then + with_toolkit_scroll_bars=yes + fi dnl Check if we can use multiple displays with this GTK version. dnl If gdk_display_open exists, assume all others are there also. @@ -1977,6 +1979,21 @@ AC_DEFINE(HAVE_GTK_MULTIDISPLAY, 1, [Define to 1 if GTK can handle more than one display.]) fi + dnl Check if we have the old file selection dialog. + dnl If gdk_display_open exists, assume all others are there also. + HAVE_GTK_FILE_SELECTION=no + AC_CHECK_FUNCS(gtk_file_selection_new, HAVE_GTK_FILE_SELECTION=yes) + + dnl Check if we have the new file chooser dialog + dnl If gdk_display_open exists, assume all others are there also. + HAVE_GTK_FILE_CHOOSER=no + AC_CHECK_FUNCS(gtk_file_chooser_dialog_new, HAVE_GTK_FILE_CHOOSER=yes) + + if test "$HAVE_GTK_FILE_SELECTION" = yes \ + && test "$HAVE_GTK_FILE_CHOOSER" = yes; then + AC_DEFINE(HAVE_GTK_FILE_BOTH, 1, + [Define to 1 if GTK has both file selection and chooser dialog.]) + fi fi dnl Do not put whitespace before the #include statements below.
--- a/etc/NEWS Fri Oct 29 00:25:02 2004 +0000 +++ b/etc/NEWS Thu Nov 04 08:55:40 2004 +0000 @@ -718,14 +718,17 @@ ** BibTeX mode: *** The new command bibtex-url browses a URL for the BibTeX entry at -point (bound to C-c C-l and mouse-2 on clickable fields). +point (bound to C-c C-l and mouse-2, RET on clickable fields). + *** The new command bibtex-entry-update (bound to C-c C-u) updates an existing BibTeX entry. + *** New `bibtex-entry-format' option `required-fields', enabled by default. + *** bibtex-maintain-sorted-entries can take values `plain', `crossref', and `entry-class' which control the sorting scheme used -for BibTeX entries. `bibtex-sort-entry-class' controls the sorting -scheme `entry-class'. TAB completion for reference keys and +for BibTeX entries. `bibtex-sort-entry-class' controls the sorting +scheme `entry-class'. TAB completion for reference keys and automatic detection of duplicates does not require anymore that bibtex-maintain-sorted-entries is non-nil. @@ -742,11 +745,22 @@ point according to context (bound to M-tab). *** The new commands bibtex-find-entry and bibtex-find-crossref -locate entries and crossref'd entries. +locate entries and crossref'd entries. Crossref fields are clickable +(bound to mouse-2, RET). *** In BibTeX mode the command fill-paragraph (bound to M-q) fills individual fields of a BibTeX entry. +*** The new command bibtex-validate-globally checks for duplicate keys +in multiple BibTeX files. See also the new variables bibtex-files +and bibtex-file-path. + +*** The new command bibtex-find-entry-globally searches BibTeX entries +in multiple BibTeX files. + +*** The new command bibtex-copy-summary-as-kill pushes summary +of BibTeX entry to kill ring (bound to C-c C-t). + ** When display margins are present in a window, the fringes are now displayed between the margins and the buffer's text area, rather than at the edges of the window. @@ -945,6 +959,9 @@ one-dimensional internal charsets, specifically the ISO-8859 ones. The utf-16 coding system is affected similarly. +** New variable `utf-translate-cjk-unicode-range' controls which +Unicode characters to translate in `utf-translate-cjk-mode'. + ** iso-10646-1 (`Unicode') fonts can be used to display any range of characters encodable by the utf-8 coding system. Just specify the fontset appropriately. @@ -999,6 +1016,11 @@ disabled by customizing the variable `use-file-dialog'. +++ +** For Gtk+ version 2.4, you can make Emacs use the old file dialog +by setting the variable `use-old-gtk-file-dialog' to t. Default is to use +the new dialog. + ++++ ** Emacs can produce an underscore-like (horizontal bar) cursor. The underscore cursor is set by putting `(cursor-type . hbar)' in default-frame-alist. It supports variable heights, like the `bar' @@ -2371,6 +2393,13 @@ * Lisp Changes in Emacs 21.4 +++ +** The new function `called-interactively-p' does what many people +have mistakenly believed `interactively-p' did: it returns t if the +calling function was called through `call-interactively'. +This should only be used when you cannot add a new "interactively" +argument to the command. + ++++ ** An interactive specification may now use the code letter 'U' to get the up-event that was discarded in case the last key sequence read for a previous 'k' or 'K' argument was a down-event; otherwise nil is used. @@ -3178,11 +3207,13 @@ and scroll-bar settings if non-nil. +++ -** Renamed file hooks to follow the convention: +** Renamed hooks to better follow the naming convention: find-file-hooks to find-file-hook, find-file-not-found-hooks to find-file-not-found-functions, write-file-hooks to write-file-functions, -write-contents-hooks to write-contents-functions. +write-contents-hooks to write-contents-functions, +x-lost-selection-hooks to x-lost-selection-functions, +x-sent-selection-hooks to x-sent-selection-functions. Marked local-write-file-hooks as obsolete (use the LOCAL arg of `add-hook'). +++
--- a/etc/TODO Fri Oct 29 00:25:02 2004 +0000 +++ b/etc/TODO Thu Nov 04 08:55:40 2004 +0000 @@ -85,6 +85,8 @@ at the same time and do it in a context-sensitive way. *** ability to add mode-specific data to the partial-parse-state. +** Add a way to convert a keyboard macro to equivalent Lisp code. + ** Have a command suggestion help system that recognizes patterns of commands which could be replaced with a simpler common command. It should not make more than one suggestion per 10 minutes.
--- a/etc/compilation.txt Fri Oct 29 00:25:02 2004 +0000 +++ b/etc/compilation.txt Thu Nov 04 08:55:40 2004 +0000 @@ -108,6 +108,24 @@ Error 24 at (2:progran.f90) : syntax error +* Fortran checker + +symbols: ftnchek-file ftnchek-line-file ftnchek-line + +File average.f: + +Warning in module COMPAV: Variables may be used before set: + SUM used at line 14 + SUM set at line 14 + +Warning near line 16 col 20: integer quotient expr I/J converted to real + + Dummy arg W in module SUBA line 8 file arrayclash.f is array + L4 used at line 55 file test/assign.f; never set +Warning near line 10 file arrayclash.f: Module contains no executable +Nonportable usage near line 31 col 9 file assign.f: mixed default and explicit + + * IAR Systems C Compiler symbol: iar @@ -125,7 +143,7 @@ foo.c(5:5) : error EDC0350: Syntax error. -* Ultrix MIPS RISC CC & DEC AXP OSF/1 cc & IRIX 5.2 +* Ultrix MIPS RISC CC, DEC AXP OSF/1 cc, IRIX 5.2 & NAG Fortran symbol: irix @@ -136,6 +154,7 @@ cfe: Warning 600: xfe.c: 170: Not in a conditional directive while ... /usr/lib/cmplrs/cc/cfe: Error: foo.c: 1: blah blah /usr/lib/cmplrs/cc/cfe: warning: foo.c: 1: blah blah +foo bar: baz.f, line 27: ... * Java Exception & Valgrind (memory debugger for x86 GNU/Linux)
--- a/lisp/ChangeLog Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/ChangeLog Thu Nov 04 08:55:40 2004 +0000 @@ -1,3 +1,421 @@ +2004-11-03 Daniel Pfeiffer <occitan@esperanto.org> + + * files.el (xml-based-modes): Delete var. + (magic-mode-alist): New more general var. + (set-auto-mode): Use it. + + * buff-menu.el (Buffer-menu-make-sort-button): Preserve point even + when clicking from another window. + +2004-11-03 Thien-Thi Nguyen <ttn@gnu.org> + + * vc-cvs.el (vc-cvs-local-month-numbers): Delete var. + (vc-cvs-annotate-time): Incorporate value of deleted var. + Remove special-case handling of beginning-of-buffer cruft. + Cache ending position (point) and return value in text property + `vc-cvs-annotate-time', and consult it on subsequent invocations. + + * vc-cvs.el (vc-cvs-annotate-command): + Delete extraneous lines from beginning of buffer. + * vc-mcvs.el (vc-mcvs-annotate-command): Likewise. + + * progmodes/grep.el (grep-default-command): Take empty string + for tag if all other methods yield nil. Shell-quote the tag. + + * vc.el (vc-annotate-display-autoscale): Add prefix-arg + spec in `interactive' form, and mention it in the docstring. + Also, make sure point is at bol after calling `annotate-time'. + +2004-11-02 Richard M. Stallman <rms@gnu.org> + + * emacs-lisp/elp.el (elp-instrument-function): + Use called-interactively-p. + + * emacs-lisp/easymenu.el (easy-menu-intern): + Don't downcase; rather, case-flip the first letter of each word. + + * emacs-lisp/easy-mmode.el (define-minor-mode): + Use called-interactively-p. + + * emacs-lisp/bytecomp.el (byte-compile-warning-types): + Add interactive-only. + (byte-compile-warnings): Add interactive-only as option. + (byte-compile-interactive-only-functions): New variable. + (byte-compile-form): Warn about calls to functions + in byte-compile-interactive-only-functions. + + * emacs-lisp/autoload.el (update-file-autoloads): + Don't use interactive-p; take new arg SAVE-AFTER. + + * emacs-lisp/advice.el (ad-make-advised-definition): + Use called-interactively-p. + +2004-11-02 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * files.el (find-file-existing): New function. + + * menu-bar.el (menu-bar-files-menu): Make "Open File..." call + find-file-existing. Add "New File..." that calls find-file. + + * diropen.pbm diropen.xpm: New files. + + * toolbar/tool-bar.el (tool-bar-setup): Tool bar item dired uses + icon diropen. New tool bar item find-file-existing uses icon open. + + * dired.el (dired-read-dir-and-switches): Call read-driectory-name + instead of read-file-name. + +2004-11-02 Ulf Jasper <ulf.jasper@web.de> + + * calendar/icalendar.el (icalendar-version): Increase to 0.08. + (icalendar--split-value): Change name of work buffer. + (icalendar--get-weekday-abbrev): Return nil on error. + (icalendar--date-to-isodate): New function. + (icalendar-convert-diary-to-ical) + (icalendar-extract-ical-from-buffer): Use only two args for + make-obsolete (XEmacs compatibility). + (icalendar-export-file, icalendar-import-file): Blank at end of + prompt. + (icalendar-export-region): Doc fix. + If error, return non-nil and write errors to a buffer. + Use correct weekday for weekly recurring events. + Check whether date has been parsed for ordinary events. + Make weekly events start in the year 2000. + DTEND is non-inclusive, shift end date by one day if + necessary (not for entries that have date and time). + Rename local let variables: oops -> found-error, datestring -> + startdatestring. + +2004-11-02 Kim F. Storm <storm@cua.dk> + + * files.el (set-auto-mode-0): Don't rely on dynamic binding of + keep-mode-if-same variable. Add it as optional arg instead. + (set-auto-mode): Call set-auto-mode-0 with keep-mode-if-same. + + * ehelp.el (electric-help-map): Reorder Q/q and R/r entries so + substitute-command-keys will select lower-case bindings like those + used in the static help texts. + + * descr-text.el (describe-text-properties): Don't err if called in + the *Help* buffer; output to *Help-2* buffer instead. + + * kmacro.el (group kmacro): Add :version. + (kmacro-keyboard-quit): New function to cleanup on C-g. + (kmacro-start-macro): Set defining-kbd-macro to append when + appending to last macro. + + * simple.el (keyboard-quit): Call kmacro-keyboard-quit. + +2004-11-02 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-ui.el (gdb-enable-debug-log) + (gdb-use-inferior-io-buffer, gdb-use-colon-colon-notation) + (gud-gdba-command-name, gdb-show-main, gdb-many-windows): + Add :version keyword. + +2004-11-02 Pavel Kobiakov <pk_at_work@yahoo.com> + + * progmodes/flymake.el (flymake-err-line-patterns): Use + `flymake-reformat-err-line-patterns-from-compile-el' to convert + `compilation-error-regexp-alist-alist' to internal Flymake format. + + * progmodes/flymake.el: eliminated byte-compiler warnings. + +2004-11-01 Jay Belanger <belanger@truman.edu> + + * calc/calc-frac.el (calc-over-notation): Replaced + `completing-read' with `interactive "s"'. + +2004-11-01 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * mouse.el (mouse-yank-at-click, mouse-yank-secondary): + Revert change from 2004-10-16. '*' checks the current buffer, but the + mouse click may be in another buffer. + +2004-11-01 John Paul Wallington <jpw@gnu.org> + + * files.el (large-file-warning-threshold): Add :version keyword. + (kill-some-buffers): Doc fix. + + * thumbs.el (group thumbs): Add :version keyword. + + * textmodes/bibtex.el (bibtex-make-field): Fix typo. + +2004-11-01 Richard M. Stallman <rms@gnu.org> + + * textmodes/ispell.el (ispell-word): Don't use interactive-p. + + * textmodes/flyspell.el (flyspell-word): Don't use interactive-p. + + * allout.el (allout group): Add :version. + (allout-init): Don't use interactive-p. + (allout-ascend-to-depth, allout-ascend, allout-end-of-level) + (allout-forward-current-level, allout-backward-current-level): + Don't use interactive-p. + + * textmodes/bibtex.el (bibtex-make-field): Don't use interactive-p. + (bibtex-find-text): Likewise. + + * progmodes/vhdl-mode.el (vhdl-fill-region) + (vhdl-beginning-of-statement): Don't use interactive-p. + + * progmodes/idlwave.el (idlwave-update-routine-info): + Don't use interactive-p. + + * progmodes/idlw-shell.el (idlwave-shell-send-char): + Don't use interactive-p. + + * progmodes/cperl-mode.el (cperl-switch-to-doc-buffer): + Don't use interactive-p. + + * progmodes/ada-xref.el (ada-make-body-gnatstub): + Don't use interactive-p. + + * play/fortune.el (fortune-to-signature): Don't use interactive-p. + (fortune-in-buffer): Doc fix. + + * play/5x5.el (5x5-new-game): Set up the buffer even if not interactive. + + * net/eudc.el (eudc-display-records): Use with-output-to-temp-buffer; + don't select the temporary buffer. + (eudc-get-email): New optional arg ERROR; don't use interactive-p. + (eudc-get-phone): Likewise. + +2004-11-01 Kim F. Storm <storm@cua.dk> + + * man.el (Man-xref-normal-file): Fix help-echo. + +2004-10-31 Stefan Monnier <monnier@iro.umontreal.ca> + + * reveal.el (reveal-last-tick): New var. + (reveal-post-command): Use it to avoid closing overlays when we're + appending text to them. + +2004-10-31 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de> + + * textmodes/bibtex.el: Require button. + (bibtex-autokey-transcriptions): Translate TeX `\ ' to space. + (bibtex-reference-keys): Distinguish between header keys and + crossref keys. + (bibtex-beginning-of-field): New function. + (bibtex-url-map): Remove. + (bibtex-font-lock-keywords): Use bibtex-font-lock-crossref. + (bibtex-font-lock-url-regexp): Assume that field names begin at + the beginning of a line. + (bibtex-font-lock-url): Simplify. Do not use bibtex-enclosing-field. + Remove field delimiters. Use bibtex-beginning-of-field. + Bugfix, point can be inside a field with a url. + (bibtex-font-lock-crossref, bibtex-button-action, bibtex-button): + New functions. + (bibtex-mark-active, bibtex-run-with-idle-timer): Remove. + (bibtex-key-in-head): Simplify. + (bibtex-current-line): Use bolp. + (bibtex-parse-keys): Remove unused arg `add'. + Use bibtex-type-in-head and bibtex-key-in-head. + (bibtex-parse-entry, bibtex-autofill-entry): + Use bibtex-type-in-head and bibtex-key-in-head. + (bibtex-autokey-get-field): Do not alter case of replacement text. + (bibtex-autokey-get-names): Do all processing of name list. + (bibtex-autokey-get-year): New function. + (bibtex-autokey-get-title): Do all processing of title words. + (bibtex-generate-autokey): Simplify. + (bibtex-string-files-init): Use default-directory. + Allow for absolute file names in bibtex-string-files. + (bibtex-files, bibtex-file-path): New variables. + (bibtex-files-expand): New function. + (bibtex-find-entry-globally): New command. + (bibtex-summary-function): New variable. + (bibtex-summary): Default value of bibtex-summary-function. + (bibtex-find-crossref): New optional args pnt and split. + (bibtex-complete-key-cleanup): Call bibtex-summary-function. + (bibtex-copy-summary-as-kill): New command bound to C-cC-t. + (bibtex-validate): Fix docstring. Check only abbreviated month fields. + Fix handling of required and alternative fields. + Identify duplicate keys even if bibtex-maintain-sorted-entries is nil. + Use cons and display-buffer. + (bibtex-validate-globally): New command. + (bibtex-clean-entry): Use bibtex-files-expand. Do not call + bibtex-parse-keys and bibtex-parse-strings for updating + bibtex-reference-keys and bibtex-strings. + (bibtex-realign): Remove blank lines past the last entry. + (bibtex-reformat): Use bibtex-entry-format as default. + (bibtex-choose-completion-string): Remove. + (bibtex-complete): Do not use bibtex-choose-completion-string. + (bibtex-url): Simplify. + +2004-10-31 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * x-dnd.el (x-dnd-test-function, x-dnd-protocol-alist) + (x-dnd-types-alist, x-dnd-open-file-other-window) + (x-dnd-known-types): Add :version. + +2004-10-31 John Paul Wallington <jpw@gnu.org> + + * ibuffer.el (group ibuffer): Add :version keyword. + +2004-10-31 Kim F. Storm <storm@cua.dk> + + * ido.el (group ido): Add :version keyword. + (ido-mode): Remove :version keyword. + + * emulation/cua-base.el (group cua): Add :version keyword. + (cua-mode): Remove :version keyword. + +2004-10-30 Luc Teirlinck <teirllm@auburn.edu> + + * autorevert.el (auto-revert-tail-mode-text): Add :version keyword. + + * help-at-pt.el (help-at-pt-timer): Move defvar up to avoid + compiler warning. + (help-at-pt-timer-delay): Add :initialize keyword. Simplify :set + function. + (help-at-pt-display-when-idle): Remove autoload. + +2004-10-30 Stefan Monnier <monnier@iro.umontreal.ca> + + * makefile.w32-in (custom-deps, autoloads): Fix *-hooks -> *-hook. + +2004-10-30 Juri Linkov <juri@jurta.org> + + * help.el (function-called-at-point): + * help-fns.el (variable-at-point): Read -> intern. + +2004-10-30 Simon Josefsson <jas@extundo.com> + + * progmodes/autoconf.el (autoconf-font-lock-keywords): + Recognize AS_* too. + +2004-10-29 Simon Josefsson <jas@extundo.com> + + * subr.el (read-passwd): Move back from password.el. + + * password.el: Remove, not ready yet. + +2004-10-29 Andreas Schwab <schwab@suse.de> + + * speedbar.el (speedbar-frame-parameters): Improve customize type. + +2004-10-29 Sam Steingold <sds@gnu.org> + + * mouse.el (mouse-show-mark): Replace the last occurrence of + x-lost-selection-hooks with x-lost-selection-functions. + +2004-10-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * mouse.el (mouse-show-mark): Adjust to new name and don't assume + x-lost-selection-functions is bound. + + * mouse-sel.el (mouse-sel-mode): + * emacs-lisp/lselect.el: Adjust to new names for + x-(lost|sent)-selection-functions. + + * subr.el (x-lost-selection-hooks, x-sent-selection-hooks): + New obsolete aliases of x-lost-selection-functions and + x-sent-selection-functions. + +2004-10-28 Kim F. Storm <storm@cua.dk> + + * imenu.el (imenu-scanning-message): Remove. + (imenu-progress-message): Make it a no-op. + +2004-10-28 John Paul Wallington <jpw@gnu.org> + + * files.el (set-auto-mode): Call `throw' correctly. + +2004-10-28 Juri Linkov <juri@jurta.org> + + * info.el (Info-file-list-for-emacs): Add ("Info" . "info") + to search `Info-...' commands in `info' manual. + (Info-goto-emacs-command-node, Info-goto-emacs-key-command-node): + Add 'info-file "emacs" property. + (Info-find-emacs-command-nodes): Fix index line number regexp. + Set real line number (instead of fake 0) in first element of the + returned list. + (Info-goto-emacs-command-node): Use line number of first element + to set point in the first found Info node. + + * progmodes/grep.el (grep-regexp-alist): Move match highlighting + code to `grep-mode-font-lock-keywords'. + (grep-mode-font-lock-keywords): Delete grep markers instead + of making them invisible. + +2004-10-28 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * mail/emacsbug.el (report-emacs-bug): Insert x-server-vendor + and x-server-version in bug report. + +2004-10-28 Daniel Pfeiffer <occitan@esperanto.org> + + * files.el (set-auto-mode-0): New function. + (set-auto-mode): Use it to handle aliased modes and to + be consistent between C-x C-f and C-x C-w. + +2004-10-28 Kenichi Handa <handa@m17n.org> + + * international/utf-8.el (utf-translate-cjk-charsets): + Add katakana-jisx0201. + + * international/subst-jis.el: Add data for JISX0201. + +2004-10-27 Stefan Monnier <monnier@iro.umontreal.ca> + + * obsolete/hilit19.el (hilit-mode): New function. + Move all the toplevel side-effecting stuff into it, so that loading + hilit19 doesn't mess everything up any more. + +2004-10-27 Richard M. Stallman <rms@gnu.org> + + * add-log.el (add-change-log-entry): Set up mailing address + and full name later, and don't alter add-log-mailing-address + or add-log-full-name. + + * elide-head.el (elide-head): Change error to message. + (elide-head-show): Likewise. + + * apropos.el (apropos-macrop): Doc fix. + + * mouse.el (mouse-show-mark): Do most processing the same + regardless of transient-mark-mode. + + * shadowfile.el (shadow-copy-files): Use interactive-p + only to control whether to print a message. + + * tar-mode.el (tar-mode): Use write-contents-functions, + not write-contents-hooks. + + * eshell/em-unix.el (eshell-du-sum-directory): Don't use + directory-sep-char. + +2004-10-27 Richard M. Stallman <rms@gnu.org> + + * strokes.el (strokes-unload-hook): Fix previous change. + + * type-break.el (type-break-run-at-time): Always use run-at-time; + forget the alternatives. + (type-break-cancel-function-timers): Always use cancel-function-timers; + forget the alternatives. + + * pcomplete.el (pcomplete-entries): Don't use directory-sep-char. + +2004-10-27 Kenichi Handa <handa@m17n.org> + + * international/subst-jis.el: Use utf-translate-cjk-substitutable-p. + + * international/subst-gb2312.el: Likewise. + + * international/subst-big5.el: Likewise. + + * international/subst-ksc.el: Likewise. + + * international/utf-8.el (utf-translate-cjk-unicode-range-string): + New variable. + (utf-translate-cjk-set-unicode-range): New function. + (utf-translate-cjk-unicode-range): Make it customizable. + (utf-8-post-read-conversion): + Use utf-translate-cjk-unicode-range-string. + (ccl-decode-mule-utf-8): Check utf-subst-table-for-decode for more + Unicode ranges. + 2004-10-26 Daniel Pfeiffer <occitan@esperanto.org> * files.el (auto-mode-alist): Add pod, js, xbm and xpm and group @@ -46,8 +464,8 @@ 2004-10-26 Pavel Kobiakov <pk_at_work@yahoo.com> - * progmodes/flymake.el (flymake-split-string): Use - `flymake-split-string-remove-empty-edges' in any case. + * progmodes/flymake.el (flymake-split-string): + Use `flymake-split-string-remove-empty-edges' in any case. 2004-10-26 Masatake YAMATO <jet@gyve.org> @@ -55,6 +473,11 @@ Use `compilation-error-regexp-alist-alist' instead of `compilation-error-regexp-alist'. +2004-10-25 Stefan Monnier <monnier@iro.umontreal.ca> + + * textmodes/tex-mode.el (tex-font-lock-keywords-1): Fix up the spurious + verbatim face on the \ of \end{verbatim}. + 2004-10-25 Jay Belanger <belanger@truman.edu> * calc/calc-incom.el (calc-digit-dots): Inhibit read-only before @@ -980,7 +1403,7 @@ 2004-09-17 Jay Belanger <belanger@truman.edu> - * calc/calc.el (calc-mode-var-list): Fixed the value of + * calc/calc.el (calc-mode-var-list): Fix the value of `calc-matrix-brackets'. 2004-09-17 Romain Francoise <romain@orebokech.com>
--- a/lisp/add-log.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/add-log.el Thu Nov 04 08:55:40 2004 +0000 @@ -471,20 +471,6 @@ non-nil, otherwise in local time." (interactive (list current-prefix-arg (prompt-for-change-log-name))) - (or add-log-full-name - (setq add-log-full-name (user-full-name))) - (or add-log-mailing-address - (setq add-log-mailing-address user-mail-address)) - (if whoami - (progn - (setq add-log-full-name (read-input "Full name: " add-log-full-name)) - ;; Note that some sites have room and phone number fields in - ;; full name which look silly when inserted. Rather than do - ;; anything about that here, let user give prefix argument so that - ;; s/he can edit the full name field in prompter if s/he wants. - (setq add-log-mailing-address - (read-input "Mailing address: " add-log-mailing-address)))) - (let* ((defun (add-log-current-defun)) (version (and change-log-version-info-enabled (change-log-version-number-search))) @@ -495,7 +481,19 @@ (file-name (expand-file-name (find-change-log file-name buffer-file))) ;; Set ITEM to the file name to use in the new item. (item (add-log-file-name buffer-file file-name)) - bound) + bound + (full-name (or add-log-full-name (user-full-name))) + (mailing-address (or add-log-mailing-address user-mail-address))) + + (if whoami + (progn + (setq full-name (read-input "Full name: " full-name)) + ;; Note that some sites have room and phone number fields in + ;; full name which look silly when inserted. Rather than do + ;; anything about that here, let user give prefix argument so that + ;; s/he can edit the full name field in prompter if s/he wants. + (setq mailing-address + (read-input "Mailing address: " mailing-address)))) (unless (equal file-name buffer-file-name) (if (or other-window (window-dedicated-p (selected-window))) @@ -515,11 +513,11 @@ ;; Advance into first entry if it is usable; else make new one. (let ((new-entries (mapcar (lambda (addr) (concat (funcall add-log-time-format) - " " add-log-full-name + " " full-name " <" addr ">")) - (if (consp add-log-mailing-address) - add-log-mailing-address - (list add-log-mailing-address))))) + (if (consp mailing-address) + mailing-address + (list mailing-address))))) (if (and (not add-log-always-start-new-record) (let ((hit nil)) (dolist (entry new-entries hit)
--- a/lisp/allout.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/allout.el Thu Nov 04 08:55:40 2004 +0000 @@ -68,7 +68,8 @@ (defgroup allout nil "Extensive outline mode for use alone and with other modes." :prefix "allout-" - :group 'editing) + :group 'editing + :version "21.4") ;;;_ + Layout, Mode, and Topic Header Configuration @@ -954,20 +955,16 @@ \(require 'allout) \(allout-init t)" - (interactive) - (if (interactive-p) - (progn - (setq mode - (completing-read - (concat "Select outline auto setup mode " - "(empty for report, ? for options) ") - '(("nil")("full")("activate")("deactivate") - ("ask") ("report") ("")) - nil - t)) - (if (string= mode "") - (setq mode 'report) - (setq mode (intern-soft mode))))) + (interactive + (let ((m (completing-read + (concat "Select outline auto setup mode " + "(empty for report, ? for options) ") + '(("nil")("full")("activate")("deactivate") + ("ask") ("report") ("")) + nil + t))) + (if (string= m "") 'report + (intern-soft m)))) (let ;; convenience aliases, for consistent ref to respective vars: ((hook 'allout-find-file-hook) @@ -1902,16 +1899,12 @@ (if (= (allout-recent-depth) depth) (progn (goto-char allout-recent-prefix-beginning) depth) - (goto-char last-good) - nil)) - (if (interactive-p) (allout-end-of-prefix)))) + (goto-char last-good))))) ;;;_ > allout-ascend () (defun allout-ascend () "Ascend one level, returning t if successful, nil if not." - (prog1 - (if (allout-beginning-of-level) - (allout-previous-heading)) - (if (interactive-p) (allout-end-of-prefix)))) + (if (allout-beginning-of-level) + (allout-previous-heading))) ;;;_ > allout-descend-to-depth (depth) (defun allout-descend-to-depth (depth) "Descend to depth DEPTH within current topic. @@ -1931,13 +1924,13 @@ nil)) ) ;;;_ > allout-up-current-level (arg &optional dont-complain) -(defun allout-up-current-level (arg &optional dont-complain) +(defun allout-up-current-level (arg &optional dont-complain interactive) "Move out ARG levels from current visible topic. Positions on heading line of containing topic. Error if unable to ascend that far, or nil if unable to ascend but optional arg DONT-COMPLAIN is non-nil." - (interactive "p") + (interactive "p\np") (allout-back-to-current-heading) (let ((present-level (allout-recent-depth)) (last-good (point)) @@ -1958,12 +1951,12 @@ (if (or failed (> arg 0)) (progn (goto-char last-good) - (if (interactive-p) (allout-end-of-prefix)) + (if interactive (allout-end-of-prefix)) (if (not dont-complain) (error "Can't ascend past outermost level") - (if (interactive-p) (allout-end-of-prefix)) + (if interactive (allout-end-of-prefix)) nil)) - (if (interactive-p) (allout-end-of-prefix)) + (if interactive (allout-end-of-prefix)) allout-recent-prefix-beginning))) ;;;_ - Linear @@ -2029,7 +2022,7 @@ (let ((depth (allout-depth))) (while (allout-previous-sibling depth nil)) (prog1 (allout-recent-depth) - (if (interactive-p) (allout-end-of-prefix))))) + (allout-end-of-prefix)))) ;;;_ > allout-next-visible-heading (arg) (defun allout-next-visible-heading (arg) "Move to the next ARG'th visible heading line, backward if arg is negative. @@ -2067,13 +2060,13 @@ (interactive "p") (allout-next-visible-heading (- arg))) ;;;_ > allout-forward-current-level (arg) -(defun allout-forward-current-level (arg) +(defun allout-forward-current-level (arg &optional interactive) "Position point at the next heading of the same level. Takes optional repeat-count, goes backward if count is negative. Returns resulting position, else nil if none found." - (interactive "p") + (interactive "p\np") (let ((start-depth (allout-current-depth)) (start-point (point)) (start-arg arg) @@ -2101,7 +2094,7 @@ (= (allout-recent-depth) start-depth))) allout-recent-prefix-beginning (goto-char last-good) - (if (not (interactive-p)) + (if (not interactive) nil (allout-end-of-prefix) (error "Hit %s level %d topic, traversed %d of %d requested" @@ -2110,10 +2103,10 @@ (- (abs start-arg) arg) (abs start-arg)))))) ;;;_ > allout-backward-current-level (arg) -(defun allout-backward-current-level (arg) +(defun allout-backward-current-level (arg &optional interactive) "Inverse of `allout-forward-current-level'." - (interactive "p") - (if (interactive-p) + (interactive "p\np") + (if interactive (let ((current-prefix-arg (* -1 arg))) (call-interactively 'allout-forward-current-level)) (allout-forward-current-level (* -1 arg))))
--- a/lisp/apropos.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/apropos.el Thu Nov 04 08:55:40 2004 +0000 @@ -875,7 +875,7 @@ (defun apropos-macrop (symbol) - "T if SYMBOL is a Lisp macro." + "Return t if SYMBOL is a Lisp macro." (and (fboundp symbol) (consp (setq symbol (symbol-function symbol)))
--- a/lisp/autorevert.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/autorevert.el Thu Nov 04 08:55:40 2004 +0000 @@ -172,7 +172,8 @@ \(When the string is not empty, make sure that it has a leading space.)" :group 'auto-revert - :type 'string) + :type 'string + :version "21.4") (defcustom auto-revert-mode-hook nil "Functions to run when Auto-Revert Mode is activated."
--- a/lisp/buff-menu.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/buff-menu.el Thu Nov 04 08:55:40 2004 +0000 @@ -627,8 +627,9 @@ (define-key map [header-line mouse-2] `(lambda (e) (interactive "e") - (if e (set-buffer (window-buffer (posn-window (event-end e))))) - (Buffer-menu-sort ,column))) + (save-window-excursion + (if e (mouse-select-window e)) + (Buffer-menu-sort ,column)))) map))) (defun list-buffers-noselect (&optional files-only)
--- a/lisp/calc/calc-frac.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/calc/calc-frac.el Thu Nov 04 08:55:40 2004 +0000 @@ -54,12 +54,7 @@ (defun calc-over-notation (fmt) - (interactive - (list - (completing-read "Fraction separator: " (mapcar (lambda (s) - (cons s 0)) - '(":" "::" "/" "//" ":/")) - nil t))) + (interactive "sFraction separator: ") (calc-wrapper (if (string-match "\\`\\([^ 0-9][^ 0-9]?\\)[0-9]*\\'" fmt) (let ((n nil))
--- a/lisp/calendar/icalendar.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/calendar/icalendar.el Thu Nov 04 08:55:40 2004 +0000 @@ -31,16 +31,7 @@ ;;; History: -;; 0.07: Renamed commands! -;; icalendar-extract-ical-from-buffer -> icalendar-import-buffer -;; icalendar-convert-diary-to-ical -> icalendar-export-file -;; Naming scheme: icalendar-.* = user command; icalendar--.* = -;; internal. -;; Added icalendar-export-region. -;; The import and export commands do not clear their target file, -;; but append their results to the target file. -;; I18n-problems fixed -- use calendar-(month|day)-name-array. -;; Fixed problems with export of multi-line diary entries. +;; 0.07 onwards: see lisp/ChangeLog ;; 0.06: Bugfixes regarding icalendar-import-format-*. ;; Fix in icalendar-convert-diary-to-ical -- thanks to Philipp @@ -99,7 +90,7 @@ ;;; Code: -(defconst icalendar-version 0.07 +(defconst icalendar-version 0.08 "Version number of icalendar.el.") ;; ====================================================================== @@ -333,7 +324,7 @@ param-name param-value) (when value-string (save-current-buffer - (set-buffer (get-buffer-create " *ical-temp*")) + (set-buffer (get-buffer-create " *icalendar-work*")) (set-buffer-modified-p nil) (erase-buffer) (insert value-string) @@ -529,7 +520,17 @@ (setq num (1+ num)))) calendar-day-name-array)) ;; Error: - "??")) + nil)) + +(defun icalendar--date-to-isodate (date &optional day-shift) + "Convert DATE to iso-style date. +DATE must be a list of the form (month day year). +If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days." + (let ((mdy (calendar-gregorian-from-absolute + (+ (calendar-absolute-from-gregorian date) + (or day-shift 0))))) + (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy)))) + (defun icalendar--datestring-to-isodate (datestring &optional day-shift) "Convert diary-style DATESTRING to iso-style date. @@ -587,7 +588,7 @@ (if (> day 0) (let ((mdy (calendar-gregorian-from-absolute (+ (calendar-absolute-from-gregorian (list month day - year)) + year)) (or day-shift 0))))) (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy))) nil))) @@ -625,22 +626,24 @@ "Export diary file to iCalendar format. All diary entries in the file DIARY-FILENAME are converted to iCalendar format. The result is appended to the file ICAL-FILENAME." - (interactive "FExport diary data from file: + (interactive "FExport diary data from file: Finto iCalendar file: ") (save-current-buffer (set-buffer (find-file diary-filename)) (icalendar-export-region (point-min) (point-max) ical-filename))) (defalias 'icalendar-convert-diary-to-ical 'icalendar-export-file) -(make-obsolete 'icalendar-convert-diary-to-ical 'icalendar-export-file - "icalendar 0.07") +(make-obsolete 'icalendar-convert-diary-to-ical 'icalendar-export-file) ;; User function (defun icalendar-export-region (min max ical-filename) "Export region in diary file to iCalendar format. All diary entries in the region from MIN to MAX in the current buffer are converted to iCalendar format. The result is appended to the file -ICAL-FILENAME." +ICAL-FILENAME. + +Returns non-nil if an error occurred. In this case an error message is +written to the buffer ` *icalendar-errors*'." (interactive "r FExport diary data into iCalendar file: ") (let ((result "") @@ -649,9 +652,14 @@ (entry-rest "") (header "") (contents) - (oops nil) + (found-error nil) (nonmarker (concat "^" (regexp-quote diary-nonmarking-symbol) "?"))) + ;; prepare buffer with error messages + (save-current-buffer + (set-buffer (get-buffer-create " *icalendar-errors*")) + (erase-buffer)) + ;; here we go (save-excursion (goto-char min) (while (re-search-forward @@ -664,330 +672,366 @@ (car (current-time)) (cadr (current-time)) (car (cddr (current-time))))) - (setq oops nil) - (cond - ;; anniversaries - ((string-match - (concat nonmarker - "%%(diary-anniversary \\([^)]+\\))\\s-*\\(.*\\)") - entry-main) - (icalendar--dmsg "diary-anniversary %s" entry-main) - (let* ((datetime (substring entry-main (match-beginning 1) - (match-end 1))) - (summary (icalendar--convert-string-for-export - (substring entry-main (match-beginning 2) - (match-end 2)))) - (startisostring (icalendar--datestring-to-isodate - datetime)) - (endisostring (icalendar--datestring-to-isodate - datetime 1))) - (setq contents - (concat "\nDTSTART;VALUE=DATE:" startisostring - "\nDTEND;VALUE=DATE:" endisostring - "\nSUMMARY:" summary - "\nRRULE:FREQ=YEARLY;INTERVAL=1" - ;; the following is redundant, - ;; but korganizer seems to expect this... ;( - ;; and evolution doesn't understand it... :( - ;; so... who is wrong?! - ";BYMONTH=" (substring startisostring 4 6) - ";BYMONTHDAY=" (substring startisostring 6 8) - ))) - (unless (string= entry-rest "") - (setq contents (concat contents "\nDESCRIPTION:" - (icalendar--convert-string-for-export - entry-rest))))) - ;; cyclic events - ;; %%(diary-cyclic ) - ((string-match - (concat nonmarker - "%%(diary-cyclic \\([^ ]+\\) +" - "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)") - entry-main) - (icalendar--dmsg "diary-cyclic %s" entry-main) - (let* ((frequency (substring entry-main (match-beginning 1) - (match-end 1))) - (datetime (substring entry-main (match-beginning 2) - (match-end 2))) - (summary (icalendar--convert-string-for-export - (substring entry-main (match-beginning 3) - (match-end 3)))) - (startisostring (icalendar--datestring-to-isodate - datetime)) - (endisostring (icalendar--datestring-to-isodate - datetime 1))) - (setq contents - (concat "\nDTSTART;VALUE=DATE:" startisostring - "\nDTEND;VALUE=DATE:" endisostring - "\nSUMMARY:" summary - "\nRRULE:FREQ=DAILY;INTERVAL=" frequency - ;; strange: korganizer does not expect - ;; BYSOMETHING here... - ))) - (unless (string= entry-rest "") - (setq contents (concat contents "\nDESCRIPTION:" - (icalendar--convert-string-for-export - entry-rest))))) - ;; diary-date -- FIXME - ((string-match - (concat nonmarker - "%%(diary-date \\([^)]+\\))\\s-*\\(.*\\)") - entry-main) - (icalendar--dmsg "diary-date %s" entry-main) - (setq oops t)) - ;; float events -- FIXME - ((string-match - (concat nonmarker - "%%(diary-float \\([^)]+\\))\\s-*\\(.*\\)") - entry-main) - (icalendar--dmsg "diary-float %s" entry-main) - (setq oops t)) - ;; block events - ((string-match - (concat nonmarker - "%%(diary-block \\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\) +" - "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)") - entry-main) - (icalendar--dmsg "diary-block %s" entry-main) - (let* ((startstring (substring entry-main (match-beginning 1) - (match-end 1))) - (endstring (substring entry-main (match-beginning 2) - (match-end 2))) - (summary (icalendar--convert-string-for-export - (substring entry-main (match-beginning 3) - (match-end 3)))) - (startisostring (icalendar--datestring-to-isodate - startstring)) - (endisostring (icalendar--datestring-to-isodate - endstring 1))) - (setq contents - (concat "\nDTSTART;VALUE=DATE:" startisostring - "\nDTEND;VALUE=DATE:" endisostring - "\nSUMMARY:" summary - )) - (unless (string= entry-rest "") - (setq contents (concat contents "\nDESCRIPTION:" - (icalendar--convert-string-for-export - entry-rest)))))) - ;; other sexp diary entries -- FIXME - ((string-match - (concat nonmarker - "%%(\\([^)]+\\))\\s-*\\(.*\\)") - entry-main) - (icalendar--dmsg "diary-sexp %s" entry-main) - (setq oops t)) - ;; weekly by day - ;; Monday 8:30 Team meeting - ((and (string-match - (concat nonmarker - "\\([a-z]+\\)\\s-+" - "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" - "\\(-0?" - "\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" - "\\)?" - "\\s-*\\(.*\\)$") - entry-main) - (icalendar--get-weekday-abbrev - (substring entry-main (match-beginning 1) (match-end 1)))) - (icalendar--dmsg "weekly %s" entry-main) - (let* ((day (icalendar--get-weekday-abbrev - (substring entry-main (match-beginning 1) - (match-end 1)))) - (starttimestring (icalendar--diarytime-to-isotime - (if (match-beginning 3) - (substring entry-main - (match-beginning 3) - (match-end 3)) - nil) - (if (match-beginning 4) - (substring entry-main - (match-beginning 4) - (match-end 4)) - nil))) - (endtimestring (icalendar--diarytime-to-isotime - (if (match-beginning 6) - (substring entry-main - (match-beginning 6) - (match-end 6)) - nil) - (if (match-beginning 7) - (substring entry-main - (match-beginning 7) - (match-end 7)) - nil))) - (summary (icalendar--convert-string-for-export - (substring entry-main (match-beginning 8) - (match-end 8))))) - (when starttimestring - (unless endtimestring - (let ((time (read (icalendar--rris "^T0?" "" - starttimestring)))) - (setq endtimestring (format "T%06d" (+ 10000 time)))))) - (setq contents - (concat "\nDTSTART" - (if starttimestring "" ";VALUE=DATE") - ":19000101" ;; FIXME? Probability that this - ;; is the right day is 1/7 - (or starttimestring "") - "\nDTEND" - (if endtimestring "" ";VALUE=DATE") - ":19000101" ;; FIXME? - (or endtimestring "") - "\nSUMMARY:" summary - "\nRRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=" day - ))) - (unless (string= entry-rest "") - (setq contents (concat contents "\nDESCRIPTION:" - (icalendar--convert-string-for-export - entry-rest))))) - ;; yearly by day - ;; 1 May Tag der Arbeit - ((string-match - (concat nonmarker - (if european-calendar-style - "0?\\([1-9]+[0-9]?\\)\\s-+\\([a-z]+\\)\\s-+" - "\\([a-z]+\\)\\s-+0?\\([1-9]+[0-9]?\\)\\s-+") - "\\*?\\s-*" - "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" - "\\(" - "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" - "\\)?" - "\\s-*\\([^0-9]+.*\\)$" ; must not match years - ) - entry-main) - (icalendar--dmsg "yearly %s" entry-main) - (let* ((daypos (if european-calendar-style 1 2)) - (monpos (if european-calendar-style 2 1)) - (day (read (substring entry-main (match-beginning daypos) - (match-end daypos)))) - (month (icalendar--get-month-number - (substring entry-main (match-beginning monpos) - (match-end monpos)))) - (starttimestring (icalendar--diarytime-to-isotime - (if (match-beginning 4) - (substring entry-main - (match-beginning 4) - (match-end 4)) - nil) - (if (match-beginning 5) - (substring entry-main - (match-beginning 5) - (match-end 5)) - nil))) - (endtimestring (icalendar--diarytime-to-isotime - (if (match-beginning 7) - (substring entry-main - (match-beginning 7) - (match-end 7)) - nil) - (if (match-beginning 8) - (substring entry-main - (match-beginning 8) - (match-end 8)) - nil))) - (summary (icalendar--convert-string-for-export - (substring entry-main (match-beginning 9) - (match-end 9))))) - (when starttimestring - (unless endtimestring - (let ((time (read (icalendar--rris "^T0?" "" - starttimestring)))) - (setq endtimestring (format "T%06d" (+ 10000 time)))))) - (setq contents - (concat "\nDTSTART" - (if starttimestring "" ";VALUE=DATE") - (format ":1900%02d%02d" month day) - (or starttimestring "") - "\nDTEND" - (if endtimestring "" ";VALUE=DATE") - (format ":1900%02d%02d" month day) - (or endtimestring "") - "\nSUMMARY:" summary - "\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=" - (format "%2d" month) - ";BYMONTHDAY=" - (format "%2d" day) - ))) - (unless (string= entry-rest "") - (setq contents (concat contents "\nDESCRIPTION:" - (icalendar--convert-string-for-export - entry-rest))))) - ;; "ordinary" events, start and end time given - ;; 1 Feb 2003 Hs Hochzeitsfeier, Dreieich - ((string-match - (concat nonmarker - "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)\\s-+" - "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" - "\\(" - "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" - "\\)?" - "\\s-*\\(.*\\)") - entry-main) - (icalendar--dmsg "ordinary %s" entry-main) - (let* ((datestring (icalendar--datestring-to-isodate - (substring entry-main (match-beginning 1) - (match-end 1)))) - (starttimestring (icalendar--diarytime-to-isotime - (if (match-beginning 3) - (substring entry-main - (match-beginning 3) - (match-end 3)) - nil) - (if (match-beginning 4) - (substring entry-main - (match-beginning 4) - (match-end 4)) - nil))) - (endtimestring (icalendar--diarytime-to-isotime - (if (match-beginning 6) - (substring entry-main - (match-beginning 6) - (match-end 6)) - nil) - (if (match-beginning 7) - (substring entry-main - (match-beginning 7) - (match-end 7)) - nil))) - (summary (icalendar--convert-string-for-export - (substring entry-main (match-beginning 8) - (match-end 8))))) - (when starttimestring - (unless endtimestring - (let ((time (read (icalendar--rris "^T0?" "" - starttimestring)))) - (setq endtimestring (format "T%06d" (+ 10000 time)))))) - (setq contents (format - "\nDTSTART%s:%s%s\nDTEND%s:%s%s\nSUMMARY:%s" - (if starttimestring "" ";VALUE=DATE") - datestring - (or starttimestring "") - (if endtimestring "" - ";VALUE=DATE") - datestring - (or endtimestring "") - summary)) - (unless (string= entry-rest "") - (setq contents (concat contents "\nDESCRIPTION:" - (icalendar--convert-string-for-export - entry-rest)))))) - ;; everything else - (t - ;; Oops! what's that? - (setq oops t))) - (if oops - (message "Cannot export entry on line %d" - (count-lines (point-min) (point))) - (setq result (concat result header contents "\nEND:VEVENT")))) + (condition-case error-val + (progn + (cond + ;; anniversaries + ((string-match + (concat nonmarker + "%%(diary-anniversary \\([^)]+\\))\\s-*\\(.*\\)") + entry-main) + (icalendar--dmsg "diary-anniversary %s" entry-main) + (let* ((datetime (substring entry-main (match-beginning 1) + (match-end 1))) + (summary (icalendar--convert-string-for-export + (substring entry-main (match-beginning 2) + (match-end 2)))) + (startisostring (icalendar--datestring-to-isodate + datetime)) + (endisostring (icalendar--datestring-to-isodate + datetime 1))) + (setq contents + (concat "\nDTSTART;VALUE=DATE:" startisostring + "\nDTEND;VALUE=DATE:" endisostring + "\nSUMMARY:" summary + "\nRRULE:FREQ=YEARLY;INTERVAL=1" + ;; the following is redundant, + ;; but korganizer seems to expect this... ;( + ;; and evolution doesn't understand it... :( + ;; so... who is wrong?! + ";BYMONTH=" (substring startisostring 4 6) + ";BYMONTHDAY=" (substring startisostring 6 8) + ))) + (unless (string= entry-rest "") + (setq contents (concat contents "\nDESCRIPTION:" + (icalendar--convert-string-for-export + entry-rest))))) + ;; cyclic events + ;; %%(diary-cyclic ) + ((string-match + (concat nonmarker + "%%(diary-cyclic \\([^ ]+\\) +" + "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)") + entry-main) + (icalendar--dmsg "diary-cyclic %s" entry-main) + (let* ((frequency (substring entry-main (match-beginning 1) + (match-end 1))) + (datetime (substring entry-main (match-beginning 2) + (match-end 2))) + (summary (icalendar--convert-string-for-export + (substring entry-main (match-beginning 3) + (match-end 3)))) + (startisostring (icalendar--datestring-to-isodate + datetime)) + (endisostring (icalendar--datestring-to-isodate + datetime 1))) + (setq contents + (concat "\nDTSTART;VALUE=DATE:" startisostring + "\nDTEND;VALUE=DATE:" endisostring + "\nSUMMARY:" summary + "\nRRULE:FREQ=DAILY;INTERVAL=" frequency + ;; strange: korganizer does not expect + ;; BYSOMETHING here... + ))) + (unless (string= entry-rest "") + (setq contents (concat contents "\nDESCRIPTION:" + (icalendar--convert-string-for-export + entry-rest))))) + ;; diary-date -- FIXME + ((string-match + (concat nonmarker + "%%(diary-date \\([^)]+\\))\\s-*\\(.*\\)") + entry-main) + (icalendar--dmsg "diary-date %s" entry-main) + (error "`diary-date' is not supported yet")) + ;; float events -- FIXME + ((string-match + (concat nonmarker + "%%(diary-float \\([^)]+\\))\\s-*\\(.*\\)") + entry-main) + (icalendar--dmsg "diary-float %s" entry-main) + (error "`diary-float' is not supported yet")) + ;; block events + ((string-match + (concat nonmarker + "%%(diary-block \\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\) +" + "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)") + entry-main) + (icalendar--dmsg "diary-block %s" entry-main) + (let* ((startstring (substring entry-main (match-beginning 1) + (match-end 1))) + (endstring (substring entry-main (match-beginning 2) + (match-end 2))) + (summary (icalendar--convert-string-for-export + (substring entry-main (match-beginning 3) + (match-end 3)))) + (startisostring (icalendar--datestring-to-isodate + startstring)) + (endisostring (icalendar--datestring-to-isodate + endstring 1))) + (setq contents + (concat "\nDTSTART;VALUE=DATE:" startisostring + "\nDTEND;VALUE=DATE:" endisostring + "\nSUMMARY:" summary + )) + (unless (string= entry-rest "") + (setq contents (concat contents "\nDESCRIPTION:" + (icalendar--convert-string-for-export + entry-rest)))))) + ;; other sexp diary entries -- FIXME + ((string-match + (concat nonmarker + "%%(\\([^)]+\\))\\s-*\\(.*\\)") + entry-main) + (icalendar--dmsg "diary-sexp %s" entry-main) + (error "sexp-entries are not supported yet")) + ;; weekly by day + ;; Monday 8:30 Team meeting + ((and (string-match + (concat nonmarker + "\\([a-z]+\\)\\s-+" + "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" + "\\(-0?" + "\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" + "\\)?" + "\\s-*\\(.*\\)$") + entry-main) + (icalendar--get-weekday-abbrev + (substring entry-main (match-beginning 1) (match-end 1)))) + (icalendar--dmsg "weekly %s" entry-main) + (let* ((day (icalendar--get-weekday-abbrev + (substring entry-main (match-beginning 1) + (match-end 1)))) + (starttimestring (icalendar--diarytime-to-isotime + (if (match-beginning 3) + (substring entry-main + (match-beginning 3) + (match-end 3)) + nil) + (if (match-beginning 4) + (substring entry-main + (match-beginning 4) + (match-end 4)) + nil))) + (endtimestring (icalendar--diarytime-to-isotime + (if (match-beginning 6) + (substring entry-main + (match-beginning 6) + (match-end 6)) + nil) + (if (match-beginning 7) + (substring entry-main + (match-beginning 7) + (match-end 7)) + nil))) + (summary (icalendar--convert-string-for-export + (substring entry-main (match-beginning 8) + (match-end 8))))) + (when starttimestring + (unless endtimestring + (let ((time (read (icalendar--rris "^T0?" "" + starttimestring)))) + (setq endtimestring (format "T%06d" (+ 10000 time)))))) + (setq contents + (concat "\nDTSTART;" + (if starttimestring + "VALUE=DATE-TIME:" + "VALUE=DATE:") + ;; find the correct week day, + ;; 1st january 2000 was a saturday + (format + "200001%02d" + (+ (icalendar--get-weekday-number day) 2)) + (or starttimestring "") + "\nDTEND;" + (if endtimestring + "VALUE=DATE-TIME:" + "VALUE=DATE:") + (format + "200001%02d" + ;; end is non-inclusive! + (+ (icalendar--get-weekday-number day) + (if endtimestring 2 3))) + (or endtimestring "") + "\nSUMMARY:" summary + "\nRRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=" day + ))) + (unless (string= entry-rest "") + (setq contents (concat contents "\nDESCRIPTION:" + (icalendar--convert-string-for-export + entry-rest))))) + ;; yearly by day + ;; 1 May Tag der Arbeit + ((string-match + (concat nonmarker + (if european-calendar-style + "0?\\([1-9]+[0-9]?\\)\\s-+\\([a-z]+\\)\\s-+" + "\\([a-z]+\\)\\s-+0?\\([1-9]+[0-9]?\\)\\s-+") + "\\*?\\s-*" + "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" + "\\(" + "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" + "\\)?" + "\\s-*\\([^0-9]+.*\\)$" ; must not match years + ) + entry-main) + (icalendar--dmsg "yearly %s" entry-main) + (let* ((daypos (if european-calendar-style 1 2)) + (monpos (if european-calendar-style 2 1)) + (day (read (substring entry-main (match-beginning daypos) + (match-end daypos)))) + (month (icalendar--get-month-number + (substring entry-main (match-beginning monpos) + (match-end monpos)))) + (starttimestring (icalendar--diarytime-to-isotime + (if (match-beginning 4) + (substring entry-main + (match-beginning 4) + (match-end 4)) + nil) + (if (match-beginning 5) + (substring entry-main + (match-beginning 5) + (match-end 5)) + nil))) + (endtimestring (icalendar--diarytime-to-isotime + (if (match-beginning 7) + (substring entry-main + (match-beginning 7) + (match-end 7)) + nil) + (if (match-beginning 8) + (substring entry-main + (match-beginning 8) + (match-end 8)) + nil))) + (summary (icalendar--convert-string-for-export + (substring entry-main (match-beginning 9) + (match-end 9))))) + (when starttimestring + (unless endtimestring + (let ((time (read (icalendar--rris "^T0?" "" + starttimestring)))) + (setq endtimestring (format "T%06d" (+ 10000 time)))))) + (setq contents + (concat "\nDTSTART;" + (if starttimestring "VALUE=DATE-TIME:" + "VALUE=DATE:") + (format "1900%02d%02d" month day) + (or starttimestring "") + "\nDTEND;" + (if endtimestring "VALUE=DATE-TIME:" + "VALUE=DATE:") + ;; end is not included! shift by one day + (icalendar--date-to-isodate + (list month day 1900) (if endtimestring 0 1)) + (or endtimestring "") + "\nSUMMARY:" + summary + "\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=" + (format "%2d" month) + ";BYMONTHDAY=" + (format "%2d" day) + ))) + (unless (string= entry-rest "") + (setq contents (concat contents "\nDESCRIPTION:" + (icalendar--convert-string-for-export + entry-rest))))) + ;; "ordinary" events, start and end time given + ;; 1 Feb 2003 Hs Hochzeitsfeier, Dreieich + ((string-match + (concat nonmarker + "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)\\s-+" + "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" + "\\(" + "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" + "\\)?" + "\\s-*\\(.*\\)") + entry-main) + (icalendar--dmsg "ordinary %s" entry-main) + (let* ((startdatestring (icalendar--datestring-to-isodate + (substring entry-main + (match-beginning 1) + (match-end 1)))) + (starttimestring (icalendar--diarytime-to-isotime + (if (match-beginning 3) + (substring entry-main + (match-beginning 3) + (match-end 3)) + nil) + (if (match-beginning 4) + (substring entry-main + (match-beginning 4) + (match-end 4)) + nil))) + (endtimestring (icalendar--diarytime-to-isotime + (if (match-beginning 6) + (substring entry-main + (match-beginning 6) + (match-end 6)) + nil) + (if (match-beginning 7) + (substring entry-main + (match-beginning 7) + (match-end 7)) + nil))) + (summary (icalendar--convert-string-for-export + (substring entry-main (match-beginning 8) + (match-end 8))))) + (unless startdatestring + (error "Could not parse date")) + (when starttimestring + (unless endtimestring + (let ((time (read (icalendar--rris "^T0?" "" + starttimestring)))) + (setq endtimestring (format "T%06d" (+ 10000 time)))))) + (setq contents (concat + "\nDTSTART;" + (if starttimestring "VALUE=DATE-TIME:" + "VALUE=DATE:") + startdatestring + (or starttimestring "") + "\nDTEND;" + (if endtimestring "VALUE=DATE-TIME:" + "VALUE=DATE:") + (icalendar--datestring-to-isodate + (substring entry-main + (match-beginning 1) + (match-end 1)) + (if endtimestring 0 1)) + (or endtimestring "") + "\nSUMMARY:" + summary)) + ;; could not parse the date + (unless (string= entry-rest "") + (setq contents (concat contents "\nDESCRIPTION:" + (icalendar--convert-string-for-export + entry-rest)))))) + ;; everything else + (t + ;; Oops! what's that? + (error "Could not parse entry"))) + (setq result (concat result header contents "\nEND:VEVENT"))) + ;; handle errors + (error + (setq found-error t) + (save-current-buffer + (set-buffer (get-buffer-create " *icalendar-errors*")) + (insert (format "Error in line %d -- %s: `%s'\n" + (count-lines (point-min) (point)) + (cadr error-val) + entry-main)))))) + ;; we're done, insert everything into the file (let ((coding-system-for-write 'utf8)) (set-buffer (find-file ical-filename)) (goto-char (point-max)) (insert "BEGIN:VCALENDAR") - (insert "\nPRODID:-//Emacs//NONSGML icalendar.el//EN") + (insert "\nPRODID:-//Emacs//NONSGML icalendar.el//EN") (insert "\nVERSION:2.0") (insert result) - (insert "\nEND:VCALENDAR\n"))))) + (insert "\nEND:VCALENDAR\n"))) + found-error)) ;; ====================================================================== ;; Import -- convert icalendar to emacs-diary @@ -1001,7 +1045,7 @@ Argument DIARY-FILENAME input `diary-file'. Optional argument NON-MARKING determines whether events are created as non-marking or not." - (interactive "fImport iCalendar data from file: + (interactive "fImport iCalendar data from file: Finto diary file: p") ;; clean up the diary file @@ -1062,9 +1106,7 @@ "Current buffer does not contain icalendar contents!")))) (defalias 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer) - -(make-obsolete 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer - "icalendar 0.07") +(make-obsolete 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer) ;; ====================================================================== ;; private area @@ -1184,7 +1226,7 @@ (setq diary-string (format "%s %s%s%s" (aref calendar-day-name-array - weekday) + weekday) start-t (if end-t "-" "") (or end-t ""))) ;; FIXME!!!!
--- a/lisp/comint.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/comint.el Thu Nov 04 08:55:40 2004 +0000 @@ -788,7 +788,7 @@ (defun comint-insert-input (&optional event) "In a Comint buffer, set the current input to the previous input at point." - (interactive "@") + (interactive "e") (if event (mouse-set-point event)) (let ((pos (point))) (if (not (eq (get-char-property pos 'field) 'input))
--- a/lisp/cus-edit.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/cus-edit.el Thu Nov 04 08:55:40 2004 +0000 @@ -896,15 +896,14 @@ (let ((name (format "*Customize Group: %s*" (custom-unlispify-tag-name group)))) (if (get-buffer name) - (let ((window (selected-window)) + (let ( ;; Copied from `custom-buffer-create-other-window'. (pop-up-windows t) (special-display-buffer-names nil) (special-display-regexps nil) (same-window-buffer-names nil) (same-window-regexps nil)) - (pop-to-buffer name) - (select-window window)) + (pop-to-buffer name)) (custom-buffer-create-other-window (list (list group 'custom-group)) name @@ -1240,21 +1239,20 @@ ;;;###autoload (defun custom-buffer-create-other-window (options &optional name description) - "Create a buffer containing OPTIONS. + "Create a buffer containing OPTIONS, and display it in another window. +The result includes selecting that window. Optional NAME is the name of the buffer. OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where SYMBOL is a customization option, and WIDGET is a widget for editing that option." (unless name (setq name "*Customization*")) - (let ((window (selected-window)) - (pop-up-windows t) + (let ((pop-up-windows t) (special-display-buffer-names nil) (special-display-regexps nil) (same-window-buffer-names nil) (same-window-regexps nil)) (pop-to-buffer (custom-get-fresh-buffer name)) - (custom-buffer-create-internal options description) - (select-window window))) + (custom-buffer-create-internal options description))) (defcustom custom-reset-button-menu nil "If non-nil, only show a single reset button in customize buffers.
--- a/lisp/descr-text.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/descr-text.el Thu Nov 04 08:55:40 2004 +0000 @@ -176,11 +176,12 @@ (describe-text-properties-1 pos output-buffer) (if (not (or (text-properties-at pos) (overlays-at pos))) (message "This is plain text.") - (let ((buffer (current-buffer))) - (when (eq buffer (get-buffer "*Help*")) - (error "Can't do self inspection")) + (let ((buffer (current-buffer)) + (target-buffer "*Help*")) + (when (eq buffer (get-buffer target-buffer)) + (setq target-buffer "*Help-2*")) (save-excursion - (with-output-to-temp-buffer "*Help*" + (with-output-to-temp-buffer target-buffer (set-buffer standard-output) (setq output-buffer (current-buffer)) (widget-insert "Text content at position " (format "%d" pos) ":\n\n")
--- a/lisp/dired.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/dired.el Thu Nov 04 08:55:40 2004 +0000 @@ -546,7 +546,7 @@ (if current-prefix-arg (read-string "Dired listing switches: " dired-listing-switches)) - (read-file-name (format "Dired %s(directory): " str) + (read-directory-name (format "Dired %s(directory): " str) nil default-directory nil)))) ;;;###autoload (define-key ctl-x-map "d" 'dired)
--- a/lisp/ehelp.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/ehelp.el Thu Nov 04 08:55:40 2004 +0000 @@ -85,11 +85,11 @@ (define-key map "<" 'beginning-of-buffer) (define-key map ">" 'end-of-buffer) ;(define-key map "\C-g" 'electric-help-exit) + (define-key map "Q" 'electric-help-exit) (define-key map "q" 'electric-help-exit) - (define-key map "Q" 'electric-help-exit) ;;a better key than this? + (define-key map "R" 'electric-help-retain) (define-key map "r" 'electric-help-retain) - (define-key map "R" 'electric-help-retain) (define-key map "\ex" 'electric-help-execute-extended) (define-key map "\C-x" 'electric-help-ctrl-x-prefix)
--- a/lisp/elide-head.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/elide-head.el Thu Nov 04 08:55:40 2004 +0000 @@ -98,7 +98,7 @@ (if rest (setq rest (cdr rest)))) (if (not (and beg end)) (if (interactive-p) - (error "No header found")) + (message "No header found")) (goto-char beg) (end-of-line) (if (overlayp elide-head-overlay) @@ -115,7 +115,7 @@ (overlay-buffer elide-head-overlay)) (delete-overlay elide-head-overlay) (if (interactive-p) - (error "No header hidden")))) + (message "No header hidden")))) (provide 'elide-head)
--- a/lisp/emacs-lisp/advice.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/emacs-lisp/advice.el Thu Nov 04 08:55:40 2004 +0000 @@ -3106,7 +3106,7 @@ (not advised-interactive-form)) ;; Check whether we were called interactively ;; in order to do proper prompting: - `(if (interactive-p) + `(if (called-interactively-p) (call-interactively ',origname) ,(ad-make-mapped-call orig-arglist advised-arglist
--- a/lisp/emacs-lisp/autoload.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/emacs-lisp/autoload.el Thu Nov 04 08:55:40 2004 +0000 @@ -360,11 +360,14 @@ (message "Generating autoloads for %s...done" file))) ;;;###autoload -(defun update-file-autoloads (file) +(defun update-file-autoloads (file &optional save-after) "Update the autoloads for FILE in `generated-autoload-file' \(which FILE might bind in its local variables). -Return FILE if there was no autoload cookie in it." - (interactive "fUpdate autoloads for file: ") +If SAVE-AFTER is non-nil (which is always, when called interactively), +save the buffer too. + +Return FILE if there was no autoload cookie in it, else nil." + (interactive "fUpdate autoloads for file: \np") (let ((load-name (let ((name (file-name-nondirectory file))) (if (string-match "\\.elc?\\(\\.\\|$\\)" name) (substring name 0 (match-beginning 0)) @@ -464,7 +467,7 @@ (or existing-buffer (kill-buffer (current-buffer)))))))) (generate-file-autoloads file)))) - (and (interactive-p) + (and save-after (buffer-modified-p) (save-buffer))
--- a/lisp/emacs-lisp/bytecomp.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/emacs-lisp/bytecomp.el Thu Nov 04 08:55:40 2004 +0000 @@ -98,6 +98,9 @@ ;; `obsolete' (obsolete variables and functions) ;; `noruntime' (calls to functions only defined ;; within `eval-when-compile') +;; `cl-warnings' (calls to CL functions) +;; `interactive-only' (calls to commands that are +;; not good to call from Lisp) ;; byte-compile-compatibility Whether the compiler should ;; generate .elc files which can be loaded into ;; generic emacs 18. @@ -325,7 +328,8 @@ :type 'boolean) (defconst byte-compile-warning-types - '(redefine callargs free-vars unresolved obsolete noruntime cl-functions) + '(redefine callargs free-vars unresolved + obsolete noruntime cl-functions interactive-only) "The list of warning types used when `byte-compile-warnings' is t.") (defcustom byte-compile-warnings t "*List of warnings that the byte-compiler should issue (t for all). @@ -341,13 +345,21 @@ noruntime functions that may not be defined at runtime (typically defined only under `eval-when-compile'). cl-functions calls to runtime functions from the CL package (as - distinguished from macros and aliases)." + distinguished from macros and aliases). + interactive-only + commands that normally shouldn't be called from Lisp code." :group 'bytecomp :type `(choice (const :tag "All" t) (set :menu-tag "Some" (const free-vars) (const unresolved) (const callargs) (const redefine) - (const obsolete) (const noruntime) (const cl-functions)))) + (const obsolete) (const noruntime) + (const cl-functions) (const interactive-only)))) + +(defvar byte-compile-interactive-only-functions + '(beginning-of-buffer end-of-buffer replace-string replace-regexp + insert-file) + "List of commands that are not meant to be called from Lisp.") (defvar byte-compile-not-obsolete-var nil "If non-nil, this is a variable that shouldn't be reported as obsolete.") @@ -2710,6 +2722,10 @@ (byte-compile-set-symbol-position fn) (when (byte-compile-const-symbol-p fn) (byte-compile-warn "`%s' called as a function" fn)) + (and (memq 'interactive-only byte-compile-warnings) + (memq (car form) byte-compile-interactive-only-functions) + (byte-compile-warn "`%s' used from Lisp code\n\ +That command is designed for interactive use only" fn)) (if (and handler (or (not (byte-compile-version-cond byte-compile-compatibility))
--- a/lisp/emacs-lisp/easy-mmode.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/emacs-lisp/easy-mmode.el Thu Nov 04 08:55:40 2004 +0000 @@ -209,7 +209,7 @@ ,@body ;; The on/off hooks are here for backward compatibility only. (run-hooks ',hook (if ,mode ',hook-on ',hook-off)) - (if (interactive-p) + (if (called-interactively-p) (progn ,(if globalp `(customize-mark-as-set ',mode)) (unless (current-message)
--- a/lisp/emacs-lisp/easymenu.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/emacs-lisp/easymenu.el Thu Nov 04 08:55:40 2004 +0000 @@ -42,7 +42,25 @@ :version "20.3") (defsubst easy-menu-intern (s) - (if (stringp s) (intern (downcase s)) s)) + (if (stringp s) + (let ((copy (copy-sequence s)) + (pos 0) + found) + ;; For each letter that starts a word, flip its case. + ;; This way, the usual convention for menu strings (capitalized) + ;; corresponds to the usual convention for menu item event types + ;; (all lower case). It's a 1-1 mapping so causes no conflicts. + (while (setq found (string-match "\\<\\sw" copy pos)) + (setq pos (match-end 0)) + (unless (= (upcase (aref copy found)) + (downcase (aref copy found))) + (aset copy found + (if (= (upcase (aref copy found)) + (aref copy found)) + (downcase (aref copy found)) + (upcase (aref copy found)))))) + (intern copy)) + s)) ;;;###autoload (put 'easy-menu-define 'lisp-indent-function 'defun)
--- a/lisp/emacs-lisp/elp.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/emacs-lisp/elp.el Thu Nov 04 08:55:40 2004 +0000 @@ -257,7 +257,7 @@ (setq newguts (append newguts `((elp-wrapper (quote ,funsym) ,(when (commandp funsym) - '(interactive-p)) + '(called-interactively-p)) args)))) ;; to record profiling times, we set the symbol's function ;; definition so that it runs the elp-wrapper function with the
--- a/lisp/emacs-lisp/lselect.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/emacs-lisp/lselect.el Thu Nov 04 08:55:40 2004 +0000 @@ -1,6 +1,6 @@ ;;; lselect.el --- Lucid interface to X Selections -;; Copyright (C) 1990, 1993 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1993, 2004 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: emulations @@ -146,7 +146,7 @@ (x-disown-selection-internal (if secondary-p 'SECONDARY 'PRIMARY))) (defun x-dehilight-selection (selection) - "for use as a value of x-lost-selection-hooks." + "for use as a value of `x-lost-selection-functions'." (cond ((eq selection 'PRIMARY) (if primary-selection-extent (let ((inhibit-quit t)) @@ -160,23 +160,23 @@ (setq secondary-selection-extent nil))))) nil) -(setq x-lost-selection-hooks 'x-dehilight-selection) +(setq x-lost-selection-functions 'x-dehilight-selection) (defun x-notice-selection-requests (selection type successful) - "for possible use as the value of x-sent-selection-hooks." + "for possible use as the value of `x-sent-selection-functions'." (if (not successful) (message "Selection request failed to convert %s to %s" selection type) (message "Sent selection %s as %s" selection type))) (defun x-notice-selection-failures (selection type successful) - "for possible use as the value of x-sent-selection-hooks." + "for possible use as the value of `x-sent-selection-functions'." (or successful (message "Selection request failed to convert %s to %s" selection type))) -;(setq x-sent-selection-hooks 'x-notice-selection-requests) -;(setq x-sent-selection-hooks 'x-notice-selection-failures) +;(setq x-sent-selection-functions 'x-notice-selection-requests) +;(setq x-sent-selection-functions 'x-notice-selection-failures) ;; Random utility functions @@ -232,5 +232,5 @@ (provide 'lselect) -;;; arch-tag: 92fa54d4-c5d1-4e9b-ad58-cf1e13930556 +;; arch-tag: 92fa54d4-c5d1-4e9b-ad58-cf1e13930556 ;;; lselect.el ends here
--- a/lisp/emulation/cua-base.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/emulation/cua-base.el Thu Nov 04 08:55:40 2004 +0000 @@ -1,6 +1,7 @@ ;;; cua-base.el --- emulate CUA key bindings -;; Copyright (C) 1997,98,99,200,01,02,03,04 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 +;; Free Software Foundation, Inc. ;; Author: Kim F. Storm <storm@cua.dk> ;; Keywords: keyboard emulation convenience cua @@ -266,6 +267,7 @@ :group 'editing-basics :group 'convenience :group 'emulations + :version "21.4" :link '(emacs-commentary-link :tag "Commentary" "cua-base.el") :link '(emacs-library-link :tag "Lisp File" "cua-base.el")) @@ -1337,7 +1339,6 @@ :set-after '(cua-enable-modeline-indications cua-use-hyper-key) :require 'cua-base :link '(emacs-commentary-link "cua-base.el") - :version "21.4" (setq mark-even-if-inactive t) (setq highlight-nonselected-windows nil) (make-variable-buffer-local 'cua--explicit-region-start)
--- a/lisp/eshell/em-unix.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/eshell/em-unix.el Thu Nov 04 08:55:40 2004 +0000 @@ -799,7 +799,7 @@ (size 0.0)) (while entries (unless (string-match "\\`\\.\\.?\\'" (caar entries)) - (let* ((entry (concat path (char-to-string directory-sep-char) + (let* ((entry (concat path "/" (caar entries))) (symlink (and (stringp (cadr (car entries))) (cadr (car entries)))))
--- a/lisp/fast-lock.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/fast-lock.el Thu Nov 04 08:55:40 2004 +0000 @@ -26,7 +26,7 @@ ;;; Commentary: -;; Lazy Lock mode is a Font Lock support mode. +;; Fast Lock mode is a Font Lock support mode. ;; It makes visiting a file in Font Lock mode faster by restoring its face text ;; properties from automatically saved associated Font Lock cache files. ;;
--- a/lisp/files.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/files.el Thu Nov 04 08:55:40 2004 +0000 @@ -977,6 +977,14 @@ (mapcar 'switch-to-buffer (cdr value))) (switch-to-buffer-other-frame value)))) +(defun find-file-existing (filename &optional wildcards) + "Edit the existing file FILENAME. +Like \\[find-file] but only allow files that exists." + (interactive (find-file-read-args "Find existing file: " t)) + (unless (file-exists-p filename) (error "%s does not exist" filename)) + (find-file filename wildcards) + (current-buffer)) + (defun find-file-read-only (filename &optional wildcards) "Edit file FILENAME but don't allow changes. Like \\[find-file] but marks buffer as read-only. @@ -1225,6 +1233,7 @@ When nil, never request confirmation." :group 'files :group 'find-file + :version "21.4" :type '(choice integer (const :tag "Never request confirmation" nil))) (defun find-file-noselect (filename &optional nowarn rawfile wildcards) @@ -1645,7 +1654,9 @@ (mapc (lambda (elt) (cons (purecopy (car elt)) (cdr elt))) - '(("\\.te?xt\\'" . text-mode) + '(;; do this first, so that .html.pl is Polish html, not Perl + ("\\.s?html?\\(\\.[a-zA-Z_]+\\)?\\'" . html-mode) + ("\\.te?xt\\'" . text-mode) ("\\.[tT]e[xX]\\'" . tex-mode) ("\\.ins\\'" . tex-mode) ;Installation files for TeX packages. ("\\.ltx\\'" . latex-mode) @@ -1661,7 +1672,6 @@ ("\\.ad[abs]\\'" . ada-mode) ("\\.ad[bs].dg\\'" . ada-mode) ("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode) - ("\\.s?html?\\'" . html-mode) ("\\.mk\\'" . makefile-mode) ("\\([Mm]\\|GNUm\\)akep*file\\'" . makefile-mode) ("\\.am\\'" . makefile-mode) ;For Automake. @@ -1689,7 +1699,8 @@ ("\\.bib\\'" . bibtex-mode) ("\\.sql\\'" . sql-mode) ("\\.m[4c]\\'" . m4-mode) - ("\\.m[fp]\\'" . metapost-mode) + ("\\.mf\\'" . metafont-mode) + ("\\.mp\\'" . metapost-mode) ("\\.vhdl?\\'" . vhdl-mode) ("\\.article\\'" . text-mode) ("\\.letter\\'" . text-mode) @@ -1834,20 +1845,27 @@ regular expression. The mode is then determined as the mode associated with that interpreter in `interpreter-mode-alist'.") -(defvar xml-based-modes '(html-mode) - "Modes that override an XML declaration. -When `set-auto-mode' sees an <?xml or <!DOCTYPE declaration, that -buffer will be in some XML mode. If `auto-mode-alist' associates -the file with one of the modes in this list, that mode will be -used. Else `xml-mode' or `sgml-mode' is used.") - -(defun set-auto-mode (&optional just-from-file-name) +(defvar magic-mode-alist + '(;; The < comes before the groups (but the first) to reduce backtracking. + ;; Is there a nicer way of getting . including \n? + ;; TODO: UTF-16 <?xml may be preceded by a BOM 0xff 0xfe or 0xfe 0xff. + ("\\(?:<\\?xml\\s +[^>]*>\\)?\\s *<\\(?:!--\\(?:.\\|\n\\)*?-->\\s *<\\)*\\(?:!DOCTYPE\\s +[^>]*>\\s *<\\)?\\s *\\(?:!--\\(?:.\\|\n\\)*?-->\\s *<\\)*[Hh][Tt][Mm][Ll]" . html-mode) + ;; These two must come after html, because they are more general: + ("<\\?xml " . xml-mode) + ("\\s *<\\(?:!--\\(?:.\\|\n\\)*?-->\\s *<\\)*!DOCTYPE " . sgml-mode) + ("%![^V]" . ps-mode)) + "Alist of buffer beginnings vs corresponding major mode functions. +Each element looks like (REGEXP . FUNCTION). FUNCTION will be +called, unless it is nil.") + +(defun set-auto-mode (&optional keep-mode-if-same) "Select major mode appropriate for current buffer. + This checks for a -*- mode tag in the buffer's text, checks the interpreter that runs this file against `interpreter-mode-alist', -looks for an <?xml or <!DOCTYPE declaration (see -`xml-based-modes'), or compares the filename against the entries -in `auto-mode-alist'. +compares the buffer beginning against `magic-mode-alist', +or compares the filename against the entries in +`auto-mode-alist'. It does not check for the `mode:' local variable in the Local Variables section of the file; for that, use `hack-local-variables'. @@ -1855,88 +1873,103 @@ If `enable-local-variables' is nil, this function does not check for a -*- mode tag. -If the optional argument JUST-FROM-FILE-NAME is non-nil, -then we do not set anything but the major mode, -and we don't even do that unless it would come from the file name." +If the optional argument KEEP-MODE-IF-SAME is non-nil, then we +only set the major mode, if that would change it." ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*- (let (end done mode modes xml) - (unless just-from-file-name - ;; Find a -*- mode tag - (save-excursion - (goto-char (point-min)) - (skip-chars-forward " \t\n") - ;; While we're at this point, check xml for later. - (setq xml (looking-at "<\\?xml \\|<!DOCTYPE")) - (and enable-local-variables - (setq end (set-auto-mode-1)) - (if (save-excursion (search-forward ":" end t)) - ;; Find all specifications for the `mode:' variable - ;; and execute them left to right. - (while (let ((case-fold-search t)) - (or (and (looking-at "mode:") - (goto-char (match-end 0))) - (re-search-forward "[ \t;]mode:" end t))) - (skip-chars-forward " \t") - (let ((beg (point))) - (if (search-forward ";" end t) - (forward-char -1) - (goto-char end)) - (skip-chars-backward " \t") - (push (intern (concat (downcase (buffer-substring beg (point))) "-mode")) - modes))) - ;; Simple -*-MODE-*- case. - (push (intern (concat (downcase (buffer-substring (point) end)) - "-mode")) - modes)))) - ;; If we found modes to use, invoke them now, outside the save-excursion. - (if modes + ;; Find a -*- mode tag + (save-excursion + (goto-char (point-min)) + (skip-chars-forward " \t\n") + ;; While we're at this point, check xml for later. + (setq xml (looking-at "<\\?xml \\|<!DOCTYPE")) + (and enable-local-variables + (setq end (set-auto-mode-1)) + (if (save-excursion (search-forward ":" end t)) + ;; Find all specifications for the `mode:' variable + ;; and execute them left to right. + (while (let ((case-fold-search t)) + (or (and (looking-at "mode:") + (goto-char (match-end 0))) + (re-search-forward "[ \t;]mode:" end t))) + (skip-chars-forward " \t") + (let ((beg (point))) + (if (search-forward ";" end t) + (forward-char -1) + (goto-char end)) + (skip-chars-backward " \t") + (push (intern (concat (downcase (buffer-substring beg (point))) "-mode")) + modes))) + ;; Simple -*-MODE-*- case. + (push (intern (concat (downcase (buffer-substring (point) end)) + "-mode")) + modes)))) + ;; If we found modes to use, invoke them now, outside the save-excursion. + (if modes + (catch 'nop (dolist (mode (nreverse modes)) (if (not (functionp mode)) (message "Ignoring unknown mode `%s'" mode) (setq done t) - (funcall mode))) - ;; If we didn't, look for an interpreter specified in the first line. - ;; As a special case, allow for things like "#!/bin/env perl", which - ;; finds the interpreter anywhere in $PATH. - (setq mode (save-excursion - (goto-char (point-min)) - (if (looking-at auto-mode-interpreter-regexp) - (match-string 2) - "")) - ;; Map interpreter name to a mode, signalling we're done at the - ;; same time. - done (assoc (file-name-nondirectory mode) - interpreter-mode-alist)) - ;; If we found an interpreter mode to use, invoke it now. - (if done (funcall (cdr done))))) - (if (and (not done) buffer-file-name) - (let ((name buffer-file-name)) - ;; Remove backup-suffixes from file name. - (setq name (file-name-sans-versions name)) - (while (not done) - ;; Find first matching alist entry. - (let ((case-fold-search - (memq system-type '(vax-vms windows-nt cygwin)))) - (if (and (setq mode (assoc-default name auto-mode-alist + (or (set-auto-mode-0 mode keep-mode-if-same) + (throw 'nop nil))))) + ;; If we didn't, look for an interpreter specified in the first line. + ;; As a special case, allow for things like "#!/bin/env perl", which + ;; finds the interpreter anywhere in $PATH. + (setq mode (save-excursion + (goto-char (point-min)) + (if (looking-at auto-mode-interpreter-regexp) + (match-string 2) + "")) + ;; Map interpreter name to a mode, signalling we're done at the + ;; same time. + done (assoc (file-name-nondirectory mode) + interpreter-mode-alist))) + ;; If we found an interpreter mode to use, invoke it now. + (if done + (set-auto-mode-0 (cdr done) keep-mode-if-same) + (if (setq done (save-excursion + (goto-char (point-min)) + (assoc-default nil magic-mode-alist + (lambda (re dummy) + (looking-at re))))) + (set-auto-mode-0 done keep-mode-if-same) + (if buffer-file-name + (let ((name buffer-file-name)) + ;; Remove backup-suffixes from file name. + (setq name (file-name-sans-versions name)) + (while name + ;; Find first matching alist entry. + (let ((case-fold-search + (memq system-type '(vax-vms windows-nt cygwin)))) + (if (and (setq mode (assoc-default name auto-mode-alist 'string-match)) - (consp mode) - (cadr mode)) - (setq mode (car mode) - name (substring name 0 (match-beginning 0))) - (setq done t))) - (if mode - ;; When JUST-FROM-FILE-NAME is set, we are working on behalf - ;; of set-visited-file-name. In that case, if the major mode - ;; specified is the same one we already have, don't actually - ;; reset it. We don't want to lose minor modes such as Font - ;; Lock. - (unless (and just-from-file-name (eq mode major-mode)) - (if (if xml (memq mode xml-based-modes) t) - (funcall mode) - (xml-mode))))))) - (and (not done) - xml - (xml-mode)))) + (consp mode) + (cadr mode)) + (setq mode (car mode) + name (substring name 0 (match-beginning 0))) + (setq name))) + (when mode + (set-auto-mode-0 mode keep-mode-if-same))))))))) + + +;; When `keep-mode-if-same' is set, we are working on behalf of +;; set-visited-file-name. In that case, if the major mode specified is the +;; same one we already have, don't actually reset it. We don't want to lose +;; minor modes such as Font Lock. +(defun set-auto-mode-0 (mode &optional keep-mode-if-same) + "Apply MODE and return it. +If optional arg KEEP-MODE-IF-SAME is non-nil, MODE is chased of +any aliases and compared to current major mode. If they are the +same, do nothing and return nil." + (when keep-mode-if-same + (while (symbolp (symbol-function mode)) + (setq mode (symbol-function mode))) + (if (eq mode major-mode) + (setq mode nil))) + (when mode + (funcall mode) + mode)) (defun set-auto-mode-1 () @@ -3797,7 +3830,7 @@ (defun kill-some-buffers (&optional list) "Kill some buffers. Asks the user whether to kill each one of them. -Non-interactively, if optional argument LIST is non-`nil', it +Non-interactively, if optional argument LIST is non-nil, it specifies the list of buffers to kill, asking for approval for each one." (interactive) (if (null list)
--- a/lisp/gnus/ChangeLog Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/gnus/ChangeLog Thu Nov 04 08:55:40 2004 +0000 @@ -1,3 +1,158 @@ +2004-11-04 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art. (gnus-article-edit-article): Don't associate the + article buffer with a draft file. This is a temporary measure + against the 2004-08-22 change to gnus-article-edit-mode. + +2004-11-02 Katsumi Yamaoka <yamaoka@jpl.org> + + * html2text.el (html2text-get-attr): Remove unused argument `tag'. + (html2text-format-tags): Remove unused variable `attr'. + + * mm-util.el (mm-enrich-utf-8-by-mule-ucs): Fix cleaning of + after-load-alist. + + * mm-util.el (mm-mime-mule-charset-alist): Add the windows-1251 + entry. From Ilya N. Golubev <gin@mo.msk.ru>. + (mm-enrich-utf-8-by-mule-ucs): New function run when Mule-UCS is + loaded under XEmacs. + (): Don't make duplicated entries in mm-mime-mule-charset-alist. + + * mm-util.el (mm-coding-system-p): Return a coding-system. + (mm-mime-mule-charset-alist): Use shift_jis instead of + iso-2022-jp-2 for the katakana-jisx0201 mule charset; add new + entries for the mime charsets iso-2022-jp-3 and shift_jis. + (mm-coding-system-priorities): Use shift_jis and iso-8859-1 + instead of japanese-shift-jis and iso-latin-1 respectively in + order to share the default value with both Emacs and XEmacs-mule. + (mm-mule-charset-to-mime-charset): Make + mm-coding-system-priorities effective. + (mm-sort-coding-systems-predicate): Canonicalize coding-systems + while predicating of candidates upon the priorities. + +2004-11-01 Reiner Steib <Reiner.Steib@gmx.de> + + * gnus-msg.el (gnus-summary-resend-default-address): Add :version. + + * tls.el (tls-process-connection-type, tls-success) + (tls-certtool-program): Add :version. + + * starttls.el (starttls-gnutls-program, starttls-use-gnutls) + (starttls-extra-arguments, starttls-process-connection-type) + (starttls-connect, starttls-failure, starttls-success): + + * spam-stat.el (spam-stat): Add :version. + + * sieve.el (sieve): Add :version. + + * sha1.el (sha1): Added :version. + (sha1-use-external): Removed redundant version. + + * nnmail.el (nnmail-split-fancy-with-parent-ignore-groups) + (nnmail-cache-ignore-groups, nnmail-spool-hook) + (nnmail-split-fancy-match-partial-words) + (nnmail-split-lowercase-expanded): + + * nndiary.el (nndiary): Add :version. + + * mml2015.el (mml2015-unabbrev-trust-alist): Add :version. + + * mml-sec.el (mml-default-sign-method) + (mml-default-encrypt-method, mml-signencrypt-style-alist): Add + :version. + + * mm-uu.el (mm-uu-diff-groups-regexp): Add :version. + + * mm-url.el (mm-url-use-external, mm-url-program) + (mm-url-arguments): Add :version. + + * mm-decode.el (mm-inline-text-html-with-w3m-keymap) + (mm-attachment-file-modes, mm-decrypt-option) + (mm-w3m-safe-url-regexp): Add :version. + + * message.el (message-cite-prefix-regexp) + (message-sendmail-envelope-from, message-minibuffer-local-map) + (message-user-fqdn, message-completion-alist): Add :version. + + * gnus-win.el (gnus-configure-windows-hook) + (gnus-use-frames-on-any-display): Add :version. + + * gnus-art.el (gnus-article-address-banner-alist) + (gnus-treat-unsplit-urls, gnus-treat-unfold-headers) + (gnus-treat-from-picon, gnus-treat-mail-picon) + (gnus-treat-x-pgp-sig): Add :version. + + * gnus-sum.el (gnus-spam-mark, gnus-recent-mark) + (gnus-undownloaded-mark, gnus-summary-article-move-hook) + (gnus-summary-article-delete-hook) + (gnus-summary-display-while-building): Add :version. + + * gnus-start.el (gnus-subscribe-newsgroup-hooks) + (gnus-get-top-new-news-hook):Add :version. + + * gnus-srvr.el (gnus-server-agent-face, gnus-server-opened-face) + (gnus-server-closed-face, gnus-server-denied-face): Add :version. + + * gnus-registry.el (gnus-registry): Add :version. + + * gnus-spec.el (gnus-use-correct-string-widths) + (gnus-make-format-preserve-properties): Add :version. + + * gnus.el (gnus-group-charter-alist) + (gnus-group-fetch-control-use-browse-url) + (gnus-install-group-spam-parameters): Add :version. + + * gnus-diary.el (gnus-diary): Add :version. + + * gnus-delay.el (gnus-delay): Add :version. + + * gnus-cite.el (gnus-cite-unsightly-citation-regexp) + (gnus-cite-ignore-quoted-from, gnus-cite-attribution-face) + (gnus-cite-blank-line-after-header, gnus-article-boring-faces): + Add :version. + + * gnus-agent.el (gnus-agent-max-fetch-size) + (gnus-agent-enable-expiration, gnus-agent-queue-mail) + (gnus-agent-prompt-send-queue): Add :version. + + * deuglify.el (gnus-outlook-deuglify): Add :version. + + * html2text.el: Beautify code. Improve doc strings. Some checkdoc + cleanup. + (html2text-get-attr, html2text-fix-paragraph): Simplify code. + (html2text-format-tag-list): Added "strong" and "em". From + "Alfred M. Szmidt" <ams@kemisten.nu> (tiny change). + +2004-10-29 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-msg.el (gnus-configure-posting-styles): Work with empty + signature file. Suggested by Manoj Srivastava + <srivasta@golden-gryphon.com>. + + * mm-util.el (mm-coding-system-priorities): Prefer iso-8859-1 than + iso-2022-jp even in the Japanese language environment. Suggested + by Jason Rumney <jasonr@gnu.org>. + +2004-10-28 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-sum.el (gnus-update-summary-mark-positions): Allow users to + use the same characters as the dummy marks; make it free from + getting affected by the language environment. + (gnus-summary-read-group-1): Update mark positions only when the + format spec is updated. + + * gnus-spec.el (gnus-update-format-specifications): Return a list + of updated types. + +2004-10-26 Katsumi Yamaoka <yamaoka@jpl.org> + + * nnspool.el (nnspool-spool-directory): Use news-path if the + news-directory variable is not bound. + + * gnus-group.el (gnus-group-line-format-alist): Convert the value + of gnus-tmp-news-method into string if it may be passed to + gnus-correct-length which takes only a string argument. + 2004-10-25 Reiner Steib <Reiner.Steib@gmx.de> * html2text.el (html2text-buffer-head): Removed. Use `goto-char'
--- a/lisp/gnus/deuglify.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/gnus/deuglify.el Thu Nov 04 08:55:40 2004 +0000 @@ -230,7 +230,8 @@ ;;; User Customizable Variables: (defgroup gnus-outlook-deuglify nil - "Deuglify articles generated by broken user agents like MS Outlook (Express).") + "Deuglify articles generated by broken user agents like MS Outlook (Express)." + :version "21.4") ;;;###autoload (defcustom gnus-outlook-deuglify-unwrap-min 45
--- a/lisp/gnus/gnus-agent.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/gnus/gnus-agent.el Thu Nov 04 08:55:40 2004 +0000 @@ -160,6 +160,7 @@ "Chunk size for `gnus-agent-fetch-session'. The function will split its article fetches into chunks smaller than this limit." + :version "21.4" :group 'gnus-agent :type 'integer) @@ -170,6 +171,7 @@ to disable expiration in specific categories, topics, and groups. Of course, you could change gnus-agent-enable-expiration to DISABLE then enable expiration per categories, topics, and groups." + :version "21.4" :group 'gnus-agent :type '(radio (const :format "Enable " ENABLE) (const :format "Disable " DISABLE))) @@ -195,6 +197,7 @@ "Whether and when outgoing mail should be queued by the agent. When `always', always queue outgoing mail. When nil, never queue. Otherwise, queue if and only if unplugged." + :version "21.4" :group 'gnus-agent :type '(radio (const :format "Always" always) (const :format "Never" nil) @@ -203,6 +206,7 @@ (defcustom gnus-agent-prompt-send-queue nil "If non-nil, `gnus-group-send-queue' will prompt if called when unplugged." + :version "21.4" :group 'gnus-agent :type 'boolean)
--- a/lisp/gnus/gnus-art.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/gnus/gnus-art.el Thu Nov 04 08:55:40 2004 +0000 @@ -318,6 +318,7 @@ (symbol :tag "Item in `gnus-article-banner-alist'" none) regexp (const :tag "None" nil)))) + :version "21.4" :group 'gnus-article-washing) (defcustom gnus-emphasis-alist @@ -920,6 +921,7 @@ "Remove newlines from within URLs. Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' for details." + :version "21.4" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) @@ -1124,6 +1126,7 @@ "Unfold folded header lines. Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' for details." + :version "21.4" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) @@ -1238,6 +1241,7 @@ Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' and Info node `(gnus)Picons' for details." + :version "21.4" :group 'gnus-article-treat :group 'gnus-picon :link '(custom-manual "(gnus)Customizing Articles") @@ -1253,6 +1257,7 @@ Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' and Info node `(gnus)Picons' for details." + :version "21.4" :group 'gnus-article-treat :group 'gnus-picon :link '(custom-manual "(gnus)Customizing Articles") @@ -1338,6 +1343,7 @@ To automatically treat X-PGP-Sig, set it to head. Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' for details." + :version "21.4" :group 'gnus-article-treat :group 'mime-security :link '(custom-manual "(gnus)Customizing Articles") @@ -5645,7 +5651,10 @@ "Start editing the contents of the current article buffer." (let ((winconf (current-window-configuration))) (set-buffer gnus-article-buffer) - (gnus-article-edit-mode) + (let ((message-auto-save-directory + ;; Don't associate the article buffer with a draft file. + nil)) + (gnus-article-edit-mode)) (funcall start-func) (set-buffer-modified-p nil) (gnus-configure-windows 'edit-article)
--- a/lisp/gnus/gnus-cite.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/gnus/gnus-cite.el Thu Nov 04 08:55:40 2004 +0000 @@ -124,6 +124,7 @@ (defcustom gnus-cite-unsightly-citation-regexp "^-----Original Message-----\nFrom: \\(.+\n\\)+\n" "Regexp matching Microsoft-type rest-of-message citations." + :version "21.4" :group 'gnus-cite :type 'regexp) @@ -131,6 +132,7 @@ "Non-nil means don't regard lines beginning with \">From \" as cited text. Those lines may have been quoted by MTAs in order not to mix up with the envelope From line." + :version "21.4" :group 'gnus-cite :type 'boolean) @@ -141,6 +143,7 @@ (defcustom gnus-cite-attribution-face 'gnus-cite-attribution-face "Face used for attribution lines. It is merged with the face for the cited text belonging to the attribution." + :version "21.4" :group 'gnus-cite :type 'face) @@ -278,7 +281,6 @@ (defcustom gnus-cite-blank-line-after-header t "If non-nil, put a blank line between the citation header and the button." - :version "21.4" :group 'gnus-cite :type 'boolean) @@ -290,7 +292,6 @@ If an article has more pages below the one you are looking at, but nothing on those pages is a word of at least three letters that is not in a boring face, then the pages will be skipped." - :version "21.4" :type '(repeat face) :group 'gnus-article-hiding)
--- a/lisp/gnus/gnus-delay.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/gnus/gnus-delay.el Thu Nov 04 08:55:40 2004 +0000 @@ -41,6 +41,7 @@ ;;;###autoload (defgroup gnus-delay nil "Arrange for sending postings later." + :version "21.4" :group 'gnus) (defcustom gnus-delay-group "delayed"
--- a/lisp/gnus/gnus-diary.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/gnus/gnus-diary.el Thu Nov 04 08:55:40 2004 +0000 @@ -102,7 +102,8 @@ (require 'gnus-art) (defgroup gnus-diary nil - "Utilities on top of the nndiary backend for Gnus.") + "Utilities on top of the nndiary backend for Gnus." + :version "21.4") (defcustom gnus-diary-summary-line-format "%U%R%z %uD: %(%s%) (%ud)\n" "*Summary line format for nndiary groups."
--- a/lisp/gnus/gnus-group.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/gnus/gnus-group.el Thu Nov 04 08:55:40 2004 +0000 @@ -491,7 +491,10 @@ (?O gnus-tmp-moderated-string ?s) (?p gnus-tmp-process-marked ?c) (?s gnus-tmp-news-server ?s) - (?n gnus-tmp-news-method ?s) + (?n ,(if (featurep 'xemacs) + '(symbol-name gnus-tmp-news-method) + 'gnus-tmp-news-method) + ?s) (?P gnus-group-indentation ?s) (?E gnus-tmp-group-icon ?s) (?B gnus-tmp-summary-live ?c)
--- a/lisp/gnus/gnus-msg.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/gnus/gnus-msg.el Thu Nov 04 08:55:40 2004 +0000 @@ -281,6 +281,7 @@ "If non-nil, Gnus tries to suggest a default address to resend to. If nil, the address field will always be empty after invoking `gnus-summary-resend-message'." + :version "21.4" :group 'gnus-message :type 'boolean) @@ -1871,8 +1872,9 @@ (setq v (with-temp-buffer (insert-file-contents v) (goto-char (point-max)) - (while (bolp) - (delete-char -1)) + (skip-chars-backward "\n") + (delete-region (+ (point) (if (bolp) 0 1)) + (point-max)) (buffer-string)))) (setq results (delq (assoc element results) results)) (push (cons element v) results))))
--- a/lisp/gnus/gnus-registry.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/gnus/gnus-registry.el Thu Nov 04 08:55:40 2004 +0000 @@ -66,6 +66,7 @@ (defgroup gnus-registry nil "The Gnus registry." + :version "21.4" :group 'gnus) (defvar gnus-registry-hashtb nil
--- a/lisp/gnus/gnus-spec.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/gnus/gnus-spec.el Thu Nov 04 08:55:40 2004 +0000 @@ -32,12 +32,14 @@ (defcustom gnus-use-correct-string-widths (featurep 'xemacs) "*If non-nil, use correct functions for dealing with wide characters." + :version "21.4" :group 'gnus-format :type 'boolean) (defcustom gnus-make-format-preserve-properties (featurep 'xemacs) "*If non-nil, use a replacement `format' function which preserves text properties. This is only needed on XEmacs, as FSF Emacs does this anyway." + :version "21.4" :group 'gnus-format :type 'boolean) @@ -183,7 +185,8 @@ (insert (gnus-pp-to-string spec)))) (defun gnus-update-format-specifications (&optional force &rest types) - "Update all (necessary) format specifications." + "Update all (necessary) format specifications. +Return a list of updated types." ;; Make the indentation array. ;; See whether all the stored info needs to be flushed. (when (or force @@ -195,13 +198,12 @@ (setq gnus-format-specs nil)) ;; Go through all the formats and see whether they need updating. - (let (new-format entry type val) + (let (new-format entry type val updated) (while (setq type (pop types)) ;; Jump to the proper buffer to find out the value of the ;; variable, if possible. (It may be buffer-local.) (save-excursion - (let ((buffer (intern (format "gnus-%s-buffer" type))) - val) + (let ((buffer (intern (format "gnus-%s-buffer" type)))) (when (and (boundp buffer) (setq val (symbol-value buffer)) (gnus-buffer-exists-p val)) @@ -231,10 +233,12 @@ (setcar (cdr entry) val) (setcar entry new-format)) (push (list type new-format val) gnus-format-specs)) - (set (intern (format "gnus-%s-line-format-spec" type)) val))))) + (set (intern (format "gnus-%s-line-format-spec" type)) val) + (push type updated)))) - (unless (assq 'version gnus-format-specs) - (push (cons 'version emacs-version) gnus-format-specs))) + (unless (assq 'version gnus-format-specs) + (push (cons 'version emacs-version) gnus-format-specs)) + updated)) (defvar gnus-mouse-face-0 'highlight) (defvar gnus-mouse-face-1 'highlight)
--- a/lisp/gnus/gnus-srvr.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/gnus/gnus-srvr.el Thu Nov 04 08:55:40 2004 +0000 @@ -205,21 +205,25 @@ (defcustom gnus-server-agent-face 'gnus-server-agent-face "Face name to use on AGENTIZED servers." + :version "21.4" :group 'gnus-server-visual :type 'face) (defcustom gnus-server-opened-face 'gnus-server-opened-face "Face name to use on OPENED servers." + :version "21.4" :group 'gnus-server-visual :type 'face) (defcustom gnus-server-closed-face 'gnus-server-closed-face "Face name to use on CLOSED servers." + :version "21.4" :group 'gnus-server-visual :type 'face) (defcustom gnus-server-denied-face 'gnus-server-denied-face "Face name to use on DENIED servers." + :version "21.4" :group 'gnus-server-visual :type 'face)
--- a/lisp/gnus/gnus-start.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/gnus/gnus-start.el Thu Nov 04 08:55:40 2004 +0000 @@ -299,6 +299,7 @@ (defcustom gnus-subscribe-newsgroup-hooks nil "*Hooks run after you subscribe to a new group. The hooks will be called with new group's name as argument." + :version "21.4" :group 'gnus-group-new :type 'hook) @@ -405,6 +406,7 @@ (defcustom gnus-get-top-new-news-hook nil "A hook run just before Gnus checks for new news globally." + :version "21.4" :group 'gnus-group-new :type 'hook)
--- a/lisp/gnus/gnus-sum.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/gnus/gnus-sum.el Thu Nov 04 08:55:40 2004 +0000 @@ -469,6 +469,7 @@ (defcustom gnus-spam-mark ?$ "*Mark used for spam articles." + :version "21.4" :group 'gnus-summary-marks :type 'character) @@ -505,6 +506,7 @@ (defcustom gnus-recent-mark ?N "*Mark used for articles that are recent." + :version "21.4" :group 'gnus-summary-marks :type 'character) @@ -552,6 +554,7 @@ (defcustom gnus-undownloaded-mark ?- "*Mark used for articles that weren't downloaded." + :version "21.4" :group 'gnus-summary-marks :type 'character) @@ -890,16 +893,19 @@ (defcustom gnus-summary-article-move-hook nil "*A hook called after an article is moved, copied, respooled, or crossposted." + :version "21.4" :group 'gnus-summary :type 'hook) (defcustom gnus-summary-article-delete-hook nil "*A hook called after an article is deleted." + :version "21.4" :group 'gnus-summary :type 'hook) (defcustom gnus-summary-article-expire-hook nil "*A hook called after an article is expired." + :version "21.4" :group 'gnus-summary :type 'hook) @@ -3225,43 +3231,54 @@ (save-excursion (when (gnus-buffer-exists-p gnus-summary-buffer) (set-buffer gnus-summary-buffer)) - (let ((gnus-replied-mark 129) - (gnus-score-below-mark 130) - (gnus-score-over-mark 130) - (gnus-undownloaded-mark 131) - (spec gnus-summary-line-format-spec) - gnus-visual pos) + (let ((spec gnus-summary-line-format-spec) + pos) (save-excursion (gnus-set-work-buffer) - (let ((gnus-summary-line-format-spec spec) + (let ((gnus-tmp-unread ?Z) + (gnus-replied-mark ?Z) + (gnus-score-below-mark ?Z) + (gnus-score-over-mark ?Z) + (gnus-undownloaded-mark ?Z) + (gnus-summary-line-format-spec spec) (gnus-newsgroup-downloadable '(0)) - marks) - (insert ?\200 "\200" ?\201 "\201" ?\202 "\202" ?\203 "\203") - (while (not (bobp)) - (push (buffer-substring (1- (point)) (point)) marks) - (backward-char)) + (header [0 "" "" "05 Apr 2001 23:33:09 +0400" "" "" 0 0 "" nil]) + case-fold-search ignores) + ;; Here, all marks are bound to Z. + (gnus-summary-insert-line header + 0 nil t gnus-tmp-unread t nil "" nil 1) + (goto-char (point-min)) + ;; Memorize the positions of the same characters as dummy marks. + (while (re-search-forward "[A-D]" nil t) + (push (point) ignores)) (erase-buffer) - (gnus-summary-insert-line - [0 "" "" "05 Apr 2001 23:33:09 +0400" "" "" 0 0 "" nil] - 0 nil t 128 t nil "" nil 1) + ;; We use A-D as dummy marks in order to know column positions + ;; where marks should be inserted. + (setq gnus-tmp-unread ?A + gnus-replied-mark ?B + gnus-score-below-mark ?C + gnus-score-over-mark ?C + gnus-undownloaded-mark ?D) + (gnus-summary-insert-line header + 0 nil t gnus-tmp-unread t nil "" nil 1) + ;; Ignore characters which aren't dummy marks. + (dolist (p ignores) + (delete-region (goto-char (1- p)) p) + (insert ?Z)) (goto-char (point-min)) (setq pos (list (cons 'unread - (and (or (search-forward (nth 0 marks) nil t) - (search-forward (nth 1 marks) nil t)) + (and (search-forward "A" nil t) (- (point) (point-min) 1))))) (goto-char (point-min)) - (push (cons 'replied (and (or (search-forward (nth 2 marks) nil t) - (search-forward (nth 3 marks) nil t)) + (push (cons 'replied (and (search-forward "B" nil t) (- (point) (point-min) 1))) pos) (goto-char (point-min)) - (push (cons 'score (and (or (search-forward (nth 4 marks) nil t) - (search-forward (nth 5 marks) nil t)) + (push (cons 'score (and (search-forward "C" nil t) (- (point) (point-min) 1))) pos) (goto-char (point-min)) - (push (cons 'download (and (or (search-forward (nth 6 marks) nil t) - (search-forward (nth 7 marks) nil t)) + (push (cons 'download (and (search-forward "D" nil t) (- (point) (point-min) 1))) pos))) (setq gnus-summary-mark-positions pos)))) @@ -3559,9 +3576,11 @@ (gnus-active gnus-newsgroup-name))) ;; You can change the summary buffer in some way with this hook. (gnus-run-hooks 'gnus-select-group-hook) - (gnus-update-format-specifications - nil 'summary 'summary-mode 'summary-dummy) - (gnus-update-summary-mark-positions) + (when (memq 'summary (gnus-update-format-specifications + nil 'summary 'summary-mode 'summary-dummy)) + ;; The format specification for the summary line was updated, + ;; so we need to update the mark positions as well. + (gnus-update-summary-mark-positions)) ;; Do score processing. (when gnus-use-scoring (gnus-possibly-score-headers)) @@ -9165,6 +9184,7 @@ "If non-nil, show and update the summary buffer as it's being built. If the value is t, update the buffer after every line is inserted. If the value is an integer (N), update the display every N lines." + :version "21.4" :group 'gnus-thread :type '(choice (const :tag "off" nil) number
--- a/lisp/gnus/gnus-win.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/gnus/gnus-win.el Thu Nov 04 08:55:40 2004 +0000 @@ -62,6 +62,7 @@ "*If non-nil, frames on all displays will be considered useable by Gnus. When nil, only frames on the same display as the selected frame will be used to display Gnus windows." + :version "21.4" :group 'gnus-windows :type 'boolean) @@ -198,6 +199,7 @@ (defcustom gnus-configure-windows-hook nil "*A hook called when configuring windows." + :version "21.4" :group 'gnus-windows :type 'hook)
--- a/lisp/gnus/gnus.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/gnus/gnus.el Thu Nov 04 08:55:40 2004 +0000 @@ -1314,6 +1314,7 @@ (gnus-replace-in-string name "\\." "-") "-charter.html"))) "*An alist of (HIERARCHY . FORM) pairs used to construct the URL of a charter. When FORM is evaluated `name' is bound to the name of the group." + :version "21.4" :group 'gnus-group-various :type '(repeat (cons (string :tag "Hierarchy") (sexp :tag "Form")))) @@ -1321,6 +1322,7 @@ "*Non-nil means that control messages are displayed using `browse-url'. Otherwise they are fetched with ange-ftp and displayed in an ephemeral group." + :version "21.4" :group 'gnus-group-various :type 'boolean) @@ -1788,6 +1790,7 @@ (defcustom gnus-install-group-spam-parameters t "*Disable the group parameters for spam detection. Enable if `G c' in XEmacs is giving you trouble, and make sure to submit a bug report." + :version "21.4" :type 'boolean :group 'gnus-start)
--- a/lisp/gnus/html2text.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/gnus/html2text.el Thu Nov 04 08:55:40 2004 +0000 @@ -24,11 +24,11 @@ ;; These functions provide a simple way to wash/clean html infected ;; mails. Definitely do not work in all cases, but some improvement -;; in readability is generally obtained. Formatting is only done in +;; in readability is generally obtained. Formatting is only done in ;; the buffer, so the next time you enter the article it will be ;; "re-htmlized". ;; -;; The main function is "html2text" +;; The main function is `html2text'. ;;; Code: @@ -47,9 +47,9 @@ "The map of entity to text. This is an alist were each element is a dotted pair consisting of an -old string, and a replacement string. This replacement is done by the -function \"html2text-substitute\" which basically performs a -replace-string operation for every element in the list. This is +old string, and a replacement string. This replacement is done by the +function `html2text-substitute' which basically performs a +`replace-string' operation for every element in the list. This is completely verbatim - without any use of REGEXP.") (defvar html2text-remove-tag-list @@ -57,11 +57,11 @@ "A list of removable tags. This is a list of tags which should be removed, without any -formatting. Observe that if you the tags in the list are presented -*without* any \"<\" or \">\". All occurences of a tag appearing in -this list are removed, irrespective of whether it is a closing or -opening tag, or if the tag has additional attributes. The actual -deletion is done by the function \"html2text-remove-tags\". +formatting. Note that tags in the list are presented *without* +any \"<\" or \">\". All occurences of a tag appearing in this +list are removed, irrespective of whether it is a closing or +opening tag, or if the tag has additional attributes. The +deletion is done by the function `html2text-remove-tags'. For instance the text: @@ -75,8 +75,10 @@ (defvar html2text-format-tag-list '(("b" . html2text-clean-bold) + ("strong" . html2text-clean-bold) ("u" . html2text-clean-underline) ("i" . html2text-clean-italic) + ("em" . html2text-clean-italic) ("blockquote" . html2text-clean-blockquote) ("a" . html2text-clean-anchor) ("ul" . html2text-clean-ul) @@ -86,7 +88,7 @@ "An alist of tags and processing functions. This is an alist where each dotted pair consists of a tag, and then -the name of a function to be called when this tag is found. The +the name of a function to be called when this tag is found. The function is called with the arguments p1, p2, p3 and p4. These are demontrated below: @@ -117,17 +119,15 @@ ;; -(defun html2text-replace-string (from-string to-string p1 p2) - (goto-char p1) +(defun html2text-replace-string (from-string to-string min max) + "Replace FROM-STRING with TO-STRING in region from MIN to MAX." + (goto-char min) (let ((delta (- (string-width to-string) (string-width from-string))) (change 0)) - (while (search-forward from-string p2 t) + (while (search-forward from-string max t) (replace-match to-string) - (setq change (+ change delta)) - ) - change - ) - ) + (setq change (+ change delta))) + change)) ;; ;; </Utility functions> @@ -140,11 +140,11 @@ ;; <Functions related to attributes> i.e. <font size=+3> ;; -(defun html2text-attr-value (attr-list attr) - (nth 1 (assoc attr attr-list)) - ) +(defun html2text-attr-value (list attribute) + "Get value of ATTRIBUTE from LIST." + (nth 1 (assoc attribute list))) -(defun html2text-get-attr (p1 p2 tag) +(defun html2text-get-attr (p1 p2) (goto-char p1) (re-search-forward " +[^ ]" p2 t) (let* ((attr-string (buffer-substring-no-properties (1- (point)) (1- p2))) @@ -161,14 +161,10 @@ ((string-match "[^ ]=[^ ]" prev) (let ((attr (nth 0 (split-string prev "="))) (value (nth 1 (split-string prev "=")))) - (setq attr-list (cons (list attr value) attr-list)) - ) - ) + (setq attr-list (cons (list attr value) attr-list)))) ;; size= 3 ((string-match "[^ ]=\\'" prev) - (setq attr-list (cons (list (substring prev 0 -1) this) attr-list)) - ) - ) + (setq attr-list (cons (list (substring prev 0 -1) this) attr-list)))) (while (< index (length tmp-list)) (cond @@ -176,29 +172,20 @@ ((string-match "[^ ]=[^ ]" this) (let ((attr (nth 0 (split-string this "="))) (value (nth 1 (split-string this "=")))) - (setq attr-list (cons (list attr value) attr-list)) - ) - ) + (setq attr-list (cons (list attr value) attr-list)))) ;; size =3 ((string-match "\\`=[^ ]" this) (setq attr-list (cons (list prev (substring this 1)) attr-list))) - ;; size= 3 ((string-match "[^ ]=\\'" this) - (setq attr-list (cons (list (substring this 0 -1) next) attr-list)) - ) - + (setq attr-list (cons (list (substring this 0 -1) next) attr-list))) ;; size = 3 ((string= "=" this) - (setq attr-list (cons (list prev next) attr-list)) - ) - ) + (setq attr-list (cons (list prev next) attr-list)))) (setq index (1+ index)) (setq prev this) (setq this next) - (setq next (nth (1+ index) tmp-list)) - ) - + (setq next (nth (1+ index) tmp-list))) ;; ;; Tags with no accompanying "=" i.e. value=nil ;; @@ -207,41 +194,25 @@ (setq next (nth 2 tmp-list)) (setq index 1) - (if (not (string-match "=" prev)) - (progn - (if (not (string= (substring this 0 1) "=")) - (setq attr-list (cons (list prev nil) attr-list)) - ) - ) - ) - + (when (and (not (string-match "=" prev)) + (not (string= (substring this 0 1) "="))) + (setq attr-list (cons (list prev nil) attr-list))) (while (< index (1- (length tmp-list))) - (if (not (string-match "=" this)) - (if (not (or (string= (substring next 0 1) "=") - (string= (substring prev -1) "="))) - (setq attr-list (cons (list this nil) attr-list)) - ) - ) + (when (and (not (string-match "=" this)) + (not (or (string= (substring next 0 1) "=") + (string= (substring prev -1) "=")))) + (setq attr-list (cons (list this nil) attr-list))) (setq index (1+ index)) (setq prev this) (setq this next) - (setq next (nth (1+ index) tmp-list)) - ) + (setq next (nth (1+ index) tmp-list))) - (if this - (progn - (if (not (string-match "=" this)) - (progn - (if (not (string= (substring prev -1) "=")) - (setq attr-list (cons (list this nil) attr-list)) - ) - ) - ) - ) - ) - attr-list ;; return - value - ) - ) + (when (and this + (not (string-match "=" this)) + (not (string= (substring prev -1) "="))) + (setq attr-list (cons (list this nil) attr-list))) + ;; return - value + attr-list)) ;; ;; </Functions related to attributes> @@ -266,10 +237,7 @@ (cond ((string= list-type "ul") (insert " o ")) ((string= list-type "ol") (insert (format " %s: " item-nr))) - (t (insert " x "))) - ) - ) - ) + (t (insert " x ")))))) (defun html2text-clean-dtdd (p1 p2) (goto-char p1) @@ -308,61 +276,51 @@ (html2text-delete-single-tag p1 p2) (goto-char p1) (newline 1) - (insert (make-string fill-column ?-)) - ) + (insert (make-string fill-column ?-))) (defun html2text-clean-ul (p1 p2 p3 p4) (html2text-delete-tags p1 p2 p3 p4) - (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ul") - ) + (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ul")) (defun html2text-clean-ol (p1 p2 p3 p4) (html2text-delete-tags p1 p2 p3 p4) - (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ol") - ) + (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ol")) (defun html2text-clean-dl (p1 p2 p3 p4) (html2text-delete-tags p1 p2 p3 p4) - (html2text-clean-dtdd p1 (- p3 (- p1 p2))) - ) + (html2text-clean-dtdd p1 (- p3 (- p1 p2)))) (defun html2text-clean-center (p1 p2 p3 p4) (html2text-delete-tags p1 p2 p3 p4) - (center-region p1 (- p3 (- p2 p1))) - ) + (center-region p1 (- p3 (- p2 p1)))) (defun html2text-clean-bold (p1 p2 p3 p4) (put-text-property p2 p3 'face 'bold) - (html2text-delete-tags p1 p2 p3 p4) - ) + (html2text-delete-tags p1 p2 p3 p4)) (defun html2text-clean-title (p1 p2 p3 p4) (put-text-property p2 p3 'face 'bold) - (html2text-delete-tags p1 p2 p3 p4) - ) + (html2text-delete-tags p1 p2 p3 p4)) (defun html2text-clean-underline (p1 p2 p3 p4) (put-text-property p2 p3 'face 'underline) - (html2text-delete-tags p1 p2 p3 p4) - ) + (html2text-delete-tags p1 p2 p3 p4)) (defun html2text-clean-italic (p1 p2 p3 p4) (put-text-property p2 p3 'face 'italic) - (html2text-delete-tags p1 p2 p3 p4) - ) + (html2text-delete-tags p1 p2 p3 p4)) (defun html2text-clean-font (p1 p2 p3 p4) - (html2text-delete-tags p1 p2 p3 p4) - ) + (html2text-delete-tags p1 p2 p3 p4)) (defun html2text-clean-blockquote (p1 p2 p3 p4) - (html2text-delete-tags p1 p2 p3 p4) - ) + (html2text-delete-tags p1 p2 p3 p4)) (defun html2text-clean-anchor (p1 p2 p3 p4) - ;; If someone can explain how to make the URL clickable I will - ;; surely improve upon this. - (let* ((attr-list (html2text-get-attr p1 p2 "a")) + ;; If someone can explain how to make the URL clickable I will surely + ;; improve upon this. + ;; Maybe `goto-addr.el' can be used here. + (let* ((attr-list (html2text-get-attr p1 p2)) (href (html2text-attr-value attr-list "href"))) (delete-region p1 p4) (when href @@ -386,38 +344,27 @@ (let ((has-br-line) (refill-start) (refill-stop)) - (if (re-search-forward "<br>$" p2 t) - (setq has-br-line t) - ) - (if has-br-line - (progn - (goto-char p1) - (if (re-search-forward ".+[^<][^b][^r][^>]$" p2 t) - (progn - (beginning-of-line) - (setq refill-start (point)) - (goto-char p2) - (re-search-backward ".+[^<][^b][^r][^>]$" refill-start t) - (next-line 1) - (end-of-line) - ;; refill-stop should ideally be adjusted to - ;; accomodate the "<br>" strings which are removed - ;; between refill-start and refill-stop. Can simply - ;; be returned from my-replace-string - (setq refill-stop (+ (point) - (html2text-replace-string - "<br>" "" - refill-start (point)))) - ;; (message "Point = %s refill-stop = %s" (point) refill-stop) - ;; (sleep-for 4) - (fill-region refill-start refill-stop) - ) - ) - ) - ) - ) - (html2text-replace-string "<br>" "" p1 p2) - ) + (when (re-search-forward "<br>$" p2 t) + (goto-char p1) + (when (re-search-forward ".+[^<][^b][^r][^>]$" p2 t) + (beginning-of-line) + (setq refill-start (point)) + (goto-char p2) + (re-search-backward ".+[^<][^b][^r][^>]$" refill-start t) + (next-line 1) + (end-of-line) + ;; refill-stop should ideally be adjusted to + ;; accomodate the "<br>" strings which are removed + ;; between refill-start and refill-stop. Can simply + ;; be returned from my-replace-string + (setq refill-stop (+ (point) + (html2text-replace-string + "<br>" "" + refill-start (point)))) + ;; (message "Point = %s refill-stop = %s" (point) refill-stop) + ;; (sleep-for 4) + (fill-region refill-start refill-stop)))) + (html2text-replace-string "<br>" "" p1 p2)) ;; ;; This one is interactive ... @@ -452,7 +399,7 @@ ;; (defun html2text-remove-tags (tag-list) - "Removes the tags listed in the list \"html2text-remove-tag-list\". + "Removes the tags listed in the list `html2text-remove-tag-list'. See the documentation for that variable." (interactive) (dolist (tag tag-list) @@ -461,7 +408,7 @@ (delete-region (match-beginning 0) (match-end 0))))) (defun html2text-format-tags () - "See the variable \"html2text-format-tag-list\" for documentation" + "See the variable `html2text-format-tag-list' for documentation." (interactive) (dolist (tag-and-function html2text-format-tag-list) (let ((tag (car tag-and-function)) @@ -471,8 +418,7 @@ (point-max) t) (let ((p1) (p2 (point)) - (p3) (p4) - (attr (match-string 1))) + (p3) (p4)) (search-backward "<" (point-min) t) (setq p1 (point)) (re-search-forward (format "</%s>" tag) (point-max) t) @@ -480,27 +426,18 @@ (search-backward "</" (point-min) t) (setq p3 (point)) (funcall function p1 p2 p3 p4) - (goto-char p1) - ) - ) - ) - ) - ) + (goto-char p1)))))) (defun html2text-substitute () - "See the variable \"html2text-replace-list\" for documentation" + "See the variable `html2text-replace-list' for documentation." (interactive) (dolist (e html2text-replace-list) (goto-char (point-min)) (let ((old-string (car e)) (new-string (cdr e))) - (html2text-replace-string old-string new-string (point-min) (point-max)) - ) - ) - ) + (html2text-replace-string old-string new-string (point-min) (point-max))))) (defun html2text-format-single-elements () - "" (interactive) (dolist (tag-and-function html2text-format-single-element-list) (let ((tag (car tag-and-function)) @@ -512,12 +449,7 @@ (p2 (point))) (search-backward "<" (point-min) t) (setq p1 (point)) - (funcall function p1 p2) - ) - ) - ) - ) - ) + (funcall function p1 p2)))))) ;; ;; Main function @@ -540,6 +472,6 @@ ;; ;; </Interactive functions> ;; - +(provide 'html2text) ;;; arch-tag: e9e57b79-35d4-4de1-a647-e7e01fe56d1e ;;; html2text.el ends here
--- a/lisp/gnus/message.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/gnus/message.el Thu Nov 04 08:55:40 2004 +0000 @@ -587,6 +587,7 @@ non-word-constituents "]\\)+>+\\|[ \t]*[]>|}+]\\)+")))) "*Regexp matching the longest possible citation prefix on a line." + :version "21.4" :group 'message-insertion :link '(custom-manual "(message)Insertion Variables") :type 'regexp) @@ -743,6 +744,7 @@ "*Envelope-from when sending mail with sendmail. If this is nil, use `user-mail-address'. If it is the symbol `header', use the From: header of the message." + :version "21.4" :type '(choice (string :tag "From name") (const :tag "Use From: header from message" header) (const :tag "Use `user-mail-address'" nil)) @@ -855,7 +857,8 @@ (let ((map (make-sparse-keymap 'message-minibuffer-local-map))) (set-keymap-parent map minibuffer-local-map) map) - "Keymap for `message-read-from-minibuffer'.") + "Keymap for `message-read-from-minibuffer'." + :version "21.4") ;;;###autoload (defcustom message-citation-line-function 'message-insert-citation-line @@ -1435,6 +1438,7 @@ (defcustom message-user-fqdn nil "*Domain part of Messsage-Ids." + :version "21.4" :group 'message-headers :link '(custom-manual "(message)News Headers") :type '(radio (const :format "%v " nil) @@ -6590,6 +6594,7 @@ '("^\\(Disposition-Notification-To\\|Return-Receipt-To\\):" . message-expand-name)) "Alist of (RE . FUN). Use FUN for completion on header lines matching RE." + :version "21.4" :group 'message :type '(alist :key-type regexp :value-type function))
--- a/lisp/gnus/mm-decode.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/gnus/mm-decode.el Thu Nov 04 08:55:40 2004 +0000 @@ -150,12 +150,14 @@ matches parts embedded to the Multipart/Related type MIME contents and Gnus will never connect to the spammer's site arbitrarily. You may set this variable to nil if you consider all urls to be safe." + :version "21.4" :type '(choice (regexp :tag "Regexp") (const :tag "All URLs are safe" nil)) :group 'mime-display) (defcustom mm-inline-text-html-with-w3m-keymap t "If non-nil, use emacs-w3m command keys in the article buffer." + :version "21.4" :type 'boolean :group 'mime-display) @@ -378,6 +380,7 @@ (defcustom mm-attachment-file-modes 384 "Set the mode bits of saved attachments to this integer." + :version "21.4" :type 'integer :group 'mime-display) @@ -435,6 +438,7 @@ "Option of decrypting encrypted parts. `never', not decrypt; `always', always decrypt; `known', only decrypt known protocols. Otherwise, ask user." + :version "21.4" :type '(choice (item always) (item never) (item :tag "only known protocols" known)
--- a/lisp/gnus/mm-url.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/gnus/mm-url.el Thu Nov 04 08:55:40 2004 +0000 @@ -49,6 +49,7 @@ (require 'url) (error nil))) "*If non-nil, use external grab program `mm-url-program'." + :version "21.4" :type 'boolean :group 'mm-url) @@ -67,6 +68,7 @@ (t "GET")) "The url grab program. Likely values are `wget', `w3m', `lynx' and `curl'." + :version "21.4" :type '(choice (symbol :tag "wget" wget) (symbol :tag "w3m" w3m) @@ -77,6 +79,7 @@ (defcustom mm-url-arguments nil "The arguments for `mm-url-program'." + :version "21.4" :type '(repeat string) :group 'mm-url)
--- a/lisp/gnus/mm-util.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/gnus/mm-util.el Thu Nov 04 08:55:40 2004 +0000 @@ -123,13 +123,16 @@ (defun mm-coding-system-p (cs) "Return non-nil if CS is a symbol naming a coding system. -In XEmacs, also return non-nil if CS is a coding system object." +In XEmacs, also return non-nil if CS is a coding system object. +If CS is available, return CS itself in Emacs, and return a coding +system object in XEmacs." (if (fboundp 'find-coding-system) (find-coding-system cs) (if (fboundp 'coding-system-p) - (coding-system-p cs) + (when (coding-system-p cs) + cs) ;; Is this branch ever actually useful? - (memq cs (mm-get-coding-system-list))))) + (car (memq cs (mm-get-coding-system-list)))))) (defvar mm-charset-synonym-alist `( @@ -219,12 +222,12 @@ (big5 chinese-big5-1 chinese-big5-2) (tibetan tibetan) (thai-tis620 thai-tis620) + (windows-1251 cyrillic-iso8859-5) (iso-2022-7bit ethiopic arabic-1-column arabic-2-column) (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7 latin-jisx0201 japanese-jisx0208-1978 chinese-gb2312 japanese-jisx0208 - korean-ksc5601 japanese-jisx0212 - katakana-jisx0201) + korean-ksc5601 japanese-jisx0212) (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7 latin-jisx0201 japanese-jisx0208-1978 chinese-gb2312 japanese-jisx0208 @@ -239,6 +242,9 @@ chinese-cns11643-3 chinese-cns11643-4 chinese-cns11643-5 chinese-cns11643-6 chinese-cns11643-7) + (iso-2022-jp-3 latin-jisx0201 japanese-jisx0208-1978 japanese-jisx0208 + japanese-jisx0213-1 japanese-jisx0213-2) + (shift_jis latin-jisx0201 katakana-jisx0201 japanese-jisx0208) ,(if (or (not (fboundp 'charsetp)) ;; non-Mule case (charsetp 'unicode-a) (not (mm-coding-system-p 'mule-utf-8))) @@ -249,32 +255,56 @@ (coding-system-get 'mule-utf-8 'safe-charsets))))) "Alist of MIME-charset/MULE-charsets.") -;; Correct by construction, but should be unnecessary: -;; XEmacs hates it. -(when (and (not (featurep 'xemacs)) - (fboundp 'coding-system-list) - (fboundp 'sort-coding-systems)) - (setq mm-mime-mule-charset-alist - (apply - 'nconc - (mapcar - (lambda (cs) - (when (and (or (coding-system-get cs :mime-charset) ; Emacs 22 - (coding-system-get cs 'mime-charset)) - (not (eq t (coding-system-get cs 'safe-charsets)))) - (list (cons (or (coding-system-get cs :mime-charset) - (coding-system-get cs 'mime-charset)) - (delq 'ascii - (coding-system-get cs 'safe-charsets)))))) - (sort-coding-systems (coding-system-list 'base-only)))))) +(defun mm-enrich-utf-8-by-mule-ucs () + "Make the `utf-8' MIME charset usable by the Mule-UCS package. +This function will run when the `un-define' module is loaded under +XEmacs, and fill the `utf-8' entry in `mm-mime-mule-charset-alist' +with Mule charsets. It is completely useless for Emacs." + (unless (cdr (delete '(mm-enrich-utf-8-by-mule-ucs) + (assoc "un-define" after-load-alist))) + (setq after-load-alist + (delete '("un-define") after-load-alist))) + (when (boundp 'unicode-basic-translation-charset-order-list) + (condition-case nil + (let ((val (delq + 'ascii + (copy-sequence + (symbol-value + 'unicode-basic-translation-charset-order-list)))) + (elem (assq 'utf-8 mm-mime-mule-charset-alist))) + (if elem + (setcdr elem val) + (setq mm-mime-mule-charset-alist + (nconc mm-mime-mule-charset-alist + (list (cons 'utf-8 val)))))) + (error)))) + +;; Correct by construction, but should be unnecessary for Emacs: +(if (featurep 'xemacs) + (eval-after-load "un-define" '(mm-enrich-utf-8-by-mule-ucs)) + (when (and (fboundp 'coding-system-list) + (fboundp 'sort-coding-systems)) + (let ((css (sort-coding-systems (coding-system-list 'base-only))) + cs mime mule alist) + (while css + (setq cs (pop css) + mime (or (coding-system-get cs :mime-charset) ; Emacs 22 + (coding-system-get cs 'mime-charset))) + (when (and mime + (not (eq t (setq mule + (coding-system-get cs 'safe-charsets)))) + (not (assq mime alist))) + (push (cons mime (delq 'ascii mule)) alist))) + (setq mm-mime-mule-charset-alist (nreverse alist))))) (defcustom mm-coding-system-priorities (if (boundp 'current-language-environment) (let ((lang (symbol-value 'current-language-environment))) (cond ((string= lang "Japanese") - ;; Japanese users may prefer iso-2022-jp to shift-jis. - '(iso-2022-jp iso-2022-jp-2 japanese-shift-jis - iso-latin-1 utf-8))))) + ;; Japanese users prefer iso-2022-jp to euc-japan or + ;; shift_jis, however iso-8859-1 should be used when + ;; there are only ASCII text and Latin-1 characters. + '(iso-8859-1 iso-2022-jp iso-2022-jp-2 shift_jis utf-8))))) "Preferred coding systems for encoding outgoing messages. More than one suitable coding system may be found for some text. @@ -301,16 +331,20 @@ "Return the MIME charset corresponding to the given Mule CHARSET." (if (and (fboundp 'find-coding-systems-for-charsets) (fboundp 'sort-coding-systems)) - (let (mime) - (dolist (cs (sort-coding-systems - (copy-sequence - (find-coding-systems-for-charsets (list charset))))) - (unless mime - (when cs - (setq mime (or (coding-system-get cs :mime-charset) - (coding-system-get cs 'mime-charset)))))) + (let ((css (sort (sort-coding-systems + (find-coding-systems-for-charsets (list charset))) + 'mm-sort-coding-systems-predicate)) + cs mime) + (while (and (not mime) + css) + (when (setq cs (pop css)) + (setq mime (or (coding-system-get cs :mime-charset) + (coding-system-get cs 'mime-charset))))) mime) - (let ((alist mm-mime-mule-charset-alist) + (let ((alist (mapcar (lambda (cs) + (assq cs mm-mime-mule-charset-alist)) + (sort (mapcar 'car mm-mime-mule-charset-alist) + 'mm-sort-coding-systems-predicate))) out) (while alist (when (memq charset (cdar alist)) @@ -482,11 +516,14 @@ (let ((priorities (mapcar (lambda (cs) ;; Note: invalid entries are dropped silently - (and (coding-system-p cs) + (and (setq cs (mm-coding-system-p cs)) (coding-system-base cs))) mm-coding-system-priorities))) - (> (length (memq a priorities)) - (length (memq b priorities))))) + (and (setq a (mm-coding-system-p a)) + (if (setq b (mm-coding-system-p b)) + (> (length (memq (coding-system-base a) priorities)) + (length (memq (coding-system-base b) priorities))) + t)))) (defun mm-find-mime-charset-region (b e) "Return the MIME charsets needed to encode the region between B and E.
--- a/lisp/gnus/mm-uu.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/gnus/mm-uu.el Thu Nov 04 08:55:40 2004 +0000 @@ -80,6 +80,7 @@ (defcustom mm-uu-diff-groups-regexp "gnus\\.commits" "*Regexp matching diff groups." + :version "21.4" :type 'regexp :group 'gnus-article-mime)
--- a/lisp/gnus/mml-sec.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/gnus/mml-sec.el Thu Nov 04 08:55:40 2004 +0000 @@ -43,6 +43,7 @@ (defcustom mml-default-sign-method "pgpmime" "Default sign method. The string must have an entry in `mml-sign-alist'." + :version "21.4" :type '(choice (const "smime") (const "pgp") (const "pgpauto") @@ -60,6 +61,7 @@ (defcustom mml-default-encrypt-method "pgpmime" "Default encryption method. The string must have an entry in `mml-encrypt-alist'." + :version "21.4" :type '(choice (const "smime") (const "pgp") (const "pgpauto") @@ -83,6 +85,7 @@ understood by all PGP implementations, in particular PGP version 2 does not support it! See Info node `(message)Security' for details." + :version "21.4" :group 'message :type '(repeat (list (choice (const :tag "S/MIME" "smime") (const :tag "PGP" "pgp")
--- a/lisp/gnus/mml2015.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/gnus/mml2015.el Thu Nov 04 08:55:40 2004 +0000 @@ -83,6 +83,7 @@ ("TRUST_FULLY" . t) ("TRUST_ULTIMATE" . t)) "Map GnuPG trust output values to a boolean saying if you trust the key." + :version "21.4" :group 'mime-security :type '(repeat (cons (regexp :tag "GnuPG output regexp") (boolean :tag "Trust key"))))
--- a/lisp/gnus/nndiary.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/gnus/nndiary.el Thu Nov 04 08:55:40 2004 +0000 @@ -223,6 +223,7 @@ (defgroup nndiary nil "The Gnus Diary backend." + :version "21.4" :group 'gnus-diary) (defcustom nndiary-mail-sources
--- a/lisp/gnus/nnmail.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/gnus/nnmail.el Thu Nov 04 08:55:40 2004 +0000 @@ -119,6 +119,7 @@ (defcustom nnmail-split-fancy-with-parent-ignore-groups nil "Regexp that matches group names to be ignored when applying `nnmail-split-fancy-with-parent'. This can also be a list of regexps." + :version "21.4" :group 'nnmail-split :type '(choice (const :tag "none" nil) (regexp :value ".*") @@ -127,6 +128,7 @@ (defcustom nnmail-cache-ignore-groups nil "Regexp that matches group names to be ignored when inserting message ids into the cache (`nnmail-cache-insert'). This can also be a list of regexps." + :version "21.4" :group 'nnmail-split :type '(choice (const :tag "none" nil) (regexp :value ".*") @@ -353,6 +355,7 @@ (defcustom nnmail-spool-hook nil "*A hook called when a new article is spooled." + :version "21.4" :group 'nnmail :type 'hook) @@ -575,6 +578,7 @@ by \"\\=\\<...\\>\". If this variable is true, they are not implicitly\ surrounded by anything." + :version "21.4" :group 'nnmail :type 'boolean) @@ -582,6 +586,7 @@ "Whether to lowercase expanded entries (i.e. \\N) when splitting mails. This avoids the creation of multiple groups when users send to an address using different case (i.e. mailing-list@domain vs Mailing-List@Domain)." + :version "21.4" :group 'nnmail :type 'boolean)
--- a/lisp/gnus/nnspool.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/gnus/nnspool.el Thu Nov 04 08:55:40 2004 +0000 @@ -44,7 +44,10 @@ "Switches for nnspool-request-post to pass to `inews' for posting news. If you are using Cnews, you probably should set this variable to nil.") -(defvoo nnspool-spool-directory (file-name-as-directory news-directory) +(defvoo nnspool-spool-directory + (file-name-as-directory (if (boundp 'news-directory) + (symbol-value 'news-directory) + news-path)) "Local news spool directory.") (defvoo nnspool-nov-directory (concat nnspool-spool-directory "over.view/")
--- a/lisp/gnus/sha1.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/gnus/sha1.el Thu Nov 04 08:55:40 2004 +0000 @@ -60,6 +60,7 @@ (defgroup sha1 nil "Elisp interface for SHA1 hash computation." + :version "21.4" :group 'extensions) (defcustom sha1-maximum-internal-length 500 @@ -82,7 +83,6 @@ (error)) "*Use external SHA1 program. If this variable is set to nil, use internal function only." - :version "21.4" :type 'boolean :group 'sha1)
--- a/lisp/gnus/sieve.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/gnus/sieve.el Thu Nov 04 08:55:40 2004 +0000 @@ -65,6 +65,7 @@ (defgroup sieve nil "Manage sieve scripts." + :version "21.4" :group 'tools) (defcustom sieve-new-script "<new script>"
--- a/lisp/gnus/spam-stat.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/gnus/spam-stat.el Thu Nov 04 08:55:40 2004 +0000 @@ -128,6 +128,7 @@ Use the functions to build a dictionary of words and their statistical distribution in spam and non-spam mails. Then use a function to determine whether a buffer contains spam or not." + :version "21.4" :group 'gnus) (defcustom spam-stat-file "~/.spam-stat.el"
--- a/lisp/gnus/starttls.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/gnus/starttls.el Thu Nov 04 08:55:40 2004 +0000 @@ -126,6 +126,7 @@ "Name of GNUTLS command line tool. This program is used when GNUTLS is used, i.e. when `starttls-use-gnutls' is non-nil." + :version "21.4" :type 'string :group 'starttls) @@ -138,6 +139,7 @@ (defcustom starttls-use-gnutls (not (executable-find starttls-program)) "*Whether to use GNUTLS instead of the `starttls' command." + :version "21.4" :type 'boolean :group 'starttls) @@ -156,11 +158,13 @@ For example, non-TLS compliant servers may require '(\"--protocols\" \"ssl3\"). Invoke \"gnutls-cli --help\" to find out which parameters are available." + :version "21.4" :type '(repeat string) :group 'starttls) (defcustom starttls-process-connection-type nil "*Value for `process-connection-type' to use when starting STARTTLS process." + :version "21.4" :type 'boolean :group 'starttls) @@ -170,6 +174,7 @@ ;; GNUTLS cli.c:main() print this string when it is starting to run ;; in the application read/write phase. If the logic, or the string ;; itself, is modified, this must be updated. + :version "21.4" :type 'regexp :group 'starttls) @@ -178,6 +183,7 @@ The default is what GNUTLS's \"gnutls-cli\" outputs." ;; GNUTLS cli.c:do_handshake() print this string on failure. If the ;; logic, or the string itself, is modified, this must be updated. + :version "21.4" :type 'regexp :group 'starttls) @@ -188,6 +194,7 @@ ;; common.c:print_info(), that unconditionally print this string ;; last. If that logic, or the string itself, is modified, this ;; must be updated. + :version "21.4" :type 'regexp :group 'starttls)
--- a/lisp/help-at-pt.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/help-at-pt.el Thu Nov 04 08:55:40 2004 +0000 @@ -1,6 +1,6 @@ ;;; help-at-pt.el --- local help through the keyboard -;; Copyright (C) 2003 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2004 Free Software Foundation, Inc. ;; Author: Luc Teirlinck <teirllm@auburn.edu> ;; Keywords: help @@ -98,6 +98,13 @@ (message "%s" help) (if (not arg) (message "No local help at point"))))) +(defvar help-at-pt-timer nil + "Non-nil means that a timer is set that checks for local help. +If non-nil, this is the value returned by the call of +`run-with-idle-timer' that set that timer. This variable is used +internally to enable `help-at-pt-display-when-idle'. Do not set it +yourself.") + (defcustom help-at-pt-timer-delay 1 "*Delay before displaying local help. This is used if `help-at-pt-display-when-idle' is enabled. @@ -112,17 +119,12 @@ new value." :group 'help-at-pt :type 'number + :initialize 'custom-initialize-default :set (lambda (variable value) (set-default variable value) - (when (and (boundp 'help-at-pt-timer) help-at-pt-timer) - (timer-set-idle-time help-at-pt-timer value t)))) - -(defvar help-at-pt-timer nil - "Non-nil means that a timer is set that checks for local help. -If non-nil, this is the value returned by the call of -`run-with-idle-timer' that set that timer. This variable is used -internally to enable `help-at-pt-display-when-idle'. Do not set it -yourself.") + (and (boundp 'help-at-pt-timer) + help-at-pt-timer + (timer-set-idle-time help-at-pt-timer value t)))) ;;;###autoload (defun help-at-pt-cancel-timer () @@ -144,7 +146,6 @@ (run-with-idle-timer help-at-pt-timer-delay t #'help-at-pt-maybe-display)))) -;;;###autoload (defcustom help-at-pt-display-when-idle 'never "*Automatically show local help on point-over. If the value is t, the string obtained from any `kbd-help' or
--- a/lisp/help-fns.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/help-fns.el Thu Nov 04 08:55:40 2004 +0000 @@ -473,7 +473,7 @@ (and (symbolp obj) (boundp obj) obj)))) (error nil)) (let* ((str (find-tag-default)) - (obj (if str (read str)))) + (obj (if str (intern str)))) (and (symbolp obj) (boundp obj) obj)) 0))
--- a/lisp/help.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/help.el Thu Nov 04 08:55:40 2004 +0000 @@ -267,7 +267,7 @@ (and (symbolp obj) (fboundp obj) obj)))) (error nil)))) (let* ((str (find-tag-default)) - (obj (if str (read str)))) + (obj (if str (intern str)))) (and (symbolp obj) (fboundp obj) obj))))
--- a/lisp/ibuffer.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/ibuffer.el Thu Nov 04 08:55:40 2004 +0000 @@ -45,6 +45,7 @@ Ibuffer allows you to operate on buffers in a manner much like Dired. Operations include sorting, marking by regular expression, and the ability to filter the displayed buffers by various criteria." + :version "21.4" :group 'convenience) (defcustom ibuffer-formats '((mark modified read-only " " (name 18 18 :left :elide)
--- a/lisp/ido.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/ido.el Thu Nov 04 08:55:40 2004 +0000 @@ -338,6 +338,7 @@ "Switch between files using substrings." :group 'extensions :group 'convenience + :version "21.4" :link '(emacs-commentary-link :tag "Commentary" "ido.el") :link '(emacs-library-link :tag "Lisp File" "ido.el")) @@ -359,7 +360,6 @@ :require 'ido :link '(emacs-commentary-link "ido.el") :set-after '(ido-save-directory-list-file) - :version "21.4" :type '(choice (const :tag "Turn on only buffer" buffer) (const :tag "Turn on only file" file) (const :tag "Turn on both buffer and file" both)
--- a/lisp/imenu.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/imenu.el Thu Nov 04 08:55:40 2004 +0000 @@ -161,16 +161,17 @@ :type 'integer :group 'imenu) -(defcustom imenu-scanning-message "Scanning buffer for index (%3d%%)" - "*Progress message during the index scanning of the buffer. -If non-nil, user gets a message during the scanning of the buffer. - -Relevant only if the mode-specific function that creates the buffer -index use `imenu-progress-message', and not useful if that is fast, in -which case you might as well set this to nil." - :type '(choice string - (const :tag "None" nil)) - :group 'imenu) +;; No longer used. KFS 2004-10-27 +;; (defcustom imenu-scanning-message "Scanning buffer for index (%3d%%)" +;; "*Progress message during the index scanning of the buffer. +;; If non-nil, user gets a message during the scanning of the buffer. +;; +;; Relevant only if the mode-specific function that creates the buffer +;; index use `imenu-progress-message', and not useful if that is fast, in +;; which case you might as well set this to nil." +;; :type '(choice string +;; (const :tag "None" nil)) +;; :group 'imenu) (defcustom imenu-space-replacement "." "*The replacement string for spaces in index names. @@ -300,16 +301,22 @@ ;; is calculated. ;; PREVPOS is the variable in which we store the last position displayed. (defmacro imenu-progress-message (prevpos &optional relpos reverse) - `(and - imenu-scanning-message - (let ((pos ,(if relpos - relpos - `(imenu--relative-position ,reverse)))) - (if ,(if relpos t - `(> pos (+ 5 ,prevpos))) - (progn - (message imenu-scanning-message pos) - (setq ,prevpos pos)))))) + +;; Made obsolete/empty, as computers are now faster than the eye, and +;; it had problems updating the messages correctly, and could shadow +;; more important messages/prompts in the minibuffer. KFS 2004-10-27. + +;; `(and +;; imenu-scanning-message +;; (let ((pos ,(if relpos +;; relpos +;; `(imenu--relative-position ,reverse)))) +;; (if ,(if relpos t +;; `(> pos (+ 5 ,prevpos))) +;; (progn +;; (message imenu-scanning-message pos) +;; (setq ,prevpos pos))))) +) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -765,7 +772,7 @@ (INDEX-NAME . INDEX-POSITION) or like: (INDEX-NAME INDEX-POSITION FUNCTION ARGUMENTS...) -They may also be nested index alists like: +They may also be nested index alists like: (INDEX-NAME . INDEX-ALIST) depending on PATTERNS."
--- a/lisp/info.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/info.el Thu Nov 04 08:55:40 2004 +0000 @@ -1980,7 +1980,7 @@ (if (match-beginning 5) (string-to-number (match-string 5)) (buffer-substring (match-beginning 0) (1- (match-beginning 1))))) -;;; Comment out the next line to use names of cross-references: +;;; Uncomment next line to use names of cross-references in non-index nodes: ;;; (setq Info-point-loc ;;; (buffer-substring (match-beginning 0) (1- (match-beginning 1)))) ) @@ -3214,7 +3214,7 @@ (message "Tags may have changed. Use Info-tagify if necessary"))) (defvar Info-file-list-for-emacs - '("ediff" "eudc" "forms" "gnus" "info" ("mh" . "mh-e") + '("ediff" "eudc" "forms" "gnus" "info" ("Info" . "info") ("mh" . "mh-e") "sc" "message" ("dired" . "dired-x") "viper" "vip" "idlwave" ("c" . "ccmode") ("c++" . "ccmode") ("objc" . "ccmode") ("java" . "ccmode") ("idl" . "ccmode") ("pike" . "ccmode") @@ -3245,11 +3245,13 @@ If COMMAND has no property, the variable `Info-file-list-for-emacs' defines heuristics for which Info manual to try. The locations are of the format used in `Info-history', i.e. -\(FILENAME NODENAME BUFFERPOS\)." - (let ((where '()) +\(FILENAME NODENAME BUFFERPOS\), where BUFFERPOS is the line number +in the first element of the returned list (which is treated specially in +`Info-goto-emacs-command-node'), and 0 for the rest elements of a list." + (let ((where '()) line-number (cmd-desc (concat "^\\* +" (regexp-quote (symbol-name command)) "\\( <[0-9]+>\\)?:\\s *\\(.*\\)\\." - "\\([ \t]*(line[ \t]*[0-9]*)\\)?$")) + "\\(?:[ \t\n]+(line +\\([0-9]+\\))\\)?")) (info-file "emacs")) ;default ;; Determine which info file this command is documented in. (if (get command 'info-file) @@ -3288,11 +3290,17 @@ (cons (list Info-current-file (match-string-no-properties 2) 0) - where))) + where)) + (setq line-number (and (match-beginning 3) + (string-to-number (match-string 3))))) (and (setq nodes (cdr nodes) node (car nodes)))) (Info-goto-node node))) - where)) + (if (and line-number where) + (cons (list (nth 0 (car where)) (nth 1 (car where)) line-number) + (cdr where)) + where))) +;;;###autoload (put 'Info-goto-emacs-command-node 'info-file "emacs") ;;;###autoload (defun Info-goto-emacs-command-node (command) "Go to the Info node in the Emacs manual for command COMMAND. @@ -3316,9 +3324,11 @@ ;; Bind Info-history to nil, to prevent the last Index node ;; visited by Info-find-emacs-command-nodes from being ;; pushed onto the history. - (let ((Info-history nil) (Info-history-list nil)) - (Info-find-node (car (car where)) - (car (cdr (car where))))) + (let ((Info-history nil) (Info-history-list nil) + (line-number (nth 2 (car where)))) + (Info-find-node (nth 0 (car where)) (nth 1 (car where))) + (if (and (integerp line-number) (> line-number 0)) + (forward-line (1- line-number)))) (if (> num-matches 1) (progn ;; (car where) will be pushed onto Info-history @@ -3332,6 +3342,7 @@ (if (> num-matches 2) "them" "it"))))) (error "Couldn't find documentation for %s" command)))) +;;;###autoload (put 'Info-goto-emacs-key-command-node 'info-file "emacs") ;;;###autoload (defun Info-goto-emacs-key-command-node (key) "Go to the node in the Emacs manual which describes the command bound to KEY.
--- a/lisp/kmacro.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/kmacro.el Thu Nov 04 08:55:40 2004 +0000 @@ -1,6 +1,6 @@ ;;; kmacro.el --- enhanced keyboard macros -;; Copyright (C) 2002 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc. ;; Author: Kim F. Storm <storm@cua.dk> ;; Keywords: keyboard convenience @@ -120,6 +120,7 @@ "Simplified keyboard macro user interface." :group 'keyboard :group 'convenience + :version "21.4" :link '(emacs-commentary-link :tag "Commentary" "kmacro.el") :link '(emacs-library-link :tag "Lisp File" "kmacro.el")) @@ -222,6 +223,14 @@ (global-set-key (vector kmacro-call-mouse-event) 'kmacro-end-call-mouse)) +;;; Called from keyboard-quit + +(defun kmacro-keyboard-quit () + (or (not defining-kbd-macro) + (eq defining-kbd-macro 'append) + (kmacro-ring-empty-p) + (kmacro-pop-ring))) + ;;; Keyboard macro counter @@ -585,7 +594,9 @@ (and append (if kmacro-execute-before-append (> (car arg) 4) - (= (car arg) 4))))))) + (= (car arg) 4)))) + (if (and defining-kbd-macro append) + (setq defining-kbd-macro 'append))))) ;;;###autoload
--- a/lisp/mail/emacsbug.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/mail/emacsbug.el Thu Nov 04 08:55:40 2004 +0000 @@ -128,6 +128,9 @@ (insert "\n\n\n") (insert "In " (emacs-version) "\n") + (if (fboundp 'x-server-vendor) + (insert "Distributor `" (x-server-vendor) "', version " + (mapconcat 'number-to-string (x-server-version) ".") "\n")) (if (and system-configuration-options (not (equal system-configuration-options ""))) (insert "configured using `configure "
--- a/lisp/makefile.w32-in Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/makefile.w32-in Thu Nov 04 08:55:40 2004 +0000 @@ -171,7 +171,7 @@ touch $@ custom-deps: cus-load.el doit @echo Directories: $(WINS) - -$(emacs) -l cus-dep --eval $(ARGQUOTE)(setq find-file-hooks nil)$(ARGQUOTE) -f custom-make-dependencies $(lisp) $(WINS) + -$(emacs) -l cus-dep --eval $(ARGQUOTE)(setq find-file-hook nil)$(ARGQUOTE) -f custom-make-dependencies $(lisp) $(WINS) finder-data: doit @echo Directories: $(WINS) @@ -221,7 +221,7 @@ autoloads: loaddefs.el doit @echo Directories: $(WINS) $(emacs) -l autoload \ - --eval $(ARGQUOTE)(setq find-file-hooks nil \ + --eval $(ARGQUOTE)(setq find-file-hook nil \ find-file-suppress-same-file-warnings t \ generated-autoload-file \ $(DQUOTE)$(lisp)/loaddefs.el$(DQUOTE))$(ARGQUOTE) \
--- a/lisp/man.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/man.el Thu Nov 04 08:55:40 2004 +0000 @@ -426,7 +426,7 @@ (view-file f) (error "Cannot read a file: %s" f)) (error "Cannot find a file: %s" f)))) - 'help-echo "mouse-2: mouse-2: display this file") + 'help-echo "mouse-2: display this file") ;; ======================================================================
--- a/lisp/menu-bar.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/menu-bar.el Thu Nov 04 08:55:40 2004 +0000 @@ -186,10 +186,15 @@ '(menu-item "Open Directory..." dired :help "Read a directory, operate on its files")) (define-key menu-bar-files-menu [open-file] - '(menu-item "Open File..." find-file + '(menu-item "Open File..." find-file-existing :enable (not (window-minibuffer-p (frame-selected-window menu-updating-frame))) - :help "Read a file into an Emacs buffer")) + :help "Read an existing file into an Emacs buffer")) +(define-key menu-bar-files-menu [new-file] + '(menu-item "New File..." find-file + :enable (not (window-minibuffer-p + (frame-selected-window menu-updating-frame))) + :help "Read or create a file and edit it")) ;; The "Edit" menu items
--- a/lisp/mouse-sel.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/mouse-sel.el Thu Nov 04 08:55:40 2004 +0000 @@ -1,6 +1,7 @@ ;;; mouse-sel.el --- multi-click selection support for Emacs 19 -;; Copyright (C) 1993,1994,1995,2001,2002 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 1995, 2001, 2002, 2004 +;; Free Software Foundation, Inc. ;; Author: Mike Williams <mdub@bigfoot.com> ;; Keywords: mouse @@ -243,7 +244,7 @@ :group 'mouse-sel (if mouse-sel-mode (progn - (add-hook 'x-lost-selection-hooks 'mouse-sel-lost-selection-hook) + (add-hook 'x-lost-selection-functions 'mouse-sel-lost-selection-hook) (when mouse-sel-default-bindings ;; Save original bindings and replace them with new ones. (setq mouse-sel-original-bindings @@ -263,7 +264,7 @@ interprogram-paste-function nil)))) ;; Restore original bindings - (remove-hook 'x-lost-selection-hooks 'mouse-sel-lost-selection-hook) + (remove-hook 'x-lost-selection-functions 'mouse-sel-lost-selection-hook) (dolist (binding mouse-sel-original-bindings) (global-set-key (car binding) (cdr binding))) ;; Restore the old values of these variables, @@ -712,5 +713,5 @@ (provide 'mouse-sel) -;;; arch-tag: 86e6c73f-deaa-48d3-a24e-c565fda1f7d7 +;; arch-tag: 86e6c73f-deaa-48d3-a24e-c565fda1f7d7 ;;; mouse-sel.el ends here
--- a/lisp/mouse.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/mouse.el Thu Nov 04 08:55:40 2004 +0000 @@ -1025,54 +1025,56 @@ "List of keys which shall cause the mouse region to be deleted.") (defun mouse-show-mark () - (if transient-mark-mode - (delete-overlay mouse-drag-overlay) - (let ((inhibit-quit t) - (echo-keystrokes 0) - event events key ignore - x-lost-selection-hooks) - (add-hook 'x-lost-selection-hooks - (lambda (seltype) - (if (eq seltype 'PRIMARY) - (progn (setq ignore t) - (throw 'mouse-show-mark t))))) - (move-overlay mouse-drag-overlay (point) (mark t)) - (catch 'mouse-show-mark - ;; In this loop, execute scroll bar and switch-frame events. - ;; Also ignore down-events that are undefined. - (while (progn (setq event (read-event)) - (setq events (append events (list event))) - (setq key (apply 'vector events)) - (or (and (consp event) - (eq (car event) 'switch-frame)) - (and (consp event) - (eq (posn-point (event-end event)) - 'vertical-scroll-bar)) - (and (memq 'down (event-modifiers event)) - (not (key-binding key)) - (not (mouse-undouble-last-event events)) - (not (member key mouse-region-delete-keys))))) - (and (consp event) - (or (eq (car event) 'switch-frame) - (eq (posn-point (event-end event)) - 'vertical-scroll-bar)) - (let ((keys (vector 'vertical-scroll-bar event))) - (and (key-binding keys) - (progn - (call-interactively (key-binding keys) - nil keys) - (setq events nil))))))) - ;; If we lost the selection, just turn off the highlighting. - (if ignore - nil - ;; For certain special keys, delete the region. - (if (member key mouse-region-delete-keys) - (delete-region (overlay-start mouse-drag-overlay) - (overlay-end mouse-drag-overlay)) - ;; Otherwise, unread the key so it gets executed normally. - (setq unread-command-events - (nconc events unread-command-events)))) - (setq quit-flag nil) + (let ((inhibit-quit t) + (echo-keystrokes 0) + event events key ignore + (x-lost-selection-functions + (when (boundp 'x-lost-selection-functions) + (copy-sequence x-lost-selection-functions)))) + (add-hook 'x-lost-selection-functions + (lambda (seltype) + (when (eq seltype 'PRIMARY) + (setq ignore t) + (throw 'mouse-show-mark t)))) + (if transient-mark-mode + (delete-overlay mouse-drag-overlay) + (move-overlay mouse-drag-overlay (point) (mark t))) + (catch 'mouse-show-mark + ;; In this loop, execute scroll bar and switch-frame events. + ;; Also ignore down-events that are undefined. + (while (progn (setq event (read-event)) + (setq events (append events (list event))) + (setq key (apply 'vector events)) + (or (and (consp event) + (eq (car event) 'switch-frame)) + (and (consp event) + (eq (posn-point (event-end event)) + 'vertical-scroll-bar)) + (and (memq 'down (event-modifiers event)) + (not (key-binding key)) + (not (mouse-undouble-last-event events)) + (not (member key mouse-region-delete-keys))))) + (and (consp event) + (or (eq (car event) 'switch-frame) + (eq (posn-point (event-end event)) + 'vertical-scroll-bar)) + (let ((keys (vector 'vertical-scroll-bar event))) + (and (key-binding keys) + (progn + (call-interactively (key-binding keys) + nil keys) + (setq events nil))))))) + ;; If we lost the selection, just turn off the highlighting. + (unless ignore + ;; For certain special keys, delete the region. + (if (member key mouse-region-delete-keys) + (delete-region (overlay-start mouse-drag-overlay) + (overlay-end mouse-drag-overlay)) + ;; Otherwise, unread the key so it gets executed normally. + (setq unread-command-events + (nconc events unread-command-events)))) + (setq quit-flag nil) + (unless transient-mark-mode (delete-overlay mouse-drag-overlay)))) (defun mouse-set-mark (click) @@ -1110,7 +1112,7 @@ Prefix arguments are interpreted as with \\[yank]. If `mouse-yank-at-point' is non-nil, insert at point regardless of where you click." - (interactive "*e\nP") + (interactive "e\nP") ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook) (or mouse-yank-at-point (mouse-set-point click)) @@ -1412,7 +1414,7 @@ Move point to the end of the inserted text. If `mouse-yank-at-point' is non-nil, insert at point regardless of where you click." - (interactive "*e") + (interactive "e") ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook) (or mouse-yank-at-point (mouse-set-point click))
--- a/lisp/net/eudc.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/net/eudc.el Thu Nov 04 08:55:40 2004 +0000 @@ -462,73 +462,73 @@ "Display the record list RECORDS in a formatted buffer. If RAW-ATTR-NAMES is non-nil, the raw attribute names are displayed otherwise they are formatted according to `eudc-user-attribute-names-alist'." - (let ((buffer (get-buffer-create "*Directory Query Results*")) - inhibit-read-only + (let (inhibit-read-only precords (width 0) beg first-record attribute-name) - (switch-to-buffer buffer) - (setq buffer-read-only t) - (setq inhibit-read-only t) - (erase-buffer) - (insert "Directory Query Result\n") - (insert "======================\n\n\n") - (if (null records) - (insert "No match found.\n" - (if eudc-strict-return-matches - "Try setting `eudc-strict-return-matches' to nil or change `eudc-default-return-attributes'.\n" - "")) - ;; Replace field names with user names, compute max width - (setq precords - (mapcar - (function - (lambda (record) + (with-output-to-temp-buffer "*Directory Query Results*" + (with-current-buffer standard-output + (setq buffer-read-only t) + (setq inhibit-read-only t) + (erase-buffer) + (insert "Directory Query Result\n") + (insert "======================\n\n\n") + (if (null records) + (insert "No match found.\n" + (if eudc-strict-return-matches + "Try setting `eudc-strict-return-matches' to nil or change `eudc-default-return-attributes'.\n" + "")) + ;; Replace field names with user names, compute max width + (setq precords (mapcar (function - (lambda (field) - (setq attribute-name - (if raw-attr-names - (symbol-name (car field)) - (eudc-format-attribute-name-for-display (car field)))) - (if (> (length attribute-name) width) - (setq width (length attribute-name))) - (cons attribute-name (cdr field)))) - record))) - records)) - ;; Display the records - (setq first-record (point)) - (mapcar - (function - (lambda (record) - (setq beg (point)) - ;; Map over the record fields to print the attribute/value pairs - (mapcar (function - (lambda (field) - (eudc-print-record-field field width))) - record) - ;; Store the record internal format in some convenient place - (overlay-put (make-overlay beg (point)) - 'eudc-record - (car records)) - (setq records (cdr records)) - (insert "\n"))) - precords)) - (insert "\n") - (widget-create 'push-button - :notify (lambda (&rest ignore) - (eudc-query-form)) - "New query") - (widget-insert " ") - (widget-create 'push-button - :notify (lambda (&rest ignore) - (kill-this-buffer)) - "Quit") - (eudc-mode) - (widget-setup) - (if first-record - (goto-char first-record)))) + (lambda (record) + (mapcar + (function + (lambda (field) + (setq attribute-name + (if raw-attr-names + (symbol-name (car field)) + (eudc-format-attribute-name-for-display (car field)))) + (if (> (length attribute-name) width) + (setq width (length attribute-name))) + (cons attribute-name (cdr field)))) + record))) + records)) + ;; Display the records + (setq first-record (point)) + (mapcar + (function + (lambda (record) + (setq beg (point)) + ;; Map over the record fields to print the attribute/value pairs + (mapcar (function + (lambda (field) + (eudc-print-record-field field width))) + record) + ;; Store the record internal format in some convenient place + (overlay-put (make-overlay beg (point)) + 'eudc-record + (car records)) + (setq records (cdr records)) + (insert "\n"))) + precords)) + (insert "\n") + (widget-create 'push-button + :notify (lambda (&rest ignore) + (eudc-query-form)) + "New query") + (widget-insert " ") + (widget-create 'push-button + :notify (lambda (&rest ignore) + (kill-this-buffer)) + "Quit") + (eudc-mode) + (widget-setup) + (if first-record + (goto-char first-record)))))) (defun eudc-process-form () "Process the query form in current buffer and display the results." @@ -709,34 +709,36 @@ (eudc-save-options))) ;;;###autoload -(defun eudc-get-email (name) - "Get the email field of NAME from the directory server." - (interactive "sName: ") +(defun eudc-get-email (name &optional error) + "Get the email field of NAME from the directory server. +If ERROR is non-nil, report an error if there is none." + (interactive "sName: \np") (or eudc-server (call-interactively 'eudc-set-server)) (let ((result (eudc-query (list (cons 'name name)) '(email))) email) (if (null (cdr result)) (setq email (eudc-cdaar result)) - (error "Multiple match. Use the query form")) - (if (interactive-p) + (error "Multiple match--use the query form")) + (if error (if email (message "%s" email) (error "No record matching %s" name))) email)) ;;;###autoload -(defun eudc-get-phone (name) - "Get the phone field of NAME from the directory server." - (interactive "sName: ") +(defun eudc-get-phone (name &optional error) + "Get the phone field of NAME from the directory server. +If ERROR is non-nil, report an error if there is none." + (interactive "sName: \np") (or eudc-server (call-interactively 'eudc-set-server)) (let ((result (eudc-query (list (cons 'name name)) '(phone))) phone) (if (null (cdr result)) (setq phone (eudc-cdaar result)) - (error "Multiple match. Use the query form")) - (if (interactive-p) + (error "Multiple match--use the query form")) + (if error (if phone (message "%s" phone) (error "No record matching %s" name)))
--- a/lisp/net/password.el Fri Oct 29 00:25:02 2004 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,184 +0,0 @@ -;;; password.el --- Read passwords from user, possibly using a password cache. - -;; Copyright (C) 1999, 2000, 2003, 2004 Free Software Foundation, Inc. - -;; Author: Simon Josefsson <simon@josefsson.org> -;; Created: 2003-12-21 -;; Keywords: password cache passphrase key - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; Greatly influenced by pgg.el written by Daiki Ueno, with timer -;; fixes for XEmacs by Katsumi Yamaoka. In fact, this is mostly just -;; a rip-off. -;; -;; (password-read "Password? " "test") -;; ;; Minibuffer prompt for password. -;; => "foo" -;; -;; (password-cache-add "test" "foo") -;; => nil - -;; Note the previous two can be replaced with: -;; (password-read-and-add "Password? " "test") -;; ;; Minibuffer prompt for password. -;; => "foo" -;; ;; "foo" is now cached with key "test" - - -;; (password-read "Password? " "test") -;; ;; No minibuffer prompt -;; => "foo" -;; -;; (password-read "Password? " "test") -;; ;; No minibuffer prompt -;; => "foo" -;; -;; ;; Wait `password-cache-expiry' seconds. -;; -;; (password-read "Password? " "test") -;; ;; Minibuffer prompt for password is back. -;; => "foo" - -;;; Code: - -(when (featurep 'xemacs) - (require 'run-at-time)) - -(eval-when-compile - (require 'cl)) - -(defcustom password-cache t - "Whether to cache passwords." - :group 'password - :type 'boolean) - -(defcustom password-cache-expiry 16 - "How many seconds passwords are cached, or nil to disable expiring. -Whether passwords are cached at all is controlled by `password-cache'." - :group 'password - :type '(choice (const :tag "Never" nil) - (integer :tag "Seconds"))) - -(defvar password-data (make-vector 7 0)) - -(defun password-read (prompt &optional key) - "Read password, for use with KEY, from user, or from cache if wanted. -KEY indicate the purpose of the password, so the cache can -separate passwords. The cache is not used if KEY is nil. It is -typically a string. -The variable `password-cache' control whether the cache is used." - (or (and password-cache - key - (symbol-value (intern-soft key password-data))) - (read-passwd prompt))) - -(defun password-read-and-add (prompt &optional key) - "Read password, for use with KEY, from user, or from cache if wanted. -Then store the password in the cache. Uses `password-read' and -`password-cache-add'." - (let ((password (password-read prompt key))) - (when (and password key) - (password-cache-add key password)) - password)) - -(defun password-cache-remove (key) - "Remove password indexed by KEY from password cache. -This is typically run be a timer setup from `password-cache-add', -but can be invoked at any time to forcefully remove passwords -from the cache. This may be useful when it has been detected -that a password is invalid, so that `password-read' query the -user again." - (let ((password (symbol-value (intern-soft key password-data)))) - (when password - (fillarray password ?_) - (unintern key password-data)))) - -(defun password-cache-add (key password) - "Add password to cache. -The password is removed by a timer after `password-cache-expiry' -seconds." - (set (intern key password-data) password) - (when password-cache-expiry - (run-at-time password-cache-expiry nil - #'password-cache-remove - key)) - nil) - -;;;###autoload -(defun read-passwd (prompt &optional confirm default) - "Read a password, prompting with PROMPT, and return it. -If optional CONFIRM is non-nil, read the password twice to make sure. -Optional DEFAULT is a default password to use instead of empty input. - -This function echoes `.' for each character that the user types. -The user ends with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line. -C-g quits; if `inhibit-quit' was non-nil around this function, -then it returns nil if the user types C-g. - -Once the caller uses the password, it can erase the password -by doing (clear-string STRING)." - (with-local-quit - (if confirm - (let (success) - (while (not success) - (let ((first (read-passwd prompt nil default)) - (second (read-passwd "Confirm password: " nil default))) - (if (equal first second) - (progn - (and (arrayp second) (clear-string second)) - (setq success first)) - (and (arrayp first) (clear-string first)) - (and (arrayp second) (clear-string second)) - (message "Password not repeated accurately; please start over") - (sit-for 1)))) - success) - (let ((pass nil) - (c 0) - (echo-keystrokes 0) - (cursor-in-echo-area t)) - (while (progn (message "%s%s" - prompt - (make-string (length pass) ?.)) - (setq c (read-char-exclusive nil t)) - (and (/= c ?\r) (/= c ?\n) (/= c ?\e))) - (clear-this-command-keys) - (if (= c ?\C-u) - (progn - (and (arrayp pass) (clear-string pass)) - (setq pass "")) - (if (and (/= c ?\b) (/= c ?\177)) - (let* ((new-char (char-to-string c)) - (new-pass (concat pass new-char))) - (and (arrayp pass) (clear-string pass)) - (clear-string new-char) - (setq c ?\0) - (setq pass new-pass)) - (if (> (length pass) 0) - (let ((new-pass (substring pass 0 -1))) - (and (arrayp pass) (clear-string pass)) - (setq pass new-pass)))))) - (message nil) - (or pass default ""))))) - -(provide 'password) - -;;; arch-tag: ab160494-16c8-4c68-a4a1-73eebf6686e5 -;;; password.el ends here
--- a/lisp/net/tls.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/net/tls.el Thu Nov 04 08:55:40 2004 +0000 @@ -67,18 +67,21 @@ (defcustom tls-process-connection-type nil "*Value for `process-connection-type' to use when starting TLS process." + :version "21.4" :type 'boolean :group 'tls) (defcustom tls-success "- Handshake was completed" "*Regular expression indicating completed TLS handshakes. The default is what GNUTLS's \"gnutls-cli\" outputs." + :version "21.4" :type 'regexp :group 'tls) (defcustom tls-certtool-program (executable-find "certtool") "Name of GnuTLS certtool. Used by `tls-certificate-information'." + :version "21.4" :type '(repeat string) :group 'tls)
--- a/lisp/obsolete/hilit19.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/obsolete/hilit19.el Thu Nov 04 08:55:40 2004 +0000 @@ -1,6 +1,6 @@ ;;; hilit19.el --- customizable highlighting for Emacs 19 -;; Copyright (c) 1993, 1994, 2001 Free Software Foundation, Inc. +;; Copyright (c) 1993, 1994, 2001, 2004 Free Software Foundation, Inc. ;; Author: Jonathan Stigelman <stig@hackvan.com> ;; Maintainer: FSF @@ -397,8 +397,6 @@ If hilit19 is dumped into emacs at your site, you may have to set this in your init file.") -(eval-when-compile (setq byte-optimize t)) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Use this to report bugs: @@ -945,47 +943,61 @@ ;; Initialization. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(and (not hilit-inhibit-rebinding) - (progn - (substitute-key-definition 'yank 'hilit-yank - (current-global-map)) - (substitute-key-definition 'yank-pop 'hilit-yank-pop - (current-global-map)) - (substitute-key-definition 'recenter 'hilit-recenter - (current-global-map)))) +(define-minor-mode hilit-mode + "Obsolete minor mode. Use `global-font-lock-mode' instead." + :global t + + (unless (and hilit-inhibit-rebinding hilit-mode) + (substitute-key-definition + (if hilit-mode 'yank 'hilit-yank) + (if hilit-mode 'hilit-yank 'yank) + (current-global-map)) + (substitute-key-definition + (if hilit-mode 'yank-pop 'hilit-yank-pop) + (if hilit-mode 'hilit-yank-pop 'yank-pop) + (current-global-map)) + (substitute-key-definition + (if hilit-mode 'recenter 'hilit-recenter) + (if hilit-mode 'hilit-recenter 'recenter) + (current-global-map))) + + (if hilit-mode + (global-set-key [?\C-\S-l] 'hilit-repaint-command) + (global-unset-key [?\C-\S-l])) + + (if hilit-mode + (add-hook 'find-file-hook 'hilit-find-file-hook t) + (remove-hook 'find-file-hook 'hilit-find-file-hook)) -(global-set-key [?\C-\S-l] 'hilit-repaint-command) + (unless (and hilit-inhibit-hooks hilit-mode) + (condition-case c + (progn + + ;; BUFFER highlights... + (mapcar (lambda (hook) + (if hilit-mode + (add-hook hook 'hilit-rehighlight-buffer-quietly) + (remove-hook hook 'hilit-rehighlight-buffer-quietly))) + '( + Info-selection-hook -(add-hook 'find-file-hook 'hilit-find-file-hook t) + ;; runs too early vm-summary-mode-hooks + vm-summary-pointer-hook + vm-preview-message-hook + vm-show-message-hook + + rmail-show-message-hook + mail-setup-hook + mh-show-mode-hook + + dired-after-readin-hook + )) + ) + (error (message "Error loading highlight hooks: %s" c) + (ding) (sit-for 1))))) (eval-when-compile (require 'gnus)) ; no compilation gripes -(and (not hilit-inhibit-hooks) - (condition-case c - (progn - - ;; BUFFER highlights... - (mapcar (function - (lambda (hook) - (add-hook hook 'hilit-rehighlight-buffer-quietly))) - '( - Info-selection-hook - -;; runs too early vm-summary-mode-hooks - vm-summary-pointer-hook - vm-preview-message-hook - vm-show-message-hook - - rmail-show-message-hook - mail-setup-hook - mh-show-mode-hook - - dired-after-readin-hook - )) - ) - (error (message "Error loading highlight hooks: %s" c) - (ding) (sit-for 1)))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Default patterns for various modes. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1510,5 +1522,5 @@ (provide 'hilit19) -;;; arch-tag: db99739a-4837-41ee-ad02-3baced8ae71d +;; arch-tag: db99739a-4837-41ee-ad02-3baced8ae71d ;;; hilit19.el ends here
--- a/lisp/pcomplete.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/pcomplete.el Thu Nov 04 08:55:40 2004 +0000 @@ -150,7 +150,7 @@ :type 'boolean :group 'pcomplete) -(defcustom pcomplete-suffix-list (list directory-sep-char ?:) +(defcustom pcomplete-suffix-list (list ?/ ?:) "*A list of characters which constitute a proper suffix." :type '(repeat character) :group 'pcomplete) @@ -740,7 +740,7 @@ (function (lambda (file) (if (eq (aref file (1- (length file))) - directory-sep-char) + ?/) (and pcomplete-dir-ignore (string-match pcomplete-dir-ignore file)) (and pcomplete-file-ignore @@ -757,11 +757,11 @@ ;; since . is earlier in the ASCII alphabet than ;; / (let ((left (if (eq (aref l (1- (length l))) - directory-sep-char) + ?/) (substring l 0 (1- (length l))) l)) (right (if (eq (aref r (1- (length r))) - directory-sep-char) + ?/) (substring r 0 (1- (length r))) r))) (if above-cutoff
--- a/lisp/play/5x5.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/play/5x5.el Thu Nov 04 08:55:40 2004 +0000 @@ -224,9 +224,8 @@ 5x5-y-pos (/ 5x5-grid-size 2) 5x5-moves 0 5x5-grid (5x5-make-move (5x5-make-new-grid) 5x5-y-pos 5x5-x-pos)) - (when (interactive-p) - (5x5-draw-grid (list 5x5-grid)) - (5x5-position-cursor)))) + (5x5-draw-grid (list 5x5-grid)) + (5x5-position-cursor))) (defun 5x5-quit-game () "Quit the current game of `5x5'."
--- a/lisp/play/fortune.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/play/fortune.el Thu Nov 04 08:55:40 2004 +0000 @@ -271,7 +271,7 @@ (fortune-ask-file) fortune-file))) (save-excursion - (fortune-in-buffer (interactive-p) file) + (fortune-in-buffer t file) (set-buffer fortune-buffer-name) (let* ((fortune (buffer-string)) (signature (concat fortune-sigstart fortune fortune-sigend))) @@ -285,7 +285,7 @@ (defun fortune-in-buffer (interactive &optional file) "Put a fortune cookie in the *fortune* buffer. -When INTERACTIVE is nil, don't display it. Optional argument FILE, +INTERACTIVE is ignored. Optional argument FILE, when supplied, specifies the file to choose the fortune from." (let ((fortune-buffer (or (get-buffer fortune-buffer-name) (generate-new-buffer fortune-buffer-name)))
--- a/lisp/progmodes/ada-xref.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/progmodes/ada-xref.el Thu Nov 04 08:55:40 2004 +0000 @@ -2154,17 +2154,17 @@ adaname ) -(defun ada-make-body-gnatstub () +(defun ada-make-body-gnatstub (&optional interactive) "Create an Ada package body in the current buffer. This function uses the `gnatstub' program to create the body. This function typically is to be hooked into `ff-file-created-hooks'." - (interactive) + (interactive "p") (save-some-buffers nil nil) ;; If the current buffer is the body (as is the case when calling this ;; function from ff-file-created-hooks), then kill this temporary buffer - (unless (interactive-p) + (unless interactive (progn (set-buffer-modified-p nil) (kill-buffer (current-buffer))))
--- a/lisp/progmodes/autoconf.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/progmodes/autoconf.el Thu Nov 04 08:55:40 2004 +0000 @@ -1,6 +1,6 @@ ;;; autoconf.el --- mode for editing Autoconf configure.in files -;; Copyright (C) 2000, 2003 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2003, 2004 Free Software Foundation, Inc. ;; Author: Dave Love <fx@gnu.org> ;; Keywords: languages @@ -49,7 +49,7 @@ "AC_\\(SUBST\\|DEFINE\\(_UNQUOTED\\)?\\)(\\(\\sw+\\)") (defvar autoconf-font-lock-keywords - `(("A[CHM]_\\sw+" . font-lock-keyword-face) + `(("A[CHMS]_\\sw+" . font-lock-keyword-face) (,autoconf-definition-regexp 3 font-lock-function-name-face) ;; Are any other M4 keywords really appropriate for configure.in,
--- a/lisp/progmodes/compile.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/progmodes/compile.el Thu Nov 04 08:55:40 2004 +0000 @@ -181,6 +181,16 @@ (epc "^Error [0-9]+ at (\\([0-9]+\\):\\([^)\n]+\\))" 2 1) + (ftnchek-file + "^File \\(.+\\.f\\):$" + 1 nil nil 0) + (ftnchek-line-file + "\\(^Warning .* \\)?line \\([0-9]+\\)\\(?: col \\([0-9]+\\)\\)? file \\(.+\\.f\\)" + 4 2 3 (1) nil (1 'default nil t)) + (ftnchek-line + "\\(?:^\\(Warning\\) .* \\)?line \\([0-9]+\\)\\(?: col \\([0-9]+\\)\\)?" + nil 2 3 (1) nil (1 (compilation-face '(1)) nil t)) + (iar "^\"\\(.*\\)\",\\([0-9]+\\)\\s-+\\(?:Error\\|Warnin\\(g\\)\\)\\[[0-9]+\\]:" 1 2 nil (3)) @@ -191,8 +201,8 @@ ;; fixme: should be `mips' (irix - "^[-[:alnum:]_/]+: \\(?:[sS]evere\\|[eE]rror\\|[wW]arnin\\(g\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*:\ - \\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 3 4 nil (1 . 2)) + "^[-[:alnum:]_/ ]+: \\(?:\\(?:[sS]evere\\|[eE]rror\\|[wW]arnin\\(g\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*: \\)?\ +\\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 3 4 nil (1 . 2)) (java "^\\(?:[ \t]+at \\|==[0-9]+== +\\(?:at\\|b\\(y\\)\\)\\).+(\\([^()\n]+\\):\\([0-9]+\\))$" 2 3 nil (1))
--- a/lisp/progmodes/cperl-mode.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/progmodes/cperl-mode.el Thu Nov 04 08:55:40 2004 +0000 @@ -6664,11 +6664,11 @@ =pod Switch from Perl to POD. ") -(defun cperl-switch-to-doc-buffer () +(defun cperl-switch-to-doc-buffer (&optional interactive) "Go to the perl documentation buffer and insert the documentation." - (interactive) + (interactive "p") (let ((buf (get-buffer-create cperl-doc-buffer))) - (if (interactive-p) + (if interactive (switch-to-buffer-other-window buf) (set-buffer buf)) (if (= (buffer-size) 0)
--- a/lisp/progmodes/flymake.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/progmodes/flymake.el Thu Nov 04 08:55:40 2004 +0000 @@ -56,7 +56,7 @@ (defun flymake-makehash(&optional test) (cond ((equal flymake-emacs 'xemacs) (if test (make-hash-table :test test) (make-hash-table))) - (t (makehash test)) + (t (makehash test)) ) ) @@ -370,8 +370,8 @@ (let* ((init-f (nth 0 (flymake-get-file-name-mode-and-masks file-name)))) ;(flymake-log 0 "calling %s" init-f) ;(funcall init-f (current-buffer)) + init-f ) - (nth 0 (flymake-get-file-name-mode-and-masks file-name)) ) (defun flymake-get-cleanup-function(file-name) @@ -846,7 +846,7 @@ (set-buffer source-buffer) (flymake-parse-residual source-buffer) - (flymake-post-syntax-check source-buffer) + (flymake-post-syntax-check source-buffer exit-status command) (flymake-set-buffer-is-running source-buffer nil) ) ) @@ -863,7 +863,7 @@ ) ) -(defun flymake-post-syntax-check(source-buffer) +(defun flymake-post-syntax-check(source-buffer exit-status command) "" (flymake-set-buffer-err-info source-buffer (flymake-get-buffer-new-err-info source-buffer)) (flymake-set-buffer-new-err-info source-buffer nil) @@ -1220,7 +1220,33 @@ ) ) -(eval-when-compile (require 'compile)) +(defun flymake-reformat-err-line-patterns-from-compile-el(original-list) + "grab error line patterns from original list in compile.el format, convert to flymake internal format" + (let* ((converted-list '())) + (mapcar + (lambda (item) + (setq item (cdr item)) + (let ((regexp (nth 0 item)) + (file (nth 1 item)) + (line (nth 2 item)) + (col (nth 3 item)) + end-line) + (if (consp file) (setq file (car file))) + (if (consp line) (setq end-line (cdr line) line (car line))) + (if (consp col) (setq col (car col))) + + (when (not (functionp line)) + (setq converted-list (cons (list regexp file line col) converted-list)) + ) + ) + ) + original-list + ) + converted-list + ) +) + +(require 'compile) (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 (append '( @@ -1243,9 +1269,9 @@ (" *\\(\\[javac\\]\\)? *\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)\:\\([0-9]+\\)\:[ \t\n]*\\(.+\\)" 2 4 nil 5) ) - ;; compilation-error-regexp-alist) - (mapcar (lambda (x) (cdr x)) compilation-error-regexp-alist-alist)) - "patterns for matching error/warning lines, (regexp file-idx line-idx err-text-idx)" + ;; compilation-error-regexp-alist) + (flymake-reformat-err-line-patterns-from-compile-el compilation-error-regexp-alist-alist)) + "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" ) ;(defcustom flymake-err-line-patterns ; '( @@ -1452,7 +1478,7 @@ (let* ((dir (nth idx include-dirs))) (setq full-file-name (concat dir "/" rel-file-name)) (when (file-exists-p full-file-name) - (setq done t) + (setq found t) ) ) (setq idx (1+ idx)) @@ -1574,7 +1600,7 @@ process ) (error - (let ((err-str (format "Failed to launch syntax check process '%s' with args %s: %s" + (let* ((err-str (format "Failed to launch syntax check process '%s' with args %s: %s" cmd args (error-message-string err))) (source-file-name (buffer-file-name buffer)) (cleanup-f (flymake-get-cleanup-function source-file-name))) @@ -1905,7 +1931,8 @@ (defun flymake-mode(&optional arg) "toggle flymake-mode" (interactive) - (let ((old-flymake-mode flymake-mode)) + (let ((old-flymake-mode flymake-mode) + (turn-on nil)) (setq turn-on (if (null arg)
--- a/lisp/progmodes/gdb-ui.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/progmodes/gdb-ui.el Thu Nov 04 08:55:40 2004 +0000 @@ -25,28 +25,28 @@ ;;; Commentary: -;; This mode acts as a graphical user interface to GDB. You can interact with +;; This mode acts as a graphical user interface to GDB. You can interact with ;; GDB through the GUD buffer in the usual way, but there are also further ;; buffers which control the execution and describe the state of your program. ;; It separates the input/output of your program from that of GDB, if -;; required, and watches expressions in the speedbar. It also uses features of +;; required, and watches expressions in the speedbar. It also uses features of ;; Emacs 21 such as the fringe/display margin for breakpoints, and the toolbar ;; (see the GDB Graphical Interface section in the Emacs info manual). ;; Start the debugger with M-x gdba. ;; This file has evolved from gdba.el from GDB 5.0 written by Tom Lord and Jim -;; Kingdon and uses GDB's annotation interface. You don't need to know about +;; Kingdon and uses GDB's annotation interface. You don't need to know about ;; annotations to use this mode as a debugger, but if you are interested ;; developing the mode itself, then see the Annotations section in the GDB ;; info manual. ;; -;; GDB developers plan to make the annotation interface obsolete. A new +;; GDB developers plan to make the annotation interface obsolete. A new ;; interface called GDB/MI (machine interface) has been designed to replace -;; it. Some GDB/MI commands are used in this file through the CLI command -;; 'interpreter mi <mi-command>'. A file called gdb-mi.el is included in the +;; it. Some GDB/MI commands are used in this file through the CLI command +;; 'interpreter mi <mi-command>'. A file called gdb-mi.el is included in the ;; GDB repository for future releases (6.2 onwards) that uses GDB/MI as the -;; primary interface to GDB. It is still under development and is part of a +;; primary interface to GDB. It is still under development and is part of a ;; process to migrate Emacs from annotations to GDB/MI. ;; ;; Known Bugs: @@ -63,7 +63,7 @@ (defvar gdb-current-language nil) (defvar gdb-view-source t "Non-nil means that source code can be viewed.") (defvar gdb-selected-view 'source "Code type that user wishes to view.") -(defvar gdb-var-list nil "List of variables in watch window") +(defvar gdb-var-list nil "List of variables in watch window.") (defvar gdb-var-changed nil "Non-nil means that gdb-var-list has changed.") (defvar gdb-buffer-type nil) (defvar gdb-overlay-arrow-position nil) @@ -85,12 +85,12 @@ If `gdb-many-windows' is t, regardless of the value of `gdb-show-main', the layout below will appear unless `gdb-use-inferior-io-buffer' is nil when the source buffer -occupies the full width of the frame. Keybindings are given in +occupies the full width of the frame. Keybindings are given in relevant buffer. Watch expressions appear in the speedbar/slowbar. -The following interactive lisp functions help control operation : +The following commands help control operation : `gdb-many-windows' - Toggle the number of windows gdb uses. `gdb-restore-windows' - To restore the window layout. @@ -120,8 +120,7 @@ RET gdb-frames-select | SPC gdb-toggle-breakpoint | RET gdb-goto-breakpoint | d gdb-delete-breakpoint ---------------------------------------------------------------------- -" +---------------------------------------------------------------------" ;; (interactive (list (gud-query-cmdline 'gdba))) ;; @@ -134,12 +133,14 @@ (defcustom gdb-enable-debug-log nil "Non-nil means record the process input and output in `gdb-debug-log'." :type 'boolean - :group 'gud) + :group 'gud + :version "21.4") (defcustom gdb-use-inferior-io-buffer nil "Non-nil means display output from the inferior in a separate buffer." :type 'boolean - :group 'gud) + :group 'gud + :version "21.4") (defun gdb-ann3 () (setq gdb-debug-log nil) @@ -210,10 +211,10 @@ (run-hooks 'gdba-mode-hook)) (defcustom gdb-use-colon-colon-notation nil - "Non-nil means use FUNCTION::VARIABLE format to display variables in the -speedbar." + "If non-nil use FUN::VAR format to display variables in the speedbar." ; :type 'boolean - :group 'gud) + :group 'gud + :version "21.4") (defun gud-watch () "Watch expression at point." @@ -376,7 +377,7 @@ (setq gdb-var-changed t)))))) (defun gdb-edit-value (text token indent) - "Assign a value to a variable displayed in the speedbar" + "Assign a value to a variable displayed in the speedbar." (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list)) (varnum (cadr var)) (value)) (setq value (read-string "New value: ")) @@ -389,8 +390,8 @@ 'ignore)))) (defcustom gdb-show-changed-values t - "Non-nil means use font-lock-warning-face to display values that have -recently changed in the speedbar." + "If non-nil highlight values that have recently changed in the speedbar. +The highlighting is done with `font-lock-warning-face'." :type 'boolean :group 'gud) @@ -422,23 +423,23 @@ "The disposition of the output of the current gdb command. Possible values are these symbols: - user -- gdb output should be copied to the GUD buffer - for the user to see. + `user' -- gdb output should be copied to the GUD buffer + for the user to see. - inferior -- gdb output should be copied to the inferior-io buffer + `inferior' -- gdb output should be copied to the inferior-io buffer - pre-emacs -- output should be ignored util the post-prompt - annotation is received. Then the output-sink - becomes:... - emacs -- output should be collected in the partial-output-buffer - for subsequent processing by a command. This is the - disposition of output generated by commands that - gdb mode sends to gdb on its own behalf. - post-emacs -- ignore output until the prompt annotation is - received, then go to USER disposition. + `pre-emacs' -- output should be ignored util the post-prompt + annotation is received. Then the output-sink + becomes:... + `emacs' -- output should be collected in the partial-output-buffer + for subsequent processing by a command. This is the + disposition of output generated by commands that + gdb mode sends to gdb on its own behalf. + `post-emacs' -- ignore output until the prompt annotation is + received, then go to USER disposition. gdba (gdb-ui.el) uses all five values, gdbmi (gdb-mi.el) only two -(user and emacs).") +\(`user' and `emacs').") (defvar gdb-current-item nil "The most recent command item sent to gdb.") @@ -619,7 +620,7 @@ (defun gdb-send (proc string) "A comint send filter for gdb. -This filter may simply queue output for a later time." +This filter may simply queue input for a later time." (if gud-running (process-send-string proc (concat string "\n")) (gdb-enqueue-input (concat string "\n")))) @@ -660,7 +661,8 @@ (defcustom gud-gdba-command-name "gdb -annotate=3" "Default command to execute an executable under the GDB-UI debugger." :type 'string - :group 'gud) + :group 'gud + :version "21.4") (defvar gdb-annotation-rules '(("pre-prompt" gdb-pre-prompt) @@ -705,25 +707,25 @@ (setq gdb-current-item item) (with-current-buffer gud-comint-buffer (if (eq gud-minor-mode 'gdba) - (progn - (if (stringp item) - (progn - (setq gdb-output-sink 'user) - (process-send-string (get-buffer-process gud-comint-buffer) item)) + (if (stringp item) (progn - (gdb-clear-partial-output) - (setq gdb-output-sink 'pre-emacs) - (process-send-string (get-buffer-process gud-comint-buffer) - (car item))))) - ; case: eq gud-minor-mode 'gdbmi + (setq gdb-output-sink 'user) + (process-send-string (get-buffer-process gud-comint-buffer) item)) + (progn + (gdb-clear-partial-output) + (setq gdb-output-sink 'pre-emacs) + (process-send-string (get-buffer-process gud-comint-buffer) + (car item)))) + ;; case: eq gud-minor-mode 'gdbmi (gdb-clear-partial-output) (setq gdb-output-sink 'emacs) (process-send-string (get-buffer-process gud-comint-buffer) - (car item))))) + (car item))))) (defun gdb-pre-prompt (ignored) - "An annotation handler for `pre-prompt'. This terminates the collection of -output from a previous command if that happens to be in effect." + "An annotation handler for `pre-prompt'. +This terminates the collection of output from a previous command if that +happens to be in effect." (let ((sink gdb-output-sink)) (cond ((eq sink 'user) t) @@ -761,8 +763,9 @@ (setq gdb-prompting t)) (defun gdb-starting (ignored) - "An annotation handler for `starting'. This says that I/O for the -subprocess is now the program being debugged, not GDB." + "An annotation handler for `starting'. +This says that I/O for the subprocess is now the program being debugged, +not GDB." (let ((sink gdb-output-sink)) (cond ((eq sink 'user) @@ -773,8 +776,9 @@ (t (error "Unexpected `starting' annotation"))))) (defun gdb-stopping (ignored) - "An annotation handler for `exited' and other annotations which say that I/O -for the subprocess is now GDB, not the program being debugged." + "An annotation handler for `exited' and other annotations. +They say that I/O for the subprocess is now GDB, not the program +being debugged." (if gdb-use-inferior-io-buffer (let ((sink gdb-output-sink)) (cond @@ -792,8 +796,9 @@ (t (error "Unexpected frame-begin annotation (%S)" sink))))) (defun gdb-stopped (ignored) - "An annotation handler for `stopped'. It is just like gdb-stopping, except -that if we already set the output sink to 'user in gdb-stopping, that is fine." + "An annotation handler for `stopped'. +It is just like `gdb-stopping', except that if we already set the output +sink to `user' in `gdb-stopping', that is fine." (setq gud-running nil) (let ((sink gdb-output-sink)) (cond @@ -803,8 +808,9 @@ (t (error "Unexpected stopped annotation"))))) (defun gdb-post-prompt (ignored) - "An annotation handler for `post-prompt'. This begins the collection of -output from the current command if that happens to be appropriate." + "An annotation handler for `post-prompt'. +This begins the collection of output from the current command if that +happens to be appropriate." (if (not gdb-pending-triggers) (progn (gdb-get-current-frame) @@ -832,7 +838,7 @@ (error "Phase error in gdb-post-prompt (got %s)" sink))))) (defun gud-gdba-marker-filter (string) - "A gud marker filter for gdb. Handle a burst of output from GDB." + "A gud marker filter for gdb. Handle a burst of output from GDB." (if gdb-enable-debug-log (push (cons 'recv string) gdb-debug-log)) ;; Recall the left over gud-marker-acc from last time (setq gud-marker-acc (concat gud-marker-acc string)) @@ -1065,10 +1071,10 @@ "PBM data used for disabled breakpoint icon.") (defvar breakpoint-enabled-icon nil - "Icon for enabled breakpoint in display margin") + "Icon for enabled breakpoint in display margin.") (defvar breakpoint-disabled-icon nil - "Icon for disabled breakpoint in display margin") + "Icon for disabled breakpoint in display margin.") ;; Bitmap for breakpoint in fringe (define-fringe-bitmap 'breakpoint @@ -1133,7 +1139,7 @@ (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom))) (defun gdb-mouse-toggle-breakpoint (event) - "Toggle breakpoint in left fringe/margin with mouse click" + "Toggle breakpoint in left fringe/margin with mouse click." (interactive "e") (mouse-minibuffer-check event) (let ((posn (event-end event))) @@ -1683,7 +1689,8 @@ (defcustom gdb-show-main nil "Nil means don't display source file containing the main routine." :type 'boolean - :group 'gud) + :group 'gud + :version "21.4") (defun gdb-setup-windows () "Layout the window pattern for gdb-many-windows." @@ -1718,13 +1725,14 @@ (other-window 1)) (defcustom gdb-many-windows nil - "Nil (the default value) means just pop up the GUD buffer -unless `gdb-show-main' is t. In this case it starts with two -windows: one displaying the GUD buffer and the other with the -source file with the main routine of the inferior. Non-nil means -display the layout shown for `gdba'." + "Nil means just pop up the GUD buffer unless `gdb-show-main' is t. +In this case it starts with two windows: one displaying the GUD +buffer and the other with the source file with the main routine +of the inferior. Non-nil means display the layout shown for +`gdba'." :type 'boolean - :group 'gud) + :group 'gud + :version "21.4") (defun gdb-many-windows (arg) "Toggle the number of windows in the basic arrangement." @@ -1760,8 +1768,8 @@ (other-window 1))) (defun gdb-reset () - "Exit a debugging session cleanly by killing the gdb buffers and resetting - the source buffers." + "Exit a debugging session cleanly. +Kills the gdb buffers and resets the source buffers." (dolist (buffer (buffer-list)) (unless (eq buffer gud-comint-buffer) (with-current-buffer buffer
--- a/lisp/progmodes/grep.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/progmodes/grep.el Thu Nov 04 08:55:40 2004 +0000 @@ -1,7 +1,7 @@ ;;; grep.el --- run compiler as inferior of Emacs, parse error messages -;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 1999, 2001, 02, 2004 -;; Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +;; 2001, 2002, 2004 Free Software Foundation, Inc. ;; Author: Roland McGrath <roland@gnu.org> ;; Maintainer: FSF @@ -252,21 +252,12 @@ \\(?:-\\(?:\\([0-9]+\\)\\3\\)?\\.?\\([0-9]+\\)?\\)?[:) \t]" 1 (2 . 5) (4 . 6)) ("^\\(.+?\\)[:(]+\\([0-9]+\\)\\([:)]\\).*?\\(\033\\[01;41m\\)\\(.*?\\)\\(\033\\[00m\\)" 1 2 + ;; Calculate column positions (beg . end) of first grep match on a line ((lambda () (setq compilation-error-screen-columns nil) (- (match-beginning 5) (match-end 3) 8)) . - (lambda () (- (match-end 5) (match-end 3) 8))) - nil nil - (4 (list 'face nil 'invisible t 'intangible t)) - (5 (list 'face compilation-column-face)) - (6 (list 'face nil 'invisible t 'intangible t)) - ;; highlight other matches on the same line - ("\\(\033\\[01;41m\\)\\(.*?\\)\\(\033\\[00m\\)" - nil nil - (1 (list 'face nil 'invisible t 'intangible t)) - (2 (list 'face compilation-column-face) t) - (3 (list 'face nil 'invisible t 'intangible t)))) + (lambda () (- (match-end 5) (match-end 3) 8)))) ("^Binary file \\(.+\\) matches$" 1 nil nil 1)) "Regexp used to match grep hits. See `compilation-error-regexp-alist'.") @@ -294,7 +285,16 @@ ("^Grep \\(exited abnormally\\) with code \\([0-9]+\\).*" (0 '(face nil message nil help-echo nil mouse-face nil) t) (1 compilation-warning-face) - (2 compilation-line-face))) + (2 compilation-line-face)) + ;; Highlight grep matches and delete markers + ("\\(\033\\[01;41m\\)\\(.*?\\)\\(\033\\[00m\\)" + (2 compilation-column-face) + ((lambda (p)) + (progn + ;; Delete markers with `replace-match' because it updates + ;; the match-data, whereas `delete-region' would render it obsolete. + (replace-match "" t t nil 3) + (replace-match "" t t nil 1))))) "Additional things to highlight in grep output. This gets tacked on the end of the generated expressions.") @@ -436,9 +436,11 @@ (defun grep-default-command () (let ((tag-default - (funcall (or find-tag-default-function - (get major-mode 'find-tag-default-function) - 'find-tag-default))) + (shell-quote-argument + (or (funcall (or find-tag-default-function + (get major-mode 'find-tag-default-function) + 'find-tag-default)) + ""))) (sh-arg-re "\\(\\(?:\"\\(?:[^\"]\\|\\\\\"\\)+\"\\|'[^']+'\\|[^\"' \t\n]\\)+\\)") (grep-default (or (car grep-history) grep-command))) ;; Replace the thing matching for with that around cursor. @@ -460,7 +462,7 @@ 0 (match-beginning 2)) " *." (file-name-extension buffer-file-name)))) - (replace-match (or tag-default "") t t grep-default 1)))) + (replace-match tag-default t t grep-default 1)))) ;;;###autoload (defun grep (command-args &optional highlight-regexp)
--- a/lisp/progmodes/idlw-shell.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/progmodes/idlw-shell.el Thu Nov 04 08:55:40 2004 +0000 @@ -1137,10 +1137,10 @@ (goto-char save-point)) (set-buffer save-buffer)))) -(defun idlwave-shell-send-char (c &optional no-error) +(defun idlwave-shell-send-char (c &optional error) "Send one character to the shell, without a newline." - (interactive "cChar to send to IDL: ") - (let ((errf (if (interactive-p) 'error 'message)) + (interactive "cChar to send to IDL: \np") + (let ((errf (if error 'error 'message)) buf proc) (if (or (not (setq buf (get-buffer (idlwave-shell-buffer)))) (not (setq proc (get-buffer-process buf))))
--- a/lisp/progmodes/idlwave.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/progmodes/idlwave.el Thu Nov 04 08:55:40 2004 +0000 @@ -4231,7 +4231,7 @@ (defvar idlwave-load-rinfo-idle-timer) -(defun idlwave-update-routine-info (&optional arg) +(defun idlwave-update-routine-info (&optional arg dont-concentrate) "Update the internal routine-info lists. These lists are used by `idlwave-routine-info' (\\[idlwave-routine-info]) and by `idlwave-complete' (\\[idlwave-complete]) to provide information @@ -4248,10 +4248,12 @@ When an IDL shell is running, this command also queries the IDL program for currently compiled routines. +???Document what DONT-CONCENTRATE means??? + With prefix ARG, also reload the system and library lists. With two prefix ARG's, also rescans the library tree. With three prefix args, dispatch asynchronous process to do the update." - (interactive "P") + (interactive "P\np") ;; Stop any idle processing (if (or (and (fboundp 'itimerp) (itimerp idlwave-load-rinfo-idle-timer)) @@ -4300,7 +4302,7 @@ idlwave-query-shell-for-routine-info))) (if (or (not ask-shell) - (not (interactive-p))) + (not dont-concentrate)) ;; 1. If we are not going to ask the shell, we need to do the ;; concatenation now. ;; 2. When this function is called non-interactively, it means
--- a/lisp/progmodes/vhdl-mode.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/progmodes/vhdl-mode.el Thu Nov 04 08:55:40 2004 +0000 @@ -6120,17 +6120,17 @@ (vhdl-keep-region-active) foundp)) -(defun vhdl-beginning-of-statement (&optional count lim) +(defun vhdl-beginning-of-statement (&optional count lim interactive) "Go to the beginning of the innermost VHDL statement. With prefix arg, go back N - 1 statements. If already at the beginning of a statement then go to the beginning of the preceding one. If within a string or comment, or next to a comment (only whitespace between), move by sentences instead of statements. -When called from a program, this function takes 2 optional args: the +When called from a program, this function takes 3 optional args: the prefix arg, and a buffer position limit which is the farthest back to -search." - (interactive "p") +search, and something whose meaning I don't understand." + (interactive "p\np") (let ((count (or count 1)) (case-fold-search t) (lim (or lim (point-min))) @@ -6139,7 +6139,7 @@ (save-excursion (goto-char lim) (setq state (parse-partial-sexp (point) here nil nil))) - (if (and (interactive-p) + (if (and interactive (or (nth 3 state) (nth 4 state) (looking-at (concat "[ \t]*" comment-start-skip)))) @@ -7531,10 +7531,10 @@ (defun vhdl-fill-region (beg end &optional arg) "Fill lines for a region of code." - (interactive "r") + (interactive "r\np") (save-excursion (goto-char beg) - (let ((margin (if (interactive-p) (current-indentation) (current-column)))) + (let ((margin (if interactive (current-indentation) (current-column)))) (goto-char end) (setq end (point-marker)) ;; remove inline comments, newlines and whitespace
--- a/lisp/reveal.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/reveal.el Thu Nov 04 08:55:40 2004 +0000 @@ -1,6 +1,6 @@ ;;; reveal.el --- Automatically reveal hidden text at point -;; Copyright (C) 2000, 2001 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001, 2004 Free Software Foundation, Inc. ;; Author: Stefan Monnier <monnier@cs.yale.edu> ;; Keywords: outlines @@ -59,6 +59,9 @@ (defvar reveal-open-spots nil) (make-variable-buffer-local 'reveal-open-spots) +(defvar reveal-last-tick nil) +(make-variable-buffer-local 'reveal-last-tick) + ;; Actual code (defun reveal-post-command () @@ -90,16 +93,16 @@ (overlays-at (point)))) (push (cons (selected-window) ol) reveal-open-spots) (setq old-ols (delq ol old-ols)) - (let ((open (overlay-get ol 'reveal-toggle-invisible))) + (let ((open (overlay-get ol 'reveal-toggle-invisible)) inv) (when (or open - (let ((inv (overlay-get ol 'invisible))) - (and inv (symbolp inv) - (or (setq open (or (get inv 'reveal-toggle-invisible) - (overlay-get ol 'isearch-open-invisible-temporary))) - (overlay-get ol 'isearch-open-invisible) - (and (consp buffer-invisibility-spec) - (assq inv buffer-invisibility-spec))) - (overlay-put ol 'reveal-invisible inv)))) + (and (setq inv (overlay-get ol 'invisible)) + (symbolp inv) + (or (setq open (or (get inv 'reveal-toggle-invisible) + (overlay-get ol 'isearch-open-invisible-temporary))) + (overlay-get ol 'isearch-open-invisible) + (and (consp buffer-invisibility-spec) + (assq inv buffer-invisibility-spec))) + (overlay-put ol 'reveal-invisible inv))) (if (null open) (overlay-put ol 'invisible nil) ;; Use the provided opening function and repeat (since the @@ -113,27 +116,39 @@ (setq repeat nil) (overlay-put ol 'invisible nil)))))))) ;; Close old overlays. - (dolist (ol old-ols) - (when (and (eq (current-buffer) (overlay-buffer ol)) - (not (rassq ol reveal-open-spots))) - (if (and (>= (point) (save-excursion - (goto-char (overlay-start ol)) - (line-beginning-position 1))) - (<= (point) (save-excursion - (goto-char (overlay-end ol)) - (line-beginning-position 2)))) - ;; Still near the overlay: keep it open. - (push (cons (selected-window) ol) reveal-open-spots) - ;; Really close it. - (let ((open (overlay-get ol 'reveal-toggle-invisible)) inv) - (if (or open - (and (setq inv (overlay-get ol 'reveal-invisible)) - (setq open (or (get inv 'reveal-toggle-invisible) - (overlay-get ol 'isearch-open-invisible-temporary))))) - (condition-case err - (funcall open ol t) - (error (message "!!Reveal-hide: %s !!" err))) - (overlay-put ol 'invisible inv))))))) + (if (not (eq reveal-last-tick + (setq reveal-last-tick (buffer-modified-tick)))) + ;; The buffer was modified since last command: let's refrain from + ;; closing any overlay because it tends to behave poorly when + ;; inserting text at the end of an overlay (basically the overlay + ;; should be rear-advance when it's open, but things like + ;; outline-minor-mode make it non-rear-advance because it's + ;; a better choice when it's closed). + (dolist (ol old-ols) + (push (cons (selected-window) ol) reveal-open-spots)) + ;; The last command was only a point motion or some such + ;; non-buffer-modifying command. Let's close whatever can be closed. + (dolist (ol old-ols) + (when (and (eq (current-buffer) (overlay-buffer ol)) + (not (rassq ol reveal-open-spots))) + (if (and (>= (point) (save-excursion + (goto-char (overlay-start ol)) + (line-beginning-position 1))) + (<= (point) (save-excursion + (goto-char (overlay-end ol)) + (line-beginning-position 2)))) + ;; Still near the overlay: keep it open. + (push (cons (selected-window) ol) reveal-open-spots) + ;; Really close it. + (let ((open (overlay-get ol 'reveal-toggle-invisible)) inv) + (if (or open + (and (setq inv (overlay-get ol 'reveal-invisible)) + (setq open (or (get inv 'reveal-toggle-invisible) + (overlay-get ol 'isearch-open-invisible-temporary))))) + (condition-case err + (funcall open ol t) + (error (message "!!Reveal-hide: %s !!" err))) + (overlay-put ol 'invisible inv)))))))) (error (message "Reveal: %s" err))))) ;;;###autoload @@ -171,5 +186,5 @@ (provide 'reveal) -;;; arch-tag: 96ba0242-2274-4ed7-8e10-26bc0707b4d8 +;; arch-tag: 96ba0242-2274-4ed7-8e10-26bc0707b4d8 ;;; reveal.el ends here
--- a/lisp/shadowfile.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/shadowfile.el Thu Nov 04 08:55:40 2004 +0000 @@ -518,8 +518,9 @@ `shadow-save-buffers-kill-emacs', so it is not usually necessary to call it manually." (interactive "P") - (if (and (not shadow-files-to-copy) (interactive-p)) - (message "No files need to be shadowed.") + (if (not shadow-files-to-copy) + (if (interactive-p) + (message "No files need to be shadowed.")) (save-excursion (map-y-or-n-p (function (lambda (pair)
--- a/lisp/simple.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/simple.el Thu Nov 04 08:55:40 2004 +0000 @@ -1,7 +1,7 @@ ;;; simple.el --- basic editing commands for Emacs ;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99, -;; 2000, 01, 02, 03, 04 +;; 2000, 01, 02, 03, 2004 ;; Free Software Foundation, Inc. ;; Maintainer: FSF @@ -3916,6 +3916,8 @@ At top-level, as an editor command, this simply beeps." (interactive) (deactivate-mark) + (if (fboundp 'kmacro-keyboard-quit) + (kmacro-keyboard-quit)) (setq defining-kbd-macro nil) (signal 'quit nil))
--- a/lisp/speedbar.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/speedbar.el Thu Nov 04 08:55:40 2004 +0000 @@ -354,7 +354,9 @@ will be initialized to the height of the frame speedbar is attached to and added to this list before the new frame is initialized." :group 'speedbar - :type '(repeat (sexp :tag "Parameter:"))) + :type '(repeat (cons :format "%v" + (symbol :tag "Parameter") + (sexp :tag "Value")))) ;; These values by Hrvoje Niksic <hniksic@srce.hr> (defcustom speedbar-frame-plist
--- a/lisp/strokes.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/strokes.el Thu Nov 04 08:55:40 2004 +0000 @@ -1746,7 +1746,7 @@ (strokes-mode -1) (remove-hook 'kill-emacs-query-functions 'strokes-prompt-user-save-strokes)) -(add-hooks 'strokes-unload-hook 'strokes-unload-hook) +(add-hook 'strokes-unload-hook 'strokes-unload-hook) (run-hooks 'strokes-load-hook) (provide 'strokes)
--- a/lisp/subr.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/subr.el Thu Nov 04 08:55:40 2004 +0000 @@ -817,6 +817,10 @@ (make-obsolete-variable 'post-command-idle-delay "use timers instead, with `run-with-idle-timer'." "before 19.34") +(defvaralias 'x-lost-selection-hooks 'x-lost-selection-functions) +(make-obsolete-variable 'x-lost-selection-hooks 'x-lost-selection-functions "21.4") +(defvaralias 'x-sent-selection-hooks 'x-sent-selection-functions) +(make-obsolete-variable 'x-sent-selection-hooks 'x-sent-selection-functions "21.4") ;;;; Alternate names for functions - these are not being phased out. @@ -1211,6 +1215,61 @@ (setq first nil)) code)) +(defun read-passwd (prompt &optional confirm default) + "Read a password, prompting with PROMPT, and return it. +If optional CONFIRM is non-nil, read the password twice to make sure. +Optional DEFAULT is a default password to use instead of empty input. + +This function echoes `.' for each character that the user types. +The user ends with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line. +C-g quits; if `inhibit-quit' was non-nil around this function, +then it returns nil if the user types C-g. + +Once the caller uses the password, it can erase the password +by doing (clear-string STRING)." + (with-local-quit + (if confirm + (let (success) + (while (not success) + (let ((first (read-passwd prompt nil default)) + (second (read-passwd "Confirm password: " nil default))) + (if (equal first second) + (progn + (and (arrayp second) (clear-string second)) + (setq success first)) + (and (arrayp first) (clear-string first)) + (and (arrayp second) (clear-string second)) + (message "Password not repeated accurately; please start over") + (sit-for 1)))) + success) + (let ((pass nil) + (c 0) + (echo-keystrokes 0) + (cursor-in-echo-area t)) + (while (progn (message "%s%s" + prompt + (make-string (length pass) ?.)) + (setq c (read-char-exclusive nil t)) + (and (/= c ?\r) (/= c ?\n) (/= c ?\e))) + (clear-this-command-keys) + (if (= c ?\C-u) + (progn + (and (arrayp pass) (clear-string pass)) + (setq pass "")) + (if (and (/= c ?\b) (/= c ?\177)) + (let* ((new-char (char-to-string c)) + (new-pass (concat pass new-char))) + (and (arrayp pass) (clear-string pass)) + (clear-string new-char) + (setq c ?\0) + (setq pass new-pass)) + (if (> (length pass) 0) + (let ((new-pass (substring pass 0 -1))) + (and (arrayp pass) (clear-string pass)) + (setq pass new-pass)))))) + (message nil) + (or pass default ""))))) + ;; This should be used by `call-interactively' for `n' specs. (defun read-number (prompt &optional default) (let ((n nil))
--- a/lisp/tar-mode.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/tar-mode.el Thu Nov 04 08:55:40 2004 +0000 @@ -580,7 +580,7 @@ ;; Prevent loss of data when saving the file. (set (make-local-variable 'file-precious-flag) t) (auto-save-mode 0) - (set (make-local-variable 'write-contents-hooks) '(tar-mode-write-file)) + (set (make-local-variable 'write-contents-functions) '(tar-mode-write-file)) (widen) (if (and (boundp 'tar-header-offset) tar-header-offset) (narrow-to-region (point-min) tar-header-offset)
--- a/lisp/textmodes/bibtex.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/textmodes/bibtex.el Thu Nov 04 08:55:40 2004 +0000 @@ -42,6 +42,8 @@ ;;; Code: +(require 'button) + ;; User Options: @@ -496,7 +498,7 @@ (defcustom bibtex-string-files nil "*List of BibTeX files containing string definitions. -Those files must be specified using pathnames relative to the +List elements can be absolute file names or file names relative to the directories specified in `bibtex-string-file-path'." :group 'bibtex :type '(repeat file)) @@ -504,6 +506,18 @@ (defvar bibtex-string-file-path (getenv "BIBINPUTS") "*Colon separated list of paths to search for `bibtex-string-files'.") +(defcustom bibtex-files nil + "*List of BibTeX files checked for duplicate keys. +List elements can be absolute file names or file names relative to the +directories specified in `bibtex-file-path'. If an element is a directory, +check all BibTeX files in this directory. If an element is the symbol +`bibtex-file-path', check all BibTeX files in `bibtex-file-path'." + :group 'bibtex + :type '(repeat file)) + +(defvar bibtex-file-path (getenv "BIBINPUTS") + "*Colon separated list of paths to search for `bibtex-files'.") + (defcustom bibtex-help-message t "*If non-nil print help messages in the echo area on entering a new field." :group 'bibtex @@ -557,7 +571,7 @@ ;; braces, quotes, concatenation. ("[`'\"{}#]" . "") ;; spaces - ("[ \t\n]+" . " ")) + ("\\\\?[ \t\n]+\\|~" . " ")) "Alist of (OLD-REGEXP . NEW-STRING) pairs. Used by the default values of `bibtex-autokey-name-change-strings' and `bibtex-autokey-titleword-change-strings'. Defaults to translating some @@ -756,12 +770,22 @@ (defcustom bibtex-autoadd-commas t "If non-nil automatically add missing commas at end of BibTeX fields." + :group 'bibtex :type 'boolean) (defcustom bibtex-autofill-types '("Proceedings") "Automatically fill fields if possible for those BibTeX entry types." + :group 'bibtex :type '(repeat string)) +(defcustom bibtex-summary-function 'bibtex-summary + "Function to call for generating a one-line summary of a BibTeX entry. +It takes one argument, the key of the entry. +Used by `bibtex-complete-key-cleanup' and `bibtex-copy-summary-as-kill'." + :group 'bibtex + :type '(choice (const :tag "Default" bibtex-summary) + (function :tag "Personalized function"))) + (defcustom bibtex-generate-url-list '((("url" . ".*:.*")) ;; Example of a complex setup. @@ -778,7 +802,7 @@ Each scheme is of the form ((FIELD . REGEXP) STEP...). FIELD is a field name as returned by `bibtex-parse-entry'. -REGEXP is matched against the text of FIELD. If the match succeed, then +REGEXP is matched against the text of FIELD. If the match succeeds, then this scheme will be used. If no STEPS are specified the matched text is used as the URL, otherwise the URL is built by concatenating the STEPS. @@ -838,6 +862,7 @@ (define-key km "\C-c\C-c" 'bibtex-clean-entry) (define-key km "\C-c\C-q" 'bibtex-fill-entry) (define-key km "\C-c\C-s" 'bibtex-find-entry) + (define-key km "\C-c\C-t" 'bibtex-copy-summary-as-kill) (define-key km "\C-c?" 'bibtex-print-help-message) (define-key km "\C-c\C-p" 'bibtex-pop-previous) (define-key km "\C-c\C-n" 'bibtex-pop-next) @@ -892,7 +917,9 @@ ("Moving in BibTeX Buffer" ["Find Entry" bibtex-find-entry t] ["Find Crossref Entry" bibtex-find-crossref t]) - "--" + ("Moving between BibTeX Buffers" + ["Find Entry Globally" bibtex-find-entry-globally t]) + "--" ("Operating on Current Field" ["Fill Field" fill-paragraph t] ["Remove Delimiters" bibtex-remove-delimiters t] @@ -922,6 +949,8 @@ ["Paste Most Recently Killed Entry" bibtex-yank t] ["Paste Previously Killed Entry" bibtex-yank-pop t] "--" + ["Copy Summary to Kill Ring" bibtex-copy-summary-as-kill t] + "--" ["Ispell Entry" bibtex-ispell-entry t] ["Ispell Entry Abstract" bibtex-ispell-abstract t] ["Narrow to Entry" bibtex-narrow-to-entry t] @@ -934,7 +963,9 @@ ["Reformat Entries" bibtex-reformat t] ["Count Entries" bibtex-count-entries t] "--" - ["Convert Alien Buffer" bibtex-convert-alien t]))) + ["Convert Alien Buffer" bibtex-convert-alien t]) + ("Operating on Multiple Buffers" + ["Validate Entries" bibtex-validate-globally t]))) (easy-menu-define bibtex-entry-menu bibtex-mode-map "Entry-Types Menu in BibTeX mode" @@ -955,13 +986,6 @@ ["String" bibtex-String t] ["Preamble" bibtex-Preamble t])) -(defvar bibtex-url-map - (let ((km (make-sparse-keymap))) - (define-key km [(mouse-2)] 'bibtex-url) - km) - "Local keymap for clickable URLs.") -(fset 'bibtex-url-map bibtex-url-map) - ;; Internal Variables @@ -996,8 +1020,9 @@ (make-variable-buffer-local 'bibtex-strings) (defvar bibtex-reference-keys - (lazy-completion-table bibtex-reference-keys bibtex-parse-keys nil nil t) - "Completion table for BibTeX reference keys.") + (lazy-completion-table bibtex-reference-keys bibtex-parse-keys nil t) + "Completion table for BibTeX reference keys. +The CDRs of the elements are t for header keys and nil for crossref keys.") (make-variable-buffer-local 'bibtex-reference-keys) (defvar bibtex-buffer-last-parsed-tick nil @@ -1103,13 +1128,13 @@ (,(concat "^[ \t]*\\(" bibtex-field-name "\\)[ \t]*=") 1 font-lock-variable-name-face) ;; url - (bibtex-font-lock-url 0 '(face nil mouse-face highlight - keymap bibtex-url-map))) + bibtex-font-lock-url bibtex-font-lock-crossref) "*Default expressions to highlight in BibTeX mode.") (defvar bibtex-font-lock-url-regexp - (concat "\\<" (regexp-opt (mapcar 'caar bibtex-generate-url-list) t) - "\\>[ \t]*=[ \t]*") + ;; Assume that field names begin at the beginning of a line. + (concat "^[ \t]*" (regexp-opt (mapcar 'caar bibtex-generate-url-list) t) + "[ \t]*=[ \t]*") "Regexp for `bibtex-font-lock-url'.") (defvar bibtex-field-name-for-parsing nil @@ -1128,32 +1153,12 @@ Used when `bibtex-maintain-sorted-entries' is `entry-class'.") -;; Special support taking care of variants -(defvar zmacs-regions) -(defalias 'bibtex-mark-active - (if (boundp 'mark-active) - ;; In Emacs mark-active indicates if mark is active. - (lambda () mark-active) - ;; In XEmacs (mark) returns nil when not active. - (lambda () (if zmacs-regions (mark) (mark t))))) - -(defalias 'bibtex-run-with-idle-timer - (if (fboundp 'run-with-idle-timer) - ;; timer.el is distributed with Emacs - 'run-with-idle-timer - ;; timer.el is not distributed with XEmacs - ;; Notice that this does not (yet) pass the arguments, but they - ;; are not used (yet) in bibtex.el. Fix if needed. - (lambda (secs repeat function &rest args) - (start-itimer "bibtex" function secs (if repeat secs nil) t)))) - - ;; Support for hideshow minor mode (defun bibtex-hs-forward-sexp (arg) "Replacement for `forward-sexp' to be used by `hs-minor-mode'. ARG is ignored." (if (looking-at "@\\S(*\\s(") - (goto-char (1- (match-end 0)))) + (goto-char (1- (match-end 0)))) (forward-sexp 1)) (add-to-list @@ -1471,12 +1476,10 @@ (buffer-substring-no-properties (1+ (match-beginning bibtex-type-in-head)) (match-end bibtex-type-in-head))) -(defun bibtex-key-in-head (&optional empty) +(defsubst bibtex-key-in-head (&optional empty) "Extract BibTeX key in head. Return optional arg EMPTY if key is empty." - (if (match-beginning bibtex-key-in-head) - (buffer-substring-no-properties (match-beginning bibtex-key-in-head) - (match-end bibtex-key-in-head)) - empty)) + (or (match-string-no-properties bibtex-key-in-head) + empty)) ;; Helper Functions @@ -1492,7 +1495,7 @@ (defun bibtex-current-line () "Compute line number of point regardless whether the buffer is narrowed." (+ (count-lines 1 (point)) - (if (equal (current-column) 0) 1 0))) + (if (bolp) 1 0))) (defun bibtex-skip-to-valid-entry (&optional backward) "Move point to beginning of the next valid BibTeX entry. @@ -1525,24 +1528,25 @@ found)) (defun bibtex-map-entries (fun) - "Call FUN for each BibTeX entry starting with the current. -Do this to the end of the file. FUN is called with three arguments, the key of -the entry and the buffer positions (marker) of beginning and end of entry. -Point is inside the entry. If `bibtex-sort-ignore-string-entries' is non-nil, -FUN will not be called for @String entries." + "Call FUN for each BibTeX entry in buffer (possibly narrowed). +FUN is called with three arguments, the key of the entry and the buffer +positions (marker) of beginning and end of entry. Point is inside the entry. +If `bibtex-sort-ignore-string-entries' is non-nil, FUN will not be called for +@String entries." (let ((case-fold-search t)) - (bibtex-beginning-of-entry) - (while (re-search-forward bibtex-entry-head nil t) - (let ((entry-type (bibtex-type-in-head)) - (key (bibtex-key-in-head "")) - (beg (copy-marker (match-beginning 0))) - (end (copy-marker (save-excursion (bibtex-end-of-entry))))) - (save-excursion - (if (or (and (not bibtex-sort-ignore-string-entries) - (bibtex-string= entry-type "string")) - (assoc-string entry-type bibtex-entry-field-alist t)) - (funcall fun key beg end))) - (goto-char end))))) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward bibtex-entry-head nil t) + (let ((entry-type (bibtex-type-in-head)) + (key (bibtex-key-in-head "")) + (beg (copy-marker (match-beginning 0))) + (end (copy-marker (save-excursion (bibtex-end-of-entry))))) + (save-excursion + (if (or (and (not bibtex-sort-ignore-string-entries) + (bibtex-string= entry-type "string")) + (assoc-string entry-type bibtex-entry-field-alist t)) + (funcall fun key beg end))) + (goto-char end)))))) (defun bibtex-progress-message (&optional flag interval) "Echo a message about progress of current buffer. @@ -1581,13 +1585,13 @@ "\"")) (defun bibtex-entry-left-delimiter () - "Return a string dependent on `bibtex-field-delimiters'." + "Return a string dependent on `bibtex-entry-delimiters'." (if (equal bibtex-entry-delimiters 'braces) "{" "(")) (defun bibtex-entry-right-delimiter () - "Return a string dependent on `bibtex-field-delimiters'." + "Return a string dependent on `bibtex-entry-delimiters'." (if (equal bibtex-entry-delimiters 'braces) "}" ")")) @@ -1641,7 +1645,7 @@ (setq infix-start (bibtex-end-of-field bounds)) (setq finished t)) (goto-char infix-start)) - ;; This matches the infix* part. The AND construction assures + ;; This matches the infix* part. The AND construction assures ;; that BOUND is respected. (when (and (looking-at bibtex-entry-postfix) (eq (char-before (match-end 0)) entry-closer) @@ -1826,8 +1830,8 @@ (cdr field))) (cdr field)) req-field-list (if crossref-key - (nth 0 (nth 2 entry-list)) ; crossref part - (nth 0 (nth 1 entry-list)))) ; required part + (nth 0 (nth 2 entry-list)) ; crossref part + (nth 0 (nth 1 entry-list)))) ; required part (dolist (rfield req-field-list) (when (nth 3 rfield) ; we should have an alternative @@ -1864,9 +1868,9 @@ deleted) ;; We have more elegant high-level functions for several - ;; tasks done by bibtex-format-entry. However, they contain + ;; tasks done by bibtex-format-entry. However, they contain ;; quite some redundancy compared with what we need to do - ;; anyway. So for speed-up we avoid using them. + ;; anyway. So for speed-up we avoid using them. (if (memq 'opts-or-alts format) (cond ((and empty-field @@ -1875,8 +1879,8 @@ field-name req-field-list t))) (or (not field) ; OPT field (nth 3 field))))) ; ALT field - ;; Either it is an empty ALT field. Then we have checked - ;; already that we have one non-empty alternative. Or it + ;; Either it is an empty ALT field. Then we have checked + ;; already that we have one non-empty alternative. Or it ;; is an empty OPT field that we do not miss anyway. ;; So we can safely delete this field. (delete-region beg-field end-field) @@ -2041,19 +2045,33 @@ (dolist (pattern change-list content) (setq content (replace-regexp-in-string (car pattern) (cdr pattern) - content))))) + content t))))) (defun bibtex-autokey-get-names () "Get contents of the name field of the current entry. -Do some modifications based on `bibtex-autokey-name-change-strings' -and return results as a list." - (let ((case-fold-search t) - (names (bibtex-autokey-get-field "author\\|editor" +Do some modifications based on `bibtex-autokey-name-change-strings'. +Return the names as a concatenated string obeying `bibtex-autokey-names' +and `bibtex-autokey-names-stretch'." + (let ((names (bibtex-autokey-get-field "author\\|editor" bibtex-autokey-name-change-strings))) ;; Some entries do not have a name field. (unless (string= "" names) - (mapcar 'bibtex-autokey-demangle-name - (split-string names "[ \t\n]+and[ \t\n]+"))))) + (let* ((case-fold-search t) + (name-list (mapcar 'bibtex-autokey-demangle-name + (split-string names "[ \t\n]+and[ \t\n]+"))) + additional-names) + (unless (or (not (numberp bibtex-autokey-names)) + (<= (length name-list) + (+ bibtex-autokey-names + bibtex-autokey-names-stretch))) + ;; Take bibtex-autokey-names elements from beginning of name-list + (setq name-list (nreverse (nthcdr (- (length name-list) + bibtex-autokey-names) + (nreverse name-list))) + additional-names bibtex-autokey-additional-names)) + (concat (mapconcat 'identity name-list + bibtex-autokey-name-separator) + additional-names))))) (defun bibtex-autokey-demangle-name (fullname) "Get the last part from a well-formed FULLNAME and perform abbreviations." @@ -2082,8 +2100,15 @@ (funcall bibtex-autokey-name-case-convert name) bibtex-autokey-name-length))) +(defun bibtex-autokey-get-year () + "Return year field contents as a string obeying `bibtex-autokey-year-length'." + (let ((yearfield (bibtex-autokey-get-field "year"))) + (substring yearfield (max 0 (- (length yearfield) + bibtex-autokey-year-length))))) + (defun bibtex-autokey-get-title () - "Get title field contents up to a terminator." + "Get title field contents up to a terminator. +Return the result as a string" (let ((case-fold-search t) (titlestring (bibtex-autokey-get-field "title" @@ -2092,35 +2117,37 @@ (dolist (terminator bibtex-autokey-title-terminators) (if (string-match terminator titlestring) (setq titlestring (substring titlestring 0 (match-beginning 0))))) - ;; gather words from titlestring into a list. Ignore + ;; gather words from titlestring into a list. Ignore ;; specific words and use only a specific amount of words. (let ((counter 0) - titlewords titlewords-extra titleword end-match) + titlewords titlewords-extra word) (while (and (or (not (numberp bibtex-autokey-titlewords)) (< counter (+ bibtex-autokey-titlewords bibtex-autokey-titlewords-stretch))) (string-match "\\b\\w+" titlestring)) - (setq end-match (match-end 0) - titleword (substring titlestring - (match-beginning 0) end-match)) + (setq word (match-string 0 titlestring) + titlestring (substring titlestring (match-end 0))) + ;; Ignore words matched by one of the elements of + ;; bibtex-autokey-titleword-ignore (unless (let ((lst bibtex-autokey-titleword-ignore)) (while (and lst (not (string-match (concat "\\`\\(?:" (car lst) - "\\)\\'") titleword))) + "\\)\\'") word))) (setq lst (cdr lst))) lst) - (setq titleword - (funcall bibtex-autokey-titleword-case-convert titleword)) + (setq word (funcall bibtex-autokey-titleword-case-convert word) + counter (1+ counter)) (if (or (not (numberp bibtex-autokey-titlewords)) (< counter bibtex-autokey-titlewords)) - (setq titlewords (append titlewords (list titleword))) - (setq titlewords-extra - (append titlewords-extra (list titleword)))) - (setq counter (1+ counter))) - (setq titlestring (substring titlestring end-match))) + (push word titlewords) + (push word titlewords-extra)))) + ;; Obey bibtex-autokey-titlewords-stretch: + ;; If by now we have processed all words in titlestring, we include + ;; titlewords-extra in titlewords. Otherwise, we ignore titlewords-extra. (unless (string-match "\\b\\w+" titlestring) - (setq titlewords (append titlewords titlewords-extra))) - (mapcar 'bibtex-autokey-demangle-title titlewords)))) + (setq titlewords (append titlewords-extra titlewords))) + (mapconcat 'bibtex-autokey-demangle-title (nreverse titlewords) + bibtex-autokey-titleword-separator)))) (defun bibtex-autokey-demangle-title (titleword) "Do some abbreviations on TITLEWORD. @@ -2211,65 +2238,36 @@ the key is then presented in the minibuffer to the user, where it can be edited. The key given by the user is then used." - (let* ((name-etal "") - (namelist - (let ((nl (bibtex-autokey-get-names)) - nnl) - (if (or (not (numberp bibtex-autokey-names)) - (<= (length nl) - (+ bibtex-autokey-names - bibtex-autokey-names-stretch))) - nl - (setq name-etal bibtex-autokey-additional-names) - (while (< (length nnl) bibtex-autokey-names) - (setq nnl (append nnl (list (car nl))) - nl (cdr nl))) - nnl))) - (namepart (concat (mapconcat 'identity - namelist - bibtex-autokey-name-separator) - name-etal)) - (yearfield (bibtex-autokey-get-field "year")) - (yearpart (if (equal yearfield "") - "" - (substring yearfield - (- (length yearfield) - bibtex-autokey-year-length)))) - (titlepart (mapconcat 'identity - (bibtex-autokey-get-title) - bibtex-autokey-titleword-separator)) + (let* ((names (bibtex-autokey-get-names)) + (year (bibtex-autokey-get-year)) + (title (bibtex-autokey-get-title)) (autokey (concat bibtex-autokey-prefix-string - namepart - (unless (or (equal namepart "") - (equal yearpart "")) + names + (unless (or (equal names "") + (equal year "")) bibtex-autokey-name-year-separator) - yearpart - (unless (or (and (equal namepart "") - (equal yearpart "")) - (equal titlepart "")) + year + (unless (or (and (equal names "") + (equal year "")) + (equal title "")) bibtex-autokey-year-title-separator) - titlepart))) + title))) (if bibtex-autokey-before-presentation-function (funcall bibtex-autokey-before-presentation-function autokey) autokey))) -(defun bibtex-parse-keys (&optional add abortable verbose) +(defun bibtex-read-key (prompt &optional key) + "Read BibTeX key from minibuffer using PROMPT and default KEY." + (completing-read prompt bibtex-reference-keys + nil nil key 'bibtex-key-history)) + +(defun bibtex-parse-keys (&optional abortable verbose) "Set `bibtex-reference-keys' to the keys used in the whole buffer. -The buffer might possibly be restricted. -Find both entry keys and crossref entries. -If ADD is non-nil add the new keys to `bibtex-reference-keys' instead of -simply resetting it. If ADD is an alist of keys, also add ADD to -`bibtex-reference-keys'. If ABORTABLE is non-nil abort on user -input. If VERBOSE is non-nil gives messages about progress. -Return alist of keys if parsing was completed, `aborted' otherwise." - (let ((reference-keys (if (and add - (listp bibtex-reference-keys)) - bibtex-reference-keys))) - (if (listp add) - (dolist (key add) - (unless (assoc (car key) reference-keys) - (push key reference-keys)))) +Find both entry keys and crossref entries. If ABORTABLE is non-nil abort on +user input. If VERBOSE is non-nil gives messages about progress. Return alist +of keys if parsing was completed, `aborted' otherwise." + (let (ref-keys crossref-keys) (save-excursion (save-match-data (if verbose @@ -2286,22 +2284,24 @@ (if (and abortable (input-pending-p)) ;; user has aborted by typing a key --> return `aborted' (throw 'userkey 'aborted)) - (let ((key (cond ((match-end 3) - ;; This is a crossref. - (buffer-substring-no-properties - (1+ (match-beginning 3)) (1- (match-end 3)))) - ((assoc-string (bibtex-type-in-head) - bibtex-entry-field-alist t) - ;; This is an entry. - (match-string-no-properties bibtex-key-in-head))))) - (if (and (stringp key) - (not (assoc key reference-keys))) - (push (list key) reference-keys))))) + (cond ((match-end 3) + ;; This is a crossref. + (let ((key (buffer-substring-no-properties + (1+ (match-beginning 3)) (1- (match-end 3))))) + (unless (assoc key crossref-keys) + (push (list key) crossref-keys)))) + ;; only keys of known entries + ((assoc-string (bibtex-type-in-head) + bibtex-entry-field-alist t) + ;; This is an entry. + (let ((key (bibtex-key-in-head))) + (unless (assoc key ref-keys) + (push (cons key t) ref-keys))))))) (let (;; ignore @String entries because they are handled ;; separately by bibtex-parse-strings (bibtex-sort-ignore-string-entries t) - crossref-key bounds) + bounds) (bibtex-map-entries (lambda (key beg end) (if (and abortable @@ -2309,17 +2309,19 @@ ;; user has aborted by typing a key --> return `aborted' (throw 'userkey 'aborted)) (if verbose (bibtex-progress-message)) - (unless (assoc key reference-keys) - (push (list key) reference-keys)) + (unless (assoc key ref-keys) + (push (cons key t) ref-keys)) (if (and (setq bounds (bibtex-search-forward-field "crossref" end)) - (setq crossref-key (bibtex-text-in-field-bounds bounds t)) - (not (assoc crossref-key reference-keys))) - (push (list crossref-key) reference-keys)))))) - + (setq key (bibtex-text-in-field-bounds bounds t)) + (not (assoc key crossref-keys))) + (push (list key) crossref-keys)))))) + + (dolist (key crossref-keys) + (unless (assoc (car key) ref-keys) (push key ref-keys))) (if verbose (bibtex-progress-message 'done)) ;; successful operation --> return `bibtex-reference-keys' - (setq bibtex-reference-keys reference-keys)))))) + (setq bibtex-reference-keys ref-keys)))))) (defun bibtex-parse-strings (&optional add abortable) "Set `bibtex-strings' to the string definitions in the whole buffer. @@ -2355,39 +2357,44 @@ (defun bibtex-string-files-init () "Return initialization for `bibtex-strings'. -Use `bibtex-predefined-strings' and bib files `bibtex-string-files'." +Use `bibtex-predefined-strings' and BibTeX files `bibtex-string-files'." (save-match-data - ;; collect pathnames - (let ((dirlist (split-string (or bibtex-string-file-path ".") + (let ((dirlist (split-string (or bibtex-string-file-path default-directory) ":+")) (case-fold-search) - compl) + string-files fullfilename compl bounds found) + ;; collect absolute file names of valid string files (dolist (filename bibtex-string-files) (unless (string-match "\\.bib\\'" filename) (setq filename (concat filename ".bib"))) ;; test filenames - (let (fullfilename bounds found) + (if (file-name-absolute-p filename) + (if (file-readable-p filename) + (push filename string-files) + (error "BibTeX strings file %s not found" filename)) (dolist (dir dirlist) (when (file-readable-p (setq fullfilename (expand-file-name filename dir))) - ;; file was found - (with-temp-buffer - (insert-file-contents fullfilename) - (goto-char (point-min)) - (while (setq bounds (bibtex-search-forward-string)) - (push (cons (bibtex-reference-key-in-string bounds) - (bibtex-text-in-string bounds t)) - compl) - (goto-char (bibtex-end-of-string bounds)))) + (push fullfilename string-files) (setq found t))) (unless found (error "File %s not in paths defined via bibtex-string-file-path" filename)))) + ;; parse string files + (dolist (filename string-files) + (with-temp-buffer + (insert-file-contents filename) + (goto-char (point-min)) + (while (setq bounds (bibtex-search-forward-string)) + (push (cons (bibtex-reference-key-in-string bounds) + (bibtex-text-in-string bounds t)) + compl) + (goto-char (bibtex-end-of-string bounds))))) (append bibtex-predefined-strings (nreverse compl))))) (defun bibtex-parse-buffers-stealthily () "Parse buffer in the background during idle time. -Called by `bibtex-run-with-idle-timer'. Whenever Emacs has been idle +Called by `run-with-idle-timer'. Whenever Emacs has been idle for `bibtex-parse-keys-timeout' seconds, all BibTeX buffers (starting with the current) are parsed." (save-excursion @@ -2402,7 +2409,7 @@ (widen) ;; Output no progress messages in bibtex-parse-keys ;; because when in y-or-n-p that can hide the question. - (if (and (listp (bibtex-parse-keys nil t)) + (if (and (listp (bibtex-parse-keys t)) ;; update bibtex-strings (listp (bibtex-parse-strings strings-init t))) @@ -2410,6 +2417,51 @@ (setq bibtex-buffer-last-parsed-tick (buffer-modified-tick))))) (setq buffers (cdr buffers)))))) +(defun bibtex-files-expand (&optional current) + "Return an expanded list of BibTeX buffers based on `bibtex-files'. +Initialize in these buffers `bibtex-reference-keys' if not yet set. +List includes current buffer if CURRENT is non-nil." + (let ((file-path (split-string (or bibtex-file-path default-directory) ":+")) + file-list dir-list buffer-list) + (dolist (file bibtex-files) + (cond ((eq file 'bibtex-file-path) + (setq dir-list (append dir-list file-path))) + ((file-accessible-directory-p file) + (push file dir-list)) + ((progn (unless (string-match "\\.bib\\'" file) + (setq file (concat file ".bib"))) + (file-name-absolute-p file)) + (push file file-list)) + (t + (let (fullfilename found) + (dolist (dir file-path) + (when (file-readable-p + (setq fullfilename (expand-file-name file dir))) + (push fullfilename file-list) + (setq found t))) + (unless found + (error "File %s not in paths defined via bibtex-file-path" + file)))))) + (dolist (file file-list) + (unless (file-readable-p file) + (error "BibTeX file %s not found" file))) + ;; expand dir-list + (dolist (dir dir-list) + (setq file-list + (append file-list (directory-files dir t "\\.bib\\'" t)))) + (delete-dups file-list) + (dolist (file file-list) + (when (file-readable-p file) + (push (find-file-noselect file) buffer-list) + (with-current-buffer (car buffer-list) + (unless (listp bibtex-reference-keys) + (bibtex-parse-keys))))) + (cond ((and current (not (memq (current-buffer) buffer-list))) + (push (current-buffer) buffer-list)) + ((and (not current) (memq (current-buffer) buffer-list)) + (setq buffer-list (delq (current-buffer) buffer-list)))) + buffer-list)) + (defun bibtex-complete-internal (completions) "Complete word fragment before point to longest prefix of COMPLETIONS. COMPLETIONS should be a list of strings. If point is not after the part @@ -2459,58 +2511,59 @@ (bibtex-remove-delimiters)))))))) (defun bibtex-complete-key-cleanup (key) - "Display message on entry KEY after completion of a crossref key." + "Display summary message on entry KEY after completion of a crossref key. +Use `bibtex-summary-function' to generate summary." (save-excursion ;; Don't do anything if we completed the key of an entry. (let ((pnt (bibtex-beginning-of-entry))) (if (and (stringp key) (bibtex-find-entry key) (/= pnt (point))) - (let* ((bibtex-autokey-name-case-convert 'identity) - (bibtex-autokey-name-length 'infty) - (nl (bibtex-autokey-get-names)) - (name (concat (nth 0 nl) (if (nth 1 nl) " etal"))) - (year (bibtex-autokey-get-field "year")) - (bibtex-autokey-titlewords 5) - (bibtex-autokey-titlewords-stretch 2) - (bibtex-autokey-titleword-case-convert 'identity) - (bibtex-autokey-titleword-length 5) - (title (mapconcat 'identity - (bibtex-autokey-get-title) " ")) - (journal (bibtex-autokey-get-field - "journal" bibtex-autokey-transcriptions)) - (volume (bibtex-autokey-get-field "volume")) - (pages (bibtex-autokey-get-field "pages" '(("-.*\\'" . ""))))) - (message "Ref:%s" - (mapconcat (lambda (arg) - (if (not (string= "" (cdr arg))) - (concat (car arg) (cdr arg)))) - `((" " . ,name) (" " . ,year) - (": " . ,title) (", " . ,journal) - (" " . ,volume) (":" . ,pages)) - ""))))))) - -(defun bibtex-choose-completion-string (choice buffer mini-p base-size) - ;; Code borrowed from choose-completion-string: - ;; We must duplicate the code from choose-completion-string - ;; because it runs the hook choose-completion-string-functions - ;; before it inserts the completion. But we want to do something - ;; after the completion has been inserted. - ;; - ;; Insert the completion into the buffer where it was requested. - (set-buffer buffer) - (if base-size - (delete-region (+ base-size (point-min)) - (point)) - ;; Delete the longest partial match for CHOICE - ;; that can be found before point. - (choose-completion-delete-max-match choice)) - (insert choice) - (remove-text-properties (- (point) (length choice)) (point) - '(mouse-face nil)) - ;; Update point in the window that BUFFER is showing in. - (let ((window (get-buffer-window buffer t))) - (set-window-point window (point)))) + (message "Ref: %s" (funcall bibtex-summary-function key)))))) + +(defun bibtex-copy-summary-as-kill (key) + "Push summery of BibTeX entry KEY to kill ring. +Use `bibtex-summary-function' to generate summary." + (interactive + (list (bibtex-read-key + "Key: " (save-excursion + (bibtex-beginning-of-entry) + (when (re-search-forward bibtex-entry-head nil t) + (bibtex-key-in-head)))))) + (kill-new (message "%s" (funcall bibtex-summary-function key)))) + +(defun bibtex-summary (key) + "Return summary of BibTeX entry KEY. +Used as default value of `bibtex-summary-function'." + ;; It would be neat to customize this function. How? + (save-excursion + (if (bibtex-find-entry key) + (let* ((bibtex-autokey-name-case-convert 'identity) + (bibtex-autokey-name-length 'infty) + (bibtex-autokey-names 1) + (bibtex-autokey-names-stretch 0) + (bibtex-autokey-name-separator " ") + (bibtex-autokey-additional-names " etal") + (names (bibtex-autokey-get-names)) + (bibtex-autokey-year-length 4) + (year (bibtex-autokey-get-year)) + (bibtex-autokey-titlewords 5) + (bibtex-autokey-titlewords-stretch 2) + (bibtex-autokey-titleword-case-convert 'identity) + (bibtex-autokey-titleword-length 5) + (bibtex-autokey-titleword-separator " ") + (title (bibtex-autokey-get-title)) + (journal (bibtex-autokey-get-field + "journal" bibtex-autokey-transcriptions)) + (volume (bibtex-autokey-get-field "volume")) + (pages (bibtex-autokey-get-field "pages" '(("-.*\\'" . ""))))) + (mapconcat (lambda (arg) + (if (not (string= "" (cdr arg))) + (concat (car arg) (cdr arg)))) + `((" " . ,names) (" " . ,year) (": " . ,title) + (", " . ,journal) (" " . ,volume) (":" . ,pages)) + "")) + (error "Key `%s' not found." key)))) (defun bibtex-pop (arg direction) "Fill current field from the ARG'th same field's text in DIRECTION. @@ -2550,7 +2603,7 @@ (if failure (error "No %s matching BibTeX field" (if (eq direction 'previous) "previous" "next")) - ;; Found a matching field. Remember boundaries. + ;; Found a matching field. Remember boundaries. (setq bibtex-pop-previous-search-point (bibtex-start-of-field bounds) bibtex-pop-next-search-point (bibtex-end-of-field bounds) new-text (bibtex-text-in-field-bounds bounds)) @@ -2563,10 +2616,82 @@ (bibtex-find-text nil)) (setq this-command 'bibtex-pop)) -(defsubst bibtex-read-key (prompt &optional key) - "Read BibTeX key from minibuffer using PROMPT and default KEY." - (completing-read prompt bibtex-reference-keys - nil nil key 'bibtex-key-history)) +(defun bibtex-beginning-of-field () + "Move point backward to beginning of field. +This function uses a simple, fast algorithm assuming that the field +begins at the beginning of a line. We use this function for font-locking." + (let ((field-reg (concat "^[ \t]*" bibtex-field-name "[ \t]*="))) + (beginning-of-line) + (unless (looking-at field-reg) + (re-search-backward field-reg nil t)))) + +(defun bibtex-font-lock-url (bound) + "Font-lock for URLs." + (let ((case-fold-search t) + (pnt (point)) + field bounds start end found) + (bibtex-beginning-of-field) + (while (and (not found) + (prog1 (re-search-forward bibtex-font-lock-url-regexp bound t) + (setq field (match-string-no-properties 1))) + (setq bounds (bibtex-parse-field-text)) + (progn + (setq start (car bounds) end (cdr bounds)) + ;; Always ignore field delimiters + (if (memq (char-before end) '(?\} ?\")) + (setq end (1- end))) + (if (memq (char-after start) '(?\{ ?\")) + (setq start (1+ start))) + (>= bound start))) + (let ((lst bibtex-generate-url-list) url) + (goto-char start) + (while (and (not found) + (setq url (caar lst))) + (setq found (and (bibtex-string= field (car url)) + (re-search-forward (cdr url) end t) + (>= (match-beginning 0) pnt)) + lst (cdr lst)))) + (goto-char end)) + (if found (bibtex-button (match-beginning 0) (match-end 0) + 'bibtex-url (match-beginning 0))) + found)) + +(defun bibtex-font-lock-crossref (bound) + "Font-lock for crossref fields." + (let ((case-fold-search t) + (pnt (point)) + (crossref-reg (concat "^[ \t]*crossref[ \t]*=[ \t\n]*" + "\\(\"[^\"]*\"\\|{[^}]*}\\)[ \t\n]*[,})]")) + start end found) + (bibtex-beginning-of-field) + (while (and (not found) + (re-search-forward crossref-reg bound t)) + (setq start (1+ (match-beginning 1)) + end (1- (match-end 1)) + found (>= start pnt))) + (if found (bibtex-button start end 'bibtex-find-crossref + (buffer-substring-no-properties start end) + start t)) + found)) + +(defun bibtex-button-action (button) + "Call BUTTON's BibTeX function." + (apply (button-get button 'bibtex-function) + (button-get button 'bibtex-args))) + +(define-button-type 'bibtex-url + 'action 'bibtex-button-action + 'bibtex-function 'bibtex-url + 'help-echo (purecopy "mouse-2, RET: follow URL")) + +(define-button-type 'bibtex-find-crossref + 'action 'bibtex-button-action + 'bibtex-function 'bibtex-find-crossref + 'help-echo (purecopy "mouse-2, RET: follow crossref")) + +(defun bibtex-button (beg end type &rest args) + (make-text-button beg end 'type type 'bibtex-args args)) + ;; Interactive Functions: @@ -2668,7 +2793,7 @@ (make-local-variable 'bibtex-buffer-last-parsed-tick) ;; Install stealthy parse function if not already installed (unless bibtex-parse-idle-timer - (setq bibtex-parse-idle-timer (bibtex-run-with-idle-timer + (setq bibtex-parse-idle-timer (run-with-idle-timer bibtex-parse-keys-timeout t 'bibtex-parse-buffers-stealthily))) (set (make-local-variable 'paragraph-start) "[ \f\n\t]*$") @@ -2680,8 +2805,8 @@ (set (make-local-variable 'outline-regexp) "[ \t]*@") (set (make-local-variable 'fill-paragraph-function) 'bibtex-fill-field) (set (make-local-variable 'fill-prefix) (make-string (+ bibtex-entry-offset - bibtex-contline-indentation) - ? )) + bibtex-contline-indentation) + ? )) (set (make-local-variable 'font-lock-defaults) '(bibtex-font-lock-keywords nil t ((?$ . "\"") @@ -2693,7 +2818,7 @@ ) nil (font-lock-syntactic-keywords . bibtex-font-lock-syntactic-keywords) - (font-lock-extra-managed-props . (mouse-face keymap)) + (font-lock-extra-managed-props . (category)) (font-lock-mark-block-function . (lambda () (set-mark (bibtex-end-of-entry)) @@ -2776,8 +2901,7 @@ ;; bibtex-parse-entry moves point to the end of the last field. (let* ((fields-alist (bibtex-parse-entry)) (field-list (bibtex-field-list - (substring (cdr (assoc "=type=" fields-alist)) - 1)))) ; don't want @ + (cdr (assoc "=type=" fields-alist))))) (dolist (field (car field-list)) (unless (assoc-string (car field) fields-alist t) (bibtex-make-field field))) @@ -2793,8 +2917,8 @@ Move point to the end of the last field." (let (alist bounds) (when (looking-at bibtex-entry-maybe-empty-head) - (push (cons "=type=" (match-string bibtex-type-in-head)) alist) - (push (cons "=key=" (match-string bibtex-key-in-head)) alist) + (push (cons "=type=" (bibtex-type-in-head)) alist) + (push (cons "=key=" (bibtex-key-in-head)) alist) (goto-char (match-end 0)) (while (setq bounds (bibtex-parse-field bibtex-field-name)) (push (cons (bibtex-name-in-field bounds t) @@ -2809,8 +2933,8 @@ (undo-boundary) ;So you can easily undo it, if it didn't work right. (bibtex-beginning-of-entry) (when (looking-at bibtex-entry-head) - (let ((type (match-string bibtex-type-in-head)) - (key (match-string bibtex-key-in-head)) + (let ((type (bibtex-type-in-head)) + (key (bibtex-key-in-head)) (key-end (match-end bibtex-key-in-head)) (case-fold-search t) tmp other-key other bounds) @@ -2823,9 +2947,9 @@ (bibtex-beginning-of-entry) (when (and (looking-at bibtex-entry-head) - (bibtex-string= type (match-string bibtex-type-in-head)) + (bibtex-string= type (bibtex-type-in-head)) ;; In case we found ourselves :-( - (not (equal key (setq tmp (match-string bibtex-key-in-head))))) + (not (equal key (setq tmp (bibtex-key-in-head))))) (setq other-key tmp) (setq other (point)))) (save-excursion @@ -2833,9 +2957,9 @@ (bibtex-skip-to-valid-entry) (when (and (looking-at bibtex-entry-head) - (bibtex-string= type (match-string bibtex-type-in-head)) + (bibtex-string= type (bibtex-type-in-head)) ;; In case we found ourselves :-( - (not (equal key (setq tmp (match-string bibtex-key-in-head)))) + (not (equal key (setq tmp (bibtex-key-in-head)))) (or (not other-key) ;; Check which is the best match. (< (length (try-completion "" (list key other-key))) @@ -2883,24 +3007,26 @@ (message (nth 1 comment)) (message "No comment available"))))) -(defun bibtex-make-field (field &optional called-by-yank) +(defun bibtex-make-field (field &optional called-by-yank interactive) "Make a field named FIELD in current BibTeX entry. FIELD is either a string or a list of the form \(FIELD-NAME COMMENT-STRING INIT ALTERNATIVE-FLAG) as in `bibtex-entry-field-alist'. -If CALLED-BY-YANK is non-nil, don't insert delimiters." +If CALLED-BY-YANK is non-nil, don't insert delimiters. +In that case, or when called interactively, also don't do (WHAT?)." (interactive (list (let ((completion-ignore-case t) (field-list (bibtex-field-list - (save-excursion - (bibtex-enclosing-entry-maybe-empty-head) - (bibtex-type-in-head))))) + (save-excursion + (bibtex-enclosing-entry-maybe-empty-head) + (bibtex-type-in-head))))) (completing-read "BibTeX field name: " (append (car field-list) (cdr field-list)) - nil nil nil bibtex-field-history)))) + nil nil nil bibtex-field-history)) + t)) (unless (consp field) (setq field (list field))) - (if (or (interactive-p) called-by-yank) + (if (or interactive called-by-yank) (let (bibtex-help-message) (bibtex-find-text nil t t) (if (looking-at "[}\"]") @@ -2923,7 +3049,7 @@ ((fboundp init) (insert (funcall init))))) (unless called-by-yank (insert (bibtex-field-right-delimiter))) - (when (interactive-p) + (when interactive (forward-char -1) (bibtex-print-help-message))) @@ -3003,17 +3129,13 @@ (not count-string-entries))) (save-excursion (save-restriction - (narrow-to-region (if (bibtex-mark-active) - (region-beginning) + (narrow-to-region (if mark-active (region-beginning) (bibtex-beginning-of-first-entry)) - (if (bibtex-mark-active) - (region-end) - (point-max))) - (goto-char (point-min)) + (if mark-active (region-end) (point-max))) (bibtex-map-entries (lambda (key beg end) (setq number (1+ number)))))) (message "%s contains %d entries." - (if (bibtex-mark-active) "Region" "Buffer") + (if mark-active "Region" "Buffer") number))) (defun bibtex-ispell-entry () @@ -3110,12 +3232,39 @@ nil ; ENDKEY function 'bibtex-lessp))) ; PREDICATE -(defun bibtex-find-crossref (crossref-key) +(defun bibtex-find-entry-globally (key) + "Move point to the beginning of BibTeX entry named KEY in `bibtex-files'." + (interactive + (list (let (key-alist) + (dolist (buffer (bibtex-files-expand t)) + (with-current-buffer buffer + (setq key-alist (append bibtex-reference-keys key-alist)))) + (completing-read "Find key: " key-alist + nil nil nil 'bibtex-key-history)))) + (let ((buffer-list (bibtex-files-expand t)) + buffer found) + (while (and (not found) + (setq buffer (pop buffer-list))) + (with-current-buffer buffer + (if (cdr (assoc-string key bibtex-reference-keys)) + (setq found t)))) + (if found + (progn + (let ((same-window-buffer-names + (cons (buffer-name buffer) same-window-buffer-names))) + (pop-to-buffer buffer)) + (bibtex-find-entry key)) + (message "Key `%s' not found" key)))) + +(defun bibtex-find-crossref (crossref-key &optional pnt split) "Move point to the beginning of BibTeX entry CROSSREF-KEY. Return position of entry if CROSSREF-KEY is found and nil otherwise. If position of current entry is after CROSSREF-KEY an error is signaled. +Optional arg PNT is the position of the referencing entry. +If optional arg SPLIT is non-nil, split window so that both the referencing +and the crossrefed entry are displayed. If called interactively, CROSSREF-KEY defaults to crossref key of current -entry." +entry and SPLIT is t." (interactive (let ((crossref-key (save-excursion @@ -3123,11 +3272,23 @@ (let ((bounds (bibtex-search-forward-field "crossref" t))) (if bounds (bibtex-text-in-field-bounds bounds t)))))) - (list (bibtex-read-key "Find crossref key: " crossref-key)))) + (list (bibtex-read-key "Find crossref key: " crossref-key) (point) t))) (let ((pos (save-excursion (bibtex-find-entry crossref-key)))) - (if (and pos (> (point) pos)) - (error "This entry must not follow the crossrefed entry!")) - (goto-char pos))) + (unless pnt (setq pnt (point))) + (cond ((not pos) + (message "Crossref key `%s' not found" crossref-key)) + (split + (goto-char pnt) + (select-window (split-window)) + (goto-char pos) + (beginning-of-line) + (set-window-start (selected-window) (point)) + (if (> pnt pos) + (error "The referencing entry must preceed the crossrefed entry!"))) + ((> pnt pos) + (error "The referencing entry must preceed the crossrefed entry!")) + (t (goto-char pos))) + pos)) (defun bibtex-find-entry (key &optional start) "Move point to the beginning of BibTeX entry named KEY. @@ -3212,23 +3373,21 @@ (defun bibtex-validate (&optional test-thoroughly) "Validate if buffer or region is syntactically correct. -Only known entry types are checked, so you can put comments -outside of entries. -With optional argument TEST-THOROUGHLY non-nil it checks for absence of -required fields and questionable month fields as well. +Check also for duplicate keys and correct sort order provided +`bibtex-maintain-sorted-entries' is non-nil. +With optional argument TEST-THOROUGHLY non-nil check also for +the absence of required fields and for questionable month fields. If mark is active, validate current region, if not the whole buffer. -Returns t if test was successful, nil otherwise." +Only check known entry types, so you can put comments outside of entries. +Return t if test was successful, nil otherwise." (interactive "P") (let* ((case-fold-search t) error-list syntax-error) (save-excursion (save-restriction - (narrow-to-region (if (bibtex-mark-active) - (region-beginning) + (narrow-to-region (if mark-active (region-beginning) (bibtex-beginning-of-first-entry)) - (if (bibtex-mark-active) - (region-end) - (point-max))) + (if mark-active (region-end) (point-max))) ;; looking if entries fit syntactical structure (goto-char (point-min)) @@ -3244,41 +3403,54 @@ (if (equal (point) pnt) (forward-char) (goto-char pnt) - (push (list (bibtex-current-line) + (push (cons (bibtex-current-line) "Syntax error (check esp. commas, braces, and quotes)") error-list) (forward-char)))))) (bibtex-progress-message 'done) (if error-list + ;; proceed only if there were no syntax errors. (setq syntax-error t) - ;; looking for correct sort order and duplicates (only if - ;; there were no syntax errors) - (if bibtex-maintain-sorted-entries - (let (previous current) - (goto-char (point-min)) - (bibtex-progress-message "Checking correct sort order") - (bibtex-map-entries - (lambda (key beg end) - (bibtex-progress-message) - (goto-char beg) - (setq current (bibtex-entry-index)) - (cond ((or (not previous) - (bibtex-lessp previous current)) - (setq previous current)) - ((string-equal (car previous) (car current)) - (push (list (bibtex-current-line) - "Duplicate key with previous") - error-list)) - (t - (setq previous current) - (push (list (bibtex-current-line) - "Entries out of order") - error-list))))) - (bibtex-progress-message 'done))) + + ;; looking for duplicate keys and correct sort order + (let (previous current key-list) + (bibtex-progress-message "Checking for duplicate keys") + (bibtex-map-entries + (lambda (key beg end) + (bibtex-progress-message) + (goto-char beg) + (setq current (bibtex-entry-index)) + (cond ((not previous)) + ((member key key-list) + (push (cons (bibtex-current-line) + (format "Duplicate key `%s'" key)) + error-list)) + ((and bibtex-maintain-sorted-entries + (not (bibtex-lessp previous current))) + (push (cons (bibtex-current-line) + "Entries out of order") + error-list))) + (push key key-list) + (setq previous current))) + (bibtex-progress-message 'done)) + + ;; Check for duplicate keys in `bibtex-files'. + (bibtex-parse-keys) + (dolist (buffer (bibtex-files-expand)) + (dolist (key (with-current-buffer buffer + ;; We don't want to be fooled by outdated + ;; bibtex-reference-keys. + (bibtex-parse-keys) bibtex-reference-keys)) + (when (and (cdr key) + (cdr (assoc-string (car key) bibtex-reference-keys))) + (bibtex-find-entry (car key)) + (push (cons (bibtex-current-line) + (format "Duplicate key `%s' in %s" (car key) + (abbreviate-file-name (buffer-file-name buffer)))) + error-list)))) (when test-thoroughly - (goto-char (point-min)) (bibtex-progress-message "Checking required fields and month fields") (let ((bibtex-sort-ignore-string-entries t)) @@ -3292,73 +3464,135 @@ bibtex-entry-field-alist t))) (req (copy-sequence (elt (elt entry-list 1) 0))) (creq (copy-sequence (elt (elt entry-list 2) 0))) - crossref-there bounds) + crossref-there bounds alt-there field) (goto-char beg) (while (setq bounds (bibtex-search-forward-field bibtex-field-name end)) (goto-char (bibtex-start-of-text-in-field bounds)) (let ((field-name (bibtex-name-in-field bounds))) (if (and (bibtex-string= field-name "month") - (not (assoc-string (bibtex-text-in-field-bounds bounds) - bibtex-predefined-month-strings t))) - (push (list (bibtex-current-line) + ;; Check only abbreviated month fields. + (let ((month (bibtex-text-in-field-bounds bounds))) + (not (or (string-match "\\`[\"{].+[\"}]\\'" month) + (assoc-string + month + bibtex-predefined-month-strings t))))) + (push (cons (bibtex-current-line) "Questionable month field") error-list)) - (setq req (delete (assoc-string field-name req t) req) + (setq field (assoc-string field-name req t)) + (if (nth 3 field) + (if alt-there (push (cons (bibtex-current-line) + "More than one non-empty alternative") + error-list) + (setq alt-there t))) + (setq req (delete field req) creq (delete (assoc-string field-name creq t) creq)) (if (bibtex-string= field-name "crossref") (setq crossref-there t)))) (if crossref-there (setq req creq)) - (if (or (> (length req) 1) - (and (= (length req) 1) - (not (elt (car req) 3)))) - ;; two (or more) fields missed or one field - ;; missed and this isn't flagged alternative - ;; (notice that this fails if there are more - ;; than two alternatives in a BibTeX entry, - ;; which isn't the case momentarily) - (push (list (save-excursion - (bibtex-beginning-of-entry) - (bibtex-current-line)) - (concat "Required field `" (caar req) "' missing")) - error-list)))))) + (let (alt) + (dolist (field req) + (if (nth 3 field) + (push (car field) alt) + (push (cons (save-excursion (goto-char beg) + (bibtex-current-line)) + (format "Required field `%s' missing" + (car field))) + error-list))) + ;; The following fails if there are more than two + ;; alternatives in a BibTeX entry, which isn't + ;; the case momentarily. + (if (cdr alt) + (push (cons (save-excursion (goto-char beg) + (bibtex-current-line)) + (format "Alternative fields `%s'/`%s' missing" + (car alt) (cadr alt))) + error-list))))))) (bibtex-progress-message 'done))))) + (if error-list - (let ((bufnam (buffer-name)) - (dir default-directory)) - (setq error-list - (sort error-list - (lambda (a b) - (< (car a) (car b))))) - (let ((pop-up-windows t)) - (pop-to-buffer nil t)) - (switch-to-buffer - (get-buffer-create "*BibTeX validation errors*") t) - ;; don't use switch-to-buffer-other-window, since this - ;; doesn't allow the second parameter NORECORD - (setq default-directory dir) - (toggle-read-only -1) - (compilation-mode) - (delete-region (point-min) (point-max)) - (goto-char (point-min)) - (insert "BibTeX mode command `bibtex-validate'\n" - (if syntax-error - "Maybe undetected errors due to syntax errors. Correct and validate again." - "") - "\n") - (dolist (err error-list) - (insert bufnam ":" (number-to-string (elt err 0)) - ": " (elt err 1) "\n")) - (set-buffer-modified-p nil) - (toggle-read-only 1) - (goto-char (point-min)) - (other-window -1) + (let ((file (file-name-nondirectory (buffer-file-name))) + (dir default-directory) + (err-buf "*BibTeX validation errors*")) + (setq error-list (sort error-list 'car-less-than-car)) + (with-current-buffer (get-buffer-create err-buf) + (setq default-directory dir) + (unless (eq major-mode 'compilation-mode) (compilation-mode)) + (toggle-read-only -1) + (delete-region (point-min) (point-max)) + (insert "BibTeX mode command `bibtex-validate'\n" + (if syntax-error + "Maybe undetected errors due to syntax errors. Correct and validate again.\n" + "\n")) + (dolist (err error-list) + (insert (format "%s:%d: %s\n" file (car err) (cdr err)))) + (set-buffer-modified-p nil) + (toggle-read-only 1) + (goto-line 3)) ; first error message + (display-buffer err-buf) ;; return nil nil) - (if (bibtex-mark-active) - (message "Region is syntactically correct") - (message "Buffer is syntactically correct")) + (message "%s is syntactically correct" + (if mark-active "Region" "Buffer")) + t))) + +(defun bibtex-validate-globally (&optional strings) + "Check for duplicate keys in `bibtex-files'. +With prefix arg STRINGS, check for duplicate strings, too. +Return t if test was successful, nil otherwise." + (interactive "P") + (let ((buffer-list (bibtex-files-expand t)) + buffer-key-list current-buf current-keys error-list) + ;; Check for duplicate keys within BibTeX buffer + (dolist (buffer buffer-list) + (save-excursion + (set-buffer buffer) + (let (entry-type key key-list) + (goto-char (point-min)) + (while (re-search-forward bibtex-entry-head nil t) + (setq entry-type (bibtex-type-in-head) + key (bibtex-key-in-head)) + (if (or (and strings (bibtex-string= entry-type "string")) + (assoc-string entry-type bibtex-entry-field-alist t)) + (if (member key key-list) + (push (format "%s:%d: Duplicate key `%s'\n" + (buffer-file-name) + (bibtex-current-line) key) + error-list) + (push key key-list)))) + (push (cons buffer key-list) buffer-key-list)))) + + ;; Check for duplicate keys among BibTeX buffers + (while (setq current-buf (pop buffer-list)) + (setq current-keys (cdr (assq current-buf buffer-key-list))) + (with-current-buffer current-buf + (dolist (buffer buffer-list) + (dolist (key (cdr (assq buffer buffer-key-list))) + (when (assoc-string key current-keys) + (bibtex-find-entry key) + (push (format "%s:%d: Duplicat key `%s' in %s\n" + (buffer-file-name) (bibtex-current-line) key + (abbreviate-file-name (buffer-file-name buffer))) + error-list)))))) + + ;; Process error list + (if error-list + (let ((err-buf "*BibTeX validation errors*")) + (with-current-buffer (get-buffer-create err-buf) + (unless (eq major-mode 'compilation-mode) (compilation-mode)) + (toggle-read-only -1) + (delete-region (point-min) (point-max)) + (insert "BibTeX mode command `bibtex-validate-globally'\n\n") + (dolist (err (sort error-list 'string-lessp)) (insert err)) + (set-buffer-modified-p nil) + (toggle-read-only 1) + (goto-line 3)) ; first error message + (display-buffer err-buf) + ;; return nil + nil) + (message "No duplicate keys.") t))) (defun bibtex-next-field (arg) @@ -3378,10 +3612,9 @@ (defun bibtex-find-text (arg &optional as-if-interactive no-error) "Go to end of text of current field; with ARG, go to beginning." - (interactive "P") + (interactive "P\np") (bibtex-inside-field) - (let ((bounds (bibtex-enclosing-field (or (interactive-p) - as-if-interactive)))) + (let ((bounds (bibtex-enclosing-field as-if-interactive))) (if bounds (progn (if arg (progn (goto-char (bibtex-start-of-text-in-field bounds)) @@ -3404,7 +3637,7 @@ (match-end 0)))) (t (unless no-error - (error "Not on BibTeX field"))))))) + (error "Not on BibTeX field"))))))) (defun bibtex-remove-OPT-or-ALT () "Remove the string starting optional/alternative fields. @@ -3470,6 +3703,7 @@ (setq bibtex-last-kill-command 'field)) (defun bibtex-copy-field-as-kill () + "Copy the field at point to the kill ring." (interactive) (bibtex-kill-field t)) @@ -3492,9 +3726,9 @@ (setcdr (nthcdr (1- bibtex-entry-kill-ring-max) bibtex-entry-kill-ring) nil)) - (setq bibtex-entry-kill-ring-yank-pointer bibtex-entry-kill-ring) - (unless copy-only - (delete-region beg end)))) + (setq bibtex-entry-kill-ring-yank-pointer bibtex-entry-kill-ring) + (unless copy-only + (delete-region beg end)))) (setq bibtex-last-kill-command 'entry)) (defun bibtex-copy-entry-as-kill () @@ -3584,7 +3818,7 @@ ;; (bibtex-format-preamble) (error "No clean up of @Preamble entries")) ((bibtex-string= entry-type "string")) - ;; (bibtex-format-string) + ;; (bibtex-format-string) (t (bibtex-format-entry))) ;; set key (when (or new-key (not key)) @@ -3597,7 +3831,7 @@ (delete-region (match-beginning bibtex-key-in-head) (match-end bibtex-key-in-head))) (insert key)) - ;; sorting + (unless called-by-reformat (let* ((start (bibtex-beginning-of-entry)) (end (progn (bibtex-end-of-entry) @@ -3606,9 +3840,12 @@ (goto-char (match-beginning 0))) (point))) (entry (buffer-substring start end)) - (index (progn (goto-char start) - (bibtex-entry-index))) + ;; include the crossref key in index + (index (let ((bibtex-maintain-sorted-entries 'crossref)) + (goto-char start) + (bibtex-entry-index))) error) + ;; sorting (if (and bibtex-maintain-sorted-entries (not (and bibtex-sort-ignore-string-entries (bibtex-string= entry-type "string")))) @@ -3623,17 +3860,37 @@ (setq error (or (/= (point) start) (bibtex-find-entry key end)))) (if error - (error "New inserted entry yields duplicate key")))) - ;; final clean up - (unless called-by-reformat - (save-excursion - (save-restriction - (bibtex-narrow-to-entry) - ;; Only update the list of keys if it has been built already. - (cond ((bibtex-string= entry-type "string") - (if (listp bibtex-strings) (bibtex-parse-strings t))) - ((listp bibtex-reference-keys) (bibtex-parse-keys t))) - (run-hooks 'bibtex-clean-entry-hook)))))) + (error "New inserted entry yields duplicate key")) + (dolist (buffer (bibtex-files-expand)) + (with-current-buffer buffer + (if (cdr (assoc-string key bibtex-reference-keys)) + (error "Duplicate key in %s" (buffer-file-name))))) + + ;; Only update the list of keys if it has been built already. + (cond ((bibtex-string= entry-type "string") + (if (and (listp bibtex-strings) + (not (assoc key bibtex-strings))) + (push (list key) bibtex-strings))) + ;; We have a normal entry. + ((listp bibtex-reference-keys) + (cond ((not (assoc key bibtex-reference-keys)) + (push (cons key t) bibtex-reference-keys)) + ((not (cdr (assoc key bibtex-reference-keys))) + ;; Turn a crossref key into a header key + (setq bibtex-reference-keys + (cons (cons key t) + (delete (list key) bibtex-reference-keys))))) + ;; Handle crossref key. + (if (and (nth 1 index) + (not (assoc (nth 1 index) bibtex-reference-keys))) + (push (list (nth 1 index)) bibtex-reference-keys))))) + + ;; final clean up + (if bibtex-clean-entry-hook + (save-excursion + (save-restriction + (bibtex-narrow-to-entry) + (run-hooks 'bibtex-clean-entry-hook))))))) (defun bibtex-fill-field-bounds (bounds justify &optional move) "Fill BibTeX field delimited by BOUNDS. @@ -3705,13 +3962,24 @@ "Realign BibTeX entries such that they are separated by one blank line." (goto-char (point-min)) (let ((case-fold-search t)) + ;; No blank lines prior to the first valid entry if there no + ;; non-white characters in front of it. (when (looking-at bibtex-valid-entry-whitespace-re) (replace-match "\\1")) + ;; Valid entries are separated by one blank line. (while (re-search-forward bibtex-valid-entry-whitespace-re nil t) - (replace-match "\n\n\\1")))) + (replace-match "\n\n\\1")) + ;; One blank line past the last valid entry if it is followed by + ;; non-white characters, no blank line otherwise. + (beginning-of-line) + (when (re-search-forward bibtex-valid-entry-re nil t) + (bibtex-end-of-entry) + (bibtex-delete-whitespace) + (open-line (if (eobp) 1 2))))) (defun bibtex-reformat (&optional read-options) "Reformat all BibTeX entries in buffer or region. +Without prefix argument, reformatting is based on `bibtex-entry-format'. With prefix argument, read options for reformatting from minibuffer. With \\[universal-argument] \\[universal-argument] prefix argument, reuse previous answers (if any) again. If mark is active reformat entries in region, if not in whole buffer." @@ -3722,55 +3990,54 @@ (or bibtex-reformat-previous-options bibtex-reformat-previous-reference-keys))) (bibtex-entry-format - (if read-options - (if use-previous-options - bibtex-reformat-previous-options - (setq bibtex-reformat-previous-options - (mapcar (lambda (option) - (if (y-or-n-p (car option)) (cdr option))) - `(("Realign entries (recommended)? " . 'realign) - ("Remove empty optional and alternative fields? " . 'opts-or-alts) - ("Remove delimiters around pure numerical fields? " . 'numerical-fields) - (,(concat (if bibtex-comma-after-last-field "Insert" "Remove") - " comma at end of entry? ") . 'last-comma) - ("Replace double page dashes by single ones? " . 'page-dashes) - ("Force delimiters? " . 'delimiters) - ("Unify case of entry types and field names? " . 'unify-case))))) - '(realign))) + (cond (read-options + (if use-previous-options + bibtex-reformat-previous-options + (setq bibtex-reformat-previous-options + (mapcar (lambda (option) + (if (y-or-n-p (car option)) (cdr option))) + `(("Realign entries (recommended)? " . 'realign) + ("Remove empty optional and alternative fields? " . 'opts-or-alts) + ("Remove delimiters around pure numerical fields? " . 'numerical-fields) + (,(concat (if bibtex-comma-after-last-field "Insert" "Remove") + " comma at end of entry? ") . 'last-comma) + ("Replace double page dashes by single ones? " . 'page-dashes) + ("Inherit booktitle? " . 'inherit-booktitle) + ("Force delimiters? " . 'delimiters) + ("Unify case of entry types and field names? " . 'unify-case)))))) + ;; Do not include required-fields because `bibtex-reformat' + ;; cannot handle the error messages of `bibtex-format-entry'. + ;; Use `bibtex-validate' to check for required fields. + ((eq t bibtex-entry-format) + '(realign opts-or-alts numerical-fields delimiters + last-comma page-dashes unify-case inherit-booktitle)) + (t + (remove 'required-fields (push 'realign bibtex-entry-format))))) (reformat-reference-keys (if read-options (if use-previous-options bibtex-reformat-previous-reference-keys (setq bibtex-reformat-previous-reference-keys (y-or-n-p "Generate new reference keys automatically? "))))) - (start-point (if (bibtex-mark-active) - (region-beginning) - (point-min))) - (end-point (if (bibtex-mark-active) - (region-end) - (point-max))) (bibtex-sort-ignore-string-entries t) bibtex-autokey-edit-before-use) (save-restriction - (narrow-to-region start-point end-point) + (narrow-to-region (if mark-active (region-beginning) (point-min)) + (if mark-active (region-end) (point-max))) (if (memq 'realign bibtex-entry-format) - (bibtex-realign)) - (goto-char start-point) + (bibtex-realign)) (bibtex-progress-message "Formatting" 1) (bibtex-map-entries (lambda (key beg end) (bibtex-progress-message) (bibtex-clean-entry reformat-reference-keys t))) - (when (memq 'realign bibtex-entry-format) - (bibtex-delete-whitespace) - (open-line (if (eobp) 1 2))) (bibtex-progress-message 'done)) - (when (and reformat-reference-keys - bibtex-maintain-sorted-entries) - (bibtex-progress-message "Sorting" 1) - (bibtex-sort-buffer) + (when reformat-reference-keys (kill-local-variable 'bibtex-reference-keys) - (bibtex-progress-message 'done)) + (when bibtex-maintain-sorted-entries + (bibtex-progress-message "Sorting" 1) + (bibtex-sort-buffer) + (bibtex-progress-message 'done))) (goto-char pnt))) (defun bibtex-convert-alien (&optional read-options) @@ -3837,21 +4104,23 @@ ;; key completion (setq choose-completion-string-functions (lambda (choice buffer mini-p base-size) - (bibtex-choose-completion-string choice buffer mini-p base-size) + (let ((choose-completion-string-functions nil)) + (choose-completion-string choice buffer base-size)) (bibtex-complete-key-cleanup choice) ;; return t (required by choose-completion-string-functions) t)) - (bibtex-complete-key-cleanup (bibtex-complete-internal + (bibtex-complete-key-cleanup (bibtex-complete-internal bibtex-reference-keys))) (compl ;; string completion (setq choose-completion-string-functions `(lambda (choice buffer mini-p base-size) - (bibtex-choose-completion-string choice buffer mini-p base-size) - (bibtex-complete-string-cleanup choice ',compl) - ;; return t (required by choose-completion-string-functions) - t)) + (let ((choose-completion-string-functions nil)) + (choose-completion-string choice buffer base-size)) + (bibtex-complete-string-cleanup choice ',compl) + ;; return t (required by choose-completion-string-functions) + t)) (bibtex-complete-string-cleanup (bibtex-complete-internal compl) compl)) @@ -3960,80 +4229,56 @@ "\n") (goto-char endpos))) -(defun bibtex-url (&optional event) - "Browse a URL for the BibTeX entry at position PNT. +(defun bibtex-url (&optional pos) + "Browse a URL for the BibTeX entry at point. +Optional POS is the location of the BibTeX entry. The URL is generated using the schemes defined in `bibtex-generate-url-list' \(see there\). Then the URL is passed to `browse-url'." - (interactive (list last-input-event)) + (interactive) (save-excursion - (if event (posn-set-point (event-end event))) + (if pos (goto-char pos)) (bibtex-beginning-of-entry) (let ((fields-alist (bibtex-parse-entry)) + ;; Always ignore case, (case-fold-search t) (lst bibtex-generate-url-list) + (delim-regexp "\\`[{\"]\\(.*\\)[}\"]\\'") field url scheme) - (while (setq scheme (car lst)) + (while (setq scheme (pop lst)) (when (and (setq field (cdr (assoc-string (caar scheme) fields-alist t))) - (progn - (if (string-match "\\`[{\"]\\(.*\\)[}\"]\\'" field) - (setq field (match-string 1 field))) - (string-match (cdar scheme) field))) - (setq lst nil) + ;; Always remove field delimiters + (progn (if (string-match delim-regexp field) + (setq field (match-string 1 field))) + (string-match (cdar scheme) field))) + (setq lst nil) (if (null (cdr scheme)) (setq url (match-string 0 field))) (dolist (step (cdr scheme)) - (cond ((stringp step) - (setq url (concat url step))) - ((setq field (assoc-string (car step) fields-alist t)) - ;; always remove field delimiters - (let* ((text (if (string-match "\\`[{\"]\\(.*\\)[}\"]\\'" - (cdr field)) - (match-string 1 (cdr field)) - (cdr field))) - (str (if (string-match (nth 1 step) text) - (cond - ((functionp (nth 2 step)) - (funcall (nth 2 step) text)) - ((numberp (nth 2 step)) - (match-string (nth 2 step) text)) - (t - (replace-match (nth 2 step) nil nil text))) - ;; If the scheme is set up correctly, - ;; we should never reach this point - (error "Match failed: %s" text)))) - (setq url (concat url str)))) - ;; If the scheme is set up correctly, - ;; we should never reach this point - (t (error "Step failed: %s" step)))) - (message "%s" url) - (browse-url url)) - (setq lst (cdr lst))) - (unless url (message "No URL known."))))) - -(defun bibtex-font-lock-url (bound) - "Font-lock for URLs." - (let ((case-fold-search t) - (bounds (bibtex-enclosing-field t)) - (pnt (point)) - found field) - ;; We use start-of-field as syntax-begin - (goto-char (if bounds (bibtex-start-of-field bounds) pnt)) - (while (and (not found) - (prog1 (re-search-forward bibtex-font-lock-url-regexp bound t) - (setq field (match-string-no-properties 1))) - (setq bounds (bibtex-parse-field-text)) - (>= bound (car bounds)) - (>= (car bounds) pnt)) - (let ((lst bibtex-generate-url-list) url) - (goto-char (car bounds)) - (while (and (not found) - (setq url (caar lst))) - (when (bibtex-string= field (car url)) - (setq found (re-search-forward (cdr url) (cdr bounds) t))) - (setq lst (cdr lst)))) - (goto-char (cdr bounds))) - found)) + (cond ((stringp step) + (setq url (concat url step))) + ((setq field (cdr (assoc-string (car step) fields-alist t))) + ;; Always remove field delimiters + (if (string-match delim-regexp field) + (setq field (match-string 1 field))) + (if (string-match (nth 1 step) field) + (setq field (cond + ((functionp (nth 2 step)) + (funcall (nth 2 step) field)) + ((numberp (nth 2 step)) + (match-string (nth 2 step) field)) + (t + (replace-match (nth 2 step) nil nil field)))) + ;; If the scheme is set up correctly, + ;; we should never reach this point + (error "Match failed: %s" field)) + (setq url (concat url field))) + ;; If the scheme is set up correctly, + ;; we should never reach this point + (t (error "Step failed: %s" step)))) + (message "%s" url) + (browse-url url))) + (unless url (message "No URL known."))))) ;; Make BibTeX a Feature
--- a/lisp/textmodes/texinfo.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/textmodes/texinfo.el Thu Nov 04 08:55:40 2004 +0000 @@ -1,7 +1,7 @@ ;;; texinfo.el --- major mode for editing Texinfo files -;; Copyright (C) 1985,88,89,90,91,92,93,96,97,2000,01,03,04 -;; Free Software Foundation, Inc. +;; Copyright (C) 1985, 1988, 1989, 1990, 1991, 1992, 1993, 1996, 1997, +;; 2000, 2001, 2003, 2004 Free Software Foundation, Inc. ;; Author: Robert J. Chassell ;; Date: [See date below for texinfo-version]
--- a/lisp/thumbs.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/thumbs.el Thu Nov 04 08:55:40 2004 +0000 @@ -30,8 +30,8 @@ ;;; Commentary: ;; This package create two new mode: thumbs-mode and -;; thumbs-view-image-mode. It is used for images browsing and viewing -;; from within emacs. Minimal image manipulation functions are also +;; thumbs-view-image-mode. It is used for images browsing and viewing +;; from within Emacs. Minimal image manipulation functions are also ;; available via external programs. ;; ;; The 'convert' program from 'ImageMagick' @@ -62,6 +62,7 @@ (defgroup thumbs nil "Thumbnails previewer." + :version "21.4" :group 'multimedia) (defcustom thumbs-thumbsdir @@ -416,7 +417,7 @@ (defalias 'thumbs 'thumbs-show-all-from-dir) (defun thumbs-find-image (img &optional num otherwin) - (funcall + (funcall (if otherwin 'switch-to-buffer-other-window 'switch-to-buffer) (concat "*Image: " (file-name-nondirectory img) " - " (number-to-string (or num 0)) "*"))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/toolbar/diropen.xpm Thu Nov 04 08:55:40 2004 +0000 @@ -0,0 +1,215 @@ +/* XPM */ +static char * diropen_xpm[] = { +"24 24 188 2", +" c None", +". c #000000", +"+ c #010100", +"@ c #B5B8A5", +"# c #E4E7D2", +"$ c #878A76", +"% c #33342B", +"& c #0B0B0B", +"* c #E2E5CF", +"= c #CFD4AF", +"- c #CED3AE", +"; c #B2B696", +"> c #2D2D25", +", c #23241D", +"' c #9D9F90", +") c #C6CAA6", +"! c #C4C9A5", +"~ c #C6CBA7", +"{ c #C7CCA8", +"] c #C9CEA9", +"^ c #555847", +"/ c #1A1B15", +"( c #20201A", +"_ c #D4D6C2", +": c #BEC2A0", +"< c #B3B896", +"[ c #B0B595", +"} c #B3B797", +"| c #B6BB99", +"1 c #BBC09E", +"2 c #BCC19F", +"3 c #81856C", +"4 c #3E3F32", +"5 c #010101", +"6 c #DADDC8", +"7 c #AFB494", +"8 c #AAAF8F", +"9 c #A3A789", +"0 c #A6AA8B", +"a c #A9AD8E", +"b c #A7AB8D", +"c c #A4A88A", +"d c #A1A588", +"e c #AAAD96", +"f c #B3B5A5", +"g c #B8BBAA", +"h c #BABCAB", +"i c #40413B", +"j c #CACDBB", +"k c #BABDA8", +"l c #0C0C09", +"m c #DDDFCB", +"n c #969B7E", +"o c #9DA286", +"p c #95987C", +"q c #96997E", +"r c #9A9D81", +"s c #999D80", +"t c #9DA184", +"u c #A5AA8B", +"v c #A4A98A", +"w c #A3A889", +"x c #A2A588", +"y c #33352B", +"z c #9B9E83", +"A c #898D74", +"B c #D8DBC9", +"C c #84866E", +"D c #7D8169", +"E c #151612", +"F c #D7DAC9", +"G c #797D67", +"H c #3D3F34", +"I c #E0E0D9", +"J c #EBEDDD", +"K c #E8EBD9", +"L c #D8DBCA", +"M c #1A1A18", +"N c #0A0A09", +"O c #6E7067", +"P c #8D8F84", +"Q c #4A4B45", +"R c #2C2D29", +"S c #4B4C46", +"T c #E7EAD8", +"U c #E3E6D4", +"V c #DEE1D0", +"W c #DADCCC", +"X c #DADCD1", +"Y c #2B2C28", +"Z c #D7DAC6", +"` c #6F735E", +" . c #0D0D0D", +".. c #F4F4EC", +"+. c #606251", +"@. c #92957B", +"#. c #4A4C3E", +"$. c #434438", +"%. c #CACFAB", +"&. c #C6CBA8", +"*. c #C2C6A4", +"=. c #ABB091", +"-. c #23251E", +";. c #494B3D", +">. c #DCDCD4", +",. c #EAECDD", +"'. c #CDD2AD", +"). c #20201B", +"!. c #1C1C17", +"~. c #A4A88B", +"{. c #414337", +"]. c #BABF9D", +"^. c #B5B999", +"/. c #81836C", +"(. c #070806", +"_. c #D5D8C4", +":. c #161616", +"<. c #F2F2EA", +"[. c #CACFAA", +"}. c #050504", +"|. c #3C3D32", +"1. c #C9CEAA", +"2. c #C8CDA9", +"3. c #BFC4A2", +"4. c #3E4035", +"5. c #BCC09F", +"6. c #B6BB9A", +"7. c #B0B494", +"8. c #9DA185", +"9. c #535445", +"0. c #B6B8A7", +"a. c #747470", +"b. c #ECECE2", +"c. c #C3C8A5", +"d. c #C2C7A4", +"e. c #393B30", +"f. c #BFC4A1", +"g. c #BDC2A0", +"h. c #C0C5A2", +"i. c #3A3B31", +"j. c #A9AD8F", +"k. c #A3A78A", +"l. c #80836D", +"m. c #020201", +"n. c #A6A998", +"o. c #B8BC9B", +"p. c #1B1C17", +"q. c #181814", +"r. c #AFB394", +"s. c #ACB091", +"t. c #878A72", +"u. c #9B9F83", +"v. c #9A9D82", +"w. c #8A8D75", +"x. c #4F5243", +"y. c #070705", +"z. c #9E9F91", +"A. c #E5E6DA", +"B. c #ADB192", +"C. c #A6AA8C", +"D. c #A5A98C", +"E. c #4B4D3F", +"F. c #70735F", +"G. c #9FA286", +"H. c #999D81", +"I. c #35362D", +"J. c #2D2E26", +"K. c #8A8D74", +"L. c #71735F", +"M. c #080908", +"N. c #E3E5D9", +"O. c #C0C3AF", +"P. c #94987C", +"Q. c #8F9379", +"R. c #8B8F75", +"S. c #8A8E74", +"T. c #888C73", +"U. c #7D816A", +"V. c #0E0F0C", +"W. c #3E4034", +"X. c #4E5042", +"Y. c #282922", +"Z. c #121310", +"`. c #24251F", +" + c #71745F", +".+ c #6A6D59", +"++ c #434538", +"@+ c #080907", +" ", +" ", +" ", +" . . . . . . . ", +" + @ # # # # # $ % ", +" & * = = = - - ; > ", +", ' * ) ! ~ { ] ] ^ / . . ", +"( _ : < [ } | 1 2 3 4 5 . . . . . . . ", +", 6 7 8 9 0 8 a b c d e f g h . i j k . ", +"l m n o p q r s q t u v w x 9 . y z A . ", +". B C D E . . . . . . . . . . . . . . . 5 5 ", +". F G H I J K K L M N O P Q R . S T U V W X Y ", +". Z ` ...= = = +.. @.= = = #.. $.%.&.*.1 =.-. ", +". Z ;.>.,.'.- - ).!.'.'.'.'.~.. {.&.*.].^./.(. ", +". _.:.<.%.[.%.[.}.|.1.{ 2.2.3.. 4.5.6.7.8.9.l ", +". 0.a.b.c.d.d.*.}.e.f.g.h.g.} . i.[ j.k.l.m. ", +". n.>.o.o.^.} } p.q.r.r.r.s.t.. % u.v.w.x.y. ", +". z.A.B.j.C.D.k.E.. F.G.u.H.I.. J.K.K.L.M. ", +". N.O.P.Q.R.S.T.U.V.}.W.X.Y.Z.. `. +.+++@+ ", +" . . . . . . . . . . . . . . . . . . }. ", +" ", +" ", +" ", +" "};
--- a/lisp/toolbar/tool-bar.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/toolbar/tool-bar.el Thu Nov 04 08:55:40 2004 +0000 @@ -223,7 +223,8 @@ ;; might inadvertently click that button. ;;(tool-bar-add-item-from-menu 'save-buffers-kill-emacs "exit") (tool-bar-add-item-from-menu 'find-file "new") - (tool-bar-add-item-from-menu 'dired "open") + (tool-bar-add-item-from-menu 'find-file-existing "open") + (tool-bar-add-item-from-menu 'dired "diropen") (tool-bar-add-item-from-menu 'kill-this-buffer "close") (tool-bar-add-item-from-menu 'save-buffer "save" nil :visible '(or buffer-file-name
--- a/lisp/type-break.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/type-break.el Thu Nov 04 08:55:40 2004 +0000 @@ -1005,8 +1005,8 @@ (setcar type-break-keystroke-threshold lower) (setcdr type-break-keystroke-threshold upper) (if (interactive-p) - (message "min threshold: %d\tmax threshold: %d" lower upper) - type-break-keystroke-threshold))) + (message "min threshold: %d\tmax threshold: %d" lower upper)) + type-break-keystroke-threshold)) ;;; misc functions @@ -1103,37 +1103,12 @@ (defun type-break-run-at-time (time repeat function) (condition-case nil (or (require 'timer) (require 'itimer)) (error nil)) - (cond ((fboundp 'run-at-time) - (run-at-time time repeat function)) - ((fboundp 'start-timer) - (let ((name (if (symbolp function) - (symbol-name function) - "type-break"))) - (start-timer name function time repeat))) - ((fboundp 'start-itimer) - (let ((name (if (symbolp function) - (symbol-name function) - "type-break"))) - (start-itimer name function time repeat))))) + (run-at-time time repeat function)) (defvar timer-dont-exit) (defun type-break-cancel-function-timers (function) - (cond ((fboundp 'cancel-function-timers) - (let ((timer-dont-exit t)) - (cancel-function-timers function))) - ((fboundp 'delete-timer) - (let ((list timer-list)) - (while list - (and (eq (funcall 'timer-function (car list)) function) - (delete-timer (car list))) - (setq list (cdr list))))) - ((fboundp 'delete-itimer) - (with-no-warnings - (let ((list itimer-list)) - (while list - (and (eq (funcall 'itimer-function (car list)) function) - (delete-itimer (car list))) - (setq list (cdr list)))))))) + (let ((timer-dont-exit t)) + (cancel-function-timers function))) ;;; Demo wrappers
--- a/lisp/url/ChangeLog Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/url/ChangeLog Thu Nov 04 08:55:40 2004 +0000 @@ -1,3 +1,15 @@ +2004-11-02 Masatake YAMATO <jet@gyve.org> + + * url-imap.el (url-imap-open-host): Don't use + `string-to-int'. The port returned by `url-port' + is expected to be an integer. + + * url-irc.el (url-irc): Ditto. + + * url-news.el (url-news-open-host): Ditto. + + * url-nfs.el (url-nfs-build-filename): Ditto. + 2004-10-20 John Paul Wallington <jpw@gnu.org> * url-gw.el (url-gateway-nslookup-host):
--- a/lisp/url/url-imap.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/url/url-imap.el Thu Nov 04 08:55:40 2004 +0000 @@ -47,8 +47,6 @@ (let ((imap-username user) (imap-password pass) (authenticator (if user 'login 'anonymous))) - (if (stringp port) - (setq port (string-to-int port))) (nnimap-open-server host `((nnimap-server-port ,port) (nnimap-stream 'network)
--- a/lisp/url/url-irc.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/url/url-irc.el Thu Nov 04 08:55:40 2004 +0000 @@ -61,7 +61,7 @@ ;;;###autoload (defun url-irc (url) (let* ((host (url-host url)) - (port (string-to-int (url-port url))) + (port (url-port url)) (pass (url-password url)) (user (url-user url)) (chan (url-filename url)))
--- a/lisp/url/url-news.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/url/url-news.el Thu Nov 04 08:55:40 2004 +0000 @@ -38,7 +38,7 @@ (defun url-news-open-host (host port user pass) (if (fboundp 'nnheader-init-server-buffer) (nnheader-init-server-buffer)) - (nntp-open-server host (list (string-to-int port))) + (nntp-open-server host (list port)) (if (and user pass) (progn (nntp-send-command "^.*\r?\n" "AUTHINFO USER" user)
--- a/lisp/url/url-nfs.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/url/url-nfs.el Thu Nov 04 08:55:40 2004 +0000 @@ -62,7 +62,7 @@ (defun url-nfs-build-filename (url) (let* ((host (url-host url)) - (port (string-to-int (url-port url))) + (port (url-port url)) (pass (url-password url)) (user (url-user url)) (file (url-filename url)))
--- a/lisp/vc-cvs.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/vc-cvs.el Thu Nov 04 08:55:40 2004 +0000 @@ -5,7 +5,7 @@ ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Andre Spiegel <spiegel@gnu.org> -;; $Id: vc-cvs.el,v 1.67 2004/01/20 17:41:18 uid65624 Exp $ +;; $Id$ ;; This file is part of GNU Emacs. @@ -89,12 +89,12 @@ The value can also be a regular expression or list of regular expressions to match against the host name of a repository; then VC only stays local for hosts that match it. Alternatively, the value -can be a list of regular expressions where the first element is the -symbol `except'; then VC always stays local except for hosts matched +can be a list of regular expressions where the first element is the +symbol `except'; then VC always stays local except for hosts matched by these regular expressions." :type '(choice (const :tag "Always stay local" t) (const :tag "Don't stay local" nil) - (list :format "\nExamine hostname and %v" :tag "Examine hostname ..." + (list :format "\nExamine hostname and %v" :tag "Examine hostname ..." (set :format "%v" :inline t (const :format "%t" :tag "don't" except)) (regexp :format " stay local,\n%t: %v" :tag "if it matches") (repeat :format "%v%i\n" :inline t (regexp :tag "or")))) @@ -152,12 +152,6 @@ ;;; Internal variables ;;; -(defvar vc-cvs-local-month-numbers - '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) ("Apr" . 4) - ("May" . 5) ("Jun" . 6) ("Jul" . 7) ("Aug" . 8) - ("Sep" . 9) ("Oct" . 10) ("Nov" . 11) ("Dec" . 12)) - "Local association list of month numbers.") - ;;; ;;; State-querying functions @@ -590,7 +584,11 @@ (defun vc-cvs-annotate-command (file buffer &optional version) "Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER. Optional arg VERSION is a version to annotate from." - (vc-cvs-command buffer 0 file "annotate" (if version (concat "-r" version)))) + (vc-cvs-command buffer 0 file "annotate" (if version (concat "-r" version))) + (with-current-buffer buffer + (goto-char (point-min)) + (re-search-forward "^[0-9]") + (delete-region (point-min) (1- (point))))) (defun vc-cvs-annotate-current-time () "Return the current time, based at midnight of the current day, and @@ -601,29 +599,36 @@ (defun vc-cvs-annotate-time () "Return the time of the next annotation (as fraction of days) systime, or nil if there is none." - (let ((time-stamp - "^\\S-+\\s-+\\S-+\\s-+\\([0-9]+\\)-\\(\\sw+\\)-\\([0-9]+\\)): ")) - (if (looking-at time-stamp) - (progn - (let* ((day (string-to-number (match-string 1))) - (month (cdr (assoc (match-string 2) - vc-cvs-local-month-numbers))) - (year-tmp (string-to-number (match-string 3))) - ;; Years 0..68 are 2000..2068. - ;; Years 69..99 are 1969..1999. - (year (+ (cond ((> 69 year-tmp) 2000) - ((> 100 year-tmp) 1900) - (t 0)) - year-tmp))) - (goto-char (match-end 0)) ; Position at end makes for nicer overlay result - (vc-annotate-convert-time (encode-time 0 0 0 day month year)))) - ;; If we did not look directly at an annotation, there might be - ;; some further down. This is the case if we are positioned at - ;; the very top of the buffer, for instance. - (if (re-search-forward time-stamp nil t) - (progn - (beginning-of-line nil) - (vc-cvs-annotate-time)))))) + (let* ((bol (point)) + (cache (get-text-property bol 'vc-cvs-annotate-time)) + buffer-read-only) + (cond + (cache) + ((looking-at + "^\\S-+\\s-+\\S-+\\s-+\\([0-9]+\\)-\\(\\sw+\\)-\\([0-9]+\\)): ") + (let ((day (string-to-number (match-string 1))) + (month (cdr (assq (intern (match-string 2)) + '((Jan . 1) (Feb . 2) (Mar . 3) + (Apr . 4) (May . 5) (Jun . 6) + (Jul . 7) (Aug . 8) (Sep . 9) + (Oct . 10) (Nov . 11) (Dec . 12))))) + (year (let ((tmp (string-to-number (match-string 3)))) + ;; Years 0..68 are 2000..2068. + ;; Years 69..99 are 1969..1999. + (+ (cond ((> 69 tmp) 2000) + ((> 100 tmp) 1900) + (t 0)) + tmp)))) + (put-text-property + bol (1+ bol) 'vc-cvs-annotate-time + (setq cache (cons + ;; Position at end makes for nicer overlay result. + (match-end 0) + (vc-annotate-convert-time + (encode-time 0 0 0 day month year)))))))) + (when cache + (goto-char (car cache)) ; fontify from here to eol + (cdr cache)))) ; days (float) (defun vc-cvs-annotate-extract-revision-at-line () (save-excursion @@ -839,7 +844,7 @@ (let ((coding-system-for-read (or file-name-coding-system default-file-name-coding-system))) (vc-insert-file (expand-file-name "CVS/Entries" dir)))) - + (defun vc-cvs-valid-symbolic-tag-name-p (tag) "Return non-nil if TAG is a valid symbolic tag name." ;; According to the CVS manual, a valid symbolic tag must start with @@ -929,7 +934,7 @@ "\\(.*\\)")) ;Sticky tag (vc-file-setprop file 'vc-workfile-version (match-string 1)) (vc-file-setprop file 'vc-cvs-sticky-tag - (vc-cvs-parse-sticky-tag (match-string 4) + (vc-cvs-parse-sticky-tag (match-string 4) (match-string 5))) ;; Compare checkout time and modification time. ;; This is intentionally different from the algorithm that CVS uses
--- a/lisp/vc-mcvs.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/vc-mcvs.el Thu Nov 04 08:55:40 2004 +0000 @@ -26,9 +26,9 @@ ;;; Commentary: ;; The home page of the Meta-CVS version control system is at -;; +;; ;; http://users.footprints.net/~kaz/mcvs.html -;; +;; ;; This is derived from vc-cvs.el as follows: ;; - cp vc-cvs.el vc-mcvs.el ;; - Replace CVS/ with MCVS/CVS/ @@ -478,7 +478,11 @@ (vc-mcvs-command buffer (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0) - file "annotate" (if version (concat "-r" version)))) + file "annotate" (if version (concat "-r" version))) + (with-current-buffer buffer + (goto-char (point-min)) + (re-search-forward "^[0-9]") + (delete-region (point-min) (1- (point))))) (defalias 'vc-mcvs-annotate-current-time 'vc-cvs-annotate-current-time) (defalias 'vc-mcvs-annotate-time 'vc-cvs-annotate-time)
--- a/lisp/vc.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/vc.el Thu Nov 04 08:55:40 2004 +0000 @@ -2896,9 +2896,9 @@ (defun vc-annotate-display-autoscale (&optional full) "Highlight the output of \\[vc-annotate] using an autoscaled color map. Autoscaling means that the map is scaled from the current time to the -oldest annotation in the buffer, or, with argument FULL non-nil, to +oldest annotation in the buffer, or, with prefix argument FULL, to cover the range from the oldest annotation to the newest." - (interactive) + (interactive "P") (let ((newest 0.0) (oldest 999999.) ;Any CVS users at the founding of Rome? (current (vc-annotate-convert-time (current-time))) @@ -2907,7 +2907,9 @@ ;; Run through this file and find the oldest and newest dates annotated. (save-excursion (goto-char (point-min)) - (while (setq date (vc-call-backend vc-annotate-backend 'annotate-time)) + (while (setq date (prog1 (vc-call-backend vc-annotate-backend + 'annotate-time) + (forward-line 1))) (if (> date newest) (setq newest date)) (if (< date oldest)
--- a/lisp/x-dnd.el Fri Oct 29 00:25:02 2004 +0000 +++ b/lisp/x-dnd.el Thu Nov 04 08:55:40 2004 +0000 @@ -47,6 +47,7 @@ the wanted action as car and the wanted type as cdr. The wanted action can be copy, move, link, ask or private. The default value for this variable is `x-dnd-default-test-function'." + :version "21.4" :type 'symbol :group 'x) @@ -69,6 +70,7 @@ for that. The function shall return the action done (move, copy, link or private) if some action was made, or nil if the URL is ignored." + :version "21.4" :type 'alist :group 'x) @@ -96,11 +98,13 @@ call to `x-dnd-test-function'. DATA is the drop data. The function shall return the action used (copy, move, link or private) if drop is successful, nil if not." + :version "21.4" :type 'alist :group 'x) (defcustom x-dnd-open-file-other-window nil "If non-nil, always use find-file-other-window to open dropped files." + :version "21.4" :type 'boolean :group 'x) @@ -120,6 +124,7 @@ ) "The types accepted by default for dropped data. The types are chosen in the order they appear in the list." + :version "21.4" :type '(repeat string) :group 'x )
--- a/lispref/ChangeLog Fri Oct 29 00:25:02 2004 +0000 +++ b/lispref/ChangeLog Thu Nov 04 08:55:40 2004 +0000 @@ -1,3 +1,28 @@ +2004-11-01 Richard M. Stallman <rms@gnu.org> + + * commands.texi (Interactive Call): Add called-interactively-p. + +2004-10-29 Simon Josefsson <jas@extundo.com> + + * minibuf.texi (Reading a Password): Revert. + +2004-10-28 Richard M. Stallman <rms@gnu.org> + + * frames.texi (Display Feature Testing): Explain about "vendor". + +2004-10-27 Richard M. Stallman <rms@gnu.org> + + * commands.texi (Interactive Codes): `N' uses numeric prefix, + not raw. Clarify `n'. + (Interactive Call): Rewrite interactive-p, focusing on when + and how to use it. + (Misc Events): Clarify previous change. + + * advice.texi (Simple Advice): Clarify what job the example does. + (Around-Advice): Clarify ad-do-it. + (Activation of Advice): An option of ad-default-compilation-action + is `never', not `nil'. + 2004-10-26 Kim F. Storm <storm@cua.dk> * commands.texi (Interactive Codes): Add U code letter.
--- a/lispref/advice.texi Fri Oct 29 00:25:02 2004 +0000 +++ b/lispref/advice.texi Thu Nov 04 08:55:40 2004 +0000 @@ -51,7 +51,8 @@ Suppose you wanted to add a similar feature to @code{previous-line}, which would insert a new line at the beginning of the buffer for the -command to move to. How could you do this? +command to move to (when @code{next-line-add-newlines} is +non-@code{nil}). How could you do this? You could do it by redefining the whole function, but that is not modular. The advice feature provides a cleaner alternative: you can @@ -273,9 +274,9 @@ searches when the original definition of @code{foo} is run. @defvar ad-do-it -This is not really a variable, but it is somewhat used like one -in around-advice. It specifies the place to run the function's -original definition and other ``earlier'' around-advice. +This is not really a variable, rather a place-holder that looks like a +variable. You use it in around-advice to specify the place to run the +function's original definition and other ``earlier'' around-advice. @end defvar If the around-advice does not use @code{ad-do-it}, then it does not run @@ -360,10 +361,9 @@ This command activates all the advice defined for @var{function}. @end deffn -To activate advice for a function whose advice is already active is not -a no-op. It is a useful operation which puts into effect any changes in -that function's advice since the previous activation of advice for that -function. + Activating advice does nothing if @var{function}'s advice is already +active. But if there is new advice, added since the previous time you +activated advice for @var{function}, it activates the new advice. @deffn Command ad-deactivate function This command deactivates the advice for @var{function}. @@ -430,7 +430,7 @@ that results from activating advice for a function. A value of @code{always} specifies to compile unconditionally. -A value of @code{nil} specifies never compile the advice. +A value of @code{never} specifies never compile the advice. A value of @code{maybe} specifies to compile if the byte-compiler is already loaded. A value of @code{like-original} specifies to compile
--- a/lispref/commands.texi Fri Oct 29 00:25:02 2004 +0000 +++ b/lispref/commands.texi Thu Nov 04 08:55:40 2004 +0000 @@ -382,15 +382,14 @@ Emacs Manual}). Prompt. @item n -A number read with the minibuffer. If the input is not a number, the -user is asked to try again. The prefix argument, if any, is not used. +A number, read with the minibuffer. If the input is not a number, the +user has to try again. @samp{n} never uses the prefix argument. Prompt. @item N -@cindex raw prefix argument usage -The numeric prefix argument; but if there is no prefix argument, read a -number as with @kbd{n}. Requires a number. @xref{Prefix Command -Arguments}. Prompt. +The numeric prefix argument; but if there is no prefix argument, read +a number as with @kbd{n}. The value is always a number. @xref{Prefix +Command Arguments}. Prompt. @item p @cindex numeric prefix argument usage @@ -398,6 +397,7 @@ No I/O. @item P +@cindex raw prefix argument usage The raw prefix argument. (Note that this @samp{P} is upper case.) No I/O. @@ -613,25 +613,23 @@ @end deffn @defun interactive-p -This function returns @code{t} if the containing function (the one whose -code includes the call to @code{interactive-p}) was called -interactively, with the function @code{call-interactively}. (It makes -no difference whether @code{call-interactively} was called from Lisp or -directly from the editor command loop.) If the containing function was -called by Lisp evaluation (or with @code{apply} or @code{funcall}), then -it was not called interactively. +This function returns @code{t} if the containing function (the one +whose code includes the call to @code{interactive-p}) was called in +direct response to user input. This means that it was called with the +function @code{call-interactively}, and that a keyboard macro is +not running, and that Emacs is not running in batch mode. + +If the containing function was called by Lisp evaluation (or with +@code{apply} or @code{funcall}), then it was not called interactively. @end defun - The most common use of @code{interactive-p} is for deciding whether to -print an informative message. As a special exception, -@code{interactive-p} returns @code{nil} whenever a keyboard macro is -being run. This is to suppress the informative messages and speed -execution of the macro. - - For example: + The most common use of @code{interactive-p} is for deciding whether +to give the user additional visual feedback (such as by printing an +informative message). For example: @example @group +;; @r{Here's the usual way to use @code{interactive-p}.} (defun foo () (interactive) (when (interactive-p) @@ -640,6 +638,7 @@ @end group @group +;; @r{This function is just to illustrate the behavior.} (defun bar () (interactive) (setq foobar (list (foo) (interactive-p)))) @@ -653,7 +652,7 @@ @group ;; @r{Type @kbd{M-x bar}.} -;; @r{This does not print anything.} +;; @r{This does not display a message.} @end group @group @@ -662,10 +661,11 @@ @end group @end example - The other way to do this sort of job is to make the command take an -argument @code{print-message} which should be non-@code{nil} in an -interactive call, and use the @code{interactive} spec to make sure it is -non-@code{nil}. Here's how: + If you want to test @emph{only} whether the function was called +using @code{call-interactively}, add an optional argument +@code{print-message} which should be non-@code{nil} in an interactive +call, and use the @code{interactive} spec to make sure it is +non-@code{nil}. Here's an example: @example (defun foo (&optional print-message) @@ -675,10 +675,18 @@ @end example @noindent -Defined in this way, the function does display the message when -called from a keyboard macro. - - The numeric prefix argument, provided by @samp{p}, is never @code{nil}. +Defined in this way, the function does display the message when called +from a keyboard macro. We use @code{"p"} because the numeric prefix +argument is never @code{nil}. + +@defun called-interactively-p +This function returns @code{t} when the calling function was called +using @code{call-interactively}. + +When possible, instead of using this function, you should use the +method in the example above; that method makes it possible for a +caller to ``pretend'' that the function was called interactively. +@end defun @node Command Loop Info @comment node-name, next, previous, up @@ -1513,16 +1521,17 @@ @cindex @code{wheel-down} event @item (wheel-up @var{position}) @item (wheel-down @var{position}) -This kind of event is generated by moving a wheel on a mouse. Its -effect is typically a kind of scroll or zoom. +These kinds of event are generated by moving a mouse wheel. Their +usual meaning is a kind of scroll or zoom. The element @var{position} is a list describing the position of the event, in the same format as used in a mouse-click event. -This kind of event is generated only on some kinds of systems. On -other systems, mouse-4 and mouse-5 may be used instead. For portable -code, the variables @code{mouse-wheel-up-event} and -@code{mouse-wheel-down-event} defined in @file{mwheel.el} can be used. +This kind of event is generated only on some kinds of systems. On some +systems, @code{mouse-4} and @code{mouse-5} are used instead. For +portable code, use the variables @code{mouse-wheel-up-event} and +@code{mouse-wheel-down-event} defined in @file{mwheel.el} to determine +what event types to expect for the mouse wheel. @cindex @code{drag-n-drop} event @item (drag-n-drop @var{position} @var{files})
--- a/lispref/frames.texi Fri Oct 29 00:25:02 2004 +0000 +++ b/lispref/frames.texi Thu Nov 04 08:55:40 2004 +0000 @@ -1980,12 +1980,18 @@ @defun x-server-version &optional display This function returns the list of version numbers of the X server running the display. The value is a list of three integers: the major -and minor version numbers, and the vendor-specific release number. +and minor version numbers of the X protocol, and the +distributor-specific release number of the X server software itself. @end defun @defun x-server-vendor &optional display -This function returns the ``vendor'' that provided the X server software -(as a string). +This function returns the ``vendor'' that provided the X server +software (as a string). Really this means whoever distributes the X +server. + +When the developers of X labelled software distributors as +``vendors'', they showed their false assumption that no system could +ever be developed and distributed noncommercially. @end defun @ignore
--- a/lispref/minibuf.texi Fri Oct 29 00:25:02 2004 +0000 +++ b/lispref/minibuf.texi Thu Nov 04 08:55:40 2004 +0000 @@ -1660,32 +1660,6 @@ To read a password to pass to another program, you can use the function @code{read-passwd}. -@cindex password cache - Passwords are sometimes needed several times throughout an Emacs -session. Then it can be useful to avoid having to ask for a password -more than once. Passwords are entered into the password cache using -the function @code{password-cache-add}. To read a password, possibly -retrieving the password from the cache without querying the user, you -can use the function @code{password-read}. The two calls can be -combined into the function @code{password-read-and-add} that read a -password and store it in the cache. - - Typically users do not use the same password for all services. The -password cache mechanism use a @samp{key} string to differentiate -among the passwords. The @samp{key} string is typically a fixed -string chosen to be related to what the password is used for. For -example, a password used when connecting to a @acronym{IMAP} mail -server called @samp{mail.example.org}, could use a @samp{key} string -of @samp{imap:mail.example.org}. You can use any string, as long as -it is reasonably unique. - -@cindex password expiry -Passwords in the cache typically expire after a while (controlled by -the variable @code{password-cache-expiry}), but you can force removal -of a password using the function @code{password-cache-remove}. This -is useful when there is a problem with the password, to avoid using -the same incorrect password from the cache in the future. - @defun read-passwd prompt &optional confirm default This function reads a password, prompting with @var{prompt}. It does not echo the password as the user types it; instead, it echoes @samp{.} @@ -1701,41 +1675,6 @@ then @code{read-passwd} returns the null string in that case. @end defun -@defun password-read prompt key -Read a password from the user, using @code{read-passwd}, prompting -with @var{prompt}. If a password has been stored in the password -cache, using @code{password-cache-add} on the same @var{key}, it is -returned directly, without querying the user. -@end defun - -@defun password-cache-add key password -Add a password to the password cache, indexed under the given -@var{key}. The password is later retrieved using @code{password-read} -called with the same @var{key}. -@end defun - -@defun password-cache-remove key -Remove a password from the cache, indexed under the given @var{key}. -@end defun - -@defun password-read-and-add prompt &optional key -Read a password, prompting with @var{prompt}, and possibly add it to -the cache, indexed using the @var{key} string. This is one-call -interface to @code{password-read} and @code{password-cache-add}. -@end defun - -@defvar password-cache-expiry -This variable specify for how many seconds passwords are retained in -the password cache before they are expired. For high security, use a -low value (below a minute). For more lax security, use a setting of -@samp{14400} corresponding to half a work day (4 hours). -@end defvar - -@defvar password-cache -This variable toggle whether or not the password cache is used at all. -The default is non-@code{nil}, i.e., to use the cache. -@end defvar - @node Minibuffer Misc @section Minibuffer Miscellany
--- a/lwlib/ChangeLog Fri Oct 29 00:25:02 2004 +0000 +++ b/lwlib/ChangeLog Thu Nov 04 08:55:40 2004 +0000 @@ -1,3 +1,10 @@ +2004-11-01 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * xlwmenu.c (find_first_selectable, find_next_selectable) + (find_prev_selectable): Rename parameter skip_no_call_data to + skip_titles. Recognize titles as having no call_data and no contents. + (Down, Up): Comment update. + 2004-08-30 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> * lwlib.h (_widget_value): Added lname and lkey.
--- a/lwlib/xlwmenu.c Fri Oct 29 00:25:02 2004 +0000 +++ b/lwlib/xlwmenu.c Thu Nov 04 08:55:40 2004 +0000 @@ -2054,26 +2054,26 @@ } static widget_value * -find_first_selectable (mw, item, skip_no_call_data) +find_first_selectable (mw, item, skip_titles) XlwMenuWidget mw; widget_value *item; - int skip_no_call_data; + int skip_titles; { widget_value *current = item; enum menu_separator separator; while (lw_separator_p (current->name, &separator, 0) || !current->enabled - || (skip_no_call_data && !current->call_data)) + || (skip_titles && !current->call_data && !current->contents)) if (current->next) current=current->next; else - return NULL; + return NULL; return current; } static widget_value * -find_next_selectable (mw, item, skip_no_call_data) +find_next_selectable (mw, item, skip_titles) XlwMenuWidget mw; widget_value *item; { @@ -2082,7 +2082,7 @@ while (current->next && (current=current->next) && (lw_separator_p (current->name, &separator, 0) || !current->enabled - || (skip_no_call_data && !current->call_data))) + || (skip_titles && !current->call_data && !current->contents))) ; if (current == item) @@ -2093,7 +2093,8 @@ while (lw_separator_p (current->name, &separator, 0) || !current->enabled - || (skip_no_call_data && !current->call_data)) + || (skip_titles && !current->call_data + && !current->contents)) { if (current->next) current=current->next; @@ -2108,14 +2109,14 @@ } static widget_value * -find_prev_selectable (mw, item, skip_no_call_data) +find_prev_selectable (mw, item, skip_titles) XlwMenuWidget mw; widget_value *item; { widget_value *current = item; widget_value *prev = item; - while ((current=find_next_selectable (mw, current, skip_no_call_data)) + while ((current=find_next_selectable (mw, current, skip_titles)) != item) { if (prev == current) @@ -2141,8 +2142,7 @@ if (mw->menu.old_depth == mw->menu.top_depth) /* When <down> in the menu-bar is pressed, display the corresponding sub-menu and select the first selectable menu item there. - If this is a popup menu, skip items with zero call data (title of - the popup). */ + If this is a popup menu, skip title item of the popup. */ set_new_state (mw, find_first_selectable (mw, selected_item->contents, @@ -2174,8 +2174,7 @@ last selectable item in the list. So we select the first selectable one and find the previous selectable item. Is there a better way? */ - /* If this is a popup menu, skip items with zero call data (title of - the popup). */ + /* If this is a popup menu, skip title item of the popup. */ set_new_state (mw, find_first_selectable (mw, selected_item->contents,
--- a/man/ChangeLog Fri Oct 29 00:25:02 2004 +0000 +++ b/man/ChangeLog Thu Nov 04 08:55:40 2004 +0000 @@ -1,3 +1,21 @@ +2004-11-02 Katsumi Yamaoka <yamaoka@jpl.org> + + * emacs-mime.texi (Encoding Customization): Fix + mm-coding-system-priorities entry. + +2004-11-03 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * frames.texi (Dialog Boxes): + * idlwave.texi (Continued Statement Indentation): + * reftex.texi (Options (Index Support)): + (Displaying and Editing the Index, Table of Contents): + * speedbar.texi (Creating a display, Major Display Modes): Replace + non-nil with non-@code{nil}. + +2004-11-02 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * frames.texi (Dialog Boxes): Document use-old-gtk-file-dialog. + 2004-10-23 Eli Zaretskii <eliz@gnu.org> * text.texi (Text Based Tables, Table Definition)
--- a/man/emacs-mime.texi Fri Oct 29 00:25:02 2004 +0000 +++ b/man/emacs-mime.texi Thu Nov 04 08:55:40 2004 +0000 @@ -814,12 +814,12 @@ @vindex mm-coding-system-priorities Prioritize coding systems to use for outgoing messages. The default is @code{nil}, which means to use the defaults in Emacs. It is a list of -coding system symbols (aliases of coding systems does not work, use -@kbd{M-x describe-coding-system} to make sure you are not specifying -an alias in this variable). For example, if you have configured Emacs +coding system symbols (aliases of coding systems are also allowed, use +@kbd{M-x describe-coding-system} to make sure you are specifying correct +coding system names). For example, if you have configured Emacs to prefer UTF-8, but wish that outgoing messages should be sent in ISO-8859-1 if possible, you can set this variable to -@code{(iso-latin-1)}. You can override this setting on a per-message +@code{(iso-8859-1)}. You can override this setting on a per-message basis by using the @code{charset} @acronym{MML} tag (@pxref{MML Definition}). @item mm-content-transfer-encoding-defaults
--- a/man/frames.texi Fri Oct 29 00:25:02 2004 +0000 +++ b/man/frames.texi Thu Nov 04 08:55:40 2004 +0000 @@ -910,6 +910,11 @@ of dialogs. This option has no effect if you have suppressed all dialog boxes with the option @code{use-dialog-box}. +@vindex use-old-gtk-file-dialog + For Gtk+ version 2.4, you can make Emacs use the old file dialog +by setting the variable @code{use-old-gtk-file-dialog} to a non-@code{nil} +value. If Emacs is built with a Gtk+ version that has only one file dialog, +the setting of this variable has no effect. @node Tooltips @section Tooltips (or ``Balloon Help'')
--- a/man/idlwave.texi Fri Oct 29 00:25:02 2004 +0000 +++ b/man/idlwave.texi Thu Nov 04 08:55:40 2004 +0000 @@ -832,7 +832,7 @@ continuation indentation, especially if @code{idlwave-max-extra-continuation-indent} is small, the key @kbd{C-u @key{TAB}} will re-indent all lines in the current statement. -Note that @code{idlwave-indent-to-open-paren}, if non-nil, overrides +Note that @code{idlwave-indent-to-open-paren}, if non-@code{nil}, overrides the @code{idlwave-max-extra-continuation-indent} limit, for parentheses only, forcing them always to line up.
--- a/man/reftex.texi Fri Oct 29 00:25:02 2004 +0000 +++ b/man/reftex.texi Thu Nov 04 08:55:40 2004 +0000 @@ -568,7 +568,7 @@ @item r @vindex reftex-enable-partial-scans Reparse the LaTeX document and rebuild the @file{*toc*} buffer. When -@code{reftex-enable-partial-scans} is non-nil, rescan only the file this +@code{reftex-enable-partial-scans} is non-@code{nil}, rescan only the file this location is defined in, not the entire document.@refill @item C-u r @@ -2355,7 +2355,7 @@ @item r @vindex reftex-enable-partial-scans Reparse the LaTeX document and rebuild the @file{*Index*} buffer. When -@code{reftex-enable-partial-scans} is non-nil, rescan only the file this +@code{reftex-enable-partial-scans} is non-@code{nil}, rescan only the file this location is defined in, not the entire document.@refill @item C-u r @@ -4348,7 +4348,7 @@ should be @samp{Molecules!}.@refill @var{exclude} can be a function. If this function exists and returns a -non-nil value, the index entry at point is ignored. This was +non-@code{nil} value, the index entry at point is ignored. This was implemented to support the (deprecated) @samp{^} and @samp{_} shortcuts in the LaTeX2e @code{index} package.@refill
--- a/man/speedbar.texi Fri Oct 29 00:25:02 2004 +0000 +++ b/man/speedbar.texi Thu Nov 04 08:55:40 2004 +0000 @@ -1066,7 +1066,7 @@ There are several helper functions you can use if you are going to use built in tagging. These functions can be @code{or}ed since each one -returns non-nil if it displays a message. They are: +returns non-@code{nil} if it displays a message. They are: @table @code @cindex @code{speedbar-item-info-file-helper} @@ -1165,7 +1165,7 @@ user clicks on the text. The optional argument @var{token} is extra data to associated with the -text. Lastly @var{prevline} should be non-nil if you want this line to +text. Lastly @var{prevline} should be non-@code{nil} if you want this line to appear directly after the last button which was created instead of on the next line. @end defun
--- a/src/.gdbinit Fri Oct 29 00:25:02 2004 +0000 +++ b/src/.gdbinit Thu Nov 04 08:55:40 2004 +0000 @@ -70,6 +70,34 @@ Works only when an inferior emacs is executing. end +# Print out current buffer point and boundaries +define ppt + set $b = current_buffer + set $t = $b->text + printf "BUF PT: %d", $b->pt + if ($b->pt != $b->pt_byte) + printf "[%d]", $b->pt_byte + end + printf " of 1..%d", $t->z + if ($t->z != $t->z_byte) + printf "[%d]", $t->z_byte + end + if ($b->begv != 1 || $b->zv != $t->z) + printf " NARROW=%d..%d", $b->begv, $b->zv + if ($b->begv != $b->begv_byte || $b->zv != $b->zv_byte) + printf " [%d..%d]", $b->begv_byte, $b->zv_byte + end + end + printf " GAP: %d", $t->gpt + if ($t->gpt != $t->gpt_byte) + printf "[%d]", $t->gpt_byte + end + printf " SZ=%d\n", $t->gap_size +end +document ppt +Print point, beg, end, narrow, and gap for current buffer. +end + define xtype xgettype $ output $type
--- a/src/ChangeLog Fri Oct 29 00:25:02 2004 +0000 +++ b/src/ChangeLog Thu Nov 04 08:55:40 2004 +0000 @@ -1,3 +1,166 @@ +2004-11-04 Kenichi Handa <handa@m17n.org> + + * fontset.c (fontset_pattern_regexp): If '*' is preceded by '\', + treat it as a literal character. + +2004-11-03 Kim F. Storm <storm@cua.dk> + + * .gdbinit (ppt): New function. + +2004-11-02 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * xterm.c (x_window_to_scroll_bar): Only call + xg_get_scroll_id_for_window if toolkit scroll bars are used. + + * gtkutil.c (xg_get_file_with_chooser): Use GTK_STOCK_OK instead + of save. + +2004-11-02 Andreas Schwab <schwab@suse.de> + + * window.c (Fscroll_right): Fix last change. + +2004-11-02 Kim F. Storm <storm@cua.dk> + + * Makefile.in (callproc.o): Depend on blockinput.h atimer.h systime.h. + +2004-11-02 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * callproc.c (Fcall_process): Block input around vfork. + +2004-11-02 Kim F. Storm <storm@cua.dk> + + * eval.c (Fcalled_interactively_p): Rename from Fcall_interactive_p. + (syms_of_eval): Defsubr it. + +2004-11-02 Richard M. Stallman <rms@gnu.org> + + * insdel.c (replace_range_2): New function. + + * casefiddle.c (casify_region): Handle changes in byte-length + using replace_range_2. + + * emacs.c (USAGE3): Delete --horizontal-scroll-bars, -hb. + + * xdisp.c (back_to_previous_visible_line_start): + Subtract 1 from pos when checking previous newline for invisibility. + + * window.c (window_scroll_pixel_based): Update preserve_y + for header line if any. + (Fscroll_left, Fscroll_right): Don't call interactive_p; + use a new second argument instead. + + * eval.c (Fcall_interactive_p): New function. + (interactive_p): Don't test INTERACTIVE here. + (Finteractive_p): Doc fix. + + * eval.c (Feval): Abort if INPUT_BLOCKED_P. + +2004-11-02 KOBAYASHI Yasuhiro <kobayays@otsukakj.co.jp> + + * w32fns.c (w32_font_match): Use fast_string_match_ignore_case for + comparing font names. + +2004-11-02 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * fileio.c (Fread_file_name): Pass Qt as fifth parameter to + Fx_file_dialog if only directories should be read. + + * lisp.h: Fx_file_dialog takes 5 parameters. + + * xfns.c (Fx_file_dialog): Both Motif and GTK version: Add + parameter only_dir_p. + In Motif version, don't put DEFAULT_FILENAME in filter part of the + dialog, just text field part. Do not add DEFAULT_FILENAME + to list of files if it isn't there. + In GTK version, pass only_dir_p parameter to xg_get_file_name. + + * macfns.c (Fx_file_dialog): Add parameter only_dir_p. Check + only_dir_p instead of comparing prompt to "Dired". When using + a save dialog, add option kNavDontConfirmReplacement, change title + to "Enter name", change text for save button to "Ok". + + * w32fns.c (Fx_file_dialog): Add parameter only_dir_p. Check + only_dir_p instead of comparing prompt to "Dired". + + * gtkutil.c (xg_get_file_with_chooser) + (xg_get_file_with_selection): New functions, only defined ifdef + HAVE_GTK_FILE_CHOOSER_DIALOG_NEW and HAVE_GTK_FILE_SELECTION_NEW + respectively. + (xg_get_file_name): Add parameter only_dir_p. + Call xg_get_file_with_chooser or xg_get_file_with_selection + depending on HAVE_GTK_FILE* and the value of use_old_gtk_file_dialog. + (xg_initialize): New DEFVAR_BOOL use_old_gtk_file_dialog. + + * gtkutil.h (xg_get_file_name): Add parameter only_dir_p. + + * config.in: Rebuild (added HAVE_GTK_FILE_*). + +2004-11-01 Kim F. Storm <storm@cua.dk> + + * process.c (connect_wait_mask, num_pending_connects): Only + declare and use them if NON_BLOCKING_CONNECT is defined. + (init_process): Initialize them if NON_BLOCKING_CONNECT defined. + (IF_NON_BLOCKING_CONNECT): New helper macro. + (wait_reading_process_output): Only declare and use local vars + Connecting and check_connect when NON_BLOCKING_CONNECT is defined. + +2004-11-01 Andy Petrusenco <Igrek@star-sw.com> (tiny change) + + * w32term.c (x_scroll_run): Delete region objects after use. + +2004-10-31 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * xmenu.c: Add prototypes for forward function declarations. + (popup_get_selection): Remove parameter do_timers, remove call to + timer_check. + (create_and_show_popup_menu, create_and_show_dialog): Remove + parameter do_timers from call to popup_get_selection. + + * xdisp.c (update_tool_bar): Pass a copy of f->tool_bar_items to + tool_bar_items and assign the result to f->tool_bar_items if + not equal. Move BLOCK/UNBLOCK_INPUT from around call to + tool_bar_items to assignment of result. + + * atimer.c (alarm_signal_handler): Do not call set_alarm if + pending_atmers is non-zero. + +2004-10-31 Kim F. Storm <storm@cua.dk> + + * dispnew.c (margin_glyphs_to_reserve): Don't use ncols_scale_factor. + +2004-10-28 Will <will@glozer.net> + + * macterm.c: allow user to assign key modifiers to the Mac Option + key via a 'mac-option-modifier' variable. + +2004-10-28 Stefan <monnier@iro.umontreal.ca> + + * xselect.c (Vx_lost_selection_functions, Vx_sent_selection_functions): + Rename from Vx_lost_selection_hooks and Vx_sent_selection_hooks. + (x_handle_selection_request, x_handle_selection_clear) + (x_clear_frame_selections, syms_of_xselect): Adjust accordingly. + +2004-10-28 Richard M. Stallman <rms@gnu.org> + + * w32fns.c (Fx_server_vendor, Fx_server_version): Doc fixes. + + * xfns.c (Fx_server_vendor, Fx_server_version): Doc fixes. + +2004-10-27 Stefan Monnier <monnier@iro.umontreal.ca> + + * syntax.c (scan_sexps_forward): Give precedence to a 2-char + comment-starter over a 1-char one. + +2004-10-27 Richard M. Stallman <rms@gnu.org> + + * xdisp.c (get_next_display_element): In mode lines, + treat newline and tab like other control characters. + + * editfns.c (Fmessage): Doc fix. + + * indent.c (vmotion): When moving up, check the newline before. + Make prevline an int, not a Lisp_Object. + 2004-10-27 Kim F. Storm <storm@cua.dk> * editfns.c (Fformat): Allocate discarded table with SAFE_ALLOCA. @@ -12,8 +175,8 @@ 2004-10-26 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> * gtkutil.c: Put empty line between comment and function body. - (xg_destroy_widgets): Renamed from remove_from_container. Just - destroy all widgets in list. Argument wcont removed. + (xg_destroy_widgets): Rename from remove_from_container. + Just destroy all widgets in list. Argument wcont removed. (xg_update_menubar, xg_update_submenu): Call xg_destroy_widgets instead of remove_from_container. (xg_display_close, xg_create_tool_bar, update_frame_tool_bar) @@ -54,17 +217,17 @@ 2004-10-21 K,Aa(Broly L$,1 q(Brentey <lorentey@elte.hu> - * xterm.h (x_output): New member `xic_base_fontname'. - (FRAME_XIC_BASE_FONTNAME): New macro. - (xic_free_xfontset): Declare. - - * xfns.c (xic_create_xfontset): Share fontsets between frames - based on base_fontname. - (xic_free_xfontset): New function. - (free_frame_xic): Use it. - (xic_set_xfontset): Ditto. - - * xterm.c (xim_destroy_callback): Ditto. + * xterm.h (x_output): New member `xic_base_fontname'. + (FRAME_XIC_BASE_FONTNAME): New macro. + (xic_free_xfontset): Declare. + + * xfns.c (xic_create_xfontset): Share fontsets between frames + based on base_fontname. + (xic_free_xfontset): New function. + (free_frame_xic): Use it. + (xic_set_xfontset): Ditto. + + * xterm.c (xim_destroy_callback): Ditto. 2004-10-20 B. Anyos <banyos@freemail.hu> (tiny change) @@ -108,10 +271,10 @@ * gtkutil.h (xg_update_scrollbar_pos): Remove arguments real_left and canon_width. - (xg_frame_cleared): Removed. - - * gtkutil.c (xg_frame_cleared, xg_fixed_handle_expose, - xg_find_top_left_in_fixed): Removed. + (xg_frame_cleared): Remove. + + * gtkutil.c (xg_frame_cleared, xg_fixed_handle_expose) + (xg_find_top_left_in_fixed): Remove. (xg_create_scroll_bar): Put an event box widget between the scroll bar widget and the edit widget. (xg_show_scroll_bar): Show the parent widget (the event box). @@ -120,11 +283,11 @@ Move the parent (the event box) widget inside the fixed widget. Move window clear to xterm.c. - * gtkutil.h (xg_frame_cleared): Removed. + * gtkutil.h (xg_frame_cleared): Remove. * xterm.c (x_clear_frame): Remove call to xg_frame_cleared - (x_scroll_bar_create, XTset_vertical_scroll_bar): Remove - arguments left and width to xg_update_scrollbar_pos. + (x_scroll_bar_create, XTset_vertical_scroll_bar): + Remove arguments left and width to xg_update_scrollbar_pos. (XTset_vertical_scroll_bar): Do x_clear_area for USE_GTK also. 2004-10-19 Kenichi Handa <handa@m17n.org> @@ -349,7 +512,7 @@ compositions to encode. (encode_coding_string): Likewise. Free composition data. -2004-09-30 Florian Weimer <fw@deneb.enyo.de> (tiny change) +2004-09-30 Florian Weimer <fw@deneb.enyo.de> * coding.c (code_convert_region): Free composition data. @@ -923,7 +1086,7 @@ (Fsave_window_excursion, Fset_window_vscroll) (syms_of_window) <window-size-fixed>: Doc fixes. -2004-07-19 KOBAYASHI Yasuhiro <kobayays@otsukakj.co.jp> (tiny change) +2004-07-19 KOBAYASHI Yasuhiro <kobayays@otsukakj.co.jp> * w32fns.c (Fx_file_dialog): Use ENCODE_FILE instead of ENCODE_SYSTEM for filenames. @@ -982,7 +1145,7 @@ * buffer.c (syms_of_buffer) <transient-mark-mode>: Doc fix. -2004-07-15 KOBAYASHI Yasuhiro <kobayays@otsukakj.co.jp> (tiny change) +2004-07-15 KOBAYASHI Yasuhiro <kobayays@otsukakj.co.jp> * w32fns.c (Fx_file_dialog): Encode strings in system coding system before passing them to OS functions for display. @@ -1646,7 +1809,7 @@ before actually accepting connection in case it has already been accepted due to recursion. -2004-05-23 K,Ba(Broly L,Bu(Brentey <lorentey@elte.hu> (tiny change) +2004-05-23 K,Ba(Broly L,Bu(Brentey <lorentey@elte.hu> * coding.c (Fset_safe_terminal_coding_system_internal): Set suppress_error in safe_terminal_coding, not terminal_coding. @@ -1960,7 +2123,7 @@ * w32fns.c (Vw32_ansi_code_page): New Lisp variable. (globals_of_w32fns): Set it. -2004-05-09 Piet van Oostrum <piet@cs.uu.nl> (tiny change) +2004-05-09 Piet van Oostrum <piet@cs.uu.nl> * data.c (Fquo): Simplify. @@ -2009,7 +2172,7 @@ * emacs.c (main) [VMS]: Fix var ref. -2004-05-06 Romain Francoise <romain@orebokech.com> (tiny change) +2004-05-06 Romain Francoise <romain@orebokech.com> * data.c (Fsetq_default): Fix docstring. @@ -2049,7 +2212,7 @@ * Makefile.in (region-cache.o): Depend on config.h. -2004-05-02 Romain Francoise <romain@orebokech.com> (tiny change) +2004-05-02 Romain Francoise <romain@orebokech.com> * indent.c (compute_motion): Save vpos in prev_vpos when dealing with continuation lines, too. @@ -3292,7 +3455,7 @@ entries that were used before we return. (init_keyboard): Initialize read_avail_input_buf here. -2004-02-16 Jesper Harder <harder@ifa.au.dk> (tiny change) +2004-02-16 Jesper Harder <harder@ifa.au.dk> * cmds.c (Fend_of_line): Doc fix. @@ -3960,7 +4123,7 @@ to the definition of `signal' in the Elisp manual. * eval.c (Fsignal): Ditto. -2003-12-29 James Clark <jjc@jclark.com> (tiny change) +2003-12-29 James Clark <jjc@jclark.com> * fns.c (internal_equal): Return t for two NaN arguments. @@ -5020,7 +5183,7 @@ * fileio.c (Fwrite_region): Fix conditional expression to issue the right message. -2003-08-16 Juri Linkov <juri@jurta.org> (tiny change) +2003-08-16 Juri Linkov <juri@jurta.org> * syntax.c (Fforward_word): Argument changed to optional. Set default value to 1. @@ -5079,7 +5242,7 @@ * fns.c (Fclear_string): New function. (syms_of_fns): defsubr it. -2003-07-28 KOBAYASHI Yasuhiro <kobayays@otsukakj.co.jp> (tiny change) +2003-07-28 KOBAYASHI Yasuhiro <kobayays@otsukakj.co.jp> * xfns.c (xic_set_preeditarea): Add the left fringe width to spot.x. @@ -5307,7 +5470,7 @@ * alloc.c (Fgarbage_collect): Doc fix. -2003-07-07 Nozomu Ando <nand@mac.com> (tiny change) +2003-07-07 Nozomu Ando <nand@mac.com> * buffer.c (Fkill_buffer): Clear charpos cache if necessary. @@ -6517,7 +6680,7 @@ * alloc.c (Fgarbage_collect): Cast pointers into specpdl to avoid GCC warning. -2003-05-16 Ralph Schleicher <rs@nunatak.allgaeu.org> (tiny change) +2003-05-16 Ralph Schleicher <rs@nunatak.allgaeu.org> * fileio.c (Fdelete_file): Handle symlinks pointing to directories. @@ -8240,7 +8403,7 @@ (w32_init_class): Use it. (x_put_x_image): Declare all args. -2003-01-21 Richard Dawe <rich@phekda.freeserve.co.uk> (tiny change) +2003-01-21 Richard Dawe <rich@phekda.freeserve.co.uk> * Makefile.in (ALL_CFLAGS): Include MYCPPFLAGS, not MYCPPFLAG. @@ -8612,7 +8775,7 @@ in direct action cases for Qforward_char and Qbackward_char. Set already_adjusted so it won't be done twice. -2002-12-30 Richard Dawe <rich@phekda.freeserve.co.uk> (tiny change) +2002-12-30 Richard Dawe <rich@phekda.freeserve.co.uk> * src/config.in (!HAVE_SIZE_T): Fix order of arguments in type definition of size_t. @@ -8710,7 +8873,7 @@ * dired.c (file_name_completion): Fix that change. Delete special quit-handling code; just use QUIT. -2002-12-21 Tak Ota <Takaaki.Ota@am.sony.com> (tiny change) +2002-12-21 Tak Ota <Takaaki.Ota@am.sony.com> * dired.c (file_name_completion): Close directory on error just as in directory_files_internal. @@ -10050,8 +10213,8 @@ 2002-08-26 Kim F. Storm <storm@cua.dk> - * frame.c (make_terminal_frame) [CANNOT_DUMP]: Initialize foreground - and background colors. From Joe Buehler (tiny change). + * frame.c (make_terminal_frame) [CANNOT_DUMP]: Initialize + foreground and background colors. From Joe Buehler. 2002-08-26 Miles Bader <miles@gnu.org>
--- a/src/ChangeLog.8 Fri Oct 29 00:25:02 2004 +0000 +++ b/src/ChangeLog.8 Thu Nov 04 08:55:40 2004 +0000 @@ -6,25 +6,25 @@ 1999-12-31 William M. Perry <wmperry@aventail.com> - * xfns.c (jpeg_format): Added the :data keyword + * xfns.c (jpeg_format): Add the :data keyword (jpeg_image_p): JPEG is valid with :file _or_ :data - (jpeg_memory_src): Defined new JPEG image source to read from a + (jpeg_memory_src): Define new JPEG image source to read from a memory buffer. (jpeg_load): Pay attention to the :data keyword if specified. Instantiates a jpeg_memory_src instead of jpeg_stdio_src if found. - (png_format): Added the :data keyword + (png_format): Add the :data keyword (png_image_p): PNG is valid with :file _or_ :data (png_read_from_memory): New PNG read function to read from a memory buffer. (png_load): Pay attention to the :data keyword if specified. Use png_set_read_fn() instead of png_init_io() if specified. - (tiff_format): Added the :data keyword for TIFF images. + (tiff_format): Add the :data keyword for TIFF images. (tiff_image_p): TIFF is valid with :file _or_ :data - (tiff_read_from_memory): Defined new TIFF I/O functions to read + (tiff_read_from_memory): Define new TIFF I/O functions to read from a memory buffer. (tiff_load): Pay attention to the :data keyword if specified. Uses TIFFClientOpen() instead of TIFFOpen() if specified. - (gif_format): Added the :data keyword + (gif_format): Add the :data keyword (gif_image_p): GIF is valid with :file _or_ :data (gif_read_from_memory): New GIF input function to read from a memory buffer.
--- a/src/Makefile.in Fri Oct 29 00:25:02 2004 +0000 +++ b/src/Makefile.in Thu Nov 04 08:55:40 2004 +0000 @@ -1034,7 +1034,7 @@ keyboard.h dispextern.h $(config_h) callproc.o: callproc.c epaths.h buffer.h commands.h $(config_h) \ process.h systty.h syssignal.h character.h coding.h ccl.h msdos.h \ - composite.h w32.h + composite.h w32.h blockinput.h atimer.h systime.h casefiddle.o: casefiddle.c syntax.h commands.h buffer.h character.h \ composite.h \ charset.h keymap.h $(config_h)
--- a/src/atimer.c Fri Oct 29 00:25:02 2004 +0000 +++ b/src/atimer.c Thu Nov 04 08:55:40 2004 +0000 @@ -397,7 +397,8 @@ EMACS_GET_TIME (now); } - set_alarm (); + if (! pending_atimers) + set_alarm (); }
--- a/src/callproc.c Fri Oct 29 00:25:02 2004 +0000 +++ b/src/callproc.c Thu Nov 04 08:55:40 2004 +0000 @@ -83,6 +83,7 @@ #include "process.h" #include "syssignal.h" #include "systty.h" +#include "blockinput.h" #ifdef MSDOS #include "msdos.h" @@ -620,6 +621,8 @@ pid = child_setup (filefd, fd1, fd_error, (char **) new_argv, 0, current_dir); #else /* not WINDOWSNT */ + BLOCK_INPUT; + pid = vfork (); if (pid == 0) @@ -637,6 +640,8 @@ child_setup (filefd, fd1, fd_error, (char **) new_argv, 0, current_dir); } + + UNBLOCK_INPUT; #endif /* not WINDOWSNT */ /* The MSDOS case did this already. */
--- a/src/config.in Fri Oct 29 00:25:02 2004 +0000 +++ b/src/config.in Thu Nov 04 08:55:40 2004 +0000 @@ -217,6 +217,15 @@ /* Define to 1 if using GTK. */ #undef HAVE_GTK +/* Define to 1 if GTK has both file selection and chooser dialog. */ +#undef HAVE_GTK_FILE_BOTH + +/* Define to 1 if you have the `gtk_file_chooser_dialog_new' function. */ +#undef HAVE_GTK_FILE_CHOOSER_DIALOG_NEW + +/* Define to 1 if you have the `gtk_file_selection_new' function. */ +#undef HAVE_GTK_FILE_SELECTION_NEW + /* Define to 1 if GTK can handle more than one display. */ #undef HAVE_GTK_MULTIDISPLAY
--- a/src/dispnew.c Fri Oct 29 00:25:02 2004 +0000 +++ b/src/dispnew.c Thu Nov 04 08:55:40 2004 +0000 @@ -579,7 +579,7 @@ int width = XFASTINT (w->total_cols); double d = max (0, XFLOATINT (margin)); d = min (width / 2 - 1, d); - n = (int) ((double) total_glyphs / width * d) * w->ncols_scale_factor; + n = (int) ((double) total_glyphs / width * d); } else n = 0;
--- a/src/editfns.c Fri Oct 29 00:25:02 2004 +0000 +++ b/src/editfns.c Thu Nov 04 08:55:40 2004 +0000 @@ -3168,11 +3168,14 @@ DEFUN ("message", Fmessage, Smessage, 1, MANY, 0, doc: /* Print a one-line message at the bottom of the screen. +The message also goes into the `*Messages*' buffer. +\(In keyboard macros, that's all it does.) + The first argument is a format control string, and the rest are data to be formatted under control of the string. See `format' for details. -If the first argument is nil, clear any existing message; let the -minibuffer contents show. +If the first argument is nil, the function clears any existing message; +this lets the minibuffer contents show. See also `current-message'. usage: (message STRING &rest ARGS) */) (nargs, args)
--- a/src/emacs.c Fri Oct 29 00:25:02 2004 +0000 +++ b/src/emacs.c Thu Nov 04 08:55:40 2004 +0000 @@ -305,7 +305,6 @@ --fullscreen, -fs make first frame fullscreen\n\ --fullwidth, -fw make the first frame wide as the screen\n\ --geometry, -g GEOMETRY window geometry\n\ ---horizontal-scroll-bars, -hb enable horizontal scroll bars\n\ --icon-type, -i use picture of gnu for Emacs icon\n\ --iconic start Emacs in iconified state\n\ --internal-border, -ib WIDTH width between text and main border\n\
--- a/src/eval.c Fri Oct 29 00:25:02 2004 +0000 +++ b/src/eval.c Thu Nov 04 08:55:40 2004 +0000 @@ -540,21 +540,45 @@ DEFUN ("interactive-p", Finteractive_p, Sinteractive_p, 0, 0, 0, - doc: /* Return t if function in which this appears was called interactively. + doc: /* Return t if the function was run directly by user input. This means that the function was called with call-interactively (which includes being called as the binding of a key) -and input is currently coming from the keyboard (not in keyboard macro). */) +and input is currently coming from the keyboard (not in keyboard macro), +and Emacs is not running in batch mode (`noninteractive' is nil). + +The only known proper use of `interactive-p' is in deciding whether to +display a helpful message, or how to display it. If you're thinking +of using it for any other purpose, it is quite likely that you're +making a mistake. Think: what do you want to do when the command is +called from a keyboard macro? + +If you want to test whether your function was called with +`call-interactively', the way to do that is by adding an extra +optional argument, and making the `interactive' spec specify non-nil +unconditionally for that argument. (`p' is a good way to do this.) */) () { - return interactive_p (1) ? Qt : Qnil; + return (INTERACTIVE && interactive_p (1)) ? Qt : Qnil; } -/* Return 1 if function in which this appears was called - interactively. This means that the function was called with - call-interactively (which includes being called as the binding of - a key) and input is currently coming from the keyboard (not in - keyboard macro). +DEFUN ("called-interactively-p", Fcalled_interactively_p, Scalled_interactively_p, 0, 0, 0, + doc: /* Return t if the function using this was called with call-interactively. +This is used for implementing advice and other function-modifying +features of Emacs. + +The cleanest way to test whether your function was called with +`call-interactively', the way to do that is by adding an extra +optional argument, and making the `interactive' spec specify non-nil +unconditionally for that argument. (`p' is a good way to do this.) */) + () +{ + return (INTERACTIVE && interactive_p (1)) ? Qt : Qnil; +} + + +/* Return 1 if function in which this appears was called using + call-interactively. EXCLUDE_SUBRS_P non-zero means always return 0 if the function called is a built-in. */ @@ -566,9 +590,6 @@ struct backtrace *btp; Lisp_Object fun; - if (!INTERACTIVE) - return 0; - btp = backtrace_list; /* If this isn't a byte-compiled function, there may be a frame at @@ -1975,7 +1996,7 @@ struct backtrace backtrace; struct gcpro gcpro1, gcpro2, gcpro3; - if (handling_signal) + if (handling_signal || INPUT_BLOCKED_P) abort (); if (SYMBOLP (form)) @@ -3449,6 +3470,7 @@ defsubr (&Scondition_case); defsubr (&Ssignal); defsubr (&Sinteractive_p); + defsubr (&Scalled_interactively_p); defsubr (&Scommandp); defsubr (&Sautoload); defsubr (&Seval);
--- a/src/fileio.c Fri Oct 29 00:25:02 2004 +0000 +++ b/src/fileio.c Thu Nov 04 08:55:40 2004 +0000 @@ -6237,7 +6237,8 @@ } if (!NILP(default_filename)) default_filename = Fexpand_file_name (default_filename, dir); - val = Fx_file_dialog (prompt, dir, default_filename, mustmatch); + val = Fx_file_dialog (prompt, dir, default_filename, mustmatch, + EQ (predicate, Qfile_directory_p) ? Qt : Qnil); add_to_history = 1; } else
--- a/src/fontset.c Fri Oct 29 00:25:02 2004 +0000 +++ b/src/fontset.c Thu Nov 04 08:55:40 2004 +0000 @@ -1076,7 +1076,7 @@ { if (*p0 == '-') ndashes++; - else if (*p0 == '*') + else if (*p0 == '*' && p0 > SDATA (pattern) && p0[-1] != '\\') nstars++; } @@ -1091,7 +1091,7 @@ *p1++ = '^'; for (p0 = (char *) SDATA (pattern); *p0; p0++) { - if (*p0 == '*') + if (*p0 == '*' && p0 > SDATA (pattern) && p0[-1] != '\\') { if (ndashes < 14) *p1++ = '.';
--- a/src/gtkutil.c Fri Oct 29 00:25:02 2004 +0000 +++ b/src/gtkutil.c Thu Nov 04 08:55:40 2004 +0000 @@ -1118,6 +1118,10 @@ } + +/*********************************************************************** + File dialog functions + ***********************************************************************/ enum { XG_FILE_NOT_DONE, @@ -1126,6 +1130,69 @@ XG_FILE_DESTROYED, }; +#ifdef HAVE_GTK_FILE_BOTH +static int use_old_gtk_file_dialog; +#endif + + +#ifdef HAVE_GTK_FILE_CHOOSER_DIALOG_NEW +/* Read a file name from the user using a file chooser dialog. + F is the current frame. + PROMPT is a prompt to show to the user. May not be NULL. + DEFAULT_FILENAME is a default selection to be displayed. May be NULL. + If MUSTMATCH_P is non-zero, the returned file name must be an existing + file. + + Returns a file name or NULL if no file was selected. + The returned string must be freed by the caller. */ + +static char * +xg_get_file_with_chooser (f, prompt, default_filename, mustmatch_p, only_dir_p) + FRAME_PTR f; + char *prompt; + char *default_filename; + int mustmatch_p, only_dir_p; +{ + GtkWidget *filewin; + GtkWindow *gwin = GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)); + + char *fn = 0; + GtkFileChooserAction action = (mustmatch_p ? + GTK_FILE_CHOOSER_ACTION_OPEN : + GTK_FILE_CHOOSER_ACTION_SAVE); + + if (only_dir_p) + action = GTK_FILE_CHOOSER_ACTION_SELECT_FOLDER; + + filewin = gtk_file_chooser_dialog_new (prompt, gwin, action, + GTK_STOCK_CANCEL, GTK_RESPONSE_CANCEL, + (mustmatch_p || only_dir_p ? + GTK_STOCK_OPEN : GTK_STOCK_OK), + GTK_RESPONSE_OK, + NULL); + + xg_set_screen (filewin, f); + gtk_widget_set_name (filewin, "emacs-filedialog"); + gtk_window_set_transient_for (GTK_WINDOW (filewin), gwin); + gtk_window_set_destroy_with_parent (GTK_WINDOW (filewin), TRUE); + + + if (default_filename) + gtk_file_chooser_set_filename (GTK_FILE_CHOOSER (filewin), + default_filename); + + gtk_widget_show (filewin); + + if (gtk_dialog_run (GTK_DIALOG (filewin)) == GTK_RESPONSE_OK) + fn = gtk_file_chooser_get_filename (GTK_FILE_CHOOSER (filewin)); + + gtk_widget_destroy (filewin); + + return fn; +} +#endif /* HAVE_GTK_FILE_CHOOSER_DIALOG_NEW */ + +#ifdef HAVE_GTK_FILE_SELECTION_NEW /* Callback function invoked when the Ok button is pressed in a file dialog. W is the file dialog widget, @@ -1167,7 +1234,7 @@ *(int*)arg = XG_FILE_DESTROYED; } -/* Read a file name from the user using a file dialog. +/* Read a file name from the user using a file selection dialog. F is the current frame. PROMPT is a prompt to show to the user. May not be NULL. DEFAULT_FILENAME is a default selection to be displayed. May be NULL. @@ -1177,12 +1244,13 @@ Returns a file name or NULL if no file was selected. The returned string must be freed by the caller. */ -char * -xg_get_file_name (f, prompt, default_filename, mustmatch_p) +static char * +xg_get_file_with_selection (f, prompt, default_filename, + mustmatch_p, only_dir_p) FRAME_PTR f; char *prompt; char *default_filename; - int mustmatch_p; + int mustmatch_p, only_dir_p; { GtkWidget *filewin; GtkFileSelection *filesel; @@ -1193,9 +1261,7 @@ filesel = GTK_FILE_SELECTION (filewin); xg_set_screen (filewin, f); - gtk_widget_set_name (filewin, "emacs-filedialog"); - gtk_window_set_transient_for (GTK_WINDOW (filewin), GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f))); gtk_window_set_destroy_with_parent (GTK_WINDOW (filewin), TRUE); @@ -1237,6 +1303,49 @@ return fn; } +#endif /* HAVE_GTK_FILE_SELECTION_NEW */ + +/* Read a file name from the user using a file dialog, either the old + file selection dialog, or the new file chooser dialog. Which to use + depends on what the GTK version used has, and what the value of + gtk-use-old-file-dialog. + F is the current frame. + PROMPT is a prompt to show to the user. May not be NULL. + DEFAULT_FILENAME is a default selection to be displayed. May be NULL. + If MUSTMATCH_P is non-zero, the returned file name must be an existing + file. + + Returns a file name or NULL if no file was selected. + The returned string must be freed by the caller. */ + +char * +xg_get_file_name (f, prompt, default_filename, mustmatch_p, only_dir_p) + FRAME_PTR f; + char *prompt; + char *default_filename; + int mustmatch_p, only_dir_p; +{ +#ifdef HAVE_GTK_FILE_BOTH + if (use_old_gtk_file_dialog) + return xg_get_file_with_selection (f, prompt, default_filename, + mustmatch_p, only_dir_p); + return xg_get_file_with_chooser (f, prompt, default_filename, + mustmatch_p, only_dir_p); + +#else /* not HAVE_GTK_FILE_BOTH */ + +#ifdef HAVE_GTK_FILE_SELECTION_DIALOG_NEW + return xg_get_file_with_selection (f, prompt, default_filename, + mustmatch_p, only_dir_p); +#endif +#ifdef HAVE_GTK_FILE_CHOOSER_DIALOG_NEW + return xg_get_file_with_chooser (f, prompt, default_filename, + mustmatch_p, only_dir_p); +#endif + +#endif /* HAVE_GTK_FILE_BOTH */ + return 0; +} /*********************************************************************** @@ -3429,6 +3538,14 @@ "gtk-key-theme-name", "Emacs", EMACS_CLASS); + +#ifdef HAVE_GTK_FILE_BOTH + DEFVAR_BOOL ("use-old-gtk-file-dialog", &use_old_gtk_file_dialog, + doc: /* *Non-nil means that the old GTK file selection dialog is used. + If nil the new GTK file chooser is used instead. To turn off + all file dialogs set the variable `use-file-dialog'. */); + use_old_gtk_file_dialog = 0; +#endif } #endif /* USE_GTK */
--- a/src/gtkutil.h Fri Oct 29 00:25:02 2004 +0000 +++ b/src/gtkutil.h Thu Nov 04 08:55:40 2004 +0000 @@ -132,7 +132,8 @@ extern char *xg_get_file_name P_ ((FRAME_PTR f, char *prompt, char *default_filename, - int mustmatch_p)); + int mustmatch_p, + int only_dir_p)); extern GtkWidget *xg_create_widget P_ ((char *type, char *name,
--- a/src/indent.c Fri Oct 29 00:25:02 2004 +0000 +++ b/src/indent.c Thu Nov 04 08:55:40 2004 +0000 @@ -1883,7 +1883,7 @@ struct position pos; /* vpos is cumulative vertical position, changed as from is changed */ register int vpos = 0; - Lisp_Object prevline; + int prevline; register int first; int from_byte; int lmargin = hscroll > 0 ? 1 - hscroll : 0; @@ -1917,23 +1917,21 @@ { Lisp_Object propval; - XSETFASTINT (prevline, find_next_newline_no_quit (from - 1, -1)); - while (XFASTINT (prevline) > BEGV + prevline = find_next_newline_no_quit (from - 1, -1); + while (prevline > BEGV && ((selective > 0 - && indented_beyond_p (XFASTINT (prevline), - CHAR_TO_BYTE (XFASTINT (prevline)), + && indented_beyond_p (prevline, + CHAR_TO_BYTE (prevline), (double) selective)) /* iftc */ - /* watch out for newlines with `invisible' property */ - || (propval = Fget_char_property (prevline, + /* Watch out for newlines with `invisible' property. + When moving upward, check the newline before. */ + || (propval = Fget_char_property (make_number (prevline - 1), Qinvisible, text_prop_object), TEXT_PROP_MEANS_INVISIBLE (propval)))) - XSETFASTINT (prevline, - find_next_newline_no_quit (XFASTINT (prevline) - 1, - -1)); - pos = *compute_motion (XFASTINT (prevline), 0, - lmargin + (XFASTINT (prevline) == BEG - ? start_hpos : 0), + prevline = find_next_newline_no_quit (prevline - 1, -1); + pos = *compute_motion (prevline, 0, + lmargin + (prevline == BEG ? start_hpos : 0), 0, from, /* Don't care for VPOS... */ @@ -1944,12 +1942,11 @@ /* This compensates for start_hpos so that a tab as first character still occupies 8 columns. */ - (XFASTINT (prevline) == BEG - ? -start_hpos : 0), + (prevline == BEG ? -start_hpos : 0), w); vpos -= pos.vpos; first = 0; - from = XFASTINT (prevline); + from = prevline; } /* If we made exactly the desired vertical distance, @@ -1977,21 +1974,21 @@ { Lisp_Object propval; - XSETFASTINT (prevline, find_next_newline_no_quit (from, -1)); - while (XFASTINT (prevline) > BEGV + prevline = find_next_newline_no_quit (from, -1); + while (prevline > BEGV && ((selective > 0 - && indented_beyond_p (XFASTINT (prevline), - CHAR_TO_BYTE (XFASTINT (prevline)), + && indented_beyond_p (prevline, + CHAR_TO_BYTE (prevline), (double) selective)) /* iftc */ - /* watch out for newlines with `invisible' property */ - || (propval = Fget_char_property (prevline, Qinvisible, + /* Watch out for newlines with `invisible' property. + When moving downward, check the newline after. */ + || (propval = Fget_char_property (make_number (prevline), + Qinvisible, text_prop_object), TEXT_PROP_MEANS_INVISIBLE (propval)))) - XSETFASTINT (prevline, - find_next_newline_no_quit (XFASTINT (prevline) - 1, - -1)); - pos = *compute_motion (XFASTINT (prevline), 0, - lmargin + (XFASTINT (prevline) == BEG + prevline = find_next_newline_no_quit (prevline - 1, -1); + pos = *compute_motion (prevline, 0, + lmargin + (prevline == BEG ? start_hpos : 0), 0, from, @@ -2000,7 +1997,7 @@ /* ... nor HPOS. */ 1 << (BITS_PER_SHORT - 1), -1, hscroll, - (XFASTINT (prevline) == BEG ? -start_hpos : 0), + (prevline == BEG ? -start_hpos : 0), w); did_motion = 1; }
--- a/src/insdel.c Fri Oct 29 00:25:02 2004 +0000 +++ b/src/insdel.c Thu Nov 04 08:55:40 2004 +0000 @@ -1497,7 +1497,7 @@ Z -= len; Z_BYTE -= len_byte; adjust_after_replace (from, from_byte, Qnil, newlen, len_byte); } - + /* Replace the text from character positions FROM to TO with NEW, If PREPARE is nonzero, call prepare_to_modify_buffer. If INHERIT, the newly inserted text should inherit text properties @@ -1674,6 +1674,122 @@ update_compositions (from, GPT, CHECK_BORDER); } +/* Replace the text from character positions FROM to TO with + the text in INS of length INSCHARS. + Keep the text properties that applied to the old characters + (extending them to all the new chars if there are more new chars). + + Note that this does not yet handle markers quite right. + + If MARKERS is nonzero, relocate markers. + + Unlike most functions at this level, never call + prepare_to_modify_buffer and never call signal_after_change. */ + +void +replace_range_2 (from, from_byte, to, to_byte, ins, inschars, insbytes, markers) + int from, from_byte, to, to_byte; + char *ins; + int inschars, insbytes, markers; +{ + int nbytes_del, nchars_del; + Lisp_Object temp; + + CHECK_MARKERS (); + + nchars_del = to - from; + nbytes_del = to_byte - from_byte; + + if (nbytes_del <= 0 && insbytes == 0) + return; + + /* Make sure point-max won't overflow after this insertion. */ + XSETINT (temp, Z_BYTE - nbytes_del + insbytes); + if (Z_BYTE - nbytes_del + insbytes != XINT (temp)) + error ("Maximum buffer size exceeded"); + + /* Make sure the gap is somewhere in or next to what we are deleting. */ + if (from > GPT) + gap_right (from, from_byte); + if (to < GPT) + gap_left (to, to_byte, 0); + + GAP_SIZE += nbytes_del; + ZV -= nchars_del; + Z -= nchars_del; + ZV_BYTE -= nbytes_del; + Z_BYTE -= nbytes_del; + GPT = from; + GPT_BYTE = from_byte; + if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */ + + if (GPT_BYTE < GPT) + abort (); + + if (GPT - BEG < BEG_UNCHANGED) + BEG_UNCHANGED = GPT - BEG; + if (Z - GPT < END_UNCHANGED) + END_UNCHANGED = Z - GPT; + + if (GAP_SIZE < insbytes) + make_gap (insbytes - GAP_SIZE); + + /* Copy the replacement text into the buffer. */ + bcopy (ins, GPT_ADDR, insbytes); + +#ifdef BYTE_COMBINING_DEBUG + /* We have copied text into the gap, but we have not marked + it as part of the buffer. So we can use the old FROM and FROM_BYTE + here, for both the previous text and the following text. + Meanwhile, GPT_ADDR does point to + the text that has been stored by copy_text. */ + if (count_combining_before (GPT_ADDR, insbytes, from, from_byte) + || count_combining_after (GPT_ADDR, insbytes, from, from_byte)) + abort (); +#endif + + GAP_SIZE -= insbytes; + GPT += inschars; + ZV += inschars; + Z += inschars; + GPT_BYTE += insbytes; + ZV_BYTE += insbytes; + Z_BYTE += insbytes; + if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */ + + if (GPT_BYTE < GPT) + abort (); + + /* Adjust the overlay center as needed. This must be done after + adjusting the markers that bound the overlays. */ + if (nchars_del != inschars) + { + adjust_overlays_for_insert (from, inschars); + adjust_overlays_for_delete (from + inschars, nchars_del); + } + + /* Adjust markers for the deletion and the insertion. */ + if (markers + && ! (nchars_del == 1 && inschars == 1)) + adjust_markers_for_replace (from, from_byte, nchars_del, nbytes_del, + inschars, insbytes); + + offset_intervals (current_buffer, from, inschars - nchars_del); + + /* Relocate point as if it were a marker. */ + if (from < PT && nchars_del != inschars) + adjust_point ((from + inschars - (PT < to ? PT : to)), + (from_byte + insbytes + - (PT_BYTE < to_byte ? PT_BYTE : to_byte))); + + if (insbytes == 0) + evaporate_overlays (from); + + CHECK_MARKERS (); + + MODIFF++; +} + /* Delete characters in current buffer from FROM up to (but not including) TO. If TO comes before FROM, we delete nothing. */
--- a/src/lisp.h Fri Oct 29 00:25:02 2004 +0000 +++ b/src/lisp.h Thu Nov 04 08:55:40 2004 +0000 @@ -3165,7 +3165,7 @@ #ifdef HAVE_WINDOW_SYSTEM /* Defined in xfns.c, w32fns.c, or macfns.c */ EXFUN (Fxw_display_color_p, 1); -EXFUN (Fx_file_dialog, 4); +EXFUN (Fx_file_dialog, 5); #endif /* HAVE_WINDOW_SYSTEM */ /* Defined in xsmfns.c */
--- a/src/macfns.c Fri Oct 29 00:25:02 2004 +0000 +++ b/src/macfns.c Thu Nov 04 08:55:40 2004 +0000 @@ -4216,22 +4216,23 @@ extern Lisp_Object Qfile_name_history; -DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0, +DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0, doc: /* Read file name, prompting with PROMPT in directory DIR. Use a file selection dialog. Select DEFAULT-FILENAME in the dialog's file selection box, if -specified. Ensure that file exists if MUSTMATCH is non-nil. */) - (prompt, dir, default_filename, mustmatch) - Lisp_Object prompt, dir, default_filename, mustmatch; +specified. Ensure that file exists if MUSTMATCH is non-nil. +If ONLY-DIR-P is non-nil, the user can only select directories. */) + (prompt, dir, default_filename, mustmatch, only_dir_p) + Lisp_Object prompt, dir, default_filename, mustmatch, only_dir_p; { struct frame *f = SELECTED_FRAME (); Lisp_Object file = Qnil; int count = SPECPDL_INDEX (); - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6; char filename[1001]; int default_filter_index = 1; /* 1: All Files, 2: Directories only */ - GCPRO5 (prompt, dir, default_filename, mustmatch, file); + GCPRO6 (prompt, dir, default_filename, mustmatch, file, only_dir_p); CHECK_STRING (prompt); CHECK_STRING (dir); @@ -4245,7 +4246,8 @@ NavDialogRef dialogRef; NavTypeListHandle fileTypes = NULL; NavUserAction userAction; - CFStringRef message=NULL, client=NULL, saveName = NULL; + CFStringRef message=NULL, client=NULL, saveName = NULL, ok = NULL; + CFStringRef title = NULL; BLOCK_INPUT; /* No need for a callback function because we are modal */ @@ -4268,13 +4270,19 @@ options.clientName = client; */ - /* Do Dired hack copied from w32fns.c */ - if (!NILP(prompt) && strncmp (SDATA(prompt), "Dired", 5) == 0) + if (!NILP (only_dir_p)) status = NavCreateChooseFolderDialog(&options, NULL, NULL, NULL, &dialogRef); else if (NILP (mustmatch)) { /* This is a save dialog */ + ok = CFStringCreateWithCString (NULL, "Ok", kCFStringEncodingUTF8); + title = CFStringCreateWithCString (NULL, "Enter name", + kCFStringEncodingUTF8); + options.optionFlags |= kNavDontConfirmReplacement; + options.actionButtonLabel = ok; + options.windowTitle = title; + if (!NILP(default_filename)) { saveName = CFStringCreateWithCString(NULL, SDATA(default_filename), @@ -4282,20 +4290,10 @@ options.saveFileName = saveName; options.optionFlags |= kNavSelectDefaultLocation; } - /* MAC_TODO: Find a better way to determine if this is a save - or load dialog than comparing dir with default_filename */ - if (EQ(dir, default_filename)) - { - status = NavCreateChooseFileDialog(&options, fileTypes, - NULL, NULL, NULL, NULL, - &dialogRef); - } - else { status = NavCreatePutFileDialog(&options, 'TEXT', kNavGenericSignature, NULL, NULL, &dialogRef); } - } else { /* This is an open dialog*/ @@ -4324,6 +4322,8 @@ if (saveName) CFRelease(saveName); if (client) CFRelease(client); if (message) CFRelease(message); + if (ok) CFRelease(ok); + if (title) CFRelease(title); if (status == noErr) { userAction = NavDialogGetUserAction(dialogRef);
--- a/src/macterm.c Fri Oct 29 00:25:02 2004 +0000 +++ b/src/macterm.c Thu Nov 04 08:55:40 2004 +0000 @@ -230,6 +230,10 @@ extern int extra_keyboard_modifiers; +/* The keysyms to use for the various modifiers. */ + +static Lisp_Object Qalt, Qhyper, Qsuper, Qmodifier_value; + static Lisp_Object Qvendor_specific_keysyms; #if 0 @@ -7014,6 +7018,9 @@ /* True if using command key as meta key. */ Lisp_Object Vmac_command_key_is_meta; +/* Modifier associated with the option key, or nil for normal behavior. */ +Lisp_Object Vmac_option_modifier; + /* True if the ctrl and meta keys should be reversed. */ Lisp_Object Vmac_reverse_ctrl_meta; @@ -7095,6 +7102,12 @@ result |= meta_modifier; if (NILP (Vmac_command_key_is_meta) && (mods & macAltKey)) result |= alt_modifier; + if (!NILP (Vmac_option_modifier) && (mods & optionKey)) { + Lisp_Object val = Fget(Vmac_option_modifier, Qmodifier_value); + if (!NILP(val)) + result |= XUINT(val); + } + return result; } @@ -8575,7 +8588,18 @@ unsigned long some_state = 0; inev.code = KeyTranslate (kchr_ptr, new_keycode, &some_state) & 0xff; - } + } else if (!NILP(Vmac_option_modifier) && (er.modifiers & optionKey)) + { + /* When using the option key as an emacs modifier, convert + the pressed key code back to one without the Mac option + modifier applied. */ + int new_modifiers = er.modifiers & ~optionKey; + int new_keycode = keycode | new_modifiers; + Ptr kchr_ptr = (Ptr) GetScriptManagerVariable (smKCHRCache); + unsigned long some_state = 0; + inev.code = KeyTranslate (kchr_ptr, new_keycode, + &some_state) & 0xff; + } else inev.code = er.message & charCodeMask; inev.kind = ASCII_KEYSTROKE_EVENT; @@ -9274,6 +9298,14 @@ x_error_message_string = Qnil; #endif + Qmodifier_value = intern ("modifier-value"); + Qalt = intern ("alt"); + Fput (Qalt, Qmodifier_value, make_number (alt_modifier)); + Qhyper = intern ("hyper"); + Fput (Qhyper, Qmodifier_value, make_number (hyper_modifier)); + Qsuper = intern ("super"); + Fput (Qsuper, Qmodifier_value, make_number (super_modifier)); + Fprovide (intern ("mac-carbon"), Qnil); staticpro (&Qreverse); @@ -9330,6 +9362,12 @@ Otherwise the option key is used. */); Vmac_command_key_is_meta = Qt; + DEFVAR_LISP ("mac-option-modifier", &Vmac_option_modifier, + doc: /* Modifier to use for the Mac alt/option key. The value can +be alt, hyper, or super for the respective modifier. If the value is +nil then the key will act as the normal Mac option modifier. */); + Vmac_option_modifier = Qnil; + DEFVAR_LISP ("mac-reverse-ctrl-meta", &Vmac_reverse_ctrl_meta, doc: /* Non-nil means that the control and meta keys are reversed. This is useful for non-standard keyboard layouts. */);
--- a/src/process.c Fri Oct 29 00:25:02 2004 +0000 +++ b/src/process.c Thu Nov 04 08:55:40 2004 +0000 @@ -310,6 +310,7 @@ static SELECT_TYPE non_process_wait_mask; +#ifdef NON_BLOCKING_CONNECT /* Mask of bits indicating the descriptors that we wait for connect to complete on. Once they complete, they are removed from this mask and added to the input_wait_mask and non_keyboard_wait_mask. */ @@ -319,6 +320,11 @@ /* Number of bits set in connect_wait_mask. */ static int num_pending_connects; +#define IF_NON_BLOCKING_CONNECT(s) s +#else +#define IF_NON_BLOCKING_CONNECT(s) +#endif + /* The largest descriptor currently in use for a process object. */ static int max_process_desc; @@ -3673,12 +3679,14 @@ chan_process[inchannel] = Qnil; FD_CLR (inchannel, &input_wait_mask); FD_CLR (inchannel, &non_keyboard_wait_mask); +#ifdef NON_BLOCKING_CONNECT if (FD_ISSET (inchannel, &connect_wait_mask)) { FD_CLR (inchannel, &connect_wait_mask); if (--num_pending_connects < 0) abort (); } +#endif if (inchannel == max_process_desc) { int i; @@ -4039,8 +4047,11 @@ { register int channel, nfds; SELECT_TYPE Available; +#ifdef NON_BLOCKING_CONNECT SELECT_TYPE Connecting; - int check_connect, check_delay, no_avail; + int check_connect; +#endif + int check_delay, no_avail; int xerrno; Lisp_Object proc; EMACS_TIME timeout, end_time; @@ -4051,7 +4062,9 @@ int saved_waiting_for_user_input_p = waiting_for_user_input_p; FD_ZERO (&Available); +#ifdef NON_BLOCKING_CONNECT FD_ZERO (&Connecting); +#endif /* If wait_proc is a process to watch, set wait_channel accordingly. */ if (wait_proc != NULL) @@ -4188,7 +4201,10 @@ timeout to get our attention. */ if (update_tick != process_tick && do_display) { - SELECT_TYPE Atemp, Ctemp; + SELECT_TYPE Atemp; +#ifdef NON_BLOCKING_CONNECT + SELECT_TYPE Ctemp; +#endif Atemp = input_wait_mask; #if 0 @@ -4200,11 +4216,16 @@ */ FD_CLR (0, &Atemp); #endif - Ctemp = connect_wait_mask; + IF_NON_BLOCKING_CONNECT (Ctemp = connect_wait_mask); + EMACS_SET_SECS_USECS (timeout, 0, 0); if ((select (max (max_process_desc, max_keyboard_desc) + 1, &Atemp, +#ifdef NON_BLOCKING_CONNECT (num_pending_connects > 0 ? &Ctemp : (SELECT_TYPE *)0), +#else + (SELECT_TYPE *)0, +#endif (SELECT_TYPE *)0, &timeout) <= 0)) { @@ -4264,12 +4285,14 @@ if (XINT (wait_proc->infd) < 0) /* Terminated */ break; FD_SET (XINT (wait_proc->infd), &Available); - check_connect = check_delay = 0; + check_delay = 0; + IF_NON_BLOCKING_CONNECT (check_connect = 0); } else if (!NILP (wait_for_cell)) { Available = non_process_wait_mask; - check_connect = check_delay = 0; + check_delay = 0; + IF_NON_BLOCKING_CONNECT (check_connect = 0); } else { @@ -4277,7 +4300,7 @@ Available = non_keyboard_wait_mask; else Available = input_wait_mask; - check_connect = (num_pending_connects > 0); + IF_NON_BLOCKING_CONNECT (check_connect = (num_pending_connects > 0)); check_delay = wait_channel >= 0 ? 0 : process_output_delay_count; } @@ -4302,8 +4325,10 @@ } else { +#ifdef NON_BLOCKING_CONNECT if (check_connect) Connecting = connect_wait_mask; +#endif #ifdef ADAPTIVE_READ_BUFFERING if (process_output_skip && check_delay > 0) @@ -4334,7 +4359,11 @@ nfds = select (max (max_process_desc, max_keyboard_desc) + 1, &Available, +#ifdef NON_BLOCKING_CONNECT (check_connect ? &Connecting : (SELECT_TYPE *)0), +#else + (SELECT_TYPE *)0, +#endif (SELECT_TYPE *)0, &timeout); } @@ -4390,7 +4419,7 @@ if (no_avail) { FD_ZERO (&Available); - check_connect = 0; + IF_NON_BLOCKING_CONNECT (check_connect = 0); } #if defined(sun) && !defined(USG5_4) @@ -6626,6 +6655,11 @@ FD_ZERO (&non_process_wait_mask); max_process_desc = 0; +#ifdef NON_BLOCKING_CONNECT + FD_ZERO (&connect_wait_mask); + num_pending_connects = 0; +#endif + #ifdef ADAPTIVE_READ_BUFFERING process_output_delay_count = 0; process_output_skip = 0;
--- a/src/search.c Fri Oct 29 00:25:02 2004 +0000 +++ b/src/search.c Thu Nov 04 08:55:40 2004 +0000 @@ -521,7 +521,7 @@ direction indicated by COUNT. If we find COUNT instances, set *SHORTAGE to zero, and return the - position after the COUNTth match. Note that for reverse motion + position past the COUNTth match. Note that for reverse motion this is not the same as the usual convention for Emacs motion commands. If we don't find COUNT instances before reaching END, set *SHORTAGE
--- a/src/syntax.c Fri Oct 29 00:25:02 2004 +0000 +++ b/src/syntax.c Thu Nov 04 08:55:40 2004 +0000 @@ -3023,12 +3023,23 @@ INC_FROM; code = prev_from_syntax & 0xff; - if (code == Scomment) + if (from < end + && SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax) + && (c1 = FETCH_CHAR (from_byte), + SYNTAX_COMSTART_SECOND (c1))) + /* Duplicate code to avoid a complex if-expression + which causes trouble for the SGI compiler. */ { - state.comstyle = SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax); - state.incomment = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) ? - 1 : -1); + /* Record the comment style we have entered so that only + the comment-end sequence of the same style actually + terminates the comment section. */ + state.comstyle = SYNTAX_COMMENT_STYLE (c1); + comnested = SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax); + comnested = comnested || SYNTAX_COMMENT_NESTED (c1); + state.incomment = comnested ? 1 : -1; state.comstr_start = prev_from; + INC_FROM; + code = Scomment; } else if (code == Scomment_fence) { @@ -3040,24 +3051,13 @@ state.comstr_start = prev_from; code = Scomment; } - else if (from < end) - if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax)) - if (c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte), - SYNTAX_COMSTART_SECOND (c1)) - /* Duplicate code to avoid a complex if-expression - which causes trouble for the SGI compiler. */ - { - /* Record the comment style we have entered so that only - the comment-end sequence of the same style actually - terminates the comment section. */ - state.comstyle = SYNTAX_COMMENT_STYLE (c1); - comnested = SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax); - comnested = comnested || SYNTAX_COMMENT_NESTED (c1); - state.incomment = comnested ? 1 : -1; - state.comstr_start = prev_from; - INC_FROM; - code = Scomment; - } + else if (code == Scomment) + { + state.comstyle = SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax); + state.incomment = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) ? + 1 : -1); + state.comstr_start = prev_from; + } if (SYNTAX_FLAGS_PREFIX (prev_from_syntax)) continue;
--- a/src/w32fns.c Fri Oct 29 00:25:02 2004 +0000 +++ b/src/w32fns.c Thu Nov 04 08:55:40 2004 +0000 @@ -5667,14 +5667,12 @@ char * fontname; char * pattern; { + char *ptr; char *font_name_copy; - char *ptr; - Lisp_Object encoded_font_name; char *regex = alloca (strlen (pattern) * 2 + 3); - /* Convert fontname to unibyte for match. */ - encoded_font_name = string_make_unibyte (build_string (fontname)); - font_name_copy = SDATA (encoded_font_name); + font_name_copy = alloca (strlen (fontname) + 1); + strcpy (font_name_copy, fontname); ptr = regex; *ptr++ = '^'; @@ -5712,8 +5710,8 @@ return FALSE; } - return (fast_c_string_match_ignore_case (build_string (regex), - font_name_copy) >= 0); + return (fast_string_match_ignore_case (build_string (regex), + build_string(font_name_copy)) >= 0); } /* Callback functions, and a structure holding info they need, for @@ -6459,7 +6457,7 @@ } DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0, - doc: /* Returns the vendor ID string of the W32 system (Microsoft). + doc: /* Returns the "vendor ID" string of the W32 system (Microsoft). The optional argument DISPLAY specifies which display to ask about. DISPLAY should be either a frame or a display name (a string). If omitted or nil, that stands for the selected frame's display. */) @@ -6472,7 +6470,7 @@ DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0, doc: /* Returns the version numbers of the server of DISPLAY. The value is a list of three integers: the major and minor -version numbers, and the vendor-specific release +version numbers of the X Protocol in use, and the distributor-specific release number. See also the function `x-server-vendor'. The optional argument DISPLAY specifies which display to ask about. @@ -7803,23 +7801,24 @@ return 0; } -DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0, +DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0, doc: /* Read file name, prompting with PROMPT in directory DIR. Use a file selection dialog. Select DEFAULT-FILENAME in the dialog's file selection box, if -specified. Ensure that file exists if MUSTMATCH is non-nil. */) - (prompt, dir, default_filename, mustmatch) - Lisp_Object prompt, dir, default_filename, mustmatch; +specified. Ensure that file exists if MUSTMATCH is non-nil. +If ONLY-DIR-P is non-nil, the user can only select directories. */) + (prompt, dir, default_filename, mustmatch, only_dir_p) + Lisp_Object prompt, dir, default_filename, mustmatch, only_dir_p; { struct frame *f = SELECTED_FRAME (); Lisp_Object file = Qnil; int count = SPECPDL_INDEX (); - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6; char filename[MAX_PATH + 1]; char init_dir[MAX_PATH + 1]; int default_filter_index = 1; /* 1: All Files, 2: Directories only */ - GCPRO5 (prompt, dir, default_filename, mustmatch, file); + GCPRO6 (prompt, dir, default_filename, mustmatch, only_dir_p, file); CHECK_STRING (prompt); CHECK_STRING (dir); @@ -7867,10 +7866,7 @@ file_details.lpstrInitialDir = init_dir; file_details.lpstrTitle = SDATA (prompt); - /* If prompt starts with Dired, default to directories only. */ - /* A bit hacky, but there doesn't seem to be a better way to - DTRT for dired. */ - if (strncmp (file_details.lpstrTitle, "Dired", 5) == 0) + if (! NILP (only_dir_p)) default_filter_index = 2; file_details.nFilterIndex = default_filter_index;
--- a/src/w32term.c Fri Oct 29 00:25:02 2004 +0000 +++ b/src/w32term.c Thu Nov 04 08:55:40 2004 +0000 @@ -2914,9 +2914,13 @@ /* If the dirty region is not what we expected, redraw the entire frame. */ if (!EqualRgn (combined, expect_dirty)) SET_FRAME_GARBAGED (f); + + DeleteObject (dirty); + DeleteObject (combined); } UNBLOCK_INPUT; + DeleteObject (expect_dirty); }
--- a/src/window.c Fri Oct 29 00:25:02 2004 +0000 +++ b/src/window.c Thu Nov 04 08:55:40 2004 +0000 @@ -4625,17 +4625,25 @@ w->force_start = Qt; } + /* The rest of this function uses current_y in a nonstandard way, + not including the height of the header line if any. */ it.current_y = it.vpos = 0; - /* Preserve the screen position if we must. */ + /* Preserve the screen position if we should. */ if (preserve_y >= 0) { + /* If we have a header line, take account of it. */ + if (WINDOW_WANTS_HEADER_LINE_P (w)) + preserve_y -= CURRENT_HEADER_LINE_HEIGHT (w); + move_it_to (&it, -1, -1, preserve_y, -1, MOVE_TO_Y); SET_PT_BOTH (IT_CHARPOS (it), IT_BYTEPOS (it)); } else { - /* Move PT out of scroll margins. */ + /* Move PT out of scroll margins. + This code wants current_y to be zero at the window start position + even if there is a header line. */ this_scroll_margin = max (0, scroll_margin); this_scroll_margin = min (this_scroll_margin, XFASTINT (w->total_lines) / 4); this_scroll_margin *= FRAME_LINE_HEIGHT (it.f); @@ -4990,17 +4998,17 @@ return Qnil; } -DEFUN ("scroll-left", Fscroll_left, Sscroll_left, 0, 1, "P", +DEFUN ("scroll-left", Fscroll_left, Sscroll_left, 0, 2, "P\np", doc: /* Scroll selected window display ARG columns left. Default for ARG is window width minus 2. Value is the total amount of leftward horizontal scrolling in effect after the change. -If `automatic-hscrolling' is non-nil, the argument ARG modifies -a lower bound for automatic scrolling, i.e. automatic scrolling +If SET_MINIMUM is non-nil, the new scroll amount becomes the +lower bound for automatic scrolling, i.e. automatic scrolling will not scroll a window to a column less than the value returned -by this function. */) - (arg) - register Lisp_Object arg; +by this function. This happens in an interactive call. */) + (arg, set_minimum) + register Lisp_Object arg, set_minimum; { Lisp_Object result; int hscroll; @@ -5014,23 +5022,23 @@ hscroll = XINT (w->hscroll) + XINT (arg); result = Fset_window_hscroll (selected_window, make_number (hscroll)); - if (interactive_p (0)) + if (!NILP (set_minimum)) w->min_hscroll = w->hscroll; return result; } -DEFUN ("scroll-right", Fscroll_right, Sscroll_right, 0, 1, "P", +DEFUN ("scroll-right", Fscroll_right, Sscroll_right, 0, 2, "P\np", doc: /* Scroll selected window display ARG columns right. Default for ARG is window width minus 2. Value is the total amount of leftward horizontal scrolling in effect after the change. -If `automatic-hscrolling' is non-nil, the argument ARG modifies -a lower bound for automatic scrolling, i.e. automatic scrolling +If SET_MINIMUM is non-nil, the new scroll amount becomes the +lower bound for automatic scrolling, i.e. automatic scrolling will not scroll a window to a column less than the value returned -by this function. */) - (arg) - register Lisp_Object arg; +by this function. This happens in an interactive call. */) + (arg, set_minimum) + register Lisp_Object arg, set_minimum; { Lisp_Object result; int hscroll; @@ -5044,7 +5052,7 @@ hscroll = XINT (w->hscroll) - XINT (arg); result = Fset_window_hscroll (selected_window, make_number (hscroll)); - if (interactive_p (0)) + if (!NILP (set_minimum)) w->min_hscroll = w->hscroll; return result;
--- a/src/xdisp.c Fri Oct 29 00:25:02 2004 +0000 +++ b/src/xdisp.c Thu Nov 04 08:55:40 2004 +0000 @@ -4651,7 +4651,8 @@ { Lisp_Object prop; - prop = Fget_char_property (make_number (IT_CHARPOS (*it)), + /* Check the newline before point for invisibility. */ + prop = Fget_char_property (make_number (IT_CHARPOS (*it) - 1), Qinvisible, it->window); if (TEXT_PROP_MEANS_INVISIBLE (prop)) visible_p = 0; @@ -4984,8 +4985,11 @@ If it->multibyte_p is zero, eight-bit characters that don't have corresponding multibyte char code are also translated to octal form. */ - else if ((it->c < ' ' ? (it->area != TEXT_AREA - || (it->c != '\n' && it->c != '\t')) + else if ((it->c < ' ' + ? (it->area != TEXT_AREA + /* In mode line, treat \n, \t like other crl chars. */ + || (it->glyph_row && it->glyph_row->mode_line_p) + || (it->c != '\n' && it->c != '\t')) : it->multibyte_p ? !CHAR_PRINTABLE_P (it->c) : (it->c >= 127 && (! unibyte_display_via_language_environment @@ -8525,7 +8529,8 @@ { struct buffer *prev = current_buffer; int count = SPECPDL_INDEX (); - Lisp_Object old_tool_bar; + Lisp_Object new_tool_bar; + int new_n_tool_bar; struct gcpro gcpro1; /* Set current_buffer to the buffer of the selected @@ -8544,18 +8549,24 @@ specbind (Qoverriding_local_map, Qnil); } - old_tool_bar = f->tool_bar_items; - GCPRO1 (old_tool_bar); + GCPRO1 (new_tool_bar); /* Build desired tool-bar items from keymaps. */ - BLOCK_INPUT; - f->tool_bar_items - = tool_bar_items (f->tool_bar_items, &f->n_tool_bar_items); - UNBLOCK_INPUT; + new_tool_bar = tool_bar_items (Fcopy_sequence (f->tool_bar_items), + &new_n_tool_bar); /* Redisplay the tool-bar if we changed it. */ - if (! NILP (Fequal (old_tool_bar, f->tool_bar_items))) - w->update_mode_line = Qt; + if (NILP (Fequal (new_tool_bar, f->tool_bar_items))) + { + /* Redisplay that happens asynchronously due to an expose event + may access f->tool_bar_items. Make sure we update both + variables within BLOCK_INPUT so no such event interrupts. */ + BLOCK_INPUT; + f->tool_bar_items = new_tool_bar; + f->n_tool_bar_items = new_n_tool_bar; + w->update_mode_line = Qt; + UNBLOCK_INPUT; + } UNGCPRO;
--- a/src/xfns.c Fri Oct 29 00:25:02 2004 +0000 +++ b/src/xfns.c Thu Nov 04 08:55:40 2004 +0000 @@ -3483,7 +3483,9 @@ } DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0, - doc: /* Returns the vendor ID string of the X server of display DISPLAY. + doc: /* Returns the "vendor ID" string of the X server of display DISPLAY. +\(Labelling every distributor as a "vendor" embodies the false assumption +that operating systems cannot be developed and distributed noncommercially.) The optional argument DISPLAY specifies which display to ask about. DISPLAY should be either a frame or a display name (a string). If omitted or nil, that stands for the selected frame's display. */) @@ -3500,7 +3502,7 @@ DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0, doc: /* Returns the version numbers of the X server of display DISPLAY. The value is a list of three integers: the major and minor -version numbers of the X Protocol in use, and the vendor-specific release +version numbers of the X Protocol in use, and the distributor-specific release number. See also the function `x-server-vendor'. The optional argument DISPLAY specifies which display to ask about. @@ -5088,27 +5090,26 @@ } -DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0, +DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0, doc: /* Read file name, prompting with PROMPT in directory DIR. -Use a file selection dialog. -Select DEFAULT-FILENAME in the dialog's file selection box, if -specified. Don't let the user enter a file name in the file -selection dialog's entry field, if MUSTMATCH is non-nil. */) - (prompt, dir, default_filename, mustmatch) - Lisp_Object prompt, dir, default_filename, mustmatch; +Use a file selection dialog. Select DEFAULT-FILENAME in the dialog's file +selection box, if specified. If MUSTMATCH is non-nil, the returned file +or directory must exist. ONLY-DIR-P is ignored." */) + (prompt, dir, default_filename, mustmatch, only_dir_p) + Lisp_Object prompt, dir, default_filename, mustmatch, only_dir_p; { int result; struct frame *f = SELECTED_FRAME (); Lisp_Object file = Qnil; - Widget dialog, text, list, help; + Widget dialog, text, help; Arg al[10]; int ac = 0; extern XtAppContext Xt_app_con; XmString dir_xmstring, pattern_xmstring; int count = SPECPDL_INDEX (); - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; - - GCPRO5 (prompt, dir, default_filename, mustmatch, file); + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6; + + GCPRO6 (prompt, dir, default_filename, mustmatch, only_dir_p, file); CHECK_STRING (prompt); CHECK_STRING (dir); @@ -5141,9 +5142,9 @@ XtAddCallback (dialog, XmNunmapCallback, file_dialog_unmap_cb, (XtPointer) &result); - /* Disable the help button since we can't display help. */ + /* Remove the help button since we can't display help. */ help = XmFileSelectionBoxGetChild (dialog, XmDIALOG_HELP_BUTTON); - XtSetSensitive (help, False); + XtUnmanageChild (help); /* Mark OK button as default. */ XtVaSetValues (XmFileSelectionBoxGetChild (dialog, XmDIALOG_OK_BUTTON), @@ -5165,30 +5166,30 @@ /* Manage the dialog, so that list boxes get filled. */ XtManageChild (dialog); - /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME - must include the path for this to work. */ - list = XmFileSelectionBoxGetChild (dialog, XmDIALOG_LIST); if (STRINGP (default_filename)) { XmString default_xmstring; - int item_pos; - - default_xmstring - = XmStringCreateLocalized (SDATA (default_filename)); - - if (!XmListItemExists (list, default_xmstring)) - { - /* Add a new item if DEFAULT_FILENAME is not in the list. */ - XmListAddItem (list, default_xmstring, 0); - item_pos = 0; - } - else - item_pos = XmListItemPos (list, default_xmstring); + Widget wtext = XmFileSelectionBoxGetChild (dialog, XmDIALOG_TEXT); + Widget list = XmFileSelectionBoxGetChild (dialog, XmDIALOG_LIST); + + XmTextPosition last_pos = XmTextFieldGetLastPosition (wtext); + XmTextFieldReplace (wtext, 0, last_pos, + (SDATA (Ffile_name_nondirectory (default_filename)))); + + /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME + must include the path for this to work. */ + + default_xmstring = XmStringCreateLocalized (SDATA (default_filename)); + + if (XmListItemExists (list, default_xmstring)) + { + int item_pos = XmListItemPos (list, default_xmstring); + /* Select the item and scroll it into view. */ + XmListSelectPos (list, item_pos, True); + XmListSetPos (list, item_pos); + } + XmStringFree (default_xmstring); - - /* Select the item and scroll it into view. */ - XmListSelectPos (list, item_pos, True); - XmListSetPos (list, item_pos); } /* Process events until the user presses Cancel or OK. */ @@ -5232,23 +5233,23 @@ #ifdef USE_GTK -DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0, - "Read file name, prompting with PROMPT in directory DIR.\n\ -Use a file selection dialog.\n\ -Select DEFAULT-FILENAME in the dialog's file selection box, if\n\ -specified. Don't let the user enter a file name in the file\n\ -selection dialog's entry field, if MUSTMATCH is non-nil.") - (prompt, dir, default_filename, mustmatch) - Lisp_Object prompt, dir, default_filename, mustmatch; +DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0, + doc: /* Read file name, prompting with PROMPT in directory DIR. +Use a file selection dialog. Select DEFAULT-FILENAME in the dialog's file +selection box, if specified. If MUSTMATCH is non-nil, the returned file +or directory must exist. If ONLY-DIR-P is non-nil, the user can only select +directories. */) + (prompt, dir, default_filename, mustmatch, only_dir_p) + Lisp_Object prompt, dir, default_filename, mustmatch, only_dir_p; { FRAME_PTR f = SELECTED_FRAME (); char *fn; Lisp_Object file = Qnil; int count = specpdl_ptr - specpdl; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6; char *cdef_file; - GCPRO5 (prompt, dir, default_filename, mustmatch, file); + GCPRO6 (prompt, dir, default_filename, mustmatch, only_dir_p, file); CHECK_STRING (prompt); CHECK_STRING (dir); @@ -5262,7 +5263,9 @@ else cdef_file = SDATA (dir); - fn = xg_get_file_name (f, SDATA (prompt), cdef_file, ! NILP (mustmatch)); + fn = xg_get_file_name (f, SDATA (prompt), cdef_file, + ! NILP (mustmatch), + ! NILP (only_dir_p)); if (fn) {
--- a/src/xmenu.c Fri Oct 29 00:25:02 2004 +0000 +++ b/src/xmenu.c Thu Nov 04 08:55:40 2004 +0000 @@ -110,11 +110,12 @@ extern Lisp_Object Qmenu_bar_update_hook; #ifdef USE_X_TOOLKIT -extern void set_frame_menubar (); +extern void set_frame_menubar P_ ((FRAME_PTR, int, int)); extern XtAppContext Xt_app_con; -static Lisp_Object xdialog_show (); -static void popup_get_selection (); +static Lisp_Object xdialog_show P_ ((FRAME_PTR, int, Lisp_Object, char **)); +static void popup_get_selection P_ ((XEvent *, struct x_display_info *, + LWLIB_ID, int)); /* Define HAVE_BOXES if menus can handle radio and toggle buttons. */ @@ -124,8 +125,8 @@ #ifdef USE_GTK #include "gtkutil.h" #define HAVE_BOXES 1 -extern void set_frame_menubar (); -static Lisp_Object xdialog_show (); +extern void set_frame_menubar P_ ((FRAME_PTR, int, int)); +static Lisp_Object xdialog_show P_ ((FRAME_PTR, int, Lisp_Object, char **)); #endif /* This is how to deal with multibyte text if HAVE_MULTILINGUAL_MENU @@ -156,7 +157,6 @@ static void list_of_panes P_ ((Lisp_Object)); static void list_of_items P_ ((Lisp_Object)); -extern EMACS_TIME timer_check P_ ((int)); /* This holds a Lisp vector that holds the results of decoding the keymaps or alist-of-alists that specify a menu. @@ -1128,21 +1128,16 @@ #ifdef USE_X_TOOLKIT static void -popup_get_selection (initial_event, dpyinfo, id, do_timers, down_on_keypress) +popup_get_selection (initial_event, dpyinfo, id, down_on_keypress) XEvent *initial_event; struct x_display_info *dpyinfo; LWLIB_ID id; - int do_timers; int down_on_keypress; { XEvent event; while (popup_activated_flag) { - /* If we have no events to run, consider timers. */ - if (do_timers && !XtAppPending (Xt_app_con)) - timer_check (1); - if (initial_event) { event = *initial_event; @@ -2489,7 +2484,7 @@ popup_activated_flag = 1; /* Process events that apply to the menu. */ - popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), menu_id, 0, 0); + popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), menu_id, 0); /* fp turned off the following statement and wrote a comment that it is unnecessary--that the menu has already disappeared. @@ -2883,8 +2878,7 @@ Fcons (make_number (dialog_id >> (fact)), make_number (dialog_id & ~(-1 << (fact))))); - popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), - dialog_id, 1, 1); + popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id, 1); unbind_to (count, Qnil); }
--- a/src/xselect.c Fri Oct 29 00:25:02 2004 +0000 +++ b/src/xselect.c Thu Nov 04 08:55:40 2004 +0000 @@ -108,8 +108,8 @@ QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7; #endif -static Lisp_Object Vx_lost_selection_hooks; -static Lisp_Object Vx_sent_selection_hooks; +static Lisp_Object Vx_lost_selection_functions; +static Lisp_Object Vx_sent_selection_functions; /* Coding system for communicating with other X clients via cutbuffer, selection, and clipboard. */ static Lisp_Object Vselection_coding_system; @@ -856,7 +856,7 @@ /* Let random lisp code notice that the selection has been asked for. */ { Lisp_Object rest; - rest = Vx_sent_selection_hooks; + rest = Vx_sent_selection_functions; if (!EQ (rest, Qunbound)) for (; CONSP (rest); rest = Fcdr (rest)) call3 (Fcar (rest), selection_symbol, target_symbol, successful_p); @@ -939,7 +939,7 @@ { Lisp_Object rest; - rest = Vx_lost_selection_hooks; + rest = Vx_lost_selection_functions; if (!EQ (rest, Qunbound)) { for (; CONSP (rest); rest = Fcdr (rest)) @@ -972,7 +972,7 @@ /* Let random Lisp code notice that the selection has been stolen. */ Lisp_Object hooks, selection_symbol; - hooks = Vx_lost_selection_hooks; + hooks = Vx_lost_selection_functions; selection_symbol = Fcar (Fcar (Vselection_alist)); if (!EQ (hooks, Qunbound)) @@ -996,7 +996,7 @@ /* Let random Lisp code notice that the selection has been stolen. */ Lisp_Object hooks, selection_symbol; - hooks = Vx_lost_selection_hooks; + hooks = Vx_lost_selection_functions; selection_symbol = Fcar (Fcar (XCDR (rest))); if (!EQ (hooks, Qunbound)) @@ -2699,15 +2699,15 @@ and there is no meaningful selection value. */); Vselection_converter_alist = Qnil; - DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks, + DEFVAR_LISP ("x-lost-selection-functions", &Vx_lost_selection_functions, doc: /* A list of functions to be called when Emacs loses an X selection. \(This happens when some other X client makes its own selection or when a Lisp program explicitly clears the selection.) The functions are called with one argument, the selection type \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */); - Vx_lost_selection_hooks = Qnil; - - DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks, + Vx_lost_selection_functions = Qnil; + + DEFVAR_LISP ("x-sent-selection-functions", &Vx_sent_selection_functions, doc: /* A list of functions to be called when Emacs answers a selection request. The functions are called with four arguments: - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD'); @@ -2719,7 +2719,7 @@ to convert into a type that we don't know about or that is inappropriate. This hook doesn't let you change the behavior of Emacs's selection replies, it merely informs you that they have happened. */); - Vx_sent_selection_hooks = Qnil; + Vx_sent_selection_functions = Qnil; DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system, doc: /* Coding system for communicating with other X clients.
--- a/src/xterm.c Fri Oct 29 00:25:02 2004 +0000 +++ b/src/xterm.c Thu Nov 04 08:55:40 2004 +0000 @@ -3930,9 +3930,9 @@ { Lisp_Object tail; -#ifdef USE_GTK +#if defined (USE_GTK) && defined (USE_TOOLKIT_SCROLL_BARS) window_id = (Window) xg_get_scroll_id_for_window (display, window_id); -#endif /* USE_GTK */ +#endif /* USE_GTK && USE_TOOLKIT_SCROLL_BARS */ for (tail = Vframe_list; XGCTYPE (tail) == Lisp_Cons;