From a5954fa5c84101c99857ea65196ef9050138119f Mon Sep 17 00:00:00 2001 From: Gnus developers Date: Wed, 30 Mar 2011 14:59:42 +0000 Subject: [PATCH] Merge Gnus' changes. gnus.texi (Listing Groups): Document gnus-group-list-ticked. gssapi.el (open-gssapi-stream): Remove the last mentions of the IMAP stuff. gnus-score.el (gnus-score-string): Fix calling convention of `gnus-simplify-buffer-fuzzy' after last patches. gnus-sum.el (gnus-update-marks): Don't send any marks updates to the server for articles we didn't get any headers for. This is a sanity check. nnimap.el (nnimap-open-connection-1): Is the login responds with a new CAPABILITY, use it. gnus-agent.el (gnus-agent-fetch-headers): Don't message if we're not downloading anything. gnus.el (gnus-splash-svg-color-symbols): Removed superfluous `and'. gnus.el (gnus-group-startup-message): Prefer svg file and replace colors. (gnus-splash-svg-color-symbols): New function. gnus-sum.el (gnus-simplify-buffer-fuzzy): Take the regexp explicitly instead of using the global gnus-simplify-subject-fuzzy-regexp. (gnus-simplify-subject-fuzzy): Use the local gnus-simplify-subject-fuzzy-regex instead of the global one. This makes using this variable in group parameters work. gnus-registry.el (gnus-registry-unfollowed-groups): Add "archive:sent" to the unfollowed group regex (for the recent Gnus archive:sent-YYYY-MM-DD groups). (gnus-registry-split-fancy-with-parent): Bail out early in sender tracking if there are more than `gnus-registry-max-track-groups' matches. message.el (message--yank-original-internal): New function to do the insertion cleanly inside eval in `message-yank-original'. (message-yank-original): Use it. --- doc/misc/ChangeLog | 4 +++ doc/misc/gnus.texi | 5 ++++ lisp/gnus/ChangeLog | 53 ++++++++++++++++++++++++++++++++++++++ lisp/gnus/gnus-agent.el | 7 ++--- lisp/gnus/gnus-registry.el | 40 ++++++++++++++-------------- lisp/gnus/gnus-score.el | 2 +- lisp/gnus/gnus-sum.el | 49 +++++++++++++++++++++-------------- lisp/gnus/gnus.el | 25 +++++++++++++++--- lisp/gnus/gssapi.el | 14 +++++----- lisp/gnus/message.el | 33 +++++++++++++----------- lisp/gnus/nnimap.el | 15 ++++++++--- 11 files changed, 174 insertions(+), 73 deletions(-) diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 50f0e4e45b9..1c29d2598a8 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,7 @@ +2011-03-19 Antoine Levitt + + * gnus.texi (Listing Groups): Document gnus-group-list-ticked + 2011-03-17 Jay Belanger * calc.texi (Logarithmic Units): Update the function names. diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index b55452cfa82..9771392f0cc 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -3320,6 +3320,11 @@ List all groups with cached articles (@code{gnus-group-list-cached}). @findex gnus-group-list-dormant List all groups with dormant articles (@code{gnus-group-list-dormant}). +@item A ! +@kindex A ! (Group) +@findex gnus-group-list-ticked +List all groups with ticked articles (@code{gnus-group-list-ticked}). + @item A / @kindex A / (Group) @findex gnus-group-list-limit diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index f6b7db61d96..51169f7b9df 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -15,6 +15,59 @@ nntp-open-plain-stream value. (nntp-open-connection): Recognize that value. +2011-03-29 Lars Magne Ingebrigtsen + + * gssapi.el (open-gssapi-stream): Remove the last mentions of the IMAP + stuff. + + * gnus-score.el (gnus-score-string): Fix calling convention of + `gnus-simplify-buffer-fuzzy' after last patches. + + * gnus-sum.el (gnus-update-marks): Don't send any marks updates to the + server for articles we didn't get any headers for. This is a sanity + check. + +2011-03-29 Michael Welsh Duggan + + * nnimap.el (nnimap-open-connection-1): Is the login responds with a + new CAPABILITY, use it. + +2011-03-29 Lars Magne Ingebrigtsen + + * gnus-agent.el (gnus-agent-fetch-headers): Don't message if we're not + downloading anything. + + * gnus.el (gnus-splash-svg-color-symbols): Removed superfluous `and'. + +2011-03-29 Adam Sjøgren + + * gnus.el (gnus-group-startup-message): Prefer svg file and replace + colors. + (gnus-splash-svg-color-symbols): New function. + +2011-03-29 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-simplify-buffer-fuzzy): Take the regexp explicitly + instead of using the global gnus-simplify-subject-fuzzy-regexp. + (gnus-simplify-subject-fuzzy): Use the local + gnus-simplify-subject-fuzzy-regex instead of the global one. This + makes using this variable in group parameters work. + +2011-03-29 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-unfollowed-groups): Add + "archive:sent" to the unfollowed group regex (for the recent Gnus + archive:sent-YYYY-MM-DD groups). + (gnus-registry-split-fancy-with-parent): Bail out early in sender + tracking if there are more than `gnus-registry-max-track-groups' + matches. + +2011-03-29 Stefan Monnier + + * message.el (message--yank-original-internal): New function to do the + insertion cleanly inside eval in `message-yank-original'. + (message-yank-original): Use it. + 2011-03-29 Julien Danjou * mm-view.el (mm-display-inline-fontify): Use `set-normal-mode' with diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 989488c0995..52fbe9da11f 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -1925,9 +1925,10 @@ article numbers will be returned." (setq articles (gnus-list-range-intersection articles (list (cons low high))))))) - (gnus-message - 10 "gnus-agent-fetch-headers: undownloaded articles are '%s'" - (gnus-compress-sequence articles t)) + (when articles + (gnus-message + 10 "gnus-agent-fetch-headers: undownloaded articles are '%s'" + (gnus-compress-sequence articles t))) (with-current-buffer nntp-server-buffer (if articles diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index cef173ce1ec..db3cc06e9aa 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -124,7 +124,7 @@ display." :type 'symbol) (defcustom gnus-registry-unfollowed-groups - '("delayed$" "drafts$" "queue$" "INBOX$" "^nnmairix:") + '("delayed$" "drafts$" "queue$" "INBOX$" "^nnmairix:" "archive") "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 qualified. This parameter tells the Registry 'never split a @@ -541,24 +541,26 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." user-mail-address))) (maphash (lambda (key value) - (let ((this-sender (cdr - (gnus-registry-fetch-extra key 'sender))) - matches) - (when (and this-sender - (equal sender this-sender)) - (let ((groups (gnus-registry-fetch-groups - key - gnus-registry-max-track-groups))) - (dolist (group groups) - (when (and group (gnus-registry-follow-group-p group)) - (push group found-full) - (setq found (append (list group) (delete group found)))))) - (push key matches) - (gnus-message - ;; raise level of messaging if gnus-registry-track-extra - (if gnus-registry-track-extra 7 9) - "%s (extra tracking) traced sender %s to groups %s (keys %s)" - log-agent sender found matches)))) + ;; don't use more than gnus-registry-max-track-groups + (when (< (length found-full) gnus-registry-max-track-groups) + (let ((this-sender + (cdr (gnus-registry-fetch-extra key 'sender))) + matches) + (when (and this-sender + (equal sender this-sender)) + (let ((groups (gnus-registry-fetch-groups + key + gnus-registry-max-track-groups))) + (dolist (group groups) + (when (and group (gnus-registry-follow-group-p group)) + (push group found-full) + (setq found (append (list group) (delete group found)))))) + (push key matches) + (gnus-message + ;; raise level of messaging if gnus-registry-track-extra + (if gnus-registry-track-extra 7 9) + "%s (extra tracking) traced sender %s to groups %s (keys %s)" + log-agent sender found matches))))) gnus-registry-hashtb) ;; filter the found groups and return them ;; the found groups are NOT the full groups diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index e376b7a7b6e..9bbfbfb057e 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -2151,7 +2151,7 @@ score in `gnus-newsgroup-scored' by SCORE." ;; Find fuzzy matches. (when fuzzies ;; Simplify the entire buffer for easy matching. - (gnus-simplify-buffer-fuzzy) + (gnus-simplify-buffer-fuzzy gnus-simplify-subject-fuzzy-regexp) (while (setq kill (cadaar fuzzies)) (let* ((match (nth 0 kill)) (type (nth 3 kill)) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 9b22bbe39da..91dc6fb9595 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -1734,7 +1734,7 @@ If RE-ONLY is non-nil, strip leading `Re:'s only." (while (re-search-forward regexp nil t) (replace-match (or newtext "")))) -(defun gnus-simplify-buffer-fuzzy () +(defun gnus-simplify-buffer-fuzzy (regexp) "Simplify string in the buffer fuzzily. The string in the accessible portion of the current buffer is simplified. It is assumed to be a single-line subject. @@ -1748,11 +1748,10 @@ matter is removed. Additional things can be deleted by setting (while (not (eq modified-tick (buffer-modified-tick))) (setq modified-tick (buffer-modified-tick)) (cond - ((listp gnus-simplify-subject-fuzzy-regexp) - (mapc 'gnus-simplify-buffer-fuzzy-step - gnus-simplify-subject-fuzzy-regexp)) - (gnus-simplify-subject-fuzzy-regexp - (gnus-simplify-buffer-fuzzy-step gnus-simplify-subject-fuzzy-regexp))) + ((listp regexp) + (mapc 'gnus-simplify-buffer-fuzzy-step regexp)) + (regexp + (gnus-simplify-buffer-fuzzy-step regexp))) (gnus-simplify-buffer-fuzzy-step "^ *\\[[-+?*!][-+?*!]\\] *") (gnus-simplify-buffer-fuzzy-step "^ *\\(re\\|fw\\|fwd\\)[[{(^0-9]*[])}]?[:;] *") @@ -1767,15 +1766,16 @@ matter is removed. Additional things can be deleted by setting "Simplify a subject string fuzzily. See `gnus-simplify-buffer-fuzzy' for details." (save-excursion - (gnus-set-work-buffer) - (let ((case-fold-search t)) - ;; Remove uninteresting prefixes. - (when (and gnus-simplify-ignored-prefixes - (string-match gnus-simplify-ignored-prefixes subject)) - (setq subject (substring subject (match-end 0)))) - (insert subject) - (inline (gnus-simplify-buffer-fuzzy)) - (buffer-string)))) + (let ((regexp gnus-simplify-subject-fuzzy-regexp)) + (gnus-set-work-buffer) + (let ((case-fold-search t)) + ;; Remove uninteresting prefixes. + (when (and gnus-simplify-ignored-prefixes + (string-match gnus-simplify-ignored-prefixes subject)) + (setq subject (substring subject (match-end 0)))) + (insert subject) + (inline (gnus-simplify-buffer-fuzzy regexp)) + (buffer-string))))) (defsubst gnus-simplify-subject-fully (subject) "Simplify a subject string according to `gnus-summary-gather-subject-limit'." @@ -6068,14 +6068,23 @@ If SELECT-ARTICLES, only select those articles from GROUP." 'request-set-mark gnus-newsgroup-name) (not (gnus-article-unpropagatable-p (cdr type)))) (let* ((old (cdr (assq (cdr type) (gnus-info-marks info)))) - (del (gnus-remove-from-range (gnus-copy-sequence old) list)) - (add (gnus-remove-from-range - (gnus-copy-sequence list) old))) + ;; Don't do anything about marks for articles we + ;; didn't actually get any headers for. + (existing (gnus-compress-sequence gnus-newsgroup-articles)) + (del + (gnus-sorted-range-intersection + existing + (gnus-remove-from-range (gnus-copy-sequence old) list))) + (add + (gnus-sorted-range-intersection + existing + (gnus-remove-from-range + (gnus-copy-sequence list) old)))) (when add (push (list add 'add (list (cdr type))) delta-marks)) (when del - ;; Don't delete marks from outside the active range. This - ;; shouldn't happen, but is a sanity check. + ;; Don't delete marks from outside the active range. + ;; This shouldn't happen, but is a sanity check. (setq del (gnus-sorted-range-intersection (gnus-active gnus-newsgroup-name) del)) (push (list del 'del (list (cdr type))) delta-marks)))) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 57d085a0380..d4ecd89db92 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -1043,12 +1043,15 @@ be set in `.emacs' instead." ((boundp 'image-load-path) (symbol-value 'image-load-path)) (t load-path))) - (image (find-image - `((:type xpm :file "gnus.xpm" + (image (gnus-splash-svg-color-symbols (find-image + `((:type svg :file "gnus.svg" + :color-symbols + (("#bf9900" . ,(car gnus-logo-colors)) + ("#ffcc00" . ,(cadr gnus-logo-colors)))) + (:type xpm :file "gnus.xpm" :color-symbols (("thing" . ,(car gnus-logo-colors)) ("shadow" . ,(cadr gnus-logo-colors)))) - (:type svg :file "gnus.svg") (:type png :file "gnus.png") (:type pbm :file "gnus.pbm" ;; Account for the pbm's background. @@ -1057,7 +1060,7 @@ be set in `.emacs' instead." (:type xbm :file "gnus.xbm" ;; Account for the xbm's background. :background ,(face-foreground 'gnus-splash) - :foreground ,(face-background 'default)))))) + :foreground ,(face-background 'default))))))) (when image (let ((size (image-size image))) (insert-char ?\n (max 0 (round (- (window-height) @@ -1103,6 +1106,20 @@ be set in `.emacs' instead." (setq mode-line-buffer-identification (concat " " gnus-version)) (set-buffer-modified-p t))) +(defun gnus-splash-svg-color-symbols (list) + "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)))) + (mapc (lambda (rule) + (setq data (replace-regexp-in-string + (concat "fill:" (car rule)) + (concat "fill:" (cdr rule)) data))) color-symbols) + (cons (car list) (list :type type :data data))) + list))) + (eval-when (load) (let ((command (format "%s" this-command))) (when (string-match "gnus" command) diff --git a/lisp/gnus/gssapi.el b/lisp/gnus/gssapi.el index 3765fb84ee8..e96c23b14ac 100644 --- a/lisp/gnus/gssapi.el +++ b/lisp/gnus/gssapi.el @@ -33,14 +33,14 @@ "--authentication-id %l") "imtest -m gssapi -u %l -p %p %s") "List of strings containing commands for GSSAPI (krb5) authentication. -%s is replaced with server hostname, %p with port to connect to, and -%l with the value of `imap-default-user'. The program should accept -IMAP commands on stdin and return responses to stdout. Each entry in -the list is tried until a successful connection is made." +%s is replaced with server hostname, %p with port to connect to, +and %l with the user name. The program should accept commands on +stdin and return responses to stdout. Each entry in the list is +tried until a successful connection is made." :group 'network :type '(repeat string)) -(defun open-gssapi-stream (name buffer server port) +(defun open-gssapi-stream (name buffer server port user) (let ((cmds gssapi-program) cmd done) (with-current-buffer buffer @@ -57,7 +57,7 @@ the list is tried until a successful connection is made." (format-spec-make ?s server ?p (number-to-string port) - ?l imap-default-user)))) + ?l user)))) response) (when process (while (and (memq (process-status process) '(open run)) @@ -92,7 +92,7 @@ the list is tried until a successful connection is made." (accept-process-output process 1) (sit-for 1)) (erase-buffer) - (message "GSSAPI IMAP connection: %s" (or response "failed")) + (message "GSSAPI connection: %s" (or response "failed")) (if (and response (let ((case-fold-search nil)) (not (string-match "failed" response)))) (setq done process) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index bb9215aca7c..6d9fd712c33 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -3712,22 +3712,9 @@ To use this automatically, you may add this function to (while (re-search-forward citexp nil t) (replace-match (if remove "" "\n")))))) -(defun message-yank-original (&optional arg) - "Insert the message being replied to, if any. -Puts point before the text and mark after. -Normally indents each nonblank line ARG spaces (default 3). However, -if `message-yank-prefix' is non-nil, insert that prefix on each line. - -This function uses `message-cite-function' to do the actual citing. - -Just \\[universal-argument] as argument means don't indent, insert no -prefix, and don't delete any headers." - (interactive "P") +(defun message--yank-original-internal (arg) (let ((modified (buffer-modified-p)) body-text) - ;; eval the let forms contained in message-cite-style - (eval - `(let ,message-cite-style (when (and message-reply-buffer message-cite-function) (when (equal message-cite-reply-position 'above) @@ -3767,7 +3754,23 @@ prefix, and don't delete any headers." ;; Add a `message-setup-very-last-hook' here? ;; Add `gnus-article-highlight-citation' here? (unless modified - (setq message-checksum (message-checksum)))))))) + (setq message-checksum (message-checksum)))))) + +(defun message-yank-original (&optional arg) + "Insert the message being replied to, if any. +Puts point before the text and mark after. +Normally indents each nonblank line ARG spaces (default 3). However, +if `message-yank-prefix' is non-nil, insert that prefix on each line. + +This function uses `message-cite-function' to do the actual citing. + +Just \\[universal-argument] as argument means don't indent, insert no +prefix, and don't delete any headers." + (interactive "P") + ;; eval the let forms contained in message-cite-style + (eval + `(let ,message-cite-style + (message--yank-original-internal ',arg)))) (defun message-yank-buffer (buffer) "Insert BUFFER into the current buffer and quote it." diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index ccb082d6c71..fa09c7ff165 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -410,11 +410,18 @@ textual parts.") (setq login-result (nnimap-login (car credentials) (cadr credentials)))) (if (car login-result) - ;; save the credentials if a save function exists + (progn + ;; Save the credentials if a save function exists ;; (such a function will only be passed if a new - ;; token was created) - (when (functionp (nth 2 credentials)) - (funcall (nth 2 credentials))) + ;; token was created). + (when (functionp (nth 2 credentials)) + (funcall (nth 2 credentials))) + ;; See if CAPABILITY is set as part of login + ;; response. + (dolist (response (cddr login-result)) + (when (string= "CAPABILITY" (upcase (car response))) + (setf (nnimap-capabilities nnimap-object) + (mapcar #'upcase (cdr response)))))) ;; If the login failed, then forget the credentials ;; that are now possibly cached. (dolist (host (list (nnoo-current-server 'nnimap) -- 2.39.5