mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-27 07:37:33 +00:00
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
This commit is contained in:
Karoly Lorentey
commit
d3a6748c5b
@ -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>
|
||||
|
||||
|
||||
6
configure
vendored
6
configure
vendored
@ -2610,6 +2610,12 @@ _ACEOF
|
||||
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
|
||||
|
||||
@ -1135,6 +1135,12 @@ dnl see the `changequote' comment above.
|
||||
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
|
||||
|
||||
13
etc/NEWS
13
etc/NEWS
@ -856,13 +856,20 @@ Instead, the `$ENVVAR' text is left as is, so that `$$' quoting
|
||||
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 @@ configuration files.
|
||||
|
||||
* 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
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -1254,37 +1254,30 @@ This keyboard layout is standard for Bulgarian typewriters.
|
||||
|
||||
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 @@ are transformed into ' and $,1(K(B respectively."
|
||||
("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)
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -382,8 +382,6 @@ main (argc, argv)
|
||||
int argc;
|
||||
char **argv;
|
||||
{
|
||||
char *system_name;
|
||||
int system_name_length;
|
||||
int s, i, needlf = 0;
|
||||
FILE *out, *in;
|
||||
struct sockaddr_un server;
|
||||
@ -417,40 +415,25 @@ main (argc, argv)
|
||||
|
||||
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 @@ main (argc, argv)
|
||||
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);
|
||||
|
||||
166
lisp/ChangeLog
166
lisp/ChangeLog
@ -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>
|
||||
|
||||
|
||||
@ -378,7 +378,8 @@ indicates a specific program should be invoked."
|
||||
(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 @@ indicates a specific program should be invoked."
|
||||
(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)))
|
||||
|
||||
|
||||
@ -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 @@ if you change this variable."
|
||||
: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 @@ Each element looks like (FUNCTIONNAME . DEFINITION). It is
|
||||
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 @@ otherwise pop it")
|
||||
|
||||
(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 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
|
||||
(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 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
|
||||
"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 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
|
||||
(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 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
|
||||
(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 FORM is a lambda or a macro, byte-compile it as a function."
|
||||
(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 FORM is a lambda or a macro, byte-compile it as a function."
|
||||
(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 FORM is a lambda or a macro, byte-compile it as a function."
|
||||
(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)
|
||||
|
||||
@ -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 @@ found, do widen first and then call NARROWFUN with no args after moving."
|
||||
(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 @@ found, do widen first and then call NARROWFUN with no args after moving."
|
||||
(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 @@ found, do widen first and then call NARROWFUN with no args after moving."
|
||||
(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))
|
||||
|
||||
@ -188,7 +188,8 @@ If variable `beginning-of-defun-function' is non-nil, its value
|
||||
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 @@ If variable `end-of-defun-function' is non-nil, its value
|
||||
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 @@ already marked."
|
||||
(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))
|
||||
(end-of-defun)
|
||||
(push-mark (point) nil t)
|
||||
(beginning-of-defun)
|
||||
(push-mark (point) nil t)
|
||||
(end-of-defun)
|
||||
(exchange-point-and-mark)
|
||||
(re-search-backward "^\n" (- (point) 1) t))))
|
||||
|
||||
(defun narrow-to-defun (&optional arg)
|
||||
@ -280,10 +286,13 @@ Optional ARG is ignored."
|
||||
(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.
|
||||
|
||||
@ -170,6 +170,19 @@ do not use this variable."
|
||||
: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 @@ be added to the cache."
|
||||
;; 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 @@ in each directory, not to the directory list itself."
|
||||
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)))
|
||||
|
||||
|
||||
@ -490,13 +490,18 @@ patterns and to guarantee valid names."
|
||||
(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
|
||||
|
||||
@ -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 @@ This function could be MATCHER in a MATCH-ANCHORED `font-lock-keywords' item."
|
||||
|
||||
(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
|
||||
|
||||
@ -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 @@ Return nil if there is nothing appropriate in the buffer near point."
|
||||
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
|
||||
|
||||
150
lisp/jit-lock.el
150
lisp/jit-lock.el
@ -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 @@ Preserves the `buffer-modified-p' state of the current buffer."
|
||||
|
||||
;;; 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 @@ See also `jit-lock-stealth-nice'."
|
||||
: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 @@ The value of this variable is used when JIT Lock mode is turned on."
|
||||
(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 @@ If nil, fontification is not deferred."
|
||||
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 @@ following ways:
|
||||
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 @@ the variable `jit-lock-stealth-nice'."
|
||||
(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 @@ the variable `jit-lock-stealth-nice'."
|
||||
;; 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 @@ the variable `jit-lock-stealth-nice'."
|
||||
(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 @@ FUN will be called with two arguments START and END indicating the region
|
||||
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 @@ is active."
|
||||
;; 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 @@ Defaults to the whole buffer. END can be out of bounds."
|
||||
;; 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 @@ This functions is called after Emacs has been idle for
|
||||
(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 @@ This functions is called after Emacs has been idle for
|
||||
(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 @@ This functions is called after Emacs has been idle for
|
||||
(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 @@ This functions is called after Emacs has been idle for
|
||||
|
||||
(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 @@ This functions is called after Emacs has been idle for
|
||||
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 @@ This functions is called after Emacs has been idle for
|
||||
)))
|
||||
|
||||
|
||||
(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 @@ will take place when text is fontified stealthily."
|
||||
;; 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)
|
||||
|
||||
|
||||
@ -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:
|
||||
;; ------
|
||||
;;; Usage:
|
||||
;;; ------
|
||||
|
||||
;; put in your .emacs:
|
||||
;;; put in your .emacs:
|
||||
|
||||
;; (load "rmail-spam-filter.el")
|
||||
;;; (load "rmail-spam-filter.el")
|
||||
|
||||
;; and use customize (in rmail-spam-filter group) to:
|
||||
;;; 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 rmail-spam-filter-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 rsf-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 @@ take an effect."
|
||||
: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 @@ entries."
|
||||
: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 @@ is defined as one that fits all of the specified elements of any one
|
||||
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 @@ is spam\|another spam' (without the single quotes)."
|
||||
(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 @@ it from rmail file. Called for each new message retrieved by
|
||||
(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 @@ it from rmail file. Called for each new message retrieved by
|
||||
(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 @@ it from rmail file. Called for each new message retrieved by
|
||||
;; 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 @@ it from rmail file. Called for each new message retrieved by
|
||||
;; 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 @@ it from rmail file. Called for each new message retrieved by
|
||||
"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 @@ it from rmail file. Called for each new message retrieved by
|
||||
;; 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 @@ it from rmail file. Called for each new message retrieved by
|
||||
"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 @@ it from rmail file. Called for each new message retrieved by
|
||||
(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 @@ it from rmail file. Called for each new message retrieved by
|
||||
(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)
|
||||
'("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-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)"
|
||||
(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)
|
||||
(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))))))))
|
||||
|
||||
(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'."
|
||||
(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
|
||||
|
||||
@ -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
|
||||
@ -140,6 +140,31 @@ See `compilation-error-regexp-alist'.")
|
||||
;; The C function openp slightly modified would do the trick fine
|
||||
(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.
|
||||
|
||||
@ -318,7 +318,12 @@ Sets `grep-last-buffer' and runs `grep-setup-hook'."
|
||||
'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 @@ easily repeat a find command."
|
||||
(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."
|
||||
|
||||
@ -223,7 +223,7 @@ Fourth and fifth arg START and END specify the region to operate on."
|
||||
(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 @@ make, or the user didn't cancel the call."
|
||||
(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
|
||||
|
||||
@ -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 @@ are done with it in the server.")
|
||||
(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."
|
||||
|
||||
22
lisp/ses.el
22
lisp/ses.el
@ -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 @@ preceding cell has spilled over."
|
||||
;;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))
|
||||
|
||||
@ -678,15 +678,17 @@ the echo area."
|
||||
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.
|
||||
|
||||
@ -1172,6 +1172,7 @@ without any interpretation."
|
||||
;; 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)
|
||||
|
||||
@ -2201,8 +2201,10 @@ order until succeed.")
|
||||
(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)
|
||||
|
||||
@ -423,9 +423,13 @@ Point is moved to just past the fill prefix on the first line."
|
||||
((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)
|
||||
|
||||
@ -132,14 +132,23 @@ without a period."
|
||||
: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.
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -293,7 +293,7 @@ null strings are always omitted from the result. Thus:
|
||||
@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 @@ portion) is less.
|
||||
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 @@ operation} error.
|
||||
@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 @@ not truncated. In the third case, the padding is on the right.
|
||||
@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 @@ and @samp{A} are related by case-conversion, they should have the same
|
||||
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
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -177,6 +177,7 @@ SHELL32 = -lshell32
|
||||
USER32 = -luser32
|
||||
WSOCK32 = -lwsock32
|
||||
WINMM = -lwinmm
|
||||
WINSPOOL = -lwinspool
|
||||
|
||||
ifdef NOOPT
|
||||
DEBUG_CFLAGS = -DEMACSDEBUG
|
||||
|
||||
@ -124,6 +124,7 @@ SHELL32 = shell32.lib
|
||||
USER32 = user32.lib
|
||||
WSOCK32 = wsock32.lib
|
||||
WINMM = winmm.lib
|
||||
WINSPOOL = winspool.lib
|
||||
|
||||
!ifdef NOOPT
|
||||
DEBUG_CFLAGS = -DEMACSDEBUG
|
||||
|
||||
@ -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
|
||||
|
||||
@ -100,7 +100,7 @@ typedef POINTER_TYPE *pointer;
|
||||
# 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
|
||||
|
||||
@ -123,6 +123,9 @@ int synch_process_alive;
|
||||
/* 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 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
|
||||
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 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
|
||||
|
||||
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);
|
||||
|
||||
@ -5458,6 +5458,9 @@ coding_restore_composition (coding, obj)
|
||||
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
|
||||
|
||||
36
src/fileio.c
36
src/fileio.c
@ -6095,6 +6095,7 @@ DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_inte
|
||||
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-internal", Fread_file_name_internal, Sread_file_name_inte
|
||||
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 @@ provides a file dialog box. */)
|
||||
|
||||
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 @@ same format as a regular save would use. */);
|
||||
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,
|
||||
|
||||
10
src/fns.c
10
src/fns.c
@ -884,12 +884,11 @@ string_char_to_byte (string, char_index)
|
||||
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 @@ string_byte_to_char (string, byte_index)
|
||||
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))
|
||||
{
|
||||
|
||||
@ -8205,9 +8205,6 @@ NewMacWindow (FRAME_PTR fp)
|
||||
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 @@ make_mac_terminal_frame (struct frame *f)
|
||||
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);
|
||||
|
||||
@ -140,6 +140,7 @@ LIBS = $(TLIB0) \
|
||||
$(USER32) \
|
||||
$(MPR) \
|
||||
$(SHELL32) \
|
||||
$(WINSPOOL) \
|
||||
$(libc)
|
||||
|
||||
#
|
||||
|
||||
@ -6094,7 +6094,10 @@ kill_buffer_processes (buffer)
|
||||
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 @@ sigchld_handler (signo)
|
||||
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. */
|
||||
|
||||
@ -136,6 +136,9 @@ extern int synch_process_alive;
|
||||
/* 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;
|
||||
|
||||
12
src/search.c
12
src/search.c
@ -2366,13 +2366,21 @@ since only regular expressions have distinguished subexpressions. */)
|
||||
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;
|
||||
|
||||
@ -3832,7 +3832,8 @@ mkdir (dpath, dmode)
|
||||
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 @@ rmdir (dpath)
|
||||
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 */
|
||||
|
||||
@ -192,6 +192,7 @@ static int
|
||||
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 @@ unexec_copy (off_t dest, off_t src, ssize_t count)
|
||||
|
||||
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)
|
||||
|
||||
72
src/w32fns.c
72
src/w32fns.c
@ -51,6 +51,7 @@ Boston, MA 02111-1307, USA. */
|
||||
#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 @@ If the underlying system call fails, value is nil. */)
|
||||
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 @@ versions of Windows) characters. */);
|
||||
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;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user