Mercurial > emacs
changeset 83031:1d2f73785d9d
Merged in changes from CVS HEAD
Patches applied:
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-57
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-58
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-59
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-60
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-61
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-62
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-63
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-64
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-65
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-66
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-67
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-68
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-69
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-71
| author | Karoly Lorentey <lorentey@elte.hu> |
|---|---|
| date | Mon, 02 Feb 2004 19:19:08 +0000 |
| parents | 895e130cc8da (current diff) 7898852aa054 (diff) |
| children | b8237c556f0e |
| files | ChangeLog lib-src/emacsclient.c lisp/ChangeLog lisp/emacs-lisp/bytecomp.el lisp/server.el lisp/term/x-win.el src/macterm.c src/process.c src/sysdep.c |
| diffstat | 48 files changed, 1164 insertions(+), 617 deletions(-) [+] |
line wrap: on
line diff
--- a/ChangeLog Mon Jan 26 21:22:42 2004 +0000 +++ b/ChangeLog Mon Feb 02 19:19:08 2004 +0000 @@ -1,3 +1,7 @@ +2004-01-27 Stefan Monnier <monnier@iro.umontreal.ca> + + * configure.in <darwin>: Use fink packages if available. + 2004-01-25 Jerome Marant <jmarant@free.fr> (tiny change) * make-dist (lispref): Do include lispref/index.texi. @@ -39,7 +43,7 @@ * configure.in (HAVE_GTK_MULTIDISPLAY): Check if GTK can handle multiple displays. - Wrong number of args to AC_CHECK_LIB for HAVE_X_SM test corrected. + Wrong number of args to AC_CHECK_LIB for HAVE_X_SM test corrected. 2003-09-23 Dave Love <fx@gnu.org>
--- a/configure Mon Jan 26 21:22:42 2004 +0000 +++ b/configure Mon Feb 02 19:19:08 2004 +0000 @@ -2610,6 +2610,12 @@ machine=powermac opsys=darwin # Define CPP as follows to make autoconf work correctly. CPP="${CC-cc} -E -no-cpp-precomp" + # Use fink packages if available. + if test -d /sw/include && test -d /sw/lib; then + GCC_TEST_OPTIONS="-I/sw/include -L/sw/lib" + CPP="${CPP} ${GCC_TEST_OPTIONS}" + NON_GCC_TEST_OPTIONS=${GCC_TEST_OPTIONS} + fi ;; ## AMD x86-64 Linux-based GNU system
--- a/configure.in Mon Jan 26 21:22:42 2004 +0000 +++ b/configure.in Mon Feb 02 19:19:08 2004 +0000 @@ -1135,6 +1135,12 @@ machine=powermac opsys=darwin # Define CPP as follows to make autoconf work correctly. CPP="${CC-cc} -E -no-cpp-precomp" + # Use fink packages if available. + if test -d /sw/include && test -d /sw/lib; then + GCC_TEST_OPTIONS="-I/sw/include -L/sw/lib" + CPP="${CPP} ${GCC_TEST_OPTIONS}" + NON_GCC_TEST_OPTIONS=${GCC_TEST_OPTIONS} + fi ;; ## AMD x86-64 Linux-based GNU system
--- a/etc/NEWS Mon Jan 26 21:22:42 2004 +0000 +++ b/etc/NEWS Mon Feb 02 19:19:08 2004 +0000 @@ -856,13 +856,20 @@ is only rarely needed. --- -** jit-lock can now be delayed with `jit-lock-defer-time'. +** JIT-lock changes +*** jit-lock can now be delayed with `jit-lock-defer-time'. If this variable is non-nil, its value should be the amount of Emacs idle time in seconds to wait before starting fontification. For example, if you set `jit-lock-defer-time' to 0.25, fontification will only happen after 0.25s of idle time. +*** contextual refontification is now separate from stealth fontification. + +jit-lock-defer-contextually is renamed jit-lock-contextually and +jit-lock-context-time determines the delay after which contextual +refontification takes place. + +++ ** Marking commands extend the region when invoked multiple times. If you hit M-C-SPC (mark-sexp), M-@ (mark-word), M-h (mark-paragraph), or @@ -1790,6 +1797,10 @@ * Lisp Changes in Emacs 21.4 +** The default value of `sentence-end' is now defined using the new +variable `sentence-end-without-space' which contains such characters +that end a sentence without following spaces. + +++ ** The flags, width, and precision options for %-specifications in function `format' are now documented. Some flags that were accepted but not
--- a/leim/ChangeLog Mon Jan 26 21:22:42 2004 +0000 +++ b/leim/ChangeLog Mon Feb 02 19:19:08 2004 +0000 @@ -1,3 +1,7 @@ +2004-01-27 Ognyan Kulev <ogi@fmi.uni-sofia.bg> (tiny change) + + * quail/cyrillic.el ("bulgarian-bds"): Docstring fixed. + 2004-01-22 Ognyan Kulev <ogi@fmi.uni-sofia.bg> (tiny change) * quail/cyrillic.el ("bulgarian-phonetic"): Docstring fixed.
--- a/leim/quail/cyrillic.el Mon Jan 26 21:22:42 2004 +0000 +++ b/leim/quail/cyrillic.el Mon Feb 02 19:19:08 2004 +0000 @@ -1254,37 +1254,30 @@ The letters $,1(F(B, $,1(<(B, $,1(G(B, $,1(@(B, $,1(;(B, $,1(1(B and $,1(K(B are not affected by Caps Lock. -In addition to original bulgarian typewriter layout, keys \ and | -are transformed into ' and $,1(K(B respectively." +In addition to original Bulgarian typewriter layout, keys \\ and | +are transformed into ' and $,1(K(B respectively. Some keyboards mark these +keys as being transformed into ( and ) respectively. For ( and ), use +` and ~ respectively. This input method follows XKB." nil t t t t nil nil nil nil nil t) ;; () 1! 2? 3+ 4" 5% 6= 7: 8/ 9_ 0$,1uV(B -I .V ;; ,$,1(k(B $,1(C(B $,1(5(B $,1(8(B $,1(H(B $,1(I(B $,1(:(B $,1(A(B $,1(4(B $,1(7(B $,1(F(B ;,A'(B -;; $,1(l(B $,1(O(B $,1(0(B $,1(>(B $,1(6(B $,1(3(B $,1(B(B $,1(=(B $,1(2(B $,1(<(B $,1(G(B '$,1(K(B +;; $,1(L(B $,1(O(B $,1(0(B $,1(>(B $,1(6(B $,1(3(B $,1(B(B $,1(=(B $,1(2(B $,1(<(B $,1(G(B '$,1(K(B ;; $,1(N(B $,1(9(B $,1(J(B $,1(M(B $,1(D(B $,1(E(B $,1(?(B $,1(@(B $,1(;(B $,1(1(B (quail-define-rules ("1" ?1) ("!" ?!) - ("2" ?2) - ("@" ??) - ("3" ?3) - ("#" ?+) - ("4" ?4) - ("$" ?\") + ("2" ?2) ("@" ??) + ("3" ?3) ("#" ?+) + ("4" ?4) ("$" ?\") ("5" ?5) ("%" ?%) - ("6" ?6) - ("^" ?=) - ("7" ?7) - ("&" ?:) - ("8" ?8) - ("*" ?/) - ("9" ?9) - ("(" ?_) - ("0" ?0) - (")" ?$,1uV(B) - ("-" ?-) - ("_" ?I) + ("6" ?6) ("^" ?=) + ("7" ?7) ("&" ?:) + ("8" ?8) ("*" ?/) + ("9" ?9) ("(" ?_) + ("0" ?0) (")" ?$,1uV(B) + ("-" ?-) ("_" ?I) ("=" ?.) ("+" ?V) ("q" ?,) ("Q" ?$,1(k(B) @@ -1298,8 +1291,7 @@ ("o" ?$,1(T(B) ("O" ?$,1(4(B) ("p" ?$,1(W(B) ("P" ?$,1(7(B) ("[" ?$,1(f(B) ("{" ?$,1(F(B) - ("]" ?\;) - ("}" ?,A'(B) ;; not in XKB's bg + ("]" ?\;) ("}" ?,A'(B) ("a" ?$,1(l(B) ("A" ?$,1(L(B) ("s" ?$,1(o(B) ("S" ?$,1(O(B)
--- a/lib-src/ChangeLog Mon Jan 26 21:22:42 2004 +0000 +++ b/lib-src/ChangeLog Mon Feb 02 19:19:08 2004 +0000 @@ -1,8 +1,19 @@ +2004-01-27 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacsclient.c (main): Don't use the hostname in the socket name. + Look for relative socket names in the /tmp dir rather than in cwd. + 2004-01-24 Richard M. Stallman <rms@gnu.org> * emacsclient.c (main): Restore errno from saved_errno, so the error message comes from socket_status. +2004-01-20 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacsclient.c (main): Stop if socket name too long. + Only try su-fallback if the socket name was not explicit. + Check socket name length in su-fallback case as well. + 2004-01-08 Andreas Schwab <schwab@suse.de> * emacsclient.c (main): Save errno from socket_status.
--- a/lib-src/emacsclient.c Mon Jan 26 21:22:42 2004 +0000 +++ b/lib-src/emacsclient.c Mon Feb 02 19:19:08 2004 +0000 @@ -382,8 +382,6 @@ int argc; char **argv; { - char *system_name; - int system_name_length; int s, i, needlf = 0; FILE *out, *in; struct sockaddr_un server; @@ -418,39 +416,24 @@ server.sun_family = AF_UNIX; { - char *dot; - system_name_length = 32; - - while (1) - { - system_name = (char *) xmalloc (system_name_length + 1); - - /* system_name must be null-terminated string. */ - system_name[system_name_length] = '\0'; - - if (gethostname (system_name, system_name_length) == 0) - break; - - free (system_name); - system_name_length *= 2; - } - - /* We always use the non-dotted host name, for simplicity. */ - dot = index (system_name, '.'); - if (dot) - *dot = '\0'; - } - - { int sock_status = 0; int default_sock = !socket_name; int saved_errno = 0; - if (default_sock) + char *server_name = "server"; + + if (socket_name && !index (socket_name, '/') && !index (socket_name, '\\')) + { /* socket_name is a file name component. */ + server_name = socket_name; + socket_name = NULL; + default_sock = 1; /* Try both UIDs. */ + } + + if (default_sock) { - socket_name = alloca (system_name_length + 100); - sprintf (socket_name, "/tmp/emacs%d-%s/server", - (int) geteuid (), system_name); + socket_name = alloca (100 + strlen (server_name)); + sprintf (socket_name, "/tmp/emacs%d/%s", + (int) geteuid (), server_name); } if (strlen (socket_name) < sizeof (server.sun_path)) @@ -484,8 +467,9 @@ if (pw && (pw->pw_uid != geteuid ())) { /* We're running under su, apparently. */ - sprintf (socket_name, "/tmp/emacs%d-%s/server", - (int) pw->pw_uid, system_name); + socket_name = alloca (100 + strlen (server_name)); + sprintf (socket_name, "/tmp/emacs%d/%s", + (int) pw->pw_uid, server_name); if (strlen (socket_name) < sizeof (server.sun_path)) strcpy (server.sun_path, socket_name);
--- a/lisp/ChangeLog Mon Jan 26 21:22:42 2004 +0000 +++ b/lisp/ChangeLog Mon Feb 02 19:19:08 2004 +0000 @@ -1,12 +1,162 @@ +2004-02-02 David Kastrup <dak@gnu.org> + + * replace.el (perform-replace): Allow 'literal argument in + regexp-flag to indicate literal replacement. + (query-replace-regexp-eval): Use it. + +2004-02-01 Andreas Schwab <schwab@suse.de> + + * progmodes/executable.el (executable-command-find-posix-p): Doc + fix. + +2004-02-01 Stephen Eglen <stephen@gnu.org> + + * info-look.el: Add support for maxima-mode. Update commentary + because info-lookup-symbol is now bound to C-h S. + +2004-01-31 Luc Teirlinck <teirllm@auburn.edu> + + * simple.el (edit-and-eval-command): Bind print-level and + minibuffer-history-sexp-flag around call to read-from-minibuffer. + Correct initial position in command-history. + +2004-01-30 Luc Teirlinck <teirllm@auburn.edu> + + * files.el (read-directory-name): Adapt the docstring to recent + change in Fread_file_name. + +2004-01-30 Jonathan Yavner <jyavner@member.fsf.org> + + * ses.el (ses-print-cell): If print format too wide for column + width, truncate decimal places if that helps to avoid "#####" fill. + * ses.el (ses-initial-column-width): Revert previous change. + +2004-01-29 Stefan Monnier <monnier@iro.umontreal.ca> + + * jit-lock.el (jit-lock-context-time, jit-lock-context-timer): New var. + (with-buffer-unmodified, with-buffer-prepared-for-jit-lock): + Add edebug info. + (jit-lock-mode): Setup/cancel the new timer. + (jit-lock-context-fontify): New fun. Extracted from + context fontification code of jit-lock-stealth-fontify. + (jit-lock-stealth-fontify): Don't do context fontification any more. + + * jit-lock.el (jit-lock-stealth-fontify): Allow quit. + (jit-lock-fontify-now): Handle the `quit' case. + (jit-lock-contextually): Rename from jit-lock-defer-contextually. + +2004-01-29 Jari Aalto <jari.aalto@poboxes.com> + + * progmodes/executable.el (executable-command-find-posix-p): + New. Check if find handles arguments Posix-style. + + * progmodes/grep.el (grep-compute-defaults): + Use executable-command-find-posix-p. + (grep-find): Check `grep-find-command'. + + * filecache.el (file-cache-find-posix-p): Delete. + (file-cache-add-directory-using-find): + Use `executable-command-find-posix-p'. + +2004-01-29 Dave Love <fx@gnu.org> + + * emacs-lisp/lisp.el (beginning-of-defun-raw, end-of-defun): + Iterate the hook function if arg is given. + (mark-defun, narrow-to-defun): Change order of finding the limits. + + * emacs-lisp/bytecomp.el (byte-compile-compatibility): Doc fix. + (byte-compile-format-warn): New. + (byte-compile-callargs-warn): Use it. + (Format, message, error): Add byte-compile-format-like property. + (byte-compile-maybe-guarded): New. + (byte-compile-if, byte-compile-cond): Use it. + (byte-compile-lambda): Compile interactive forms, + just to make warnings about them. + +2004-01-29 Jonathan Yavner <jyavner@member.fsf.org> + + * ses.el (ses-initial-column-width): Increase to 14, so it will + work well with the default printer of "%.7g" for extreme values + like "-1.234567e+07". + +2004-01-29 Kenichi Handa <handa@m17n.org> + + * term/x-win.el (x-selection-value): Optimize for ASCII only case. + +2004-01-28 Peter 'Luna' Runestig <peter@runestig.com> + + * dos-w32.el: Added support for the `default-printer-name' function. + +2004-01-27 Stefan Monnier <monnier@iro.umontreal.ca> + + * server.el (server-socket-name): Don't use the hostname in the + socket name since /tmp is local to the host anyway. + + * emacs-lisp/easy-mmode.el (easy-mmode-define-navigation): Use a more + robust check of widening and fix var-naming. + +2004-01-27 Eli Tziperman <eli@deas.harvard.edu> + + * rmail-spam-filter.el: Change rmail-spam-filter- or spam-filter- + or rmail-spam- to rsf- in all function and variable names. + (rsf-min-region-to-spam-list): New variable. + (rsf-bbdb-auto-delete-spam-entries): Rename from + rmail-bbdb-auto-delete-spam-bbdb-entries. The cc: field is + scanned together with the recipients field for spam testing; Don't + delete spam message if rmail-delete-after-output is non-nil; + (rsf-check-field): New function, extracted from code in + rmail-spam-filter to ease addition of header fields like + content-type:; + (message-content-type): New variable. The content-type: field was + added also in defcustom of rsf-definitions-alist; + (rmail-spam-filter): Replace repeated test code for header fields + by calls to check-field; change the call to + rmail-output-to-rmail-file such that rmail-current-message stays + the same to avoid wrong deletion of unseen flags. + (rmail-use-spam-filter): Add autoload cookie. + +2004-01-27 Jari Aalto <jari.aalto@poboxes.com> + + * filecache.el (file-cache-find-posix-p): New function. Detect Cygwin. + (file-cache-add-directory-using-find): Add Cygwin support. + (file-cache-find-command-posix-flag): New user variable. + + * filecache.el (file-cache-add-directory): Check for + directories an remove them from dir-files. + +2004-01-27 Richard M. Stallman <rms@gnu.org> + + * man.el (Man-fontify-manpage): Clean up message. + +2004-01-27 Kenichi Handa <handa@m17n.org> + + * textmodes/paragraphs.el (sentence-end-without-space): New variable. + (sentence-end): Define using sentence-end-without-space. + + * textmodes/fill.el (fill-delete-newlines): Don't add a space if + a sentence ends with one of a character in sentence-end-without-space. + +2004-01-26 Stefan Monnier <monnier@iro.umontreal.ca> + + * font-lock.el (font-lock): Add jit-lock as explicit group member. + (jit-lock): Group declaration moved to jit-lock.el. + (toplevel): Don't explicitly require jit-lock, since it's autoloaded + when necessary. + + * jit-lock.el (jit-lock): Move group declaration from font-lock.el. + (jit-lock-context-unfontify-pos): Rename from + jit-lock-first-unfontify-pos. + (jit-lock-defer-buffers): Rename from jit-lock-buffers. + 2004-01-25 Glenn Morris <gmorris@ast.cam.ac.uk> - * progmodes/fortran.el (fortran-break-before-delimiters): Doc fix. - (fortran-break-delimiters-re, fortran-no-break-re): New defconsts. + * progmodes/fortran.el (fortran-break-before-delimiters): Doc fix. + (fortran-break-delimiters-re, fortran-no-break-re): New consts. (fortran-fill): When filling a string, adjust re-search-backward argument for special case of string just on fill-column. When filling non-string, allow one extra char if - fortran-break-before-delimiters is non-nil. Suggested by - Michael Hagemann <michael.hagemann@unibas.ch>. + fortran-break-before-delimiters is non-nil. + Suggested by Michael Hagemann <michael.hagemann@unibas.ch>. Use fortran-break-delimiters-re and fortran-no-break-re to correctly handle cases such as "**". @@ -41,16 +191,16 @@ 2004-01-22 Kenichi Handa <handa@m17n.org> - * language/cyrillic.el (ccl-encode-windows-1251-font): Rearrange - code point (register r1) only for charset mule-unicode-0100-24ff. + * language/cyrillic.el (ccl-encode-windows-1251-font): Rearrange code + point (register r1) only for charset mule-unicode-0100-24ff. 2004-01-21 Markus Rost <rost@mathematik.uni-bielefeld.de> * mail/rmail.el (rmail-convert-to-babyl-format): Avoid deleting trailing white space and ensure a final newline. - * mail/rmail-spam-filter.el (rmail-use-spam-filter): Add autoload - cookie. + * mail/rmail-spam-filter.el (rmail-use-spam-filter): + Add autoload cookie. 2004-01-21 Benjamin Rutt <brutt@bloomington.in.us>
--- a/lisp/dos-w32.el Mon Jan 26 21:22:42 2004 +0000 +++ b/lisp/dos-w32.el Mon Feb 02 19:19:08 2004 +0000 @@ -378,7 +378,8 @@ (printer (or (and (boundp 'dos-printer) (stringp (symbol-value 'dos-printer)) (symbol-value 'dos-printer)) - printer-name))) + printer-name + (default-printer-name)))) (or (eq coding-system-for-write 'no-conversion) (setq coding-system-for-write (aref eol-type 1))) ; force conversion to DOS EOLs @@ -411,7 +412,8 @@ (let ((printer (or (and (boundp 'dos-ps-printer) (stringp (symbol-value 'dos-ps-printer)) (symbol-value 'dos-ps-printer)) - ps-printer-name))) + ps-printer-name + (default-printer-name)))) (direct-print-region-helper printer start end lpr-prog delete-text buf display rest)))
--- a/lisp/emacs-lisp/bytecomp.el Mon Jan 26 21:22:42 2004 +0000 +++ b/lisp/emacs-lisp/bytecomp.el Mon Feb 02 19:19:08 2004 +0000 @@ -10,7 +10,7 @@ ;;; This version incorporates changes up to version 2.10 of the ;;; Zawinski-Furuseth compiler. -(defconst byte-compile-version "$Revision: 2.141 $") +(defconst byte-compile-version "$Revision: 2.142 $") ;; This file is part of GNU Emacs. @@ -251,7 +251,9 @@ :type 'boolean) (defcustom byte-compile-compatibility nil - "*Non-nil means generate output that can run in Emacs 18." + "*Non-nil means generate output that can run in Emacs 18. +This only means that it can run in principle, if it doesn't require +facilities that have been added more recently." :group 'bytecomp :type 'boolean) @@ -444,6 +446,11 @@ Used for warnings when the function is not known to be defined or is later defined with incorrect args.") +(defvar byte-compile-noruntime-functions nil + "Alist of functions called that may not be defined when the compiled code is run. +Used for warnings about calling a function that is defined during compilation +but won't necessarily be defined when the compiled file is loaded.") + (defvar byte-compile-tag-number 0) (defvar byte-compile-output nil "Alist describing contents to put in byte code string. @@ -776,7 +783,7 @@ (defun byte-compile-eval (form) "Eval FORM and mark the functions defined therein. -Each function's symbol gets marked with the `byte-compile-noruntime' property." +Each function's symbol gets added to `byte-compile-noruntime-functions'." (let ((hist-orig load-history) (hist-nil-orig current-load-list)) (prog1 (eval form) @@ -794,17 +801,17 @@ (cond ((symbolp s) (unless (memq s old-autoloads) - (put s 'byte-compile-noruntime t))) + (push s byte-compile-noruntime-functions))) ((and (consp s) (eq t (car s))) (push (cdr s) old-autoloads)) ((and (consp s) (eq 'autoload (car s))) - (put (cdr s) 'byte-compile-noruntime t))))))) + (push (cdr s) byte-compile-noruntime-functions))))))) ;; Go through current-load-list for the locally defined funs. (let (old-autoloads) (while (and hist-nil-new (not (eq hist-nil-new hist-nil-orig))) (let ((s (pop hist-nil-new))) (when (and (symbolp s) (not (memq s old-autoloads))) - (put s 'byte-compile-noruntime t)) + (push s byte-compile-noruntime-functions)) (when (and (consp s) (eq t (car s))) (push (cdr s) old-autoloads)))))))))) @@ -1170,10 +1177,11 @@ "requires" "accepts only") (byte-compile-arglist-signature-string sig)))) + (byte-compile-format-warn form) ;; Check to see if the function will be available at runtime ;; and/or remember its arity if it's unknown. (or (and (or sig (fboundp (car form))) ; might be a subr or autoload. - (not (get (car form) 'byte-compile-noruntime))) + (not (memq (car form) byte-compile-noruntime-functions))) (eq (car form) byte-compile-current-form) ; ## this doesn't work ; with recursion. ;; It's a currently-undefined function. @@ -1187,6 +1195,32 @@ (cons (list (car form) n) byte-compile-unresolved-functions))))))) +(defun byte-compile-format-warn (form) + "Warn if FORM is `format'-like with inconsistent args. +Applies if head of FORM is a symbol with non-nil property +`byte-compile-format-like' and first arg is a constant string. +Then check the number of format fields matches the number of +extra args." + (when (and (symbolp (car form)) + (stringp (nth 1 form)) + (get (car form) 'byte-compile-format-like)) + (let ((nfields (with-temp-buffer + (insert (nth 1 form)) + (goto-char 1) + (let ((n 0)) + (while (re-search-forward "%." nil t) + (unless (eq ?% (char-after (1+ (match-beginning 0)))) + (setq n (1+ n)))) + n))) + (nargs (- (length form) 2))) + (unless (= nargs nfields) + (byte-compile-warn + "`%s' called with %d args to fill %d format field(s)" (car form) + nargs nfields))))) + +(dolist (elt '(format message error)) + (put elt 'byte-compile-format-like t)) + ;; Warn if the function or macro is being redefined with a different ;; number of arguments. (defun byte-compile-arglist-warn (form macrop) @@ -1254,7 +1288,7 @@ (let ((func (car-safe form))) (if (and byte-compile-cl-functions (memq func byte-compile-cl-functions) - ;; Aliases which won't have been expended at this point. + ;; Aliases which won't have been expanded at this point. ;; These aren't all aliases of subrs, so not trivial to ;; avoid hardwiring the list. (not (memq func @@ -2453,17 +2487,19 @@ (if (cdr (cdr int)) (byte-compile-warn "malformed interactive spec: %s" (prin1-to-string int))) - ;; If the interactive spec is a call to `list', - ;; don't compile it, because `call-interactively' - ;; looks at the args of `list'. + ;; If the interactive spec is a call to `list', don't + ;; compile it, because `call-interactively' looks at the + ;; args of `list'. Actually, compile it to get warnings, + ;; but don't use the result. (let ((form (nth 1 int))) (while (memq (car-safe form) '(let let* progn save-excursion)) (while (consp (cdr form)) (setq form (cdr form))) (setq form (car form))) - (or (eq (car-safe form) 'list) - (setq int (list 'interactive - (byte-compile-top-level (nth 1 int))))))) + (if (eq (car-safe form) 'list) + (byte-compile-top-level (nth 1 int)) + (setq int (list 'interactive + (byte-compile-top-level (nth 1 int))))))) ((cdr int) (byte-compile-warn "malformed interactive spec: %s" (prin1-to-string int))))) @@ -3265,51 +3301,55 @@ (if ,discard 'byte-goto-if-nil 'byte-goto-if-nil-else-pop)) ,tag)) +(defmacro byte-compile-maybe-guarded (condition &rest body) + "Execute forms in BODY, potentially guarded by CONDITION. +CONDITION is the test in an `if' form or in a `cond' clause. +BODY is to compile the first arm of the if or the body of the +cond clause. If CONDITION is of the form `(foundp 'foo)' +or `(boundp 'foo)', the relevant warnings from BODY about foo +being undefined will be suppressed." + (declare (indent 1) (debug t)) + `(let* ((fbound + (if (eq 'fboundp (car-safe ,condition)) + (and (eq 'quote (car-safe (nth 1 ,condition))) + ;; Ignore if the symbol is already on the + ;; unresolved list. + (not (assq (nth 1 (nth 1 ,condition)) ; the relevant symbol + byte-compile-unresolved-functions)) + (nth 1 (nth 1 ,condition))))) + (bound (if (or (eq 'boundp (car-safe ,condition)) + (eq 'default-boundp (car-safe ,condition))) + (and (eq 'quote (car-safe (nth 1 ,condition))) + (nth 1 (nth 1 ,condition))))) + ;; Maybe add to the bound list. + (byte-compile-bound-variables + (if bound + (cons bound byte-compile-bound-variables) + byte-compile-bound-variables))) + (progn ,@body) + ;; Maybe remove the function symbol from the unresolved list. + (if fbound + (setq byte-compile-unresolved-functions + (delq (assq fbound byte-compile-unresolved-functions) + byte-compile-unresolved-functions))))) + (defun byte-compile-if (form) (byte-compile-form (car (cdr form))) ;; Check whether we have `(if (fboundp ...' or `(if (boundp ...' ;; and avoid warnings about the relevent symbols in the consequent. - (let* ((clause (nth 1 form)) - (fbound (if (eq 'fboundp (car-safe clause)) - (and (eq 'quote (car-safe (nth 1 clause))) - ;; Ignore if the symbol is already on the - ;; unresolved list. - (not (assq - (nth 1 (nth 1 clause)) ; the relevant symbol - byte-compile-unresolved-functions)) - (nth 1 (nth 1 clause))))) - (bound (if (eq 'boundp (car-safe clause)) - (and (eq 'quote (car-safe (nth 1 clause))) - (nth 1 (nth 1 clause))))) - (donetag (byte-compile-make-tag))) + (let ((clause (nth 1 form)) + (donetag (byte-compile-make-tag))) (if (null (nthcdr 3 form)) ;; No else-forms (progn (byte-compile-goto-if nil for-effect donetag) - ;; Maybe add to the bound list. - (let ((byte-compile-bound-variables - (if bound - (cons bound byte-compile-bound-variables) - byte-compile-bound-variables))) + (byte-compile-maybe-guarded clause (byte-compile-form (nth 2 form) for-effect)) - ;; Maybe remove the function symbol from the unresolved list. - (if fbound - (setq byte-compile-unresolved-functions - (delq (assq fbound byte-compile-unresolved-functions) - byte-compile-unresolved-functions))) (byte-compile-out-tag donetag)) (let ((elsetag (byte-compile-make-tag))) (byte-compile-goto 'byte-goto-if-nil elsetag) - ;; As above for the first form. - (let ((byte-compile-bound-variables - (if bound - (cons bound byte-compile-bound-variables) - byte-compile-bound-variables))) - (byte-compile-form (nth 2 form) for-effect)) - (if fbound - (setq byte-compile-unresolved-functions - (delq (assq fbound byte-compile-unresolved-functions) - byte-compile-unresolved-functions))) + (byte-compile-maybe-guarded clause + (byte-compile-form (nth 2 form) for-effect)) (byte-compile-goto 'byte-goto donetag) (byte-compile-out-tag elsetag) (byte-compile-body (cdr (cdr (cdr form))) for-effect) @@ -3332,14 +3372,16 @@ (if (null (cdr clause)) ;; First clause is a singleton. (byte-compile-goto-if t for-effect donetag) - (setq nexttag (byte-compile-make-tag)) - (byte-compile-goto 'byte-goto-if-nil nexttag) - (byte-compile-body (cdr clause) for-effect) - (byte-compile-goto 'byte-goto donetag) - (byte-compile-out-tag nexttag))))) + (setq nexttag (byte-compile-make-tag)) + (byte-compile-goto 'byte-goto-if-nil nexttag) + (byte-compile-maybe-guarded (car clause) + (byte-compile-body (cdr clause) for-effect)) + (byte-compile-goto 'byte-goto donetag) + (byte-compile-out-tag nexttag))))) ;; Last clause (and (cdr clause) (not (eq (car clause) t)) - (progn (byte-compile-form (car clause)) + (progn (byte-compile-maybe-guarded (car clause) + (byte-compile-form (car clause))) (byte-compile-goto-if nil for-effect donetag) (setq clause (cdr clause)))) (byte-compile-body-do-effect clause)
--- a/lisp/emacs-lisp/easy-mmode.el Mon Jan 26 21:22:42 2004 +0000 +++ b/lisp/emacs-lisp/easy-mmode.el Mon Feb 02 19:19:08 2004 +0000 @@ -1,6 +1,6 @@ ;;; easy-mmode.el --- easy definition for major and minor modes -;; Copyright (C) 1997, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. +;; Copyright (C) 1997,2000,01,02,03,2004 Free Software Foundation, Inc. ;; Author: Georges Brun-Cottan <Georges.Brun-Cottan@inria.fr> ;; Maintainer: Stefan Monnier <monnier@gnu.org> @@ -433,14 +433,13 @@ (let* ((base-name (symbol-name base)) (prev-sym (intern (concat base-name "-prev"))) (next-sym (intern (concat base-name "-next"))) - (check-narrow-maybe (when narrowfun - '(setq was-narrowed-p - (prog1 (or (/= (point-min) 1) - (/= (point-max) - (1+ (buffer-size)))) - (widen))))) + (check-narrow-maybe + (when narrowfun + '(setq was-narrowed + (prog1 (or (< (- (point-max) (point-min)) (buffer-size))) + (widen))))) (re-narrow-maybe (when narrowfun - `(when was-narrowed-p (,narrowfun))))) + `(when was-narrowed (,narrowfun))))) (unless name (setq name base-name)) `(progn (add-to-list 'debug-ignored-errors @@ -451,7 +450,7 @@ (unless count (setq count 1)) (if (< count 0) (,prev-sym (- count)) (if (looking-at ,re) (setq count (1+ count))) - (let (was-narrowed-p) + (let (was-narrowed) ,check-narrow-maybe (if (not (re-search-forward ,re nil t count)) (if (looking-at ,re) @@ -472,7 +471,7 @@ (interactive) (unless count (setq count 1)) (if (< count 0) (,next-sym (- count)) - (let (was-narrowed-p) + (let (was-narrowed) ,check-narrow-maybe (unless (re-search-backward ,re nil t count) (error "No previous %s" ,name))
--- a/lisp/emacs-lisp/lisp.el Mon Jan 26 21:22:42 2004 +0000 +++ b/lisp/emacs-lisp/lisp.el Mon Feb 02 19:19:08 2004 +0000 @@ -188,7 +188,8 @@ is called as a function to find the defun's beginning." (interactive "p") (if beginning-of-defun-function - (funcall beginning-of-defun-function) + (dotimes (i (or arg 1)) + (funcall beginning-of-defun-function)) (and arg (< arg 0) (not (eobp)) (forward-char 1)) (and (re-search-backward (if defun-prompt-regexp (concat (if open-paren-in-column-0-is-defun-start @@ -219,7 +220,8 @@ is called as a function to find the defun's end." (interactive "p") (if end-of-defun-function - (funcall end-of-defun-function) + (dotimes (i (or arg 1)) + (funcall end-of-defun-function)) (if (or (null arg) (= arg 0)) (setq arg 1)) (let ((first t)) (while (and (> arg 0) (< (point) (point-max))) @@ -267,10 +269,14 @@ (end-of-defun) (point)))) (t + ;; Do it in this order for the sake of languages with nested + ;; functions where several can end at the same place as with + ;; the offside rule, e.g. Python. (push-mark (point)) + (beginning-of-defun) + (push-mark (point) nil t) (end-of-defun) - (push-mark (point) nil t) - (beginning-of-defun) + (exchange-point-and-mark) (re-search-backward "^\n" (- (point) 1) t)))) (defun narrow-to-defun (&optional arg) @@ -280,10 +286,13 @@ (interactive) (save-excursion (widen) - (end-of-defun) - (let ((end (point))) - (beginning-of-defun) - (narrow-to-region (point) end)))) + ;; Do it in this order for the sake of languages with nested + ;; functions where several can end at the same place as with the + ;; offside rule, e.g. Python. + (beginning-of-defun) + (let ((beg (point))) + (end-of-defun) + (narrow-to-region beg (point))))) (defun insert-parentheses (arg) "Enclose following ARG sexps in parentheses. Leave point after open-paren.
--- a/lisp/filecache.el Mon Jan 26 21:22:42 2004 +0000 +++ b/lisp/filecache.el Mon Feb 02 19:19:08 2004 +0000 @@ -170,6 +170,19 @@ :type 'string :group 'file-cache) +(defcustom file-cache-find-command-posix-flag 'not-defined + "*Set to t, if `file-cache-find-command' handles wildcards POSIX style. +This variable is automatically set to nil or non-nil +if it has the initial value `not-defined' whenever you first +call the `file-cache-add-directory-using-find'. + +Under Windows operating system where Cygwin is available, this value +should be t." + :type '(choice (const :tag "Yes" t) + (const :tag "No" nil) + (const :tag "Unknown" not-defined)) + :group 'file-cache) + (defcustom file-cache-locate-command "locate" "*External program used by `file-cache-add-directory-using-locate'." :type 'string @@ -267,11 +280,13 @@ ;; Filter out files we don't want to see (mapcar '(lambda (file) - (mapcar - '(lambda (regexp) - (if (string-match regexp file) - (setq dir-files (delq file dir-files)))) - file-cache-filter-regexps)) + (if (file-directory-p file) + (setq dir-files (delq file dir-files)) + (mapcar + '(lambda (regexp) + (if (string-match regexp file) + (setq dir-files (delq file dir-files)))) + file-cache-filter-regexps))) dir-files) (file-cache-add-file-list dir-files)))) @@ -322,12 +337,21 @@ Find is run in DIRECTORY." (interactive "DAdd files under directory: ") (let ((dir (expand-file-name directory))) + (if (eq file-cache-find-command-posix-flag 'not-defined) + (setq file-cache-find-command-posix-flag + (executable-command-find-posix-p file-cache-find-command))) (set-buffer (get-buffer-create file-cache-buffer)) (erase-buffer) (call-process file-cache-find-command nil (get-buffer file-cache-buffer) nil dir "-name" - (if (eq system-type 'windows-nt) "'*'" "*") + (cond + (file-cache-find-command-posix-flag + "\\*") + ((eq system-type 'windows-nt) + "'*'") + (t + "*")) "-print") (file-cache-add-from-file-cache-buffer)))
--- a/lisp/files.el Mon Jan 26 21:22:42 2004 +0000 +++ b/lisp/files.el Mon Feb 02 19:19:08 2004 +0000 @@ -490,13 +490,18 @@ (defun read-directory-name (prompt &optional dir default-dirname mustmatch initial) "Read directory name, prompting with PROMPT and completing in directory DIR. Value is not expanded---you must call `expand-file-name' yourself. -Default name to DEFAULT-DIRNAME if user enters a null string. +Default name to DEFAULT-DIRNAME if user exits with the same +non-empty string that was inserted by this function. (If DEFAULT-DIRNAME is omitted, the current buffer's directory is used, except that if INITIAL is specified, that combined with DIR is used.) +If the user exits with an empty minibuffer, this function returns +an empty string. (This can only happen if the user erased the +pre-inserted contents or if `insert-default-directory' is nil.) Fourth arg MUSTMATCH non-nil means require existing directory's name. Non-nil and non-t means also require confirmation after completion. Fifth arg INITIAL specifies text to start with. -DIR defaults to current buffer's directory default." +DIR should be an absolute directory name. It defaults to +the value of `default-directory'." (unless dir (setq dir default-directory)) (unless default-dirname
--- a/lisp/font-lock.el Mon Jan 26 21:22:42 2004 +0000 +++ b/lisp/font-lock.el Mon Feb 02 19:19:08 2004 +0000 @@ -210,7 +210,7 @@ (require 'syntax) ;; Define core `font-lock' group. -(defgroup font-lock nil +(defgroup font-lock '((jit-lock custom-group)) "Font Lock mode text highlighting package." :link '(custom-manual "(emacs)Font Lock") :link '(custom-manual "(elisp)Font Lock Mode") @@ -237,13 +237,6 @@ :link '(custom-manual "(emacs)Support Modes") :load 'lazy-lock :group 'font-lock) - -(defgroup jit-lock nil - "Font Lock support mode to fontify just-in-time." - :link '(custom-manual "(emacs)Support Modes") - :version "21.1" - :load 'jit-lock - :group 'font-lock) ;; User variables. @@ -1927,8 +1920,5 @@ (provide 'font-lock) -(when (eq font-lock-support-mode 'jit-lock-mode) - (require 'jit-lock)) - ;;; arch-tag: 682327e4-64d8-4057-b20b-1fbb9f1fc54c ;;; font-lock.el ends here
--- a/lisp/info-look.el Mon Jan 26 21:22:42 2004 +0000 +++ b/lisp/info-look.el Mon Feb 02 19:19:08 2004 +0000 @@ -27,7 +27,7 @@ ;;; Commentary: ;; Really cool code to lookup info indexes. -;; Try especially info-lookup-symbol (aka C-h TAB). +;; Try especially info-lookup-symbol (aka C-h S). ;;; Code: @@ -830,6 +830,17 @@ nil; "^ - [^:]+:[ ]+" don't think this prefix is useful here. nil))) +(info-lookup-maybe-add-help + :mode 'maxima-mode + :ignore-case t + :regexp "[a-zA-Z_%]+" + :doc-spec '( ("(maxima)Function and Variable Index" nil + "^ - [^:]+:[ ]+\\(\\[[^=]*=[ ]+\\)?" nil))) + +(info-lookup-maybe-add-help + :mode 'inferior-maxima-mode + :other-modes '(maxima-mode)) + ;; coreutils and bash builtins overlap in places, eg. printf, so there's a ;; question which should come first. Some of the coreutils descriptions are ;; more detailed, but if bash is usually /bin/sh on a GNU system then the
--- a/lisp/jit-lock.el Mon Jan 26 21:22:42 2004 +0000 +++ b/lisp/jit-lock.el Mon Feb 02 19:19:08 2004 +0000 @@ -1,6 +1,6 @@ ;;; jit-lock.el --- just-in-time fontification -;; Copyright (C) 1998, 2000, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1998, 2000, 2001, 2004 Free Software Foundation, Inc. ;; Author: Gerd Moellmann <gerd@gnu.org> ;; Keywords: faces files @@ -32,6 +32,7 @@ (eval-when-compile (defmacro with-buffer-unmodified (&rest body) "Eval BODY, preserving the current buffer's modified state." + (declare (debug t)) (let ((modified (make-symbol "modified"))) `(let ((,modified (buffer-modified-p))) (unwind-protect @@ -42,6 +43,7 @@ (defmacro with-buffer-prepared-for-jit-lock (&rest body) "Execute BODY in current buffer, overriding several variables. Preserves the `buffer-modified-p' state of the current buffer." + (declare (debug t)) `(with-buffer-unmodified (let ((buffer-undo-list t) (inhibit-read-only t) @@ -56,6 +58,12 @@ ;;; Customization. +(defgroup jit-lock nil + "Font Lock support mode to fontify just-in-time." + :link '(custom-manual "(emacs)Support Modes") + :version "21.1" + :group 'font-lock) + (defcustom jit-lock-chunk-size 500 "*Jit-lock chunks of this many characters, or smaller." :type 'integer @@ -109,15 +117,16 @@ :group 'jit-lock) -(defcustom jit-lock-defer-contextually 'syntax-driven - "*If non-nil, means deferred fontification should be syntactically true. -If nil, means deferred fontification occurs only on those lines modified. This +(defvaralias 'jit-lock-defer-contextually 'jit-lock-contextually) +(defcustom jit-lock-contextually 'syntax-driven + "*If non-nil, means fontification should be syntactically true. +If nil, means fontification occurs only on those lines modified. This means where modification on a line causes syntactic change on subsequent lines, those subsequent lines are not refontified to reflect their new context. -If t, means deferred fontification occurs on those lines modified and all +If t, means fontification occurs on those lines modified and all subsequent lines. This means those subsequent lines are refontified to reflect -their new syntactic context, either immediately or when scrolling into them. -If any other value, e.g., `syntax-driven', means deferred syntactically true +their new syntactic context, after `jit-lock-context-time' seconds. +If any other value, e.g., `syntax-driven', means syntactically true fontification occurs only if syntactic fontification is performed using the buffer mode's syntax table, i.e., only if `font-lock-keywords-only' is nil. @@ -127,6 +136,10 @@ (other :tag "syntax-driven" syntax-driven)) :group 'jit-lock) +(defcustom jit-lock-context-time 0.5 + "Idle time after which text is contextually refontified, if applicable." + :type '(number :tag "seconds")) + (defcustom jit-lock-defer-time nil ;; 0.25 "Idle time after which deferred fontification should take place. If nil, fontification is not deferred." @@ -145,19 +158,20 @@ They are called with two arguments: the START and END of the region to fontify.") (make-variable-buffer-local 'jit-lock-functions) -(defvar jit-lock-first-unfontify-pos nil +(defvar jit-lock-context-unfontify-pos nil "Consider text after this position as contextually unfontified. If nil, contextual fontification is disabled.") -(make-variable-buffer-local 'jit-lock-first-unfontify-pos) +(make-variable-buffer-local 'jit-lock-context-unfontify-pos) (defvar jit-lock-stealth-timer nil "Timer for stealth fontification in Just-in-time Lock mode.") - +(defvar jit-lock-context-timer nil + "Timer for context fontification in Just-in-time Lock mode.") (defvar jit-lock-defer-timer nil "Timer for deferred fontification in Just-in-time Lock mode.") -(defvar jit-lock-buffers nil +(defvar jit-lock-defer-buffers nil "List of buffers with pending deferred fontification.") ;;; JIT lock mode @@ -181,9 +195,9 @@ been idle for `jit-lock-stealth-time' seconds, while Emacs remains idle. This is useful if any buffer has any deferred fontification. -- Deferred context fontification if `jit-lock-defer-contextually' is +- Deferred context fontification if `jit-lock-contextually' is non-nil. This means fontification updates the buffer corresponding to - true syntactic context, after `jit-lock-stealth-time' seconds of Emacs + true syntactic context, after `jit-lock-context-time' seconds of Emacs idle time, while Emacs remains idle. Otherwise, fontification occurs on modified lines only, and subsequent lines can remain fontified corresponding to previous syntactic contexts. This is useful where @@ -212,10 +226,14 @@ (run-with-idle-timer jit-lock-defer-time t 'jit-lock-deferred-fontify))) - ;; Initialize deferred contextual fontification if requested. - (when (eq jit-lock-defer-contextually t) - (setq jit-lock-first-unfontify-pos - (or jit-lock-first-unfontify-pos (point-max)))) + ;; Initialize contextual fontification if requested. + (when (eq jit-lock-contextually t) + (unless jit-lock-context-timer + (setq jit-lock-context-timer + (run-with-idle-timer jit-lock-context-time t + 'jit-lock-context-fontify))) + (setq jit-lock-context-unfontify-pos + (or jit-lock-context-unfontify-pos (point-max)))) ;; Setup our hooks. (add-hook 'after-change-functions 'jit-lock-after-change nil t) @@ -224,7 +242,8 @@ ;; Turn Just-in-time Lock mode off. (t ;; Cancel our idle timers. - (when (and (or jit-lock-stealth-timer jit-lock-defer-timer) + (when (and (or jit-lock-stealth-timer jit-lock-defer-timer + jit-lock-context-timer) ;; Only if there's no other buffer using them. (not (catch 'found (dolist (buf (buffer-list)) @@ -233,6 +252,9 @@ (when jit-lock-stealth-timer (cancel-timer jit-lock-stealth-timer) (setq jit-lock-stealth-timer nil)) + (when jit-lock-context-timer + (cancel-timer jit-lock-context-timer) + (setq jit-lock-context-timer nil)) (when jit-lock-defer-timer (cancel-timer jit-lock-defer-timer) (setq jit-lock-defer-timer nil))) @@ -248,8 +270,8 @@ that needs to be (re)fontified. If non-nil, CONTEXTUAL means that a contextual fontification would be useful." (add-hook 'jit-lock-functions fun nil t) - (when (and contextual jit-lock-defer-contextually) - (set (make-local-variable 'jit-lock-defer-contextually) t)) + (when (and contextual jit-lock-contextually) + (set (make-local-variable 'jit-lock-contextually) t)) (jit-lock-mode t)) (defun jit-lock-unregister (fun) @@ -281,8 +303,8 @@ ;; No deferral. (jit-lock-fontify-now start (+ start jit-lock-chunk-size)) ;; Record the buffer for later fontification. - (unless (memq (current-buffer) jit-lock-buffers) - (push (current-buffer) jit-lock-buffers)) + (unless (memq (current-buffer) jit-lock-defer-buffers) + (push (current-buffer) jit-lock-defer-buffers)) ;; Mark the area as defer-fontified so that the redisplay engine ;; is happy and so that the idle timer can find the places to fontify. (with-buffer-prepared-for-jit-lock @@ -330,7 +352,13 @@ ;; We mark it first, to make sure that we don't indefinitely ;; re-execute this fontification if an error occurs. (put-text-property start next 'fontified t) - (run-hook-with-args 'jit-lock-functions start next) + (condition-case err + (run-hook-with-args 'jit-lock-functions start next) + ;; If the user quits (which shouldn't happen in normal on-the-fly + ;; jit-locking), make sure the fontification will be performed + ;; before displaying the block again. + (quit (put-text-property start next 'fontified nil) + (funcall 'signal (car err) (cdr err)))) ;; Find the start of the next chunk, if any. (setq start (text-property-any next end 'fontified nil)))))))) @@ -390,11 +418,9 @@ (let ((buffers (buffer-list)) minibuffer-auto-raise message-log-max) - (while (and buffers (not (input-pending-p))) - (let ((buffer (car buffers))) - (setq buffers (cdr buffers)) - - (with-current-buffer buffer + (with-local-quit + (while (and buffers (not (input-pending-p))) + (with-current-buffer (pop buffers) (when jit-lock-mode ;; This is funny. Calling sit-for with 3rd arg non-nil ;; so that it doesn't redisplay, internally calls @@ -414,28 +440,6 @@ (concat "JIT stealth lock " (buffer-name))) - ;; Perform deferred unfontification, if any. - (when jit-lock-first-unfontify-pos - (save-restriction - (widen) - (when (and (>= jit-lock-first-unfontify-pos (point-min)) - (< jit-lock-first-unfontify-pos (point-max))) - ;; If we're in text that matches a complex multi-line - ;; font-lock pattern, make sure the whole text will be - ;; redisplayed eventually. - (when (get-text-property jit-lock-first-unfontify-pos - 'jit-lock-defer-multiline) - (setq jit-lock-first-unfontify-pos - (or (previous-single-property-change - jit-lock-first-unfontify-pos - 'jit-lock-defer-multiline) - (point-min)))) - (with-buffer-prepared-for-jit-lock - (remove-text-properties - jit-lock-first-unfontify-pos (point-max) - '(fontified nil jit-lock-defer-multiline nil))) - (setq jit-lock-first-unfontify-pos (point-max))))) - ;; In the following code, the `sit-for' calls cause a ;; redisplay, so it's required that the ;; buffer-modified flag of a buffer that is displayed @@ -452,8 +456,8 @@ (jit-lock-fontify-now start (+ start jit-lock-chunk-size)) ;; If stealth jit-locking is done backwards, this leads to ;; excessive O(n^2) refontification. -stef - ;; (when (>= jit-lock-first-unfontify-pos start) - ;; (setq jit-lock-first-unfontify-pos end)) + ;; (when (>= jit-lock-context-unfontify-pos start) + ;; (setq jit-lock-context-unfontify-pos end)) ;; Wait a little if load is too high. (when (and jit-lock-stealth-load @@ -466,9 +470,9 @@ (defun jit-lock-deferred-fontify () "Fontify what was deferred." - (when jit-lock-buffers + (when jit-lock-defer-buffers ;; Mark the deferred regions back to `fontified = nil' - (dolist (buffer jit-lock-buffers) + (dolist (buffer jit-lock-defer-buffers) (when (buffer-live-p buffer) (with-current-buffer buffer ;; (message "Jit-Defer %s" (buffer-name)) @@ -482,7 +486,7 @@ pos 'fontified nil (point-max))) 'fontified nil)) (setq pos (next-single-property-change pos 'fontified))))))))) - (setq jit-lock-buffers nil) + (setq jit-lock-defer-buffers nil) ;; Force fontification of the visible parts. (let ((jit-lock-defer-time nil)) ;; (message "Jit-Defer Now") @@ -491,6 +495,36 @@ ))) +(defun jit-lock-context-fontify () + "Refresh fontification to take new context into account." + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when jit-lock-context-unfontify-pos + ;; (message "Jit-Context %s" (buffer-name)) + (save-restriction + (widen) + (when (and (>= jit-lock-context-unfontify-pos (point-min)) + (< jit-lock-context-unfontify-pos (point-max))) + ;; If we're in text that matches a complex multi-line + ;; font-lock pattern, make sure the whole text will be + ;; redisplayed eventually. + ;; Despite its name, we treat jit-lock-defer-multiline here + ;; rather than in jit-lock-defer since it has to do with multiple + ;; lines, i.e. with context. + (when (get-text-property jit-lock-context-unfontify-pos + 'jit-lock-defer-multiline) + (setq jit-lock-context-unfontify-pos + (or (previous-single-property-change + jit-lock-context-unfontify-pos + 'jit-lock-defer-multiline) + (point-min)))) + (with-buffer-prepared-for-jit-lock + ;; Force contextual refontification. + (remove-text-properties + jit-lock-context-unfontify-pos (point-max) + '(fontified nil jit-lock-defer-multiline nil))) + (setq jit-lock-context-unfontify-pos (point-max)))))))) + (defun jit-lock-after-change (start end old-len) "Mark the rest of the buffer as not fontified after a change. Installed on `after-change-functions'. @@ -522,9 +556,9 @@ ;; Request refontification. (put-text-property start end 'fontified nil)) ;; Mark the change for deferred contextual refontification. - (when jit-lock-first-unfontify-pos - (setq jit-lock-first-unfontify-pos - (min jit-lock-first-unfontify-pos start)))))) + (when jit-lock-context-unfontify-pos + (setq jit-lock-context-unfontify-pos + (min jit-lock-context-unfontify-pos start)))))) (provide 'jit-lock)
--- a/lisp/mail/rmail-spam-filter.el Mon Jan 26 21:22:42 2004 +0000 +++ b/lisp/mail/rmail-spam-filter.el Mon Feb 02 19:19:08 2004 +0000 @@ -1,9 +1,9 @@ -;;; rmail-spam-filter.el --- spam filter for RMAIL +;;; rmail-spam-filter.el --- spam filter for rmail, the emacs mail reader. -;; Copyright (C) 2002 -;; Free Software Foundation, Inc. +;; Copyright (C) 2002 Free Software Foundation, Inc. + ;; Keywords: email, spam, filter, rmail -;; Author: Eli Tziperman <eli@beach.weizmann.ac.il> +;; Author: Eli Tziperman <eli AT deas.harvard.edu> ;; This file is part of GNU Emacs. @@ -23,62 +23,69 @@ ;; Boston, MA 02111-1307, USA. ;;; Commentary: +;;; ----------- -;; Automatically recognize and delete junk email before it is -;; displayed in rmail/rmail-summary. Spam emails are defined by -;; specifying one or more of the sender, subject and contents. -;; URL: http://www.weizmann.ac.il/~eli/Downloads/rmail-spam-filter/ +;;; Automatically recognize and delete junk email before it is +;;; displayed in rmail/rmail-summary. Spam emails are defined by +;;; specifying one or more of the sender, subject and contents. +;;; URL: http://deas.harvard.edu/climate/eli/Downloads/rmail-spam-filter/ -;; Usage: -;; ------ - -;; put in your .emacs: +;;; Usage: +;;; ------ -;; (load "rmail-spam-filter.el") +;;; put in your .emacs: -;; and use customize (in rmail-spam-filter group) to: +;;; (load "rmail-spam-filter.el") + +;;; and use customize (in rmail-spam-filter group) to: -;; (*) turn on the variable rmail-use-spam-filter, +;;; (*) turn on the variable rmail-use-spam-filter, -;; (*) specify in variable rmail-spam-definitions-alist what sender, -;; subject and contents make an email be considered spam. +;;; (*) specify in variable rsf-definitions-alist what sender, +;;; subject and contents make an email be considered spam. -;; in addition, you may: +;;; in addition, you may: -;; (*) Block future mail with the subject or sender of a message -;; while reading it in RMAIL: just click on the "Spam" item on the -;; menubar, and add the subject or sender to the list of spam -;; definitions using the mouse and the appropriate menu item. Â You -;; need to later also save the list of spam definitions using the -;; same menu item, or alternatively, see variable -;; `rmail-spam-filter-autosave-newly-added-spam-definitions'. +;;; (*) Block future mail with the subject or sender of a message +;;; while reading it in RMAIL: just click on the "Spam" item on the +;;; menubar, and add the subject or sender to the list of spam +;;; definitions using the mouse and the appropriate menu item. You +;;; need to later also save the list of spam definitions using the +;;; same menu item, or alternatively, see variable +;;; `rsf-autosave-newly-added-definitions'. -;; (*) specify if blind-cc'ed mail (no "To:" header field) is to be -;; treated as spam (variable rmail-spam-no-blind-cc; Thanks to Ethan -;; Brown <ethan@gso.saic.com> for this). +;;; (*) specify if blind-cc'ed mail (no "To:" header field) is to be +;;; treated as spam (variable rsf-no-blind-cc; Thanks to Ethan +;;; Brown <ethan@gso.saic.com> for this). + +;;; (*) specify if rmail-spam-filter should ignore case of spam +;;; definitions (variable rsf-ignore-case; Thanks to +;;; Ethan Brown <ethan@gso.saic.com> for the suggestion). -;; (*) specify if rmail-spam-filter should ignore case of spam -;; definitions (variable rmail-spam-filter-ignore-case; Thanks to -;; Ethan Brown <ethan@gso.saic.com> for the suggestion). - -;; (*) Specify a "white-list" of trusted senders. If any -;; rmail-spam-white-list string matches a substring of the "From" -;; header, the message is flagged as a valid, non-spam message (Ethan -;; Brown <ethan@gso.saic.com>). +;;; (*) Specify a "white-list" of trusted senders. If any +;;; rsf-white-list string matches a substring of the "From" +;;; header, the message is flagged as a valid, non-spam message (Ethan +;;; Brown <ethan@gso.saic.com>). -;; (*) rmail spam filter also works with bbdb to prevent spam senders -;; from entering into the .bbdb file. See variable -;; "rmail-spam-filter-auto-delete-spam-bbdb-entries". This is done -;; in two ways: (a) bbdb is made not to auto-create entries for -;; messages that are deleted by the rmail-spam-filter, (b) when a -;; message is deleted in rmail, the user is offered to delete the -;; sender's bbdb entry as well _if_ it was created at the same day. +;;; (*) rmail-spam-filter is best used with a general purpose spam +;;; filter such as the procmail-based http://www.spambouncer.org/. +;;; Spambouncer is set to only mark messages as spam/blocked/bulk/OK +;;; via special headers, and these headers may then be defined in +;;; rmail-spam-filter such that the spam is rejected by +;;; rmail-spam-filter itself. -;;; Code: +;;; (*) rmail spam filter also works with bbdb to prevent spam senders +;;; from entering into the .bbdb file. See variable +;;; "rsf-auto-delete-spam-bbdb-entries". This is done +;;; in two ways: (a) bbdb is made not to auto-create entries for +;;; messages that are deleted by the rmail-spam-filter, (b) when a +;;; message is deleted in rmail, the user is offered to delete the +;;; sender's bbdb entry as well _if_ it was created at the same day. (require 'rmail) +(require 'rmailsum) -;; For find-if and other cool common lisp functions we may want to use. (EDB) +;; For find-if and other cool common lisp functions we may want to use. (eval-when-compile (require 'cl)) @@ -89,41 +96,51 @@ ;;;###autoload (defcustom rmail-use-spam-filter nil "*Non-nil to activate the rmail spam filter. -Specify `rmail-spam-definitions-alist' to define what you consider spam +Specify `rsf-definitions-alist' to define what you consider spam emails." :type 'boolean :group 'rmail-spam-filter ) -(defcustom rmail-spam-file "~/XRMAIL-SPAM" +(defcustom rsf-file "~/XRMAIL-SPAM" "*Name of rmail file for optionally saving some of the spam. Spam may be either just deleted, or saved in a separate spam file to be looked at at a later time. Whether the spam is just deleted or also saved in a separete spam file is specified for each definition of -spam, as one of the fields of `rmail-spam-definitions-alist'" +spam, as one of the fields of `rsf-definitions-alist'" :type 'string :group 'rmail-spam-filter ) -(defcustom rmail-spam-no-blind-cc nil +(defcustom rsf-no-blind-cc nil "*Non-nil to treat blind CC (no To: header) as spam." :type 'boolean :group 'rmail-spam-filter ) -(defcustom rmail-spam-filter-ignore-case nil - "*Non-nil to ignore case in `rmail-spam-definitions-alist'." +(defcustom rsf-ignore-case nil + "*Non-nil to ignore case in `rsf-definitions-alist'." :type 'boolean :group 'rmail-spam-filter ) -(defcustom rmail-spam-filter-beep nil +(defcustom rsf-beep nil "*Non-nil to beep if spam is found." :type 'boolean :group 'rmail-spam-filter ) -(defcustom rmail-spam-sleep-after-message 2.0 +(defcustom rsf-sleep-after-message 2.0 "*Seconds to wait after display of message that spam was found." :type 'number :group 'rmail-spam-filter ) -(defcustom rmail-spam-filter-auto-delete-spam-bbdb-entries nil +(defcustom rsf-min-region-to-spam-list 7 + "*User may highlight a region in an incomming message and use + the menubar to add this region to the spam definitions. This + variable specifies the minimum size of region that may be added + to spam list, to avoid accidentally adding a too short region + which would result in false positive identification of spam + messages." + :type 'integer + :group 'rmail-spam-filter ) + +(defcustom rsf-auto-delete-spam-bbdb-entries nil "*Non-nil to make sure no entries are made in bbdb for spam emails. This is done in two ways: (1) bbdb is made not to auto-create entries for messages that are deleted by the `rmail-spam-filter', (2) when a @@ -134,7 +151,7 @@ :type 'boolean :group 'rmail-spam-filter ) -(defcustom rmail-spam-filter-autosave-newly-added-spam-definitions nil +(defcustom rsf-autosave-newly-added-definitions nil "*Non-nil to auto save new spam entries. New entries entered via the spam menu bar item are then saved to customization file immediately after being added via the menu bar, and @@ -143,17 +160,17 @@ :type 'boolean :group 'rmail-spam-filter ) -(defcustom rmail-spam-white-list nil +(defcustom rsf-white-list nil "*List of strings to identify valid senders. -If any rmail-spam-white-list string matches a substring of the 'From' +If any rsf-white-list string matches a substring of the 'From' header, the message is flagged as a valid, non-spam message. Example: If your domain is emacs.com then including 'emacs.com' in your -rmail-spam-white-list would flag all mail from your colleagues as +rsf-white-list would flag all mail from your colleagues as valid." :type '(repeat string) :group 'rmail-spam-filter ) -(defcustom rmail-spam-definitions-alist nil +(defcustom rsf-definitions-alist nil "*Alist matching strings defining what messages are considered spam. Each definition may contain specifications of one or more of the elements {subject, sender, recipients or contents}, as well as a @@ -162,8 +179,10 @@ of the spam definitions. The strings that specify spam subject, sender, etc, may be regexp. For example, to specify that the subject may be either 'this is spam' or 'another spam', use the regexp: 'this -is spam\|another spam' (without the single quotes)." - :type '(repeat +is spam\\|another spam' (without the single quotes). To specify that +if the contents contain both this and that the message is spam, +specify 'this\\&that' in the appropriate spam definition field." + :type '(repeat (list :format "%v" (cons :format "%v" :value (from . "") (const :format "" from) @@ -174,25 +193,53 @@ (cons :format "%v" :value (subject . "") (const :format "" subject) (string :tag "Subject" "")) + (cons :format "%v" :value (content-type . "") + (const :format "" content-type) + (string :tag "Content-Type" "")) (cons :format "%v" :value (contents . "") (const :format "" contents) (string :tag "Contents" "")) (cons :format "%v" :value (action . output-and-delete) (const :format "" action) - (choice :tag "Action selection" + (choice :tag "Action selection" (const :tag "output to spam folder and delete" output-and-delete) (const :tag "delete spam" delete-spam) )) )) :group 'rmail-spam-filter) -(defvar rmail-spam-filter-scanning-messages-now nil +(defvar rsf-scanning-messages-now nil "Non nil when rmail-spam-filter scans messages, -for interaction with `rmail-bbdb-auto-delete-spam-entries'") +for interaction with `rsf-bbdb-auto-delete-spam-entries'") + +;; the advantage over the automatic filter definitions is the AND conjunction +;; of in-one-definition-elements +(defun rsf-check-field (field-symbol message-data definition result) + "Check if field-symbol is in `rsf-definitions-alist'. +Capture maybe-spam and this-is-a-spam-email in a cons in result, +where maybe-spam is in first and this-is-a-spam-email is in rest. +The values are returned by destructively changing result. +If FIELD-SYMBOL field does not exist AND is not specified, +this may still be spam due to another element... +if (first result) is nil, we already have a contradiction in another +field" + (let ((definition-field (cdr (assoc field-symbol definition)))) + (if (and (first result) (> (length definition-field) 0)) + ;; only in this case can maybe-spam change from t to nil + ;; ... else, if FIELD-SYMBOL field does appear in the message, + ;; and it also appears in spam definition list, this + ;; is potentially a spam: + (if (and message-data + (string-match definition-field message-data)) + ;; if we do not get a contradiction from another field, this is + ;; spam + (setf (rest result) t) + ;; the message data contradicts the specification, this is no spam + (setf (first result) nil))))) (defun rmail-spam-filter (msg) - "Return nil if msg is spam based on rmail-spam-definitions-alist. -If spam, optionally output msg to a file `rmail-spam-file' and delete + "Return nil if msg is spam based on rsf-definitions-alist. +If spam, optionally output msg to a file `rsf-file' and delete it from rmail file. Called for each new message retrieved by `rmail-get-new-mail'." @@ -203,22 +250,23 @@ (message-sender) (message-recipients) (message-subject) + (message-content-type) (num-spam-definition-elements) (num-element 0) (exit-while-loop nil) (saved-case-fold-search case-fold-search) (save-current-msg) - (rmail-spam-filter-saved-bbdb/mail_auto_create_p nil) + (rsf-saved-bbdb/mail_auto_create_p nil) ) - + ;; make sure bbdb does not create entries for messages while spam ;; filter is scanning the rmail file: - (setq rmail-spam-filter-saved-bbdb/mail_auto_create_p 'bbdb/mail_auto_create_p) + (setq rsf-saved-bbdb/mail_auto_create_p 'bbdb/mail_auto_create_p) (setq bbdb/mail_auto_create_p nil) - ;; let `rmail-bbdb-auto-delete-spam-entries' know that rmail spam + ;; let `rsf-bbdb-auto-delete-spam-entries' know that rmail spam ;; filter is running, so that deletion of rmail messages should be ;; ignored for now: - (setq rmail-spam-filter-scanning-messages-now t) + (setq rsf-scanning-messages-now t) (save-excursion (save-restriction (setq this-is-a-spam-email nil) @@ -228,166 +276,111 @@ (goto-char (rmail-msgbeg msg)) (narrow-to-region (point) (progn (search-forward "\n\n") (point))) (setq message-sender (mail-fetch-field "From")) - (setq message-recipients (mail-fetch-field "To")) + (setq message-recipients + (concat (mail-fetch-field "To") + (if (mail-fetch-field "Cc") + (concat ", " (mail-fetch-field "Cc"))))) (setq message-subject (mail-fetch-field "Subject")) + (setq message-content-type (mail-fetch-field "Content-Type")) ) ;; Find number of spam-definition elements in the list - ;; rmail-spam-definitions-alist specified by user: + ;; rsf-definitions-alist specified by user: (setq num-spam-definition-elements (safe-length - rmail-spam-definitions-alist)) + rsf-definitions-alist)) ;;; do we want to ignore case in spam definitions: - (setq case-fold-search rmail-spam-filter-ignore-case) - + (setq case-fold-search rsf-ignore-case) + ;; Check for blind CC condition. Set vars such that while - ;; loop will be bypassed and spam condition will trigger (EDB) - (if (and rmail-spam-no-blind-cc + ;; loop will be bypassed and spam condition will trigger + (if (and rsf-no-blind-cc (null message-recipients)) - (progn - (setq exit-while-loop t) - (setq maybe-spam t) - (setq this-is-a-spam-email t))) + (setq exit-while-loop t + maybe-spam t + this-is-a-spam-email t)) - ;; Check white list, and likewise cause while loop - ;; bypass. (EDB) - (if (find-if '(lambda (white-str) - (string-match white-str message-sender)) - rmail-spam-white-list) - (progn - (setq exit-while-loop t) - (setq maybe-spam nil) - (setq this-is-a-spam-email nil))) + ;; Check white list, and likewise cause while loop + ;; bypass. + (if (let ((white-list rsf-white-list) + (found nil)) + (while (and (not found) white-list) + (if (string-match (car white-list) message-sender) + (setq found t) + (setq white-list (cdr white-list)))) + found) + (setq exit-while-loop t + maybe-spam nil + this-is-a-spam-email nil)) - ;; scan all elements of the list rmail-spam-definitions-alist + ;; maybe-spam is in first, this-is-a-spam-email in rest, this + ;; simplifies the call to rsf-check-field + (setq maybe-spam (cons maybe-spam this-is-a-spam-email)) + + ;; scan all elements of the list rsf-definitions-alist (while (and (< num-element num-spam-definition-elements) (not exit-while-loop)) - (progn + (let ((definition (nth num-element rsf-definitions-alist))) ;; Initialize maybe-spam which is set to t in one of two ;; cases: (1) unspecified definition-elements are found in - ;; rmail-spam-definitions-alist, (2) empty field is found + ;; rsf-definitions-alist, (2) empty field is found ;; in the message being scanned (e.g. empty subject, ;; sender, recipients, etc). The variable is set to nil ;; if a non empty field of the scanned message does not ;; match a specified field in - ;; rmail-spam-definitions-alist. - (setq maybe-spam t) + ;; rsf-definitions-alist. + ;; initialize this-is-a-spam-email to nil. This variable ;; is set to t if one of the spam definitions matches a ;; field in the scanned message. - (setq this-is-a-spam-email nil) + (setq maybe-spam (cons t nil)) ;; start scanning incoming message: ;;--------------------------------- - - ;; if sender field is not specified in message being + + ;; Maybe the different fields should also be done in a + ;; loop to make the whole thing more flexible + ;; if sender field is not specified in message being ;; scanned, AND if "from" field does not appear in spam ;; definitions for this element, this may still be spam ;; due to another element... - (if (and (not message-sender) - (string-match - (cdr (assoc 'from (nth num-element - rmail-spam-definitions-alist))) "")) - (setq maybe-spam t) - ;; ... else, if message-sender does appear in the - ;; message, and it also appears in the spam definition - ;; list, it is potentially spam: - (if (and message-sender - (string-match - (cdr (assoc 'from (nth num-element - rmail-spam-definitions-alist))) - message-sender) - ) - (setq this-is-a-spam-email t) - (setq maybe-spam nil) - ) - ) - ;; next, if spam was not ruled out already, check recipients: - (if maybe-spam - ;; if To field does not exist AND is not specified, - ;; this may still be spam due to another element... - (if (and (not message-recipients) - (string-match - (cdr (assoc 'to - (nth num-element - rmail-spam-definitions-alist))) "")) - (setq maybe-spam t) - ;; ... else, if To field does appear in the message, - ;; and it also appears in spam definition list, this - ;; is potentially a spam: - (if (and message-recipients - (string-match - (cdr (assoc 'to (nth num-element - rmail-spam-definitions-alist))) - message-recipients) - ) - (setq this-is-a-spam-email t) - (setq maybe-spam nil) - ) - ) - ) - ;; next, if spam was not ruled out already, check subject: - (if maybe-spam - ;; if subject field does not exist AND is not - ;; specified, this may still be spam due to another - ;; element... - (if (and (not message-subject) - (string-match - (cdr (assoc 'subject - (nth num-element - rmail-spam-definitions-alist))) - "")) - (setq maybe-spam t) - ;; ... else, if subject field does appear in the - ;; message, and it also appears in the spam - ;; definition list, this is potentially a spam: - (if (and message-subject - (string-match - (cdr (assoc 'subject (nth num-element - rmail-spam-definitions-alist))) - message-subject) - ) - (setq this-is-a-spam-email t) - (setq maybe-spam nil) - ) - ) - ) + (rsf-check-field 'from message-sender definition maybe-spam) + ;; next, if spam was not ruled out already, check recipients: + (rsf-check-field 'to message-recipients definition maybe-spam) + ;; next, if spam was not ruled out already, check subject: + (rsf-check-field 'subject message-subject definition maybe-spam) + ;; next, if spam was not ruled out already, check content-type: + (rsf-check-field 'content-type message-content-type + definition maybe-spam) ;; next, if spam was not ruled out already, check ;; contents: if contents field is not specified, this may ;; still be spam due to another element... - (if maybe-spam - (if (string-match - (cdr (assoc 'contents - (nth num-element - rmail-spam-definitions-alist))) "") - (setq maybe-spam t) - ;; ... else, check to see if it appears in spam - ;; definition: - (if (string-match - (cdr (assoc 'contents - (nth num-element - rmail-spam-definitions-alist))) - (buffer-substring - (rmail-msgbeg msg) (rmail-msgend msg))) - (setq this-is-a-spam-email t) - (setq maybe-spam nil))) - ) - ;; if the search in rmail-spam-definitions-alist found + (rsf-check-field 'contents + (buffer-substring + (rmail-msgbeg msg) (rmail-msgend msg)) + definition maybe-spam) + + ;; if the search in rsf-definitions-alist found ;; that this email is spam, output the email to the spam ;; rmail file, mark the email for deletion, leave the ;; while loop and return nil so that an rmail summary line ;; wont be displayed for this message: - (if (and this-is-a-spam-email maybe-spam) + (if (and (first maybe-spam) (rest maybe-spam)) ;; found that this is spam, no need to look at the - ;; rest of the rmail-spam-definitions-alist, exit + ;; rest of the rsf-definitions-alist, exit ;; loop: (setq exit-while-loop t) ;; else, spam was not yet found, increment number of - ;; element in rmail-spam-definitions-alist and proceed + ;; element in rsf-definitions-alist and proceed ;; to next element: (setq num-element (+ num-element 1))) ) - ) + ) + + ;; (BK) re-set originally used variables + (setq this-is-a-spam-email (rest maybe-spam) + maybe-spam (first maybe-spam)) + (if (and this-is-a-spam-email maybe-spam) (progn ;;(message "Found spam!") @@ -397,39 +390,42 @@ ;; output and delete the spam msg if needed: (setq save-current-msg rmail-current-message) (setq rmail-current-message msg) - ;; check action item and rmail-spam-definitions-alist + ;; check action item and rsf-definitions-alist ;; and do it: (cond ((equal (cdr (assoc 'action - (nth num-element rmail-spam-definitions-alist))) + (nth num-element rsf-definitions-alist))) 'output-and-delete) (progn - (rmail-output-to-rmail-file rmail-spam-file) - (rmail-delete-message) + (rmail-output-to-rmail-file rsf-file 1 t) + ;; Don't delete if automatic deletion after output + ;; is turned on + (unless rmail-delete-after-output (rmail-delete-message)) )) ((equal (cdr (assoc 'action - (nth num-element rmail-spam-definitions-alist))) + (nth num-element rsf-definitions-alist))) 'delete-spam) (progn (rmail-delete-message) )) ) (setq rmail-current-message save-current-msg) - (setq bbdb/mail_auto_create_p 'rmail-spam-filter-saved-bbdb/mail_auto_create_p) + (setq bbdb/mail_auto_create_p + 'rsf-saved-bbdb/mail_auto_create_p) ;; set return value. These lines must be last in the ;; function, so that they will determine the value ;; returned by rmail-spam-filter: (setq return-value nil)) (setq return-value t)))) (setq case-fold-search saved-case-fold-search) - (setq rmail-spam-filter-scanning-messages-now nil) + (setq rsf-scanning-messages-now nil) return-value)) ;; define functions for interactively adding sender/subject of a ;; specific message to the spam definitions while reading it, using ;; the menubar: -(defun rmail-spam-filter-add-subject-to-spam-list () +(defun rsf-add-subject-to-spam-list () (interactive) (set-buffer rmail-buffer) (let ((message-subject)) @@ -437,15 +433,16 @@ ;; note the use of a backquote and comma on the subject line here, ;; to make sure message-subject is actually evaluated and its value ;; substituted: - (add-to-list 'rmail-spam-definitions-alist + (add-to-list 'rsf-definitions-alist (list '(from . "") '(to . "") `(subject . ,message-subject) + '(content-type . "") '(contents . "") '(action . output-and-delete)) t) - (customize-mark-to-save 'rmail-spam-definitions-alist) - (if rmail-spam-filter-autosave-newly-added-spam-definitions + (customize-mark-to-save 'rsf-definitions-alist) + (if rsf-autosave-newly-added-definitions (progn (custom-save-all) (message (concat "added subject \n <<< \n" message-subject @@ -453,10 +450,11 @@ "and saved the spam definitions to file."))) (message (concat "added subject \n <<< \n" message-subject " \n >>> \n to list of spam definitions. \n" - "Don't forget to save the spam definitions to file using the spam menu")) + "Don't forget to save the spam definitions to file using the spam + menu")) ))) -(defun rmail-spam-filter-add-sender-to-spam-list () +(defun rsf-add-sender-to-spam-list () (interactive) (set-buffer rmail-buffer) (let ((message-sender)) @@ -464,15 +462,16 @@ ;; note the use of a backquote and comma on the "from" line here, ;; to make sure message-sender is actually evaluated and its value ;; substituted: - (add-to-list 'rmail-spam-definitions-alist + (add-to-list 'rsf-definitions-alist (list `(from . ,message-sender) '(to . "") '(subject . "") + '(content-type . "") '(contents . "") '(action . output-and-delete)) t) - (customize-mark-to-save 'rmail-spam-definitions-alist) - (if rmail-spam-filter-autosave-newly-added-spam-definitions + (customize-mark-to-save 'rsf-definitions-alist) + (if rsf-autosave-newly-added-definitions (progn (custom-save-all) (message (concat "added sender \n <<< \n" message-sender @@ -480,13 +479,14 @@ "and saved the spam definitions to file."))) (message (concat "added sender \n <<< \n " message-sender " \n >>> \n to list of spam definitions." - "Don't forget to save the spam definitions to file using the spam menu")) + "Don't forget to save the spam definitions to file using the spam + menu")) ))) -(defun rmail-spam-filter-add-region-to-spam-list () - "Add the region makred by user in the rmail buffer to the list of - spam definitions as a contents field." +(defun rsf-add-region-to-spam-list () + "Add the region makred by user in the rmail buffer to spam list. +Added to spam definitions as a contents field." (interactive) (set-buffer rmail-buffer) (let ((region-to-spam-list)) @@ -494,41 +494,48 @@ (if (not (and mark-active (not (= (region-beginning) (region-end))))) ;; if inactive, print error message: (message "you need to first highlight some text in the rmail buffer") - ;; if active, add to list of spam definisions: - (progn - (setq region-to-spam-list (buffer-substring (region-beginning) (region-end))) - ;; note the use of a backquote and comma on the "from" line here, - ;; to make sure message-sender is actually evaluated and its value - ;; substituted: - (add-to-list 'rmail-spam-definitions-alist - (list '(from . "") - '(to . "") - '(subject . "") - `(contents . ,region-to-spam-list) - '(action . output-and-delete)) - t) - (customize-mark-to-save 'rmail-spam-definitions-alist) - (if rmail-spam-filter-autosave-newly-added-spam-definitions - (progn - (custom-save-all) - (message (concat "added highlighted text \n <<< \n" region-to-spam-list - " \n >>> \n to list of spam definitions. \n" - "and saved the spam definitions to file."))) - (message (concat "added highlighted text \n <<< \n " region-to-spam-list - " \n >>> \n to list of spam definitions." - "Don't forget to save the spam definitions to file using the spam menu")) - ))))) + (if (< (- (region-end) (region-beginning)) rsf-min-region-to-spam-list) + (message + (concat "highlighted region is too small; min length set by variable \n" + "rsf-min-region-to-spam-list" + " is " (number-to-string rsf-min-region-to-spam-list))) + ;; if region active and long enough, add to list of spam definisions: + (progn + (setq region-to-spam-list (buffer-substring (region-beginning) (region-end))) + ;; note the use of a backquote and comma on the "from" line here, + ;; to make sure message-sender is actually evaluated and its value + ;; substituted: + (add-to-list 'rsf-definitions-alist + (list '(from . "") + '(to . "") + '(subject . "") + '(content-type . "") + `(contents . ,region-to-spam-list) + '(action . output-and-delete)) + t) + (customize-mark-to-save 'rsf-definitions-alist) + (if rsf-autosave-newly-added-definitions + (progn + (custom-save-all) + (message (concat "added highlighted text \n <<< \n" region-to-spam-list + " \n >>> \n to list of spam definitions. \n" + "and saved the spam definitions to file."))) + (message (concat "added highlighted text \n <<< \n " region-to-spam-list + " \n >>> \n to list of spam definitions." + "Don't forget to save the spam definitions to file using the + spam menu")) + )))))) -(defun rmail-spam-filter-customize-spam-definitions () +(defun rsf-customize-spam-definitions () (interactive) - (customize-variable (quote rmail-spam-definitions-alist))) + (customize-variable (quote rsf-definitions-alist))) -(defun rmail-spam-filter-customize-group () +(defun rsf-customize-group () (interactive) (customize-group (quote rmail-spam-filter))) -(defun rmail-spam-custom-save-all () +(defun rsf-custom-save-all () (interactive) (custom-save-all)) @@ -540,97 +547,89 @@ (cons "Spam" (make-sparse-keymap "Spam"))) (define-key rmail-summary-mode-map [menu-bar spam customize-group] - '("Browse customizations of rmail spam filter" . rmail-spam-filter-customize-group)) + '("Browse customizations of rmail spam filter" . rsf-customize-group)) (define-key rmail-mode-map [menu-bar spam customize-group] - '("Browse customizations of rmail spam filter" . rmail-spam-filter-customize-group)) -(define-key rmail-summary-mode-map "\C-cSg" 'rmail-spam-filter-customize-group) -(define-key rmail-mode-map "\C-cSg" 'rmail-spam-filter-customize-group) + '("Browse customizations of rmail spam filter" . rsf-customize-group)) +(define-key rmail-summary-mode-map "\C-cSg" 'rsf-customize-group) +(define-key rmail-mode-map "\C-cSg" 'rsf-customize-group) (define-key rmail-summary-mode-map [menu-bar spam customize-spam-list] - '("Customize list of spam definitions" . rmail-spam-filter-customize-spam-definitions)) + '("Customize list of spam definitions" . rsf-customize-spam-definitions)) (define-key rmail-mode-map [menu-bar spam customize-spam-list] - '("Customize list of spam definitions" . rmail-spam-filter-customize-spam-definitions)) -(define-key rmail-summary-mode-map "\C-cSd" 'rmail-spam-filter-customize-spam-definitions) -(define-key rmail-mode-map "\C-cSd" 'rmail-spam-filter-customize-spam-definitions) + '("Customize list of spam definitions" . rsf-customize-spam-definitions)) +(define-key rmail-summary-mode-map "\C-cSd" 'rsf-customize-spam-definitions) +(define-key rmail-mode-map "\C-cSd" 'rsf-customize-spam-definitions) (define-key rmail-summary-mode-map [menu-bar spam lambda] '("----")) (define-key rmail-mode-map [menu-bar spam lambda] '("----")) (define-key rmail-summary-mode-map [menu-bar spam my-custom-save-all] - '("save newly added spam definitions to customization file" . rmail-spam-custom-save-all)) + '("save newly added spam definitions to customization file" . rsf-custom-save-all)) (define-key rmail-mode-map [menu-bar spam my-custom-save-all] - '("save newly added spam definitions to customization file" . rmail-spam-custom-save-all)) -(define-key rmail-summary-mode-map "\C-cSa" 'rmail-spam-custom-save-all) -(define-key rmail-mode-map "\C-cSa" 'rmail-spam-custom-save-all) + '("save newly added spam definitions to customization file" . rsf-custom-save-all)) +(define-key rmail-summary-mode-map "\C-cSa" 'rsf-custom-save-all) +(define-key rmail-mode-map "\C-cSa" 'rsf-custom-save-all) (define-key rmail-summary-mode-map [menu-bar spam add-region-to-spam-list] - '("add region to spam list" . rmail-spam-filter-add-region-to-spam-list)) + '("add region to spam list" . rsf-add-region-to-spam-list)) (define-key rmail-mode-map [menu-bar spam add-region-to-spam-list] - '("add region to spam list" . rmail-spam-filter-add-region-to-spam-list)) -(define-key rmail-summary-mode-map "\C-cSn" 'rmail-spam-filter-add-region-to-spam-list) -(define-key rmail-mode-map "\C-cSn" 'rmail-spam-filter-add-region-to-spam-list) + '("add region to spam list" . rsf-add-region-to-spam-list)) +(define-key rmail-summary-mode-map "\C-cSn" 'rsf-add-region-to-spam-list) +(define-key rmail-mode-map "\C-cSn" 'rsf-add-region-to-spam-list) (define-key rmail-summary-mode-map [menu-bar spam add-sender-to-spam-list] - '("add sender to spam list" . rmail-spam-filter-add-sender-to-spam-list)) + '("add sender to spam list" . rsf-add-sender-to-spam-list)) (define-key rmail-mode-map [menu-bar spam add-sender-to-spam-list] - '("add sender to spam list" . rmail-spam-filter-add-sender-to-spam-list)) -(define-key rmail-summary-mode-map "\C-cSr" 'rmail-spam-filter-add-sender-to-spam-list) -(define-key rmail-mode-map "\C-cSr" 'rmail-spam-filter-add-sender-to-spam-list) + '("add sender to spam list" . rsf-add-sender-to-spam-list)) +(define-key rmail-summary-mode-map "\C-cSr" 'rsf-add-sender-to-spam-list) +(define-key rmail-mode-map "\C-cSr" 'rsf-add-sender-to-spam-list) (define-key rmail-summary-mode-map [menu-bar spam add-subject-to-spam-list] - '("add subject to spam list" . rmail-spam-filter-add-subject-to-spam-list)) + '("add subject to spam list" . rsf-add-subject-to-spam-list)) (define-key rmail-mode-map [menu-bar spam add-subject-to-spam-list] - '("add subject to spam list" . rmail-spam-filter-add-subject-to-spam-list)) -(define-key rmail-summary-mode-map "\C-cSt" 'rmail-spam-filter-add-subject-to-spam-list) -(define-key rmail-mode-map "\C-cSt" 'rmail-spam-filter-add-subject-to-spam-list) - - -(defun rmail-bbdb-auto-delete-spam-entries () - "When deleting a message in RMAIL, check to see if the bbdb entry -was created today, and if it was, prompt to delete it too. This function -needs to be called via the `rmail-delete-message-hook' like this: -\(add-hook 'rmail-delete-message-hook 'rmail-bbdb-auto-delete-spam-entries)" - (interactive) - (require 'bbdb-hooks) - (if (not rmail-spam-filter-scanning-messages-now) - (if (get-buffer "*BBDB*") - (save-excursion - (set-buffer (get-buffer "*BBDB*")) - (if (bbdb-current-record) - (if (equal - (format-time-string bbdb-time-internal-format (current-time)) - (bbdb-record-getprop (bbdb-current-record) 'creation-date)) - (bbdb-delete-current-record (bbdb-current-record)))))))) + '("add subject to spam list" . rsf-add-subject-to-spam-list)) +(define-key rmail-summary-mode-map "\C-cSt" 'rsf-add-subject-to-spam-list) +(define-key rmail-mode-map "\C-cSt" 'rsf-add-subject-to-spam-list) -(defun rmail-spam-filter-bbdb-dont-create-entries-for-spam () - "Make sure senderes of rmail messages marked as deleted are not added to bbdb. -Need to add this as a hook like this: -\(setq bbdb/mail-auto-create-p 'rmail-spam-filter-bbdb-dont-create-entries-for-spam) -and this is also used in conjunction with rmail-bbdb-auto-delete-spam-entries. -More doc: rmail-bbdb-auto-delete-spam-entries will delete newly created bbdb -entries of mail that is deleted. However, if one scrolls back to the deleted -messages, then the sender is again added to the bbdb. This function -prevents this. Also, don't create entries for messages in the `rmail-spam-file'." +(defun rsf-add-content-type-field () + "Maintain backward compatibility with previous versions of rmail-spam-filter. +The most recent version of rmai-spam-filter checks the contents +field of the incoming mail to see if it spam. The format of +`rsf-definitions-alist' has therefore changed. This function +checks to see if old format is used, and if it is, it converts +`rsf-definitions-alist' to the new format. Invoked +automatically, no user input is required." (interactive) - (not - ;; don't create a bbdb entry if one of the following conditions is satisfied: - (or - ;; 1) looking at a deleted message: - (rmail-message-deleted-p rmail-current-message) - ;; 2) looking at messages in rmail-spam-file: - (string-match - (expand-file-name rmail-spam-file) - (expand-file-name (buffer-file-name rmail-buffer))) - ))) - -;; activate bbdb-anti-spam measures: -(if rmail-spam-filter-auto-delete-spam-bbdb-entries - (progn - (add-hook 'rmail-delete-message-hook 'rmail-bbdb-auto-delete-spam-entries) - (setq bbdb/mail-auto-create-p 'rmail-spam-filter-bbdb-dont-create-entries-for-spam) - )) + (if (and rsf-definitions-alist + (not (assoc 'content-type (car rsf-definitions-alist)))) + (let ((result nil) + (current nil) + (definitions rsf-definitions-alist)) + (while definitions + (setq current (car definitions)) + (setq definitions (cdr definitions)) + (setq result + (append result + (list + (list (assoc 'from current) + (assoc 'to current) + (assoc 'subject current) + (cons 'content-type "") + (assoc 'contents current) + (assoc 'action current)))))) + (setq rsf-definitions-alist result) + (customize-mark-to-save 'rsf-definitions-alist) + (if rsf-autosave-newly-added-definitions + (progn + (custom-save-all) + (message (concat "converted spam definitions to new format\n" + "and saved the spam definitions to file."))) + (message (concat "converted spam definitions to new format\n" + "Don't forget to save the spam definitions to file using the + spam menu")) + )))) (provide 'rmail-spam-filter) ;;; arch-tag: 03e1d45d-b72f-4dd7-8f04-e7fd78249746 -;;; rmail-spam-filter.el ends here +;;; rmail-spam-fitler ends here
--- a/lisp/progmodes/executable.el Mon Jan 26 21:22:42 2004 +0000 +++ b/lisp/progmodes/executable.el Mon Feb 02 19:19:08 2004 +0000 @@ -1,6 +1,6 @@ ;;; executable.el --- base functionality for executable interpreter scripts -*- byte-compile-dynamic: t -*- -;; Copyright (C) 1994, 1995, 1996, 2000, 2003 by Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1996, 2000, 2003, 2004 by Free Software Foundation, Inc. ;; Author: Daniel Pfeiffer <occitan@esperanto.org> ;; Keywords: languages, unix @@ -141,6 +141,31 @@ (defvaralias 'executable-binary-suffixes 'exec-suffixes) ;;;###autoload +(defun executable-command-find-posix-p (&optional program) + "Check if PROGRAM handles arguments Posix-style. +If PROGRAM is non-nil, use that instead of \"find\"." + ;; Pick file to search from location we know + (let* ((dir (car load-path)) + (file (find-if + (lambda (x) + ;; Filter directories . and .. + (not (string-match "^\\.\\.?$" x))) + (directory-files dir)))) + (with-temp-buffer + (call-process (or program "find") + nil + (current-buffer) + nil + dir + "-name" + file + "-maxdepth" + "1") + (goto-char (point-min)) + (if (search-forward file nil t) + t)))) + +;;;###autoload (defun executable-find (command) "Search for COMMAND in `exec-path' and return the absolute file name. Return nil if COMMAND is not found anywhere in `exec-path'."
--- a/lisp/progmodes/grep.el Mon Jan 26 21:22:42 2004 +0000 +++ b/lisp/progmodes/grep.el Mon Feb 02 19:19:08 2004 +0000 @@ -318,7 +318,12 @@ 'gnu))) (unless grep-find-command (setq grep-find-command - (cond ((eq grep-find-use-xargs 'gnu) + (cond ((not (executable-command-find-unix-p "find")) + (message + (concat "compile.el: Unix type find(1) not found. " + "Please set `grep-find-command'.")) + nil) + ((eq grep-find-use-xargs 'gnu) (format "%s . -type f -print0 | xargs -0 -e %s" find-program grep-command)) (grep-find-use-xargs @@ -443,11 +448,17 @@ (progn (unless grep-find-command (grep-compute-defaults)) - (list (read-from-minibuffer "Run find (like this): " - grep-find-command nil nil - 'grep-find-history)))) - (let ((null-device nil)) ; see grep - (grep command-args))) + (if grep-find-command + (list (read-from-minibuffer "Run find (like this): " + grep-find-command nil nil + 'grep-find-history)) + ;; No default was set + (read-string + "compile.el: No `grep-find-command' command available. Press RET.") + (list nil)))) + (when (and grep-find-command command-args) + (let ((null-device nil)) ; see grep + (grep command-args)))) (defun grep-expand-command-macros (command &optional regexp files dir excl case-fold) "Patch grep COMMAND replacing <D>, etc."
--- a/lisp/replace.el Mon Jan 26 21:22:42 2004 +0000 +++ b/lisp/replace.el Mon Feb 02 19:19:08 2004 +0000 @@ -223,7 +223,7 @@ (if (and transient-mark-mode mark-active) (region-end))))) (perform-replace regexp (cons 'replace-eval-replacement to-expr) - t t delimited nil nil start end)) + t 'literal delimited nil nil start end)) (defun map-query-replace-regexp (regexp to-strings &optional n start end) "Replace some matches for REGEXP with various strings, in rotation. @@ -1057,7 +1057,7 @@ (case-fold-search (and case-fold-search (string-equal from-string (downcase from-string)))) - (literal (not regexp-flag)) + (literal (or (not regexp-flag) (eq regexp-flag 'literal))) (search-function (if regexp-flag 're-search-forward 'search-forward)) (search-string from-string) (real-match-data nil) ; the match data for the current match
--- a/lisp/server.el Mon Jan 26 21:22:42 2004 +0000 +++ b/lisp/server.el Mon Feb 02 19:19:08 2004 +0000 @@ -1,6 +1,6 @@ ;;; server.el --- Lisp code for GNU Emacs running as server process -;; Copyright (C) 1986,87,92,94,95,96,97,98,99,2000,01,02,2003 +;; Copyright (C) 1986,87,92,94,95,96,97,98,99,2000,01,02,03,2004 ;; Free Software Foundation, Inc. ;; Author: William Sommerfeld <wesommer@athena.mit.edu> @@ -168,8 +168,7 @@ (make-variable-buffer-local 'server-existing-buffer) (defvar server-socket-name - (format "/tmp/emacs%d-%s/server" (user-uid) - (substring (system-name) 0 (string-match "\\." (system-name))))) + (format "/tmp/emacs%d/server" (user-uid))) (defun server-log (string &optional client) "If a *server* buffer exists, write STRING to it for logging purposes."
--- a/lisp/ses.el Mon Jan 26 21:22:42 2004 +0000 +++ b/lisp/ses.el Mon Feb 02 19:19:08 2004 +0000 @@ -1,6 +1,6 @@ ;;;; ses.el -- Simple Emacs Spreadsheet -;; Copyright (C) 2002 Free Software Foundation, Inc. +;; Copyright (C) 2002,03,04 Free Software Foundation, Inc. ;; Author: Jonathan Yavner <jyavner@member.fsf.org> ;; Maintainer: Jonathan Yavner <jyavner@member.fsf.org> @@ -720,11 +720,23 @@ ;;Fill to complete width of all the fields spanned (setq text (concat text (make-string (- maxwidth len) ? ))) ;;Not enough room to end of line or next non-nil field. Truncate - ;;if string; otherwise fill with error indicator + ;;if string or decimal; otherwise fill with error indicator (setq sig `(error "Too wide" ,text)) - (if (stringp value) - (setq text (substring text 0 maxwidth)) - (setq text (make-string maxwidth ?#)))))))) + (cond + ((stringp value) + (setq text (substring text 0 maxwidth))) + ((and (numberp value) + (string-match "\\.[0-9]+" text) + (>= 0 (setq width + (- len maxwidth + (- (match-end 0) (match-beginning 0)))))) + ;; Turn 6.6666666666e+49 into 6.66e+49. Rounding is too hard! + (setq text (concat (substring text + 0 + (- (match-beginning 0) width)) + (substring text (match-end 0))))) + (t + (setq text (make-string maxwidth ?#))))))))) ;;Substitute question marks for tabs and newlines. Newlines are ;;used as row-separators; tabs could confuse the reimport logic. (setq text (replace-regexp-in-string "[\t\n]" "?" text))
--- a/lisp/simple.el Mon Jan 26 21:22:42 2004 +0000 +++ b/lisp/simple.el Mon Feb 02 19:19:08 2004 +0000 @@ -678,15 +678,17 @@ COMMAND is a Lisp expression. Let user edit that expression in the minibuffer, then read and evaluate the result." (let ((command - (unwind-protect - (read-from-minibuffer prompt - (prin1-to-string command) - read-expression-map t - '(command-history . 1)) - ;; If command was added to command-history as a string, - ;; get rid of that. We want only evaluable expressions there. - (if (stringp (car command-history)) - (setq command-history (cdr command-history)))))) + (let ((print-level nil) + (minibuffer-history-sexp-flag (1+ (minibuffer-depth)))) + (unwind-protect + (read-from-minibuffer prompt + (prin1-to-string command) + read-expression-map t + 'command-history) + ;; If command was added to command-history as a string, + ;; get rid of that. We want only evaluable expressions there. + (if (stringp (car command-history)) + (setq command-history (cdr command-history))))))) ;; If command to be redone does not match front of history, ;; add it to the history.
--- a/lisp/term.el Mon Jan 26 21:22:42 2004 +0000 +++ b/lisp/term.el Mon Feb 02 19:19:08 2004 +0000 @@ -1172,6 +1172,7 @@ ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook) (setq this-command 'yank) + (mouse-set-point click) (term-send-raw-string (current-kill (cond ((listp arg) 0) ((eq arg '-) -1)
--- a/lisp/term/x-win.el Mon Jan 26 21:22:42 2004 +0000 +++ b/lisp/term/x-win.el Mon Feb 02 19:19:08 2004 +0000 @@ -2201,8 +2201,10 @@ (error nil)) utf8-coding last-coding-system-used) (if utf8 - ;; If it is a locale selection, choose it. - (or (get-text-property 0 'foreign-selection utf8) + ;; If it is a local selection, or it contains only + ;; ASCII characers, choose it. + (if (or (not (get-text-property 0 'foreign-selection utf8)) + (= (length utf8) (string-bytes utf8))) (setq text utf8))) ;; If not yet decided, try COMPOUND_TEXT. (if (not text)
--- a/lisp/textmodes/fill.el Mon Jan 26 21:22:42 2004 +0000 +++ b/lisp/textmodes/fill.el Mon Feb 02 19:19:08 2004 +0000 @@ -423,9 +423,13 @@ ((string-match "\\[[^][]*\\(\\.\\)[^][]*\\]" sentence-end) (concat (replace-match ".:" nil nil sentence-end 1) "$")) ;; Can't find the right spot to insert the colon. - (t "[.?!:][])}\"']*$")))) + (t "[.?!:][])}\"']*$"))) + (sentence-end-without-space-list + (string-to-list sentence-end-without-space))) (while (re-search-forward eol-double-space-re to t) (or (>= (point) to) (memq (char-before) '(?\t ?\ )) + (memq (char-after (match-beginning 0)) + sentence-end-without-space-list) (insert-and-inherit ?\ )))) (goto-char from)
--- a/lisp/textmodes/paragraphs.el Mon Jan 26 21:22:42 2004 +0000 +++ b/lisp/textmodes/paragraphs.el Mon Feb 02 19:19:08 2004 +0000 @@ -132,14 +132,23 @@ :type 'boolean :group 'fill) +(defcustom sentence-end-without-space + "$B!#!%!)!*$A!##.#?#!$(0!$!%!)!*$(G!$!%!)!*(B" + "*String containing characters that end sentence without following spaces. +If you change this, you should also change `sentence-end'. See Info +node `Sentences'." + :group 'paragraphs + :type 'string) + (defcustom sentence-end (purecopy ;; This is a bit stupid since it's not auto-updated when the ;; other variables are changes, but it's still useful info. (concat (if sentence-end-without-period "\\w \\|") - "[.?!$B!#!%!)!*$A!##.#?#!$(0!$!%!)!*$(G!$!%!)!*(B][]\"')}]*" + "\\([.?!][]\"')}]*" (if sentence-end-double-space "\\($\\| $\\|\t\\| \\)" "\\($\\|[\t ]\\)") + "\\|[" sentence-end-without-space "]+\\)" "[ \t\n]*")) "*Regexp describing the end of a sentence. The value includes the whitespace following the sentence.
--- a/lispref/ChangeLog Mon Jan 26 21:22:42 2004 +0000 +++ b/lispref/ChangeLog Mon Feb 02 19:19:08 2004 +0000 @@ -1,3 +1,10 @@ +2004-01-26 Luc Teirlinck <teirllm@auburn.edu> + + * strings.texi (Text Comparison): assoc-string also matches + elements of alists that are strings instead of conses. + (Formatting Strings): Standardize Texinfo usage. Update index + entries. + 2004-01-20 Luc Teirlinck <teirllm@auburn.edu> * lists.texi (Sets And Lists): Add delete-dups.
--- a/lispref/strings.texi Mon Jan 26 21:22:42 2004 +0000 +++ b/lispref/strings.texi Mon Feb 02 19:19:08 2004 +0000 @@ -293,7 +293,7 @@ @end example The result is not @samp{("" "two" "words" "")}, which would rarely be -useful. If you need such a result, use an explict value for +useful. If you need such a result, use an explicit value for @var{separators}: @example @@ -530,6 +530,9 @@ This function works like @code{assoc}, except that @var{key} must be a string, and comparison is done using @code{compare-strings}. If @var{case-fold} is non-@code{nil}, it ignores case differences. +Unlike @code{assoc}, this function can also match elements of the alist +that are strings rather than conses. In particular, @var{alist} can +be a list of strings rather than an actual alist. @xref{Association Lists}. @end defun @@ -795,21 +798,20 @@ @end group @end example -@cindex numeric prefix @cindex field width @cindex padding All the specification characters allow an optional ``width'', which is a digit-string between the @samp{%} and the character. If the printed representation of the object contains fewer characters than this width, then it is padded. The padding is on the left if the -prefix is positive (or starts with zero) and on the right if the -prefix is negative. The padding character is normally a space, but if +width is positive (or starts with zero) and on the right if the +width is negative. The padding character is normally a space, but if the width starts with a zero, zeros are used for padding. Some of these conventions are ignored for specification characters for which -they do not make sense. That is, %s, %S and %c accept a width -starting with 0, but still pad with @emph{spaces} on the left. Also, -%% accepts a width, but ignores it. Here are some examples of -padding: +they do not make sense. That is, @samp{%s}, @samp{%S} and @samp{%c} +accept a width starting with 0, but still pad with @emph{spaces} on +the left. Also, @samp{%%} accepts a width, but ignores it. Here are +some examples of padding: @example (format "%06d is padded on the left with zeros" 123) @@ -849,27 +851,31 @@ @end group @end smallexample +@cindex precision in format specifications All the specification characters allow an optional ``precision'' before the character (after the width, if present). The precision is a decimal-point @samp{.} followed by a digit-string. For the -floating-point specifications (%e, %f, %g), the precision specifies -how many decimal places to show; if zero, the decimal-point itself is -also omitted. For %s and %S, the precision truncates the string to -the given width, so @code{"%.3s"} shows only the first three -characters of the representation for @var{object}. Precision is -ignored for other specification characters. +floating-point specifications (@samp{%e}, @samp{%f}, @samp{%g}), the +precision specifies how many decimal places to show; if zero, the +decimal-point itself is also omitted. For @samp{%s} and @samp{%S}, +the precision truncates the string to the given width, so +@samp{%.3s} shows only the first three characters of the +representation for @var{object}. Precision is ignored for other +specification characters. -Immediately after the % and before the optional width and precision, -you can put certain ``flag'' characters. +@cindex flags in format specifications +Immediately after the @samp{%} and before the optional width and +precision, you can put certain ``flag'' characters. -A space @var{" "} inserts a space for positive numbers (otherwise +A space character inserts a space for positive numbers (otherwise nothing is inserted for positive numbers). This flag is ignored -except for %d, %e, %f, %g. +except for @samp{%d}, @samp{%e}, @samp{%f}, @samp{%g}. -The flag @var{"#"} indicates ``alternate form''. For %o it ensures -that the result begins with a 0. For %x and %X the result is prefixed -with ``0x'' or ``0X''. For %e, %f, and %g a decimal point is always -shown even if the precision is zero. +The flag @samp{#} indicates ``alternate form''. For @samp{%o} it +ensures that the result begins with a 0. For @samp{%x} and @samp{%X} +the result is prefixed with @samp{0x} or @samp{0X}. For @samp{%e}, +@samp{%f}, and @samp{%g} a decimal point is always shown even if the +precision is zero. @node Case Conversion @comment node-name, next, previous, up @@ -1035,7 +1041,7 @@ canonical equivalent character (which should be either @samp{a} for both of them, or @samp{A} for both of them). - The extra table @var{equivalences} is a map that cyclicly permutes + The extra table @var{equivalences} is a map that cyclically permutes each equivalence class (of characters with the same canonical equivalent). (For ordinary @acronym{ASCII}, this would map @samp{a} into @samp{A} and @samp{A} into @samp{a}, and likewise for each set of
--- a/nt/ChangeLog Mon Jan 26 21:22:42 2004 +0000 +++ b/nt/ChangeLog Mon Feb 02 19:19:08 2004 +0000 @@ -1,12 +1,16 @@ +2004-01-28 Peter Runestig <peter@runestig.com> + + * gmake.defs, nmake.defs: Add linking to ``winspool.lib''. + 2003-12-24 Miles Bader <miles@gnu.ai.mit.edu> * .cvsignore: Add `.arch-inventory'. -2003-11-22 Lars Hansen <larsh@math.ku.dk> +2003-11-22 Lars Hansen <larsh@math.ku.dk> * inc/grp.h: Added. -2003-09-03 Peter Runestig <peter@runestig.com> +2003-09-03 Peter Runestig <peter@runestig.com> * configure.bat: Create ``makefile'' in directories man, lispref and lispintro.
--- a/nt/gmake.defs Mon Jan 26 21:22:42 2004 +0000 +++ b/nt/gmake.defs Mon Feb 02 19:19:08 2004 +0000 @@ -177,6 +177,7 @@ USER32 = -luser32 WSOCK32 = -lwsock32 WINMM = -lwinmm +WINSPOOL = -lwinspool ifdef NOOPT DEBUG_CFLAGS = -DEMACSDEBUG
--- a/nt/nmake.defs Mon Jan 26 21:22:42 2004 +0000 +++ b/nt/nmake.defs Mon Feb 02 19:19:08 2004 +0000 @@ -124,6 +124,7 @@ USER32 = user32.lib WSOCK32 = wsock32.lib WINMM = winmm.lib +WINSPOOL = winspool.lib !ifdef NOOPT DEBUG_CFLAGS = -DEMACSDEBUG
--- a/src/ChangeLog Mon Jan 26 21:22:42 2004 +0000 +++ b/src/ChangeLog Mon Feb 02 19:19:08 2004 +0000 @@ -1,3 +1,73 @@ +2004-02-02 Kenichi Handa <handa@m17n.org> + + * coding.c (coding_restore_composition): Check invalid + composition data more rigidly. + +2004-01-30 Luc Teirlinck <teirllm@auburn.edu> + + * fileio.c (Fread_file_name_internal): Correctly handle the case + where insert-default-directory is nil. + (Fread_file_name): Always return an empty string if the user exits + with an empty minibuffer. Adapt the docstring accordingly. + (syms_of_fileio): Adapt the docstring of insert-default-directory + to the change in Fread_file_name. + +2004-01-29 Eli Zaretskii <eliz@elta.co.il> + + * alloca.c [!alloca]: Fix the prototype for xfree. + +2004-01-29 Kenichi Handa <handa@m17n.org> + + * fns.c (string_char_to_byte): Optimize for ASCII only string. + (string_byte_to_char): Likewise. + +2004-01-28 Peter Runestig <peter@runestig.com> + + * makefile.w32-in, w32fns.c: Add `default-printer-name' function. + +2004-01-27 Steven Tamm <steventamm@mac.com> + + * unexmacosx.c (unexec_copy): Do not copy more than was + requested to prevent overwriting during unexec. + +2004-01-27 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * process.c (sigchld_handler): Add comment about not calling malloc. + + * process.h: Add extern to synch_process_termsig. + +2004-01-27 Steven Tamm <steventamm@mac.com> + + * macterm.c (make_mac_frame, make_mac_terminal_frame): Move + setting of scroll bars from make_mac_frame to + make_mac_terminal_frame to prevent clobbering of + scroll-bar-mode. + +2004-01-26 Richard M. Stallman <rms@gnu.org> + + * search.c (Freplace_match): Handle nonexistent + back-references properly. + +2004-01-03 Richard M. Stallman <rms@gnu.org> + + * window.c (decode_any_window): New function. + (Fwindow_height, Fwindow_width, Fwindow_edges) + (Fwindow_pixel_edges, Fwindow_inside_edges) + (Fwindow_inside_pixel_edges): Use decode_any_window. + +2004-01-27 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * process.h: synch_process_termsig new variable. + + * callproc.c: Define synch_process_termsig. + (Fcall_process): Initiate synch_process_termsig to zero and + check if non-zero and get signal name after subprocess has ended. + + * process.c (sigchld_handler): Set synch_process_termsig + if terminated by a signal. synch_process_death setting removed. + + * sysdep.c (mkdir, rmdir): Also check synch_process_termsig. + 2004-01-26 Andreas Schwab <schwab@suse.de> * print.c (print_preprocess): Declare size as EMACS_INT to not
--- a/src/alloca.c Mon Jan 26 21:22:42 2004 +0000 +++ b/src/alloca.c Mon Feb 02 19:19:08 2004 +0000 @@ -100,7 +100,7 @@ # define free xfree void *xmalloc _P ((size_t)); -void xfree _P ((void *)) +void xfree _P ((void *)); /* Define STACK_DIRECTION if you know the direction of stack growth for your system; otherwise it will be automatically
--- a/src/callproc.c Mon Jan 26 21:22:42 2004 +0000 +++ b/src/callproc.c Mon Feb 02 19:19:08 2004 +0000 @@ -123,6 +123,9 @@ /* Nonzero => this is a string explaining death of synchronous subprocess. */ char *synch_process_death; +/* Nonzero => this is the signal number that terminated the subprocess. */ +int synch_process_termsig; + /* If synch_process_death is zero, this is exit code of synchronous subprocess. */ int synch_process_retcode; @@ -506,6 +509,7 @@ to avoid timing error if process terminates soon. */ synch_process_death = 0; synch_process_retcode = 0; + synch_process_termsig = 0; if (NILP (error_file)) fd_error = emacs_open (NULL_DEVICE, O_WRONLY, 0); @@ -977,6 +981,19 @@ unbind_to (count, Qnil); + if (synch_process_termsig) + { + char *signame; + + synchronize_system_messages_locale (); + signame = strsignal (synch_process_termsig); + + if (signame == 0) + signame = "unknown"; + + synch_process_death = signame; + } + if (synch_process_death) return code_convert_string_norecord (build_string (synch_process_death), Vlocale_coding_system, 0);
--- a/src/coding.c Mon Jan 26 21:22:42 2004 +0000 +++ b/src/coding.c Mon Feb 02 19:19:08 2004 +0000 @@ -5458,6 +5458,9 @@ if (method == COMPOSITION_WITH_RULE_ALTCHARS && len % 2 == 0) len --; + if (len < 1) + /* Invalid composition data. */ + break; for (j = 0; j < len; j++) args[j] = make_number (data[4 + j]); components = (method == COMPOSITION_WITH_ALTCHARS
--- a/src/fileio.c Mon Jan 26 21:22:42 2004 +0000 +++ b/src/fileio.c Mon Feb 02 19:19:08 2004 +0000 @@ -6095,6 +6095,7 @@ if (SCHARS (name) == 0) return Qt; #endif /* VMS */ + string = Fexpand_file_name (string, dir); if (!NILP (Vread_file_name_predicate)) return call1 (Vread_file_name_predicate, string); return Ffile_exists_p (string); @@ -6103,15 +6104,20 @@ DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 6, 0, doc: /* Read file name, prompting with PROMPT and completing in directory DIR. Value is not expanded---you must call `expand-file-name' yourself. -Default name to DEFAULT-FILENAME if user enters a null string. +Default name to DEFAULT-FILENAME if user exits the minibuffer with +the same non-empty string that was inserted by this function. (If DEFAULT-FILENAME is omitted, the visited file name is used, except that if INITIAL is specified, that combined with DIR is used.) +If the user exits with an empty minibuffer, this function returns +an empty string. (This can only happen if the user erased the +pre-inserted contents or if `insert-default-directory' is nil.) Fourth arg MUSTMATCH non-nil means require existing file's name. Non-nil and non-t means also require confirmation after completion. Fifth arg INITIAL specifies text to start with. -If optional sixth arg PREDICATE is non-nil, possible completions and the -resulting file name must satisfy (funcall PREDICATE NAME). -DIR defaults to current buffer's directory default. +If optional sixth arg PREDICATE is non-nil, possible completions and +the resulting file name must satisfy (funcall PREDICATE NAME). +DIR should be an absolute directory name. It defaults to the value of +`default-directory'. If this command was invoked with the mouse, use a file dialog box if `use-dialog-box' is non-nil, and the window system or X toolkit in use @@ -6275,13 +6281,6 @@ if (!NILP (tem) && !NILP (default_filename)) val = default_filename; - else if (SCHARS (val) == 0 && NILP (insdef)) - { - if (!NILP (default_filename)) - val = default_filename; - else - error ("No default file name"); - } val = Fsubstitute_in_file_name (val); if (replace_in_history) @@ -6457,7 +6456,20 @@ Vread_file_name_predicate = Qnil; DEFVAR_BOOL ("insert-default-directory", &insert_default_directory, - doc: /* *Non-nil means when reading a filename start with default dir in minibuffer. */); + doc: /* *Non-nil means when reading a filename start with default dir in minibuffer. +If the initial minibuffer contents are non-empty, you can usually +request a default filename by typing RETURN without editing. For some +commands, exiting with an empty minibuffer has a special meaning, +such as making the current buffer visit no file in the case of +`set-visited-file-name'. +If this variable is non-nil, the minibuffer contents are always +initially non-empty and typing RETURN without editing will fetch the +default name, if one is provided. Note however that this default name +is not necessarily the name originally inserted in the minibuffer, if +that is just the default directory. +If this variable is nil, the minibuffer often starts out empty. In +that case you may have to explicitly fetch the next history element to +request the default name. */); insert_default_directory = 1; DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm,
--- a/src/fns.c Mon Jan 26 21:22:42 2004 +0000 +++ b/src/fns.c Mon Feb 02 19:19:08 2004 +0000 @@ -884,12 +884,11 @@ int best_below, best_below_byte; int best_above, best_above_byte; - if (! STRING_MULTIBYTE (string)) - return char_index; - best_below = best_below_byte = 0; best_above = SCHARS (string); best_above_byte = SBYTES (string); + if (best_above == best_above_byte) + return char_index; if (EQ (string, string_char_byte_cache_string)) { @@ -957,12 +956,11 @@ int best_below, best_below_byte; int best_above, best_above_byte; - if (! STRING_MULTIBYTE (string)) - return byte_index; - best_below = best_below_byte = 0; best_above = SCHARS (string); best_above_byte = SBYTES (string); + if (best_above == best_above_byte) + return byte_index; if (EQ (string, string_char_byte_cache_string)) {
--- a/src/macterm.c Mon Jan 26 21:22:42 2004 +0000 +++ b/src/macterm.c Mon Feb 02 19:19:08 2004 +0000 @@ -8205,9 +8205,6 @@ void make_mac_frame (struct frame *f) { - FRAME_CAN_HAVE_SCROLL_BARS (f) = 1; - FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_right; - FRAME_DESIRED_CURSOR (f) = FILLED_BOX_CURSOR; NewMacWindow(f); @@ -8256,6 +8253,9 @@ FRAME_COLS (f) = 96; FRAME_LINES (f) = 4; + FRAME_CAN_HAVE_SCROLL_BARS (f) = 1; + FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_right; + make_mac_frame (f); x_make_gc (f);
--- a/src/makefile.w32-in Mon Jan 26 21:22:42 2004 +0000 +++ b/src/makefile.w32-in Mon Feb 02 19:19:08 2004 +0000 @@ -140,6 +140,7 @@ $(USER32) \ $(MPR) \ $(SHELL32) \ + $(WINSPOOL) \ $(libc) #
--- a/src/process.c Mon Jan 26 21:22:42 2004 +0000 +++ b/src/process.c Mon Feb 02 19:19:08 2004 +0000 @@ -6094,7 +6094,10 @@ queued and the signal-catching function will be continually reentered until the queue is empty". Invoking signal() causes the kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems - Inc. */ + Inc. + + ** Malloc WARNING: This should never call malloc either directly or + indirectly; if it does, that is a bug */ SIGTYPE sigchld_handler (signo) @@ -6212,18 +6215,7 @@ if (WIFEXITED (w)) synch_process_retcode = WRETCODE (w); else if (WIFSIGNALED (w)) - { - int code = WTERMSIG (w); - char *signame; - - synchronize_system_messages_locale (); - signame = strsignal (code); - - if (signame == 0) - signame = "unknown"; - - synch_process_death = signame; - } + synch_process_termsig = WTERMSIG (w); /* Tell wait_reading_process_input that it needs to wake up and look around. */
--- a/src/process.h Mon Jan 26 21:22:42 2004 +0000 +++ b/src/process.h Mon Feb 02 19:19:08 2004 +0000 @@ -136,6 +136,9 @@ /* Nonzero => this is a string explaining death of synchronous subprocess. */ extern char *synch_process_death; +/* Nonzero => this is the signal number that terminated the subprocess. */ +extern int synch_process_termsig; + /* If synch_process_death is zero, this is exit code of synchronous subprocess. */ extern int synch_process_retcode;
--- a/src/search.c Mon Jan 26 21:22:42 2004 +0000 +++ b/src/search.c Mon Feb 02 19:19:08 2004 +0000 @@ -2366,13 +2366,21 @@ substart = search_regs.start[sub]; subend = search_regs.end[sub]; } - else if (c >= '1' && c <= '9' && c <= search_regs.num_regs + '0') + else if (c >= '1' && c <= '9') { - if (search_regs.start[c - '0'] >= 0) + if (search_regs.start[c - '0'] >= 0 + && c <= search_regs.num_regs + '0') { substart = search_regs.start[c - '0']; subend = search_regs.end[c - '0']; } + else + { + /* If that subexp did not match, + replace \\N with nothing. */ + substart = 0; + subend = 0; + } } else if (c == '\\') delbackslash = 1;
--- a/src/sysdep.c Mon Jan 26 21:22:42 2004 +0000 +++ b/src/sysdep.c Mon Feb 02 19:19:08 2004 +0000 @@ -3832,7 +3832,8 @@ wait_for_termination (cpid); } - if (synch_process_death != 0 || synch_process_retcode != 0) + if (synch_process_death != 0 || synch_process_retcode != 0 + || synch_process_termsig != 0) { errno = EIO; /* We don't know why, but */ return -1; /* /bin/mkdir failed */ @@ -3878,7 +3879,8 @@ wait_for_termination (cpid); } - if (synch_process_death != 0 || synch_process_retcode != 0) + if (synch_process_death != 0 || synch_process_retcode != 0 + || synch_process_termsig != 0) { errno = EIO; /* We don't know why, but */ return -1; /* /bin/rmdir failed */
--- a/src/unexmacosx.c Mon Jan 26 21:22:42 2004 +0000 +++ b/src/unexmacosx.c Mon Feb 02 19:19:08 2004 +0000 @@ -192,6 +192,7 @@ unexec_copy (off_t dest, off_t src, ssize_t count) { ssize_t bytes_read; + ssize_t bytes_to_read; char buf[UNEXEC_COPY_BUFSZ]; @@ -203,7 +204,8 @@ while (count > 0) { - bytes_read = read (infd, buf, UNEXEC_COPY_BUFSZ); + bytes_to_read = count > UNEXEC_COPY_BUFSZ ? UNEXEC_COPY_BUFSZ : count; + bytes_read = read (infd, buf, bytes_to_read); if (bytes_read <= 0) return 0; if (write (outfd, buf, bytes_read) != bytes_read)
--- a/src/w32fns.c Mon Jan 26 21:22:42 2004 +0000 +++ b/src/w32fns.c Mon Feb 02 19:19:08 2004 +0000 @@ -51,6 +51,7 @@ #include <commdlg.h> #include <shellapi.h> #include <ctype.h> +#include <winspool.h> #include <dlgs.h> #define FILE_NAME_TEXT_FIELD edt1 @@ -13921,6 +13922,76 @@ return value; } +DEFUN ("default-printer-name", Fdefault_printer_name, Sdefault_printer_name, + 0, 0, 0, doc: /* Return the name of Windows default printer device. */) + () +{ + static char pname_buf[256]; + int err; + HANDLE hPrn; + PRINTER_INFO_2 *ppi2 = NULL; + DWORD dwNeeded = 0, dwReturned = 0; + + /* Retrieve the default string from Win.ini (the registry). + * String will be in form "printername,drivername,portname". + * This is the most portable way to get the default printer. */ + if (GetProfileString ("windows", "device", ",,", pname_buf, sizeof (pname_buf)) <= 0) + return Qnil; + /* printername precedes first "," character */ + strtok (pname_buf, ","); + /* We want to know more than the printer name */ + if (!OpenPrinter (pname_buf, &hPrn, NULL)) + return Qnil; + GetPrinter (hPrn, 2, NULL, 0, &dwNeeded); + if (dwNeeded == 0) + { + ClosePrinter (hPrn); + return Qnil; + } + /* Allocate memory for the PRINTER_INFO_2 struct */ + ppi2 = (PRINTER_INFO_2 *) xmalloc (dwNeeded); + if (!ppi2) + { + ClosePrinter (hPrn); + return Qnil; + } + /* Call GetPrinter() again with big enouth memory block */ + err = GetPrinter (hPrn, 2, (LPBYTE)ppi2, dwNeeded, &dwReturned); + ClosePrinter (hPrn); + if (!err) + { + xfree(ppi2); + return Qnil; + } + + if (ppi2) + { + if (ppi2->Attributes & PRINTER_ATTRIBUTE_SHARED && ppi2->pServerName) + { + /* a remote printer */ + if (*ppi2->pServerName == '\\') + _snprintf(pname_buf, sizeof (pname_buf), "%s\\%s", ppi2->pServerName, + ppi2->pShareName); + else + _snprintf(pname_buf, sizeof (pname_buf), "\\\\%s\\%s", ppi2->pServerName, + ppi2->pShareName); + pname_buf[sizeof (pname_buf) - 1] = '\0'; + } + else + { + /* a local printer */ + strncpy(pname_buf, ppi2->pPortName, sizeof (pname_buf)); + pname_buf[sizeof (pname_buf) - 1] = '\0'; + /* `pPortName' can include several ports, delimited by ','. + * we only use the first one. */ + strtok(pname_buf, ","); + } + xfree(ppi2); + } + + return build_string (pname_buf); +} + /*********************************************************************** Initialization ***********************************************************************/ @@ -14373,6 +14444,7 @@ defsubr (&Sw32_find_bdf_fonts); defsubr (&Sfile_system_info); + defsubr (&Sdefault_printer_name); /* Setting callback functions for fontset handler. */ get_font_info_func = w32_get_font_info;