Using saved parent location: http://bzr.savannah.gnu.org/r/emacs/trunk/ Now on revision 103930. ------------------------------------------------------------ revno: 103930 author: Teodor Zlatanov committer: Katsumi Yamaoka branch nick: trunk timestamp: Sat 2011-04-16 06:56:17 +0000 message: registry.el (registry-reindex): New method to recreate the secondary registry indices. gnus-registry.el (gnus-registry-fixup-registry): Use it if the tracked field changes. (gnus-registry-unfollowed-addresses, gnus-registry-track-extra) (gnus-registry-action, gnus-registry-spool-action) (gnus-registry-handle-action) (gnus-registry--split-fancy-with-parent-internal) (gnus-registry-split-fancy-with-parent) (gnus-registry-register-message-ids): Add recipient tracking on spool, move, and delete actions, and for fancy splitting with parent. (gnus-registry-extract-addresses) (gnus-registry-fetch-recipients-fast) (gnus-registry-fetch-header-fast): Convenience functions. (gnus-registry-misc-test): ERT test of `gnus-registry-extract-addresses'. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2011-04-15 14:29:02 +0000 +++ lisp/gnus/ChangeLog 2011-04-16 06:56:17 +0000 @@ -1,3 +1,23 @@ +2011-04-16 Teodor Zlatanov + + * registry.el (registry-reindex): New method to recreate the secondary + registry indices. + + * gnus-registry.el (gnus-registry-fixup-registry): Use it if the + tracked field changes. + (gnus-registry-unfollowed-addresses, gnus-registry-track-extra) + (gnus-registry-action, gnus-registry-spool-action) + (gnus-registry-handle-action) + (gnus-registry--split-fancy-with-parent-internal) + (gnus-registry-split-fancy-with-parent) + (gnus-registry-register-message-ids): Add recipient tracking on spool, + move, and delete actions, and for fancy splitting with parent. + (gnus-registry-extract-addresses) + (gnus-registry-fetch-recipients-fast) + (gnus-registry-fetch-header-fast): Convenience functions. + (gnus-registry-misc-test): ERT test of + `gnus-registry-extract-addresses'. + 2011-04-15 Teodor Zlatanov * gnus-registry.el (gnus-registry--split-fancy-with-parent-internal): === modified file 'lisp/gnus/gnus-registry.el' --- lisp/gnus/gnus-registry.el 2011-04-15 14:29:02 +0000 +++ lisp/gnus/gnus-registry.el 2011-04-16 06:56:17 +0000 @@ -36,7 +36,7 @@ ;; Put this in your startup file (~/.gnus.el for instance) or use Customize: ;; (setq gnus-registry-max-entries 2500 -;; gnus-registry-track-extra '(sender subject)) +;; gnus-registry-track-extra '(sender subject recipient)) ;; (gnus-registry-initialize) @@ -119,7 +119,9 @@ (defcustom gnus-registry-unfollowed-addresses (list (regexp-quote user-mail-address)) "List of addresses that gnus-registry-split-fancy-with-parent won't trace. -The addresses are matched, they don't have to be fully qualified." +The addresses are matched, they don't have to be fully qualified. +In the messages, these addresses can be the sender or the +recipients." :group 'gnus-registry :type '(repeat regexp)) @@ -152,14 +154,15 @@ (make-obsolete-variable 'gnus-registry-entry-caching nil "23.4") (make-obsolete-variable 'gnus-registry-trim-articles-without-groups nil "23.4") -(defcustom gnus-registry-track-extra '(subject sender) +(defcustom gnus-registry-track-extra '(subject sender recipient) "Whether the registry should track extra data about a message. -The Subject and Sender (From:) headers are tracked this way by -default." +The subject, recipients (To: and Cc:), and Sender (From:) headers +are tracked this way by default." :group 'gnus-registry :type '(set :tag "Tracking choices" (const :tag "Track by subject (Subject: header)" subject) + (const :tag "Track by recipient (To: and Cc: headers)" recipient) (const :tag "Track by sender (From: header)" sender))) (defcustom gnus-registry-split-strategy nil @@ -224,18 +227,22 @@ (defun gnus-registry-fixup-registry (db) (when db - (oset db :precious - (append gnus-registry-extra-entries-precious - '())) - (oset db :max-hard - (or gnus-registry-max-entries - most-positive-fixnum)) - (oset db :max-soft - (or gnus-registry-max-pruned-entries - most-positive-fixnum)) - (oset db :tracked - (append gnus-registry-track-extra - '(mark group keyword)))) + (let ((old (oref db :tracked))) + (oset db :precious + (append gnus-registry-extra-entries-precious + '())) + (oset db :max-hard + (or gnus-registry-max-entries + most-positive-fixnum)) + (oset db :max-soft + (or gnus-registry-max-pruned-entries + most-positive-fixnum)) + (oset db :tracked + (append gnus-registry-track-extra + '(mark group keyword))) + (when (not (equal old (oref db :tracked))) + (gnus-message 4 "Reindexing the Gnus registry (tracked change)") + (registry-reindex db)))) db) (defun gnus-registry-make-db (&optional file) @@ -296,7 +303,17 @@ (defun gnus-registry-action (action data-header from &optional to method) (let* ((id (mail-header-id data-header)) (subject (mail-header-subject data-header)) - (sender (mail-header-from data-header)) + (recipients (sort (mapcan 'gnus-registry-extract-addresses + (list + (or (ignore-errors + (mail-header "Cc" data-header)) + "") + (or (ignore-errors + (mail-header "To" data-header)) + ""))) + 'string-lessp)) + (sender (nth 0 (gnus-registry-extract-addresses + (mail-header-from data-header)))) (from (gnus-group-guess-full-name-from-command-method from)) (to (if to (gnus-group-guess-full-name-from-command-method to) nil)) (to-name (if to to "the Bit Bucket"))) @@ -307,10 +324,16 @@ id ;; unless copying, remove the old "from" group (if (not (equal 'copy action)) from nil) - to subject sender))) + to subject sender recipients))) -(defun gnus-registry-spool-action (id group &optional subject sender) +(defun gnus-registry-spool-action (id group &optional subject sender recipients) (let ((to (gnus-group-guess-full-name-from-command-method group)) + (recipients (or recipients + (sort (mapcan 'gnus-registry-extract-addresses + (list + (or (message-fetch-field "cc") "") + (or (message-fetch-field "to") ""))) + 'string-lessp))) (subject (or subject (message-fetch-field "subject"))) (sender (or sender (message-fetch-field "from")))) (when (and (stringp id) (string-match "\r$" id)) @@ -318,12 +341,13 @@ (gnus-message 7 "Gnus registry: article %s spooled to %s" id to) - (gnus-registry-handle-action id nil to subject sender))) + (gnus-registry-handle-action id nil to subject sender recipients))) -(defun gnus-registry-handle-action (id from to subject sender) +(defun gnus-registry-handle-action (id from to subject sender + &optional recipients) (gnus-message 10 - "gnus-registry-handle-action %S" (list id from to subject sender)) + "gnus-registry-handle-action %S" (list id from to subject sender recipients)) (let ((db gnus-registry-db) ;; safe if not found (entry (gnus-registry-get-or-make-entry id)) @@ -340,11 +364,15 @@ (setq entry (cons (delete from (assoc 'group entry)) (assq-delete-all 'group entry)))) - (dolist (kv `((group ,to) (sender ,sender) (subject ,subject))) + (dolist (kv `((group ,to) + (sender ,sender) + (recipient ,@recipients) + (subject ,subject))) (when (second kv) (let ((new (or (assq (first kv) entry) (list (first kv))))) - (add-to-list 'new (second kv) t) + (dolist (toadd (cdr kv)) + (add-to-list 'new toadd t)) (setq entry (cons new (assq-delete-all (first kv) entry)))))) (gnus-message 10 "Gnus registry: new entry for %s is %S" @@ -381,6 +409,11 @@ ;; these may not be used, but the code is cleaner having them up here (sender (gnus-string-remove-all-properties (message-fetch-field "from"))) + (recipients (sort (mapcan 'gnus-registry-extract-addresses + (list + (or (message-fetch-field "cc") "") + (or (message-fetch-field "to") ""))) + 'string-lessp)) (subject (gnus-string-remove-all-properties (gnus-registry-simplify-subject (message-fetch-field "subject")))) @@ -393,12 +426,13 @@ :references references :refstr refstr :sender sender + :recipients recipients :subject subject :log-agent "Gnus registry fancy splitting with parent"))) (defun* gnus-registry--split-fancy-with-parent-internal (&rest spec - &key references refstr sender subject log-agent + &key references refstr sender subject recipients log-agent &allow-other-keys) (gnus-message 10 @@ -478,6 +512,36 @@ (setq found (gnus-registry-post-process-groups "sender" sender found))) + ;; else: there were no matches, try the extra tracking by recipient + (when (and (null found) + (memq 'recipient gnus-registry-track-extra) + recipients) + (dolist (recp recipients) + (when (and (null found) + (not (gnus-grep-in-list + recp + gnus-registry-unfollowed-addresses))) + (let ((groups (apply 'append + (mapcar + (lambda (reference) + (gnus-registry-get-id-key reference 'group)) + (registry-lookup-secondary-value + db 'recipient recp))))) + (setq found + (loop for group in groups + when (gnus-registry-follow-group-p group) + do (gnus-message + ;; warn more if gnus-registry-track-extra + (if gnus-registry-track-extra 7 9) + "%s (extra tracking) traced recipient '%s' to %s" + log-agent recp group) + collect group))))) + + ;; filter the found groups and return them + ;; the found groups are NOT the full groups + (setq found (gnus-registry-post-process-groups + "recipients" (mapconcat 'identity recipients ", ") found))) + ;; after the (cond) we extract the actual value safely (car-safe found))) @@ -629,7 +693,8 @@ article gnus-newsgroup-name) (gnus-registry-handle-action id nil gnus-newsgroup-name (gnus-registry-fetch-simplified-message-subject-fast article) - (gnus-registry-fetch-sender-fast article))))))) + (gnus-registry-fetch-sender-fast article) + (gnus-registry-fetch-recipients-fast article))))))) ;; message field fetchers (defun gnus-registry-fetch-message-id-fast (article) @@ -639,6 +704,21 @@ (mail-header-id (gnus-data-header (assoc article (gnus-data-list nil)))) nil)) +(defun gnus-registry-extract-addresses (text) + "Extract all the addresses in a normalized way from TEXT. +Returns an unsorted list of strings in the name
format. +Addresses without a name will say \"noname\"." + (mapcar (lambda (add) + (gnus-string-remove-all-properties + (let* ((name (or (nth 0 add) "noname")) + (addr (nth 1 add)) + (addr (if (bufferp addr) + (with-current-buffer addr + (buffer-string)) + addr))) + (format "%s <%s>" name addr)))) + (mail-extract-address-components text t))) + (defun gnus-registry-simplify-subject (subject) (if (stringp subject) (gnus-simplify-subject subject) @@ -655,12 +735,26 @@ nil)) (defun gnus-registry-fetch-sender-fast (article) - "Fetch the Sender quickly, using the internal gnus-data-list function" + (gnus-registry-fetch-header-fast "from" article)) + +(defun gnus-registry-fetch-recipients-fast (article) + (sort (mapcan 'gnus-registry-extract-addresses + (list + (or (ignore-errors + (gnus-registry-fetch-header-fast "Cc" article)) + "") + (or (ignore-errors + (gnus-registry-fetch-header-fast "To" article)) + ""))) + 'string-lessp)) + +(defun gnus-registry-fetch-header-fast (article header) + "Fetch the HEADER quickly, using the internal gnus-data-list function" (if (and (numberp article) (assoc article (gnus-data-list nil))) (gnus-string-remove-all-properties - (mail-header-from (gnus-data-header - (assoc article (gnus-data-list nil))))) + (mail-header header (gnus-data-header + (assoc article (gnus-data-list nil))))) nil)) ;; registry marks glue @@ -902,6 +996,19 @@ (gnus-registry-set-id-key id key val)))) (message "Import done, collected %d entries" count)))) +(ert-deftest gnus-registry-misc-test () + (should-error (gnus-registry-extract-addresses '("" ""))) + + (should (equal '("Ted Zlatanov " + "noname " + "noname " + "noname ") + (gnus-registry-extract-addresses + (concat "Ted Zlatanov , " + "ed , " ; "ed" is not a valid name here + "cyd@stupidchicken.com, " + "tzz@lifelogs.com"))))) + (ert-deftest gnus-registry-usage-test () (let* ((n 100) (tempfile (make-temp-file "gnus-registry-persist")) === modified file 'lisp/gnus/registry.el' --- lisp/gnus/registry.el 2011-04-11 01:18:19 +0000 +++ lisp/gnus/registry.el 2011-04-16 06:56:17 +0000 @@ -281,6 +281,25 @@ (registry-lookup-secondary-value db tr val value-keys)))) entry) +(defmethod registry-reindex ((db registry-db)) + "Rebuild the secondary indices of registry-db THIS." + (let ((count 0) + (expected (* (length (oref db :tracked)) (registry-size db)))) + (dolist (tr (oref db :tracked)) + (let (values) + (maphash + (lambda (key v) + (incf count) + (when (and (< 0 expected) + (= 0 (mod count 1000))) + (message "reindexing: %d of %d (%.2f%%)" + count expected (/ (* 1000 count) expected))) + (dolist (val (cdr-safe (assq tr v))) + (let* ((value-keys (registry-lookup-secondary-value db tr val))) + (push key value-keys) + (registry-lookup-secondary-value db tr val value-keys)))) + (oref db :data)))))) + (defmethod registry-size ((db registry-db)) "Returns the size of the registry-db object THIS. This is the key count of the :data slot." @@ -360,10 +379,11 @@ (when (boundp 'lexical-binding) (message "Individual lookup (breaks before lexbind)") (should (= 58 - (caadr (registry-lookup-breaks-before-lexbind db '(1 58 99))))) + (caadr (registry-lookup-breaks-before-lexbind db '(1 58 99))))) (message "Grouped individual lookup (breaks before lexbind)") (should (= 3 - (length (registry-lookup-breaks-before-lexbind db '(1 58 99)))))) + (length (registry-lookup-breaks-before-lexbind db + '(1 58 99)))))) (message "Search") (should (= n (length (registry-search db :all t)))) (should (= n (length (registry-search db :member '((sender "me")))))) ------------------------------------------------------------ revno: 103929 committer: Juanma Barranquero branch nick: trunk timestamp: Sat 2011-04-16 05:44:06 +0200 message: lisp/ChangeLog, src/ChangeLog: Fix typos. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-04-15 13:50:04 +0000 +++ lisp/ChangeLog 2011-04-16 03:44:06 +0000 @@ -228,7 +228,7 @@ 2011-04-06 Juanma Barranquero * files.el (after-find-file-from-revert-buffer): Remove variable. - (after-find-file): Dont' bind it. + (after-find-file): Don't bind it. (revert-buffer-in-progress-p): New variable. (revert-buffer): Bind it. Pass nil for `after-find-file-from-revert-buffer'. === modified file 'src/ChangeLog' --- src/ChangeLog 2011-04-16 03:14:08 +0000 +++ src/ChangeLog 2011-04-16 03:44:06 +0000 @@ -39,10 +39,10 @@ 2011-04-15 Ben Key - * keyboard.c (Qundefined): Don't declare static since it is - used in nsfns.m. - * xfaces.c (Qbold, Qexpanded, Qitalic, Qcondensed): Don't - declare static since they are used in nsfont.m. + * keyboard.c (Qundefined): Don't declare static since it is used + in nsfns.m. + * xfaces.c (Qbold, Qexpanded, Qitalic, Qcondensed): Don't declare + static since they are used in nsfont.m. 2011-04-15 Stefan Monnier ------------------------------------------------------------ revno: 103928 committer: Ben Key branch nick: trunk timestamp: Fri 2011-04-15 22:14:08 -0500 message: Fixed bugs in ns_get_family and ns_descriptor_to_entity that were caused by using free to deallocate memory blocks that were allocated by xmalloc (via xstrdup). diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-04-15 10:23:56 +0000 +++ src/ChangeLog 2011-04-16 03:14:08 +0000 @@ -1,3 +1,13 @@ +2011-04-16 Ben Key + + * nsfont.m: Fixed bugs in ns_get_family and + ns_descriptor_to_entity that were caused by using free to + deallocate memory blocks that were allocated by xmalloc (via + xstrdup). This caused Emacs to crash when compiled with + XMALLOC_OVERRUN_CHECK defined (when Emacs was configured with + --enable-checking=xmallocoverrun). xfree is now used to + deallocate these memory blocks. + 2011-04-15 Paul Eggert * sysdep.c (emacs_read): Remove unnecessary check vs MAX_RW_COUNT. === modified file 'src/nsfont.m' --- src/nsfont.m 2011-04-02 13:52:34 +0000 +++ src/nsfont.m 2011-04-16 03:14:08 +0000 @@ -104,7 +104,7 @@ NSString *family; ns_unescape_name (tmp); family = [NSString stringWithUTF8String: tmp]; - free (tmp); + xfree (tmp); return family; } } @@ -217,7 +217,7 @@ debug_print (font_entity); } - free (escapedFamily); + xfree (escapedFamily); return font_entity; } ------------------------------------------------------------ revno: 103927 committer: Ben Key branch nick: trunk timestamp: Fri 2011-04-15 17:48:00 -0500 message: Modified the code that parses the --cflags and --ldflags options to support parameters that include the = character as long as they are enclosed in quotes. diff: === modified file 'nt/ChangeLog' --- nt/ChangeLog 2011-04-06 15:44:32 +0000 +++ nt/ChangeLog 2011-04-15 22:48:00 +0000 @@ -1,3 +1,17 @@ +2011-04-15 Ben Key + + * configure.bat: Modified the code that parses the --cflags and + --ldflags options to support parameters that include the = + character as long as they are enclosed in quotes. This + functionality depends on command extensions. Configure.bat now + attempts to enable command extensions and displays a warning + message if they could not be enabled. If configure.bat could + not enable command extensions the old parsing code is used that + does not support parameters that include the = character. + + * INSTALL: Updated the file to describe the new functionality + using text provided by Eli Zaretskii. + 2011-04-06 Eli Zaretskii * config.nt (NO_INLINE, ATTRIBUTE_FORMAT) === modified file 'nt/INSTALL' --- nt/INSTALL 2011-01-26 08:36:39 +0000 +++ nt/INSTALL 2011-04-15 22:48:00 +0000 @@ -220,13 +220,23 @@ absolutely sure the produced binaries will never need to be run under a debugger. - Because of limitations of the stock Windows command shell, certain - characters (quotes, backslashes and equal signs) can be problematic - and should not be used in arguments to configure. That means that - forward slashes must be used in paths passed to the compiler and - linker via the --cflags and --ldflags options, and that it is - currently not possible to pass a macro like -DFOO=BAR (though -DFOO - is perfectly valid). + Because of limitations of the stock Windows command shells, special + care is needed to pass some characters in the arguments of the + --cflags and --ldflags options. Backslashes should not be used in + file names passed to the compiler and linker via these options. Use + forward slashes instead. If the arguments to these two options + include the `=' character, like when passing a -DFOO=bar preprocessor + option, the argument with the `=' character should be enclosed in + quotes, like this: + + configure --cflags "-DFOO=bar" + + Support for options that include the `=' character require "command + extensions" to be enabled. (They are enabled by default, but your + system administrator could have changed that. See "cmd /?" for + details.) If command extensions are disabled, a warning message might + be displayed informing you that "using parameters that include the = + character by enclosing them in quotes will not be supported." N.B. It is normal to see a few error messages output while configure is running, when gcc support is being tested. These cannot be === modified file 'nt/configure.bat' --- nt/configure.bat 2011-01-29 12:36:11 +0000 +++ nt/configure.bat 2011-04-15 22:48:00 +0000 @@ -75,6 +75,19 @@ :start rem ---------------------------------------------------------------------- +rem Attempt to enable command extensions. Set use_extensions to 1 if +rem they are available and 0 if they are not available. +set use_extensions=1 +setlocal ENABLEEXTENSIONS +if "%CMDEXTVERSION%" == "" set use_extensions=0 +if "%use_extensions%" == "1" goto afterext + +echo. Command extensions are not available. Using parameters that include the = +echo. character by enclosing them in quotes will not be supported. + +:afterext + +rem ---------------------------------------------------------------------- rem Default settings. set prefix= set nodebug=N @@ -136,6 +149,20 @@ echo. --without-xpm do not use XPM library even if it is installed echo. --with-svg use the RSVG library (experimental) echo. --distfiles path to files for make dist, e.g. libXpm.dll +if "%use_extensions%" == "0" goto end +echo. +echo. The cflags and ldflags arguments support parameters that include the = +echo. character. However, since the = character is normally treated as a +echo. separator character you will need to enclose any parameter that includes +echo. the = character in quotes. For example, to include +echo. -DSITELOAD_PURESIZE_EXTRA=100000 as one of the cflags you would run +echo. configure.bat as follows: +echo. configure.bat --cflags "-DSITELOAD_PURESIZE_EXTRA=100000" +echo. +echo. Note that this capability of processing parameters that include the = +echo. character depends on command extensions. This batch file attempts to +echo. enable command extensions. If command extensions cannot be enabled, a +echo. warning message will be displayed. goto end rem ---------------------------------------------------------------------- @@ -198,6 +225,17 @@ rem ---------------------------------------------------------------------- :usercflags +if "%use_extensions%" == "1" goto ucflagex +goto ucflagne + +:ucflagex +shift +set usercflags=%usercflags%%sep1%%~1 +set sep1= %nothing% +shift +goto again + +:ucflagne shift set usercflags=%usercflags%%sep1%%1 set sep1= %nothing% @@ -207,6 +245,17 @@ rem ---------------------------------------------------------------------- :userldflags +if "%use_extensions%" == "1" goto ulflagex +goto ulflagne + +:ulflagex +shift +set userldflags=%userldflags%%sep2%%~1 +set sep2= %nothing% +shift +goto again + +:ulflagne shift set userldflags=%userldflags%%sep2%%1 set sep2= %nothing% ------------------------------------------------------------ revno: 103926 author: Teodor Zlatanov committer: Katsumi Yamaoka branch nick: trunk timestamp: Fri 2011-04-15 14:29:02 +0000 message: nus-registry.el (gnus-registry--split-fancy-with-parent-internal): Track by subject first, then sender. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2011-04-15 12:42:51 +0000 +++ lisp/gnus/ChangeLog 2011-04-15 14:29:02 +0000 @@ -1,8 +1,14 @@ +2011-04-15 Teodor Zlatanov + + * gnus-registry.el (gnus-registry--split-fancy-with-parent-internal): + Track by subject first, then sender. + 2011-04-15 Stefan Monnier * message.el (message-bogus-system-names): Replace ^...$ => \`...\'. - * gnus.el (gnus-splash-svg-color-symbols): Don't use insert-file from Lisp. + * gnus.el (gnus-splash-svg-color-symbols): Don't use insert-file from + Lisp. * gnus-draft.el (gnus-draft-setup): New arg `dont-pop'. (gnus-draft-send): Use it to avoid popping === modified file 'lisp/gnus/gnus-registry.el' --- lisp/gnus/gnus-registry.el 2011-04-14 10:41:00 +0000 +++ lisp/gnus/gnus-registry.el 2011-04-15 14:29:02 +0000 @@ -425,6 +425,31 @@ (setq found (gnus-registry-post-process-groups "references" refstr found))) + ;; else: there were no matches, now try the extra tracking by subject + (when (and (null found) + (memq 'subject gnus-registry-track-extra) + subject + (< gnus-registry-minimum-subject-length (length subject))) + (let ((groups (apply + 'append + (mapcar + (lambda (reference) + (gnus-registry-get-id-key reference 'group)) + (registry-lookup-secondary-value db 'subject subject))))) + (setq found + (loop for group in groups + when (gnus-registry-follow-group-p group) + do (gnus-message + ;; warn more if gnus-registry-track-extra + (if gnus-registry-track-extra 7 9) + "%s (extra tracking) traced subject '%s' to %s" + log-agent subject group) + collect group)) + ;; filter the found groups and return them + ;; the found groups are NOT the full groups + (setq found (gnus-registry-post-process-groups + "subject" subject found)))) + ;; else: there were no matches, try the extra tracking by sender (when (and (null found) (memq 'sender gnus-registry-track-extra) @@ -453,30 +478,6 @@ (setq found (gnus-registry-post-process-groups "sender" sender found))) - ;; else: there were no matches, now try the extra tracking by subject - (when (and (null found) - (memq 'subject gnus-registry-track-extra) - subject - (< gnus-registry-minimum-subject-length (length subject))) - (let ((groups (apply - 'append - (mapcar - (lambda (reference) - (gnus-registry-get-id-key reference 'group)) - (registry-lookup-secondary-value db 'subject subject))))) - (setq found - (loop for group in groups - when (gnus-registry-follow-group-p group) - do (gnus-message - ;; warn more if gnus-registry-track-extra - (if gnus-registry-track-extra 7 9) - "%s (extra tracking) traced subject '%s' to %s" - log-agent subject group) - collect group)) - ;; filter the found groups and return them - ;; the found groups are NOT the full groups - (setq found (gnus-registry-post-process-groups - "subject" subject found)))) ;; after the (cond) we extract the actual value safely (car-safe found))) ------------------------------------------------------------ revno: 103925 committer: Stefan Monnier branch nick: trunk timestamp: Fri 2011-04-15 10:50:04 -0300 message: Use completion-at-point for mailalias.el * lisp/mail/mailalias.el: Use lexical-binding. (pattern, mailalias-done): Declare dynamic. (mail-completion-at-point-function): New function, from mail-complete. (mail-complete): Use it. (mail-completion-expand): New function. (mail-get-names): Use it. (mail-directory, mail-directory-process, mail-directory-stream): Don't use `pattern' for lexically bound arg. * lisp/mail/sendmail.el (mail-mode-map): Use completion-at-point. (mail-mode): Setup mailalias completion here instead. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-04-15 12:57:53 +0000 +++ lisp/ChangeLog 2011-04-15 13:50:04 +0000 @@ -1,5 +1,16 @@ 2011-04-15 Stefan Monnier + * mail/sendmail.el (mail-mode-map): Use completion-at-point. + (mail-mode): Setup mailalias completion here instead. + * mail/mailalias.el: Use lexical-binding. + (pattern, mailalias-done): Declare dynamic. + (mail-completion-at-point-function): New function, from mail-complete. + (mail-complete): Use it. + (mail-completion-expand): New function. + (mail-get-names): Use it. + (mail-directory, mail-directory-process, mail-directory-stream): + Don't use `pattern' for lexically bound arg. + * emacs-lisp/lisp-mode.el (eval-defun-2): Use eval-sexp-add-defvars. * htmlfontify.el (hfy-etags-cmd): Remove inoperant eval-and-compile. @@ -89,8 +100,8 @@ * minibuffer.el (completion-show-inline-help): New var. (completion--do-completion, minibuffer-complete) - (minibuffer-force-complete, minibuffer-complete-word): Inhibit - minibuffer messages if completion-show-inline-help is nil. + (minibuffer-force-complete, minibuffer-complete-word): + Inhibit minibuffer messages if completion-show-inline-help is nil. * icomplete.el (icomplete-mode): Bind completion-show-inline-help to avoid interference from inline help (Bug#5849). @@ -106,7 +117,7 @@ not in Image mode. (image-transform-mode, image-transform-resize) (image-transform-set-rotation): Doc fix. - (image-transform-set-resize): Deleted. + (image-transform-set-resize): Delete. (image-transform-set-scale, image-transform-fit-to-height) (image-transform-fit-to-width): Handle image-toggle-display-image and image-transform-resize directly. @@ -196,7 +207,7 @@ (package-menu--generate): Use package--push. Renamed from package--generate-package-list. (package-menu-refresh, list-packages): Use it. - (package-menu--print-info): Renamed from package-print-package. + (package-menu--print-info): Rename from package-print-package. Return insertion data instead of inserting it directly. (package-menu-describe-package, package-menu-execute): Use tabulated-list-get-id. @@ -313,8 +324,8 @@ * dired-aux.el (dired-create-files): Add docstring (Bug#7970). * textmodes/flyspell.el (flyspell-word): Recognize default - dictionary case for flyspell-mark-duplications-exceptions. Use - regexp matching for languages. + dictionary case for flyspell-mark-duplications-exceptions. + Use regexp matching for languages. (flyspell-mark-duplications-exceptions): Add "that" and "had" for default dictionary (Bug#7926). === modified file 'lisp/mail/mailalias.el' --- lisp/mail/mailalias.el 2011-01-25 04:08:28 +0000 +++ lisp/mail/mailalias.el 2011-04-15 13:50:04 +0000 @@ -1,4 +1,4 @@ -;;; mailalias.el --- expand and complete mailing address aliases +;;; mailalias.el --- expand and complete mailing address aliases -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1995-1997, 2001-2011 ;; Free Software Foundation, Inc. @@ -52,20 +52,20 @@ (defvar mail-address-field-regexp "^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\|Reply-to\\):") +(defvar pattern) + (defcustom mail-complete-alist - ;; Don't use backquote here; we don't want backquote to get loaded - ;; just because of loading this file. ;; Don't refer to mail-address-field-regexp here; ;; that confuses some things such as cus-dep.el. - (cons '("^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\|Reply-to\\):" - . (mail-get-names pattern)) - '(("Newsgroups:" . (if (boundp 'gnus-active-hashtb) - gnus-active-hashtb - (if (boundp news-group-article-assoc) - news-group-article-assoc))) - ("Followup-To:" . (mail-sentto-newsgroups)) - ;;("Distribution:" ???) - )) + '(("^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\|Reply-to\\):" + . (mail-get-names pattern)) + ("Newsgroups:" . (if (boundp 'gnus-active-hashtb) + gnus-active-hashtb + (if (boundp news-group-article-assoc) + news-group-article-assoc))) + ("Followup-To:" . (mail-sentto-newsgroups)) + ;;("Distribution:" ???) + ) "Alist of header field and expression to return alist for completion. The expression may reference the variable `pattern' which will hold the string being completed. @@ -90,6 +90,8 @@ "Function to call when completing outside `mail-complete-alist'-header." :type '(choice function (const nil)) :group 'mailalias) +(make-obsolete-variable 'mail-complete-function + 'completion-at-point-functions "24.1") (defcustom mail-directory-function nil "Function to get completions from directory service or nil for none. @@ -390,11 +392,9 @@ mail-names t)))) ;;;###autoload -(defun mail-complete (arg) - "Perform completion on header field or word preceding point. -Completable headers are according to `mail-complete-alist'. If none matches -current header, calls `mail-complete-function' and passes prefix arg if any." - (interactive "P") +(defun mail-completion-at-point-function () + "Compute completion data for mail aliases. +For use on `completion-at-point-functions'." ;; Read the defaults first, if we have not done so. (sendmail-sync-aliases) (if (eq mail-aliases t) @@ -402,52 +402,70 @@ (setq mail-aliases nil) (if (file-exists-p mail-personal-alias-file) (build-mail-aliases)))) - (let ((list mail-complete-alist)) + (let ((list mail-complete-alist) + (list-exp nil)) (if (and (< 0 (mail-header-end)) (save-excursion - (if (re-search-backward "^[^\t]" nil t) + (if (re-search-backward "^[^\t ]" nil t) (while list (if (looking-at (car (car list))) - (setq arg (cdr (car list)) + (setq list-exp (cdr (car list)) list ()) (setq list (cdr list))))) - arg)) + list-exp)) (let* ((end (point)) (beg (save-excursion (skip-chars-backward "^ \t<,:") (point))) - (pattern (buffer-substring beg end)) - completion) - (setq list (eval arg) - completion (try-completion pattern list)) - (cond ((eq completion t)) - ((null completion) - (message "Can't find completion for \"%s\"" pattern) - (ding)) - ((not (string= pattern completion)) - (delete-region beg end) - (let ((alist-elt (assoc completion mail-names))) - (if (cdr alist-elt) - (cond ((eq mail-complete-style 'parens) - (insert completion " (" (cdr alist-elt) ")")) - ((eq mail-complete-style 'angles) - (insert (cdr alist-elt) " <" completion ">")) - (t - (insert completion))) - (insert completion)))) - (t - (message "Making completion list...") - (with-output-to-temp-buffer "*Completions*" - (display-completion-list - (all-completions pattern list))) - (message "Making completion list...%s" "done")))) + (table (completion-table-dynamic + (lambda (prefix) + (let ((pattern prefix)) (eval list-exp)))))) + (list beg end table))))) + +;;;###autoload +(defun mail-complete (arg) + "Perform completion on header field or word preceding point. +Completable headers are according to `mail-complete-alist'. If none matches +current header, calls `mail-complete-function' and passes prefix ARG if any." + (interactive "P") + ;; Read the defaults first, if we have not done so. + (sendmail-sync-aliases) + (if (eq mail-aliases t) + (progn + (setq mail-aliases nil) + (if (file-exists-p mail-personal-alias-file) + (build-mail-aliases)))) + (let ((data (mail-completion-at-point-function))) + (if data + (apply #'completion-in-region data) (funcall mail-complete-function arg)))) - -(defun mail-get-names (pattern) +(make-obsolete 'mail-complete 'mail-completion-at-point-function "24.1") + +(defun mail-completion-expand (table) + "Build new completion table that expands aliases. +Completes like TABLE except that if the completion is a valid alias, +it expands it to its full `mail-complete-style' form." + (lambda (string pred action) + (cond + ((eq action nil) + (let* ((comp (try-completion string table pred)) + (name (and (listp table) comp + (assoc (if (stringp comp) comp string) table)))) + (cond + ((null name) comp) + ((eq mail-complete-style 'parens) + (concat (car name) " (" (cdr name) ")")) + ((eq mail-complete-style 'angles) + (concat (cdr name) " <" (car name) ">")) + (t comp)))) + (t + (complete-with-action action table string pred))))) + +(defun mail-get-names (prefix) "Fetch local users and global mail addresses for completion. Consults `/etc/passwd' and a directory service if one is set up via `mail-directory-function'. -PATTERN is the string we want to complete." +PREFIX is the string we want to complete." (if (eq mail-local-names t) (with-current-buffer (generate-new-buffer " passwd") (let ((files mail-passwd-files)) @@ -480,7 +498,7 @@ (and mail-directory-function (eq mail-directory-names t) (setq directory - (mail-directory (if mail-directory-requery pattern)))) + (mail-directory (if mail-directory-requery prefix)))) (or mail-directory-requery (setq mail-directory-names directory)) (if (or directory @@ -496,58 +514,59 @@ (when (consp mail-directory-names) mail-directory-names))) (lambda (a b) - ;; should cache downcased strings + ;; Should cache downcased strings. (string< (downcase (car a)) (downcase (car b))))))))) - mail-names) - - -(defun mail-directory (pattern) - "Use mail-directory facility to get user names matching PATTERN. -If PATTERN is nil, get all the defined user names. + (mail-completion-expand mail-names)) + + +(defun mail-directory (prefix) + "Use mail-directory facility to get user names matching PREFIX. +If PREFIX is nil, get all the defined user names. This function calls `mail-directory-function' to query the directory, then uses `mail-directory-parser' to parse the output it returns." (message "Querying directory...") (with-current-buffer (generate-new-buffer " *mail-directory*") - (funcall mail-directory-function pattern) + (funcall mail-directory-function prefix) (goto-char (point-min)) (let (directory) (if (stringp mail-directory-parser) (while (re-search-forward mail-directory-parser nil t) - (setq directory - (cons (match-string 1) directory))) + (push (match-string 1) directory)) (if mail-directory-parser (setq directory (funcall mail-directory-parser)) (while (not (eobp)) - (setq directory - (cons (buffer-substring (point) - (progn - (forward-line) - (if (bolp) - (1- (point)) - (point)))) - directory))))) + (push (buffer-substring (point) + (progn + (forward-line) + (if (bolp) + (1- (point)) + (point)))) + directory)))) (kill-buffer (current-buffer)) (message "Querying directory...done") directory))) +(defvar mailalias-done) -(defun mail-directory-process (pattern) +(defun mail-directory-process (prefix) "Run a shell command to output names in directory. See `mail-directory-process'." (when (consp mail-directory-process) - (apply 'call-process (eval (car mail-directory-process)) nil t nil - (mapcar 'eval (cdr mail-directory-process))))) + (let ((pattern prefix)) ;Dynbind! + (apply 'call-process (eval (car mail-directory-process)) nil t nil + (mapcar 'eval (cdr mail-directory-process)))))) ;; This should handle a dialog. Currently expects port to spit out names. -(defun mail-directory-stream (pattern) +(defun mail-directory-stream (prefix) "Open a stream to retrieve names in directory. See `mail-directory-stream'." - (let (mailalias-done) + (let ((mailalias-done nil) + (pattern prefix)) ;Dynbind! (set-process-sentinel (apply 'open-network-stream "mailalias" (current-buffer) mail-directory-stream) - (lambda (x y) + (lambda (_x _y) (setq mailalias-done t))) (while (not mailalias-done) (sit-for .1)))) === modified file 'lisp/mail/sendmail.el' --- lisp/mail/sendmail.el 2011-03-03 07:08:22 +0000 +++ lisp/mail/sendmail.el 2011-04-15 13:50:04 +0000 @@ -293,7 +293,7 @@ (defvar mail-abbrevs-loaded nil) (defvar mail-mode-map (let ((map (make-sparse-keymap))) - (define-key map "\M-\t" 'mail-complete) + (define-key map "\M-\t" 'completion-at-point) (define-key map "\C-c?" 'describe-mode) (define-key map "\C-c\C-f\C-t" 'mail-to) (define-key map "\C-c\C-f\C-b" 'mail-bcc) @@ -688,6 +688,8 @@ (setq adaptive-fill-first-line-regexp (concat "[ \t]*[-[:alnum:]]*>+[ \t]*\\|" adaptive-fill-first-line-regexp)) + (add-hook 'completion-at-point-functions #'mail-completion-at-point-function + nil 'local) ;; `-- ' precedes the signature. `-----' appears at the start of the ;; lines that delimit forwarded messages. ;; Lines containing just >= 3 dashes, perhaps after whitespace, ------------------------------------------------------------ revno: 103924 committer: Stefan Monnier branch nick: trunk timestamp: Fri 2011-04-15 09:57:53 -0300 message: * lisp/emacs-lisp/lisp-mode.el (eval-defun-2): Use eval-sexp-add-defvars. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-04-15 12:35:32 +0000 +++ lisp/ChangeLog 2011-04-15 12:57:53 +0000 @@ -1,5 +1,7 @@ 2011-04-15 Stefan Monnier + * emacs-lisp/lisp-mode.el (eval-defun-2): Use eval-sexp-add-defvars. + * htmlfontify.el (hfy-etags-cmd): Remove inoperant eval-and-compile. (hfy-e2x-etags-cmd, hfy-etags-cmd-alist-default) (hfy-etags-cmd-alist): Don't eval-and-compile any more. === modified file 'lisp/emacs-lisp/lisp-mode.el' --- lisp/emacs-lisp/lisp-mode.el 2011-04-01 15:16:50 +0000 +++ lisp/emacs-lisp/lisp-mode.el 2011-04-15 12:57:53 +0000 @@ -844,7 +844,7 @@ (end-of-defun) (beginning-of-defun) (setq beg (point)) - (setq form (read (current-buffer))) + (setq form (eval-sexp-add-defvars (read (current-buffer)))) (setq end (point))) ;; Alter the form if necessary. (setq form (eval-defun-1 (macroexpand form))) ------------------------------------------------------------ revno: 103923 committer: Stefan Monnier branch nick: trunk timestamp: Fri 2011-04-15 09:42:51 -0300 message: * lisp/gnus/gnus-draft.el (gnus-draft-setup): New arg `dont-pop'. (gnus-draft-send): Use it to avoid popping up frames from gnus-group-send-queue. * lisp/gnus/gnus.el (gnus-splash-svg-color-symbols): Don't use insert-file from Lisp. * lisp/gnus/message.el (message-bogus-system-names): Replace ^...$ => \`...\'. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2011-04-14 10:41:00 +0000 +++ lisp/gnus/ChangeLog 2011-04-15 12:42:51 +0000 @@ -1,3 +1,13 @@ +2011-04-15 Stefan Monnier + + * message.el (message-bogus-system-names): Replace ^...$ => \`...\'. + + * gnus.el (gnus-splash-svg-color-symbols): Don't use insert-file from Lisp. + + * gnus-draft.el (gnus-draft-setup): New arg `dont-pop'. + (gnus-draft-send): Use it to avoid popping + up frames from gnus-group-send-queue. + 2011-04-14 Teodor Zlatanov * gnus-registry.el: Updated gnus-registry docs. === modified file 'lisp/gnus/gnus-draft.el' --- lisp/gnus/gnus-draft.el 2011-02-03 23:43:22 +0000 +++ lisp/gnus/gnus-draft.el 2011-04-15 12:42:51 +0000 @@ -149,7 +149,7 @@ gnus-agent-queue-mail)) (rfc2047-encode-encoded-words nil) type method move-to) - (gnus-draft-setup article (or group "nndraft:queue")) + (gnus-draft-setup article (or group "nndraft:queue") nil 'dont-pop) ;; We read the meta-information that says how and where ;; this message is to be sent. (save-restriction @@ -245,11 +245,15 @@ :type 'hook) -(defun gnus-draft-setup (narticle group &optional restore) +(defun gnus-draft-setup (narticle group &optional restore dont-pop) + "Setup a mail draft buffer. +If DONT-POP is nil, display the buffer after setting it up." (let (ga) (gnus-setup-message 'forward (let ((article narticle)) - (message-mail) + (message-mail nil nil nil nil + (if dont-pop + (lambda (buf) (set-buffer (get-buffer-create buf))))) (let ((inhibit-read-only t)) (erase-buffer)) (if (not (gnus-request-restore-buffer article group)) === modified file 'lisp/gnus/gnus.el' --- lisp/gnus/gnus.el 2011-03-30 14:59:42 +0000 +++ lisp/gnus/gnus.el 2011-04-15 12:42:51 +0000 @@ -1107,16 +1107,18 @@ (set-buffer-modified-p t))) (defun gnus-splash-svg-color-symbols (list) - "Do color-symbol search-and-replace in svg file" + "Do color-symbol search-and-replace in svg file." (let ((type (plist-get (cdr list) :type)) (file (plist-get (cdr list) :file)) (color-symbols (plist-get (cdr list) :color-symbols))) (if (string= type "svg") - (let ((data (with-temp-buffer (insert-file file) (buffer-string)))) + (let ((data (with-temp-buffer (insert-file-contents file) + (buffer-string)))) (mapc (lambda (rule) (setq data (replace-regexp-in-string (concat "fill:" (car rule)) - (concat "fill:" (cdr rule)) data))) color-symbols) + (concat "fill:" (cdr rule)) data))) + color-symbols) (cons (car list) (list :type type :data data))) list))) === modified file 'lisp/gnus/message.el' --- lisp/gnus/message.el 2011-03-30 14:59:42 +0000 +++ lisp/gnus/message.el 2011-04-15 12:42:51 +0000 @@ -1882,7 +1882,7 @@ (defvar message-send-mail-real-function nil "Internal send mail function.") -(defvar message-bogus-system-names "^localhost\\.\\|\\.local$" +(defvar message-bogus-system-names "\\`localhost\\.\\|\\.local\\'" "The regexp of bogus system names.") (defcustom message-valid-fqdn-regexp ------------------------------------------------------------ revno: 103922 committer: Stefan Monnier branch nick: trunk timestamp: Fri 2011-04-15 09:35:32 -0300 message: * lisp/htmlfontify.el (hfy-etags-cmd): Remove inoperant eval-and-compile. (hfy-e2x-etags-cmd, hfy-etags-cmd-alist-default) (hfy-etags-cmd-alist): Don't eval-and-compile any more. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-04-15 12:30:15 +0000 +++ lisp/ChangeLog 2011-04-15 12:35:32 +0000 @@ -1,5 +1,9 @@ 2011-04-15 Stefan Monnier + * htmlfontify.el (hfy-etags-cmd): Remove inoperant eval-and-compile. + (hfy-e2x-etags-cmd, hfy-etags-cmd-alist-default) + (hfy-etags-cmd-alist): Don't eval-and-compile any more. + * emacs-lisp/bytecomp.el (byte-temp-output-buffer-show) (byte-save-window-excursion, byte-temp-output-buffer-setup) (byte-interactive-p): Define them again, for use when inlining === modified file 'lisp/htmlfontify.el' --- lisp/htmlfontify.el 2011-01-28 16:58:04 +0000 +++ lisp/htmlfontify.el 2011-04-15 12:35:32 +0000 @@ -290,8 +290,7 @@ :group 'htmlfontify :tag "html-quote-map" :type '(alist :key-type (string))) -(eval-and-compile - (defconst hfy-e2x-etags-cmd "for src in `find . -type f`; +(defconst hfy-e2x-etags-cmd "for src in `find . -type f`; do ETAGS=%s; case ${src} in @@ -322,17 +321,17 @@ esac; done;") - (defconst hfy-etags-cmd-alist-default - `(("emacs etags" . ,hfy-e2x-etags-cmd) - ("exuberant ctags" . "%s -R -f -" ))) +(defconst hfy-etags-cmd-alist-default + `(("emacs etags" . ,hfy-e2x-etags-cmd) + ("exuberant ctags" . "%s -R -f -" ))) - (defcustom hfy-etags-cmd-alist - hfy-etags-cmd-alist-default - "Alist of possible shell commands that will generate etags output that +(defcustom hfy-etags-cmd-alist + hfy-etags-cmd-alist-default + "Alist of possible shell commands that will generate etags output that `htmlfontify' can use. '%s' will be replaced by `hfy-etags-bin'." - :group 'htmlfontify - :tag "etags-cmd-alist" - :type '(alist :key-type (string) :value-type (string)) )) + :group 'htmlfontify + :tag "etags-cmd-alist" + :type '(alist :key-type (string) :value-type (string))) (defcustom hfy-etags-bin "etags" "Location of etags binary (we begin by assuming it's in your path).\n @@ -367,7 +366,13 @@ ((string-match "GNU E" v) "emacs etags" )) )) (defcustom hfy-etags-cmd - (eval-and-compile (cdr (assoc (hfy-which-etags) hfy-etags-cmd-alist))) + ;; We used to wrap this in a `eval-and-compile', but: + ;; - it had no effect because this expression was not seen by the + ;; byte-compiler (defcustom used to quote this argument). + ;; - it signals an error (`hfy-which-etags' is not defined at compile-time). + ;; - we want this auto-detection to reflect the system on which Emacs is run + ;; rather than the one on which it's compiled. + (cdr (assoc (hfy-which-etags) hfy-etags-cmd-alist)) "The etags equivalent command to run in a source directory to generate a tags file for the whole source tree from there on down. The command should emit the etags output on stdout.\n @@ -375,11 +380,10 @@ exuberant-ctags' etags respectively." :group 'htmlfontify :tag "etags-command" - :type (eval-and-compile - (let ((clist (list '(string)))) - (dolist (C hfy-etags-cmd-alist) - (push (list 'const :tag (car C) (cdr C)) clist)) - (cons 'choice clist)) )) + :type (let ((clist (list '(string)))) + (dolist (C hfy-etags-cmd-alist) + (push (list 'const :tag (car C) (cdr C)) clist)) + (cons 'choice clist))) (defcustom hfy-istext-command "file %s | sed -e 's@^[^:]*:[ \t]*@@'" "Command to run with the name of a file, to see whether it is a text file ------------------------------------------------------------ revno: 103921 committer: Stefan Monnier branch nick: trunk timestamp: Fri 2011-04-15 09:30:15 -0300 message: * lisp/emacs-lisp/bytecomp.el (byte-temp-output-buffer-show) (byte-save-window-excursion, byte-temp-output-buffer-setup) (byte-interactive-p): Define them again, for use when inlining old code. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-04-15 03:15:22 +0000 +++ lisp/ChangeLog 2011-04-15 12:30:15 +0000 @@ -1,3 +1,10 @@ +2011-04-15 Stefan Monnier + + * emacs-lisp/bytecomp.el (byte-temp-output-buffer-show) + (byte-save-window-excursion, byte-temp-output-buffer-setup) + (byte-interactive-p): Define them again, for use when inlining + old code. + 2011-04-15 Juanma Barranquero * loadup.el: Use `string-to-number', not `string-to-int'. === modified file 'lisp/emacs-lisp/bytecomp.el' --- lisp/emacs-lisp/bytecomp.el 2011-04-01 17:19:52 +0000 +++ lisp/emacs-lisp/bytecomp.el 2011-04-15 12:30:15 +0000 @@ -580,7 +580,7 @@ (byte-defop 114 0 byte-save-current-buffer "To make a binding to record the current buffer") (byte-defop 115 0 byte-set-mark-OBSOLETE) -;; (byte-defop 116 1 byte-interactive-p) ;Let's not use it any more. +(byte-defop 116 1 byte-interactive-p-OBSOLETE) ;; These ops are new to v19 (byte-defop 117 0 byte-forward-char) @@ -616,8 +616,8 @@ (byte-defop 138 0 byte-save-excursion "to make a binding to record the buffer, point and mark") -;; (byte-defop 139 0 byte-save-window-excursion ; Obsolete: It's a macro now. -;; "to make a binding to record entire window configuration") +(byte-defop 139 0 byte-save-window-excursion-OBSOLETE + "to make a binding to record entire window configuration") (byte-defop 140 0 byte-save-restriction "to make a binding to record the current buffer clipping restrictions") (byte-defop 141 -1 byte-catch @@ -629,9 +629,8 @@ ;; an expression for the body, and a list of clauses. (byte-defop 143 -2 byte-condition-case) -;; Obsolete: `with-output-to-temp-buffer' is a macro now. -;; (byte-defop 144 0 byte-temp-output-buffer-setup) -;; (byte-defop 145 -1 byte-temp-output-buffer-show) +(byte-defop 144 0 byte-temp-output-buffer-setup-OBSOLETE) +(byte-defop 145 -1 byte-temp-output-buffer-show-OBSOLETE) ;; these ops are new to v19 ------------------------------------------------------------ revno: 103920 committer: Paul Eggert branch nick: trunk timestamp: Fri 2011-04-15 03:23:56 -0700 message: * sysdep.c (emacs_read): Remove unnecessary check vs MAX_RW_COUNT. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-04-15 08:51:02 +0000 +++ src/ChangeLog 2011-04-15 10:23:56 +0000 @@ -1,5 +1,7 @@ 2011-04-15 Paul Eggert + * sysdep.c (emacs_read): Remove unnecessary check vs MAX_RW_COUNT. + emacs_write: Accept and return EMACS_INT for sizes. See http://lists.gnu.org/archive/html/emacs-devel/2011-04/msg00514.html et seq. === modified file 'src/sysdep.c' --- src/sysdep.c 2011-04-15 08:22:34 +0000 +++ src/sysdep.c 2011-04-15 10:23:56 +0000 @@ -1844,7 +1844,10 @@ { register ssize_t rtnval; - while ((rtnval = read (fildes, buf, min (nbyte, MAX_RW_COUNT))) == -1 + /* There is no need to check against MAX_RW_COUNT, since no caller ever + passes a size that large to emacs_read. */ + + while ((rtnval = read (fildes, buf, nbyte)) == -1 && (errno == EINTR)) QUIT; return (rtnval); ------------------------------------------------------------ revno: 103919 [merge] committer: Paul Eggert branch nick: trunk timestamp: Fri 2011-04-15 01:51:02 -0700 message: emacs_write: Accept and return EMACS_INT for sizes. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-04-15 02:03:43 +0000 +++ src/ChangeLog 2011-04-15 08:51:02 +0000 @@ -1,3 +1,30 @@ +2011-04-15 Paul Eggert + + emacs_write: Accept and return EMACS_INT for sizes. + See http://lists.gnu.org/archive/html/emacs-devel/2011-04/msg00514.html + et seq. + * gnutls.c, gnutls.h (emacs_gnutls_read, emacs_gnutls_write): + Accept and return EMACS_INT. + (emacs_gnutls_write): Return the number of bytes written on + partial writes. + * sysdep.c, lisp.h (emacs_read, emacs_write): Likewise. + (emacs_read, emacs_write): Remove check for negative size, as the + Emacs source code has been audited now. + * sysdep.c (MAX_RW_COUNT): New macro, to work around kernel bugs. + (emacs_read, emacs_write): Use it. + * process.c (send_process): Adjust to the new signatures of + emacs_write and emacs_gnutls_write. Do not attempt to store + a byte offset into an 'int'; it might overflow. + See http://lists.gnu.org/archive/html/emacs-devel/2011-04/msg00483.html + + * sound.c: Don't assume sizes fit in 'int'. + (struct sound_device.period_size, alsa_period_size): + Return EMACS_INT, not int. + (struct sound_device.write, vox_write, alsa_write): + Accept EMACS_INT, not int. + (wav_play, au_play): Use EMACS_INT to store sizes and to + record read return values. + 2011-04-15 Ben Key * keyboard.c (Qundefined): Don't declare static since it is === modified file 'src/gnutls.c' --- src/gnutls.c 2011-04-10 14:00:13 +0000 +++ src/gnutls.c 2011-04-15 08:22:34 +0000 @@ -70,12 +70,12 @@ } } -ssize_t +EMACS_INT emacs_gnutls_write (int fildes, struct Lisp_Process *proc, const char *buf, - size_t nbyte) + EMACS_INT nbyte) { ssize_t rtnval; - size_t bytes_written; + EMACS_INT bytes_written; gnutls_session_t state = proc->gnutls_state; if (proc->gnutls_initstage != GNUTLS_STAGE_READY) { @@ -85,7 +85,7 @@ #ifdef EAGAIN errno = EAGAIN; #endif - return -1; + return 0; } bytes_written = 0; @@ -99,7 +99,7 @@ if (rtnval == GNUTLS_E_AGAIN || rtnval == GNUTLS_E_INTERRUPTED) continue; else - return (bytes_written ? bytes_written : -1); + break; } buf += rtnval; @@ -110,9 +110,9 @@ return (bytes_written); } -ssize_t +EMACS_INT emacs_gnutls_read (int fildes, struct Lisp_Process *proc, char *buf, - size_t nbyte) + EMACS_INT nbyte) { ssize_t rtnval; gnutls_session_t state = proc->gnutls_state; === modified file 'src/gnutls.h' --- src/gnutls.h 2011-04-10 14:00:13 +0000 +++ src/gnutls.h 2011-04-15 08:22:34 +0000 @@ -50,12 +50,12 @@ #define GNUTLS_LOG2(level, max, string, extra) if (level <= max) { gnutls_log_function2 (level, "(Emacs) " string, extra); } -ssize_t +EMACS_INT emacs_gnutls_write (int fildes, struct Lisp_Process *proc, const char *buf, - size_t nbyte); -ssize_t + EMACS_INT nbyte); +EMACS_INT emacs_gnutls_read (int fildes, struct Lisp_Process *proc, char *buf, - size_t nbyte); + EMACS_INT nbyte); extern void syms_of_gnutls (void); === modified file 'src/lisp.h' --- src/lisp.h 2011-04-15 00:58:49 +0000 +++ src/lisp.h 2011-04-15 08:22:34 +0000 @@ -3317,8 +3317,8 @@ extern void seed_random (long); extern int emacs_open (const char *, int, int); extern int emacs_close (int); -extern ssize_t emacs_read (int, char *, size_t); -extern ssize_t emacs_write (int, const char *, size_t); +extern EMACS_INT emacs_read (int, char *, EMACS_INT); +extern EMACS_INT emacs_write (int, const char *, EMACS_INT); enum { READLINK_BUFSIZE = 1024 }; extern char *emacs_readlink (const char *, char [READLINK_BUFSIZE]); #ifndef HAVE_MEMSET === modified file 'src/process.c' --- src/process.c 2011-04-15 00:58:49 +0000 +++ src/process.c 2011-04-15 08:35:53 +0000 @@ -5368,6 +5368,7 @@ /* Send this batch, using one or more write calls. */ while (this > 0) { + EMACS_INT written = 0; int outfd = p->outfd; old_sigpipe = (void (*) (int)) signal (SIGPIPE, send_process_trap); #ifdef DATAGRAM_SOCKETS @@ -5376,7 +5377,9 @@ rv = sendto (outfd, buf, this, 0, datagram_address[outfd].sa, datagram_address[outfd].len); - if (rv < 0 && errno == EMSGSIZE) + if (0 <= rv) + written = rv; + else if (errno == EMSGSIZE) { signal (SIGPIPE, old_sigpipe); report_file_error ("sending datagram", @@ -5388,12 +5391,13 @@ { #ifdef HAVE_GNUTLS if (XPROCESS (proc)->gnutls_p) - rv = emacs_gnutls_write (outfd, - XPROCESS (proc), - buf, this); + written = emacs_gnutls_write (outfd, + XPROCESS (proc), + buf, this); else #endif - rv = emacs_write (outfd, buf, this); + written = emacs_write (outfd, buf, this); + rv = (written ? 0 : -1); #ifdef ADAPTIVE_READ_BUFFERING if (p->read_output_delay > 0 && p->adaptive_read_buffering == 1) @@ -5420,7 +5424,7 @@ that may allow the program to finish doing output and read more. */ { - int offset = 0; + EMACS_INT offset = 0; #ifdef BROKEN_PTY_READ_AFTER_EAGAIN /* A gross hack to work around a bug in FreeBSD. @@ -5466,16 +5470,14 @@ offset); else if (STRINGP (object)) buf = offset + SSDATA (object); - - rv = 0; } else /* This is a real error. */ report_file_error ("writing to process", Fcons (proc, Qnil)); } - buf += rv; - len -= rv; - this -= rv; + buf += written; + len -= written; + this -= written; } } } === modified file 'src/sound.c' --- src/sound.c 2011-04-14 20:16:48 +0000 +++ src/sound.c 2011-04-15 08:47:25 +0000 @@ -235,11 +235,11 @@ /* Return a preferred data size in bytes to be sent to write (below) each time. 2048 is used if this is NULL. */ - int (* period_size) (struct sound_device *sd); + EMACS_INT (* period_size) (struct sound_device *sd); /* Write NYBTES bytes from BUFFER to device SD. */ void (* write) (struct sound_device *sd, const char *buffer, - int nbytes); + EMACS_INT nbytes); /* A place for devices to store additional data. */ void *data; @@ -291,7 +291,7 @@ static void vox_close (struct sound_device *sd); static void vox_choose_format (struct sound_device *, struct sound *); static int vox_init (struct sound_device *); -static void vox_write (struct sound_device *, const char *, int); +static void vox_write (struct sound_device *, const char *, EMACS_INT); static void find_sound_type (struct sound *); static u_int32_t le2hl (u_int32_t); static u_int16_t le2hs (u_int16_t); @@ -600,9 +600,9 @@ else { char *buffer; - int nbytes = 0; - int blksize = sd->period_size ? sd->period_size (sd) : 2048; - int data_left = header->data_length; + EMACS_INT nbytes = 0; + EMACS_INT blksize = sd->period_size ? sd->period_size (sd) : 2048; + EMACS_INT data_left = header->data_length; buffer = (char *) alloca (blksize); lseek (s->fd, sizeof *header, SEEK_SET); @@ -690,9 +690,9 @@ SBYTES (s->data) - header->data_offset); else { - int blksize = sd->period_size ? sd->period_size (sd) : 2048; + EMACS_INT blksize = sd->period_size ? sd->period_size (sd) : 2048; char *buffer; - int nbytes; + EMACS_INT nbytes; /* Seek */ lseek (s->fd, header->data_offset, SEEK_SET); @@ -895,10 +895,9 @@ /* Write NBYTES bytes from BUFFER to device SD. */ static void -vox_write (struct sound_device *sd, const char *buffer, int nbytes) +vox_write (struct sound_device *sd, const char *buffer, EMACS_INT nbytes) { - ssize_t nwritten = emacs_write (sd->fd, buffer, nbytes); - if (nwritten < 0) + if (emacs_write (sd->fd, buffer, nbytes) != nbytes) sound_perror ("Error writing to sound device"); } @@ -953,7 +952,7 @@ alsa_sound_perror (file, err); } -static int +static EMACS_INT alsa_period_size (struct sound_device *sd) { struct alsa_params *p = (struct alsa_params *) sd->data; @@ -1156,13 +1155,13 @@ /* Write NBYTES bytes from BUFFER to device SD. */ static void -alsa_write (struct sound_device *sd, const char *buffer, int nbytes) +alsa_write (struct sound_device *sd, const char *buffer, EMACS_INT nbytes) { struct alsa_params *p = (struct alsa_params *) sd->data; /* The the third parameter to snd_pcm_writei is frames, not bytes. */ int fact = snd_pcm_format_size (sd->format, 1) * sd->channels; - int nwritten = 0; + EMACS_INT nwritten = 0; int err; while (nwritten < nbytes) === modified file 'src/sysdep.c' --- src/sysdep.c 2011-04-14 20:16:48 +0000 +++ src/sysdep.c 2011-04-15 08:22:34 +0000 @@ -1825,41 +1825,47 @@ return rtnval; } -ssize_t -emacs_read (int fildes, char *buf, size_t nbyte) +/* Maximum number of bytes to read or write in a single system call. + This works around a serious bug in Linux kernels before 2.6.16; see + . + It's likely to work around similar bugs in other operating systems, so do it + on all platforms. Round INT_MAX down to a page size, with the conservative + assumption that page sizes are at most 2**18 bytes (any kernel with a + page size larger than that shouldn't have the bug). */ +#ifndef MAX_RW_COUNT +#define MAX_RW_COUNT (INT_MAX >> 18 << 18) +#endif + +/* Read from FILEDESC to a buffer BUF with size NBYTE, retrying if interrupted. + Return the number of bytes read, which might be less than NBYTE. + On error, set errno and return -1. */ +EMACS_INT +emacs_read (int fildes, char *buf, EMACS_INT nbyte) { register ssize_t rtnval; - /* Defend against the possibility that a buggy caller passes a negative NBYTE - argument, which would be converted to a large unsigned size_t NBYTE. This - defense prevents callers from doing large writes, unfortunately. This - size restriction can be removed once we have carefully checked that there - are no such callers. */ - if ((ssize_t) nbyte < 0) - abort (); - - while ((rtnval = read (fildes, buf, nbyte)) == -1 + while ((rtnval = read (fildes, buf, min (nbyte, MAX_RW_COUNT))) == -1 && (errno == EINTR)) QUIT; return (rtnval); } -ssize_t -emacs_write (int fildes, const char *buf, size_t nbyte) +/* Write to FILEDES from a buffer BUF with size NBYTE, retrying if interrupted + or if a partial write occurs. Return the number of bytes written, setting + errno if this is less than NBYTE. */ +EMACS_INT +emacs_write (int fildes, const char *buf, EMACS_INT nbyte) { - register ssize_t rtnval, bytes_written; - - /* Defend against negative NBYTE, as in emacs_read. */ - if ((ssize_t) nbyte < 0) - abort (); + ssize_t rtnval; + EMACS_INT bytes_written; bytes_written = 0; - while (nbyte != 0) + while (nbyte > 0) { - rtnval = write (fildes, buf, nbyte); + rtnval = write (fildes, buf, min (nbyte, MAX_RW_COUNT)); - if (rtnval == -1) + if (rtnval < 0) { if (errno == EINTR) { @@ -1871,13 +1877,14 @@ continue; } else - return (bytes_written ? bytes_written : -1); + break; } buf += rtnval; nbyte -= rtnval; bytes_written += rtnval; } + return (bytes_written); } ------------------------------------------------------------ revno: 103918 committer: Juanma Barranquero branch nick: trunk timestamp: Fri 2011-04-15 05:15:22 +0200 message: lisp/loadup.el: Use `string-to-number', not `string-to-int'. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-04-15 01:44:00 +0000 +++ lisp/ChangeLog 2011-04-15 03:15:22 +0000 @@ -1,3 +1,7 @@ +2011-04-15 Juanma Barranquero + + * loadup.el: Use `string-to-number', not `string-to-int'. + 2011-04-15 Stefan Monnier * progmodes/gud.el (gud-gdb): Use completion-at-point instead of @@ -8,11 +12,10 @@ 2011-04-14 Michael Albinus - * net/tramp-sh.el (tramp-sh-handle-file-attributes): Handle the - case when the scripts fail. Use `tramp-do-file-attributes-with-ls' - then. - (tramp-do-copy-or-rename-file-out-of-band): Do not check any - longer, whether`executable-find' is bound. + * net/tramp-sh.el (tramp-sh-handle-file-attributes): Handle the case + when the scripts fail. Use `tramp-do-file-attributes-with-ls' then. + (tramp-do-copy-or-rename-file-out-of-band): Do not check any longer + whether `executable-find' is bound. * net/tramp-smb.el (tramp-smb-handle-copy-file): Fix docstring. === modified file 'lisp/loadup.el' --- lisp/loadup.el 2011-03-31 15:17:06 +0000 +++ lisp/loadup.el 2011-04-15 03:15:22 +0000 @@ -263,7 +263,7 @@ (let* ((base (concat "emacs-" emacs-version ".")) (files (file-name-all-completions base default-directory)) (versions (mapcar (function (lambda (name) - (string-to-int (substring name (length base))))) + (string-to-number (substring name (length base))))) files))) ;; `emacs-version' is a constant, so we shouldn't change it with `setq'. (defconst emacs-version ------------------------------------------------------------ Use --include-merges or -n0 to see merged revisions.