Mercurial > emacs
changeset 87859:1bb83c2fe524
Merge from gnus--devo--0
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-1001
| author | Miles Bader <miles@gnu.org> |
|---|---|
| date | Sun, 20 Jan 2008 05:17:57 +0000 |
| parents | f176bf2c0e6d |
| children | c250fe62d36e |
| files | doc/misc/ChangeLog doc/misc/gnus-news.texi etc/GNUS-NEWS lisp/ChangeLog lisp/gnus/ChangeLog lisp/gnus/gnus-art.el lisp/gnus/gnus-registry.el lisp/gnus/gnus-sum.el lisp/net/imap.el |
| diffstat | 9 files changed, 328 insertions(+), 147 deletions(-) [+] |
line wrap: on
line diff
--- a/doc/misc/ChangeLog Sun Jan 20 04:02:15 2008 +0000 +++ b/doc/misc/ChangeLog Sun Jan 20 05:17:57 2008 +0000 @@ -1,3 +1,11 @@ +2008-01-18 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-news.texi: Mention gnus-article-describe-bindings. + +2008-01-18 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-news.texi: Mention gnus-article-wide-reply-with-original. + 2008-01-18 Carsten Dominik <dominik@science.uva.nl> * org.texi (Property inheritance): New section.
--- a/doc/misc/gnus-news.texi Sun Jan 20 04:02:15 2008 +0000 +++ b/doc/misc/gnus-news.texi Sun Jan 20 05:17:57 2008 +0000 @@ -140,6 +140,19 @@ emacs-mime, The Emacs MIME Manual}. (New in Gnus 5.10.7) @c This entry is also present in the node "Oort Gnus". +@item Now the new command @kbd{S W} +(@code{gnus-article-wide-reply-with-original}) for a wide reply in the +article buffer yanks a text that is in the active region, if it is set, +as well as the @kbd{R} (@code{gnus-article-reply-with-original}) command. +Note that the @kbd{R} command in the article buffer no longer accepts a +prefix argument, which was used to make it do a wide reply. +@xref{Article Keymap}. + +@item The new command @kbd{C-h b} +(@code{gnus-article-describe-bindings}) used in the article buffer now +shows not only the article commands but also the real summary commands +that are accessible from the article buffer. + @end itemize @item Changes in Message mode
--- a/etc/GNUS-NEWS Sun Jan 20 04:02:15 2008 +0000 +++ b/etc/GNUS-NEWS Sun Jan 20 05:17:57 2008 +0000 @@ -58,7 +58,7 @@ ** International host names (IDNA) can now be decoded inside article bodies using `W i' (`gnus-summary-idna-message'). This requires that GNU Libidn -(<http://www.gnu.org/software/libidn/>) has been installed. +(`http://www.gnu.org/software/libidn/') has been installed. ** The non-ASCII group names handling has been much improved. The back ends that fully support non-ASCII group names are now `nntp', `nnml', @@ -106,13 +106,24 @@ ** You can replace MIME parts with external bodies. See `gnus-mime-replace-part' and `gnus-article-replace-part'. *Note MIME -Commands::, *Note Using MIME::. +Commands::, *note Using MIME::. ** The option `mm-fill-flowed' can be used to disable treatment of format=flowed messages. Also, flowed text is disabled when sending inline PGP signed messages. *Note Flowed text: (emacs-mime)Flowed text. (New in Gnus 5.10.7) +** Now the new command `S W' (`gnus-article-wide-reply-with-original') for +a wide reply in the article buffer yanks a text that is in the active +region, if it is set, as well as the `R' +(`gnus-article-reply-with-original') command. Note that the `R' command +in the article buffer no longer accepts a prefix argument, which was +used to make it do a wide reply. *Note Article Keymap::. + +** The new command `C-h b' (`gnus-article-describe-bindings') used in the +article buffer now shows not only the article commands but also the real +summary commands that are accessible from the article buffer. + * Changes in Message mode
--- a/lisp/ChangeLog Sun Jan 20 04:02:15 2008 +0000 +++ b/lisp/ChangeLog Sun Jan 20 05:17:57 2008 +0000 @@ -1,3 +1,14 @@ +2008-01-19 Reiner Steib <Reiner.Steib@gmx.de> + + * net/imap.el (imap-ping-server): New variable. + (imap-opened): On add extra ping if imap-ping-server is non-nil. + (imap-ping-server): Minor doc string fixes. + +2008-01-19 Knut Anders Hatlen <kahatlen@gmail.com> (tiny change) + + * net/imap.el (imap-ping-server): New function. + (imap-opened): Call imap-ping-server. + 2008-01-20 Glenn Morris <rgm@gnu.org> * progmodes/python.el: Quote all calls to "auxiliary skeleton"s to @@ -108,9 +119,11 @@ (org-flag-drawer): Use the original value of `outline-regexp'. (org-remember-handler): Add invisible-ok flag to call to `org-end-of-subtree'. - (org-agenda-highlight-todo): Respect `org-agenda-todo-keyword-format'. + (org-agenda-highlight-todo): Respect + `org-agenda-todo-keyword-format'. (org-agenda-todo-keyword-format): New option. - (org-infile-export-plist): No restriction while searching for options. + (org-infile-export-plist): No restriction while searching for + options. (org-remember-handler): Remove comments at the end of the buffer. (org-remember-use-refile-when-interactive): New option. (org-table-sort-lines): Make sure sorting works on link @@ -121,7 +134,8 @@ `full-file-path'. (org-get-refile-targets): Respect new values for `org-refile-use-outline-path'. - (org-agenda-get-restriction-and-command): DEL goes back to initial list. + (org-agenda-get-restriction-and-command): DEL goes back to initial + list. (org-export-as-xoxo): Restore point when done. (org-open-file): Allow multiple %s in command. (org-clock-in-switch-to-state): New option. @@ -129,7 +143,8 @@ (org-last-remember-storage-locations): New variable. (org-get-refile-targets): Interpret the new maxlevel setting. (org-refile-targets): New option `:maxlevel'. - (org-copy-subtree): Include empty lines before but not after subtree. + (org-copy-subtree): Include empty lines before but not after + subtree. (org-back-over-empty-lines, org-skip-whitespace): New functions. (org-move-item-down, org-move-item-up): Include empty lines before but not after item. @@ -142,7 +157,8 @@ (org-imenu-markers): New variable. (org-imenu-new-marker, org-imenu-get-tree) (org-speedbar-set-agenda-restriction): New functions. - (org-agenda-set-restriction-lock, org-agenda-remove-restriction-lock) + (org-agenda-set-restriction-lock) + (org-agenda-remove-restriction-lock) (org-agenda-maybe-redo): New functions. (org-agenda-restriction-lock): New face. (org-agenda-restriction-lock-overlay) @@ -164,8 +180,8 @@ (org-link-escape-chars): Use characters instead of strings. (org-link-escape-chars-browser, org-link-escape) (org-link-unescape): Use characters instead of strings. - (org-export-html-convert-sub-super, org-html-do-expand): - Check for protected text. + (org-export-html-convert-sub-super, org-html-do-expand): Check for + protected text. (org-emphasis-alist): Additional `verbatim' flag. (org-set-emph-re): Handle the verbatim flag and compute `org-verbatim-re'. @@ -174,13 +190,15 @@ (org-hide-emphasis-markers): New option. (org-additional-option-like-keywords): Add new keywords. (org-get-entry): Rename from `org-get-cleaned-entry'. - (org-icalendar-cleanup-string): New function for quoting icalendar text. + (org-icalendar-cleanup-string): New function for quoting icalendar + text. (org-agenda-skip-scheduled-if-done): New option. - (org-agenda-get-scheduled, org-agenda-get-blocks): - Use `org-agenda-skip-scheduled-if-done'. + (org-agenda-get-scheduled, org-agenda-get-blocks): Use + `org-agenda-skip-scheduled-if-done'. (org-prepare-agenda-buffers): Allow buffers as arguments. (org-entry-properties): Add CATEGORY as a special property. - (org-use-property-inheritance): Allow a list of properties as a value. + (org-use-property-inheritance): Allow a list of properties as a + value. (org-eval-in-calendar): No longer update the prompt. (org-read-date-popup-calendar): Rename from `org-popup-calendar-for-date-prompt'. @@ -191,8 +209,8 @@ not yet defined. (org-remember-insinuate): New function. (org-read-date-prefer-future): New option. - (org-read-date): Respect the setting of `org-read-date-prefer-future'. - Use `org-read-date-analyze'. + (org-read-date): Respect the setting of + `org-read-date-prefer-future'. Use `org-read-date-analyze'. (org-set-font-lock-defaults): Use `org-archive-tag' instead of a hardcoded string. (org-remember-apply-template): Use `remember-finalize' instead of @@ -1482,6 +1500,12 @@ * newcomment.el (comment-region-default): Don't triple the comment starter if the first region line isn't indented enough. +2007-12-21 Teodor Zlatanov <tzz@lifelogs.com> + + * net/imap.el (imap-authenticate): Use current-buffer instead of + buffer, for the cases where imap-authenticate is called with a nil + buffer parameter. + 2007-12-21 Martin Rudalics <rudalics@gmx.at> * autoinsert.el (auto-insert-alist): Remove nonsensical precision @@ -2172,6 +2196,12 @@ * textmodes/reftex-toc.el (reftex-make-separate-toc-frame): Try x-focus-frame before focus-frame. Only try focus-frame on XEmacs. +2007-12-03 Nathan J. Williams <nathanw@MIT.EDU> (tiny change) + + * net/imap.el (imap-mailbox-status-asynch): Upcase STATUS items. + (imap-parse-status): Upcase status-att for servers that sends them + lower-case (e.g., MS Exchange 2007). + 2007-12-03 Karl Fogel <kfogel@red-bean.com> * saveplace.el (save-place-quiet): Remove, reverting 1.39.
--- a/lisp/gnus/ChangeLog Sun Jan 20 04:02:15 2008 +0000 +++ b/lisp/gnus/ChangeLog Sun Jan 20 05:17:57 2008 +0000 @@ -1,3 +1,54 @@ +2008-01-18 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-describe-bindings): Make it possible to use + xrefs, i.e. [back] and [forward] buttons, in *Help* buffer. + +2008-01-18 Teodor Zlatanov <tzz@lifelogs.com> + + * gnus-registry.el (gnus-registry-trim): Use append, not concat. + +2008-01-17 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-read-summary-keys): Work for some `A' + prefix keys. + (gnus-article-read-summary-send-keys): Use gnus-character-to-event. + (gnus-article-describe-bindings): Simplify; move XEmacs stuff to + gnus-xmas.el. + +2008-01-16 Teodor Zlatanov <tzz@lifelogs.com> + + * gnus-registry.el (gnus-registry-marks, gnus-registry-default-mark): + Add new variables for article mark management. + (gnus-registry-extra-entries-precious, gnus-registry-trim): Define a + list of extra data entries which, when present, will indicate that the + article ID should not be trimmed from the registry. + (gnus-registry-mark-article, gnus-registry-article-marks): Remove these + functions. + (gnus-registry-read-mark): New function to read a mark name from the + user. + (gnus-registry-set-article-mark, gnus-registry-remove-article-mark) + (gnus-registry-set-article-mark-internal): New functions to add and + remove marks. + (gnus-registry-get-article-marks): New function to show the marks for + an article, or retrieve them for further use. + +2008-01-16 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-describe-bindings): Show all `S' prefix + keys when no argument is given. + +2008-01-12 Reiner Steib <Reiner.Steib@gmx.de> + + * gnus-sum.el (gnus-article-sort-by-random) + (gnus-thread-sort-by-random): Fix doc strings. Reported by + jidanni@jidanni.org. + +2008-01-11 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-describe-bindings): New function. + (gnus-article-read-summary-keys): Use it. + (gnus-article-mode-map): Bind `C-h b' to it. + 2008-01-10 Katsumi Yamaoka <yamaoka@jpl.org> * gnus-art.el (gnus-article-read-summary-keys): Work for `C-h' on @@ -5,8 +56,6 @@ (gnus-article-describe-key, gnus-article-describe-key-briefly): Protect against non-character events. - * lpath.el: Fbind map-keymap for Emacs 21. - 2008-01-09 Reiner Steib <Reiner.Steib@gmx.de> * gnus-group.el (gnus-group-read-ephemeral-gmane-group-url): New @@ -31,9 +80,6 @@ (gnus-article-reply-with-original): Ignore prefix argument. (gnus-article-wide-reply-with-original): New function. - * lpath.el: Fbind character-to-event and set-keymap-default-binding for - Emacs 21. - 2008-01-08 Katsumi Yamaoka <yamaoka@jpl.org> * gnus-bookmark.el (gnus-bookmark-mouse-available-p): Don't test for @@ -55,12 +101,6 @@ * mml-sec.el, sieve-manage.el, smime.el: Simplify loading of password-cache or password. Suggested by Glenn Morris <rgm@gnu.org>. -2007-12-21 Teodor Zlatanov <tzz@lifelogs.com> - - * imap.el (imap-authenticate): Use current-buffer instead of buffer, - for the cases where imap-authenticate is called with a nil buffer - parameter. - 2007-12-19 Katsumi Yamaoka <yamaoka@jpl.org> * gnus-art.el (gnus-article-browse-html-parts): Work for two or more @@ -364,12 +404,6 @@ * message.el (message-ignored-supersedes-headers): Add "X-ID". -2007-12-03 Nathan J. Williams <nathanw@MIT.EDU> (tiny change) - - * imap.el (imap-mailbox-status-asynch): Upcase STATUS items. - (imap-parse-status): Upcase status-att for servers that sends them - lower-case (e.g., MS Exchange 2007). - 2007-12-03 Lars Magne Ingebrigtsen <larsi@gnus.org> * gnus-sum.el (gnus-uu-extract-map): Add a command for the yenc @@ -837,9 +871,6 @@ * webmail.el (webmail-debug): Replace mapcar called for effect with dolist. - * gnus-xmas.el (gnus-group-add-icon): Replace mapcar called for effect - with mapc. - 2007-10-24 Katsumi Yamaoka <yamaoka@jpl.org> * gnus-agent.el (gnus-agent-read-agentview, gnus-agent-save-alist)
--- a/lisp/gnus/gnus-art.el Sun Jan 20 04:02:15 2008 +0000 +++ b/lisp/gnus/gnus-art.el Sun Jan 20 05:17:57 2008 +0000 @@ -4215,6 +4215,7 @@ "F" gnus-article-followup-with-original "\C-hk" gnus-article-describe-key "\C-hc" gnus-article-describe-key-briefly + "\C-hb" gnus-article-describe-bindings "\C-d" gnus-article-read-summary-keys "\M-*" gnus-article-read-summary-keys @@ -6241,9 +6242,10 @@ "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" "=" "^" "\M-^" "|")) (nosave-but-article - '("A\r")) + '("A " "A<" "A>" "AM" "AP" "AR" "AT" "A\C-?" "A\M-\r" "A\r" "Ab" "Ae" + "An" "Ap" [?A (meta return)] [?A delete])) (nosave-in-article - '("\C-d")) + '("AS" "\C-d")) (up-to-top '("n" "Gn" "p" "Gp")) keys new-sum-point) @@ -6260,27 +6262,7 @@ (cond ((eq (aref keys (1- (length keys))) ?\C-h) - (if (featurep 'xemacs) - (let ((keymap (with-current-buffer gnus-article-current-summary - (copy-keymap (current-local-map))))) - (map-keymap - (lambda (key def) - (define-key keymap (vector ?S key) def)) - gnus-article-send-map) - (with-temp-buffer - (setq major-mode 'gnus-article-mode) - (use-local-map keymap) - (describe-bindings (substring keys 0 -1)))) - (let ((keymap (make-sparse-keymap)) - (map (copy-keymap gnus-article-send-map))) - (define-key keymap "S" map) - (define-key map [t] nil) - (set-keymap-parent keymap - (with-current-buffer gnus-article-current-summary - (current-local-map))) - (with-temp-buffer - (use-local-map keymap) - (describe-bindings (substring keys 0 -1)))))) + (gnus-article-describe-bindings (substring keys 0 -1))) ((or (member keys nosaves) (member keys nosave-but-article) (member keys nosave-in-article)) @@ -6368,9 +6350,7 @@ (defun gnus-article-read-summary-send-keys () (interactive) - (let ((unread-command-events (list (if (featurep 'xemacs) - (character-to-event ?S) - ?S)))) + (let ((unread-command-events (list (gnus-character-to-event ?S)))) (gnus-article-read-summary-keys))) (defun gnus-article-describe-key (key) @@ -6418,6 +6398,43 @@ (describe-key-briefly (read-key-sequence nil t) insert))) (describe-key-briefly key insert))) +;;`gnus-agent-mode' in gnus-agent.el will define it. +(defvar gnus-agent-summary-mode) + +(defun gnus-article-describe-bindings (&optional prefix) + "Show a list of all defined keys, and their definitions. +The optional argument PREFIX, if non-nil, should be a key sequence; +then we display only bindings that start with that prefix." + (interactive) + (gnus-article-check-buffer) + (let ((keymap (copy-keymap gnus-article-mode-map)) + (map (copy-keymap gnus-article-send-map)) + (sumkeys (where-is-internal 'gnus-article-read-summary-keys)) + agent) + (define-key keymap "S" map) + (define-key map [t] nil) + (with-current-buffer gnus-article-current-summary + (set-keymap-parent map (key-binding "S")) + (let (def gnus-pick-mode) + (dolist (key sumkeys) + (when (setq def (key-binding key)) + (define-key keymap key def)))) + (when (boundp 'gnus-agent-summary-mode) + (setq agent gnus-agent-summary-mode))) + (with-temp-buffer + (use-local-map keymap) + (set (make-local-variable 'gnus-agent-summary-mode) agent) + (describe-bindings prefix)) + (let ((item `((lambda (prefix) + (save-excursion + (set-buffer ,(current-buffer)) + (gnus-article-describe-bindings prefix))) + ,prefix))) + (with-current-buffer (if (fboundp 'help-buffer) + (let (help-xref-following) (help-buffer)) + "*Help*") ;; Emacs 21 + (setq help-xref-stack-item item))))) + (defun gnus-article-reply-with-original (&optional wide) "Start composing a reply mail to the current message. The text in the region will be yanked. If the region isn't active,
--- a/lisp/gnus/gnus-registry.el Sun Jan 20 04:02:15 2008 +0000 +++ b/lisp/gnus/gnus-registry.el Sun Jan 20 05:17:57 2008 +0000 @@ -78,6 +78,17 @@ :test 'equal) "*The article registry by Message ID.") +(defcustom gnus-registry-marks + '(Important Work Personal To-Do Later) + "List of marks that `gnus-registry-mark-article' will offer for completion." + :group 'gnus-registry + :type '(repeat symbol)) + +(defcustom gnus-registry-default-mark 'To-Do + "The default mark." + :group 'gnus-registry + :type 'symbol) + (defcustom gnus-registry-unfollowed-groups '("delayed$" "drafts$" "queue$" "INBOX$") "List of groups that gnus-registry-split-fancy-with-parent won't return. The group names are matched, they don't have to be fully @@ -129,6 +140,16 @@ :group 'gnus-registry :type 'boolean) +(defcustom gnus-registry-extra-entries-precious '(marks) + "What extra entries are precious, meaning they won't get trimmed. +When you save the Gnus registry, it's trimmed to be no longer +than `gnus-registry-max-entries' (which is nil by default, so no +trimming happens). Any entries with extra data in this list (by +default, marks are included, so articles with marks are +considered precious) will not be trimmed." + :group 'gnus-registry + :type '(repeat symbol)) + (defcustom gnus-registry-cache-file (nnheader-concat (or gnus-dribble-directory gnus-home-directory "~/") @@ -313,30 +334,50 @@ (defun gnus-registry-trim (alist) "Trim alist to size, using gnus-registry-max-entries. -Also, drop all gnus-registry-ignored-groups matches." - (if (null gnus-registry-max-entries) +Also, drop all gnus-registry-ignored-groups matches. +Any entries with extra data (marks, currently) are left alone." + (if (null gnus-registry-max-entries) alist ; just return the alist ;; else, when given max-entries, trim the alist (let* ((timehash (make-hash-table - :size 4096 + :size 20000 + :test 'equal)) + (precious (make-hash-table + :size 20000 :test 'equal)) (trim-length (- (length alist) gnus-registry-max-entries)) - (trim-length (if (natnump trim-length) trim-length 0))) + (trim-length (if (natnump trim-length) trim-length 0)) + precious-list junk-list) (maphash (lambda (key value) - (puthash key (gnus-registry-fetch-extra key 'mtime) timehash)) + (let ((extra (gnus-registry-fetch-extra key))) + (dolist (item gnus-registry-extra-entries-precious) + (dolist (e extra) + (when (equal (nth 0 e) item) + (puthash key t precious) + (return)))) + (puthash key (gnus-registry-fetch-extra key 'mtime) timehash))) gnus-registry-hashtb) - + + (dolist (item alist) + (let ((key (nth 0 item))) + (if (gethash key precious) + (push item precious-list) + (push item junk-list)))) + + (sort + junk-list + (lambda (a b) + (let ((t1 (or (cdr (gethash (car a) timehash)) + '(0 0 0))) + (t2 (or (cdr (gethash (car b) timehash)) + '(0 0 0)))) + (time-less-p t1 t2)))) + ;; we use the return value of this setq, which is the trimmed alist - (setq alist - (nthcdr - trim-length - (sort alist - (lambda (a b) - (time-less-p - (or (cdr (gethash (car a) timehash)) '(0 0 0)) - (or (cdr (gethash (car b) timehash)) '(0 0 0)))))))))) - + (setq alist (append precious-list + (nthcdr trim-length junk-list)))))) + (defun gnus-registry-action (action data-header from &optional to method) (let* ((id (mail-header-id data-header)) (subject (gnus-string-remove-all-properties @@ -577,6 +618,7 @@ (assoc article (gnus-data-list nil))))) nil)) +;;; this should be redone with catch/throw (defun gnus-registry-grep-in-list (word list) (when word (memq nil @@ -586,80 +628,91 @@ (string-match word x)) list))))) -(defun gnus-registry-mark-article (article &optional mark remove) - "Mark ARTICLE with MARK in the Gnus registry or remove MARK. -MARK can be any symbol. If ARTICLE is nil, then the -`gnus-current-article' will be marked. If MARK is nil, -`gnus-registry-flag-default' will be used." - (interactive "nArticle number: ") - (let ((article (or article gnus-current-article)) - (mark (or mark 'gnus-registry-flag-default)) - article-id) - (unless article - (error "No article on current line")) - (setq article-id - (gnus-registry-fetch-message-id-fast gnus-current-article)) - (unless article-id - (error "No article ID could be retrieved")) - (let* ( - ;; all the marks for this article - (marks (gnus-registry-fetch-extra-flags article-id)) - ;; the marks without the mark of interest - (cleaned-marks (delq mark marks)) - ;; the new marks we want to use - (new-marks (if remove - cleaned-marks - (cons mark cleaned-marks)))) - (apply 'gnus-registry-store-extra-flags ; set the extra flags - article-id ; for the message ID - new-marks) - (gnus-registry-fetch-extra-flags article-id)))) + +(defun gnus-registry-read-mark () + "Read a mark name from the user with completion." + (let ((mark (gnus-completing-read-with-default + (symbol-name gnus-registry-default-mark) + "Label" + (mapcar (lambda (x) ; completion list + (cons (symbol-name x) x)) + gnus-registry-marks)))) + (when (stringp mark) + (intern mark)))) + +(defun gnus-registry-set-article-mark (&rest articles) + "Apply a mark to process-marked ARTICLES." + (interactive (gnus-summary-work-articles current-prefix-arg)) + (gnus-registry-set-article-mark-internal (gnus-registry-read-mark) articles nil t)) + +(defun gnus-registry-remove-article-mark (&rest articles) + "Remove a mark from process-marked ARTICLES." + (interactive (gnus-summary-work-articles current-prefix-arg)) + (gnus-registry-set-article-mark-internal (gnus-registry-read-mark) articles t t)) -(defun gnus-registry-article-marks (article) - "Get the Gnus registry marks for ARTICLE. -If ARTICLE is nil, then the `gnus-current-article' will be -used." - (interactive "nArticle number: ") - (let ((article (or article gnus-current-article)) - article-id) - (unless article - (error "No article on current line")) - (setq article-id - (gnus-registry-fetch-message-id-fast gnus-current-article)) - (unless article-id - (error "No article ID could be retrieved")) - (gnus-message 1 - "Message ID %s, Registry flags: %s" - article-id - (concat (gnus-registry-fetch-extra-flags article-id))))) - +(defun gnus-registry-set-article-mark-internal (mark articles &optional remove show-message) + "Apply a mark to a list of ARTICLES." + (let ((article-id-list + (mapcar 'gnus-registry-fetch-message-id-fast articles))) + (dolist (id article-id-list) + (let* ( + ;; all the marks for this article without the mark of + ;; interest + (marks + (delq mark (gnus-registry-fetch-extra-marks id))) + ;; the new marks we want to use + (new-marks (if remove + marks + (cons mark marks)))) + (when show-message + (gnus-message 1 "%s mark %s with message ID %s, resulting in %S" + (if remove "Removing" "Adding") + mark id new-marks)) + + (apply 'gnus-registry-store-extra-marks ; set the extra marks + id ; for the message ID + new-marks))))) -;;; if this extends to more than 'flags, it should be improved to be more generic. -(defun gnus-registry-fetch-extra-flags (id) - "Get the flags of a message, based on the message ID. -Returns a list of symbol flags or nil." - (car-safe (cdr (gnus-registry-fetch-extra id 'flags)))) +(defun gnus-registry-get-article-marks (&rest articles) + "Get the Gnus registry marks for ARTICLES and show them if interactive. +Uses process/prefix conventions. For multiple articles, +only the last one's marks are returned." + (interactive (gnus-summary-work-articles 1)) + (let (marks) + (dolist (article articles) + (let ((article-id + (gnus-registry-fetch-message-id-fast article))) + (setq marks (gnus-registry-fetch-extra-marks article-id)))) + (when (interactive-p) + (gnus-message 1 "Marks are %S" marks)) + marks)) -(defun gnus-registry-has-extra-flag (id flag) - "Checks if a message has `flag', based on the message ID." - (memq flag (gnus-registry-fetch-extra-flags id))) +;;; if this extends to more than 'marks, it should be improved to be more generic. +(defun gnus-registry-fetch-extra-marks (id) + "Get the marks of a message, based on the message ID. +Returns a list of symbol marks or nil." + (car-safe (cdr (gnus-registry-fetch-extra id 'marks)))) -(defun gnus-registry-store-extra-flags (id &rest flag-list) - "Set the flags of a message, based on the message ID. -The `flag-list' can be nil, in which case no flags are left." - (gnus-registry-store-extra-entry id 'flags (list flag-list))) +(defun gnus-registry-has-extra-mark (id mark) + "Checks if a message has `mark', based on the message ID `id'." + (memq mark (gnus-registry-fetch-extra-marks id))) + +(defun gnus-registry-store-extra-marks (id &rest mark-list) + "Set the marks of a message, based on the message ID. +The `mark-list' can be nil, in which case no marks are left." + (gnus-registry-store-extra-entry id 'marks (list mark-list))) -(defun gnus-registry-delete-extra-flags (id &rest flag-delete-list) - "Delete the message flags in `flag-delete-list', based on the message ID." - (let ((flags (gnus-registry-fetch-extra-flags id))) - (when flags - (dolist (flag flag-delete-list) - (setq flags (delq flag flags)))) - (gnus-registry-store-extra-flags id (car flags)))) +(defun gnus-registry-delete-extra-marks (id &rest mark-delete-list) + "Delete the message marks in `mark-delete-list', based on the message ID." + (let ((marks (gnus-registry-fetch-extra-marks id))) + (when marks + (dolist (mark mark-delete-list) + (setq marks (delq mark marks)))) + (gnus-registry-store-extra-marks id (car marks)))) -(defun gnus-registry-delete-all-extra-flags (id) - "Delete all the flags for a message ID." - (gnus-registry-store-extra-flags id nil)) +(defun gnus-registry-delete-all-extra-marks (id) + "Delete all the marks for a message ID." + (gnus-registry-store-extra-marks id nil)) (defun gnus-registry-fetch-extra (id &optional entry) "Get the extra data of a message, based on the message ID.
--- a/lisp/gnus/gnus-sum.el Sun Jan 20 04:02:15 2008 +0000 +++ b/lisp/gnus/gnus-sum.el Sun Jan 20 05:17:57 2008 +0000 @@ -4797,11 +4797,11 @@ (gnus-thread-header h1) (gnus-thread-header h2))) (defsubst gnus-article-sort-by-random (h1 h2) - "Sort articles by article number." + "Sort articles randomly." (zerop (random 2))) (defun gnus-thread-sort-by-random (h1 h2) - "Sort threads by root article number." + "Sort threads randomly." (gnus-article-sort-by-random (gnus-thread-header h1) (gnus-thread-header h2)))
--- a/lisp/net/imap.el Sun Jan 20 04:02:15 2008 +0000 +++ b/lisp/net/imap.el Sun Jan 20 05:17:57 2008 +0000 @@ -1150,6 +1150,13 @@ (when imap-stream buffer)))) +(defcustom imap-ping-server t + "If non-nil, check if IMAP is open. +See the function `imap-ping-server'." + :version "23.0" ;; No Gnus + :group 'imap + :type 'boolean) + (defun imap-opened (&optional buffer) "Return non-nil if connection to imap server in BUFFER is open. If BUFFER is nil then the current buffer is used." @@ -1157,7 +1164,18 @@ (buffer-live-p buffer) (with-current-buffer buffer (and imap-process - (memq (process-status imap-process) '(open run)))))) + (memq (process-status imap-process) '(open run)) + (if imap-ping-server + (imap-ping-server) + t))))) + +(defun imap-ping-server (&optional buffer) + "Ping the IMAP server in BUFFER with a \"NOOP\" command. +Return non-nil if the server responds, and nil if it does not +respond. If BUFFER is nil, the current buffer is used." + (condition-case () + (imap-ok-p (imap-send-command-wait "NOOP" buffer)) + (error nil))) (defun imap-authenticate (&optional user passwd buffer) "Authenticate to server in BUFFER, using current buffer if nil.