Mercurial > emacs
changeset 110375:6e2c9bc108c6
merge trunk
| author | Kenichi Handa <handa@m17n.org> |
|---|---|
| date | Wed, 08 Sep 2010 13:08:19 +0900 |
| parents | 99544439ab8f (current diff) 280c5216180d (diff) |
| children | cc92458a9829 |
| files | |
| diffstat | 85 files changed, 2414 insertions(+), 1914 deletions(-) [+] |
line wrap: on
line diff
--- a/ChangeLog Thu Sep 02 11:00:18 2010 +0900 +++ b/ChangeLog Wed Sep 08 13:08:19 2010 +0900 @@ -1,3 +1,8 @@ +2010-09-04 Eli Zaretskii <eliz@gnu.org> + + * config.bat: Produce lisp/gnus/_dir-locals.el from + lisp/gnus/.dir-locals.el. + 2010-08-23 Andreas Schwab <schwab@linux-m68k.org> * configure.in: Fix check for librsvg, imagemagick and
--- a/admin/ChangeLog Thu Sep 02 11:00:18 2010 +0900 +++ b/admin/ChangeLog Wed Sep 08 13:08:19 2010 +0900 @@ -1,3 +1,11 @@ +2010-09-05 Juanma Barranquero <lekktu@gmail.com> + + * unidata/BidiMirroring.txt: Update from + http://www.unicode.org/Public/6.0.0/ucd/BidiMirroring-6.0.0d2.txt + + * unidata/UnicodeData.txt: Update from + http://www.unicode.org/Public/6.0.0/ucd/UnicodeData-6.0.0d7.txt + 2010-08-09 Andreas Schwab <schwab@linux-m68k.org> * CPP-DEFINES (WORDS_BIG_ENDIAN): Remove.
--- a/admin/unidata/BidiMirroring.txt Thu Sep 02 11:00:18 2010 +0900 +++ b/admin/unidata/BidiMirroring.txt Wed Sep 08 13:08:19 2010 +0900 @@ -1,12 +1,12 @@ # BidiMirroring-6.0.0.txt -# Date: 2009-11-10, 17:09:00 PST [KW] +# Date: 2010-06-21, 12:09:00 PDT [KW] # # Bidi_Mirroring_Glyph Property # # This file is an informative contributory data file in the # Unicode Character Database. # -# Copyright (c) 1991-2009 Unicode, Inc. +# Copyright (c) 1991-2010 Unicode, Inc. # For terms of use, see http://www.unicode.org/terms_of_use.html # # This data file lists characters that have the Bidi_Mirrored=True property @@ -473,8 +473,8 @@ # 22FF; Z NOTATION BAG MEMBERSHIP # 2320; TOP HALF INTEGRAL # 2321; BOTTOM HALF INTEGRAL +# 27C0; THREE DIMENSIONAL ANGLE # 27CC; LONG DIVISION -# 27C0; THREE DIMENSIONAL ANGLE # 27D3; LOWER RIGHT CORNER WITH DOT # 27D4; UPPER LEFT CORNER WITH DOT # 27DC; LEFT MULTIMAP
--- a/admin/unidata/UnicodeData.txt Thu Sep 02 11:00:18 2010 +0900 +++ b/admin/unidata/UnicodeData.txt Wed Sep 08 13:08:19 2010 +0900 @@ -1699,7 +1699,7 @@ 06DB;ARABIC SMALL HIGH THREE DOTS;Mn;230;NSM;;;;;N;;;;; 06DC;ARABIC SMALL HIGH SEEN;Mn;230;NSM;;;;;N;;;;; 06DD;ARABIC END OF AYAH;Cf;0;AN;;;;;N;;;;; -06DE;ARABIC START OF RUB EL HIZB;Me;0;NSM;;;;;N;;;;; +06DE;ARABIC START OF RUB EL HIZB;So;0;ON;;;;;N;;;;; 06DF;ARABIC SMALL HIGH ROUNDED ZERO;Mn;230;NSM;;;;;N;;;;; 06E0;ARABIC SMALL HIGH UPRIGHT RECTANGULAR ZERO;Mn;230;NSM;;;;;N;;;;; 06E1;ARABIC SMALL HIGH DOTLESS HEAD OF KHAH;Mn;230;NSM;;;;;N;;;;; @@ -5640,9 +5640,9 @@ 19D7;NEW TAI LUE DIGIT SEVEN;Nd;0;L;;7;7;7;N;;;;; 19D8;NEW TAI LUE DIGIT EIGHT;Nd;0;L;;8;8;8;N;;;;; 19D9;NEW TAI LUE DIGIT NINE;Nd;0;L;;9;9;9;N;;;;; -19DA;NEW TAI LUE THAM DIGIT ONE;Nd;0;L;;1;1;1;N;;;;; -19DE;NEW TAI LUE SIGN LAE;Po;0;ON;;;;;N;;;;; -19DF;NEW TAI LUE SIGN LAEV;Po;0;ON;;;;;N;;;;; +19DA;NEW TAI LUE THAM DIGIT ONE;No;0;L;;;1;1;N;;;;; +19DE;NEW TAI LUE SIGN LAE;So;0;ON;;;;;N;;;;; +19DF;NEW TAI LUE SIGN LAEV;So;0;ON;;;;;N;;;;; 19E0;KHMER SYMBOL PATHAMASAT;So;0;ON;;;;;N;;;;; 19E1;KHMER SYMBOL MUOY KOET;So;0;ON;;;;;N;;;;; 19E2;KHMER SYMBOL PII KOET;So;0;ON;;;;;N;;;;; @@ -7119,6 +7119,7 @@ 20B6;LIVRE TOURNOIS SIGN;Sc;0;ET;;;;;N;;;;; 20B7;SPESMILO SIGN;Sc;0;ET;;;;;N;;;;; 20B8;TENGE SIGN;Sc;0;ET;;;;;N;;;;; +20B9;INDIAN RUPEE SIGN;Sc;0;ET;;;;;N;;;;; 20D0;COMBINING LEFT HARPOON ABOVE;Mn;230;NSM;;;;;N;NON-SPACING LEFT HARPOON ABOVE;;;; 20D1;COMBINING RIGHT HARPOON ABOVE;Mn;230;NSM;;;;;N;NON-SPACING RIGHT HARPOON ABOVE;;;; 20D2;COMBINING LONG VERTICAL LINE OVERLAY;Mn;1;NSM;;;;;N;NON-SPACING LONG VERTICAL BAR OVERLAY;;;; @@ -7176,7 +7177,7 @@ 2115;DOUBLE-STRUCK CAPITAL N;Lu;0;L;<font> 004E;;;;N;DOUBLE-STRUCK N;;;; 2116;NUMERO SIGN;So;0;ON;<compat> 004E 006F;;;;N;NUMERO;;;; 2117;SOUND RECORDING COPYRIGHT;So;0;ON;;;;;N;;;;; -2118;SCRIPT CAPITAL P;So;0;ON;;;;;N;SCRIPT P;;;; +2118;SCRIPT CAPITAL P;Sm;0;ON;;;;;N;SCRIPT P;;;; 2119;DOUBLE-STRUCK CAPITAL P;Lu;0;L;<font> 0050;;;;N;DOUBLE-STRUCK P;;;; 211A;DOUBLE-STRUCK CAPITAL Q;Lu;0;L;<font> 0051;;;;N;DOUBLE-STRUCK Q;;;; 211B;SCRIPT CAPITAL R;Lu;0;L;<font> 0052;;;;N;SCRIPT R;;;;
--- a/config.bat Thu Sep 02 11:00:18 2010 +0900 +++ b/config.bat Wed Sep 08 13:08:19 2010 +0900 @@ -250,6 +250,7 @@ rem ---------------------------------------------------------------------- Echo Configuring the lisp directory... cd lisp +If Exist gnus\.dir-locals.el update gnus/.dir-locals.el gnus/_dir-locals.el sed -f ../msdos/sedlisp.inp < Makefile.in > Makefile cd .. rem ----------------------------------------------------------------------
--- a/doc/emacs/ChangeLog Thu Sep 02 11:00:18 2010 +0900 +++ b/doc/emacs/ChangeLog Wed Sep 08 13:08:19 2010 +0900 @@ -1,3 +1,15 @@ +2010-09-06 Chong Yidong <cyd@stupidchicken.com> + + * dired.texi (Dired Enter): Minor doc fix (Bug#6982). + +2010-09-06 Glenn Morris <rgm@gnu.org> + + * misc.texi (Saving Emacs Sessions): Mention desktop-path. (Bug#6948) + +2010-09-02 Jan Djärv <jan.h.d@swipnet.se> + + * frames.texi (Cut/Paste Other App): Remove vut-buffer text. + 2010-08-21 Glenn Morris <rgm@gnu.org> * misc.texi (Amusements): Mention bubbles and animate.
--- a/doc/emacs/dired.texi Thu Sep 02 11:00:18 2010 +0900 +++ b/doc/emacs/dired.texi Wed Sep 08 13:08:19 2010 +0900 @@ -75,13 +75,12 @@ The variable @code{dired-listing-switches} specifies the options to give to @code{ls} for listing the directory; this string @emph{must} -contain @samp{-l}. If you use a numeric prefix argument with the -@code{dired} command, you can specify the @code{ls} switches with the -minibuffer before you enter the directory specification. No matter -how they are specified, the @code{ls} switches can include short -options (that is, single characters) requiring no arguments, and long -options (starting with @samp{--}) whose arguments are specified with -@samp{=}. +contain @samp{-l}. If you use a prefix argument with the @code{dired} +command, you can specify the @code{ls} switches with the minibuffer +before you enter the directory specification. No matter how they are +specified, the @code{ls} switches can include short options (that is, +single characters) requiring no arguments, and long options (starting +with @samp{--}) whose arguments are specified with @samp{=}. On MS-Windows and MS-DOS systems, Emacs @emph{emulates} @code{ls}; see @ref{ls in Lisp}, for options and peculiarities of that emulation.
--- a/doc/emacs/frames.texi Thu Sep 02 11:00:18 2010 +0900 +++ b/doc/emacs/frames.texi Wed Sep 08 13:08:19 2010 +0900 @@ -273,15 +273,6 @@ at the risk of large memory consumption if other applications generate large selections. -@cindex cut buffer -@vindex x-cut-buffer-max - Whenever Emacs saves some text to the primary selection, it may also -save it to the @dfn{cut buffer}. The cut buffer is an obsolete -predecessor to the primary selection; most modern applications do not -use it. Saving text to the cut buffer is slow and inefficient, so -Emacs only does it if the text is shorter than the value of -@code{x-cut-buffer-max} (20000 characters by default). - You can yank the primary selection into Emacs using the usual yank commands, such as @kbd{C-y} (@code{yank}) and @kbd{Mouse-2} (@code{mouse-yank-at-click}). These commands actually check the
--- a/doc/emacs/misc.texi Thu Sep 02 11:00:18 2010 +0900 +++ b/doc/emacs/misc.texi Wed Sep 08 13:08:19 2010 +0900 @@ -2349,8 +2349,11 @@ @findex desktop-change-dir @findex desktop-revert +@vindex desktop-path If you turn on @code{desktop-save-mode} in your init file, then when Emacs starts, it looks for a saved desktop in the current directory. +(More precisely, it looks in the directories specified by +@var{desktop-path}, and uses the first desktop it finds.) Thus, you can have separate saved desktops in different directories, and the starting directory determines which one Emacs reloads. You can save the current desktop and reload one saved in another directory
--- a/doc/lispref/ChangeLog Thu Sep 02 11:00:18 2010 +0900 +++ b/doc/lispref/ChangeLog Wed Sep 08 13:08:19 2010 +0900 @@ -1,3 +1,13 @@ +2010-09-06 Alexander Klimov <alserkli@inbox.ru> (tiny change) + + * files.texi (Directory Names): Use \` rather than ^. + +2010-09-02 Jan Djärv <jan.h.d@swipnet.se> + + * text.texi (Low-Level Kill Ring): + * frames.texi (Window System Selections): Remove cut buffer + documentation. + 2010-08-28 Eli Zaretskii <eliz@gnu.org> * display.texi (Fringe Size/Pos): Add a cross-reference to "Layout
--- a/doc/lispref/files.texi Thu Sep 02 11:00:18 2010 +0900 +++ b/doc/lispref/files.texi Wed Sep 08 13:08:19 2010 +0900 @@ -1933,7 +1933,7 @@ abbreviations to use for file directories. Each element has the form @code{(@var{from} . @var{to})}, and says to replace @var{from} with @var{to} when it appears in a directory name. The @var{from} string is -actually a regular expression; it should always start with @samp{^}. +actually a regular expression; it should always start with @samp{\`}. The @var{to} string should be an ordinary absolute directory name. Do not use @samp{~} to stand for a home directory in that string. The function @code{abbreviate-file-name} performs these substitutions. @@ -1946,9 +1946,9 @@ and so on. @example -(("^/home/fsf" . "/fsf") - ("^/home/gp" . "/gp") - ("^/home/gd" . "/gd")) +(("\\`/home/fsf" . "/fsf") + ("\\`/home/gp" . "/gp") + ("\\`/home/gd" . "/gd")) @end example @end defopt
--- a/doc/lispref/frames.texi Thu Sep 02 11:00:18 2010 +0900 +++ b/doc/lispref/frames.texi Wed Sep 08 13:08:19 2010 +0900 @@ -1985,28 +1985,6 @@ @code{STRING}. @end defun -@cindex cut buffer -The X server also has a set of eight numbered @dfn{cut buffers} which can -store text or other data being moved between applications. Cut buffers -are considered obsolete, but Emacs supports them for the sake of X -clients that still use them. Cut buffers are numbered from 0 to 7. - -@defun x-get-cut-buffer &optional n -This function returns the contents of cut buffer number @var{n}. -If omitted @var{n} defaults to 0. -@end defun - -@defun x-set-cut-buffer string &optional push -@anchor{Definition of x-set-cut-buffer} -This function stores @var{string} into the first cut buffer (cut buffer -0). If @var{push} is @code{nil}, only the first cut buffer is changed. -If @var{push} is non-@code{nil}, that says to move the values down -through the series of cut buffers, much like the way successive kills in -Emacs move down the kill ring. In other words, the previous value of -the first cut buffer moves into the second cut buffer, and the second to -the third, and so on through all eight cut buffers. -@end defun - @defopt selection-coding-system This variable specifies the coding system to use when reading and writing selections or the clipboard. @xref{Coding
--- a/doc/lispref/text.texi Thu Sep 02 11:00:18 2010 +0900 +++ b/doc/lispref/text.texi Wed Sep 08 13:08:19 2010 +0900 @@ -1126,16 +1126,13 @@ @defvar interprogram-cut-function This variable provides a way of communicating killed text to other programs, when you are using a window system. Its value should be -@code{nil} or a function of one required and one optional argument. +@code{nil} or a function of one required argument. If the value is a function, @code{kill-new} and @code{kill-append} call -it with the new first element of the kill ring as the first argument. -The second, optional, argument has the same meaning as the @var{push} -argument to @code{x-set-cut-buffer} (@pxref{Definition of -x-set-cut-buffer}) and only affects the second and later cut buffers. +it with the new first element of the kill ring as the argument. The normal use of this function is to set the window system's primary -selection (and first cut buffer) from the newly killed text. +selection from the newly killed text. @xref{Window System Selections}. @end defvar
--- a/doc/misc/ChangeLog Thu Sep 02 11:00:18 2010 +0900 +++ b/doc/misc/ChangeLog Wed Sep 08 13:08:19 2010 +0900 @@ -1,3 +1,15 @@ +2010-09-04 Julien Danjou <julien@danjou.info> (tiny change) + + * gnus.texi (Adaptive Scoring): Fix typo. + +2010-09-03 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (Article Display): Document gnus-html-show-images. + +2010-09-02 Jan Djärv <jan.h.d@swipnet.se> + + * cl.texi (Basic Setf): Remove x-get-cut-buffer and x-get-cutbuffer. + 2010-09-01 Lars Magne Ingebrigtsen <larsi@gnus.org> * gnus.texi (HTML): Document gnus-max-image-proportion.
--- a/doc/misc/cl.texi Thu Sep 02 11:00:18 2010 +0900 +++ b/doc/misc/cl.texi Wed Sep 08 13:08:19 2010 +0900 @@ -1043,10 +1043,10 @@ frame-width window-point get-register window-start getenv window-width -global-key-binding x-get-cut-buffer -keymap-parent x-get-cutbuffer -local-key-binding x-get-secondary-selection -mark x-get-selection +global-key-binding x-get-secondary-selection +keymap-parent x-get-selection +local-key-binding +mark mark-marker @end smallexample
--- a/doc/misc/gnus.texi Thu Sep 02 11:00:18 2010 +0900 +++ b/doc/misc/gnus.texi Wed Sep 08 13:08:19 2010 +0900 @@ -10351,6 +10351,14 @@ Remove all images from the article buffer (@code{gnus-article-remove-images}). +@item W D W +@kindex W D W (Summary) +@findex gnus-html-show-images +If you're reading an @acronym{HTML} article rendered with +@code{gnus-article-html}, then you can insert any blocked images in +the buffer with this command. +(@code{gnus-html-show-images}). + @end table @@ -21566,7 +21574,7 @@ @vindex gnus-adaptive-pretty-print Adaptive score files can get huge and are not meant to be edited by human hands. If @code{gnus-adaptive-pretty-print} is @code{nil} (the -deafult) those files will not be written in a human readable way. +default) those files will not be written in a human readable way. @vindex gnus-score-exact-adapt-limit When doing adaptive scoring, substring or fuzzy matching would probably
--- a/etc/NEWS Thu Sep 02 11:00:18 2010 +0900 +++ b/etc/NEWS Wed Sep 08 13:08:19 2010 +0900 @@ -235,6 +235,8 @@ *** `mouse-drag-copy-region' now defaults to nil. +*** Support for X cut buffers has been removed. + * Changes in Specialized Modes and Packages in Emacs 24.1 @@ -425,6 +427,8 @@ * New Modes and Packages in Emacs 24.1 +** New global minor modes electric-pair-mode and electric-indent-mode. + ** pcase.el provides the ML-style pattern matching macro `pcase'. ** smie.el is a package providing a simple generic indentation engine.
--- a/lisp/ChangeLog Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/ChangeLog Wed Sep 08 13:08:19 2010 +0900 @@ -1,3 +1,227 @@ +2010-09-07 Agustín Martín <agustin.martin@hispalinux.es> + + * textmodes/ispell.el (ispell-start-process): Make sure original + arg list is properly initialized (Bug#6993, Bug#6994). + +2010-09-06 Alexander Klimov <alserkli@inbox.ru> (tiny change) + + * files.el (directory-abbrev-alist): Use \` as default regexp. + + * emacs-lisp/rx.el (rx-any): Don't explode ranges that end in special + chars like - or ] (bug#6984). + (rx-any-condense-range): Explode 2-char ranges. + +2010-09-06 Glenn Morris <rgm@gnu.org> + + * desktop.el (desktop-path): Bump :version after 2009-09-15 change. + +2010-09-06 Stefan Monnier <monnier@iro.umontreal.ca> + + * textmodes/bibtex.el: + * proced.el: Update to new email for Roland Winkler <winkler@gnu.org>. + +2010-09-05 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/imap.el (imap-message-map): Removed optional buffer parameter, + since no callers use it. + (imap-message-get): Ditto. + (imap-message-put): Ditto. + (imap-mailbox-map): Ditto. + (imap-mailbox-put): Ditto. + (imap-mailbox-get): Ditto. + (imap-mailbox-get): Revert last change for this function. + +2010-09-05 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/imap.el (imap-fetch-safe): Removed function, and altered all + callers to use `imap-fetch' instead. According to the comments, this + should be safe, since all other IMAP clients use the 1:* syntax. + (imap-enable-exchange-bug-workaround): Removed. + (imap-debug): Removed -- doesn't seem very useful. + +2010-09-05 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/imap.el (imap-log): New convenience function used throughout + instead of repeating the same code all over the place. + +2010-09-05 David De La Harpe Golden <david@harpegolden.net> + + * mouse.el (mouse-save-then-kill): Save region to kill-ring + when mouse-drag-copy-region is non-nil (Bug#6956). + +2010-09-05 Chong Yidong <cyd@stupidchicken.com> + + * dired.el (dired-ls-sorting-switches, dired-sort-by-name-regexp): + Improve regexps (Bug#6987). + (dired-sort-toggle): Search more robustly for -t flag. + + * files.el (get-free-disk-space): Search more robustly for + "available" column. Suggested by Ehud Karni + <ehud@unix.mvs.co.il>. + +2010-09-05 Juanma Barranquero <lekktu@gmail.com> + + * international/uni-bidi.el: + * international/uni-category.el: + * international/uni-combining.el: + * international/uni-decimal.el: + * international/uni-mirrored.el: + * international/uni-name.el: Regenerate. + +2010-09-04 Stefan Monnier <monnier@iro.umontreal.ca> + + * electric.el (electric-indent-post-self-insert-function): + Don't reindent with a sloppy indentation function. + + * emacs-lisp/syntax.el (syntax-ppss): More sanity check to catch + border case in change-log-mode. + +2010-09-04 Chong Yidong <cyd@stupidchicken.com> + + * progmodes/compile.el (compilation-error-regexp-alist-alist): + Remove ruby regexp; handle Ruby errors with gcc-include and gnu. + Recognize leading tab in gcc-include regexp. Ignore names with + leading "from" or "in" in gnu regexp (Bug#6937). + +2010-09-04 Stefan Monnier <monnier@iro.umontreal.ca> + + Avoid global recursive calls to kill-buffer-hooks; fit into 80 cols. + * textmodes/ispell.el (ispell-process-buffer-name): Remove. + (ispell-start-process): Avoid setq and simplify logic. + (ispell-init-process): Setup kill-buffer-hook locally when needed. + (kill-buffer-hook): Don't use it globally with code that uses + expand-file-name since that may call kill-buffer via + code_conversion_restore. + +2010-09-04 Noorul Islam K M <noorul@noorul.com> (tiny change) + + * emacs-lisp/package.el (package-directory-list): Only call + file-name-nondirectory on a string. + +2010-09-02 Chong Yidong <cyd@stupidchicken.com> + + * emacs-lisp/package.el (package--download-one-archive): + Ensure that archive-contents is valid before saving it. + (package-activate-1, package-mark-obsolete, define-package) + (package-compute-transaction, package-list-maybe-add): Use push. + +2010-09-03 Stefan Monnier <monnier@iro.umontreal.ca> + + Use SMIE's blink-paren for octave-mode. + * progmodes/octave-mod.el (octave-font-lock-close-quotes): + Backslashes do not escape single-quotes, single-quotes do. + (octave-block-else-regexp, octave-block-end-regexp) + (octave-block-match-alist): Remove. + (octave-smie-bnf-table): New var, with old content. + (octave-smie-op-levels): Use it. + (octave-smie-closer-alist): New var. + (octave-mode): Use it. Setup smie-blink-matching and electric-indent. + (octave-blink-matching-block-open): Remove. + (octave-reindent-then-newline-and-indent, octave-electric-semi) + (octave-electric-space): Let self-insert-command run expand-abbrev and + blink parens. + + * electric.el (electricity): New group. + (electric-indent-chars): New var. + (electric-indent-post-self-insert-function): New fun. + (electric-indent-mode): New minor mode. + (electric-pair-skip-self): New custom. + (electric-pair-post-self-insert-function): New function. + (electric-pair-mode): New minor mode. + + * calc/calc-aent.el (calcAlg-blink-matching-check): New fun, to replace + calcAlg-blink-matching-open. + (calc-alg-ent-map, calc-alg-ent-esc-map): Initialize in the declaration. + (calc-do-alg-entry): Only touch the part of the keymap that varies. + Use the new blink-matching-check-function. + + Provide blink-matching support to SMIE. + * emacs-lisp/smie.el (smie-bnf-closer-alist): New function. + (smie-blink-matching-triggers, smie-blink-matching-inners): New vars. + (smie-blink-matching-check, smie-blink-matching-open): New functions. + + * simple.el (newline): Fix last change to properly remove itself from + the hook. + +2010-09-02 Stefan Monnier <monnier@iro.umontreal.ca> + + * simple.el (newline): Eliminate optimization. + Use post-self-insert-hook to set hard-newline and things before + running post-self-insert-hook. + (blink-matching-check-mismatch): New function. + (blink-matching-check-function): New variable. + (blink-matching-open): Use them. + Skip back forward over prefix chars skipped by forward-sexp. + Don't check if the parens are backslash escaped. + (blink-paren-post-self-insert-function): Check backslash escaping here. + +2010-09-02 Chong Yidong <cyd@stupidchicken.com> + + * emacs-lisp/package.el (package-menu-mode-map): + Change package-menu-revert bindings to revert-buffer. + (package-menu-mode): Set revert-buffer-function. + (package-menu-revert): Doc fix. + +2010-09-02 Agustín Martín <agustin.martin@hispalinux.es> + + * textmodes/ispell.el (ispell-init-process): Use "~/" as + `default-directory' unless using Ispell per-directory personal + dictionaries and not in a mini-buffer under XEmacs. + (kill-buffer-hook): Do not kill ispell process on exit when + `ispell-process-directory' is "~/". (Bug#6143) + +2010-09-02 Jan Djärv <jan.h.d@swipnet.se> + + * simple.el (kill-new): Call interprogram-cut-function with only + one argument. + + * term.el (term-mouse-paste): Don't call x-get-cutbuffer. + Remove cut buffer from error message. + + * term/x-win.el (x-select-text): + * term/pc-win.el (x-selection-value): + * term/ns-win.el (x-selection-value): + * eshell/em-term.el: + * w32-fns.el (x-get-selection-value): + * mouse-sel.el (mouse-sel-set-selection-function): + * frame.el (display-selections-p): Remove cut-buffer in documentation. + + * term/x-win.el: Update documentation for x-last-selected-text-*. + (x-last-selected-text-cut, x-last-selected-text-cut-encoded) + (x-last-cut-buffer-coding, x-cut-buffer-max): Remove. + (x-select-text): Remove argument PUSH, update documentation. Remove + cut-buffer code. + (x-selection-value-internal): Was previously x-selection-value. + (x-selection-value): Rename from x-cut-buffer-or-selection-value. + Update documentation, remove cut-buffer code. Call + x-selection-value-internal. + (x-clipboard-yank): Call x-selection-value-internal. + (x-initialize-window-system): Remove setting of x-cut-buffer-max. + + * term/pc-win.el (x-last-selected-text): + x-cut-buffer-or-selection-value renamed to x-selection-value + (x-select-text): Remove argument PUSH, update documentation. + + * term/ns-win.el (x-setup-function-keys, ns-last-selected-text): + x-cut-buffer-or-selection-value renamed to x-selection-value + (x-selection-value): Renamed from x-cut-buffer-or-selection-value. + (x-select-text): Remove argument PUSH, update documentation. + + * emacs-lisp/cl-macs.el (x-get-cutbuffer, x-get-cut-buffer): Remove. + + * w32-fns.el (x-last-selected-text): + x-cut-buffer-or-selection-value renamed to x-selection-value. + (x-cut-buffer-max): Remove. + (x-select-text): Remove argument PUSH, update documentation. + + * simple.el (interprogram-cut-function): Remove mention of PUSH. + + * select.el (x-get-cut-buffer, x-set-cut-buffer): Remove. + + * mouse-sel.el (mouse-sel-get-selection-function): + x-cut-buffer-or-selection-value renamed to x-selection-value. + (x-select-text): Remove optional push. + 2010-09-01 Stefan Monnier <monnier@iro.umontreal.ca> * simple.el (blink-paren-function): Move from C to here. @@ -542,7 +766,7 @@ * mouse.el (mouse-yank-primary): Avoid setting primary when deactivating the mark (Bug#6872). -2010-08-23 Chris Foote <chris@foote.com.au> (tiny change) +2010-08-23 Chris Foote <chris@foote.com.au> (tiny change) * progmodes/python.el (python-block-pairs): Allow use of "finally" with "else" (Bug#3991). @@ -1051,7 +1275,7 @@ * align.el (align-default-spacing): Doc fix. (align-region-heuristic, align-regexp): Fix typos in docstrings. -2010-08-08 Stephen Peters <speters@itasoftware.com> +2010-08-08 Stephen Peters <speters@itasoftware.com> * calendar/icalendar.el (icalendar--split-value): Fixed splitting regexp. (Bug#6766)
--- a/lisp/calc/calc-aent.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/calc/calc-aent.el Wed Sep 08 13:08:19 2010 +0900 @@ -315,10 +315,24 @@ calc-dollar-used 0))) (calc-handle-whys)))) -(defvar calc-alg-ent-map nil +(defvar calc-alg-ent-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-map) + (define-key map "'" 'calcAlg-previous) + (define-key map "`" 'calcAlg-edit) + (define-key map "\C-m" 'calcAlg-enter) + (define-key map "\C-j" 'calcAlg-enter) + map) "The keymap used for algebraic entry.") -(defvar calc-alg-ent-esc-map nil +(defvar calc-alg-ent-esc-map + (let ((map (make-keymap)) + (i 33)) + (set-keymap-parent map esc-map) + (while (< i 127) + (define-key map (vector i) 'calcAlg-escape) + (setq i (1+ i))) + map) "The keymap used for escapes in algebraic entry.") (defvar calc-alg-exp) @@ -326,19 +340,8 @@ ;;;###autoload (defun calc-do-alg-entry (&optional initial prompt no-normalize history) (let* ((calc-buffer (current-buffer)) - (blink-paren-function 'calcAlg-blink-matching-open) + (blink-matching-check-function 'calcAlg-blink-matching-check) (calc-alg-exp 'error)) - (unless calc-alg-ent-map - (setq calc-alg-ent-map (copy-keymap minibuffer-local-map)) - (define-key calc-alg-ent-map "'" 'calcAlg-previous) - (define-key calc-alg-ent-map "`" 'calcAlg-edit) - (define-key calc-alg-ent-map "\C-m" 'calcAlg-enter) - (define-key calc-alg-ent-map "\C-j" 'calcAlg-enter) - (let ((i 33)) - (setq calc-alg-ent-esc-map (copy-keymap esc-map)) - (while (< i 127) - (aset (nth 1 calc-alg-ent-esc-map) i 'calcAlg-escape) - (setq i (1+ i))))) (define-key calc-alg-ent-map "\e" nil) (if (eq calc-algebraic-mode 'total) (define-key calc-alg-ent-map "\e" calc-alg-ent-esc-map) @@ -430,18 +433,9 @@ exp)) (exit-minibuffer)))) -(defun calcAlg-blink-matching-open () - (let ((rightpt (point)) - (leftpt nil) - (rightchar (preceding-char)) - leftchar - rightsyntax - leftsyntax) - (save-excursion - (condition-case () - (setq leftpt (scan-sexps rightpt -1) - leftchar (char-after leftpt)) - (error nil))) +(defun calcAlg-blink-matching-check (leftpt rightpt) + (let ((rightchar (char-before rightpt)) + (leftchar (if leftpt (char-after leftpt)))) (if (and leftpt (or (and (= rightchar ?\)) (= leftchar ?\[)) @@ -450,20 +444,9 @@ (save-excursion (goto-char leftpt) (looking-at ".+\\(\\.\\.\\|\\\\dots\\|\\\\ldots\\)"))) - (let ((leftsaved (aref (syntax-table) leftchar)) - (rightsaved (aref (syntax-table) rightchar))) - (unwind-protect - (progn - (cond ((= leftchar ?\[) - (aset (syntax-table) leftchar (cons 4 ?\))) - (aset (syntax-table) rightchar (cons 5 ?\[))) - (t - (aset (syntax-table) leftchar (cons 4 ?\])) - (aset (syntax-table) rightchar (cons 5 ?\()))) - (blink-matching-open)) - (aset (syntax-table) leftchar leftsaved) - (aset (syntax-table) rightchar rightsaved))) - (blink-matching-open)))) + ;; [2..5) perfectly valid! + nil + (blink-matching-check-mismatch leftpt rightpt)))) ;;;###autoload (defun calc-alg-digit-entry ()
--- a/lisp/desktop.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/desktop.el Wed Sep 08 13:08:19 2010 +0900 @@ -226,7 +226,7 @@ The base name of the file is specified in `desktop-base-file-name'." :type '(repeat directory) :group 'desktop - :version "22.1") + :version "23.2") ; user-emacs-directory added (defcustom desktop-missing-file-warning nil "If non-nil, offer to recreate the buffer of a deleted file.
--- a/lisp/dired.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/dired.el Wed Sep 08 13:08:19 2010 +0900 @@ -3249,12 +3249,16 @@ format, use `\\[universal-argument] \\[dired]'.") (defvar dired-sort-by-date-regexp - (concat "^-[^" dired-ls-sorting-switches - "]*t[^" dired-ls-sorting-switches "]*$") + (concat "\\(\\`\\| \\)-[^- ]*t" + ;; `dired-ls-sorting-switches' after -t overrides -t. + "[^ " dired-ls-sorting-switches "]*" + "\\(\\(\\`\\| +\\)\\(--[^ ]+\\|-[^- t" + dired-ls-sorting-switches "]+\\)\\)* *$") "Regexp recognized by Dired to set `by date' mode.") (defvar dired-sort-by-name-regexp - (concat "^-[^t" dired-ls-sorting-switches "]+$") + (concat "\\`\\(\\(\\`\\| +\\)\\(--[^ ]+\\|" + "-[^- t" dired-ls-sorting-switches "]+\\)\\)* *$") "Regexp recognized by Dired to set `by name' mode.") (defvar dired-sort-inhibit nil @@ -3280,8 +3284,8 @@ (force-mode-line-update))) (defun dired-sort-toggle-or-edit (&optional arg) - "Toggle between sort by date/name and refresh the dired buffer. -With a prefix argument you can edit the current listing switches instead." + "Toggle sorting by date, and refresh the Dired buffer. +With a prefix argument, edit the current listing switches instead." (interactive "P") (when dired-sort-inhibit (error "Cannot sort this dired buffer")) @@ -3292,24 +3296,24 @@ (defun dired-sort-toggle () ;; Toggle between sort by date/name. Reverts the buffer. - (setq dired-actual-switches - (let (case-fold-search) - (if (string-match " " dired-actual-switches) - ;; New toggle scheme: add/remove a trailing " -t" - (if (string-match " -t\\'" dired-actual-switches) - (substring dired-actual-switches 0 (match-beginning 0)) - (concat dired-actual-switches " -t")) - ;; old toggle scheme: look for some 't' switch and add/remove it - (concat - "-l" - (dired-replace-in-string (concat "[-lt" - dired-ls-sorting-switches "]") - "" - dired-actual-switches) - (if (string-match (concat "[t" dired-ls-sorting-switches "]") - dired-actual-switches) - "" - "t"))))) + (let ((sorting-by-date (string-match dired-sort-by-date-regexp + dired-actual-switches)) + ;; Regexp for finding (possibly embedded) -t switches. + (switch-regexp "\\(\\`\\| \\)-\\([a-su-zA-Z]*\\)\\(t\\)\\([^ ]*\\)") + case-fold-search) + ;; Remove the -t switch. + (while (string-match switch-regexp dired-actual-switches) + (if (and (equal (match-string 2 dired-actual-switches) "") + (equal (match-string 4 dired-actual-switches) "")) + ;; Remove a stand-alone -t switch. + (setq dired-actual-switches + (replace-match "" t t dired-actual-switches)) + ;; Remove a switch of the form -XtY for some X and Y. + (setq dired-actual-switches + (replace-match "" t t dired-actual-switches 3)))) + ;; Now, if we weren't sorting by date before, add the -t switch. + (unless sorting-by-date + (setq dired-actual-switches (concat dired-actual-switches " -t")))) (dired-sort-set-modeline) (revert-buffer))
--- a/lisp/electric.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/electric.el Wed Sep 08 13:08:19 2010 +0900 @@ -24,10 +24,23 @@ ;;; Commentary: -; zaaaaaaap +;; "Electric" has been used in Emacs to refer to different things. +;; Among them: +;; +;; - electric modes and buffers: modes that typically pop-up in a modal kind of +;; way a transient buffer that automatically disappears as soon as the user +;; is done with it. +;; +;; - electric keys: self inserting keys which additionally perform some side +;; operation which happens to be often convenient at that time. Examples of +;; such side operations are: reindenting code, inserting a newline, +;; ... auto-fill-mode and abbrev-mode can be considered as built-in forms of +;; electric key behavior. ;;; Code: +(eval-when-compile (require 'cl)) + ;; This loop is the guts for non-standard modes which retain control ;; until some event occurs. It is a `do-forever', the only way out is ;; to throw. It assumes that you have set up the keymap, window, and @@ -157,6 +170,135 @@ (fit-window-to-buffer win max-height)) win))) +;;; Electric keys. + +(defgroup electricity () + "Electric behavior for self inserting keys." + :group 'editing) + +;; Electric indentation. + +(defvar electric-indent-chars '(?\n) + "Characters that should cause automatic reindentation.") + +(defun electric-indent-post-self-insert-function () + ;; FIXME: This reindents the current line, but what we really want instead is + ;; to reindent the whole affected text. That's the current line for simple + ;; cases, but not all cases. We do take care of the newline case in an + ;; ad-hoc fashion, but there are still missing cases such as the case of + ;; electric-pair-mode wrapping a region with a pair of parens. + ;; There might be a way to get it working by analyzing buffer-undo-list, but + ;; it looks challenging. + (when (and (memq last-command-event electric-indent-chars) + ;; Don't reindent while inserting spaces at beginning of line. + (or (not (memq last-command-event '(?\s ?\t))) + (save-excursion (skip-chars-backward " \t") (not (bolp)))) + ;; Not in a string or comment. + (not (nth 8 (syntax-ppss)))) + ;; For newline, we want to reindent both lines and basically behave like + ;; reindent-then-newline-and-indent (whose code we hence copied). + (when (and (eq last-command-event ?\n) + ;; Don't reindent the previous line if the indentation function + ;; is not a real one. + (not (memq indent-line-function + '(indent-relative indent-relative-maybe))) + ;; Sanity check. + (eq (char-before) last-command-event)) + (let ((pos (copy-marker (1- (point)) t))) + (save-excursion + (goto-char pos) + (indent-according-to-mode) + ;; We are at EOL before the call to indent-according-to-mode, and + ;; after it we usually are as well, but not always. We tried to + ;; address it with `save-excursion' but that uses a normal marker + ;; whereas we need `move after insertion', so we do the + ;; save/restore by hand. + (goto-char pos) + ;; Remove the trailing whitespace after indentation because + ;; indentation may (re)introduce the whitespace. + (delete-horizontal-space t)))) + (indent-according-to-mode))) + +;;;###autoload +(define-minor-mode electric-indent-mode + "Automatically reindent lines of code when inserting particular chars. +`electric-indent-chars' specifies the set of chars that should cause reindentation." + :global t + :group 'electricity + (if electric-indent-mode + (add-hook 'post-self-insert-hook + #'electric-indent-post-self-insert-function) + (remove-hook 'post-self-insert-hook + #'electric-indent-post-self-insert-function))) + +;; Electric pairing. + +(defcustom electric-pair-skip-self t + "If non-nil, skip char instead of inserting a second closing paren. +When inserting a closing paren character right before the same character, +just skip that character instead, so that hitting ( followed by ) results +in \"()\" rather than \"())\". +This can be convenient for people who find it easier to hit ) than C-f." + :type 'boolean) + +(defun electric-pair-post-self-insert-function () + (let* ((syntax (and (eq (char-before) last-command-event) ; Sanity check. + (char-syntax last-command-event))) + ;; FIXME: when inserting the closer, we should maybe use + ;; self-insert-command, although it may prove tricky running + ;; post-self-insert-hook recursively, and we wouldn't want to trigger + ;; blink-matching-open. + (closer (if (eq syntax ?\() + (cdr (aref (syntax-table) last-command-event)) + last-command-event))) + (cond + ;; Wrap a pair around the active region. + ((and (memq syntax '(?\( ?\" ?\$)) (use-region-p)) + (if (> (mark) (point)) + (goto-char (mark)) + ;; We already inserted the open-paren but at the end of the region, + ;; so we have to remove it and start over. + (delete-char -1) + (save-excursion + (goto-char (mark)) + (insert last-command-event))) + (insert closer)) + ;; Backslash-escaped: no pairing, no skipping. + ((save-excursion + (goto-char (1- (point))) + (not (zerop (% (skip-syntax-backward "\\") 2)))) + nil) + ;; Skip self. + ((and (memq syntax '(?\) ?\" ?\$)) + electric-pair-skip-self + (eq (char-after) last-command-event)) + ;; This is too late: rather than insert&delete we'd want to only skip (or + ;; insert in overwrite mode). The difference is in what goes in the + ;; undo-log and in the intermediate state which might be visible to other + ;; post-self-insert-hook. We'll just have to live with it for now. + (delete-char 1)) + ;; Insert matching pair. + ((not (or (not (memq syntax `(?\( ?\" ?\$))) + overwrite-mode + ;; I find it more often preferable not to pair when the + ;; same char is next. + (eq last-command-event (char-after)) + (eq last-command-event (char-before (1- (point)))) + ;; I also find it often preferable not to pair next to a word. + (eq (char-syntax (following-char)) ?w))) + (save-excursion (insert closer)))))) + +;;;###autoload +(define-minor-mode electric-pair-mode + "Automatically pair-up parens when inserting an open paren." + :global t + :group 'electricity + (if electric-pair-mode + (add-hook 'post-self-insert-hook + #'electric-pair-post-self-insert-function) + (remove-hook 'post-self-insert-hook + #'electric-pair-post-self-insert-function))) + (provide 'electric) ;; arch-tag: dae045eb-dc2d-4fb7-9f27-9cc2ce277be8
--- a/lisp/emacs-lisp/cl-loaddefs.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/emacs-lisp/cl-loaddefs.el Wed Sep 08 13:08:19 2010 +0900 @@ -282,7 +282,7 @@ ;;;;;; do-all-symbols do-symbols dotimes dolist do* do loop return-from ;;;;;; return block etypecase typecase ecase case load-time-value ;;;;;; eval-when destructuring-bind function* defmacro* defun* gentemp -;;;;;; gensym) "cl-macs" "cl-macs.el" "c5a12d86541b5137054eccc43e4fc839") +;;;;;; gensym) "cl-macs" "cl-macs.el" "c10b5cbebb5267291ef15c782c0271a6") ;;; Generated autoloads from cl-macs.el (autoload 'gensym "cl-macs" "\
--- a/lisp/emacs-lisp/cl-macs.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/emacs-lisp/cl-macs.el Wed Sep 08 13:08:19 2010 +0900 @@ -1819,8 +1819,6 @@ (defsetf window-start set-window-start) (defsetf window-width () (store) (list 'progn (list 'enlarge-window (list '- store '(window-width)) t) store)) -(defsetf x-get-cutbuffer x-store-cutbuffer t) -(defsetf x-get-cut-buffer x-store-cut-buffer t) ; groan. (defsetf x-get-secondary-selection x-own-secondary-selection t) (defsetf x-get-selection x-own-selection t)
--- a/lisp/emacs-lisp/package.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/emacs-lisp/package.el Wed Sep 08 13:08:19 2010 +0900 @@ -260,8 +260,9 @@ ;; Defaults are subdirs named "elpa" in the site-lisp dirs. (let (result) (dolist (f load-path) - (if (equal (file-name-nondirectory f) "site-lisp") - (push (expand-file-name "elpa" f) result))) + (and (stringp f) + (equal (file-name-nondirectory f) "site-lisp") + (push (expand-file-name "elpa" f) result))) (nreverse result)) "List of additional directories containing Emacs Lisp packages. Each directory name should be absolute. @@ -406,16 +407,15 @@ (error "Internal error: could not find directory for %s-%s" name version-str)) ;; Add info node. - (if (file-exists-p (expand-file-name "dir" pkg-dir)) - (progn - ;; FIXME: not the friendliest, but simple. - (require 'info) - (info-initialize) - (setq Info-directory-list (cons pkg-dir Info-directory-list)))) + (when (file-exists-p (expand-file-name "dir" pkg-dir)) + ;; FIXME: not the friendliest, but simple. + (require 'info) + (info-initialize) + (push pkg-dir Info-directory-list)) ;; Add to load path, add autoloads, and activate the package. - (setq load-path (cons pkg-dir load-path)) + (push pkg-dir load-path) (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t) - (setq package-activated-list (cons package package-activated-list)) + (push package package-activated-list) ;; Don't return nil. t)) @@ -466,10 +466,9 @@ (setcdr elt (cons (cons (package-desc-vers pkg-vec) pkg-vec) (cdr elt)))) ;; Make a new association. - (setq package-obsolete-alist - (cons (cons package (list (cons (package-desc-vers pkg-vec) - pkg-vec))) - package-obsolete-alist))))) + (push (cons package (list (cons (package-desc-vers pkg-vec) + pkg-vec))) + package-obsolete-alist)))) (defun define-package (name-str version-string &optional docstring requirements @@ -505,7 +504,7 @@ (setq package-alist (delq pkg-desc package-alist)) (package-mark-obsolete (car pkg-desc) (cdr pkg-desc))) ;; Add package to the alist. - (setq package-alist (cons new-pkg-desc package-alist))) + (push new-pkg-desc package-alist)) ;; You can have two packages with the same version, for instance ;; one in the system package directory and one in your private ;; directory. We just let the first one win. @@ -707,7 +706,7 @@ (package-version-join (package-desc-vers (cdr pkg-desc))))) ;; Only add to the transaction if we don't already have it. (unless (memq next-pkg package-list) - (setq package-list (cons next-pkg package-list))) + (push next-pkg package-list)) (setq package-list (package-compute-transaction package-list (package-desc-reqs @@ -992,17 +991,19 @@ (re-search-forward "^$" nil 'move) (forward-char) (delete-region (point-min) (point)) - (make-directory dir t) - (setq buffer-file-name (expand-file-name file dir)) - (let ((version-control 'never)) - (save-buffer))) + ;; Read the retrieved buffer to make sure it is valid (e.g. it + ;; may fetch a URL redirect page). + (when (listp (read buffer)) + (make-directory dir t) + (setq buffer-file-name (expand-file-name file dir)) + (let ((version-control 'never)) + (save-buffer)))) (kill-buffer buffer))) (defun package-refresh-contents () "Download the ELPA archive description if needed. -Invoking this will ensure that Emacs knows about the latest versions -of all packages. This will let Emacs make them available for -download." +This informs Emacs about the latest versions of all packages, and +makes them available for download." (interactive) (unless (file-exists-p package-user-dir) (make-directory package-user-dir t)) @@ -1195,7 +1196,7 @@ (define-key map "\177" 'package-menu-backup-unmark) (define-key map "d" 'package-menu-mark-delete) (define-key map "i" 'package-menu-mark-install) - (define-key map "g" 'package-menu-revert) + (define-key map "g" 'revert-buffer) (define-key map "r" 'package-menu-refresh) (define-key map "~" 'package-menu-mark-obsolete-for-deletion) (define-key map "x" 'package-menu-execute) @@ -1229,7 +1230,7 @@ :help "Mark a package for installation and move to the next line")) (define-key menu-map [s3] '("--")) (define-key menu-map [mg] - '(menu-item "Update package list" package-menu-revert + '(menu-item "Update package list" revert-buffer :help "Update the list of packages")) (define-key menu-map [mr] '(menu-item "Refresh package list" package-menu-refresh @@ -1272,6 +1273,7 @@ (setq mode-name "Package Menu") (setq truncate-lines t) (setq buffer-read-only t) + (setq revert-buffer-function 'package-menu-revert) (setq header-line-format (mapconcat (lambda (pair) @@ -1300,19 +1302,19 @@ (run-mode-hooks 'package-menu-mode-hook)) (defun package-menu-refresh () - "Download the ELPA archive. -This fetches the file describing the current contents of -the Emacs Lisp Package Archive, and then refreshes the -package menu. This lets you see what new packages are -available for download." + "Download the Emacs Lisp package archive. +This fetches the contents of each archive specified in +`package-archives', and then refreshes the package menu." (interactive) (unless (eq major-mode 'package-menu-mode) (error "The current buffer is not a Package Menu")) (package-refresh-contents) (package--generate-package-list)) -(defun package-menu-revert () - "Update the list of packages." +(defun package-menu-revert (&optional arg noconfirm) + "Update the list of packages. +This function is the `revert-buffer-function' for Package Menu +buffers. The arguments are ignored." (interactive) (unless (eq major-mode 'package-menu-mode) (error "The current buffer is not a Package Menu")) @@ -1457,8 +1459,7 @@ (defun package-list-maybe-add (package version status description result) (unless (assoc (cons package version) result) - (setq result (cons (list (cons package version) status description) - result))) + (push (list (cons package version) status description) result)) result) (defvar package-menu-package-list nil
--- a/lisp/emacs-lisp/rx.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/emacs-lisp/rx.el Wed Sep 08 13:08:19 2010 +0900 @@ -427,7 +427,7 @@ (mapcar (lambda (e) (cond ((= (car e) (cdr e)) (list (car e))) - ;; ((= (1+ (car e)) (cdr e)) (list (car e) (cdr e))) + ((= (1+ (car e)) (cdr e)) (list (car e) (cdr e))) ((list e)))) l)) (delete-dups str)))) @@ -545,7 +545,10 @@ ((numberp e) (string e)) ((consp e) (if (and (= (1+ (car e)) (cdr e)) - (null (memq (car e) '(?\] ?-)))) + ;; rx-any-condense-range should + ;; prevent this case from happening. + (null (memq (car e) '(?\] ?-))) + (null (memq (cdr e) '(?\] ?-)))) (string (car e) (cdr e)) (string (car e) ?- (cdr e)))) (e)))
--- a/lisp/emacs-lisp/smie.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/emacs-lisp/smie.el Wed Sep 08 13:08:19 2010 +0900 @@ -75,6 +75,26 @@ ;;; Building precedence level tables from BNF specs. +;; We have 4 different representations of a "grammar": +;; - a BNF table, which is a list of BNF rules of the form +;; (NONTERM RHS1 ... RHSn) where each RHS is a list of terminals (tokens) +;; or nonterminals. Any element in these lists which does not appear as +;; the `car' of a BNF rule is taken to be a terminal. +;; - A list of precedences (key word "precs"), is a list, sorted +;; from lowest to highest precedence, of precedence classes that +;; have the form (ASSOCIATIVITY TERMINAL1 .. TERMINALn), where +;; ASSOCIATIVITY can be `assoc', `left', `right' or `nonassoc'. +;; - a 2 dimensional precedence table (key word "prec2"), is a 2D +;; table recording the precedence relation (can be `<', `=', `>', or +;; nil) between each pair of tokens. +;; - a precedence-level table (key word "levels"), while is a alist +;; giving for each token its left and right precedence level (a +;; number or nil). This is used in `smie-op-levels'. +;; The prec2 tables are only intermediate data structures: the source +;; code normally provides a mix of BNF and precs tables, and then +;; turns them into a levels table, which is what's used by the rest of +;; the SMIE code. + (defun smie-set-prec2tab (table x y val &optional override) (assert (and x y)) (let* ((key (cons x y)) @@ -206,6 +226,87 @@ (setq rhs (cdr rhs))))) prec2)) +;; (defun smie-prec2-closer-alist (prec2 include-inners) +;; "Build a closer-alist from a PREC2 table. +;; The return value is in the same form as `smie-closer-alist'. +;; INCLUDE-INNERS if non-nil means that inner keywords will be included +;; in the table, e.g. the table will include things like (\"if\" . \"else\")." +;; (let* ((non-openers '()) +;; (non-closers '()) +;; ;; For each keyword, this gives the matching openers, if any. +;; (openers (make-hash-table :test 'equal)) +;; (closers '()) +;; (done nil)) +;; ;; First, find the non-openers and non-closers. +;; (maphash (lambda (k v) +;; (unless (or (eq v '<) (member (cdr k) non-openers)) +;; (push (cdr k) non-openers)) +;; (unless (or (eq v '>) (member (car k) non-closers)) +;; (push (car k) non-closers))) +;; prec2) +;; ;; Then find the openers and closers. +;; (maphash (lambda (k _) +;; (unless (member (car k) non-openers) +;; (puthash (car k) (list (car k)) openers)) +;; (unless (or (member (cdr k) non-closers) +;; (member (cdr k) closers)) +;; (push (cdr k) closers))) +;; prec2) +;; ;; Then collect the matching elements. +;; (while (not done) +;; (setq done t) +;; (maphash (lambda (k v) +;; (when (eq v '=) +;; (let ((aopeners (gethash (car k) openers)) +;; (dopeners (gethash (cdr k) openers)) +;; (new nil)) +;; (dolist (o aopeners) +;; (unless (member o dopeners) +;; (setq new t) +;; (push o dopeners))) +;; (when new +;; (setq done nil) +;; (puthash (cdr k) dopeners openers))))) +;; prec2)) +;; ;; Finally, dump the resulting table. +;; (let ((alist '())) +;; (maphash (lambda (k v) +;; (when (or include-inners (member k closers)) +;; (dolist (opener v) +;; (unless (equal opener k) +;; (push (cons opener k) alist))))) +;; openers) +;; alist))) + +(defun smie-bnf-closer-alist (bnf &optional no-inners) + ;; We can also build this closer-alist table from a prec2 table, + ;; but it takes more work, and the order is unpredictable, which + ;; is a problem for smie-close-block. + ;; More convenient would be to build it from a levels table since we + ;; always have this table (contrary to the BNF), but it has all the + ;; disadvantages of the prec2 case plus the disadvantage that the levels + ;; table has lost some info which would result in extra invalid pairs. + "Build a closer-alist from a BNF table. +The return value is in the same form as `smie-closer-alist'. +NO-INNERS if non-nil means that inner keywords will be excluded +from the table, e.g. the table will not include things like (\"if\" . \"else\")." + (let ((nts (mapcar #'car bnf)) ;non terminals. + (alist '())) + (dolist (nt bnf) + (dolist (rhs (cdr nt)) + (unless (or (< (length rhs) 2) (member (car rhs) nts)) + (if no-inners + (let ((last (car (last rhs)))) + (unless (member last nts) + (pushnew (cons (car rhs) last) alist :test #'equal))) + ;; Reverse so that the "real" closer gets there first, + ;; which is important for smie-close-block. + (dolist (term (reverse (cdr rhs))) + (unless (member term nts) + (pushnew (cons (car rhs) term) alist :test #'equal))))))) + (nreverse alist))) + + (defun smie-prec2-levels (prec2) ;; FIXME: Rather than only return an alist of precedence levels, we should ;; also extract other useful data from it: @@ -223,7 +324,7 @@ `smie-bnf-precedence-table'." ;; For each operator, we create two "variables" (corresponding to ;; the left and right precedence level), which are represented by - ;; cons cells. Those are the vary cons cells that appear in the + ;; cons cells. Those are the very cons cells that appear in the ;; final `table'. The value of each "variable" is kept in the `car'. (let ((table ()) (csts ()) @@ -596,6 +697,81 @@ pos end)))) (t))))))) +(defvar smie-blink-matching-triggers '(?\s ?\n) + "Chars which might trigger `blink-matching-open'. +These can include the final chars of end-tokens, or chars that are +typically inserted right after an end token. +I.e. a good choice can be: + (delete-dups + (mapcar (lambda (kw) (aref (cdr kw) (1- (length (cdr kw))))) + smie-closer-alist))") + +(defcustom smie-blink-matching-inners t + "Whether SMIE should blink to matching opener for inner keywords. +If non-nil, it will blink not only for \"begin..end\" but also for \"if...else\"." + :type 'boolean) + +(defun smie-blink-matching-check (start end) + (save-excursion + (goto-char end) + (let ((ender (funcall smie-backward-token-function))) + (cond + ((not (and ender (rassoc ender smie-closer-alist))) + ;; This not is one of the begin..end we know how to check. + (blink-matching-check-mismatch start end)) + ((not start) t) + (t + (goto-char start) + (let ((starter (funcall smie-forward-token-function))) + (not (member (cons starter ender) smie-closer-alist)))))))) + +(defun smie-blink-matching-open () + "Blink the matching opener when applicable. +This uses SMIE's tables and is expected to be placed on `post-self-insert-hook'." + (when (and blink-matching-paren + smie-closer-alist ; Optimization. + (eq (char-before) last-command-event) ; Sanity check. + (memq last-command-event smie-blink-matching-triggers) + (save-excursion + ;; FIXME: Here we assume that closers all end + ;; with a word-syntax char. + (unless (eq ?\w (char-syntax last-command-event)) + (forward-char -1)) + (and (looking-at "\\>") + (not (nth 8 (syntax-ppss)))))) + (save-excursion + (let ((pos (point)) + (token (funcall smie-backward-token-function))) + (if (= 1 (length token)) + ;; The trigger char is itself a token but is not + ;; one of the closers (e.g. ?\; in Octave mode), + ;; so go back to the previous token + (setq token (save-excursion + (funcall smie-backward-token-function))) + (goto-char pos)) + ;; Here we assume that smie-backward-token-function + ;; returns a token that is a string and whose content + ;; match the buffer's representation of this token. + (when (and (> (length token) 1) (stringp token) + (memq (aref token (1- (length token))) + smie-blink-matching-triggers) + (not (eq (aref token (1- (length token))) + last-command-event))) + ;; Token ends with a trigger char, so don't blink for + ;; anything else than this trigger char, lest we'd blink + ;; both when inserting the trigger char and when inserting a + ;; subsequent SPC. + (setq token nil)) + (when (and (rassoc token smie-closer-alist) + (or smie-blink-matching-inners + (null (nth 2 (assoc token smie-op-levels))))) + ;; The major mode might set blink-matching-check-function + ;; buffer-locally so that interactive calls to + ;; blink-matching-open work right, but let's not presume + ;; that's the case. + (let ((blink-matching-check-function #'smie-blink-matching-check)) + (blink-matching-open))))))) + ;;; The indentation engine. (defcustom smie-indent-basic 4
--- a/lisp/emacs-lisp/syntax.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/emacs-lisp/syntax.el Wed Sep 08 13:08:19 2010 +0900 @@ -209,7 +209,8 @@ (funcall syntax-begin-function) ;; Make sure it's better. (> (point) pt-best)) - ;; Simple sanity check. + ;; Simple sanity checks. + (< (point) pos) ; backward-paragraph can fail here. (not (memq (get-text-property (point) 'face) '(font-lock-string-face font-lock-doc-face font-lock-comment-face))))
--- a/lisp/eshell/em-term.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/eshell/em-term.el Wed Sep 08 13:08:19 2010 +0900 @@ -187,8 +187,7 @@ ; (if (boundp 'xemacs-logo) ; (eshell-term-send-raw-string ; (or (condition-case () (x-get-selection) (error ())) -; (x-get-cutbuffer) -; (error "No selection or cut buffer available"))) +; (error "No selection available"))) ; ;; Give temporary modes such as isearch a chance to turn off. ; (run-hooks 'mouse-leave-buffer-hook) ; (setq this-command 'yank)
--- a/lisp/files.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/files.el Wed Sep 08 13:08:19 2010 +0900 @@ -67,9 +67,9 @@ via absolute symbolic links. Make TO the name of the link, and FROM the name it is linked to." :type '(repeat (cons :format "%v" - :value ("" . "") + :value ("\\`" . "") (regexp :tag "From") - (regexp :tag "To"))) + (string :tag "To"))) :group 'abbrev :group 'find-file) @@ -5563,12 +5563,14 @@ (defun get-free-disk-space (dir) "Return the amount of free space on directory DIR's file system. -The result is a string that gives the number of free 1KB blocks, -or nil if the system call or the program which retrieve the information -fail. It returns also nil when DIR is a remote directory. - -This function calls `file-system-info' if it is available, or invokes the -program specified by `directory-free-space-program' if that is non-nil." +The return value is a string describing the amount of free +space (normally, the number of free 1KB blocks). + +This function calls `file-system-info' if it is available, or +invokes the program specified by `directory-free-space-program' +and `directory-free-space-args'. If the system call or program +is unsuccessful, or if DIR is a remote directory, this function +returns nil." (unless (file-remote-p dir) ;; Try to find the number of free blocks. Non-Posix systems don't ;; always have df, but might have an equivalent system call. @@ -5588,19 +5590,22 @@ directory-free-space-args dir) 0))) - ;; Usual format is a header line followed by a line of - ;; numbers. + ;; Usual format is as follows: + ;; Filesystem ... Used Available Capacity ... + ;; /dev/sda6 ...48106535 35481255 10669850 ... (goto-char (point-min)) - (forward-line 1) - (if (not (eobp)) - (progn - ;; Move to the end of the "available blocks" number. - (skip-chars-forward "^ \t") - (forward-word 3) - ;; Copy it into AVAILABLE. - (let ((end (point))) - (forward-word -1) - (buffer-substring (point) end)))))))))) + (when (re-search-forward " +Avail[^ \n]*" + (line-end-position) t) + (let ((beg (match-beginning 0)) + (end (match-end 0)) + str) + (forward-line 1) + (setq str + (buffer-substring-no-properties + (+ beg (point) (- (point-min))) + (+ end (point) (- (point-min))))) + (when (string-match "\\` *\\([^ ]+\\)" str) + (match-string 1 str)))))))))) ;; The following expression replaces `dired-move-to-filename-regexp'. (defvar directory-listing-before-filename-regexp
--- a/lisp/frame.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/frame.el Wed Sep 08 13:08:19 2010 +0900 @@ -1210,8 +1210,7 @@ (defun display-selections-p (&optional display) "Return non-nil if DISPLAY supports selections. A selection is a way to transfer text or other data between programs -via special system buffers called `selection' or `cut buffer' or -`clipboard'. +via special system buffers called `selection' or `clipboard'. DISPLAY can be a display name, a frame, or nil (meaning the selected frame's display)." (let ((frame-type (framep-on-display display)))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/gnus/.dir-locals.el Wed Sep 08 13:08:19 2010 +0900 @@ -0,0 +1,1 @@ +((emacs-lisp-mode . ((show-trailing-whitespace . t))))
--- a/lisp/gnus/ChangeLog Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/gnus/ChangeLog Wed Sep 08 13:08:19 2010 +0900 @@ -1,3 +1,257 @@ +2010-09-07 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-html.el (gnus-html-wash-tags, gnus-html-put-image): Mark cid and + internal images as deletable by `W D D'. + + * gnus-async.el (gnus-html-prefetch-images): Autoload it when compiling. + (gnus-async-article-callback): Fix typo. + +2010-09-06 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-html.el (gnus-html-wash-tags): Limit end-tag matching to the + current line to work around bugs in the output from w3m. + + * gnus-async.el (gnus-async-article-callback): Always prefetch images + for groups that want that. + + * nntp.el (nntp-wait-for-string): Supply a timeout for + accept-process-output to ensure progress. + + * gnus-start.el (gnus-get-unread-articles): If being given an explicit + level to get unread articles from, then use that for foreign groups, + too. + + * gnus-html.el (gnus-html-wash-tags): Remove <a name...> tags, which + confuses the rest of the function. + + * gnus-start.el (gnus-read-active-for-groups): Do a `gnus-request-scan' + for the methods that support -retrieve-groups, too. + + * nnml.el (nnml-save-nov): Remove some debugging-related messages. + +2010-09-06 Katsumi Yamaoka <yamaoka@jpl.org> + + * pop3.el: Require cl when compiling. + (pop3-number-of-responses): Search for "+OK", not "+OK ". + +2010-09-05 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-start.el (gnus-get-unread-articles): Don't bother with groups + that aren't going to be activated. + (gnus-get-unread-articles): Fix up the last commit. + + * gnus-html.el (gnus-article-html): Allow calling without specifying + the handle. In that case, dissect the buffer first. + + * gnus-sum.el (gnus-set-mode-line): Don't pad the mode line string. + + * nnimap.el (nnimap-open-connection): Revert the change that would look + into authinfo for imaps instead of imap. + + * gnus-start.el (gnus-activate-group): Take an optional parameter to + say that you don't want to call gnus-request-group with don-check, but + do check the reponse. This is for virtual groups only. + (gnus-get-unread-articles): Count the archive groups as secondary, so + that they're activated the same way as before. + + * nnimap.el (nnimap-request-list): Servers may return \NoSelect + case-insensitively. + (nnimap-debug): Removed. + + * mail-source.el (mail-source-fetch): Don't message if we're fetching + mail from a file, and the file doesn't exist. + + * pop3.el (pop3-streaming-movemail): Return t for success. + + * nnimap.el (nnimap-open-connection): Look for the "imaps" entry in the + .authinfo if we're using ssl connection. + + * nnvirtual.el (nnvirtual-create-mapping): Use the active info we + already have if we're in a main Gnus `g' run. + + * gnus-start.el (gnus-method-rank): Get info for virtual groups last. + +2010-09-05 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-start.el (gnus-method-rank): Replace equalp with equal. + + * nnmh.el (nnmh-request-list-1): Bind `file'. + + * pop3.el (pop3-set-process-query-on-exit-flag): New function that's an + alias to set-process-query-on-exit-flag or process-kill-without-query. + (pop3-open-server): Use it. + +2010-09-04 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * mail-source.el (mail-source-delete-crash-box): Always move the crash + box to the Incoming file. Fixes mistake in previous checkin. + + * pop3.el (pop3-send-streaming-command): Off-by-one error on the + request loop (for debugging purposes) removed. + + * nnml.el (nnml-save-nov): Message around nnml-save-nov so that the + culprit is more visible. + (nnml-save-incremental-nov, nnml-open-incremental-nov) + (nnml-add-incremental-nov): New functions to do "incremental" nov + updates, where we just append to the end of the existing nov files + without reading/writing them in full. + + * mail-source.el (mail-source-delete-crash-box): Really only check the + incoming files once in a while. + + * pop3.el (pop3-streaming-movemail): Always close the pop3 connection. + + * mail-source.el (mail-source-delete-crash-box): Only check the + incoming files for deletion once per day to save a lot of file + accesses. + + * pop3.el (pop3-logon): Fix up unbound variable typo. + + * mail-source.el (pop3-streaming-movemail): Autoload. + + * pop3.el (pop3-streaming-movemail): Respect + pop3-leave-mail-on-server. + + * mail-source.el (mail-source-fetch-pop): Use streaming pop3 + retrieval. + + * pop3.el (pop3-process-filter): Removed unused function. + (pop3-streaming-movemail, pop3-send-streaming-command) + (pop3-wait-for-messages, pop3-write-to-file) + (pop3-number-of-responses): New functions for streaming pop3 + retrieval. + + * gnus-start.el (gnus-get-unread-articles): Protect against groups that + come from no known methods. + (gnus-make-hashtable-from-newsrc-alist): Remove duplicates from .newsrc + list. + + * pop3.el (pop3-display-message-size-flag): Removed -- everybody wants + message sizes. + (pop3-movemail): Use erase-buffer instead of looping and deleting + regions, which seems rather odd. + + * gnus-agent.el (gnus-agent-load-local): Only read the agent.lib/local + file once per `g' run. + + * nnmh.el (nnmh-request-list-1): Output active lines also for empty + directories. This makes the draft queue directory work. + + * gnus-start.el (gnus-get-unread-articles): Rewrite the way we request + data from the backends, so that we only request the list of groups from + each method once. This should speed things up considerably. + + * nnvirtual.el (nnvirtual-request-list): Remove function so that we can + detect that it's not implemented. + + * nnmh.el (nnmh-request-list-1): Fix up the recursion behavior so that + we actually do recurse down into the tree, but don't stat all leaf + nodes. + + * gnus-html.el (gnus-html-show-images): If there are no images to show, + then say so instead of bugging out. + + * gnus-agent.el (gnus-agent-load-alist): Check whether the agentview + files exist before trying to read them. + + * gnus-html.el (gnus-html-wash-tags): Remove even more white space + around <pre_int>. + + * gnus-art.el (gnus-article-copy-string): Say what data we copied. + + * nnmh.el (nnmh-request-list-1): Optimize for speed. + +2010-09-03 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * mm-util.el (mm-image-load-path): Just return the image directories, + not all directories in the path in addition to the image directories. + (mm-image-load-path): Maintain a cache of the image directories so that + the `g' command in Gnus doesn't have to stat dozens of directories each + time. + + * gnus-html.el (gnus-html-put-image): Allow images to be removed. + (gnus-html-wash-tags): Add a new `i' command to insert images. + (gnus-html-insert-image): New command and keystroke. + (gnus-html-redisplay-with-images): New command and keystroke. + (gnus-html-show-images): Renamed command. + (gnus-html-wash-tags): Remove more white space before <pre_int> image + spacers. + (gnus-html-wash-tags): Decode entities at the end, so that entities + inside the tags don't mess up the rest of the "parsing". + + * gnus-agent.el (gnus-agent-auto-agentize-methods): Change the default + so that nnimap methods aren't agentized by default. There's apparently + many problems related to agent/imap behaviour. + + * gnus-art.el (gnus-article-copy-string): New command and key binding. + + * gnus-html.el: Doc fix. + +2010-09-03 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-html.el (gnus-html-put-image): Use gnus-graphic-display-p, + glyph-width and glyph-height instead of display-graphic-p and + image-size; make avoidance of displaying small images work for XEmacs. + + * gnus-util.el (gnus-graphic-display-p): Use device-on-window-system-p + for XEmacs. + + * gnus-ems.el (gnus-set-process-plist, gnus-process-plist): Change name + of symbol that holds plist data. + (gnus-process-plist): Remove plist of process after getting it. + +2010-09-02 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * message.el (message-generate-hashcash): Change default to + 'opportunistic if hashcash is installed. + + * gnus-html.el (gnus-html-rescale-image): Fix up typo in rescaling. + (gnus-html-put-image): Only call image-size once, since it's somewhat + time-consuming on remote X servers. + +2010-09-02 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-html.el (gnus-article-html): Make work buffer multibyte for + decoded contents. + (gnus-html-put-image, gnus-html-rescale-image): Pass `file' argument. + +2010-09-02 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-group.el (gnus-group-line-format): Remove %O (moderated) from + group line format, since it isn't very interesting. + + * gnus-agent.el (gnus-agent-short-article), + (gnus-agent-long-article): Increase values for these two variables, + since most people are likely to have more network connection and + storage than before. + + * gnus.el (gnus-refer-article-method): Change default to 'current. + When referring an article, the common behaviour is to refer it from the + current select method, not the native select method. The chances of + the native select method having the message in question is rather slim + these days. + + * gnus-sum.el (gnus-auto-select-subject): Change default to + `unseen-or-unread'. I think it's likely that most people want to + select an unseen article over a previously seen, but unread one. + + * gnus.el (gnus-mode-non-string-length): Change default to 30. nil + means that in the article buffer none of the minor mode elements will + be shown, usually, and this is not desirable in most cases. + + * gnus-sum.el (gnus-summary-goto-unread): Change default to nil, so + that commands like `d' (and the like) go to the next line in the + buffer, instead of the next unread article. I think this is the + behaviour that is most natural for most users. + (gnus-single-article-buffer): Change default to nil, so that people can + have as many article buffers open as they have summary buffer. I think + this is the most natural way for the groups to behave. + + * message.el (message-generate-new-buffers): Change default to + `unsent', so that all new message buffers start their names with the + string "*unsent", and it's easier to find the buffers if you move from + them. + 2010-09-01 Lars Magne Ingebrigtsen <larsi@gnus.org> * gnus-html.el (gnus-html-wash-tags): Don't show images that are really
--- a/lisp/gnus/gnus-agent.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/gnus/gnus-agent.el Wed Sep 08 13:08:19 2010 +0900 @@ -184,7 +184,7 @@ :type 'boolean :group 'gnus-agent) -(defcustom gnus-agent-auto-agentize-methods '(nntp nnimap) +(defcustom gnus-agent-auto-agentize-methods '(nntp) "Initially, all servers from these methods are agentized. The user may remove or add servers using the Server buffer. See Info node `(gnus)Server Buffer'." @@ -2108,13 +2108,15 @@ (defun gnus-agent-load-alist (group) "Load the article-state alist for GROUP." ;; Bind free variable that's used in `gnus-agent-read-agentview'. - (let ((gnus-agent-read-agentview group) - (file-name-coding-system nnmail-pathname-coding-system)) - (setq gnus-agent-article-alist - (gnus-cache-file-contents - (gnus-agent-article-name ".agentview" group) - 'gnus-agent-file-loading-cache - 'gnus-agent-read-agentview)))) + (let* ((gnus-agent-read-agentview group) + (file-name-coding-system nnmail-pathname-coding-system) + (agentview (gnus-agent-article-name ".agentview" group))) + (when (file-exists-p agentview) + (setq gnus-agent-article-alist + (gnus-cache-file-contents + agentview + 'gnus-agent-file-loading-cache + 'gnus-agent-read-agentview))))) (defun gnus-agent-read-agentview (file) "Load FILE and do a `read' there." @@ -2230,23 +2232,28 @@ (gnus-agent-update-view-total-fetched-for group nil))) (defvar gnus-agent-article-local nil) +(defvar gnus-agent-article-local-times nil) (defvar gnus-agent-file-loading-local nil) (defun gnus-agent-load-local (&optional method) "Load the METHOD'S local file. The local file contains min/max article counts for each of the method's subscribed groups." (let ((gnus-command-method (or method gnus-command-method))) - (setq gnus-agent-article-local - (gnus-cache-file-contents - (gnus-agent-lib-file "local") - 'gnus-agent-file-loading-local - 'gnus-agent-read-and-cache-local)))) + (when (or (null gnus-agent-article-local-times) + (zerop gnus-agent-article-local-times)) + (setq gnus-agent-article-local + (gnus-cache-file-contents + (gnus-agent-lib-file "local") + 'gnus-agent-file-loading-local + 'gnus-agent-read-and-cache-local)) + (when gnus-agent-article-local-times + (incf gnus-agent-article-local-times))) + gnus-agent-article-local)) (defun gnus-agent-read-and-cache-local (file) "Load and read FILE then bind its contents to gnus-agent-article-local. If that variable had `dirty' (also known as modified) original contents, they are first saved to their own file." - (if (and gnus-agent-article-local (symbol-value (intern "+dirty" gnus-agent-article-local))) (gnus-agent-save-local)) @@ -2644,10 +2651,10 @@ (defvar gnus-agent-predicate 'false "The selection predicate used when no other source is available.") -(defvar gnus-agent-short-article 100 +(defvar gnus-agent-short-article 500 "Articles that have fewer lines than this are short.") -(defvar gnus-agent-long-article 200 +(defvar gnus-agent-long-article 1000 "Articles that have more lines than this are long.") (defvar gnus-agent-low-score 0
--- a/lisp/gnus/gnus-art.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/gnus/gnus-art.el Wed Sep 08 13:08:19 2010 +0900 @@ -4823,6 +4823,22 @@ (vector (caddr c) (car c) :active t)) gnus-mime-button-commands))) +(defvar gnus-url-button-commands + '((gnus-article-copy-string "u" "Copy URL to kill ring"))) + +(defvar gnus-url-button-map + (let ((map (make-sparse-keymap))) + (dolist (c gnus-url-button-commands) + (define-key map (cadr c) (car c))) + map)) + +(easy-menu-define + gnus-url-button-menu gnus-url-button-map "URL button menu." + `("Url Button" + ,@(mapcar (lambda (c) + (vector (caddr c) (car c) :active t)) + gnus-url-button-commands))) + (defmacro gnus-bind-safe-url-regexp (&rest body) "Bind `mm-w3m-safe-url-regexp' according to `gnus-safe-html-newsgroups'." `(let ((mm-w3m-safe-url-regexp @@ -7813,7 +7829,11 @@ (unless (and (eq (car entry) 'gnus-button-url-regexp) (gnus-article-extend-url-button from start end)) (gnus-article-add-button start end - 'gnus-button-push from))))))))) + 'gnus-button-push from) + (gnus-put-text-property + start end + 'gnus-string (buffer-substring-no-properties + start end)))))))))) (defun gnus-article-extend-url-button (beg start end) "Extend url button if url is folded into two or more lines. @@ -7918,8 +7938,20 @@ (and data (list 'gnus-data data)))) (widget-convert-button 'link from to :action 'gnus-widget-press-button :help-echo (or text "Follow the link") + :keymap gnus-url-button-map :button-keymap gnus-widget-button-keymap)) +(defun gnus-article-copy-string () + "Copy the string in the button to the kill ring." + (interactive) + (gnus-article-check-buffer) + (let ((data (get-text-property (point) 'gnus-string))) + (when data + (with-temp-buffer + (insert data) + (copy-region-as-kill (point-min) (point-max)) + (message "Copied %s" data))))) + ;;; Internal functions: (defun gnus-article-set-globals ()
--- a/lisp/gnus/gnus-async.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/gnus/gnus-async.el Wed Sep 08 13:08:19 2010 +0900 @@ -228,6 +228,9 @@ `(lambda (arg) (gnus-async-article-callback arg ,group ,article ,mark ,summary ,next))) +(eval-when-compile + (autoload 'gnus-html-prefetch-images "gnus-html")) + (defun gnus-async-article-callback (arg group article mark summary next) "Function called when an async article is done being fetched." (save-excursion @@ -238,6 +241,9 @@ (save-excursion (save-restriction (narrow-to-region mark (point-max)) + ;; Prefetch images for the groups that want that. + (when (fboundp 'gnus-html-prefetch-images) + (gnus-html-prefetch-images summary)) (funcall gnus-async-post-fetch-function summary)))) (gnus-async-with-semaphore (setq
--- a/lisp/gnus/gnus-ems.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/gnus/gnus-ems.el Wed Sep 08 13:08:19 2010 +0900 @@ -314,24 +314,31 @@ (defalias 'gnus-process-put 'process-put)) (defun gnus-set-process-plist (process plist) "Replace the plist of PROCESS with PLIST. Returns PLIST." - (put 'gnus-process-plist process plist)) + (put 'gnus-process-plist-internal process plist)) + (defun gnus-process-plist (process) "Return the plist of PROCESS." - ;; Remove those of dead processes from `gnus-process-plist' - ;; to prevent it from growing. - (let ((plist (symbol-plist 'gnus-process-plist)) - proc) - (while (setq proc (car plist)) - (if (and (processp proc) - (memq (process-status proc) '(open run))) - (setq plist (cddr plist)) - (setcar plist (caddr plist)) - (setcdr plist (or (cdddr plist) '(nil)))))) - (get 'gnus-process-plist process)) + ;; This form works but can't prevent the plist data from + ;; growing infinitely. + ;;(get 'gnus-process-plist-internal process) + (let* ((plist (symbol-plist 'gnus-process-plist-internal)) + (tem (memq process plist))) + (prog1 + (cadr tem) + ;; Remove it from the plist data. + (when tem + (if (eq plist tem) + (progn + (setcar plist (caddr plist)) + (setcdr plist (or (cdddr plist) '(nil)))) + (setcdr (nthcdr (- (length plist) (length tem) 1) plist) + (cddr tem))))))) + (defun gnus-process-get (process propname) "Return the value of PROCESS' PROPNAME property. This is the last value stored with `(gnus-process-put PROCESS PROPNAME VALUE)'." (plist-get (gnus-process-plist process) propname)) + (defun gnus-process-put (process propname value) "Change PROCESS' PROPNAME property to VALUE. It can be retrieved with `(gnus-process-get PROCESS PROPNAME)'."
--- a/lisp/gnus/gnus-group.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/gnus/gnus-group.el Wed Sep 08 13:08:19 2010 +0900 @@ -169,7 +169,7 @@ (function-item gnus-group-sort-by-rank) (function :tag "other" nil)))) -(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y:%B%(%g%)%O\n" +(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y:%B%(%g%)\n" "*Format of group lines. It works along the same lines as a normal formatting string, with some simple extensions. @@ -3982,23 +3982,13 @@ (>= arg gnus-use-nocem)) (not arg))) (gnus-nocem-scan-groups)) - ;; If ARG is not a number, then we read the active file. - (when (and arg (not (numberp arg))) - (let ((gnus-read-active-file t)) - (gnus-read-active-file)) - (setq arg nil) - - ;; If the user wants it, we scan for new groups. - (when (eq gnus-check-new-newsgroups 'always) - (gnus-find-new-newsgroups))) - - (setq arg (gnus-group-default-level arg t)) - (if (and gnus-read-active-file (not arg)) - (progn - (gnus-read-active-file) - (gnus-get-unread-articles arg)) - (let ((gnus-read-active-file (if arg nil gnus-read-active-file))) - (gnus-get-unread-articles arg))) + + (gnus-get-unread-articles arg) + + ;; If the user wants it, we scan for new groups. + (when (eq gnus-check-new-newsgroups 'always) + (gnus-find-new-newsgroups)) + (gnus-check-reasonable-setup) (gnus-run-hooks 'gnus-after-getting-new-news-hook) (gnus-group-list-groups (and (numberp arg)
--- a/lisp/gnus/gnus-html.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/gnus/gnus-html.el Wed Sep 08 13:08:19 2010 +0900 @@ -1,4 +1,4 @@ -;;; gnus-html.el --- Quoted-Printable functions +;;; gnus-html.el --- Render HTML in a buffer. ;; Copyright (C) 2010 Free Software Foundation, Inc. @@ -66,9 +66,17 @@ :group 'gnus-art :type 'float) +(defvar gnus-html-image-map + (let ((map (make-sparse-keymap))) + (define-key map "u" 'gnus-article-copy-string) + (define-key map "i" 'gnus-html-insert-image) + map)) + ;;;###autoload -(defun gnus-article-html (handle) +(defun gnus-article-html (&optional handle) (let ((article-buffer (current-buffer))) + (unless handle + (setq handle (mm-dissect-buffer t))) (save-restriction (narrow-to-region (point) (point)) (save-excursion @@ -82,7 +90,10 @@ (when (and charset (setq charset (mm-charset-to-coding-system charset)) (not (eq charset 'ascii))) - (mm-decode-coding-region (point-min) (point-max) charset)) + (insert (prog1 + (mm-decode-coding-string (buffer-string) charset) + (erase-buffer) + (mm-enable-multibyte)))) (call-process-region (point-min) (point-max) "w3m" nil article-buffer nil @@ -102,9 +113,11 @@ (defun gnus-html-wash-tags () (let (tag parameters string start end images url) - (mm-url-decode-entities) (goto-char (point-min)) - (while (re-search-forward "<pre_int> *</pre_int>\n" nil t) + (while (re-search-forward " *<pre_int> *</pre_int> *\n" nil t) + (replace-match "" t t)) + (goto-char (point-min)) + (while (re-search-forward "<a name[^\n>]+>" nil t) (replace-match "" t t)) (goto-char (point-min)) (while (re-search-forward "<\\([^ />]+\\)\\([^>]*\\)>" nil t) @@ -114,7 +127,7 @@ (when (plusp (length parameters)) (set-text-properties 0 (1- (length parameters)) nil parameters)) (delete-region start (point)) - (when (search-forward (concat "</" tag ">") nil t) + (when (search-forward (concat "</" tag ">") (line-end-position) t) (delete-region (match-beginning 0) (match-end 0))) (setq end (point)) (cond @@ -137,14 +150,31 @@ (when image (let ((string (buffer-substring start end))) (delete-region start end) - (gnus-put-image image (gnus-string-or string "*"))))) + (gnus-put-image image (gnus-string-or string "*") 'cid) + (gnus-add-image 'cid image)))) ;; Normal, external URL. - (unless (gnus-html-image-url-blocked-p - url - (if (buffer-live-p gnus-summary-buffer) - (with-current-buffer gnus-summary-buffer - gnus-blocked-images) - gnus-blocked-images)) + (if (gnus-html-image-url-blocked-p + url + (if (buffer-live-p gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer + gnus-blocked-images) + gnus-blocked-images)) + (progn + (widget-convert-button + 'link start end + :action 'gnus-html-insert-image + :help-echo url + :keymap gnus-html-image-map + :button-keymap gnus-html-image-map) + (let ((overlay (gnus-make-overlay start end)) + (spec (list url + (set-marker (make-marker) start) + (set-marker (make-marker) end)))) + (gnus-overlay-put overlay 'local-map gnus-html-image-map) + (gnus-overlay-put overlay 'gnus-image spec) + (gnus-put-text-property + start end + 'gnus-image spec))) (let ((file (gnus-html-image-id url)) width height) (when (string-match "height=\"?\\([0-9]+\\)" parameters) @@ -181,6 +211,7 @@ (let ((overlay (gnus-make-overlay start end))) (gnus-overlay-put overlay 'evaporate t) (gnus-overlay-put overlay 'gnus-button-url url) + (gnus-put-text-property start end 'gnus-string url) (when gnus-article-mouse-face (gnus-overlay-put overlay 'mouse-face gnus-article-mouse-face))))) ;; The upper-case IMG_ALT is apparently just an artifact that @@ -194,10 +225,17 @@ (goto-char (point-min)) ;; The output from -halfdump isn't totally regular, so strip ;; off any </pre_int>s that were left over. - (while (re-search-forward "</pre_int>" nil t) + (while (re-search-forward "</pre_int>\\|</internal>" nil t) (replace-match "" t t)) (when images - (gnus-html-schedule-image-fetching (current-buffer) (nreverse images))))) + (gnus-html-schedule-image-fetching (current-buffer) (nreverse images))) + (mm-url-decode-entities))) + +(defun gnus-html-insert-image () + "Fetch and insert the image under point." + (interactive) + (gnus-html-schedule-image-fetching + (current-buffer) (list (get-text-property (point) 'gnus-image)))) (defun gnus-html-schedule-image-fetching (buffer images) (gnus-message 8 "gnus-html-schedule-image-fetching: buffer %s, images %s" @@ -239,35 +277,52 @@ (gnus-html-schedule-image-fetching buffer images))))) (defun gnus-html-put-image (file point string) - (when (display-graphic-p) - (let ((image (ignore-errors - (gnus-create-image file)))) + (when (gnus-graphic-display-p) + (let* ((image (ignore-errors + (gnus-create-image file))) + (size (and image + (if (featurep 'xemacs) + (cons (glyph-width image) (glyph-height image)) + (image-size image t))))) (save-excursion (goto-char point) (if (and image ;; Kludge to avoid displaying 30x30 gif images, which ;; seems to be a signal of a broken image. - (not (and (listp image) - (eq (plist-get (cdr image) :type) 'gif) - (= (car (image-size image t)) 30) - (= (cdr (image-size image t)) 30)))) + (not (and (if (featurep 'xemacs) + (glyphp image) + (listp image)) + (eq (if (featurep 'xemacs) + (let ((data (cdadar (specifier-spec-list + (glyph-image image))))) + (and (vectorp data) + (aref data 0))) + (plist-get (cdr image) :type)) + 'gif) + (= (car size) 30) + (= (cdr size) 30)))) (progn - (gnus-put-image (gnus-html-rescale-image image) - (gnus-string-or string "*")) + (setq image (gnus-html-rescale-image image file size)) + (gnus-put-image image + (gnus-string-or string "*") + 'external) + (gnus-add-image 'external image) t) (insert string) (when (fboundp 'find-image) - (gnus-put-image (find-image - '((:type xpm :file "lock-broken.xpm"))) - (gnus-string-or string "*"))) + (setq image (find-image '((:type xpm :file "lock-broken.xpm")))) + (gnus-put-image image + (gnus-string-or string "*") + 'internal) + (gnus-add-image 'internal image)) nil))))) -(defun gnus-html-rescale-image (image) +(defun gnus-html-rescale-image (image file size) (if (or (not (fboundp 'imagemagick-types)) (not (get-buffer-window (current-buffer)))) image - (let* ((width (car (image-size image t))) - (height (cdr (image-size image t))) + (let* ((width (car size)) + (height (cdr size)) (edges (window-pixel-edges (get-buffer-window (current-buffer)))) (window-width (truncate (* gnus-max-image-proportion (- (nth 2 edges) (nth 0 edges))))) @@ -278,11 +333,12 @@ (setq image (or (create-image file 'imagemagick nil :height window-height) image)) - (when (> (car (image-size image t)) window-width) - (setq image (or - (create-image file 'imagemagick nil - :width window-width) - image)))) + (setq size (image-size image t))) + (when (> (car size) window-width) + (setq image (or + (create-image file 'imagemagick nil + :width window-width) + image))) image))) (defun gnus-html-prune-cache () @@ -314,6 +370,20 @@ url blocked-images)) ret)) +(defun gnus-html-show-images () + "Show any images that are in the HTML-rendered article buffer. +This only works if the article in question is HTML." + (interactive) + (gnus-with-article-buffer + (let ((overlays (overlays-in (point-min) (point-max))) + overlay images) + (while (setq overlay (pop overlays)) + (when (overlay-get overlay 'gnus-image) + (push (overlay-get overlay 'gnus-image) images))) + (if (not images) + (message "No images to show") + (gnus-html-schedule-image-fetching (current-buffer) images))))) + ;;;###autoload (defun gnus-html-prefetch-images (summary) (let (blocked-images urls)
--- a/lisp/gnus/gnus-int.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/gnus/gnus-int.el Wed Sep 08 13:08:19 2010 +0900 @@ -365,7 +365,7 @@ (when (stringp gnus-command-method) (setq gnus-command-method (inline (gnus-server-to-method gnus-command-method)))) - (funcall (inline (gnus-get-function gnus-command-method 'request-group)) + (funcall (inline (gnus-get-function gnus-command-method 'request-group)) (gnus-group-real-name group) (nth 1 gnus-command-method) dont-check))) @@ -544,7 +544,8 @@ (if group (gnus-find-method-for-group group) gnus-command-method)) (gnus-inhibit-demon t) (mail-source-plugged gnus-plugged)) - (when (or gnus-plugged (not (gnus-agent-method-p gnus-command-method))) + (when (or gnus-plugged + (not (gnus-agent-method-p gnus-command-method))) (setq gnus-internal-registry-spool-current-method gnus-command-method) (funcall (gnus-get-function gnus-command-method 'request-scan) (and group (gnus-group-real-name group))
--- a/lisp/gnus/gnus-start.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/gnus/gnus-start.el Wed Sep 08 13:08:19 2010 +0900 @@ -1526,7 +1526,8 @@ (when (> (cdr cache-active) (cdr active)) (setcdr active (cdr cache-active)))))))) -(defun gnus-activate-group (group &optional scan dont-check method) +(defun gnus-activate-group (group &optional scan dont-check method + dont-sub-check) "Check whether a group has been activated or not. If SCAN, request a scan of that group as well." (let ((method (or method (inline (gnus-find-method-for-group group)))) @@ -1541,9 +1542,11 @@ (gnus-request-scan group method)) t) (if (or debug-on-error debug-on-quit) - (inline (gnus-request-group group dont-check method)) + (inline (gnus-request-group group (or dont-sub-check dont-check) + method)) (condition-case nil - (inline (gnus-request-group group dont-check method)) + (inline (gnus-request-group group (or dont-sub-check dont-check) + method)) ;;(error nil) (quit (message "Quit activating %s" group) @@ -1674,18 +1677,22 @@ (let* ((newsrc (cdr gnus-newsrc-alist)) (alevel (or level gnus-activate-level (1+ gnus-level-subscribed))) (foreign-level - (min - (cond ((and gnus-activate-foreign-newsgroups - (not (numberp gnus-activate-foreign-newsgroups))) - (1+ gnus-level-subscribed)) - ((numberp gnus-activate-foreign-newsgroups) - gnus-activate-foreign-newsgroups) - (t 0)) - alevel)) + (or + level + (min + (cond ((and gnus-activate-foreign-newsgroups + (not (numberp gnus-activate-foreign-newsgroups))) + (1+ gnus-level-subscribed)) + ((numberp gnus-activate-foreign-newsgroups) + gnus-activate-foreign-newsgroups) + (t 0)) + alevel))) (methods-cache nil) (type-cache nil) - scanned-methods info group active method retrieve-groups cmethod - method-type) + (gnus-agent-article-local-times 0) + (archive-method (gnus-server-to-method "archive")) + infos info group active method cmethod + method-type method-group-list) (gnus-message 6 "Checking new news...") (while newsrc @@ -1704,114 +1711,101 @@ ;; nil for non-foreign groups that the user has requested not be checked ;; t for unchecked foreign groups or bogus groups, or groups that can't ;; be checked, for one reason or other. - (when (setq method (gnus-info-method info)) + + ;; First go through all the groups, see what select methods they + ;; belong to, and then collect them into lists per unique select + ;; method. + (if (not (setq method (gnus-info-method info))) + (setq method gnus-select-method) (if (setq cmethod (assoc method methods-cache)) (setq method (cdr cmethod)) (setq cmethod (inline (gnus-server-get-method nil method))) (push (cons method cmethod) methods-cache) (setq method cmethod))) - (when (and method - (not (setq method-type (cdr (assoc method type-cache))))) + (setq method-group-list (assoc method type-cache)) + (unless method-group-list (setq method-type (cond - ((gnus-secondary-method-p method) + ((or (gnus-secondary-method-p method) + (and (gnus-archive-server-wanted-p) + (gnus-methods-equal-p archive-method method))) 'secondary) ((inline (gnus-server-equal gnus-select-method method)) 'primary) (t 'foreign))) - (push (cons method method-type) type-cache)) + (push (setq method-group-list (list method method-type nil)) + type-cache)) + ;; Only add groups that need updating. + (when (<= (gnus-info-level info) + (if (eq (cadr method-group-list) 'foreign) + foreign-level + alevel)) + (setcar (nthcdr 2 method-group-list) + (cons info (nth 2 method-group-list))))) + + ;; Sort the methods based so that the primary and secondary + ;; methods come first. This is done for legacy reasons to try to + ;; ensure that side-effect behaviour doesn't change from previous + ;; Gnus versions. + (setq type-cache + (sort (nreverse type-cache) + (lambda (c1 c2) + (< (gnus-method-rank (cadr c1) (car c1)) + (gnus-method-rank (cadr c2) (car c2)))))) + + (while type-cache + (setq method (nth 0 (car type-cache)) + method-type (nth 1 (car type-cache)) + infos (nth 2 (car type-cache))) + (pop type-cache) + + (when (and method + infos) + ;; See if any of the groups from this method require updating. + (gnus-read-active-for-groups method infos) + (dolist (info infos) + (inline (gnus-get-unread-articles-in-group + info (gnus-active (gnus-info-group info))))))) + (gnus-message 6 "Checking new news...done"))) - (cond ((and method (eq method-type 'foreign)) - ;; These groups are foreign. Check the level. - (if (<= (gnus-info-level info) foreign-level) - (when (setq active (gnus-activate-group group 'scan)) - ;; Let the Gnus agent save the active file. - (when (and gnus-agent active (gnus-online method)) - (gnus-agent-save-group-info - method (gnus-group-real-name group) active)) - (unless (inline (gnus-virtual-group-p group)) - (inline (gnus-close-group group))) - (when (fboundp (intern (concat (symbol-name (car method)) - "-request-update-info"))) - (inline (gnus-request-update-info info method)))) - (if (and level - ;; If `active' is nil that means the group has - ;; never been read, the group should be marked - ;; as having never been checked (see below). - active - (> (gnus-info-level info) level)) - ;; Don't check groups of which levels are higher - ;; than the one that a user specified. - (setq active 'ignore)))) - ;; These groups are native or secondary. - ((> (gnus-info-level info) alevel) - ;; We don't want these groups. - (setq active 'ignore)) - ;; Activate groups. - ((not gnus-read-active-file) - (if (gnus-check-backend-function 'retrieve-groups group) - ;; if server support gnus-retrieve-groups we push - ;; the group onto retrievegroups for later checking - (if (assoc method retrieve-groups) - (setcdr (assoc method retrieve-groups) - (cons group (cdr (assoc method retrieve-groups)))) - (push (list method group) retrieve-groups)) - ;; hack: `nnmail-get-new-mail' changes the mail-source depending - ;; on the group, so we must perform a scan for every group - ;; if the users has any directory mail sources. - ;; hack: if `nnmail-scan-directory-mail-source-once' is non-nil, - ;; for it scan all spool files even when the groups are - ;; not required. - (if (and - (or nnmail-scan-directory-mail-source-once - (null (assq 'directory mail-sources))) - (member method scanned-methods)) - (setq active (gnus-activate-group group)) - (setq active (gnus-activate-group group 'scan)) - (push method scanned-methods)) - (when active - (gnus-close-group group))))) +(defun gnus-method-rank (type method) + (cond + ;; Get info for virtual groups last. + ((eq (car method) 'nnvirtual) + 200) + ((eq type 'primary) + 1) + ;; Compute the rank of the secondary methods based on where they + ;; are in the secondary select list. + ((eq type 'secondary) + (let ((i 2)) + (block nil + (dolist (smethod gnus-secondary-select-methods) + (when (equal method smethod) + (return i)) + (incf i)) + i))) + ;; Just say that all foreign groups have the same rank. + (t + 100))) - ;; Get the number of unread articles in the group. - (cond - ((eq active 'ignore) - ;; Don't do anything. - ) - (active - (inline (gnus-get-unread-articles-in-group info active t))) - (t - ;; The group couldn't be reached, so we nix out the number of - ;; unread articles and stuff. - (gnus-set-active group nil) - (let ((tmp (gnus-group-entry group))) - (when tmp - (setcar tmp t)))))) - - ;; iterate through groups on methods which support gnus-retrieve-groups - ;; and fetch a partial active file and use it to find new news. - (dolist (rg retrieve-groups) - (let ((method (or (car rg) gnus-select-method)) - (groups (cdr rg))) - (when (gnus-check-server method) - ;; Request that the backend scan its incoming messages. - (when (gnus-check-backend-function 'request-scan (car method)) - (gnus-request-scan nil method)) - (gnus-read-active-file-2 - (mapcar (lambda (group) (gnus-group-real-name group)) groups) - method) - (dolist (group groups) - (cond - ((setq active (gnus-active (gnus-info-group - (setq info (gnus-get-info group))))) - (inline (gnus-get-unread-articles-in-group info active t))) - (t - ;; The group couldn't be reached, so we nix out the number of - ;; unread articles and stuff. - (gnus-set-active group nil) - (setcar (gnus-group-entry group) t))))))) - - (gnus-message 6 "Checking new news...done"))) +(defun gnus-read-active-for-groups (method infos) + (with-current-buffer nntp-server-buffer + (cond + ((gnus-check-backend-function 'retrieve-groups (car method)) + (when (gnus-check-backend-function 'request-scan (car method)) + (gnus-request-scan nil method)) + (gnus-read-active-file-2 + (mapcar (lambda (info) + (gnus-group-real-name (gnus-info-group info))) + infos) + method)) + ((gnus-check-backend-function 'request-list (car method)) + (gnus-read-active-file-1 method nil)) + (t + (dolist (info infos) + (gnus-activate-group (gnus-info-group info) nil nil method t)))))) ;; Create a hash table out of the newsrc alist. The `car's of the ;; alist elements are used as keys. @@ -1833,14 +1827,18 @@ (if (setq rest (member method methods)) (gnus-info-set-method info (car rest)) (push method methods))) - (gnus-sethash - (car info) - ;; Preserve number of unread articles in groups. - (cons (and ohashtb (car (gnus-gethash (car info) ohashtb))) - prev) - gnus-newsrc-hashtb) - (setq prev alist - alist (cdr alist))) + ;; Check for duplicates. + (if (gnus-gethash (car info) gnus-newsrc-hashtb) + ;; Remove this entry from the alist. + (setcdr prev (cddr prev)) + (gnus-sethash + (car info) + ;; Preserve number of unread articles in groups. + (cons (and ohashtb (car (gnus-gethash (car info) ohashtb))) + prev) + gnus-newsrc-hashtb) + (setq prev alist)) + (setq alist (cdr alist))) ;; Make the same select-methods in `gnus-server-alist' identical ;; as well. (while methods @@ -2043,7 +2041,9 @@ (gnus-message 5 mesg) (when (gnus-check-server method) ;; Request that the backend scan its incoming messages. - (when (gnus-check-backend-function 'request-scan (car method)) + (when (and gnus-agent + (gnus-online method) + (gnus-check-backend-function 'request-scan (car method))) (gnus-request-scan nil method)) (cond ((and (eq gnus-read-active-file 'some) @@ -3196,5 +3196,3 @@ (provide 'gnus-start) ;;; gnus-start.el ends here - -
--- a/lisp/gnus/gnus-sum.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/gnus/gnus-sum.el Wed Sep 08 13:08:19 2010 +0900 @@ -221,7 +221,7 @@ :group 'gnus-summary-format :type 'string) -(defcustom gnus-summary-goto-unread t +(defcustom gnus-summary-goto-unread nil "*If t, many commands will go to the next unread article. This applies to marking commands as well as other commands that \"naturally\" select the next article, like, for instance, `SPC' at @@ -231,6 +231,7 @@ \(they go to the next article instead). If `never', commands that usually go to the next unread article, will go to the next article, whether it is read or not." + :version "24.1" :group 'gnus-summary-marks :link '(custom-manual "(gnus)Setting Marks") :type '(choice (const :tag "off" nil) @@ -349,7 +350,7 @@ :type '(choice (const :tag "none" nil) (sexp :menu-tag "first" t))) -(defcustom gnus-auto-select-subject 'unread +(defcustom gnus-auto-select-subject 'unseen-or-unread "*Says what subject to place under point when entering a group. This variable can either be the symbols `first' (place point on the @@ -360,7 +361,7 @@ line of the first unseen article or, if all article have been seen, on the subject line of the first unread article), or a function to be called to place point on some subject line." - :version "22.1" + :version "24.1" :group 'gnus-group-select :type '(choice (const best) (const unread) @@ -464,9 +465,10 @@ :group 'gnus-summary :type 'boolean) -(defcustom gnus-single-article-buffer t +(defcustom gnus-single-article-buffer nil "*If non-nil, display all articles in the same buffer. If nil, each group will get its own article buffer." + :version "24.1" :group 'gnus-article-various :type 'boolean) @@ -2108,6 +2110,7 @@ "d" gnus-article-display-face "s" gnus-treat-smiley "D" gnus-article-remove-images + "W" gnus-html-show-images "f" gnus-treat-from-picon "m" gnus-treat-mail-picon "n" gnus-treat-newsgroups-picon) @@ -6048,9 +6051,7 @@ (when (> (length mode-string) max-len) (setq mode-string (concat (truncate-string-to-width mode-string (- max-len 3)) - "..."))) - ;; Pad the mode string a bit. - (setq mode-string (format (format "%%-%ds" max-len) mode-string)))) + "..."))))) ;; Update the mode line. (setq mode-line-buffer-identification (gnus-mode-line-buffer-identification (list mode-string)))
--- a/lisp/gnus/gnus-util.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/gnus/gnus-util.el Wed Sep 08 13:08:19 2010 +0900 @@ -1580,11 +1580,9 @@ (car (symbol-value history)))) (defun gnus-graphic-display-p () - (or (and (fboundp 'display-graphic-p) - (display-graphic-p)) - ;;;!!!This is bogus. Fixme! - (and (featurep 'xemacs) - t))) + (if (featurep 'xemacs) + (device-on-window-system-p) + (display-graphic-p))) (put 'gnus-parse-without-error 'lisp-indent-function 0) (put 'gnus-parse-without-error 'edebug-form-spec '(body))
--- a/lisp/gnus/gnus.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/gnus/gnus.el Wed Sep 08 13:08:19 2010 +0900 @@ -1443,7 +1443,7 @@ ;; Customization variables -(defcustom gnus-refer-article-method nil +(defcustom gnus-refer-article-method 'current "Preferred method for fetching an article by Message-ID. If you are reading news from the local spool (with nnspool), fetching articles by Message-ID is painfully slow. By setting this method to an @@ -1455,6 +1455,7 @@ It can also be a list of select methods, as well as the special symbol `current', which means to use the current select method. If it is a list, Gnus will try all the methods in the list until it finds a match." + :version "24.1" :group 'gnus-server :type '(choice (const :tag "default" nil) (const current) @@ -1804,12 +1805,11 @@ (const summary) (const tree))) -;; Added by Keinonen Kari <kk85613@cs.tut.fi>. -(defcustom gnus-mode-non-string-length nil +(defcustom gnus-mode-non-string-length 30 "*Max length of mode-line non-string contents. If this is nil, Gnus will take space as is needed, leaving the rest -of the mode line intact. Note that the default of nil is unlikely -to be desirable; see the manual for further details." +of the mode line intact." + :version "24.1" :group 'gnus-various :type '(choice (const nil) integer))
--- a/lisp/gnus/mail-source.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/gnus/mail-source.el Wed Sep 08 13:08:19 2010 +0900 @@ -34,7 +34,7 @@ (require 'cl) (require 'imap)) (autoload 'auth-source-user-or-password "auth-source") -(autoload 'pop3-movemail "pop3") +(autoload 'pop3-streaming-movemail "pop3") (autoload 'pop3-get-message-count "pop3") (autoload 'nnheader-cancel-timer "nnheader") (require 'mm-util) @@ -536,7 +536,7 @@ (t value))) -(defun mail-source-fetch (source callback) +(defun mail-source-fetch (source callback &optional method) "Fetch mail from SOURCE and call CALLBACK zero or more times. CALLBACK will be called with the name of the file where (some of) the mail from SOURCE is put. @@ -544,6 +544,16 @@ (mail-source-bind-common source (if (or mail-source-plugged plugged) (save-excursion + ;; Special-case the `file' handler since it's so common and + ;; just adds noise. + (when (or (not (eq (car source) 'file)) + (mail-source-bind (file source) + (file-exists-p path))) + (nnheader-message 4 "%sReading incoming mail from %s..." + (if method + (format "%s: " method) + "") + (car source))) (let ((function (cadr (assq (car source) mail-source-fetcher-alist))) (found 0)) (unless function @@ -619,6 +629,8 @@ 0) (funcall callback mail-source-crash-box info))) +(defvar mail-source-incoming-last-checked-time nil) + (defun mail-source-delete-crash-box () (when (file-exists-p mail-source-crash-box) ;; Delete or move the incoming mail out of the way. @@ -634,9 +646,16 @@ (rename-file mail-source-crash-box incoming t) ;; remove old incoming files? (when (natnump mail-source-delete-incoming) - (mail-source-delete-old-incoming - mail-source-delete-incoming - mail-source-delete-old-incoming-confirm)))))) + ;; Don't check for old incoming files more than once per day to + ;; save a lot of file accesses. + (when (or (null mail-source-incoming-last-checked-time) + (> (time-to-seconds + (time-since mail-source-incoming-last-checked-time)) + (* 24 60 60))) + (setq mail-source-incoming-last-checked-time (current-time)) + (mail-source-delete-old-incoming + mail-source-delete-incoming + mail-source-delete-old-incoming-confirm))))))) (defun mail-source-movemail (from to) "Move FROM to TO using movemail." @@ -820,9 +839,11 @@ (if (eq authentication 'apop) 'apop 'pass)) (pop3-stream-type stream)) (if (or debug-on-quit debug-on-error) - (save-excursion (pop3-movemail mail-source-crash-box)) + (save-excursion (pop3-streaming-movemail + mail-source-crash-box)) (condition-case err - (save-excursion (pop3-movemail mail-source-crash-box)) + (save-excursion (pop3-streaming-movemail + mail-source-crash-box)) (error ;; We nix out the password in case the error ;; was because of a wrong password being given.
--- a/lisp/gnus/message.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/gnus/message.el Wed Sep 08 13:08:19 2010 +0900 @@ -464,7 +464,7 @@ :link '(custom-manual "(message)Sending Variables") :type 'boolean) -(defcustom message-generate-new-buffers 'unique +(defcustom message-generate-new-buffers 'unsent "*Say whether to create a new message buffer to compose a message. Valid values include: @@ -487,6 +487,7 @@ If this is a function, call that function with three parameters: The type, the To address and the group name (any of these may be nil). The function should return the new buffer name." + :version "24.1" :group 'message-buffers :link '(custom-manual "(message)Message Buffers") :type '(choice (const nil) @@ -1725,13 +1726,14 @@ (const :tag "Never" nil) (const :tag "Always" t))) -(defcustom message-generate-hashcash (if (executable-find "hashcash") t) +(defcustom message-generate-hashcash (if (executable-find "hashcash") 'opportunistic) "*Whether to generate X-Hashcash: headers. If t, always generate hashcash headers. If `opportunistic', only generate hashcash headers if it can be done without the user waiting (i.e., only asynchronously). You must have the \"hashcash\" binary installed, see `hashcash-path'." + :version "24.1" :group 'message-headers :link '(custom-manual "(message)Mail Headers") :type '(choice (const :tag "Always" t)
--- a/lisp/gnus/mm-util.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/gnus/mm-util.el Wed Sep 08 13:08:19 2010 +0900 @@ -1429,16 +1429,23 @@ ;; Reset the umask. (set-default-file-modes umask))))) +(defvar mm-image-load-path-cache nil) + (defun mm-image-load-path (&optional package) - (let (dir result) - (dolist (path load-path (nreverse result)) - (when (and path - (file-directory-p - (setq dir (concat (file-name-directory - (directory-file-name path)) - "etc/images/" (or package "gnus/"))))) - (push dir result)) - (push path result)))) + (if (and mm-image-load-path-cache + (equal load-path (car mm-image-load-path-cache))) + (cdr mm-image-load-path-cache) + (let (dir result) + (dolist (path load-path) + (when (and path + (file-directory-p + (setq dir (concat (file-name-directory + (directory-file-name path)) + "etc/images/" (or package "gnus/"))))) + (push dir result))) + (setq result (nreverse result) + mm-image-load-path-cache (cons load-path result)) + result))) ;; Fixme: This doesn't look useful where it's used. (if (fboundp 'detect-coding-region)
--- a/lisp/gnus/nnimap.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/gnus/nnimap.el Wed Sep 08 13:08:19 2010 +0900 @@ -588,11 +588,12 @@ (imap-mailbox-select decoded-group examine)) (let (minuid maxuid) (when (> (imap-mailbox-get 'exists) 0) - (imap-fetch-safe '("1,*" . "1,*:*") "UID" nil 'nouidfetch) - (imap-message-map (lambda (uid Uid) - (setq minuid (if minuid (min minuid uid) uid) - maxuid (if maxuid (max maxuid uid) uid))) - 'UID)) + (imap-fetch "1:*" "UID" nil 'nouidfetch) + (imap-message-map + (lambda (uid Uid) + (setq minuid (if minuid (min minuid uid) uid) + maxuid (if maxuid (max maxuid uid) uid))) + 'UID)) (list (imap-mailbox-get 'exists) minuid maxuid)))))) (defun nnimap-possibly-change-group (group &optional server) @@ -833,8 +834,8 @@ nnimap-authinfo-file) (netrc-parse nnimap-authinfo-file))) (port (if nnimap-server-port - (int-to-string nnimap-server-port) - "imap")) + (int-to-string nnimap-server-port) + "imap")) (auth-info (auth-source-user-or-password '("login" "password") server port)) (auth-user (nth 0 auth-info)) @@ -1114,14 +1115,16 @@ (dolist (pattern (nnimap-pattern-to-list-arguments nnimap-list-pattern)) (dolist (mbx (funcall nnimap-request-list-method (cdr pattern) (car pattern))) - (or (member "\\NoSelect" (imap-mailbox-get 'list-flags mbx)) - (let* ((encoded-mbx (nnimap-encode-group-name mbx)) - (info (nnimap-find-minmax-uid encoded-mbx 'examine))) - (when info - (with-current-buffer nntp-server-buffer - (insert (format "\"%s\" %d %d y\n" - encoded-mbx (or (nth 2 info) 0) - (max 1 (or (nth 1 info) 1))))))))))) + (unless (member "\\noselect" + (mapcar #'downcase + (imap-mailbox-get 'list-flags mbx))) + (let* ((encoded-mbx (nnimap-encode-group-name mbx)) + (info (nnimap-find-minmax-uid encoded-mbx 'examine))) + (when info + (with-current-buffer nntp-server-buffer + (insert (format "\"%s\" %d %d y\n" + encoded-mbx (or (nth 2 info) 0) + (max 1 (or (nth 1 info) 1))))))))))) (gnus-message 5 "nnimap: Generating active list%s...done" (if (> (length server) 0) (concat " for " server) "")) t)) @@ -1807,68 +1810,6 @@ "Return t if MARK can be permanently (between IMAP sessions) saved on articles, in GROUP." (imap-message-flag-permanent-p (nnimap-mark-to-flag mark))) -(when nnimap-debug - (require 'trace) - (buffer-disable-undo (get-buffer-create nnimap-debug-buffer)) - (mapc (lambda (f) (trace-function-background f nnimap-debug-buffer)) - '( - nnimap-possibly-change-server - nnimap-verify-uidvalidity - nnimap-find-minmax-uid - nnimap-before-find-minmax-bugworkaround - nnimap-possibly-change-group - ;;nnimap-replace-whitespace - nnimap-retrieve-headers-progress - nnimap-retrieve-which-headers - nnimap-group-overview-filename - nnimap-retrieve-headers-from-file - nnimap-retrieve-headers-from-server - nnimap-retrieve-headers - nnimap-open-connection - nnimap-open-server - nnimap-server-opened - nnimap-close-server - nnimap-request-close - nnimap-status-message - ;;nnimap-demule - nnimap-request-article-part - nnimap-request-article - nnimap-request-head - nnimap-request-body - nnimap-request-group - nnimap-close-group - nnimap-pattern-to-list-arguments - nnimap-request-list - nnimap-request-post - nnimap-retrieve-groups - nnimap-request-update-info-internal - nnimap-request-type - nnimap-request-set-mark - nnimap-split-to-groups - nnimap-split-find-rule - nnimap-split-find-inbox - nnimap-split-articles - nnimap-request-scan - nnimap-request-newgroups - nnimap-request-create-group - nnimap-time-substract - nnimap-date-days-ago - nnimap-request-expire-articles-progress - nnimap-request-expire-articles - nnimap-request-move-article - nnimap-request-accept-article - nnimap-request-delete-group - nnimap-request-rename-group - gnus-group-nnimap-expunge - gnus-group-nnimap-edit-acl - gnus-group-nnimap-edit-acl-done - nnimap-group-mode-hook - nnimap-mark-to-predicate - nnimap-mark-to-flag-1 - nnimap-mark-to-flag - nnimap-mark-permanent-p - ))) - (provide 'nnimap) ;;; nnimap.el ends here
--- a/lisp/gnus/nnmail.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/gnus/nnmail.el Wed Sep 08 13:08:19 2010 +0900 @@ -1823,8 +1823,6 @@ ;; The we go through all the existing mail source specification ;; and fetch the mail from each. (while (setq source (pop fetching-sources)) - (nnheader-message 4 "%s: Reading incoming mail from %s..." - method (car source)) (when (setq new (mail-source-fetch source @@ -1842,8 +1840,9 @@ (incf i))) ;; If we did indeed read any incoming spools, we save all info. (if (zerop total) - (nnheader-message 4 "%s: Reading incoming mail (no new mail)...done" - method (car source)) + (when mail-source-plugged + (nnheader-message 4 "%s: Reading incoming mail (no new mail)...done" + method (car source))) (nnmail-save-active (nnmail-get-value "%s-group-alist" method) (nnmail-get-value "%s-active-file" method))
--- a/lisp/gnus/nnmh.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/gnus/nnmh.el Wed Sep 08 13:08:19 2010 +0900 @@ -207,40 +207,48 @@ (defun nnmh-request-list-1 (dir) (setq dir (expand-file-name dir)) ;; Recurse down all directories. - (let ((dirs (and (file-readable-p dir) - (nnheader-directory-files dir t nil t))) - rdir) + (let ((files (nnheader-directory-files dir t nil t)) + (max 0) + min rdir num subdirectoriesp file) ;; Recurse down directories. - (while (setq rdir (pop dirs)) - (when (and (file-directory-p rdir) - (file-readable-p rdir) - (not (equal (file-truename rdir) - (file-truename dir)))) - (nnmh-request-list-1 rdir)))) - ;; For each directory, generate an active file line. - (unless (string= (expand-file-name nnmh-toplev) dir) - (let ((files (mapcar 'string-to-number - (directory-files dir nil "^[0-9]+$" t)))) - (when files - (with-current-buffer nntp-server-buffer - (goto-char (point-max)) - (insert - (format - "%s %.0f %.0f y\n" - (progn - (string-match - (regexp-quote - (file-truename (file-name-as-directory - (expand-file-name nnmh-toplev)))) - dir) - (mm-string-to-multibyte ;Why? Isn't it multibyte already? - (mm-encode-coding-string - (nnheader-replace-chars-in-string - (substring dir (match-end 0)) - ?/ ?.) - nnmail-pathname-coding-system))) - (apply 'max files) - (apply 'min files))))))) + (setq subdirectoriesp (> (nth 1 (file-attributes dir)) 2)) + (dolist (rdir files) + (if (or (not subdirectoriesp) + (file-regular-p rdir)) + (progn + (setq file (file-name-nondirectory rdir)) + (when (string-match "^[0-9]+$" file) + (setq num (string-to-number file)) + (setq max (max max num)) + (when (or (null min) + (< num min)) + (setq min num)))) + ;; This is a directory. + (when (and (file-readable-p rdir) + (not (equal (file-truename rdir) + (file-truename dir)))) + (nnmh-request-list-1 rdir)))) + ;; For each directory, generate an active file line. + (unless (string= (expand-file-name nnmh-toplev) dir) + (with-current-buffer nntp-server-buffer + (goto-char (point-max)) + (insert + (format + "%s %.0f %.0f y\n" + (progn + (string-match + (regexp-quote + (file-truename (file-name-as-directory + (expand-file-name nnmh-toplev)))) + dir) + (mm-string-to-multibyte ;Why? Isn't it multibyte already? + (mm-encode-coding-string + (nnheader-replace-chars-in-string + (substring dir (match-end 0)) + ?/ ?.) + nnmail-pathname-coding-system))) + (or max 0) + (or min 1)))))) t) (deffoo nnmh-request-newgroups (date &optional server)
--- a/lisp/gnus/nnml.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/gnus/nnml.el Wed Sep 08 13:08:19 2010 +0900 @@ -283,7 +283,7 @@ (deffoo nnml-request-scan (&optional group server) (setq nnml-article-file-alist nil) (nnml-possibly-change-directory group server) - (nnmail-get-new-mail 'nnml 'nnml-save-nov nnml-directory group)) + (nnmail-get-new-mail 'nnml 'nnml-save-incremental-nov nnml-directory group)) (deffoo nnml-close-group (group &optional server) (setq nnml-article-file-alist nil) @@ -438,7 +438,7 @@ (setq result (car (nnml-save-mail (list (cons group (nnml-active-number group server))) - server))) + server t))) (progn (nnmail-save-active nnml-group-alist nnml-active-file) (and last (nnml-save-nov)))) @@ -449,7 +449,7 @@ (nnml-active-number group ,server))))) (yes-or-no-p "Moved to `junk' group; delete article? ")) (setq result 'junk) - (setq result (car (nnml-save-mail result server)))) + (setq result (car (nnml-save-mail result server t)))) (when last (nnmail-save-active nnml-group-alist nnml-active-file) (when nnmail-cache-accepted-message-ids @@ -691,7 +691,7 @@ (make-directory (directory-file-name dir) t) (nnheader-message 5 "Creating mail directory %s" dir)))) -(defun nnml-save-mail (group-art &optional server) +(defun nnml-save-mail (group-art &optional server full-nov) "Save a mail into the groups GROUP-ART in the nnml server SERVER. GROUP-ART is a list that each element is a cons of a group name and an article number. This function is called narrowed to an article." @@ -742,11 +742,14 @@ ;; header. (setq headers (nnml-parse-head chars)) ;; Output the nov line to all nov databases that should have it. - (if nnmail-group-names-not-encoded-p + (let ((func (if full-nov + 'nnml-add-nov + 'nnml-add-incremental-nov))) + (if nnmail-group-names-not-encoded-p + (dolist (ga group-art) + (funcall func (pop dec) (cdr ga) headers)) (dolist (ga group-art) - (nnml-add-nov (pop dec) (cdr ga) headers)) - (dolist (ga group-art) - (nnml-add-nov (car ga) (cdr ga) headers)))) + (funcall func (car ga) (cdr ga) headers))))) group-art) (defun nnml-active-number (group &optional server) @@ -778,6 +781,35 @@ (setcdr active (1+ (cdr active)))) (cdr active))) +(defvar nnml-incremental-nov-buffer-alist nil) + +(defun nnml-save-incremental-nov () + (save-excursion + (while nnml-incremental-nov-buffer-alist + (when (buffer-name (cdar nnml-incremental-nov-buffer-alist)) + (set-buffer (cdar nnml-incremental-nov-buffer-alist)) + (when (buffer-modified-p) + (nnmail-write-region (point-min) (point-max) + nnml-nov-buffer-file-name t 'nomesg)) + (set-buffer-modified-p nil) + (kill-buffer (current-buffer))) + (setq nnml-incremental-nov-buffer-alist + (cdr nnml-incremental-nov-buffer-alist))))) + +(defun nnml-open-incremental-nov (group) + (or (cdr (assoc group nnml-incremental-nov-buffer-alist)) + (let ((buffer (nnml-get-nov-buffer group t))) + (push (cons group buffer) nnml-incremental-nov-buffer-alist) + buffer))) + +(defun nnml-add-incremental-nov (group article headers) + "Add a nov line for the GROUP nov headers, incrementally." + (save-excursion + (set-buffer (nnml-open-incremental-nov group)) + (goto-char (point-max)) + (mail-header-set-number headers article) + (nnheader-insert-nov headers))) + (defun nnml-add-nov (group article headers) "Add a nov line for the GROUP base." (save-excursion @@ -804,16 +836,21 @@ (mail-header-set-number headers number) headers)))) -(defun nnml-get-nov-buffer (group) +(defun nnml-get-nov-buffer (group &optional incrementalp) (let* ((decoded (nnml-decoded-group-name group)) - (buffer (get-buffer-create (format " *nnml overview %s*" decoded))) + (buffer (get-buffer-create (format " *nnml %soverview %s*" + (if incrementalp + "incremental " + "") + decoded))) (file-name-coding-system nnmail-pathname-coding-system)) (save-excursion (set-buffer buffer) (set (make-local-variable 'nnml-nov-buffer-file-name) (nnmail-group-pathname decoded nnml-directory nnml-nov-file-name)) (erase-buffer) - (when (file-exists-p nnml-nov-buffer-file-name) + (when (and (not incrementalp) + (file-exists-p nnml-nov-buffer-file-name)) (nnheader-insert-file-contents nnml-nov-buffer-file-name))) buffer))
--- a/lisp/gnus/nntp.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/gnus/nntp.el Wed Sep 08 13:08:19 2010 +0900 @@ -1768,7 +1768,7 @@ (while (and (setq proc (get-buffer-process buf)) (memq (process-status proc) '(open run)) (not (re-search-forward regexp nil t))) - (accept-process-output proc) + (accept-process-output proc 0.1) (set-buffer buf) (goto-char (point-min)))))
--- a/lisp/gnus/nnvirtual.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/gnus/nnvirtual.el Wed Sep 08 13:08:19 2010 +0900 @@ -260,13 +260,11 @@ (nnheader-report 'nnvirtual "No component groups in %s" group)) (t (setq nnvirtual-current-group group) - (when (or (not dont-check) - nnvirtual-always-rescan) - (nnvirtual-create-mapping) - (when nnvirtual-always-rescan - (nnvirtual-request-update-info - (nnvirtual-current-group) - (gnus-get-info (nnvirtual-current-group))))) + (nnvirtual-create-mapping dont-check) + (when nnvirtual-always-rescan + (nnvirtual-request-update-info + (nnvirtual-current-group) + (gnus-get-info (nnvirtual-current-group)))) (nnheader-insert "211 %d 1 %d %s\n" nnvirtual-mapping-len nnvirtual-mapping-len group)))) @@ -300,10 +298,6 @@ t) -(deffoo nnvirtual-request-list (&optional server) - (nnheader-report 'nnvirtual "LIST is not implemented.")) - - (deffoo nnvirtual-request-newgroups (date &optional server) (nnheader-report 'nnvirtual "NEWGROUPS is not supported.")) @@ -674,7 +668,7 @@ carticles)) -(defun nnvirtual-create-mapping () +(defun nnvirtual-create-mapping (dont-check) "Build the tables necessary to map between component (group, article) to virtual article. Generate the set of read messages and marks for the virtual group based on the marks on the component groups." @@ -693,7 +687,9 @@ ;; Into all-marks we put (g marks). ;; We also increment cnt and tot here, and compute M (max of sizes). (mapc (lambda (g) - (setq active (gnus-activate-group g) + (setq active (or (and dont-check + (gnus-active g)) + (gnus-activate-group g)) min (car active) max (cdr active)) (when (and active (>= max min) (not (zerop max)))
--- a/lisp/gnus/pop3.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/gnus/pop3.el Wed Sep 08 13:08:19 2010 +0900 @@ -33,6 +33,7 @@ ;;; Code: +(eval-when-compile (require 'cl)) (require 'mail-utils) (defvar parse-time-months) @@ -98,12 +99,6 @@ :type 'boolean :group 'pop3) -(defcustom pop3-display-message-size-flag t - "*If non-nil, display the size of the message that is being fetched." - :version "22.1" ;; Oort Gnus - :type 'boolean - :group 'pop3) - (defvar pop3-timestamp nil "Timestamp returned when initially connected to the POP server. Used for APOP authentication.") @@ -134,15 +129,91 @@ (truncate pop3-read-timeout)) 1000)))))) -(defun pop3-movemail (&optional crashbox) - "Transfer contents of a maildrop to the specified CRASHBOX." - (or crashbox (setq crashbox (expand-file-name "~/.crashbox"))) +(defun pop3-streaming-movemail (file) + "Transfer contents of a maildrop to the specified FILE. +Use streaming commands." (let* ((process (pop3-open-server pop3-mailhost pop3-port)) - (crashbuf (get-buffer-create " *pop3-retr*")) - (n 1) - message-count - message-sizes - (pop3-password pop3-password)) + message-count message-total-size) + (pop3-logon process) + (with-current-buffer (process-buffer process) + (let ((size (pop3-stat process))) + (setq message-count (car size) + message-total-size (cadr size))) + (when (plusp message-count) + (pop3-send-streaming-command + process "RETR" message-count message-total-size) + (pop3-write-to-file file) + (unless pop3-leave-mail-on-server + (pop3-send-streaming-command + process "DELE" message-count nil)))) + (pop3-quit process) + t)) + +(defun pop3-send-streaming-command (process command count total-size) + (erase-buffer) + (let ((i 1)) + (while (>= count i) + (process-send-string process (format "%s %d\r\n" command i)) + ;; Only do 100 messages at a time to avoid pipe stalls. + (when (zerop (% i 100)) + (pop3-wait-for-messages process i total-size)) + (incf i))) + (pop3-wait-for-messages process count total-size)) + +(defun pop3-wait-for-messages (process count total-size) + (while (< (pop3-number-of-responses total-size) count) + (when total-size + (message "pop3 retrieved %dKB (%d%%)" + (truncate (/ (buffer-size) 1000)) + (truncate (* (/ (* (buffer-size) 1.0) + total-size) 100)))) + (nnheader-accept-process-output process))) + +(defun pop3-write-to-file (file) + (let ((pop-buffer (current-buffer)) + (start (point-min)) + beg end + temp-buffer) + (with-temp-buffer + (setq temp-buffer (current-buffer)) + (with-current-buffer pop-buffer + (goto-char (point-min)) + (while (re-search-forward "^\\+OK" nil t) + (forward-line 1) + (setq beg (point)) + (when (re-search-forward "^\\.\r?\n" nil t) + (setq start (point)) + (forward-line -1) + (setq end (point))) + (with-current-buffer temp-buffer + (goto-char (point-max)) + (let ((hstart (point))) + (insert-buffer-substring pop-buffer beg end) + (pop3-clean-region hstart (point)) + (goto-char (point-max)) + (pop3-munge-message-separator hstart (point)) + (goto-char (point-max)))))) + (let ((coding-system-for-write 'binary)) + (goto-char (point-min)) + ;; Check whether something inserted a newline at the start and + ;; delete it. + (when (eolp) + (delete-char 1)) + (write-region (point-min) (point-max) file nil 'nomesg))))) + +(defun pop3-number-of-responses (endp) + (let ((responses 0)) + (save-excursion + (goto-char (point-min)) + (while (or (and (re-search-forward "^\\+OK" nil t) + (or (not endp) + (re-search-forward "^\\.\r?\n" nil t))) + (re-search-forward "^-ERR " nil t)) + (incf responses))) + responses)) + +(defun pop3-logon (process) + (let ((pop3-password pop3-password)) ;; for debugging only (if pop3-debug (switch-to-buffer (process-buffer process))) ;; query for password @@ -154,30 +225,33 @@ ((equal 'pass pop3-authentication-scheme) (pop3-user process pop3-maildrop) (pop3-pass process)) - (t (error "Invalid POP3 authentication scheme"))) + (t (error "Invalid POP3 authentication scheme"))))) + +(defun pop3-movemail (&optional crashbox) + "Transfer contents of a maildrop to the specified CRASHBOX." + (or crashbox (setq crashbox (expand-file-name "~/.crashbox"))) + (let* ((process (pop3-open-server pop3-mailhost pop3-port)) + (crashbuf (get-buffer-create " *pop3-retr*")) + (n 1) + message-count + message-sizes) + (pop3-logon process) (setq message-count (car (pop3-stat process))) - (when (and pop3-display-message-size-flag - (> message-count 0)) + (when (> message-count 0) (setq message-sizes (pop3-list process))) (unwind-protect (while (<= n message-count) - (if pop3-display-message-size-flag - (message "Retrieving message %d of %d from %s... (%.1fk)" - n message-count pop3-mailhost - (/ (cdr (assoc n message-sizes)) - 1024.0)) - (message "Retrieving message %d of %d from %s..." - n message-count pop3-mailhost)) + (message "Retrieving message %d of %d from %s... (%.1fk)" + n message-count pop3-mailhost + (/ (cdr (assoc n message-sizes)) + 1024.0)) (pop3-retr process n crashbuf) (save-excursion (set-buffer crashbuf) (let ((coding-system-for-write 'binary)) (write-region (point-min) (point-max) crashbox t 'nomesg)) (set-buffer (process-buffer process)) - (while (> (buffer-size) 5000) - (goto-char (point-min)) - (forward-line 50) - (delete-region (point-min) (point)))) + (erase-buffer)) (unless pop3-leave-mail-on-server (pop3-dele process n)) (setq n (+ 1 n)) @@ -229,6 +303,13 @@ (const :tag "SSL/TLS" ssl) (const starttls))) +(eval-and-compile + (if (fboundp 'set-process-query-on-exit-flag) + (defalias 'pop3-set-process-query-on-exit-flag + 'set-process-query-on-exit-flag) + (defalias 'pop3-set-process-query-on-exit-flag + 'process-kill-without-query))) + (defun pop3-open-server (mailhost port) "Open TCP connection to MAILHOST on PORT. Returns the process associated with the connection." @@ -289,16 +370,11 @@ (setq pop3-timestamp (substring response (or (string-match "<" response) 0) (+ 1 (or (string-match ">" response) -1))))) + (pop3-set-process-query-on-exit-flag process nil) process))) ;; Support functions -(defun pop3-process-filter (process output) - (save-excursion - (set-buffer (process-buffer process)) - (goto-char (point-max)) - (insert output))) - (defun pop3-send-command (process command) (set-buffer (process-buffer process)) (goto-char (point-max)) @@ -415,10 +491,7 @@ nil (goto-char (point-max)) (insert "\n")) - (narrow-to-region (point) (point-max)) - (let ((size (- (point-max) (point-min)))) - (goto-char (point-min)) - (widen) + (let ((size (- (point-max) (point)))) (forward-line -1) (insert (format "Content-Length: %s\n" size))) )))))
--- a/lisp/gnus/spam-report.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/gnus/spam-report.el Wed Sep 08 13:08:19 2010 +0900 @@ -267,7 +267,7 @@ (gnus-message 7 "Waiting for response from %s..." host) (while (and (memq (process-status tcp-connection) '(open run)) (zerop (buffer-size))) - (accept-process-output tcp-connection)) + (accept-process-output tcp-connection 1)) (gnus-message 7 "Waiting for response from %s... done" host))))) ;;;###autoload
--- a/lisp/mail/hashcash.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/mail/hashcash.el Wed Sep 08 13:08:19 2010 +0900 @@ -276,7 +276,7 @@ (unless buffer (setq buffer (current-buffer))) (let (entry) (while (setq entry (rassq buffer hashcash-process-alist)) - (accept-process-output (car entry))))) + (accept-process-output (car entry) 1)))) (defun hashcash-processes-running-p (buffer) "Return non-nil if hashcash processes in BUFFER are still running."
--- a/lisp/mouse-sel.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/mouse-sel.el Wed Sep 08 13:08:19 2010 +0900 @@ -98,7 +98,7 @@ ;; ;; Selection/kill-ring interaction is retained ;; interprogram-cut-function = x-select-text -;; interprogram-paste-function = x-cut-buffer-or-selection-value +;; interprogram-paste-function = x-selection-value ;; ;; What you lose is the ability to select some text in ;; delete-selection-mode and yank over the top of it. @@ -299,7 +299,7 @@ SELECTION-THING-SYMBOL = name of variable where the current selection type for this selection should be stored.") -(declare-function x-select-text "term/x-win" (text &optional push)) +(declare-function x-select-text "term/x-win" (text)) (defvar mouse-sel-set-selection-function (if (eq mouse-sel-default-bindings 'interprogram-cut-paste) @@ -314,15 +314,15 @@ SELECTION, the name of the selection concerned, and VALUE, the text to store. -This sets the selection as well as the cut buffer for the older applications, -unless `mouse-sel-default-bindings' is `interprogram-cut-paste'.") +This sets the selection, unless `mouse-sel-default-bindings' +is `interprogram-cut-paste'.") -(declare-function x-cut-buffer-or-selection-value "term/x-win" ()) +(declare-function x-selection-value "term/x-win" ()) (defvar mouse-sel-get-selection-function (lambda (selection) (if (eq selection 'PRIMARY) - (or (x-cut-buffer-or-selection-value) + (or (x-selection-value) (bound-and-true-p x-last-selected-text) (bound-and-true-p x-last-selected-text-primary)) (x-get-selection selection)))
--- a/lisp/mouse.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/mouse.el Wed Sep 08 13:08:19 2010 +0900 @@ -43,7 +43,10 @@ :group 'mouse) (defcustom mouse-drag-copy-region nil - "If non-nil, mouse drag copies region to kill-ring." + "If non-nil, copy to kill-ring upon mouse adjustments of the region. + +This affects `mouse-save-then-kill' (\\[mouse-save-then-kill]) in +addition to mouse drags." :type 'boolean :version "24.1" :group 'mouse) @@ -1348,8 +1351,13 @@ have selected whole words or lines, move point or mark to the word or line boundary closest to CLICK instead. +If `mouse-drag-copy-region' is non-nil, this command also saves the +new region to the kill ring (replacing the previous kill if the +previous region was just saved to the kill ring). + If this command is called a second consecutive time with the same -CLICK position, kill the region." +CLICK position, kill the region (or delete it +if `mouse-drag-copy-region' is non-nil)" (interactive "e") (mouse-minibuffer-check click) (let* ((posn (event-start click)) @@ -1371,7 +1379,11 @@ ((and (eq last-command 'mouse-save-then-kill) (eq click-pt mouse-save-then-kill-posn) (eq window (selected-window))) - (kill-region (mark t) (point)) + (if mouse-drag-copy-region + ;; Region already saved in the previous click; + ;; don't make a duplicate entry, just delete. + (delete-region (mark t) (point)) + (kill-region (mark t) (point))) (setq mouse-selection-click-count 0) (setq mouse-save-then-kill-posn nil)) @@ -1394,6 +1406,9 @@ (goto-char (nth 1 range))) (setq deactivate-mark nil) (mouse-set-region-1) + (when mouse-drag-copy-region + ;; Region already copied to kill-ring once, so replace. + (kill-new (filter-buffer-substring (mark t) (point)) t)) ;; Arrange for a repeated mouse-3 to kill the region. (setq mouse-save-then-kill-posn click-pt))) @@ -1405,6 +1420,8 @@ (if before-scroll (goto-char before-scroll))) (exchange-point-and-mark) (mouse-set-region-1) + (when mouse-drag-copy-region + (kill-new (filter-buffer-substring (mark t) (point)))) (setq mouse-save-then-kill-posn click-pt)))))
--- a/lisp/net/imap.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/net/imap.el Wed Sep 08 13:08:19 2010 +0900 @@ -448,18 +448,6 @@ The function should take two arguments, the first the IMAP tag and the second the status (OK, NO, BAD etc) of the command.") -(defvar imap-enable-exchange-bug-workaround nil - "Send FETCH UID commands as *:* instead of *. - -When non-nil, use an alternative UIDS form. Enabling appears to -be required for some servers (e.g., Microsoft Exchange 2007) -which otherwise would trigger a response 'BAD The specified -message set is invalid.'. We don't unconditionally use this -form, since this is said to be significantly inefficient. - -This variable is set to t automatically per server if the -canonical form fails.") - ;; Utility functions: @@ -515,6 +503,16 @@ ;; Server functions; stream stuff: +(defun imap-log (string-or-buffer) + (when imap-log + (with-current-buffer (get-buffer-create imap-log-buffer) + (imap-disable-multibyte) + (buffer-disable-undo) + (goto-char (point-max)) + (if (bufferp string-or-buffer) + (insert-buffer-substring string-or-buffer) + (insert string-or-buffer))))) + (defun imap-kerberos4-stream-p (buffer) (imap-capability 'AUTH=KERBEROS_V4 buffer)) @@ -569,12 +567,6 @@ (setq response (match-string 1))))) (accept-process-output process 1) (sit-for 1)) - (and imap-log - (with-current-buffer (get-buffer-create imap-log-buffer) - (imap-disable-multibyte) - (buffer-disable-undo) - (goto-char (point-max)) - (insert-buffer-substring buffer))) (erase-buffer) (message "Opening Kerberos 4 IMAP connection with `%s'...%s" cmd (if response (concat "done, " response) "failed")) @@ -645,12 +637,7 @@ (setq response (match-string 1))))) (accept-process-output process 1) (sit-for 1)) - (and imap-log - (with-current-buffer (get-buffer-create imap-log-buffer) - (imap-disable-multibyte) - (buffer-disable-undo) - (goto-char (point-max)) - (insert-buffer-substring buffer))) + (imap-log buffer) (erase-buffer) (message "GSSAPI IMAP connection: %s" (or response "failed")) (if (and response (let ((case-fold-search nil)) @@ -701,12 +688,7 @@ (not (imap-parse-greeting))) (accept-process-output process 1) (sit-for 1)) - (and imap-log - (with-current-buffer (get-buffer-create imap-log-buffer) - (imap-disable-multibyte) - (buffer-disable-undo) - (goto-char (point-max)) - (insert-buffer-substring buffer))) + (imap-log buffer) (erase-buffer) (when (memq (process-status process) '(open run)) (setq done process)))))) @@ -740,12 +722,7 @@ (not (imap-parse-greeting))) (accept-process-output process 1) (sit-for 1)) - (and imap-log - (with-current-buffer (get-buffer-create imap-log-buffer) - (imap-disable-multibyte) - (buffer-disable-undo) - (goto-char (point-max)) - (insert-buffer-substring buffer))) + (imap-log buffer) (when (memq (process-status process) '(open run)) process)))) @@ -764,12 +741,7 @@ (not (imap-parse-greeting))) (accept-process-output process 1) (sit-for 1)) - (and imap-log - (with-current-buffer (get-buffer-create imap-log-buffer) - (imap-disable-multibyte) - (buffer-disable-undo) - (goto-char (point-max)) - (insert-buffer-substring buffer))) + (imap-log buffer) (when (memq (process-status process) '(open run)) process)))) @@ -803,12 +775,7 @@ (not (imap-parse-greeting))) (accept-process-output process 1) (sit-for 1)) - (and imap-log - (with-current-buffer (get-buffer-create imap-log-buffer) - (imap-disable-multibyte) - (buffer-disable-undo) - (goto-char (point-max)) - (insert-buffer-substring buffer))) + (imap-log buffer) (erase-buffer) (when (memq (process-status process) '(open run)) (setq done process))))) @@ -845,11 +812,7 @@ (not (re-search-forward "[0-9]+ OK.*\r?\n" nil t))) (accept-process-output process 1) (sit-for 1)) - (and imap-log - (with-current-buffer (get-buffer-create imap-log-buffer) - (buffer-disable-undo) - (goto-char (point-max)) - (insert-buffer-substring buffer))) + (imap-log buffer) (when (and (setq tls-info (starttls-negotiate process)) (memq (process-status process) '(open run))) (setq done process))) @@ -1340,40 +1303,38 @@ ;; Mailbox functions: -(defun imap-mailbox-put (propname value &optional mailbox buffer) - (with-current-buffer (or buffer (current-buffer)) - (if imap-mailbox-data - (put (intern (or mailbox imap-current-mailbox) imap-mailbox-data) - propname value) - (error "Imap-mailbox-data is nil, prop %s value %s mailbox %s buffer %s" - propname value mailbox (current-buffer))) - t)) +(defun imap-mailbox-put (propname value &optional mailbox) + (if imap-mailbox-data + (put (intern (or mailbox imap-current-mailbox) imap-mailbox-data) + propname value) + (error "Imap-mailbox-data is nil, prop %s value %s mailbox %s buffer %s" + propname value mailbox (current-buffer))) + t) (defsubst imap-mailbox-get-1 (propname &optional mailbox) (get (intern-soft (or mailbox imap-current-mailbox) imap-mailbox-data) propname)) (defun imap-mailbox-get (propname &optional mailbox buffer) - (let ((mailbox (imap-utf7-encode mailbox))) - (with-current-buffer (or buffer (current-buffer)) - (imap-mailbox-get-1 propname (or mailbox imap-current-mailbox))))) + (with-current-buffer (or buffer (current-buffer)) + (imap-mailbox-get-1 propname (or (imap-utf7-encode mailbox) + imap-current-mailbox)))) -(defun imap-mailbox-map-1 (func &optional mailbox-decoder buffer) - (with-current-buffer (or buffer (current-buffer)) - (let (result) - (mapatoms - (lambda (s) - (push (funcall func (if mailbox-decoder - (funcall mailbox-decoder (symbol-name s)) - (symbol-name s))) result)) - imap-mailbox-data) - result))) +(defun imap-mailbox-map-1 (func &optional mailbox-decoder) + (let (result) + (mapatoms + (lambda (s) + (push (funcall func (if mailbox-decoder + (funcall mailbox-decoder (symbol-name s)) + (symbol-name s))) result)) + imap-mailbox-data) + result)) -(defun imap-mailbox-map (func &optional buffer) +(defun imap-mailbox-map (func) "Map a function across each mailbox in `imap-mailbox-data', returning a list. Function should take a mailbox name (a string) as the only argument." - (imap-mailbox-map-1 func 'imap-utf7-decode buffer)) + (imap-mailbox-map-1 func 'imap-utf7-decode)) (defun imap-current-mailbox (&optional buffer) (with-current-buffer (or buffer (current-buffer)) @@ -1687,29 +1648,26 @@ uids) (imap-message-get uids receive)))))) -(defun imap-message-put (uid propname value &optional buffer) - (with-current-buffer (or buffer (current-buffer)) - (if imap-message-data - (put (intern (number-to-string uid) imap-message-data) - propname value) - (error "Imap-message-data is nil, uid %s prop %s value %s buffer %s" - uid propname value (current-buffer))) - t)) +(defun imap-message-put (uid propname value) + (if imap-message-data + (put (intern (number-to-string uid) imap-message-data) + propname value) + (error "Imap-message-data is nil, uid %s prop %s value %s buffer %s" + uid propname value (current-buffer))) + t) -(defun imap-message-get (uid propname &optional buffer) - (with-current-buffer (or buffer (current-buffer)) - (get (intern-soft (number-to-string uid) imap-message-data) - propname))) +(defun imap-message-get (uid propname) + (get (intern-soft (number-to-string uid) imap-message-data) + propname)) -(defun imap-message-map (func propname &optional buffer) +(defun imap-message-map (func propname) "Map a function across each message in `imap-message-data', returning a list." - (with-current-buffer (or buffer (current-buffer)) - (let (result) - (mapatoms - (lambda (s) - (push (funcall func (get s 'UID) (get s propname)) result)) - imap-message-data) - result))) + (let (result) + (mapatoms + (lambda (s) + (push (funcall func (get s 'UID) (get s propname)) result)) + imap-message-data) + result)) (defmacro imap-message-envelope-date (uid &optional buffer) `(with-current-buffer (or ,buffer (current-buffer)) @@ -1805,48 +1763,6 @@ (format "String %s cannot be converted to a Lisp integer" number)) number))) -(defun imap-fetch-safe (uids props &optional receive nouidfetch buffer) - "Like `imap-fetch', but DTRT with Exchange 2007 bug. -However, UIDS here is a cons, where the car is the canonical form -of the UIDS specification, and the cdr is the one which works with -Exchange 2007 or, potentially, other buggy servers. -See `imap-enable-exchange-bug-workaround'." - ;; The first time we get here for a given, we'll try the canonical - ;; form. If we get the known error from the buggy server, set the - ;; flag buffer-locally (to account for connections to multiple - ;; servers), then re-try with the alternative UIDS spec. We don't - ;; unconditionally use the alternative form, since the - ;; currently-used alternatives are seriously inefficient with some - ;; servers (although they are valid). - ;; - ;; FIXME: Maybe it would be cleaner to have a flag to not signal - ;; the error (which otherwise gives a message), and test - ;; `imap-failed-tags'. Also, Other IMAP clients use other forms of - ;; request which work with Exchange, e.g. Claws does "UID FETCH 1:* - ;; (UID)" rather than "FETCH UID 1,*". Is there a good reason not - ;; to do the same? - (condition-case data - ;; Binding `debug-on-error' allows us to get the error from - ;; `imap-parse-response' -- it's normally caught by Emacs around - ;; execution of a process filter. - (let ((debug-on-error t)) - (imap-fetch (if imap-enable-exchange-bug-workaround - (cdr uids) - (car uids)) - props receive nouidfetch buffer)) - (error - (if (and (not imap-enable-exchange-bug-workaround) - ;; This is the Exchange 2007 response. It may be more - ;; robust just to check for a BAD response to the - ;; attempted fetch. - (string-match "The specified message set is invalid" - (cadr data))) - (with-current-buffer (or buffer (current-buffer)) - (set (make-local-variable 'imap-enable-exchange-bug-workaround) - t) - (imap-fetch (cdr uids) props receive nouidfetch)) - (signal (car data) (cdr data)))))) - (defun imap-message-copyuid-1 (mailbox) (if (imap-capability 'UIDPLUS) (list (nth 0 (imap-mailbox-get-1 'copyuid mailbox)) @@ -1856,7 +1772,7 @@ (imap-message-data (make-vector 2 0))) (when (imap-mailbox-examine-1 mailbox) (prog1 - (and (imap-fetch-safe '("*" . "*:*") "UID") + (and (imap-fetch "*:*" "UID") (list (imap-mailbox-get-1 'uidvalidity mailbox) (apply 'max (imap-message-map (lambda (uid prop) uid) 'UID)))) @@ -1902,7 +1818,7 @@ (imap-message-data (make-vector 2 0))) (when (imap-mailbox-examine-1 mailbox) (prog1 - (and (imap-fetch-safe '("*" . "*:*") "UID") + (and (imap-fetch "*:*" "UID") (list (imap-mailbox-get-1 'uidvalidity mailbox) (apply 'max (imap-message-map (lambda (uid prop) uid) 'UID)))) @@ -1959,12 +1875,7 @@ (defun imap-send-command-1 (cmdstr) (setq cmdstr (concat cmdstr imap-client-eol)) - (and imap-log - (with-current-buffer (get-buffer-create imap-log-buffer) - (imap-disable-multibyte) - (buffer-disable-undo) - (goto-char (point-max)) - (insert cmdstr))) + (imap-log cmdstr) (process-send-string imap-process cmdstr)) (defun imap-send-command (command &optional buffer) @@ -2002,13 +1913,7 @@ (stream imap-stream) (eol imap-client-eol)) (with-current-buffer cmd - (and imap-log - (with-current-buffer (get-buffer-create - imap-log-buffer) - (imap-disable-multibyte) - (buffer-disable-undo) - (goto-char (point-max)) - (insert-buffer-substring cmd))) + (imap-log cmd) (process-send-region process (point-min) (point-max))) (process-send-string process imap-client-eol)))) @@ -2084,12 +1989,7 @@ (with-current-buffer (process-buffer proc) (goto-char (point-max)) (insert string) - (and imap-log - (with-current-buffer (get-buffer-create imap-log-buffer) - (imap-disable-multibyte) - (buffer-disable-undo) - (goto-char (point-max)) - (insert string))) + (imap-log string) (let (end) (goto-char (point-min)) (while (setq end (imap-find-next-line)) @@ -2992,105 +2892,6 @@ (imap-forward) (nreverse body))))) -(when imap-debug ; (untrace-all) - (require 'trace) - (buffer-disable-undo (get-buffer-create imap-debug-buffer)) - (mapc (lambda (f) (trace-function-background f imap-debug-buffer)) - '( - imap-utf7-encode - imap-utf7-decode - imap-error-text - imap-kerberos4s-p - imap-kerberos4-open - imap-ssl-p - imap-ssl-open - imap-network-p - imap-network-open - imap-interactive-login - imap-kerberos4a-p - imap-kerberos4-auth - imap-cram-md5-p - imap-cram-md5-auth - imap-login-p - imap-login-auth - imap-anonymous-p - imap-anonymous-auth - imap-open-1 - imap-open - imap-opened - imap-ping-server - imap-authenticate - imap-close - imap-capability - imap-namespace - imap-send-command-wait - imap-mailbox-put - imap-mailbox-get - imap-mailbox-map-1 - imap-mailbox-map - imap-current-mailbox - imap-current-mailbox-p-1 - imap-current-mailbox-p - imap-mailbox-select-1 - imap-mailbox-select - imap-mailbox-examine-1 - imap-mailbox-examine - imap-mailbox-unselect - imap-mailbox-expunge - imap-mailbox-close - imap-mailbox-create-1 - imap-mailbox-create - imap-mailbox-delete - imap-mailbox-rename - imap-mailbox-lsub - imap-mailbox-list - imap-mailbox-subscribe - imap-mailbox-unsubscribe - imap-mailbox-status - imap-mailbox-acl-get - imap-mailbox-acl-set - imap-mailbox-acl-delete - imap-current-message - imap-list-to-message-set - imap-fetch-asynch - imap-fetch - imap-fetch-safe - imap-message-put - imap-message-get - imap-message-map - imap-search - imap-message-flag-permanent-p - imap-message-flags-set - imap-message-flags-del - imap-message-flags-add - imap-message-copyuid-1 - imap-message-copyuid - imap-message-copy - imap-message-appenduid-1 - imap-message-appenduid - imap-message-append - imap-body-lines - imap-envelope-from - imap-send-command-1 - imap-send-command - imap-wait-for-tag - imap-sentinel - imap-find-next-line - imap-arrival-filter - imap-parse-greeting - imap-parse-response - imap-parse-resp-text - imap-parse-resp-text-code - imap-parse-data-list - imap-parse-fetch - imap-parse-status - imap-parse-acl - imap-parse-flag-list - imap-parse-envelope - imap-parse-body-extension - imap-parse-body - ))) - (provide 'imap) ;;; imap.el ends here
--- a/lisp/proced.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/proced.el Wed Sep 08 13:08:19 2010 +0900 @@ -2,7 +2,7 @@ ;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc. -;; Author: Roland Winkler <Roland.Winkler@physik.uni-erlangen.de> +;; Author: Roland Winkler <winkler@gnu.org> ;; Keywords: Processes, Unix ;; This file is part of GNU Emacs.
--- a/lisp/progmodes/compile.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/progmodes/compile.el Wed Sep 08 13:08:19 2010 +0900 @@ -227,10 +227,6 @@ "^[-[:alnum:]_/ ]+: \\(?:\\(?:[sS]evere\\|[eE]rror\\|[wW]arnin\\(g\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*: \\)?\ \\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 3 4 nil (1 . 2)) - (ruby - "^[\t ]*\\(?:from \\)?\ -\\([^\(\n][^[:space:]\n]*\\):\\([1-9][0-9]*\\)\\(:in `.*'\\)?.*$" 1 2) - (java "^\\(?:[ \t]+at \\|==[0-9]+== +\\(?:at\\|b\\(y\\)\\)\\).+(\\([^()\n]+\\):\\([0-9]+\\))$" 2 3 nil (1)) @@ -241,6 +237,10 @@ nil 1 nil 2 0 (2 (compilation-face '(3)))) + (gcc-include + "^\\(?:In file included \\| \\|\t\\)from \ +\\(.+\\):\\([0-9]+\\)\\(?:\\(:\\)\\|\\(,\\|$\\)\\)?" 1 2 nil (3 . 4)) + (gnu ;; The first line matches the program name for @@ -264,7 +264,7 @@ ;; can be composed of any non-newline char, but it also rules out some ;; valid but unlikely cases, such as a trailing space or a space ;; followed by a -. - "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\)?\ + "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\|[ \t]+\\(?:in \\|from \\)\\)?\ \\([0-9]*[^0-9\n]\\(?:[^\n ]\\| [^-/\n]\\)*?\\): ?\ \\([0-9]+\\)\\(?:\\([.:]\\)\\([0-9]+\\)\\)?\ \\(?:-\\([0-9]+\\)?\\(?:\\.\\([0-9]+\\)\\)?\\)?:\ @@ -273,12 +273,6 @@ \[0-9]?\\(?:[^0-9\n]\\|$\\)\\|[0-9][0-9][0-9]\\)" 1 (2 . 5) (4 . 6) (7 . 8)) - ;; The `gnu' style above can incorrectly match gcc's "In file - ;; included from" message, so we process that first. -- cyd - (gcc-include - "^\\(?:In file included\\| \\) from \ -\\(.+\\):\\([0-9]+\\)\\(?:\\(:\\)\\|\\(,\\)\\)?" 1 2 nil (3 . 4)) - (lcc "^\\(?:E\\|\\(W\\)\\), \\([^(\n]+\\)(\\([0-9]+\\),[ \t]*\\([0-9]+\\)" 2 3 4 (1))
--- a/lisp/progmodes/octave-mod.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/progmodes/octave-mod.el Wed Sep 08 13:08:19 2010 +0900 @@ -193,10 +193,19 @@ ((eq (nth 3 state) ?\') ;; A '..' string. (save-excursion - (when (and (or (looking-at "\\('\\)") - (re-search-forward "[^\\]\\(?:\\\\\\\\\\)*\\('\\)" - nil t)) - (not (eobp))) + (when (re-search-forward "\\(?:\\=\\|[^']\\)\\(?:''\\)*\\('\\)[^']" + nil t) + (goto-char (1- (point))) + ;; Remove any syntax-table property we may have applied to + ;; some of the (doubled) single quotes within the string. + ;; Since these are the only chars on which we place properties, + ;; we take a shortcut and just remove all properties. + (remove-text-properties (1+ (nth 8 state)) (match-beginning 1) + '(syntax-table nil)) + (when (eq (char-before (match-beginning 1)) ?\\) + ;; Backslash cannot escape a single quote. + (put-text-property (1- (match-beginning 1)) (match-beginning 1) + 'syntax-table (string-to-syntax "."))) (put-text-property (match-beginning 1) (match-end 1) 'syntax-table (string-to-syntax "\"'")))))) @@ -342,29 +351,6 @@ :type 'integer :group 'octave) -(defvar octave-block-else-regexp - (concat "\\<\\(" - (mapconcat 'identity octave-else-keywords "\\|") - "\\)\\>")) -(defvar octave-block-end-regexp - (concat "\\<\\(" - (mapconcat 'identity octave-end-keywords "\\|") - "\\)\\>")) -(defvar octave-block-else-or-end-regexp - (concat octave-block-else-regexp "\\|" octave-block-end-regexp)) -(defvar octave-block-match-alist - '(("do" . ("until")) - ("for" . ("end" "endfor")) - ("function" . ("end" "endfunction")) - ("if" . ("else" "elseif" "end" "endif")) - ("switch" . ("case" "otherwise" "end" "endswitch")) - ("try" . ("catch" "end" "end_try_catch")) - ("unwind_protect" . ("unwind_protect_cleanup" "end" "end_unwind_protect")) - ("while" . ("end" "endwhile"))) - "Alist with Octave's matching block keywords. -Has Octave's begin keywords as keys and a list of the matching else or -end keywords as associated values.") - (defvar octave-block-comment-start (concat (make-string 2 octave-comment-char) " ") "String to insert to start a new Octave comment on an empty line.") @@ -435,43 +421,49 @@ ;; could be convenient to treat it as one. (assoc "..."))) +(defconst octave-smie-bnf-table + '((atom) + ;; We can't distinguish the first element in a sequence with + ;; precedence grammars, so we can't distinguish the condition + ;; if the `if' from the subsequent body, for example. + ;; This has to be done later in the indentation rules. + (exp (exp "\n" exp) + ;; We need to mention at least one of the operators in this part + ;; of the grammar: if the BNF and the operator table have + ;; no overlap, SMIE can't know how they relate. + (exp ";" exp) + ("try" exp "catch" exp "end_try_catch") + ("try" exp "catch" exp "end") + ("unwind_protect" exp + "unwind_protect_cleanup" exp "end_unwind_protect") + ("unwind_protect" exp "unwind_protect_cleanup" exp "end") + ("for" exp "endfor") + ("for" exp "end") + ("do" exp "until" atom) + ("while" exp "endwhile") + ("while" exp "end") + ("if" exp "endif") + ("if" exp "else" exp "endif") + ("if" exp "elseif" exp "else" exp "endif") + ("if" exp "elseif" exp "elseif" exp "else" exp "endif") + ("if" exp "elseif" exp "elseif" exp "else" exp "end") + ("switch" exp "case" exp "endswitch") + ("switch" exp "case" exp "otherwise" exp "endswitch") + ("switch" exp "case" exp "case" exp "otherwise" exp "endswitch") + ("switch" exp "case" exp "case" exp "otherwise" exp "end") + ("function" exp "endfunction") + ("function" exp "end")) + ;; (fundesc (atom "=" atom)) + )) + +(defconst octave-smie-closer-alist + (smie-bnf-closer-alist octave-smie-bnf-table)) + (defconst octave-smie-op-levels (smie-prec2-levels (smie-merge-prec2s (smie-bnf-precedence-table - '((atom) - ;; We can't distinguish the first element in a sequence with - ;; precedence grammars, so we can't distinguish the condition - ;; if the `if' from the subsequent body, for example. - ;; This has to be done later in the indentation rules. - (exp (exp "\n" exp) - ;; We need to mention at least one of the operators in this part - ;; of the grammar: if the BNF and the operator table have - ;; no overlap, SMIE can't know how they relate. - (exp ";" exp) - ("try" exp "catch" exp "end_try_catch") - ("try" exp "catch" exp "end") - ("unwind_protect" exp - "unwind_protect_cleanup" exp "end_unwind_protect") - ("unwind_protect" exp "unwind_protect_cleanup" exp "end") - ("for" exp "endfor") - ("for" exp "end") - ("do" exp "until" atom) - ("while" exp "endwhile") - ("while" exp "end") - ("if" exp "endif") - ("if" exp "else" exp "endif") - ("if" exp "elseif" exp "else" exp "endif") - ("if" exp "elseif" exp "elseif" exp "else" exp "endif") - ("if" exp "elseif" exp "elseif" exp "else" exp "end") - ("switch" exp "case" exp "endswitch") - ("switch" exp "case" exp "otherwise" exp "endswitch") - ("switch" exp "case" exp "case" exp "otherwise" exp "endswitch") - ("switch" exp "case" exp "case" exp "otherwise" exp "end") - ("function" exp "endfunction") - ("function" exp "end")) - ;; (fundesc (atom "=" atom)) - ) + octave-smie-bnf-table '((assoc "\n" ";"))) (smie-precs-precedence-table @@ -646,9 +638,28 @@ 'octave-smie-forward-token) (set (make-local-variable 'forward-sexp-function) 'smie-forward-sexp-command) - (set (make-local-variable 'smie-closer-alist) - (mapcar (lambda (elem) (cons (car elem) (car (last elem)))) - octave-block-match-alist)) + (set (make-local-variable 'smie-closer-alist) octave-smie-closer-alist) + ;; Only needed for interactive calls to blink-matching-open. + (set (make-local-variable 'blink-matching-check-function) + #'smie-blink-matching-check) + + (when octave-blink-matching-block + (add-hook 'post-self-insert-hook #'smie-blink-matching-open 'append 'local) + (set (make-local-variable 'smie-blink-matching-triggers) + (append smie-blink-matching-triggers '(\;) + ;; Rather than wait for SPC or ; to blink, try to blink as + ;; soon as we type the last char of a block ender. + ;; But strip ?d from this list so that we don't blink twice + ;; when the user writes "endif" (once at "end" and another + ;; time at "endif"). + (delq ?d (delete-dups + (mapcar (lambda (kw) + (aref (cdr kw) (1- (length (cdr kw))))) + smie-closer-alist)))))) + + ;; FIXME: maybe we should use (cons ?\; electric-indent-chars) + ;; since only ; is really octave-specific. + (set (make-local-variable 'electric-indent-chars) '(?\; ?\s ?\n)) (set (make-local-variable 'comment-start) octave-comment-start) (set (make-local-variable 'comment-end) "") @@ -846,54 +857,6 @@ (backward-up-list 1)) (mark-sexp)) -(defun octave-blink-matching-block-open () - "Blink the matching Octave begin block keyword. -If point is right after an Octave else or end type block keyword, move -cursor momentarily to the corresponding begin keyword. -Signal an error if the keywords are incompatible." - (interactive) - (let (bb-keyword bb-arg eb-keyword pos eol) - (if (and (octave-not-in-string-or-comment-p) - (looking-at "\\>") - (save-excursion - (skip-syntax-backward "w") - (octave-looking-at-kw octave-block-else-or-end-regexp))) - (save-excursion - (cond - ((match-end 1) - (setq eb-keyword - (buffer-substring-no-properties - (match-beginning 1) (match-end 1))) - (backward-up-list 1)) - ((match-end 2) - (setq eb-keyword - (buffer-substring-no-properties - (match-beginning 2) (match-end 2))) - (backward-sexp 1))) - (setq pos (match-end 0) - bb-keyword - (buffer-substring-no-properties - (match-beginning 0) pos) - pos (+ pos 1) - eol (line-end-position) - bb-arg - (save-excursion - (save-restriction - (goto-char pos) - (while (and (skip-syntax-forward "^<" eol) - (octave-in-string-p) - (not (forward-char 1)))) - (skip-syntax-backward " ") - (buffer-substring-no-properties pos (point))))) - (if (member eb-keyword - (cdr (assoc bb-keyword octave-block-match-alist))) - (progn - (message "Matches `%s %s'" bb-keyword bb-arg) - (if (pos-visible-in-window-p) - (sit-for blink-matching-delay))) - (error "Block keywords `%s' and `%s' do not match" - bb-keyword eb-keyword)))))) - (defun octave-beginning-of-defun (&optional arg) "Move backward to the beginning of an Octave function. With positive ARG, do it that many times. Negative argument -N means @@ -1082,9 +1045,6 @@ If Abbrev mode is on, expand abbrevs first." ;; FIXME: None of this is Octave-specific. (interactive) - (if abbrev-mode (expand-abbrev)) - (if octave-blink-matching-block - (octave-blink-matching-block-open)) (reindent-then-newline-and-indent)) (defun octave-electric-semi () @@ -1093,14 +1053,12 @@ Reindent the line if `octave-auto-indent' is non-nil. Insert a newline if `octave-auto-newline' is non-nil." (interactive) + (setq last-command-event ?\;) (if (not (octave-not-in-string-or-comment-p)) - (insert ";") - (if abbrev-mode (expand-abbrev)) - (if octave-blink-matching-block - (octave-blink-matching-block-open)) + (self-insert-command 1) (if octave-auto-indent (indent-according-to-mode)) - (insert ";") + (self-insert-command 1) (if octave-auto-newline (newline-and-indent)))) @@ -1115,9 +1073,6 @@ (progn (indent-according-to-mode) (self-insert-command 1)) - (if abbrev-mode (expand-abbrev)) - (if octave-blink-matching-block - (octave-blink-matching-block-open)) (if (and octave-auto-indent (save-excursion (skip-syntax-backward " ")
--- a/lisp/select.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/select.el Wed Sep 08 13:08:19 2010 +0900 @@ -174,36 +174,6 @@ (symbolp data) (integerp data))) -;;; Cut Buffer support - -(declare-function x-get-cut-buffer-internal "xselect.c") - -(defun x-get-cut-buffer (&optional which-one) - "Return the value of one of the 8 X server cut-buffers. -Optional arg WHICH-ONE should be a number from 0 to 7, defaulting to 0. -Cut buffers are considered obsolete; you should use selections instead." - (x-get-cut-buffer-internal - (if which-one - (aref [CUT_BUFFER0 CUT_BUFFER1 CUT_BUFFER2 CUT_BUFFER3 - CUT_BUFFER4 CUT_BUFFER5 CUT_BUFFER6 CUT_BUFFER7] - which-one) - 'CUT_BUFFER0))) - -(declare-function x-rotate-cut-buffers-internal "xselect.c") -(declare-function x-store-cut-buffer-internal "xselect.c") - -(defun x-set-cut-buffer (string &optional push) - "Store STRING into the X server's primary cut buffer. -If PUSH is non-nil, also rotate the cut buffers: -this means the previous value of the primary cut buffer moves to the second -cut buffer, and the second to the third, and so on (there are 8 buffers.) -Cut buffers are considered obsolete; you should use selections instead." - (or (stringp string) (signal 'wrong-type-argument (list 'stringp string))) - (if push - (x-rotate-cut-buffers-internal 1)) - (x-store-cut-buffer-internal 'CUT_BUFFER0 string)) - - ;; Functions to convert the selection into various other selection types. ;; Every selection type that Emacs handles is implemented this way, except ;; for TIMESTAMP, which is a special case.
--- a/lisp/simple.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/simple.el Wed Sep 08 13:08:19 2010 +0900 @@ -457,72 +457,43 @@ than the value of `fill-column' and ARG is nil." (interactive "*P") (barf-if-buffer-read-only) - ;; Inserting a newline at the end of a line produces better redisplay in - ;; try_window_id than inserting at the beginning of a line, and the textual - ;; result is the same. So, if we're at beginning of line, pretend to be at - ;; the end of the previous line. - (let ((flag (and (not (bobp)) - (bolp) - ;; Make sure no functions want to be told about - ;; the range of the changes. - (not after-change-functions) - (not before-change-functions) - ;; Make sure there are no markers here. - (not (buffer-has-markers-at (1- (point)))) - (not (buffer-has-markers-at (point))) - ;; Make sure no text properties want to know - ;; where the change was. - (not (get-char-property (1- (point)) 'modification-hooks)) - (not (get-char-property (1- (point)) 'insert-behind-hooks)) - (or (eobp) - (not (get-char-property (point) 'insert-in-front-hooks))) - ;; Make sure the newline before point isn't intangible. - (not (get-char-property (1- (point)) 'intangible)) - ;; Make sure the newline before point isn't read-only. - (not (get-char-property (1- (point)) 'read-only)) - ;; Make sure the newline before point isn't invisible. - (not (get-char-property (1- (point)) 'invisible)) - ;; Make sure the newline before point has the same - ;; properties as the char before it (if any). - (< (or (previous-property-change (point)) -2) - (- (point) 2)))) - (was-page-start (and (bolp) - (looking-at page-delimiter))) - (beforepos (point))) - (if flag (backward-char 1)) - ;; Call self-insert so that auto-fill, abbrev expansion etc. happens. - ;; Set last-command-event to tell self-insert what to insert. - (let ((last-command-event ?\n) - ;; Don't auto-fill if we have a numeric argument. - ;; Also not if flag is true (it would fill wrong line); - ;; there is no need to since we're at BOL. - (auto-fill-function (if (or arg flag) nil auto-fill-function))) - (unwind-protect - (self-insert-command (prefix-numeric-value arg)) - ;; If we get an error in self-insert-command, put point at right place. - (if flag (forward-char 1)))) - ;; Even if we did *not* get an error, keep that forward-char; - ;; all further processing should apply to the newline that the user - ;; thinks he inserted. - - ;; Mark the newline(s) `hard'. - (if use-hard-newlines - (set-hard-newline-properties - (- (point) (prefix-numeric-value arg)) (point))) - ;; If the newline leaves the previous line blank, - ;; and we have a left margin, delete that from the blank line. - (or flag - (save-excursion - (goto-char beforepos) - (beginning-of-line) - (and (looking-at "[ \t]$") - (> (current-left-margin) 0) - (delete-region (point) (progn (end-of-line) (point)))))) - ;; Indent the line after the newline, except in one case: - ;; when we added the newline at the beginning of a line - ;; which starts a page. - (or was-page-start - (move-to-left-margin nil t))) + ;; Call self-insert so that auto-fill, abbrev expansion etc. happens. + ;; Set last-command-event to tell self-insert what to insert. + (let* ((was-page-start (and (bolp) (looking-at page-delimiter))) + (beforepos (point)) + (last-command-event ?\n) + ;; Don't auto-fill if we have a numeric argument. + (auto-fill-function (if arg nil auto-fill-function)) + (postproc + ;; Do the rest in post-self-insert-hook, because we want to do it + ;; *before* other functions on that hook. + (lambda () + ;; Mark the newline(s) `hard'. + (if use-hard-newlines + (set-hard-newline-properties + (- (point) (prefix-numeric-value arg)) (point))) + ;; If the newline leaves the previous line blank, and we + ;; have a left margin, delete that from the blank line. + (save-excursion + (goto-char beforepos) + (beginning-of-line) + (and (looking-at "[ \t]$") + (> (current-left-margin) 0) + (delete-region (point) + (line-end-position)))) + ;; Indent the line after the newline, except in one case: + ;; when we added the newline at the beginning of a line which + ;; starts a page. + (or was-page-start + (move-to-left-margin nil t))))) + (unwind-protect + (progn + (add-hook 'post-self-insert-hook postproc) + (self-insert-command (prefix-numeric-value arg))) + ;; We first used let-binding to protect the hook, but that was naive + ;; since add-hook affects the symbol-default value of the variable, + ;; whereas the let-binding might only protect the buffer-local value. + (remove-hook 'post-self-insert-hook postproc))) nil) (defun set-hard-newline-properties (from to) @@ -2929,11 +2900,8 @@ is put in the kill ring, to make the new kill available to other programs. -The function takes one or two arguments. -The first argument, TEXT, is a string containing -the text which should be made available. -The second, optional, argument PUSH, has the same meaning as the -similar argument to `x-set-cut-buffer', which see.") +The function takes one argument, TEXT, which is a string containing +the text which should be made available.") (defvar interprogram-paste-function nil "Function to call to get text cut from other programs. @@ -3050,7 +3018,7 @@ (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)))) (setq kill-ring-yank-pointer kill-ring) (if interprogram-cut-function - (funcall interprogram-cut-function string (not replace)))) + (funcall interprogram-cut-function string))) (defun kill-append (string before-p &optional yank-handler) "Append STRING to the end of the latest kill in the kill ring. @@ -5506,21 +5474,40 @@ :type 'boolean :group 'paren-blinking) +(defun blink-matching-check-mismatch (start end) + "Return whether or not START...END are matching parens. +END is the current point and START is the blink position. +START might be nil if no matching starter was found. +Returns non-nil if we find there is a mismatch." + (let* ((end-syntax (syntax-after (1- end))) + (matching-paren (and (consp end-syntax) + (eq (syntax-class end-syntax) 5) + (cdr end-syntax)))) + ;; For self-matched chars like " and $, we can't know when they're + ;; mismatched or unmatched, so we can only do it for parens. + (when matching-paren + (not (and start + (or + (eq (char-after start) matching-paren) + ;; The cdr might hold a new paren-class info rather than + ;; a matching-char info, in which case the two CDRs + ;; should match. + (eq matching-paren (cdr-safe (syntax-after start))))))))) + +(defvar blink-matching-check-function #'blink-matching-check-mismatch + "Function to check parentheses mismatches. +The function takes two arguments (START and END) where START is the +position just before the opening token and END is the position right after. +START can be nil, if it was not found. +The function should return non-nil if the two tokens do not match.") + (defun blink-matching-open () "Move cursor momentarily to the beginning of the sexp before point." (interactive) - (when (and (> (point) (point-min)) - blink-matching-paren - ;; Verify an even number of quoting characters precede the close. - (= 1 (logand 1 (- (point) - (save-excursion - (forward-char -1) - (skip-syntax-backward "/\\") - (point)))))) + (when (and (not (bobp)) + blink-matching-paren) (let* ((oldpos (point)) - (message-log-max nil) ; Don't log messages about paren matching. - (atdollar (eq (syntax-class (syntax-after (1- oldpos))) 8)) - (isdollar) + (message-log-max nil) ; Don't log messages about paren matching. (blinkpos (save-excursion (save-restriction @@ -5535,38 +5522,25 @@ (condition-case () (progn (forward-sexp -1) + ;; backward-sexp skips backward over prefix chars, + ;; so move back to the matching paren. + (while (and (< (point) (1- oldpos)) + (let ((code (car (syntax-after (point))))) + (or (eq (logand 65536 code) 6) + (eq (logand 1048576 code) 1048576)))) + (forward-char 1)) (point)) (error nil)))))) - (matching-paren - (and blinkpos - ;; Not syntax '$'. - (not (setq isdollar - (eq (syntax-class (syntax-after blinkpos)) 8))) - (let ((syntax (syntax-after blinkpos))) - (and (consp syntax) - (eq (syntax-class syntax) 4) - (cdr syntax)))))) + (mismatch (funcall blink-matching-check-function blinkpos oldpos))) (cond - ;; isdollar is for: - ;; http://lists.gnu.org/archive/html/emacs-devel/2007-10/msg00871.html - ((not (or (and isdollar blinkpos) - (and atdollar (not blinkpos)) ; see below - (eq matching-paren (char-before oldpos)) - ;; The cdr might hold a new paren-class info rather than - ;; a matching-char info, in which case the two CDRs - ;; should match. - (eq matching-paren (cdr (syntax-after (1- oldpos)))))) - (if (minibufferp) - (minibuffer-message " [Mismatched parentheses]") - (message "Mismatched parentheses"))) - ((not blinkpos) - (or blink-matching-paren-distance - ;; Don't complain when `$' with no blinkpos, because it - ;; could just be the first one typed in the buffer. - atdollar + (mismatch + (if blinkpos (if (minibufferp) - (minibuffer-message " [Unmatched parenthesis]") - (message "Unmatched parenthesis")))) + (minibuffer-message " [Mismatched parentheses]") + (message "Mismatched parentheses")) + (if (minibufferp) + (minibuffer-message " [Unmatched parenthesis]") + (message "Unmatched parenthesis")))) ((pos-visible-in-window-p blinkpos) ;; Matching open within window, temporarily move to blinkpos but only ;; if `blink-matching-paren-on-screen' is non-nil. @@ -5618,7 +5592,13 @@ (memq (char-syntax last-command-event) '(?\) ?\$)) blink-paren-function (not executing-kbd-macro) - (not noninteractive)) + (not noninteractive) + ;; Verify an even number of quoting characters precede the close. + (= 1 (logand 1 (- (point) + (save-excursion + (forward-char -1) + (skip-syntax-backward "/\\") + (point)))))) (funcall blink-paren-function))) (add-hook 'post-self-insert-hook #'blink-paren-post-self-insert-function
--- a/lisp/term.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/term.el Wed Sep 08 13:08:19 2010 +0900 @@ -1231,8 +1231,7 @@ (if (featurep 'xemacs) (term-send-raw-string (or (condition-case () (x-get-selection) (error ())) - (x-get-cutbuffer) - (error "No selection or cut buffer available"))) + (error "No selection available"))) ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook) (setq this-command 'yank)
--- a/lisp/term/ns-win.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/term/ns-win.el Wed Sep 08 13:08:19 2010 +0900 @@ -293,7 +293,7 @@ (unless (terminal-parameter frame 'x-setup-function-keys) (with-selected-frame frame (setq interprogram-cut-function 'x-select-text - interprogram-paste-function 'x-cut-buffer-or-selection-value) + interprogram-paste-function 'x-selection-value) (let ((map (copy-keymap ns-alternatives-map))) (set-keymap-parent map (keymap-parent local-function-key-map)) (set-keymap-parent local-function-key-map map)) @@ -1015,23 +1015,21 @@ ;; We keep track of the last text selected here, so we can check the ;; current selection against it, and avoid passing back our own text -;; from x-cut-buffer-or-selection-value. +;; from x-selection-value. (defvar ns-last-selected-text nil) -(defun x-select-text (text &optional push) +(defun x-select-text (text) "Select TEXT, a string, according to the window system. -On X, put TEXT in the primary X selection. For backward -compatibility with older X applications, set the value of X cut -buffer 0 as well, and if the optional argument PUSH is non-nil, -rotate the cut buffers. If `x-select-enable-clipboard' is -non-nil, copy the text to the X clipboard as well. +On X, if `x-select-enable-clipboard' is non-nil, copy TEXT to the +clipboard. If `x-select-enable-primary' is non-nil, put TEXT in +the primary selection. On Windows, make TEXT the current selection. If `x-select-enable-clipboard' is non-nil, copy the text to the -clipboard as well. The argument PUSH is ignored. +clipboard as well. -On Nextstep, put TEXT in the pasteboard; PUSH is ignored." +On Nextstep, put TEXT in the pasteboard." ;; Don't send the pasteboard too much text. ;; It becomes slow, and if really big it causes errors. (ns-set-pasteboard text) @@ -1040,11 +1038,10 @@ ;; Return the value of the current Nextstep selection. For ;; compatibility with older Nextstep applications, this checks cut ;; buffer 0 before retrieving the value of the primary selection. -(defun x-cut-buffer-or-selection-value () +(defun x-selection-value () (let (text) - ;; Consult the selection, then the cut buffer. Treat empty strings - ;; as if they were unset. + ;; Consult the selection. Treat empty strings as if they were unset. (or text (setq text (ns-get-pasteboard))) (if (string= text "") (setq text nil))
--- a/lisp/term/pc-win.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/term/pc-win.el Wed Sep 08 13:08:19 2010 +0900 @@ -192,11 +192,11 @@ ;; From lisp/term/w32-win.el ; -;;;; Selections and cut buffers +;;;; Selections ; ;;; We keep track of the last text selected here, so we can check the ;;; current selection against it, and avoid passing back our own text -;;; from x-cut-buffer-or-selection-value. +;;; from x-selection-value. (defvar x-last-selected-text nil) (defcustom x-select-enable-clipboard t @@ -209,27 +209,24 @@ :type 'boolean :group 'killing) -(defun x-select-text (text &optional push) +(defun x-select-text (text) "Select TEXT, a string, according to the window system. -On X, put TEXT in the primary X selection. For backward -compatibility with older X applications, set the value of X cut -buffer 0 as well, and if the optional argument PUSH is non-nil, -rotate the cut buffers. If `x-select-enable-clipboard' is -non-nil, copy the text to the X clipboard as well. +On X, if `x-select-enable-clipboard' is non-nil, copy TEXT to the +clipboard. If `x-select-enable-primary' is non-nil, put TEXT in +the primary selection. On Windows, make TEXT the current selection. If `x-select-enable-clipboard' is non-nil, copy the text to the -clipboard as well. The argument PUSH is ignored. +clipboard as well. -On Nextstep, put TEXT in the pasteboard; PUSH is ignored." +On Nextstep, put TEXT in the pasteboard." (if x-select-enable-clipboard (w16-set-clipboard-data text)) (setq x-last-selected-text text)) ;;; Return the value of the current selection. -;;; Consult the selection, then the cut buffer. Treat empty strings -;;; as if they were unset. +;;; Consult the selection. Treat empty strings as if they were unset. (defun x-get-selection-value () (if x-select-enable-clipboard (let (text)
--- a/lisp/term/x-win.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/term/x-win.el Wed Sep 08 13:08:19 2010 +0900 @@ -1192,32 +1192,19 @@ ;; #x0dde THAI MAIHANAKAT Thai -;;;; Selections and cut buffers +;;;; Selections ;; We keep track of the last text selected here, so we can check the ;; current selection against it, and avoid passing back our own text -;; from x-cut-buffer-or-selection-value. We track all three +;; from x-selection-value. We track both ;; separately in case another X application only sets one of them -;; (say the cut buffer) we aren't fooled by the PRIMARY or -;; CLIPBOARD selection staying the same. +;; we aren't fooled by the PRIMARY or CLIPBOARD selection staying the same. (defvar x-last-selected-text-clipboard nil "The value of the CLIPBOARD X selection last time we selected or pasted text.") (defvar x-last-selected-text-primary nil "The value of the PRIMARY X selection last time we selected or pasted text.") -(defvar x-last-selected-text-cut nil - "The value of the X cut buffer last time we selected or pasted text. -The actual text stored in the X cut buffer is what encoded from this value.") -(defvar x-last-selected-text-cut-encoded nil - "The value of the X cut buffer last time we selected or pasted text. -This is the actual text stored in the X cut buffer.") -(defvar x-last-cut-buffer-coding 'iso-latin-1 - "The coding we last used to encode/decode the text from the X cut buffer") - -(defvar x-cut-buffer-max 20000 ; Note this value is overridden below. - "Max number of characters to put in the cut buffer. -It is said that overlarge strings are slow to put into the cut buffer.") (defcustom x-select-enable-clipboard t "Non-nil means cutting and pasting uses the clipboard. @@ -1232,29 +1219,20 @@ :group 'killing :version "24.1") -(defun x-select-text (text &optional push) +(defun x-select-text (text) "Select TEXT, a string, according to the window system. -If `x-select-enable-clipboard' is non-nil, copy TEXT to the + +On X, if `x-select-enable-clipboard' is non-nil, copy TEXT to the clipboard. If `x-select-enable-primary' is non-nil, put TEXT in -the primary selection. For backward compatibility with older X -applications, this function also sets the value of X cut buffer -0, and, if the optional argument PUSH is non-nil, rotates the cut -buffers." +the primary selection. + +On Windows, make TEXT the current selection. If +`x-select-enable-clipboard' is non-nil, copy the text to the +clipboard as well. + +On Nextstep, put TEXT in the pasteboard." ;; With multi-tty, this function may be called from a tty frame. (when (eq (framep (selected-frame)) 'x) - ;; Don't send the cut buffer too much text. - ;; It becomes slow, and if really big it causes errors. - (cond ((>= (length text) x-cut-buffer-max) - (x-set-cut-buffer "" push) - (setq x-last-selected-text-cut "" - x-last-selected-text-cut-encoded "")) - (t - (setq x-last-selected-text-cut text - x-last-cut-buffer-coding 'iso-latin-1 - x-last-selected-text-cut-encoded - ;; ICCCM says cut buffer always contain ISO-Latin-1 - (encode-coding-string text 'iso-latin-1)) - (x-set-cut-buffer x-last-selected-text-cut-encoded push))) (when x-select-enable-primary (x-set-selection 'PRIMARY text) (setq x-last-selected-text-primary text)) @@ -1282,7 +1260,7 @@ ;; The return value is already decoded. If x-get-selection causes an ;; error, this function return nil. -(defun x-selection-value (type) +(defun x-selection-value-internal (type) (let ((request-type (or x-select-request-type '(UTF8_STRING COMPOUND_TEXT STRING))) text) @@ -1300,17 +1278,16 @@ text)) ;; Return the value of the current X selection. -;; Consult the selection, and the cut buffer. Treat empty strings -;; as if they were unset. +;; Consult the selection. Treat empty strings as if they were unset. ;; If this function is called twice and finds the same text, ;; it returns nil the second time. This is so that a single ;; selection won't be added to the kill ring over and over. -(defun x-cut-buffer-or-selection-value () +(defun x-selection-value () ;; With multi-tty, this function may be called from a tty frame. (when (eq (framep (selected-frame)) 'x) - (let (clip-text primary-text cut-text) + (let (clip-text primary-text) (when x-select-enable-clipboard - (setq clip-text (x-selection-value 'CLIPBOARD)) + (setq clip-text (x-selection-value-internal 'CLIPBOARD)) (if (string= clip-text "") (setq clip-text nil)) ;; Check the CLIPBOARD selection for 'newness', is it different @@ -1329,7 +1306,7 @@ (t (setq x-last-selected-text-clipboard clip-text))))) (when x-select-enable-primary - (setq primary-text (x-selection-value 'PRIMARY)) + (setq primary-text (x-selection-value-internal 'PRIMARY)) ;; Check the PRIMARY selection for 'newness', is it different ;; from what we remebered them to be last time we did a ;; cut/paste operation. @@ -1346,69 +1323,35 @@ (t (setq x-last-selected-text-primary primary-text))))) - (setq cut-text (x-get-cut-buffer 0)) - - ;; Check the x cut buffer for 'newness', is it different - ;; from what we remebered them to be last time we did a - ;; cut/paste operation. - (setq cut-text - (let ((next-coding (or next-selection-coding-system 'iso-latin-1))) - (cond ;; check cut buffer - ((or (not cut-text) (string= cut-text "")) - (setq x-last-selected-text-cut nil)) - ;; This short cut doesn't work because x-get-cut-buffer - ;; always returns a newly created string. - ;; ((eq cut-text x-last-selected-text-cut) nil) - ((and (string= cut-text x-last-selected-text-cut-encoded) - (eq x-last-cut-buffer-coding next-coding)) - ;; See the comment above. No need of this recording. - ;; Record the newer string, - ;; so subsequent calls can use the `eq' test. - ;; (setq x-last-selected-text-cut cut-text) - nil) - (t - (setq x-last-selected-text-cut-encoded cut-text - x-last-cut-buffer-coding next-coding - x-last-selected-text-cut - ;; ICCCM says cut buffer always contain ISO-Latin-1, but - ;; use next-selection-coding-system if not nil. - (decode-coding-string - cut-text next-coding)))))) - ;; As we have done one selection, clear this now. (setq next-selection-coding-system nil) ;; At this point we have recorded the current values for the - ;; selection from clipboard (if we are supposed to) primary, - ;; and cut buffer. So return the first one that has changed + ;; selection from clipboard (if we are supposed to) and primary. + ;; So return the first one that has changed ;; (which is the first non-null one). ;; ;; NOTE: There will be cases where more than one of these has ;; changed and the new values differ. This indicates that ;; something like the following has happened since the last time ;; we looked at the selections: Application X set all the - ;; selections, then Application Y set only one or two of them (say - ;; just the cut-buffer). In this case since we don't have + ;; selections, then Application Y set only one of them. + ;; In this case since we don't have ;; timestamps there is no way to know what the 'correct' value to ;; return is. The nice thing to do would be to tell the user we ;; saw multiple possible selections and ask the user which was the ;; one they wanted. - ;; This code is still a big improvement because now the user can - ;; futz with the current selection and get emacs to pay attention - ;; to the cut buffer again (previously as soon as clipboard or - ;; primary had been set the cut buffer would essentially never be - ;; checked again). - (or clip-text primary-text cut-text) + (or clip-text primary-text) ))) ;; Arrange for the kill and yank functions to set and check the clipboard. (setq interprogram-cut-function 'x-select-text) -(setq interprogram-paste-function 'x-cut-buffer-or-selection-value) +(setq interprogram-paste-function 'x-selection-value) (defun x-clipboard-yank () "Insert the clipboard contents, or the last stretch of killed text." (interactive "*") - (let ((clipboard-text (x-selection-value 'CLIPBOARD)) + (let ((clipboard-text (x-selection-value-internal 'CLIPBOARD)) (x-select-enable-clipboard t)) (if (and clipboard-text (> (length clipboard-text) 0)) (kill-new clipboard-text)) @@ -1465,9 +1408,6 @@ ;; are the initial display. (eq initial-window-system 'x)) - (setq x-cut-buffer-max (min (- (/ (x-server-max-request-size) 2) 100) - x-cut-buffer-max)) - ;; Create the default fontset. (create-default-fontset)
--- a/lisp/textmodes/bibtex.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/textmodes/bibtex.el Wed Sep 08 13:08:19 2010 +0900 @@ -9,7 +9,7 @@ ;; Mike Newton <newton@gumby.cs.caltech.edu> ;; Aaron Larson <alarson@src.honeywell.com> ;; Dirk Herrmann <D.Herrmann@tu-bs.de> -;; Maintainer: Roland Winkler <roland.winkler@physik.uni-erlangen.de> +;; Maintainer: Roland Winkler <winkler@gnu.org> ;; Keywords: BibTeX, LaTeX, TeX ;; This file is part of GNU Emacs.
--- a/lisp/textmodes/ispell.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/textmodes/ispell.el Wed Sep 08 13:08:19 2010 +0900 @@ -221,10 +221,10 @@ (let (ver mver) (if (string-match "[0-9]+" version start-ver) (setq start-ver (match-end 0) - ver (string-to-number (substring version (match-beginning 0) (match-end 0))))) + ver (string-to-number (match-string 0 version)))) (if (string-match "[0-9]+" minver start-mver) (setq start-mver (match-end 0) - mver (string-to-number (substring minver (match-beginning 0) (match-end 0))))) + mver (string-to-number (match-string 0 minver)))) (if (or ver mver) (progn @@ -310,7 +310,9 @@ may produce undesired results." :type '(choice (const exclusive) (const :tag "off" nil) (const :tag "on" t)) :group 'ispell) -;;;###autoload(put 'ispell-check-comments 'safe-local-variable (lambda (a) (memq a '(nil t exclusive)))) +;;;###autoload +(put 'ispell-check-comments 'safe-local-variable + (lambda (a) (memq a '(nil t exclusive)))) (defcustom ispell-query-replace-choices nil "*Corrections made throughout region when non-nil. @@ -514,7 +516,8 @@ :type '(choice string (const :tag "default" nil)) :group 'ispell) -;;;###autoload(put 'ispell-local-dictionary 'safe-local-variable 'string-or-null-p) +;;;###autoload +(put 'ispell-local-dictionary 'safe-local-variable 'string-or-null-p) (make-variable-buffer-local 'ispell-local-dictionary) @@ -738,8 +741,8 @@ contain the same character set as casechars and otherchars in the LANGUAGE.aff file \(e.g., english.aff\).") -(defvar ispell-really-aspell nil) ; Non-nil if aspell extensions should be used -(defvar ispell-really-hunspell nil) ; Non-nil if hunspell extensions should be used +(defvar ispell-really-aspell nil) ; Non-nil if we can use aspell extensions. +(defvar ispell-really-hunspell nil) ; Non-nil if we can use hunspell extensions. (defvar ispell-encoding8-command nil "Command line option prefix to select UTF-8 if supported, nil otherwise. If UTF-8 if supported by spellchecker and is selectable from the command line @@ -962,7 +965,8 @@ (setq found (nconc found (list dict))))) (setq ispell-aspell-dictionary-alist found) ;; Add a default entry - (let ((default-dict '(nil "[[:alpha:]]" "[^[:alpha:]]" "[']" nil ("-B") nil utf-8))) + (let ((default-dict + '(nil "[[:alpha:]]" "[^[:alpha:]]" "[']" nil ("-B") nil utf-8))) (push default-dict ispell-aspell-dictionary-alist)))) (defvar ispell-aspell-data-dir nil @@ -1026,7 +1030,8 @@ (defun ispell-aspell-add-aliases (alist) "Find aspell's dictionary aliases and add them to dictionary ALIST. Return the new dictionary alist." - (let ((aliases (file-expand-wildcards + (let ((aliases + (file-expand-wildcards (concat (or ispell-aspell-dict-dir (setq ispell-aspell-dict-dir (ispell-get-aspell-config-value "dict-dir"))) @@ -1168,7 +1173,8 @@ `(menu-item ,(purecopy "Complete Word") ispell-complete-word :help ,(purecopy "Complete word at cursor using dictionary"))) (define-key ispell-menu-map [ispell-complete-word-interior-frag] - `(menu-item ,(purecopy "Complete Word Fragment") ispell-complete-word-interior-frag + `(menu-item ,(purecopy "Complete Word Fragment") + ispell-complete-word-interior-frag :help ,(purecopy "Complete word fragment at cursor"))))) ;;;###autoload @@ -1185,7 +1191,8 @@ `(menu-item ,(purecopy "Spell-Check Word") ispell-word :help ,(purecopy "Spell-check word at cursor"))) (define-key ispell-menu-map [ispell-comments-and-strings] - `(menu-item ,(purecopy "Spell-Check Comments") ispell-comments-and-strings + `(menu-item ,(purecopy "Spell-Check Comments") + ispell-comments-and-strings :help ,(purecopy "Spell-check only comments and strings"))))) ;;;###autoload @@ -1334,9 +1341,6 @@ (defvar ispell-process-directory nil "The directory where `ispell-process' was started.") -(defvar ispell-process-buffer-name nil - "The buffer where `ispell-process' was started.") - (defvar ispell-filter nil "Output filter from piped calls to Ispell.") @@ -1400,7 +1404,8 @@ (ispell-dictionary-keyword forward-line) (ispell-pdict-keyword forward-line) (ispell-parsing-keyword forward-line) - (,(purecopy "^---*BEGIN PGP [A-Z ]*--*") . ,(purecopy "^---*END PGP [A-Z ]*--*")) + (,(purecopy "^---*BEGIN PGP [A-Z ]*--*") + . ,(purecopy "^---*END PGP [A-Z ]*--*")) ;; assume multiline uuencoded file? "\nM.*$"? (,(purecopy "^begin [0-9][0-9][0-9] [^ \t]+$") . ,(purecopy "\nend\n")) (,(purecopy "^%!PS-Adobe-[123].0") . ,(purecopy "\n%%EOF\n")) @@ -1880,9 +1885,10 @@ ;; setup the *Choices* buffer with valid data. (with-current-buffer (get-buffer-create ispell-choices-buffer) (setq mode-line-format - (concat "-- %b -- word: " word - " -- dict: " (or ispell-current-dictionary "default") - " -- prog: " (file-name-nondirectory ispell-program-name))) + (concat + "-- %b -- word: " word + " -- dict: " (or ispell-current-dictionary "default") + " -- prog: " (file-name-nondirectory ispell-program-name))) ;; XEmacs: no need for horizontal scrollbar in choices window (with-no-warnings (and (fboundp 'set-specifier) @@ -2280,8 +2286,9 @@ (unless (file-readable-p lookup-dict) (error "lookup-words error: Unreadable or missing plain word-list %s." lookup-dict)) - (error (concat "lookup-words error: No plain word-list found at system default " - "locations. Customize `ispell-alternate-dictionary' to set yours."))) + (error (concat "lookup-words error: No plain word-list found at system" + "default locations. " + "Customize `ispell-alternate-dictionary' to set yours."))) (let* ((process-connection-type ispell-use-ptys-p) (wild-p (string-match "\\*" word)) @@ -2332,16 +2339,16 @@ results)) -;;; "ispell-filter" is a list of output lines from the generating function. -;;; Each full line (ending with \n) is a separate item on the list. -;;; "output" can contain multiple lines, part of a line, or both. -;;; "start" and "end" are used to keep bounds on lines when "output" contains -;;; multiple lines. -;;; "ispell-filter-continue" is true when we have received only part of a -;;; line as output from a generating function ("output" did not end with \n) -;;; THIS FUNCTION WILL FAIL IF THE PROCESS OUTPUT DOESN'T END WITH \n! -;;; This is the case when a process dies or fails. The default behavior -;;; in this case treats the next input received as fresh input. +;; "ispell-filter" is a list of output lines from the generating function. +;; Each full line (ending with \n) is a separate item on the list. +;; "output" can contain multiple lines, part of a line, or both. +;; "start" and "end" are used to keep bounds on lines when "output" contains +;; multiple lines. +;; "ispell-filter-continue" is true when we have received only part of a +;; line as output from a generating function ("output" did not end with \n) +;; THIS FUNCTION WILL FAIL IF THE PROCESS OUTPUT DOESN'T END WITH \n! +;; This is the case when a process dies or fails. The default behavior +;; in this case treats the next input received as fresh input. (defun ispell-filter (process output) "Output filter function for ispell, grep, and look." @@ -2573,37 +2580,35 @@ (defun ispell-start-process () "Start the ispell process, with support for no asynchronous processes. Keeps argument list for future ispell invocations for no async support." - (let ((default-directory default-directory) - args) - (unless (and (file-directory-p default-directory) - (file-readable-p default-directory)) - ;; Defend against bad `default-directory'. - (setq default-directory (expand-file-name "~/"))) - ;; Local dictionary becomes the global dictionary in use. - (setq ispell-current-dictionary - (or ispell-local-dictionary ispell-dictionary)) - (setq ispell-current-personal-dictionary - (or ispell-local-pdict ispell-personal-dictionary)) - (setq args (ispell-get-ispell-args)) - (if (and ispell-current-dictionary ; use specified dictionary - (not (member "-d" args))) ; only define if not overridden - (setq args - (append (list "-d" ispell-current-dictionary) args))) - (if ispell-current-personal-dictionary ; use specified pers dict - (setq args - (append args - (list "-p" - (expand-file-name ispell-current-personal-dictionary))))) - - ;; If we are using recent aspell or hunspell, make sure we use the right encoding - ;; for communication. ispell or older aspell/hunspell does not support this - (if ispell-encoding8-command - (setq args - (append args - (list - (concat ispell-encoding8-command - (symbol-name (ispell-get-coding-system))))))) - (setq args (append args ispell-extra-args)) + ;; Local dictionary becomes the global dictionary in use. + (setq ispell-current-dictionary + (or ispell-local-dictionary ispell-dictionary)) + (setq ispell-current-personal-dictionary + (or ispell-local-pdict ispell-personal-dictionary)) + (let* ((default-directory + (if (and (file-directory-p default-directory) + (file-readable-p default-directory)) + default-directory + ;; Defend against bad `default-directory'. + (expand-file-name "~/"))) + (orig-args (ispell-get-ispell-args)) + (args + (append + (if (and ispell-current-dictionary ; Not for default dict (nil) + (not (member "-d" orig-args))) ; Only define if not overridden. + (list "-d" ispell-current-dictionary)) + orig-args + (if ispell-current-personal-dictionary ; Use specified pers dict. + (list "-p" + (expand-file-name ispell-current-personal-dictionary))) + ;; If we are using recent aspell or hunspell, make sure we use the + ;; right encoding for communication. ispell or older aspell/hunspell + ;; does not support this. + (if ispell-encoding8-command + (list + (concat ispell-encoding8-command + (symbol-name (ispell-get-coding-system))))) + ispell-extra-args))) ;; Initially we don't know any buffer's local words. (setq ispell-buffer-local-name nil) @@ -2612,9 +2617,11 @@ (let ((process-connection-type ispell-use-ptys-p)) (apply 'start-process "ispell" nil ispell-program-name - "-a" ; accept single input lines - (if ispell-really-hunspell "" "-m") ; make root/affix combos not in dict - args)) ; hunspell -m option means different + "-a" ; Accept single input lines. + ;; Make root/affix combos not in dict. + ;; hunspell -m option means different. + (if ispell-really-hunspell "" "-m") + args)) (setq ispell-cmd-args args ispell-output-buffer (generate-new-buffer " *ispell-output*") ispell-session-buffer (generate-new-buffer " *ispell-session*")) @@ -2622,79 +2629,107 @@ t))) - (defun ispell-init-process () "Check status of Ispell process and start if necessary." - (if (and ispell-process - (eq (ispell-process-status) 'run) - ;; Unless we are using an explicit personal dictionary, - ;; ensure we're in the same default directory! - ;; Restart check for personal dictionary is done in - ;; `ispell-internal-change-dictionary', called from `ispell-buffer-local-dict' - (or (or ispell-local-pdict ispell-personal-dictionary) - (equal ispell-process-directory (expand-file-name default-directory)))) - (setq ispell-filter nil ispell-filter-continue nil) - ;; may need to restart to select new personal dictionary. - (ispell-kill-ispell t) - (message "Starting new Ispell process [%s] ..." - (or ispell-local-dictionary ispell-dictionary "default")) - (sit-for 0) - (setq ispell-library-directory (ispell-check-version) - ispell-process (ispell-start-process) - ispell-filter nil - ispell-filter-continue nil) - ;; When spellchecking minibuffer contents, make sure ispell process - ;; is not restarted every time the minibuffer is killed. - (if (window-minibuffer-p) - (if (fboundp 'minibuffer-selected-window) - ;; Assign ispell process to parent buffer - (setq ispell-process-directory (expand-file-name default-directory) - ispell-process-buffer-name (window-buffer (minibuffer-selected-window))) - ;; Force `ispell-process-directory' to $HOME and use a dummy name - (setq ispell-process-directory (expand-file-name "~/") - ispell-process-buffer-name " * Minibuffer-has-spellcheck-enabled")) - ;; Not in a minibuffer - (setq ispell-process-directory (expand-file-name default-directory) - ispell-process-buffer-name (buffer-name))) - (if ispell-async-processp - (set-process-filter ispell-process 'ispell-filter)) - ;; protect against bogus binding of `enable-multibyte-characters' in XEmacs - (if (and (or (featurep 'xemacs) - (and (boundp 'enable-multibyte-characters) - enable-multibyte-characters)) - (fboundp 'set-process-coding-system)) - (set-process-coding-system ispell-process (ispell-get-coding-system) - (ispell-get-coding-system))) - ;; Get version ID line - (ispell-accept-output 3) - ;; get more output if filter empty? - (if (null ispell-filter) (ispell-accept-output 3)) - (cond ((null ispell-filter) - (error "%s did not output version line" ispell-program-name)) - ((and - (stringp (car ispell-filter)) - (if (string-match "warning: " (car ispell-filter)) - (progn - (ispell-accept-output 3) ; was warn msg. - (stringp (car ispell-filter))) - (null (cdr ispell-filter))) - (string-match "^@(#) " (car ispell-filter))) - ;; got the version line as expected (we already know it's the right - ;; version, so don't bother checking again.) - nil) - (t - ;; Otherwise, it must be an error message. Show the user. - ;; But first wait to see if some more output is going to arrive. - ;; Otherwise we get cool errors like "Can't open ". - (sleep-for 1) - (ispell-accept-output 3) - (error "%s" (mapconcat 'identity ispell-filter "\n")))) - (setq ispell-filter nil) ; Discard version ID line - (let ((extended-char-mode (ispell-get-extended-character-mode))) - (if extended-char-mode ; ~ extended character mode - (ispell-send-string (concat extended-char-mode "\n")))) - (if ispell-async-processp - (set-process-query-on-exit-flag ispell-process nil)))) + (let* (;; Basename of dictionary used by the spell-checker + (dict-bname (or (car (cdr (member "-d" (ispell-get-ispell-args)))) + ispell-current-dictionary)) + ;; Use "~/" as default-directory unless using Ispell with per-dir + ;; personal dictionaries and not in a minibuffer under XEmacs + (default-directory + (if (or ispell-really-aspell + ispell-really-hunspell + ;; Protect against bad default-directory + (not (and (file-directory-p default-directory) + (file-readable-p default-directory))) + ;; Ispell and per-dir personal dicts available + (not (or (file-readable-p (concat default-directory + ".ispell_words")) + (file-readable-p (concat default-directory + ".ispell_" + (or dict-bname + "default"))))) + ;; Ispell, in a minibuffer, and XEmacs + (and (window-minibuffer-p) + (not (fboundp 'minibuffer-selected-window)))) + (expand-file-name "~/") + (expand-file-name default-directory)))) + ;; Check if process needs restart + (if (and ispell-process + (eq (ispell-process-status) 'run) + ;; Unless we are using an explicit personal dictionary, ensure + ;; we're in the same default directory! Restart check for + ;; personal dictionary is done in + ;; `ispell-internal-change-dictionary', called from + ;; `ispell-buffer-local-dict' + (or (or ispell-local-pdict ispell-personal-dictionary) + (equal ispell-process-directory default-directory))) + (setq ispell-filter nil ispell-filter-continue nil) + ;; may need to restart to select new personal dictionary. + (ispell-kill-ispell t) + (message "Starting new Ispell process [%s] ..." + (or ispell-local-dictionary ispell-dictionary "default")) + (sit-for 0) + (setq ispell-library-directory (ispell-check-version) + ispell-process (ispell-start-process) + ispell-filter nil + ispell-filter-continue nil + ispell-process-directory default-directory) + + ;; Kill ispell process when killing its associated buffer if using Ispell + ;; per-directory personal dictionaries. + (unless (equal ispell-process-directory (expand-file-name "~/")) + (with-current-buffer + (if (and (window-minibuffer-p) + (fboundp 'minibuffer-selected-window)) ;; E.g. XEmacs. + ;; When spellchecking minibuffer contents, assign ispell + ;; process to parent buffer if known (not known for XEmacs). + ;; Use (buffer-name) otherwise. + (window-buffer (minibuffer-selected-window)) + (current-buffer)) + (add-hook 'kill-buffer-hook (lambda () (ispell-kill-ispell t)) + nil 'local))) + + (if ispell-async-processp + (set-process-filter ispell-process 'ispell-filter)) + ;; protect against bogus binding of `enable-multibyte-characters' in + ;; XEmacs. + (if (and (or (featurep 'xemacs) + (and (boundp 'enable-multibyte-characters) + enable-multibyte-characters)) + (fboundp 'set-process-coding-system)) + (set-process-coding-system ispell-process (ispell-get-coding-system) + (ispell-get-coding-system))) + ;; Get version ID line + (ispell-accept-output 3) + ;; get more output if filter empty? + (if (null ispell-filter) (ispell-accept-output 3)) + (cond ((null ispell-filter) + (error "%s did not output version line" ispell-program-name)) + ((and + (stringp (car ispell-filter)) + (if (string-match "warning: " (car ispell-filter)) + (progn + (ispell-accept-output 3) ; was warn msg. + (stringp (car ispell-filter))) + (null (cdr ispell-filter))) + (string-match "^@(#) " (car ispell-filter))) + ;; got the version line as expected (we already know it's the right + ;; version, so don't bother checking again.) + nil) + (t + ;; Otherwise, it must be an error message. Show the user. + ;; But first wait to see if some more output is going to arrive. + ;; Otherwise we get cool errors like "Can't open ". + (sleep-for 1) + (ispell-accept-output 3) + (error "%s" (mapconcat 'identity ispell-filter "\n")))) + (setq ispell-filter nil) ; Discard version ID line + (let ((extended-char-mode (ispell-get-extended-character-mode))) + (if extended-char-mode ; ~ extended character mode + (ispell-send-string (concat extended-char-mode "\n")))) + (if ispell-async-processp + (set-process-query-on-exit-flag ispell-process nil))))) ;;;###autoload (defun ispell-kill-ispell (&optional no-error) @@ -2716,17 +2751,10 @@ (kill-buffer ispell-session-buffer) (setq ispell-output-buffer nil ispell-session-buffer nil)) - (setq ispell-process-buffer-name nil) (setq ispell-process nil) (message "Ispell process killed") nil)) -;; Kill ispell process when killing its associated buffer -(add-hook 'kill-buffer-hook - '(lambda () - (if (equal ispell-process-buffer-name (buffer-name)) - (ispell-kill-ispell t)))) - ;;; ispell-change-dictionary is set in some people's hooks. Maybe this should ;;; call ispell-init-process rather than wait for a spell checking command? @@ -2823,9 +2851,10 @@ (set-marker skip-region-start (- (point) (length key))) (goto-char reg-start))) (let (message-log-max) - (message "Continuing spelling check using %s with %s dictionary..." - (file-name-nondirectory ispell-program-name) - (or ispell-current-dictionary "default"))) + (message + "Continuing spelling check using %s with %s dictionary..." + (file-name-nondirectory ispell-program-name) + (or ispell-current-dictionary "default"))) (set-marker rstart reg-start) (set-marker ispell-region-end reg-end) (while (and (not ispell-quit) @@ -3090,9 +3119,9 @@ (sit-for 2))))) -;;; Grab the next line of data. -;;; Returns a string with the line data (defun ispell-get-line (start end in-comment) + "Grab the next line of data. +Returns a string with the line data." (let ((ispell-casechars (ispell-get-casechars)) string) (cond ; LOOK AT THIS LINE AND SKIP OR PROCESS @@ -3119,7 +3148,8 @@ (point) (+ (point) len)) coding))))) -;;; Avoid error messages when compiling for these dynamic variables. +;; Avoid error messages when compiling for these dynamic variables. +;; FIXME: dynamically scoped vars should have an "ispell-" prefix. (defvar start) (defvar end) @@ -3254,10 +3284,12 @@ ;; (length (car poss))))) )) (if (not ispell-quit) + ;; FIXME: remove redundancy with identical code above. (let (message-log-max) - (message "Continuing spelling check using %s with %s dictionary..." - (file-name-nondirectory ispell-program-name) - (or ispell-current-dictionary "default")))) + (message + "Continuing spelling check using %s with %s dictionary..." + (file-name-nondirectory ispell-program-name) + (or ispell-current-dictionary "default")))) (sit-for 0) (setq start (marker-position line-start) end (marker-position line-end)) @@ -3330,7 +3362,7 @@ ;;; Interactive word completion. -;;; Forces "previous-word" processing. Do we want to make this selectable? +;; Forces "previous-word" processing. Do we want to make this selectable? ;;;###autoload (defun ispell-complete-word (&optional interior-frag)
--- a/lisp/w32-fns.el Thu Sep 02 11:00:18 2010 +0900 +++ b/lisp/w32-fns.el Wed Sep 08 13:08:19 2010 +0900 @@ -425,40 +425,32 @@ 'w32-charset-info-alist "21.1") -;;;; Selections and cut buffers +;;;; Selections ;; We keep track of the last text selected here, so we can check the ;; current selection against it, and avoid passing back our own text -;; from x-cut-buffer-or-selection-value. +;; from x-selection-value. (defvar x-last-selected-text nil) -;; It is said that overlarge strings are slow to put into the cut buffer. -;; Note this value is overridden below. -(defvar x-cut-buffer-max 20000 - "Max number of characters to put in the cut buffer.") - -(defun x-select-text (text &optional push) +(defun x-select-text (text) "Select TEXT, a string, according to the window system. -On X, put TEXT in the primary X selection. For backward -compatibility with older X applications, set the value of X cut -buffer 0 as well, and if the optional argument PUSH is non-nil, -rotate the cut buffers. If `x-select-enable-clipboard' is -non-nil, copy the text to the X clipboard as well. +On X, if `x-select-enable-clipboard' is non-nil, copy TEXT to the +clipboard. If `x-select-enable-primary' is non-nil, put TEXT in +the primary selection. On Windows, make TEXT the current selection. If `x-select-enable-clipboard' is non-nil, copy the text to the -clipboard as well. The argument PUSH is ignored. +clipboard as well. -On Nextstep, put TEXT in the pasteboard; PUSH is ignored." +On Nextstep, put TEXT in the pasteboard." (if x-select-enable-clipboard (w32-set-clipboard-data text)) (setq x-last-selected-text text)) (defun x-get-selection-value () "Return the value of the current selection. -Consult the selection, then the cut buffer. Treat empty strings as if -they were unset." +Consult the selection. Treat empty strings as if they were unset." (if x-select-enable-clipboard (let (text) ;; Don't die if x-get-selection signals an error. @@ -476,7 +468,7 @@ (t (setq x-last-selected-text text)))))) -(defalias 'x-cut-buffer-or-selection-value 'x-get-selection-value) +(defalias 'x-selection-value 'x-get-selection-value) ;; Arrange for the kill and yank functions to set and check the clipboard. (setq interprogram-cut-function 'x-select-text)
--- a/src/ChangeLog Thu Sep 02 11:00:18 2010 +0900 +++ b/src/ChangeLog Wed Sep 08 13:08:19 2010 +0900 @@ -1,3 +1,51 @@ +2010-09-05 Juanma Barranquero <lekktu@gmail.com> + + * biditype.h: Regenerate. + +2010-09-04 Andreas Schwab <schwab@linux-m68k.org> + + * nsimage.m (ns_load_image): Check argument types. + + * image.c: Remove all uses of gcpro. + (xpm_load): Check all lisp types. + (pbm_load): Likewise. + (png_load): Likewise. + (jpeg_load): Likewise. + (tiff_load): Likewise. + (gif_load): Likewise. + (imagemagick_load_image): Likewise. + (imagemagick_load): Likewise. + (svg_load): Likewise. + (gs_load): Likewise. + +2010-09-04 Eli Zaretskii <eliz@gnu.org> + + * w32uniscribe.c (uniscribe_shape): Update commentary. Don't + try to reorder grapheme clusters, since LGSTRING should always + hold them in the logical order. + (uniscribe_encode_char, uniscribe_shape): Force ScriptShape to + return glyph codes in the logical order. + +2010-09-04 Andreas Schwab <schwab@linux-m68k.org> + + * image.c (imagemagick_image_p): Replace bcopy by memcpy. + (imagemagick_load_image): Fix type mismatch. + (Fimagemagick_types): Likewise. Doc fix. + +2010-09-02 Jan Djärv <jan.h.d@swipnet.se> + + * xterm.h (struct dpyinfo): Remove cut_buffers_initialized. + + * xterm.c (x_term_init): Don't set dpyinfo->cut_buffers_initialized. + + * xselect.c: Remove declaration of cut-buffer objects and functions. + (symbol_to_x_atom): Remove mapping to XA_CUT_BUFFERn. + (x_atom_to_symbol): Remove mapping to QCUT_BUFFERn. + (Fx_get_cut_buffer_internal, Fx_store_cut_buffer_internal) + (Fx_rotate_cut_buffers_internal): Remove. + (syms_of_xselect): Remove defsubr of above. + Remove intern of QCUT_BUFFERn. + 2010-09-01 Stefan Monnier <monnier@iro.umontreal.ca> * cmds.c (Vblink_paren_function): Remove.
--- a/src/biditype.h Thu Sep 02 11:00:18 2010 +0900 +++ b/src/biditype.h Wed Sep 08 13:08:19 2010 +0900 @@ -83,7 +83,8 @@ { 0x0671, 0x06D5, STRONG_AL }, { 0x06D6, 0x06DC, WEAK_NSM }, { 0x06DD, 0x06DD, WEAK_AN }, - { 0x06DE, 0x06E4, WEAK_NSM }, + { 0x06DE, 0x06DE, NEUTRAL_ON }, + { 0x06DF, 0x06E4, WEAK_NSM }, { 0x06E5, 0x06E6, STRONG_AL }, { 0x06E7, 0x06E8, WEAK_NSM }, { 0x06E9, 0x06E9, NEUTRAL_ON }, @@ -271,7 +272,7 @@ { 0x2080, 0x2089, WEAK_EN }, { 0x208A, 0x208B, WEAK_ES }, { 0x208C, 0x208E, NEUTRAL_ON }, - { 0x20A0, 0x20B8, WEAK_ET }, + { 0x20A0, 0x20B9, WEAK_ET }, { 0x20D0, 0x20F0, WEAK_NSM }, { 0x2100, 0x2101, NEUTRAL_ON }, { 0x2103, 0x2106, NEUTRAL_ON },
--- a/src/image.c Thu Sep 02 11:00:18 2010 +0900 +++ b/src/image.c Wed Sep 08 13:08:19 2010 +0900 @@ -1735,7 +1735,6 @@ struct image_cache *c; struct image *img; unsigned hash; - struct gcpro gcpro1; EMACS_TIME now; /* F must be a window-system frame, and SPEC must be a valid image @@ -1745,8 +1744,6 @@ c = FRAME_IMAGE_CACHE (f); - GCPRO1 (spec); - /* Look up SPEC in the hash table of the image cache. */ hash = sxhash (spec, 0); img = search_image_cache (f, spec, hash); @@ -1838,8 +1835,6 @@ EMACS_GET_TIME (now); img->timestamp = EMACS_SECS (now); - UNGCPRO; - /* Value is the image id. */ return img->id; } @@ -2179,16 +2174,13 @@ x_find_image_file (Lisp_Object file) { Lisp_Object file_found, search_path; - struct gcpro gcpro1, gcpro2; int fd; - file_found = Qnil; /* TODO I think this should use something like image-load-path instead. Unfortunately, that can contain non-string elements. */ search_path = Fcons (Fexpand_file_name (build_string ("images"), Vdata_directory), Vx_bitmap_file_path); - GCPRO2 (file_found, search_path); /* Try to find FILE in data-directory/images, then x-bitmap-file-path. */ fd = openp (search_path, file, Qnil, &file_found, Qnil); @@ -2201,7 +2193,6 @@ close (fd); } - UNGCPRO; return file_found; } @@ -2875,14 +2866,11 @@ Lisp_Object file; unsigned char *contents; int size; - struct gcpro gcpro1; file = x_find_image_file (file_name); - GCPRO1 (file); if (!STRINGP (file)) { image_error ("Cannot find image file `%s'", file_name, Qnil); - UNGCPRO; return 0; } @@ -2890,12 +2878,10 @@ if (contents == NULL) { image_error ("Error loading XBM image `%s'", img->spec, Qnil); - UNGCPRO; return 0; } success_p = xbm_load_image (f, img, contents, contents + size); - UNGCPRO; } else { @@ -3456,12 +3442,31 @@ CONSP (tail); ++i, tail = XCDR (tail)) { - Lisp_Object name = XCAR (XCAR (tail)); - Lisp_Object color = XCDR (XCAR (tail)); - xpm_syms[i].name = (char *) alloca (SCHARS (name) + 1); - strcpy (xpm_syms[i].name, SDATA (name)); - xpm_syms[i].value = (char *) alloca (SCHARS (color) + 1); - strcpy (xpm_syms[i].value, SDATA (color)); + Lisp_Object name; + Lisp_Object color; + + if (!CONSP (XCAR (tail))) + { + xpm_syms[i].name = ""; + xpm_syms[i].value = ""; + continue; + } + name = XCAR (XCAR (tail)); + color = XCDR (XCAR (tail)); + if (STRINGP (name)) + { + xpm_syms[i].name = (char *) alloca (SCHARS (name) + 1); + strcpy (xpm_syms[i].name, SDATA (name)); + } + else + xpm_syms[i].name = ""; + if (STRINGP (color)) + { + xpm_syms[i].value = (char *) alloca (SCHARS (color) + 1); + strcpy (xpm_syms[i].value, SDATA (color)); + } + else + xpm_syms[i].value = ""; } } @@ -3487,6 +3492,9 @@ if (!STRINGP (file)) { image_error ("Cannot find image file `%s'", specified_file, Qnil); +#ifdef ALLOC_XPM_COLORS + xpm_free_color_cache (); +#endif return 0; } @@ -3505,6 +3513,14 @@ else { Lisp_Object buffer = image_spec_value (img->spec, QCdata, NULL); + if (!STRINGP (buffer)) + { + image_error ("Invalid image data `%s'", buffer, Qnil); +#ifdef ALLOC_XPM_COLORS + xpm_free_color_cache (); +#endif + return 0; + } #ifdef HAVE_NTGUI /* XpmCreatePixmapFromBuffer is not available in the Windows port of libxpm. But XpmCreateImageFromBuffer almost does what we want. */ @@ -4071,14 +4087,11 @@ Lisp_Object file; unsigned char *contents; int size; - struct gcpro gcpro1; file = x_find_image_file (file_name); - GCPRO1 (file); if (!STRINGP (file)) { image_error ("Cannot find image file `%s'", file_name, Qnil); - UNGCPRO; return 0; } @@ -4086,19 +4099,22 @@ if (contents == NULL) { image_error ("Error loading XPM image `%s'", img->spec, Qnil); - UNGCPRO; return 0; } success_p = xpm_load_image (f, img, contents, contents + size); xfree (contents); - UNGCPRO; } else { Lisp_Object data; data = image_spec_value (img->spec, QCdata, NULL); + if (!STRINGP (data)) + { + image_error ("Invalid image data `%s'", data, Qnil); + return 0; + } success_p = xpm_load_image (f, img, SDATA (data), SDATA (data) + SBYTES (data)); } @@ -5090,14 +5106,11 @@ XImagePtr ximg; Lisp_Object file, specified_file; enum {PBM_MONO, PBM_GRAY, PBM_COLOR} type; - struct gcpro gcpro1; unsigned char *contents = NULL; unsigned char *end, *p; int size; specified_file = image_spec_value (img->spec, QCfile, NULL); - file = Qnil; - GCPRO1 (file); if (STRINGP (specified_file)) { @@ -5105,7 +5118,6 @@ if (!STRINGP (file)) { image_error ("Cannot find image file `%s'", specified_file, Qnil); - UNGCPRO; return 0; } @@ -5113,7 +5125,6 @@ if (contents == NULL) { image_error ("Error reading `%s'", file, Qnil); - UNGCPRO; return 0; } @@ -5124,6 +5135,11 @@ { Lisp_Object data; data = image_spec_value (img->spec, QCdata, NULL); + if (!STRINGP (data)) + { + image_error ("Invalid image data `%s'", data, Qnil); + return 0; + } p = SDATA (data); end = p + SBYTES (data); } @@ -5134,7 +5150,6 @@ image_error ("Not a PBM image: `%s'", img->spec, Qnil); error: xfree (contents); - UNGCPRO; return 0; } @@ -5336,7 +5351,6 @@ img->width = width; img->height = height; */ - UNGCPRO; xfree (contents); return 1; } @@ -5576,7 +5590,6 @@ Lisp_Object specified_data; int x, y, i; XImagePtr ximg, mask_img = NULL; - struct gcpro gcpro1; png_struct *png_ptr = NULL; png_info *info_ptr = NULL, *end_info = NULL; FILE *volatile fp = NULL; @@ -5593,8 +5606,6 @@ /* Find out what file to load. */ specified_file = image_spec_value (img->spec, QCfile, NULL); specified_data = image_spec_value (img->spec, QCdata, NULL); - file = Qnil; - GCPRO1 (file); if (NILP (specified_data)) { @@ -5602,7 +5613,6 @@ if (!STRINGP (file)) { image_error ("Cannot find image file `%s'", specified_file, Qnil); - UNGCPRO; return 0; } @@ -5611,7 +5621,6 @@ if (!fp) { image_error ("Cannot open image file `%s'", file, Qnil); - UNGCPRO; return 0; } @@ -5620,13 +5629,18 @@ || fn_png_sig_cmp (sig, 0, sizeof sig)) { image_error ("Not a PNG file: `%s'", file, Qnil); - UNGCPRO; fclose (fp); return 0; } } else { + if (!STRINGP (specified_data)) + { + image_error ("Invalid image data `%s'", specified_data, Qnil); + return 0; + } + /* Read from memory. */ tbr.bytes = SDATA (specified_data); tbr.len = SBYTES (specified_data); @@ -5637,7 +5651,6 @@ || fn_png_sig_cmp (tbr.bytes, 0, sizeof sig)) { image_error ("Not a PNG image: `%s'", img->spec, Qnil); - UNGCPRO; return 0; } @@ -5653,7 +5666,6 @@ if (!png_ptr) { if (fp) fclose (fp); - UNGCPRO; return 0; } @@ -5663,7 +5675,6 @@ { fn_png_destroy_read_struct (&png_ptr, NULL, NULL); if (fp) fclose (fp); - UNGCPRO; return 0; } @@ -5673,7 +5684,6 @@ { fn_png_destroy_read_struct (&png_ptr, &info_ptr, NULL); if (fp) fclose (fp); - UNGCPRO; return 0; } @@ -5687,7 +5697,6 @@ xfree (pixels); xfree (rows); if (fp) fclose (fp); - UNGCPRO; return 0; } @@ -5912,7 +5921,6 @@ x_destroy_x_image (mask_img); } - UNGCPRO; return 1; } @@ -6313,13 +6321,10 @@ int rc; unsigned long *colors; int width, height; - struct gcpro gcpro1; /* Open the JPEG file. */ specified_file = image_spec_value (img->spec, QCfile, NULL); specified_data = image_spec_value (img->spec, QCdata, NULL); - file = Qnil; - GCPRO1 (file); if (NILP (specified_data)) { @@ -6327,7 +6332,6 @@ if (!STRINGP (file)) { image_error ("Cannot find image file `%s'", specified_file, Qnil); - UNGCPRO; return 0; } @@ -6335,10 +6339,14 @@ if (fp == NULL) { image_error ("Cannot open `%s'", file, Qnil); - UNGCPRO; return 0; } } + else if (!STRINGP (specified_data)) + { + image_error ("Invalid image data `%s'", specified_data, Qnil); + return 0; + } /* Customize libjpeg's error handling to call my_error_exit when an error is detected. This function will perform a longjmp. @@ -6367,8 +6375,6 @@ /* Free pixmap and colors. */ x_clear_image (f, img); - - UNGCPRO; return 0; } @@ -6466,7 +6472,6 @@ /* Put the image into the pixmap. */ x_put_x_image (f, ximg, img->pixmap, width, height); x_destroy_x_image (ximg); - UNGCPRO; return 1; } @@ -6741,14 +6746,11 @@ uint32 *buf; int rc, rc2; XImagePtr ximg; - struct gcpro gcpro1; tiff_memory_source memsrc; Lisp_Object image; specified_file = image_spec_value (img->spec, QCfile, NULL); specified_data = image_spec_value (img->spec, QCdata, NULL); - file = Qnil; - GCPRO1 (file); fn_TIFFSetErrorHandler (tiff_error_handler); fn_TIFFSetWarningHandler (tiff_warning_handler); @@ -6760,7 +6762,6 @@ if (!STRINGP (file)) { image_error ("Cannot find image file `%s'", specified_file, Qnil); - UNGCPRO; return 0; } @@ -6770,12 +6771,17 @@ if (tiff == NULL) { image_error ("Cannot open `%s'", file, Qnil); - UNGCPRO; return 0; } } else { + if (!STRINGP (specified_data)) + { + image_error ("Invalid image data `%s'", specified_data, Qnil); + return 0; + } + /* Memory source! */ memsrc.bytes = SDATA (specified_data); memsrc.len = SBYTES (specified_data); @@ -6794,7 +6800,6 @@ if (!tiff) { image_error ("Cannot open memory source for `%s'", img->spec, Qnil); - UNGCPRO; return 0; } } @@ -6808,7 +6813,6 @@ image_error ("Invalid image number `%s' in image `%s'", image, img->spec); fn_TIFFClose (tiff); - UNGCPRO; return 0; } } @@ -6822,7 +6826,6 @@ { image_error ("Invalid image size (see `max-image-size')", Qnil, Qnil); fn_TIFFClose (tiff); - UNGCPRO; return 0; } @@ -6844,7 +6847,6 @@ { image_error ("Error reading TIFF image `%s'", img->spec, Qnil); xfree (buf); - UNGCPRO; return 0; } @@ -6852,7 +6854,6 @@ if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap)) { xfree (buf); - UNGCPRO; return 0; } @@ -6893,7 +6894,6 @@ x_destroy_x_image (ximg); xfree (buf); - UNGCPRO; return 1; } @@ -7099,7 +7099,6 @@ ColorMapObject *gif_color_map; unsigned long pixel_colors[256]; GifFileType *gif; - struct gcpro gcpro1; Lisp_Object image; int ino, image_height, image_width; gif_memory_source memsrc; @@ -7107,8 +7106,6 @@ specified_file = image_spec_value (img->spec, QCfile, NULL); specified_data = image_spec_value (img->spec, QCdata, NULL); - file = Qnil; - GCPRO1 (file); if (NILP (specified_data)) { @@ -7116,7 +7113,6 @@ if (!STRINGP (file)) { image_error ("Cannot find image file `%s'", specified_file, Qnil); - UNGCPRO; return 0; } @@ -7126,12 +7122,17 @@ if (gif == NULL) { image_error ("Cannot open `%s'", file, Qnil); - UNGCPRO; return 0; } } else { + if (!STRINGP (specified_data)) + { + image_error ("Invalid image data `%s'", specified_data, Qnil); + return 0; + } + /* Read from memory! */ current_gif_memory_src = &memsrc; memsrc.bytes = SDATA (specified_data); @@ -7143,7 +7144,6 @@ if (!gif) { image_error ("Cannot open memory source `%s'", img->spec, Qnil); - UNGCPRO; return 0; } } @@ -7153,7 +7153,6 @@ { image_error ("Invalid image size (see `max-image-size')", Qnil, Qnil); fn_DGifCloseFile (gif); - UNGCPRO; return 0; } @@ -7163,7 +7162,6 @@ { image_error ("Error reading `%s'", img->spec, Qnil); fn_DGifCloseFile (gif); - UNGCPRO; return 0; } @@ -7174,7 +7172,6 @@ image_error ("Invalid image number `%s' in image `%s'", image, img->spec); fn_DGifCloseFile (gif); - UNGCPRO; return 0; } @@ -7196,7 +7193,6 @@ { image_error ("Invalid image size (see `max-image-size')", Qnil, Qnil); fn_DGifCloseFile (gif); - UNGCPRO; return 0; } @@ -7204,7 +7200,6 @@ if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap)) { fn_DGifCloseFile (gif); - UNGCPRO; return 0; } @@ -7323,7 +7318,6 @@ x_put_x_image (f, ximg, img->pixmap, width, height); x_destroy_x_image (ximg); - UNGCPRO; return 1; } @@ -7389,9 +7383,9 @@ {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}, {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}, {":background", IMAGE_STRING_OR_NIL_VALUE, 0}, - {":height", IMAGE_INTEGER_VALUE, 0}, - {":width", IMAGE_INTEGER_VALUE, 0}, - {":rotation", IMAGE_NUMBER_VALUE, 0}, + {":height", IMAGE_INTEGER_VALUE, 0}, + {":width", IMAGE_INTEGER_VALUE, 0}, + {":rotation", IMAGE_NUMBER_VALUE, 0}, {":crop", IMAGE_DONT_CHECK_VALUE_TYPE, 0} }; /* Free X resources of imagemagick image IMG which is used on frame F. */ @@ -7413,7 +7407,7 @@ imagemagick_image_p (Lisp_Object object) { struct image_keyword fmt[IMAGEMAGICK_LAST]; - bcopy (imagemagick_format, fmt, sizeof fmt); + memcpy (fmt, imagemagick_format, sizeof fmt); if (!parse_image_spec (object, fmt, IMAGEMAGICK_LAST, Qimagemagick)) return 0; @@ -7440,7 +7434,7 @@ imagemagick_load_image (/* Pointer to emacs frame structure. */ struct frame *f, /* Pointer to emacs image structure. */ - struct image *img, + struct image *img, /* String containing the IMAGEMAGICK data to be parsed. */ unsigned char *contents, @@ -7450,8 +7444,8 @@ contents/size. */ unsigned char *filename) { - size_t width; - size_t height; + unsigned long width; + unsigned long height; MagickBooleanType status; @@ -7463,52 +7457,52 @@ int y; MagickWand *image_wand; - MagickWand *ping_wand; + MagickWand *ping_wand; PixelIterator *iterator; PixelWand **pixels; MagickPixelPacket pixel; Lisp_Object image; - Lisp_Object value; + Lisp_Object value; Lisp_Object crop, geometry; long ino; int desired_width, desired_height; double rotation; int imagemagick_rendermethod; - int pixelwidth; + int pixelwidth; ImageInfo *image_info; ExceptionInfo *exception; Image * im_image; - + /* Handle image index for image types who can contain more than one image. Interface :index is same as for GIF. First we "ping" the image to see how many sub-images it contains. Pinging is faster than loading the image to find out things about it. */ image = image_spec_value (img->spec, QCindex, NULL); ino = INTEGERP (image) ? XFASTINT (image) : 0; - ping_wand=NewMagickWand(); - MagickSetResolution(ping_wand, 2, 2); + ping_wand = NewMagickWand (); + MagickSetResolution (ping_wand, 2, 2); if (filename != NULL) { - status = MagickPingImage(ping_wand, filename); + status = MagickPingImage (ping_wand, filename); } else { - status = MagickPingImageBlob(ping_wand, contents, size); - } - - if (ino >= MagickGetNumberImages(ping_wand)) - { - image_error ("Invalid image number `%s' in image `%s'", - image, img->spec); - UNGCPRO; - return 0; - } + status = MagickPingImageBlob (ping_wand, contents, size); + } + + if (ino >= MagickGetNumberImages (ping_wand)) + { + image_error ("Invalid image number `%s' in image `%s'", + image, img->spec); + DestroyMagickWand (ping_wand); + return 0; + } if (MagickGetNumberImages(ping_wand) > 1) img->data.lisp_val = Fcons (Qcount, - Fcons (make_number (MagickGetNumberImages(ping_wand)), + Fcons (make_number (MagickGetNumberImages (ping_wand)), img->data.lisp_val)); DestroyMagickWand (ping_wand); @@ -7517,21 +7511,21 @@ if (filename != NULL) { - image_info=CloneImageInfo((ImageInfo *) NULL); - (void) strcpy(image_info->filename, filename); - image_info -> number_scenes = 1; - image_info -> scene = ino; - exception=AcquireExceptionInfo(); - - im_image = ReadImage (image_info, exception); - CatchException(exception); - - image_wand = NewMagickWandFromImage(im_image); + image_info = CloneImageInfo ((ImageInfo *) NULL); + (void) strcpy (image_info->filename, filename); + image_info->number_scenes = 1; + image_info->scene = ino; + exception = AcquireExceptionInfo (); + + im_image = ReadImage (image_info, exception); + CatchException (exception); + + image_wand = NewMagickWandFromImage (im_image); } else { - image_wand = NewMagickWand(); - status = MagickReadImageBlob(image_wand, contents, size); + image_wand = NewMagickWand (); + status = MagickReadImageBlob (image_wand, contents, size); } image_error ("im read failed", Qnil, Qnil); if (status == MagickFalse) goto imagemagick_error; @@ -7552,44 +7546,56 @@ if(desired_width != -1 && desired_height == -1) { /* w known, calculate h. */ - desired_height = ( (double)desired_width / width ) * height; + desired_height = (double) desired_width / width * height; } if(desired_width == -1 && desired_height != -1) { /* h known, calculate w. */ - desired_width = ( (double)desired_height / height ) * width; - } + desired_width = (double) desired_height / height * width; + } if(desired_width != -1 && desired_height != -1) { - status = MagickScaleImage(image_wand, desired_width, desired_height); - if (status == MagickFalse) { - image_error ("Imagemagick scale failed", Qnil, Qnil); - goto imagemagick_error; - } + status = MagickScaleImage (image_wand, desired_width, desired_height); + if (status == MagickFalse) + { + image_error ("Imagemagick scale failed", Qnil, Qnil); + goto imagemagick_error; + } } /* crop behaves similar to image slicing in Emacs but is more memory - efficient */ - crop = image_spec_value (img->spec, QCcrop, NULL); - - if(CONSP (crop)) - { - /* - after some testing, it seems MagickCropImage is the fastest - crop function in ImageMagick. This crop function seems to do + efficient. */ + crop = image_spec_value (img->spec, QCcrop, NULL); + + if (CONSP (crop) && INTEGERP (XCAR (crop))) + { + /* After some testing, it seems MagickCropImage is the fastest + crop function in ImageMagick. This crop function seems to do less copying than the alternatives, but it still reads the entire image into memory before croping, which is aparently - difficult to avoid when using imagemagick. */ - - int w,h,x,y; - w=XFASTINT(XCAR(crop)); - h=XFASTINT(XCAR(XCDR(crop))); - x=XFASTINT(XCAR(XCDR(XCDR(crop)))); - y=XFASTINT(XCAR(XCDR(XCDR(XCDR(crop))))); - MagickCropImage(image_wand, w,h, x,y); - } - + difficult to avoid when using imagemagick. */ + + int w, h, x, y; + w = XFASTINT (XCAR (crop)); + crop = XCDR (crop); + if (CONSP (crop) && INTEGERP (XCAR (crop))) + { + h = XFASTINT (XCAR (crop)); + crop = XCDR (crop); + if (CONSP (crop) && INTEGERP (XCAR (crop))) + { + x = XFASTINT (XCAR (crop)); + crop = XCDR (crop); + if (CONSP (crop) && INTEGERP (XCAR (crop))) + { + y = XFASTINT (XCAR (crop)); + MagickCropImage (image_wand, w, h, x, y); + } + } + } + } + /* Furthermore :rotation. we need background color and angle for rotation. */ /* @@ -7599,11 +7605,11 @@ value = image_spec_value (img->spec, QCrotation, NULL); if (FLOATP (value)) { - PixelWand* background = NewPixelWand(); + PixelWand* background = NewPixelWand (); PixelSetColor (background, "#ffffff");/*TODO remove hardcode*/ - + rotation = extract_float (value); - + status = MagickRotateImage (image_wand, background, rotation); DestroyPixelWand (background); if (status == MagickFalse) @@ -7612,23 +7618,23 @@ goto imagemagick_error; } } - + /* Finaly we are done manipulating the image, figure out resulting width, height, and then transfer ownerwship to Emacs. */ height = MagickGetImageHeight (image_wand); width = MagickGetImageWidth (image_wand); if (status == MagickFalse) { - image_error ("Imagemagick image get size failed", Qnil, Qnil); + image_error ("Imagemagick image get size failed", Qnil, Qnil); goto imagemagick_error; } - + if (! check_image_size (f, width, height)) { image_error ("Invalid image size (see `max-image-size')", Qnil, Qnil); goto imagemagick_error; } - + /* We can now get a valid pixel buffer from the imagemagick file, if all went ok. */ @@ -7644,24 +7650,24 @@ image_error("Imagemagick X bitmap allocation failure", Qnil, Qnil); goto imagemagick_error; } - + /* Copy imagegmagick image to x with primitive yet robust pixel pusher loop. This has been tested a lot with many different images. */ - + /* Copy pixels from the imagemagick image structure to the x image map. */ iterator = NewPixelIterator (image_wand); - if ((iterator == (PixelIterator *) NULL)) + if (iterator == (PixelIterator *) NULL) { image_error ("Imagemagick pixel iterator creation failed", Qnil, Qnil); goto imagemagick_error; } - for (y = 0; y < (long) MagickGetImageHeight(image_wand); y++) + for (y = 0; y < (long) MagickGetImageHeight (image_wand); y++) { pixels = PixelGetNextIteratorRow (iterator, &width); - if ((pixels == (PixelWand **) NULL)) + if (pixels == (PixelWand **) NULL) break; for (x = 0; x < (long) width; x++) { @@ -7685,12 +7691,13 @@ char* exportdepth = imagedepth <= 8 ? "I" : "BGRP";/*"RGBP";*/ /* Try to create a x pixmap to hold the imagemagick pixmap. */ if (!x_create_x_image_and_pixmap (f, width, height, imagedepth, - &ximg, &img->pixmap)){ - image_error("Imagemagick X bitmap allocation failure", Qnil, Qnil); - goto imagemagick_error; - } - - + &ximg, &img->pixmap)) + { + image_error("Imagemagick X bitmap allocation failure", Qnil, Qnil); + goto imagemagick_error; + } + + /* Oddly, the below code doesnt seem to work:*/ /* switch(ximg->bitmap_unit){ */ /* case 8: */ @@ -7711,20 +7718,20 @@ seems about 3 times as fast as pixel pushing(not carefully measured) */ pixelwidth = CharPixel;/*??? TODO figure out*/ -#ifdef HAVE_MAGICKEXPORTIMAGEPIXELS - MagickExportImagePixels(image_wand, - 0, 0, - width, height, - exportdepth, - pixelwidth, - /*&(img->pixmap));*/ - ximg->data); +#ifdef HAVE_MAGICKEXPORTIMAGEPIXELS + MagickExportImagePixels (image_wand, + 0, 0, + width, height, + exportdepth, + pixelwidth, + /*&(img->pixmap));*/ + ximg->data); #else - image_error("You dont have MagickExportImagePixels, upgrade ImageMagick!", - Qnil, Qnil); -#endif - } - + image_error ("You dont have MagickExportImagePixels, upgrade ImageMagick!", + Qnil, Qnil); +#endif + } + #ifdef COLOR_TABLE_SUPPORT /* Remember colors allocated for this image. */ @@ -7770,20 +7777,14 @@ if (STRINGP (file_name)) { Lisp_Object file; - unsigned char *contents; - int size; - struct gcpro gcpro1; file = x_find_image_file (file_name); - GCPRO1 (file); if (!STRINGP (file)) { image_error ("Cannot find image file `%s'", file_name, Qnil); - UNGCPRO; return 0; } - success_p = imagemagick_load_image (f, img, 0, 0, SDATA(file_name)); - UNGCPRO; + success_p = imagemagick_load_image (f, img, 0, 0, SDATA (file)); } /* Else its not a file, its a lisp object. Load the image from a lisp object rather than a file. */ @@ -7792,6 +7793,11 @@ Lisp_Object data; data = image_spec_value (img->spec, QCdata, NULL); + if (!STRINGP (data)) + { + image_error ("Invalid image data `%s'", data, Qnil); + return 0; + } success_p = imagemagick_load_image (f, img, SDATA (data), SBYTES (data), NULL); } @@ -7823,16 +7829,16 @@ -DEFUN ("imagemagick-types", Fimagemagick_types, Simagemagick_types, 0, 0, 0, +DEFUN ("imagemagick-types", Fimagemagick_types, Simagemagick_types, 0, 0, 0, doc: /* Return image file types supported by ImageMagick. - Since ImageMagick recognizes a lot of file-types that clash with Emacs, - such as .c, we want to be able to alter the list at the lisp level. */) +Since ImageMagick recognizes a lot of file-types that clash with Emacs, +such as .c, we want to be able to alter the list at the lisp level. */) (void) { Lisp_Object typelist = Qnil; - size_t numf; + unsigned long numf; ExceptionInfo ex; - char** imtypes = GetMagickList ("*", &numf, &ex); + char **imtypes = GetMagickList ("*", &numf, &ex); int i; Lisp_Object Qimagemagicktype; for (i = 0; i < numf; i++) @@ -7842,7 +7848,7 @@ } return typelist; } - + #endif /* defined (HAVE_IMAGEMAGICK) */ @@ -8038,14 +8044,11 @@ Lisp_Object file; unsigned char *contents; int size; - struct gcpro gcpro1; file = x_find_image_file (file_name); - GCPRO1 (file); if (!STRINGP (file)) { image_error ("Cannot find image file `%s'", file_name, Qnil); - UNGCPRO; return 0; } @@ -8054,13 +8057,11 @@ if (contents == NULL) { image_error ("Error loading SVG image `%s'", img->spec, Qnil); - UNGCPRO; return 0; } /* If the file was slurped into memory properly, parse it. */ success_p = svg_load_image (f, img, contents, size); xfree (contents); - UNGCPRO; } /* Else its not a file, its a lisp object. Load the image from a lisp object rather than a file. */ @@ -8069,6 +8070,11 @@ Lisp_Object data; data = image_spec_value (img->spec, QCdata, NULL); + if (!STRINGP (data)) + { + image_error ("Invalid image data `%s'", data, Qnil); + return 0; + } success_p = svg_load_image (f, img, SDATA (data), SBYTES (data)); } @@ -8368,7 +8374,6 @@ { char buffer[100]; Lisp_Object window_and_pixmap_id = Qnil, loader, pt_height, pt_width; - struct gcpro gcpro1, gcpro2; Lisp_Object frame; double in_width, in_height; Lisp_Object pixel_colors = Qnil; @@ -8378,10 +8383,10 @@ = 1/72 in, xdpi and ydpi are stored in the frame's X display info. */ pt_width = image_spec_value (img->spec, QCpt_width, NULL); - in_width = XFASTINT (pt_width) / 72.0; + in_width = INTEGERP (pt_width) ? XFASTINT (pt_width) / 72.0 : 0; img->width = in_width * FRAME_X_DISPLAY_INFO (f)->resx; pt_height = image_spec_value (img->spec, QCpt_height, NULL); - in_height = XFASTINT (pt_height) / 72.0; + in_height = INTEGERP (pt_height) ? XFASTINT (pt_height) / 72.0 : 0; img->height = in_height * FRAME_X_DISPLAY_INFO (f)->resy; if (!check_image_size (f, img->width, img->height)) @@ -8410,8 +8415,6 @@ if successful. We do not record_unwind_protect here because other places in redisplay like calling window scroll functions don't either. Let the Lisp loader use `unwind-protect' instead. */ - GCPRO2 (window_and_pixmap_id, pixel_colors); - sprintf (buffer, "%lu %lu", (unsigned long) FRAME_X_WINDOW (f), (unsigned long) img->pixmap); @@ -8432,7 +8435,6 @@ make_number (img->height), window_and_pixmap_id, pixel_colors); - UNGCPRO; return PROCESSP (img->data.lisp_val); } @@ -8622,12 +8624,13 @@ #endif #if defined (HAVE_IMAGEMAGICK) - if (EQ (type, Qimagemagick)){ - /* MagickWandGenesis() initalizes the imagemagick library. */ - MagickWandGenesis(); - return CHECK_LIB_AVAILABLE (&imagemagick_type, init_imagemagick_functions, - libraries); - } + if (EQ (type, Qimagemagick)) + { + /* MagickWandGenesis() initalizes the imagemagick library. */ + MagickWandGenesis (); + return CHECK_LIB_AVAILABLE (&imagemagick_type, init_imagemagick_functions, + libraries); + } #endif #ifdef HAVE_GHOSTSCRIPT @@ -8786,7 +8789,7 @@ staticpro (&Qimagemagick); ADD_IMAGE_TYPE (Qimagemagick); #endif - + #if defined (HAVE_RSVG) Qsvg = intern_c_string ("svg"); staticpro (&Qsvg); @@ -8803,9 +8806,9 @@ #endif /* HAVE_RSVG */ defsubr (&Sinit_image_library); -#ifdef HAVE_IMAGEMAGICK +#ifdef HAVE_IMAGEMAGICK defsubr (&Simagemagick_types); -#endif +#endif defsubr (&Sclear_image_cache); defsubr (&Simage_flush); defsubr (&Simage_size); @@ -8836,10 +8839,10 @@ The function `clear-image-cache' disregards this variable. */); Vimage_cache_eviction_delay = make_number (300); -#ifdef HAVE_IMAGEMAGICK +#ifdef HAVE_IMAGEMAGICK DEFVAR_LISP ("imagemagick-render-type", &Vimagemagick_render_type, doc: /* Choose between ImageMagick render methods. */); -#endif +#endif }
--- a/src/nsimage.m Thu Sep 02 11:00:18 2010 +0900 +++ b/src/nsimage.m Wed Sep 08 13:08:19 2010 +0900 @@ -83,19 +83,21 @@ ns_load_image (struct frame *f, struct image *img, Lisp_Object spec_file, Lisp_Object spec_data) { - EmacsImage *eImg; + EmacsImage *eImg = nil; NSSize size; NSTRACE (ns_load_image); - if (NILP (spec_data)) + if (STRINGP (spec_file)) { eImg = [EmacsImage allocInitFromFile: spec_file]; } - else + else if (STRINGP (spec_data)) { - NSData *data = [NSData dataWithBytes: SDATA (spec_data) - length: SBYTES (spec_data)]; + NSData *data; + + data = [NSData dataWithBytes: SDATA (spec_data) + length: SBYTES (spec_data)]; eImg = [[EmacsImage alloc] initWithData: data]; [eImg setPixmapData]; }
--- a/src/w32uniscribe.c Thu Sep 02 11:00:18 2010 +0900 +++ b/src/w32uniscribe.c Wed Sep 08 13:08:19 2010 +0900 @@ -180,17 +180,18 @@ /* Uniscribe implementation of shape for font backend. - Shape text in LGSTRING. See the docstring of `font-make-gstring' - for the format of LGSTRING. If the (N+1)th element of LGSTRING - is nil, input of shaping is from the 1st to (N)th elements. In - each input glyph, FROM, TO, CHAR, and CODE are already set. + Shape text in LGSTRING. See the docstring of + `composition-get-gstring' for the format of LGSTRING. If the + (N+1)th element of LGSTRING is nil, input of shaping is from the + 1st to (N)th elements. In each input glyph, FROM, TO, CHAR, and + CODE are already set. This function updates all fields of the input glyphs. If the output glyphs (M) are more than the input glyphs (N), (N+1)th through (M)th elements of LGSTRING are updated possibly by making a new glyph object and storing it in LGSTRING. If (M) is greater - than the length of LGSTRING, nil should be return. In that case, - this function is called again with the larger LGSTRING. */ + than the length of LGSTRING, nil should be returned. In that case, + this function is called again with a larger LGSTRING. */ static Lisp_Object uniscribe_shape (Lisp_Object lgstring) { @@ -217,6 +218,9 @@ max_glyphs = nchars = LGSTRING_GLYPH_LEN (lgstring); done_glyphs = 0; chars = (wchar_t *) alloca (nchars * sizeof (wchar_t)); + /* FIXME: This loop assumes that characters in the input LGSTRING + are all inside the BMP. Need to encode characters beyond the BMP + as UTF-16. */ for (i = 0; i < nchars; i++) { /* lgstring can be bigger than the number of characters in it, in @@ -248,9 +252,6 @@ return Qnil; } - /* TODO: When we get BIDI support, we need to call ScriptLayout here. - Requires that we know the surrounding context. */ - glyphs = alloca (max_glyphs * sizeof (WORD)); clusters = alloca (nchars * sizeof (WORD)); attributes = alloca (max_glyphs * sizeof (SCRIPT_VISATTR)); @@ -259,8 +260,12 @@ for (i = 0; i < nitems; i++) { - int nglyphs, nchars_in_run, rtl = items[i].a.fRTL ? -1 : 1; + int nglyphs, nchars_in_run; nchars_in_run = items[i+1].iCharPos - items[i].iCharPos; + /* Force ScriptShape to generate glyphs in the same order as + they are in the input LGSTRING, which is in the logical + order. */ + items[i].a.fLogicalOrder = 1; /* Context may be NULL here, in which case the cache should be used without needing to select the font. */ @@ -321,7 +326,7 @@ { int j, nclusters, from, to; - from = rtl > 0 ? 0 : nchars_in_run - 1; + from = 0; to = from; for (j = 0; j < nglyphs; j++) @@ -342,22 +347,19 @@ gl = glyphs[j]; LGLYPH_SET_CODE (lglyph, gl); - /* Detect clusters, for linking codes back to characters. */ + /* Detect clusters, for linking codes back to + characters. */ if (attributes[j].fClusterStart) { - while (from >= 0 && from < nchars_in_run - && clusters[from] < j) - from += rtl; - if (from < 0) - from = to = 0; - else if (from >= nchars_in_run) + while (from < nchars_in_run && clusters[from] < j) + from++; + if (from >= nchars_in_run) from = to = nchars_in_run - 1; else { int k; - to = rtl > 0 ? nchars_in_run - 1 : 0; - for (k = from + rtl; k >= 0 && k < nchars_in_run; - k += rtl) + to = nchars_in_run - 1; + for (k = from + 1; k < nchars_in_run; k++) { if (clusters[k] > j) { @@ -486,6 +488,10 @@ SCRIPT_VISATTR attrs[2]; int nglyphs; + /* Force ScriptShape to generate glyphs in the logical + order. */ + items[0].a.fLogicalOrder = 1; + result = ScriptShape (context, &(uniscribe_font->cache), ch, len, 2, &(items[0].a), glyphs, clusters, attrs, &nglyphs);
--- a/src/xselect.c Thu Sep 02 11:00:18 2010 +0900 +++ b/src/xselect.c Wed Sep 08 13:08:19 2010 +0900 @@ -83,8 +83,6 @@ unsigned char **, Atom *, unsigned *, int *, int *); static Lisp_Object clean_local_selection_data (Lisp_Object); -static void initialize_cut_buffers (Display *, Window); - /* Printing traces to stderr. */ @@ -105,8 +103,6 @@ #endif -#define CUT_BUFFER_SUPPORT - Lisp_Object QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP, QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL, QATOM_PAIR; @@ -116,11 +112,6 @@ Lisp_Object Qcompound_text_with_extensions; -#ifdef CUT_BUFFER_SUPPORT -Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3, - QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7; -#endif - static Lisp_Object Vx_lost_selection_functions; static Lisp_Object Vx_sent_selection_functions; static Lisp_Object Qforeign_selection; @@ -270,16 +261,6 @@ if (EQ (sym, QEMACS_TMP)) return dpyinfo->Xatom_EMACS_TMP; if (EQ (sym, QTARGETS)) return dpyinfo->Xatom_TARGETS; if (EQ (sym, QNULL)) return dpyinfo->Xatom_NULL; -#ifdef CUT_BUFFER_SUPPORT - if (EQ (sym, QCUT_BUFFER0)) return XA_CUT_BUFFER0; - if (EQ (sym, QCUT_BUFFER1)) return XA_CUT_BUFFER1; - if (EQ (sym, QCUT_BUFFER2)) return XA_CUT_BUFFER2; - if (EQ (sym, QCUT_BUFFER3)) return XA_CUT_BUFFER3; - if (EQ (sym, QCUT_BUFFER4)) return XA_CUT_BUFFER4; - if (EQ (sym, QCUT_BUFFER5)) return XA_CUT_BUFFER5; - if (EQ (sym, QCUT_BUFFER6)) return XA_CUT_BUFFER6; - if (EQ (sym, QCUT_BUFFER7)) return XA_CUT_BUFFER7; -#endif if (!SYMBOLP (sym)) abort (); TRACE1 (" XInternAtom %s", (char *) SDATA (SYMBOL_NAME (sym))); @@ -315,24 +296,6 @@ return QINTEGER; case XA_ATOM: return QATOM; -#ifdef CUT_BUFFER_SUPPORT - case XA_CUT_BUFFER0: - return QCUT_BUFFER0; - case XA_CUT_BUFFER1: - return QCUT_BUFFER1; - case XA_CUT_BUFFER2: - return QCUT_BUFFER2; - case XA_CUT_BUFFER3: - return QCUT_BUFFER3; - case XA_CUT_BUFFER4: - return QCUT_BUFFER4; - case XA_CUT_BUFFER5: - return QCUT_BUFFER5; - case XA_CUT_BUFFER6: - return QCUT_BUFFER6; - case XA_CUT_BUFFER7: - return QCUT_BUFFER7; -#endif } dpyinfo = x_display_info_for_display (dpy); @@ -2258,195 +2221,6 @@ } -#ifdef CUT_BUFFER_SUPPORT - -/* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */ -static void -initialize_cut_buffers (Display *display, Window window) -{ - unsigned char *data = (unsigned char *) ""; - BLOCK_INPUT; -#define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \ - PropModeAppend, data, 0) - FROB (XA_CUT_BUFFER0); - FROB (XA_CUT_BUFFER1); - FROB (XA_CUT_BUFFER2); - FROB (XA_CUT_BUFFER3); - FROB (XA_CUT_BUFFER4); - FROB (XA_CUT_BUFFER5); - FROB (XA_CUT_BUFFER6); - FROB (XA_CUT_BUFFER7); -#undef FROB - UNBLOCK_INPUT; -} - - -#define CHECK_CUT_BUFFER(symbol) \ - do { CHECK_SYMBOL ((symbol)); \ - if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \ - && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \ - && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \ - && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \ - signal_error ("Doesn't name a cut buffer", (symbol)); \ - } while (0) - -DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal, - Sx_get_cut_buffer_internal, 1, 1, 0, - doc: /* Returns the value of the named cut buffer (typically CUT_BUFFER0). */) - (Lisp_Object buffer) -{ - Window window; - Atom buffer_atom; - unsigned char *data = NULL; - int bytes; - Atom type; - int format; - unsigned long size; - Lisp_Object ret; - Display *display; - struct x_display_info *dpyinfo; - struct frame *sf = SELECTED_FRAME (); - - check_x (); - - if (! FRAME_X_P (sf)) - return Qnil; - - display = FRAME_X_DISPLAY (sf); - dpyinfo = FRAME_X_DISPLAY_INFO (sf); - window = RootWindow (display, 0); /* Cut buffers are on screen 0 */ - CHECK_CUT_BUFFER (buffer); - buffer_atom = symbol_to_x_atom (dpyinfo, display, buffer); - - x_get_window_property (display, window, buffer_atom, &data, &bytes, - &type, &format, &size, 0); - - if (!data || !format) - { - xfree (data); - return Qnil; - } - - if (format != 8 || type != XA_STRING) - signal_error ("Cut buffer doesn't contain 8-bit data", - list2 (x_atom_to_symbol (display, type), - make_number (format))); - - ret = (bytes ? make_unibyte_string ((char *) data, bytes) : Qnil); - /* Use xfree, not XFree, because x_get_window_property - calls xmalloc itself. */ - xfree (data); - return ret; -} - - -DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal, - Sx_store_cut_buffer_internal, 2, 2, 0, - doc: /* Sets the value of the named cut buffer (typically CUT_BUFFER0). */) - (Lisp_Object buffer, Lisp_Object string) -{ - Window window; - Atom buffer_atom; - unsigned char *data; - int bytes; - int bytes_remaining; - int max_bytes; - Display *display; - struct frame *sf = SELECTED_FRAME (); - - check_x (); - - if (! FRAME_X_P (sf)) - return Qnil; - - display = FRAME_X_DISPLAY (sf); - window = RootWindow (display, 0); /* Cut buffers are on screen 0 */ - - max_bytes = SELECTION_QUANTUM (display); - if (max_bytes > MAX_SELECTION_QUANTUM) - max_bytes = MAX_SELECTION_QUANTUM; - - CHECK_CUT_BUFFER (buffer); - CHECK_STRING (string); - buffer_atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf), - display, buffer); - data = (unsigned char *) SDATA (string); - bytes = SBYTES (string); - bytes_remaining = bytes; - - if (! FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized) - { - initialize_cut_buffers (display, window); - FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized = 1; - } - - BLOCK_INPUT; - - /* Don't mess up with an empty value. */ - if (!bytes_remaining) - XChangeProperty (display, window, buffer_atom, XA_STRING, 8, - PropModeReplace, data, 0); - - while (bytes_remaining) - { - int chunk = (bytes_remaining < max_bytes - ? bytes_remaining : max_bytes); - XChangeProperty (display, window, buffer_atom, XA_STRING, 8, - (bytes_remaining == bytes - ? PropModeReplace - : PropModeAppend), - data, chunk); - data += chunk; - bytes_remaining -= chunk; - } - UNBLOCK_INPUT; - return string; -} - - -DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal, - Sx_rotate_cut_buffers_internal, 1, 1, 0, - doc: /* Rotate the values of the cut buffers by N steps. -Positive N means shift the values forward, negative means backward. */) - (Lisp_Object n) -{ - Window window; - Atom props[8]; - Display *display; - struct frame *sf = SELECTED_FRAME (); - - check_x (); - - if (! FRAME_X_P (sf)) - return Qnil; - - display = FRAME_X_DISPLAY (sf); - window = RootWindow (display, 0); /* Cut buffers are on screen 0 */ - CHECK_NUMBER (n); - if (XINT (n) == 0) - return n; - if (! FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized) - { - initialize_cut_buffers (display, window); - FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized = 1; - } - - props[0] = XA_CUT_BUFFER0; - props[1] = XA_CUT_BUFFER1; - props[2] = XA_CUT_BUFFER2; - props[3] = XA_CUT_BUFFER3; - props[4] = XA_CUT_BUFFER4; - props[5] = XA_CUT_BUFFER5; - props[6] = XA_CUT_BUFFER6; - props[7] = XA_CUT_BUFFER7; - BLOCK_INPUT; - XRotateWindowProperties (display, window, props, 8, XINT (n)); - UNBLOCK_INPUT; - return n; -} - -#endif - /*********************************************************************** Drag and drop support ***********************************************************************/ @@ -2850,12 +2624,6 @@ defsubr (&Sx_selection_owner_p); defsubr (&Sx_selection_exists_p); -#ifdef CUT_BUFFER_SUPPORT - defsubr (&Sx_get_cut_buffer_internal); - defsubr (&Sx_store_cut_buffer_internal); - defsubr (&Sx_rotate_cut_buffers_internal); -#endif - defsubr (&Sx_get_atom_name); defsubr (&Sx_send_client_message); defsubr (&Sx_register_dnd_atom); @@ -2937,17 +2705,6 @@ Qcompound_text_with_extensions = intern_c_string ("compound-text-with-extensions"); staticpro (&Qcompound_text_with_extensions); -#ifdef CUT_BUFFER_SUPPORT - QCUT_BUFFER0 = intern_c_string ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0); - QCUT_BUFFER1 = intern_c_string ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1); - QCUT_BUFFER2 = intern_c_string ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2); - QCUT_BUFFER3 = intern_c_string ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3); - QCUT_BUFFER4 = intern_c_string ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4); - QCUT_BUFFER5 = intern_c_string ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5); - QCUT_BUFFER6 = intern_c_string ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6); - QCUT_BUFFER7 = intern_c_string ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7); -#endif - Qforeign_selection = intern_c_string ("foreign-selection"); staticpro (&Qforeign_selection); }
--- a/src/xterm.c Thu Sep 02 11:00:18 2010 +0900 +++ b/src/xterm.c Wed Sep 08 13:08:19 2010 +0900 @@ -10124,8 +10124,6 @@ dpyinfo->Xatom_net_wm_name = XInternAtom (dpyinfo->display, "_NET_WM_NAME", False); - dpyinfo->cut_buffers_initialized = 0; - dpyinfo->x_dnd_atoms_size = 8; dpyinfo->x_dnd_atoms_length = 0; dpyinfo->x_dnd_atoms = xmalloc (sizeof (*dpyinfo->x_dnd_atoms)
--- a/src/xterm.h Thu Sep 02 11:00:18 2010 +0900 +++ b/src/xterm.h Wed Sep 08 13:08:19 2010 +0900 @@ -299,8 +299,6 @@ /* Atom used in XEmbed client messages. */ Atom Xatom_XEMBED; - int cut_buffers_initialized; /* Whether we're sure they all exist */ - /* The frame (if any) which has the X window that has keyboard focus. Zero if none. This is examined by Ffocus_frame in xfns.c. Note that a mere EnterNotify event can set this; if you need to know the