Using saved parent location: http://bzr.savannah.gnu.org/r/emacs/trunk/ Now on revision 101353. ------------------------------------------------------------ revno: 101353 committer: Katsumi Yamaoka branch nick: trunk timestamp: Sun 2010-09-05 04:09:07 +0000 message: (nnmh-request-list-1): Bind `file'. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-09-05 04:01:41 +0000 +++ lisp/gnus/ChangeLog 2010-09-05 04:09:07 +0000 @@ -1,5 +1,7 @@ 2010-09-05 Katsumi Yamaoka + * 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. === modified file 'lisp/gnus/nnmh.el' --- lisp/gnus/nnmh.el 2010-09-05 00:44:53 +0000 +++ lisp/gnus/nnmh.el 2010-09-05 04:09:07 +0000 @@ -209,7 +209,7 @@ ;; Recurse down all directories. (let ((files (nnheader-directory-files dir t nil t)) (max 0) - min rdir num subdirectoriesp) + min rdir num subdirectoriesp file) ;; Recurse down directories. (setq subdirectoriesp (> (nth 1 (file-attributes dir)) 2)) (dolist (rdir files) ------------------------------------------------------------ revno: 101352 committer: Katsumi Yamaoka branch nick: trunk timestamp: Sun 2010-09-05 04:01:41 +0000 message: 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 for XEmacs and old Emacsen. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-09-05 01:27:15 +0000 +++ lisp/gnus/ChangeLog 2010-09-05 04:01:41 +0000 @@ -1,3 +1,9 @@ +2010-09-05 Katsumi Yamaoka + + * 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 * mail-source.el (mail-source-delete-crash-box): Always move the crash === modified file 'lisp/gnus/pop3.el' --- lisp/gnus/pop3.el 2010-09-05 01:18:05 +0000 +++ lisp/gnus/pop3.el 2010-09-05 04:01:41 +0000 @@ -301,6 +301,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." @@ -361,7 +368,7 @@ (setq pop3-timestamp (substring response (or (string-match "<" response) 0) (+ 1 (or (string-match ">" response) -1))))) - (set-process-query-on-exit-flag process nil) + (pop3-set-process-query-on-exit-flag process nil) process))) ;; Support functions ------------------------------------------------------------ revno: 101351 committer: Juanma Barranquero branch nick: trunk timestamp: Sun 2010-09-05 04:06:39 +0200 message: Update to latest Unicode 6.0 beta data files. * admin/unidata/BidiMirroring.txt: Update from http://www.unicode.org/Public/6.0.0/ucd/BidiMirroring-6.0.0d2.txt * admin/unidata/UnicodeData.txt: Update from http://www.unicode.org/Public/6.0.0/ucd/UnicodeData-6.0.0d7.txt * lisp/international/uni-bidi.el: * lisp/international/uni-category.el: * lisp/international/uni-combining.el: * lisp/international/uni-decimal.el: * lisp/international/uni-mirrored.el: * lisp/international/uni-name.el: Regenerate. * src/biditype.h: Regenerate. diff: === modified file 'admin/ChangeLog' --- admin/ChangeLog 2010-08-09 19:25:41 +0000 +++ admin/ChangeLog 2010-09-05 02:06:39 +0000 @@ -1,3 +1,11 @@ +2010-09-05 Juanma Barranquero + + * 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 * CPP-DEFINES (WORDS_BIG_ENDIAN): Remove. === modified file 'admin/unidata/BidiMirroring.txt' --- admin/unidata/BidiMirroring.txt 2010-06-12 15:52:43 +0000 +++ admin/unidata/BidiMirroring.txt 2010-09-05 02:06:39 +0000 @@ -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 === modified file 'admin/unidata/UnicodeData.txt' --- admin/unidata/UnicodeData.txt 2010-06-09 15:46:41 +0000 +++ admin/unidata/UnicodeData.txt 2010-09-05 02:06:39 +0000 @@ -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; 004E;;;;N;DOUBLE-STRUCK N;;;; 2116;NUMERO SIGN;So;0;ON; 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; 0050;;;;N;DOUBLE-STRUCK P;;;; 211A;DOUBLE-STRUCK CAPITAL Q;Lu;0;L; 0051;;;;N;DOUBLE-STRUCK Q;;;; 211B;SCRIPT CAPITAL R;Lu;0;L; 0052;;;;N;SCRIPT R;;;; === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-09-04 22:54:58 +0000 +++ lisp/ChangeLog 2010-09-05 02:06:39 +0000 @@ -1,3 +1,12 @@ +2010-09-05 Juanma Barranquero + + * 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 * electric.el (electric-indent-post-self-insert-function): @@ -696,7 +705,7 @@ * mouse.el (mouse-yank-primary): Avoid setting primary when deactivating the mark (Bug#6872). -2010-08-23 Chris Foote (tiny change) +2010-08-23 Chris Foote (tiny change) * progmodes/python.el (python-block-pairs): Allow use of "finally" with "else" (Bug#3991). @@ -1205,7 +1214,7 @@ * align.el (align-default-spacing): Doc fix. (align-region-heuristic, align-regexp): Fix typos in docstrings. -2010-08-08 Stephen Peters +2010-08-08 Stephen Peters * calendar/icalendar.el (icalendar--split-value): Fixed splitting regexp. (Bug#6766) === modified file 'lisp/international/uni-bidi.el' Binary files lisp/international/uni-bidi.el 2010-06-09 15:46:41 +0000 and lisp/international/uni-bidi.el 2010-09-05 02:06:39 +0000 differ === modified file 'lisp/international/uni-category.el' Binary files lisp/international/uni-category.el 2010-06-09 15:46:41 +0000 and lisp/international/uni-category.el 2010-09-05 02:06:39 +0000 differ === modified file 'lisp/international/uni-combining.el' Binary files lisp/international/uni-combining.el 2010-06-09 15:46:41 +0000 and lisp/international/uni-combining.el 2010-09-05 02:06:39 +0000 differ === modified file 'lisp/international/uni-decimal.el' Binary files lisp/international/uni-decimal.el 2010-06-09 15:46:41 +0000 and lisp/international/uni-decimal.el 2010-09-05 02:06:39 +0000 differ === modified file 'lisp/international/uni-mirrored.el' Binary files lisp/international/uni-mirrored.el 2010-06-09 15:46:41 +0000 and lisp/international/uni-mirrored.el 2010-09-05 02:06:39 +0000 differ === modified file 'lisp/international/uni-name.el' Binary files lisp/international/uni-name.el 2010-06-09 15:46:41 +0000 and lisp/international/uni-name.el 2010-09-05 02:06:39 +0000 differ === modified file 'src/ChangeLog' --- src/ChangeLog 2010-09-04 19:39:34 +0000 +++ src/ChangeLog 2010-09-05 02:06:39 +0000 @@ -1,3 +1,7 @@ +2010-09-05 Juanma Barranquero + + * biditype.h: Regenerate. + 2010-09-04 Andreas Schwab * nsimage.m (ns_load_image): Check argument types. === modified file 'src/biditype.h' --- src/biditype.h 2010-06-12 15:52:43 +0000 +++ src/biditype.h 2010-09-05 02:06:39 +0000 @@ -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 }, ------------------------------------------------------------ revno: 101350 author: Lars Magne Ingebrigtsen committer: Katsumi Yamaoka branch nick: trunk timestamp: Sun 2010-09-05 01:31:15 +0000 message: gnus-int.el (gnus-request-group): Indent. diff: === modified file 'lisp/gnus/gnus-int.el' --- lisp/gnus/gnus-int.el 2010-09-05 00:34:16 +0000 +++ lisp/gnus/gnus-int.el 2010-09-05 01:31:15 +0000 @@ -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))) ------------------------------------------------------------ revno: 101349 author: Lars Magne Ingebrigtsen committer: Katsumi Yamaoka branch nick: trunk timestamp: Sun 2010-09-05 01:27:15 +0000 message: mail-source.el (mail-source-delete-crash-box): Always move the crash box to the Incoming file. Fixes mistake in previous checkin; Do incremental NOV updates when scanning new male. (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. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-09-05 01:18:05 +0000 +++ lisp/gnus/ChangeLog 2010-09-05 01:27:15 +0000 @@ -1,7 +1,17 @@ 2010-09-04 Lars Magne Ingebrigtsen + * 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. === modified file 'lisp/gnus/mail-source.el' --- lisp/gnus/mail-source.el 2010-09-05 01:18:05 +0000 +++ lisp/gnus/mail-source.el 2010-09-05 01:27:15 +0000 @@ -631,23 +631,23 @@ ;; Delete or move the incoming mail out of the way. (if (eq mail-source-delete-incoming t) (delete-file mail-source-crash-box) - ;; 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)) - (let ((incoming - (mm-make-temp-file - (expand-file-name - mail-source-incoming-file-prefix - mail-source-directory)))) - (unless (file-exists-p (file-name-directory incoming)) - (make-directory (file-name-directory incoming) t)) - (rename-file mail-source-crash-box incoming t) - ;; remove old incoming files? - (when (natnump mail-source-delete-incoming) + (let ((incoming + (mm-make-temp-file + (expand-file-name + mail-source-incoming-file-prefix + mail-source-directory)))) + (unless (file-exists-p (file-name-directory incoming)) + (make-directory (file-name-directory incoming) t)) + (rename-file mail-source-crash-box incoming t) + ;; remove old incoming files? + (when (natnump mail-source-delete-incoming) + ;; 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))))))) === modified file 'lisp/gnus/nnml.el' --- lisp/gnus/nnml.el 2010-09-05 01:18:05 +0000 +++ lisp/gnus/nnml.el 2010-09-05 01:27:15 +0000 @@ -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,37 @@ (setcdr active (1+ (cdr active)))) (cdr active))) +(defvar nnml-incremental-nov-buffer-alist nil) + +(defun nnml-save-incremental-nov () + (message "nnml saving 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)))) + (message "nnml saving incremental nov...done")) + +(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 +838,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)) ------------------------------------------------------------ revno: 101348 author: Lars Magne Ingebrigtsen committer: Katsumi Yamaoka branch nick: trunk timestamp: Sun 2010-09-05 01:18:05 +0000 message: pop3.el (pop3-write-to-file): Don't output messages when saving; mail-source.el (mail-source-delete-crash-box): Really only check the incoming files once in a while; nnml.el (nnml-save-nov): Message around nnml-save-nov so that the culprit is more visible; pop3.el (pop3-send-streaming-command): Off-by-one error on the request loop (for debugging purposes) removed. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-09-05 01:12:51 +0000 +++ lisp/gnus/ChangeLog 2010-09-05 01:18:05 +0000 @@ -1,5 +1,11 @@ 2010-09-04 Lars Magne Ingebrigtsen + * nnml.el (nnml-save-nov): Message around nnml-save-nov so that the + culprit is more visible. + + * 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 === modified file 'lisp/gnus/mail-source.el' --- lisp/gnus/mail-source.el 2010-09-05 01:08:22 +0000 +++ lisp/gnus/mail-source.el 2010-09-05 01:18:05 +0000 @@ -637,20 +637,20 @@ (> (time-to-seconds (time-since mail-source-incoming-last-checked-time)) (* 24 60 60))) - (setq mail-source-incoming-last-checked-time (current-time))) - (let ((incoming - (mm-make-temp-file - (expand-file-name - mail-source-incoming-file-prefix - mail-source-directory)))) - (unless (file-exists-p (file-name-directory incoming)) - (make-directory (file-name-directory incoming) t)) - (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)))))) + (setq mail-source-incoming-last-checked-time (current-time)) + (let ((incoming + (mm-make-temp-file + (expand-file-name + mail-source-incoming-file-prefix + mail-source-directory)))) + (unless (file-exists-p (file-name-directory incoming)) + (make-directory (file-name-directory incoming) t)) + (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))))))) (defun mail-source-movemail (from to) "Move FROM to TO using movemail." === modified file 'lisp/gnus/nnml.el' --- lisp/gnus/nnml.el 2010-09-02 00:55:51 +0000 +++ lisp/gnus/nnml.el 2010-09-05 01:18:05 +0000 @@ -824,6 +824,7 @@ buffer))) (defun nnml-save-nov () + (message "nnml saving nov...") (save-excursion (while nnml-nov-buffer-alist (when (buffer-name (cdar nnml-nov-buffer-alist)) @@ -833,7 +834,8 @@ nnml-nov-buffer-file-name nil 'nomesg)) (set-buffer-modified-p nil) (kill-buffer (current-buffer))) - (setq nnml-nov-buffer-alist (cdr nnml-nov-buffer-alist))))) + (setq nnml-nov-buffer-alist (cdr nnml-nov-buffer-alist)))) + (message "nnml saving nov...done")) ;;;###autoload (defun nnml-generate-nov-databases (&optional server) === modified file 'lisp/gnus/pop3.el' --- lisp/gnus/pop3.el 2010-09-05 01:12:51 +0000 +++ lisp/gnus/pop3.el 2010-09-05 01:18:05 +0000 @@ -150,7 +150,7 @@ (defun pop3-send-streaming-command (process command count total-size) (erase-buffer) (let ((i 1)) - (while (>= (1+ count) i) + (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)) @@ -197,7 +197,7 @@ ;; delete it. (when (eolp) (delete-char 1)) - (write-region (point-min) (point-max) file))))) + (write-region (point-min) (point-max) file nil 'nomesg))))) (defun pop3-number-of-responses (endp) (let ((responses 0)) ------------------------------------------------------------ revno: 101347 author: Lars Magne Ingebrigtsen committer: Katsumi Yamaoka branch nick: trunk timestamp: Sun 2010-09-05 01:12:51 +0000 message: pop3.el (pop3-streaming-movemail): Always close the pop3 connection. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-09-05 01:08:22 +0000 +++ lisp/gnus/ChangeLog 2010-09-05 01:12:51 +0000 @@ -1,5 +1,7 @@ 2010-09-04 Lars Magne Ingebrigtsen + * 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. === modified file 'lisp/gnus/pop3.el' --- lisp/gnus/pop3.el 2010-09-05 01:08:22 +0000 +++ lisp/gnus/pop3.el 2010-09-05 01:12:51 +0000 @@ -144,8 +144,8 @@ (pop3-write-to-file file) (unless pop3-leave-mail-on-server (pop3-send-streaming-command - process "DELE" message-count nil)) - (pop3-quit process))))) + process "DELE" message-count nil)))) + (pop3-quit process))) (defun pop3-send-streaming-command (process command count total-size) (erase-buffer) ------------------------------------------------------------ revno: 101346 author: Lars Magne Ingebrigtsen committer: Katsumi Yamaoka branch nick: trunk timestamp: Sun 2010-09-05 01:08:22 +0000 message: gnus-start.el: White space clean up; mail-source.el (mail-source-fetch-pop): Use streaming pop3 retrieval; pop3.el (pop3-streaming-movemail): Respect pop3-leave-mail-on-server; pop3.el (pop3-logon): Fix up unbound variable typo; 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. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-09-05 00:56:31 +0000 +++ lisp/gnus/ChangeLog 2010-09-05 01:08:22 +0000 @@ -1,5 +1,25 @@ 2010-09-04 Lars Magne Ingebrigtsen + * 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 === modified file 'lisp/gnus/gnus-start.el' --- lisp/gnus/gnus-start.el 2010-09-05 00:56:31 +0000 +++ lisp/gnus/gnus-start.el 2010-09-05 01:08:22 +0000 @@ -3184,5 +3184,3 @@ (provide 'gnus-start) ;;; gnus-start.el ends here - - === modified file 'lisp/gnus/mail-source.el' --- lisp/gnus/mail-source.el 2010-09-05 00:34:16 +0000 +++ lisp/gnus/mail-source.el 2010-09-05 01:08:22 +0000 @@ -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) @@ -624,11 +624,20 @@ 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. (if (eq mail-source-delete-incoming t) (delete-file mail-source-crash-box) + ;; 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))) (let ((incoming (mm-make-temp-file (expand-file-name @@ -825,9 +834,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. === modified file 'lisp/gnus/pop3.el' --- lisp/gnus/pop3.el 2010-09-05 00:52:55 +0000 +++ lisp/gnus/pop3.el 2010-09-05 01:08:22 +0000 @@ -128,6 +128,103 @@ (truncate pop3-read-timeout)) 1000)))))) +(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)) + 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))))) + +(defun pop3-send-streaming-command (process command count total-size) + (erase-buffer) + (let ((i 1)) + (while (>= (1+ 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))))) + +(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 + (if (and pop3-password-required (not pop3-password)) + (setq pop3-password + (read-passwd (format "Password for %s: " pop3-maildrop)))) + (cond ((equal 'apop pop3-authentication-scheme) + (pop3-apop process pop3-maildrop)) + ((equal 'pass pop3-authentication-scheme) + (pop3-user process pop3-maildrop) + (pop3-pass process)) + (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"))) @@ -135,23 +232,10 @@ (crashbuf (get-buffer-create " *pop3-retr*")) (n 1) message-count - message-sizes - (pop3-password pop3-password)) - ;; for debugging only - (if pop3-debug (switch-to-buffer (process-buffer process))) - ;; query for password - (if (and pop3-password-required (not pop3-password)) - (setq pop3-password - (read-passwd (format "Password for %s: " pop3-maildrop)))) - (cond ((equal 'apop pop3-authentication-scheme) - (pop3-apop process pop3-maildrop)) - ((equal 'pass pop3-authentication-scheme) - (pop3-user process pop3-maildrop) - (pop3-pass process)) - (t (error "Invalid POP3 authentication scheme"))) + 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) @@ -277,16 +361,11 @@ (setq pop3-timestamp (substring response (or (string-match "<" response) 0) (+ 1 (or (string-match ">" response) -1))))) + (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)) @@ -403,10 +482,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))) ))))) ------------------------------------------------------------ revno: 101345 author: Lars Magne Ingebrigtsen committer: Katsumi Yamaoka branch nick: trunk timestamp: Sun 2010-09-05 00:56:31 +0000 message: gnus-start.el (gnus-make-hashtable-from-newsrc-alist): Remove duplicates from .newsrc list. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-09-05 00:52:55 +0000 +++ lisp/gnus/ChangeLog 2010-09-05 00:56:31 +0000 @@ -2,6 +2,8 @@ * 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. === modified file 'lisp/gnus/gnus-start.el' --- lisp/gnus/gnus-start.el 2010-09-05 00:52:55 +0000 +++ lisp/gnus/gnus-start.el 2010-09-05 00:56:31 +0000 @@ -1815,14 +1815,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 ------------------------------------------------------------ revno: 101344 author: Lars Magne Ingebrigtsen committer: Katsumi Yamaoka branch nick: trunk timestamp: Sun 2010-09-05 00:52:55 +0000 message: pop3.el (pop3-movemail): Use erase-buffer instead of looping and deleting regions, which seems rather odd; gnus-start.el (gnus-get-unread-articles): Protect against groups that come from no known methods. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-09-05 00:49:07 +0000 +++ lisp/gnus/ChangeLog 2010-09-05 00:52:55 +0000 @@ -1,7 +1,12 @@ 2010-09-04 Lars Magne Ingebrigtsen + * gnus-start.el (gnus-get-unread-articles): Protect against groups that + come from no known methods. + * 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. === modified file 'lisp/gnus/gnus-start.el' --- lisp/gnus/gnus-start.el 2010-09-05 00:44:53 +0000 +++ lisp/gnus/gnus-start.el 2010-09-05 00:52:55 +0000 @@ -1747,18 +1747,19 @@ infos (nth 2 (car type-cache))) (pop type-cache) - ;; See if any of the groups from this method require updating. - (when (block nil - (dolist (info infos) - (when (<= (gnus-info-level info) - (if (eq method-type 'foreign) - foreign-level - alevel)) - (return t)))) - (gnus-read-active-for-groups method infos) - (dolist (info infos) - (inline (gnus-get-unread-articles-in-group - info (gnus-active (gnus-info-group info))))))) + (when method + ;; See if any of the groups from this method require updating. + (when (block nil + (dolist (info infos) + (when (<= (gnus-info-level info) + (if (eq method-type 'foreign) + foreign-level + alevel)) + (return t)))) + (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"))) (defun gnus-method-rank (type method) === modified file 'lisp/gnus/pop3.el' --- lisp/gnus/pop3.el 2010-09-05 00:49:07 +0000 +++ lisp/gnus/pop3.el 2010-09-05 00:52:55 +0000 @@ -165,10 +165,7 @@ (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)) ------------------------------------------------------------ revno: 101343 author: Lars Magne Ingebrigtsen committer: Katsumi Yamaoka branch nick: trunk timestamp: Sun 2010-09-05 00:49:07 +0000 message: (pop3-display-message-size-flag): Removed -- everybody wants message sizes. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-09-05 00:44:53 +0000 +++ lisp/gnus/ChangeLog 2010-09-05 00:49:07 +0000 @@ -1,5 +1,8 @@ 2010-09-04 Lars Magne Ingebrigtsen + * pop3.el (pop3-display-message-size-flag): Removed -- everybody wants + message sizes. + * gnus-agent.el (gnus-agent-load-local): Only read the agent.lib/local file once per `g' run. === modified file 'lisp/gnus/pop3.el' --- lisp/gnus/pop3.el 2010-09-02 01:42:32 +0000 +++ lisp/gnus/pop3.el 2010-09-05 00:49:07 +0000 @@ -98,12 +98,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.") @@ -161,13 +155,10 @@ (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) ------------------------------------------------------------ revno: 101342 author: Lars Magne Ingebrigtsen committer: Katsumi Yamaoka branch nick: trunk timestamp: Sun 2010-09-05 00:44:53 +0000 message: gnus-agent.el (gnus-agent-load-local): Only read the agent.lib/local file once per `g' run. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-09-05 00:38:39 +0000 +++ lisp/gnus/ChangeLog 2010-09-05 00:44:53 +0000 @@ -1,5 +1,8 @@ 2010-09-04 Lars Magne Ingebrigtsen + * 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. === modified file 'lisp/gnus/gnus-agent.el' --- lisp/gnus/gnus-agent.el 2010-09-04 15:24:35 +0000 +++ lisp/gnus/gnus-agent.el 2010-09-05 00:44:53 +0000 @@ -2232,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)) === modified file 'lisp/gnus/gnus-start.el' --- lisp/gnus/gnus-start.el 2010-09-05 00:34:16 +0000 +++ lisp/gnus/gnus-start.el 2010-09-05 00:44:53 +0000 @@ -1684,6 +1684,7 @@ alevel)) (methods-cache nil) (type-cache nil) + (gnus-agent-article-local-times 0) infos info group active method cmethod method-type method-group-list) (gnus-message 6 "Checking new news...") === modified file 'lisp/gnus/nnmh.el' --- lisp/gnus/nnmh.el 2010-09-05 00:38:39 +0000 +++ lisp/gnus/nnmh.el 2010-09-05 00:44:53 +0000 @@ -248,7 +248,7 @@ ?/ ?.) nnmail-pathname-coding-system))) (or max 0) - (or min 0)))))) + (or min 1)))))) t) (deffoo nnmh-request-newgroups (date &optional server) ------------------------------------------------------------ revno: 101341 author: Lars Magne Ingebrigtsen committer: Katsumi Yamaoka branch nick: trunk timestamp: Sun 2010-09-05 00:38:39 +0000 message: nnmh.el (nnmh-request-list-1): Output active lines also for empty directories. This makes the draft queue directory work. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-09-05 00:34:16 +0000 +++ lisp/gnus/ChangeLog 2010-09-05 00:38:39 +0000 @@ -1,5 +1,8 @@ 2010-09-04 Lars Magne Ingebrigtsen + * 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. === modified file 'lisp/gnus/nnmh.el' --- lisp/gnus/nnmh.el 2010-09-05 00:34:16 +0000 +++ lisp/gnus/nnmh.el 2010-09-05 00:38:39 +0000 @@ -230,25 +230,25 @@ (nnmh-request-list-1 rdir)))) ;; For each directory, generate an active file line. (unless (string= (expand-file-name nnmh-toplev) dir) - (when min - (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))) - max min)))))) + (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 0)))))) t) (deffoo nnmh-request-newgroups (date &optional server) ------------------------------------------------------------ revno: 101340 author: Lars Magne Ingebrigtsen committer: Katsumi Yamaoka branch nick: trunk timestamp: Sun 2010-09-05 00:34:16 +0000 message: Rewrite the Gnus group activation method to be more efficient; nnmh.el (nnmh-request-list-1): Fix up the recursion behavior; Add more changes related to the new methodology for requesting backend data. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-09-04 15:28:57 +0000 +++ lisp/gnus/ChangeLog 2010-09-05 00:34:16 +0000 @@ -1,5 +1,16 @@ 2010-09-04 Lars Magne Ingebrigtsen + * 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. === modified file 'lisp/gnus/gnus-group.el' --- lisp/gnus/gnus-group.el 2010-09-02 03:43:31 +0000 +++ lisp/gnus/gnus-group.el 2010-09-05 00:34:16 +0000 @@ -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) === modified file 'lisp/gnus/gnus-int.el' --- lisp/gnus/gnus-int.el 2010-09-02 00:55:51 +0000 +++ lisp/gnus/gnus-int.el 2010-09-05 00:34:16 +0000 @@ -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)) === modified file 'lisp/gnus/gnus-start.el' --- lisp/gnus/gnus-start.el 2010-09-02 01:42:32 +0000 +++ lisp/gnus/gnus-start.el 2010-09-05 00:34:16 +0000 @@ -1684,8 +1684,8 @@ alevel)) (methods-cache nil) (type-cache nil) - scanned-methods info group active method retrieve-groups cmethod - method-type) + infos info group active method cmethod + method-type method-group-list) (gnus-message 6 "Checking new news...") (while newsrc @@ -1704,14 +1704,19 @@ ;; 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) @@ -1720,99 +1725,74 @@ 'primary) (t 'foreign))) - (push (cons method method-type) type-cache)) - - (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))))) - - ;; 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))))))) - + (push (setq method-group-list (list method method-type nil)) + type-cache)) + (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) + + ;; See if any of the groups from this method require updating. + (when (block nil + (dolist (info infos) + (when (<= (gnus-info-level info) + (if (eq method-type 'foreign) + foreign-level + alevel)) + (return t)))) + (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"))) +(defun gnus-method-rank (type method) + (cond + ((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 (equalp method smethod) + (return i)) + (incf i)) + i))) + ;; Just say that all foreign groups have the same rank. + (t + 100))) + +(defun gnus-read-active-for-groups (method infos) + (with-current-buffer nntp-server-buffer + (cond + ((gnus-check-backend-function 'retrieve-groups (car 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)))))) + ;; Create a hash table out of the newsrc alist. The `car's of the ;; alist elements are used as keys. (defun gnus-make-hashtable-from-newsrc-alist () @@ -2043,7 +2023,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) === modified file 'lisp/gnus/mail-source.el' --- lisp/gnus/mail-source.el 2010-09-02 01:42:32 +0000 +++ lisp/gnus/mail-source.el 2010-09-05 00:34:16 +0000 @@ -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,11 @@ (mail-source-bind-common source (if (or mail-source-plugged plugged) (save-excursion + (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 === modified file 'lisp/gnus/nnmail.el' --- lisp/gnus/nnmail.el 2010-09-02 00:55:51 +0000 +++ lisp/gnus/nnmail.el 2010-09-05 00:34:16 +0000 @@ -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)) === modified file 'lisp/gnus/nnmh.el' --- lisp/gnus/nnmh.el 2010-09-04 00:45:13 +0000 +++ lisp/gnus/nnmh.el 2010-09-05 00:34:16 +0000 @@ -209,24 +209,25 @@ ;; Recurse down all directories. (let ((files (nnheader-directory-files dir t nil t)) (max 0) - min rdir attributes num) + min rdir num subdirectoriesp) ;; Recurse down directories. + (setq subdirectoriesp (> (nth 1 (file-attributes dir)) 2)) (dolist (rdir files) - (setq attributes (file-attributes rdir)) - (when (null (nth 0 attributes)) - (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)))) - (when (and (eq (nth 0 attributes) t) ; Is a directory - (> (nth 1 attributes) 2) ; Has sub-directories - (file-readable-p rdir) - (not (equal (file-truename rdir) - (file-truename dir)))) - (nnmh-request-list-1 rdir))) + (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) (when min === modified file 'lisp/gnus/nnvirtual.el' --- lisp/gnus/nnvirtual.el 2010-09-02 00:55:51 +0000 +++ lisp/gnus/nnvirtual.el 2010-09-05 00:34:16 +0000 @@ -300,10 +300,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.")) ------------------------------------------------------------ revno: 101339 committer: Stefan Monnier branch nick: trunk timestamp: Sun 2010-09-05 00:54:58 +0200 message: * lisp/electric.el (electric-indent-post-self-insert-function): Don't reindent with a sloppy indentation function. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-09-04 22:51:39 +0000 +++ lisp/ChangeLog 2010-09-04 22:54:58 +0000 @@ -1,5 +1,8 @@ 2010-09-04 Stefan Monnier + * 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. @@ -12,7 +15,7 @@ 2010-09-04 Stefan Monnier - Avoid global recursive calls to kill-buffer-hooks, and fit into 80 cols. + 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. === modified file 'lisp/electric.el' --- lisp/electric.el 2010-09-03 13:06:51 +0000 +++ lisp/electric.el 2010-09-04 22:54:58 +0000 @@ -198,6 +198,10 @@ ;; 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))) ------------------------------------------------------------ revno: 101338 committer: Stefan Monnier branch nick: trunk timestamp: Sun 2010-09-05 00:51:39 +0200 message: * lisp/emacs-lisp/syntax.el (syntax-ppss): More sanity check to catch border case in change-log-mode. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-09-04 20:42:03 +0000 +++ lisp/ChangeLog 2010-09-04 22:51:39 +0000 @@ -1,3 +1,8 @@ +2010-09-04 Stefan Monnier + + * emacs-lisp/syntax.el (syntax-ppss): More sanity check to catch + border case in change-log-mode. + 2010-09-04 Chong Yidong * progmodes/compile.el (compilation-error-regexp-alist-alist): === modified file 'lisp/emacs-lisp/syntax.el' --- lisp/emacs-lisp/syntax.el 2010-08-01 00:24:55 +0000 +++ lisp/emacs-lisp/syntax.el 2010-09-04 22:51:39 +0000 @@ -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)))) ------------------------------------------------------------ revno: 101337 committer: Chong Yidong branch nick: trunk timestamp: Sat 2010-09-04 16:42:03 -0400 message: Fix Ruby compilation error matching. * 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). diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-09-04 18:47:29 +0000 +++ lisp/ChangeLog 2010-09-04 20:42:03 +0000 @@ -1,3 +1,10 @@ +2010-09-04 Chong Yidong + + * 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 Avoid global recursive calls to kill-buffer-hooks, and fit into 80 cols. === modified file 'lisp/progmodes/compile.el' --- lisp/progmodes/compile.el 2010-08-15 00:04:53 +0000 +++ lisp/progmodes/compile.el 2010-09-04 20:42:03 +0000 @@ -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)) ------------------------------------------------------------ revno: 101336 committer: Andreas Schwab branch nick: emacs timestamp: Sat 2010-09-04 21:44:39 +0200 message: Update cl-loaddefs.el diff: === modified file 'lisp/emacs-lisp/cl-loaddefs.el' --- lisp/emacs-lisp/cl-loaddefs.el 2010-08-31 01:53:46 +0000 +++ lisp/emacs-lisp/cl-loaddefs.el 2010-09-04 19:44:39 +0000 @@ -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" "\ ------------------------------------------------------------ revno: 101335 committer: Andreas Schwab branch nick: emacs timestamp: Sat 2010-09-04 21:39:34 +0200 message: Check all lisp types in image loader * 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. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-09-04 15:16:08 +0000 +++ src/ChangeLog 2010-09-04 19:39:34 +0000 @@ -1,3 +1,19 @@ +2010-09-04 Andreas Schwab + + * 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 * w32uniscribe.c (uniscribe_shape): Update commentary. Don't === modified file 'src/image.c' --- src/image.c 2010-09-04 10:43:43 +0000 +++ src/image.c 2010-09-04 19:39:34 +0000 @@ -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. */ @@ -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, @@ -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)) + 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 + /* 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,7 +7829,7 @@ -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. */) @@ -7832,7 +7838,7 @@ Lisp_Object typelist = Qnil; 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 } === modified file 'src/nsimage.m' --- src/nsimage.m 2010-08-06 10:12:41 +0000 +++ src/nsimage.m 2010-09-04 19:39:34 +0000 @@ -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]; } ------------------------------------------------------------ revno: 101334 committer: Stefan Monnier branch nick: trunk timestamp: Sat 2010-09-04 20:47:29 +0200 message: Avoid global recursive calls to kill-buffer-hooks, and fit into 80 cols. * lisp/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. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-09-04 17:54:48 +0000 +++ lisp/ChangeLog 2010-09-04 18:47:29 +0000 @@ -1,3 +1,13 @@ +2010-09-04 Stefan Monnier + + Avoid global recursive calls to kill-buffer-hooks, and 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 (tiny change) * emacs-lisp/package.el (package-directory-list): Only call @@ -5,8 +15,8 @@ 2010-09-02 Chong Yidong - * emacs-lisp/package.el (package--download-one-archive): Ensure - that archive-contents is valid before saving it. + * 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. === modified file 'lisp/textmodes/ispell.el' --- lisp/textmodes/ispell.el 2010-09-02 12:37:29 +0000 +++ lisp/textmodes/ispell.el 2010-09-04 18:47:29 +0000 @@ -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,34 @@ (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 "~/"))) + (args + (append + (if (and ispell-current-dictionary ; Use specified dictionary. + (not (member "-d" args))) ; Only define if not overridden. + (list "-d" ispell-current-dictionary)) + (ispell-get-ispell-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 +2616,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*")) @@ -2650,10 +2656,11 @@ ;; 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' + ;; 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) @@ -2667,17 +2674,25 @@ ispell-filter nil ispell-filter-continue nil ispell-process-directory default-directory) - ;; When spellchecking minibuffer contents, assign ispell process to parent - ;; buffer if known (not known for XEmacs). Use (buffer-name) otherwise. - (setq ispell-process-buffer-name + + ;; 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)) ;; Not XEmacs + (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)) - (buffer-name))) + (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 + ;; protect against bogus binding of `enable-multibyte-characters' in + ;; XEmacs. (if (and (or (featurep 'xemacs) (and (boundp 'enable-multibyte-characters) enable-multibyte-characters)) @@ -2735,19 +2750,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 if using Ispell -;; per-directory personal dictionaries. -(add-hook 'kill-buffer-hook - '(lambda () - (if (and (not (equal ispell-process-directory (expand-file-name "~/"))) - (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? @@ -2844,9 +2850,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) @@ -3111,9 +3118,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 @@ -3140,7 +3147,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) @@ -3275,10 +3283,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)) @@ -3351,7 +3361,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) ------------------------------------------------------------ revno: 101333 committer: Chong Yidong branch nick: trunk timestamp: Sat 2010-09-04 13:54:48 -0400 message: * emacs-lisp/package.el (package-directory-list): Only call file-name-nondirectory on a string. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-09-04 17:13:14 +0000 +++ lisp/ChangeLog 2010-09-04 17:54:48 +0000 @@ -1,3 +1,8 @@ +2010-09-04 Noorul Islam K M (tiny change) + + * emacs-lisp/package.el (package-directory-list): Only call + file-name-nondirectory on a string. + 2010-09-02 Chong Yidong * emacs-lisp/package.el (package--download-one-archive): Ensure === modified file 'lisp/emacs-lisp/package.el' --- lisp/emacs-lisp/package.el 2010-09-04 17:13:14 +0000 +++ lisp/emacs-lisp/package.el 2010-09-04 17:54:48 +0000 @@ -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. ------------------------------------------------------------ revno: 101332 committer: Chong Yidong branch nick: trunk timestamp: Sat 2010-09-04 13:13:14 -0400 message: Avoid corrupting archive-contents file. * 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. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-09-03 13:28:09 +0000 +++ lisp/ChangeLog 2010-09-04 17:13:14 +0000 @@ -1,3 +1,10 @@ +2010-09-02 Chong Yidong + + * 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 Use SMIE's blink-paren for octave-mode. === modified file 'lisp/emacs-lisp/package.el' --- lisp/emacs-lisp/package.el 2010-09-02 15:29:15 +0000 +++ lisp/emacs-lisp/package.el 2010-09-04 17:13:14 +0000 @@ -406,16 +406,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 +465,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 +503,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 +705,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 +990,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)) @@ -1301,11 +1301,9 @@ (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")) @@ -1460,8 +1458,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 ------------------------------------------------------------ revno: 101331 author: Julien Danjou committer: Katsumi Yamaoka branch nick: trunk timestamp: Sat 2010-09-04 15:34:39 +0000 message: gnus.texi (Adaptive Scoring): Fix typo. diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2010-09-04 00:30:49 +0000 +++ doc/misc/ChangeLog 2010-09-04 15:34:39 +0000 @@ -1,3 +1,7 @@ +2010-09-04 Julien Danjou (tiny change) + + * gnus.texi (Adaptive Scoring): Fix typo. + 2010-09-03 Lars Magne Ingebrigtsen * gnus.texi (Article Display): Document gnus-html-show-images. === modified file 'doc/misc/gnus.texi' --- doc/misc/gnus.texi 2010-09-04 00:30:49 +0000 +++ doc/misc/gnus.texi 2010-09-04 15:34:39 +0000 @@ -21574,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 ------------------------------------------------------------ revno: 101330 author: Lars Magne Ingebrigtsen committer: Katsumi Yamaoka branch nick: trunk timestamp: Sat 2010-09-04 15:28:57 +0000 message: (gnus-html-show-images): If there are no images to show, then say so instead of bugging out. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-09-04 15:24:35 +0000 +++ lisp/gnus/ChangeLog 2010-09-04 15:28:57 +0000 @@ -1,5 +1,8 @@ 2010-09-04 Lars Magne Ingebrigtsen + * 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. === modified file 'lisp/gnus/gnus-html.el' --- lisp/gnus/gnus-html.el 2010-09-04 15:24:35 +0000 +++ lisp/gnus/gnus-html.el 2010-09-04 15:28:57 +0000 @@ -372,7 +372,9 @@ (while (setq overlay (pop overlays)) (when (overlay-get overlay 'gnus-image) (push (overlay-get overlay 'gnus-image) images))) - (gnus-html-schedule-image-fetching (current-buffer) images)))) + (if (not images) + (message "No images to show") + (gnus-html-schedule-image-fetching (current-buffer) images))))) ;;;###autoload (defun gnus-html-prefetch-images (summary) ------------------------------------------------------------ revno: 101329 author: Lars Magne Ingebrigtsen committer: Katsumi Yamaoka branch nick: trunk timestamp: Sat 2010-09-04 15:24:35 +0000 message: (gnus-article-copy-string): Say what data we copied; (gnus-html-wash-tags): Remove even more white space around ; (gnus-agent-load-alist): Check whether the agentview files exist before trying to read them. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-09-04 00:45:13 +0000 +++ lisp/gnus/ChangeLog 2010-09-04 15:24:35 +0000 @@ -1,5 +1,13 @@ 2010-09-04 Lars Magne Ingebrigtsen + * 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 . + + * 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 === modified file 'lisp/gnus/gnus-agent.el' --- lisp/gnus/gnus-agent.el 2010-09-04 00:21:34 +0000 +++ lisp/gnus/gnus-agent.el 2010-09-04 15:24:35 +0000 @@ -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." === modified file 'lisp/gnus/gnus-art.el' --- lisp/gnus/gnus-art.el 2010-09-04 00:21:34 +0000 +++ lisp/gnus/gnus-art.el 2010-09-04 15:24:35 +0000 @@ -7949,7 +7949,8 @@ (when data (with-temp-buffer (insert data) - (copy-region-as-kill (point-min) (point-max)))))) + (copy-region-as-kill (point-min) (point-max)) + (message "Copied %s" data))))) ;;; Internal functions: === modified file 'lisp/gnus/gnus-html.el' --- lisp/gnus/gnus-html.el 2010-09-04 00:50:02 +0000 +++ lisp/gnus/gnus-html.el 2010-09-04 15:24:35 +0000 @@ -112,7 +112,7 @@ (defun gnus-html-wash-tags () (let (tag parameters string start end images url) (goto-char (point-min)) - (while (re-search-forward " * *\n" nil t) + (while (re-search-forward " * * *\n" nil t) (replace-match "" t t)) (goto-char (point-min)) (while (re-search-forward "<\\([^ />]+\\)\\([^>]*\\)>" nil t) ------------------------------------------------------------ revno: 101328 committer: Eli Zaretskii branch nick: trunk timestamp: Sat 2010-09-04 18:16:08 +0300 message: Fix display of composed R2L text on MS-Windows. 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. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-09-04 10:43:43 +0000 +++ src/ChangeLog 2010-09-04 15:16:08 +0000 @@ -1,3 +1,11 @@ +2010-09-04 Eli Zaretskii + + * 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 * image.c (imagemagick_image_p): Replace bcopy by memcpy. === modified file 'src/w32uniscribe.c' --- src/w32uniscribe.c 2010-07-07 22:18:28 +0000 +++ src/w32uniscribe.c 2010-09-04 15:16:08 +0000 @@ -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); ------------------------------------------------------------ revno: 101327 committer: Andreas Schwab branch nick: emacs timestamp: Sat 2010-09-04 12:43:43 +0200 message: * image.c (Fimagemagick_types): Doc fix. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-09-04 10:41:52 +0000 +++ src/ChangeLog 2010-09-04 10:43:43 +0000 @@ -2,7 +2,7 @@ * image.c (imagemagick_image_p): Replace bcopy by memcpy. (imagemagick_load_image): Fix type mismatch. - (Fimagemagick_types): Likewise. + (Fimagemagick_types): Likewise. Doc fix. 2010-09-02 Jan Djärv === modified file 'src/image.c' --- src/image.c 2010-09-04 10:41:52 +0000 +++ src/image.c 2010-09-04 10:43:43 +0000 @@ -7825,8 +7825,8 @@ 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; ------------------------------------------------------------ revno: 101326 committer: Andreas Schwab branch nick: emacs timestamp: Sat 2010-09-04 12:41:52 +0200 message: Fix type mismatch in ImageMagick loader * image.c (imagemagick_load_image): Fix type mismatch. (Fimagemagick_types): Likewise. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-09-04 08:23:09 +0000 +++ src/ChangeLog 2010-09-04 10:41:52 +0000 @@ -1,6 +1,8 @@ 2010-09-04 Andreas Schwab * image.c (imagemagick_image_p): Replace bcopy by memcpy. + (imagemagick_load_image): Fix type mismatch. + (Fimagemagick_types): Likewise. 2010-09-02 Jan Djärv === modified file 'src/image.c' --- src/image.c 2010-09-04 08:23:09 +0000 +++ src/image.c 2010-09-04 10:41:52 +0000 @@ -7450,8 +7450,8 @@ contents/size. */ unsigned char *filename) { - size_t width; - size_t height; + unsigned long width; + unsigned long height; MagickBooleanType status; @@ -7830,7 +7830,7 @@ (void) { Lisp_Object typelist = Qnil; - size_t numf; + unsigned long numf; ExceptionInfo ex; char** imtypes = GetMagickList ("*", &numf, &ex); int i; ------------------------------------------------------------ revno: 101325 committer: Andreas Schwab branch nick: emacs timestamp: Sat 2010-09-04 10:23:09 +0200 message: * image.c (imagemagick_image_p): Replace bcopy by memcpy. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-09-02 09:47:08 +0000 +++ src/ChangeLog 2010-09-04 08:23:09 +0000 @@ -1,3 +1,7 @@ +2010-09-04 Andreas Schwab + + * image.c (imagemagick_image_p): Replace bcopy by memcpy. + 2010-09-02 Jan Djärv * xterm.h (struct dpyinfo): Remove cut_buffers_initialized. === modified file 'src/image.c' --- src/image.c 2010-08-20 12:02:43 +0000 +++ src/image.c 2010-09-04 08:23:09 +0000 @@ -7413,7 +7413,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; ------------------------------------------------------------ revno: 101324 committer: Eli Zaretskii branch nick: trunk timestamp: Sat 2010-09-04 10:30:14 +0300 message: Update config.bat due to lisp/gnus/.dir-locals.el. config.bat: Produce lisp/gnus/_dir-locals.el from lisp/gnus/.dir-locals.el. diff: === modified file 'ChangeLog' --- ChangeLog 2010-08-23 12:54:09 +0000 +++ ChangeLog 2010-09-04 07:30:14 +0000 @@ -1,3 +1,8 @@ +2010-09-04 Eli Zaretskii + + * config.bat: Produce lisp/gnus/_dir-locals.el from + lisp/gnus/.dir-locals.el. + 2010-08-23 Andreas Schwab * configure.in: Fix check for librsvg, imagemagick and === modified file 'config.bat' --- config.bat 2010-06-26 14:36:27 +0000 +++ config.bat 2010-09-04 07:30:14 +0000 @@ -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 ---------------------------------------------------------------------- ------------------------------------------------------------ revno: 101323 committer: Katsumi Yamaoka branch nick: trunk timestamp: Sat 2010-09-04 00:50:02 +0000 message: Fix previous merge from Gnus trunk. diff: === modified file 'lisp/gnus/gnus-html.el' --- lisp/gnus/gnus-html.el 2010-09-04 00:36:13 +0000 +++ lisp/gnus/gnus-html.el 2010-09-04 00:50:02 +0000 @@ -111,7 +111,6 @@ (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 " * *\n" nil t) (replace-match "" t t)) @@ -223,7 +222,8 @@ (while (re-search-forward "" 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."