From 4478e0748856d1ed3f79305ac9b268d642cd3d16 Mon Sep 17 00:00:00 2001 From: Gnus developers Date: Sun, 26 Sep 2010 23:01:31 +0000 Subject: [PATCH] mail-source.el (mail-source-value): Revert previous patch. gnus-picon.el: Inhibit showing picons for top level domains. gnus-art.el (gnus-article-treat-body-boundary): Fix length computing. gnus-news.texi: Mention nnimap-inbox. nnimap.el (nnimap-request-expire-articles): Compress ranges before deletion. nnimap.el (nnimap-retrieve-headers): Don't select the group, because that's already done by nnimap-possibly-change-group. gnus-html.el (gnus-html-show-images): Fix gnus-html-display-image arguments. gnus-html.el (gnus-html-wash-images): Fix spec computing to include start/end. nnimap.el: Store the IMAP greeting, so that we can tell what kind of server we're talking to. gnus.el (gnus): Give a final warning after startup. gnus-ems.el (gnus-create-image): Ignore all image-creation errors. nndraft.el (nndraft-request-expire-articles): Fetch the expiry target for the correct group. nnmh.el (nnmh-request-expire-articles): Don't try to fetch the expiry target here, because we don't know the Gnus name of the group. nnimap.el (nnimap-get-whole-article): Remove the data that may have arrived before the FETCH data. gnus-agent.el (gnus-agent-retrieve-headers): Don't propagate `fetch-old'. gnus-agent.el (gnus-agent-read-servers-validate): Change the level for the "Ignoring disappeared server" to something low. nndoc.el (nndoc-request-list): Return success always. --- doc/misc/gnus-news.texi | 6 ++++-- doc/misc/gnus.texi | 6 ++++++ lisp/gnus/gnus-agent.el | 4 ++-- lisp/gnus/gnus-art.el | 4 ++-- lisp/gnus/gnus-ems.el | 3 ++- lisp/gnus/gnus-html.el | 2 +- lisp/gnus/gnus-picon.el | 10 +++++++++- lisp/gnus/gnus-util.el | 20 +++++++++++++++++--- lisp/gnus/gnus.el | 4 +++- lisp/gnus/nndoc.el | 2 +- lisp/gnus/nndraft.el | 5 +++++ lisp/gnus/nnimap.el | 19 ++++++++++++------- lisp/gnus/nnmh.el | 3 --- 13 files changed, 64 insertions(+), 24 deletions(-) diff --git a/doc/misc/gnus-news.texi b/doc/misc/gnus-news.texi index 7d654820440..028539a7fb4 100644 --- a/doc/misc/gnus-news.texi +++ b/doc/misc/gnus-news.texi @@ -68,8 +68,10 @@ remove-installed-shadows}. @item New version of @code{nnimap} -@code{nnimap} has been reimplemented in a mostly-compatible way. -@c Mention any incompatibilities. +@code{nnimap} has been reimplemented in a mostly-compatible way. See +the Gnus manual for a description of the new interface. In +particular, @code{nnimap-inbox} and the client side split method has +changed. @item Gnus includes the Emacs Lisp @acronym{SASL} library. diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 1914fb0bc74..c1acf7e0d8a 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -23233,6 +23233,12 @@ want to add @samp{"unknown"} to this list. Ordered list of suffixes on picon file names to try. Defaults to @code{("xpm" "gif" "xbm")} minus those not built-in your Emacs. +@item gnus-picon-inhibit-top-level-domains +@vindex gnus-picon-inhibit-top-level-domains +If non-@code{nil} (which is the default), don't display picons for +things like @samp{.net} and @samp{.de}, which aren't usually very +interesting. + @end table @node Gravatars diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 8112565ba54..4788deba5da 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -1026,7 +1026,7 @@ supported." (unless (member server gnus-agent-covered-methods) (push server gnus-agent-covered-methods) (setq gnus-agent-method-p-cache nil)) - (gnus-message 1 "Ignoring disappeared server `%s'" server)))) + (gnus-message 8 "Ignoring disappeared server `%s'" server)))) (prog1 gnus-agent-covered-methods (setq gnus-agent-covered-methods nil)))) @@ -3752,7 +3752,7 @@ has been fetched." (erase-buffer) (cond ((not (eq 'nov (let (gnus-agent) ; Turn off agent (gnus-retrieve-headers - uncached-articles group fetch-old)))) + uncached-articles group)))) (nnvirtual-convert-headers)) ((eq 'nntp (car gnus-current-select-method)) ;; The author of gnus-get-newsgroup-headers-xover diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index ad6ccb213cf..5662bfa5e8b 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -2301,9 +2301,9 @@ long lines if and only if arg is positive." (insert "X-Boundary: ") (gnus-add-text-properties start (point) '(invisible t intangible t)) (insert (let (str) - (while (>= (1- (window-width)) (length str)) + (while (>= (window-width) (length str)) (setq str (concat str gnus-body-boundary-delimiter))) - (substring str 0 (1- (window-width)))) + (substring str 0 (window-width))) "\n") (gnus-put-text-property start (point) 'gnus-decoration 'header))))) diff --git a/lisp/gnus/gnus-ems.el b/lisp/gnus/gnus-ems.el index 9c395dbf24a..7b3f3d8a80e 100644 --- a/lisp/gnus/gnus-ems.el +++ b/lisp/gnus/gnus-ems.el @@ -272,7 +272,8 @@ (when face (setq props (plist-put props :foreground (face-foreground face))) (setq props (plist-put props :background (face-background face)))) - (apply 'create-image file type data-p props))) + (ignore-errors + (apply 'create-image file type data-p props)))) (defun gnus-put-image (glyph &optional string category) (let ((point (point))) diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el index cb5d3c6e30b..587c28e974a 100644 --- a/lisp/gnus/gnus-html.el +++ b/lisp/gnus/gnus-html.el @@ -226,7 +226,7 @@ CHARS is a regexp-like character alternative (e.g., \"[)$]\")." :keymap gnus-html-image-map :button-keymap gnus-html-image-map) (let ((overlay (gnus-make-overlay start end)) - (spec (list url alt-text))) + (spec (list url start end alt-text))) (gnus-overlay-put overlay 'local-map gnus-html-image-map) (gnus-overlay-put overlay 'gnus-image spec) (gnus-put-text-property diff --git a/lisp/gnus/gnus-picon.el b/lisp/gnus/gnus-picon.el index 97cd8207162..3cc7c3701c5 100644 --- a/lisp/gnus/gnus-picon.el +++ b/lisp/gnus/gnus-picon.el @@ -85,6 +85,12 @@ added right to the textual representation." (const right)) :group 'gnus-picon) +(defcustom gnus-picon-inhibit-top-level-domains t + "If non-nil, don't piconify top-level domains. +These are often not very interesting." + :type 'boolean + :group 'gnus-picon) + ;;; Internal variables: (defvar gnus-picon-glyph-alist nil @@ -188,7 +194,9 @@ replacement is added." (setcar spec (cons (gnus-picon-create-glyph file) (car spec)))) - (dotimes (i (1- (length spec))) + (dotimes (i (- (length spec) + (if gnus-picon-inhibit-top-level-domains + 2 1))) (when (setq file (gnus-picon-find-face (concat "unknown@" (mapconcat diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index ead48f43cea..5ebccc03f0f 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -601,6 +601,8 @@ but also to the ones displayed in the echo area." (t (apply 'message ,format-string ,args)))))))) +(defvar gnus-action-message-log nil) + (defun gnus-message-with-timestamp (format-string &rest args) "Display message with timestamp. Arguments are the same as `message'. The `gnus-add-timestamp-to-message' variable controls how to add @@ -615,14 +617,26 @@ Guideline for numbers: that take a long time, 7 - not very important messages on stuff, 9 - messages inside loops." (if (<= level gnus-verbose) - (if gnus-add-timestamp-to-message - (apply 'gnus-message-with-timestamp args) - (apply 'message args)) + (let ((message + (if gnus-add-timestamp-to-message + (apply 'gnus-message-with-timestamp args) + (apply 'message args)))) + (when (and (consp gnus-action-message-log) + (<= level 3)) + (push message gnus-action-message-log)) + message) ;; We have to do this format thingy here even if the result isn't ;; shown - the return value has to be the same as the return value ;; from `message'. (apply 'format args))) +(defun gnus-final-warning () + (when (and (consp gnus-action-message-log) + (setq gnus-action-message-log + (delete nil gnus-action-message-log))) + (message "Warning: %s" + (mapconcat #'identity gnus-action-message-log "; ")))) + (defun gnus-error (level &rest args) "Beep an error if LEVEL is equal to or less than `gnus-verbose'. ARGS are passed to `message'." diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index ee504597535..2024721ab0a 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -4366,7 +4366,9 @@ prompt the user for the name of an NNTP server to use." (unless (byte-code-function-p (symbol-function 'gnus)) (message "You should byte-compile Gnus") (sit-for 2)) - (gnus-1 arg dont-connect slave)) + (let ((gnus-action-message-log (list nil))) + (gnus-1 arg dont-connect slave) + (gnus-final-warning))) ;; Allow redefinition of Gnus functions. diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el index 2eeaeba0512..15e5e82c6f9 100644 --- a/lisp/gnus/nndoc.el +++ b/lisp/gnus/nndoc.el @@ -298,7 +298,7 @@ from the document.") t) (deffoo nndoc-request-list (&optional server) - nil) + t) (deffoo nndoc-request-newgroups (date &optional server) nil) diff --git a/lisp/gnus/nndraft.el b/lisp/gnus/nndraft.el index 313675c2fac..5dc51f321c5 100644 --- a/lisp/gnus/nndraft.el +++ b/lisp/gnus/nndraft.el @@ -222,6 +222,11 @@ are generated if and only if they are also in `message-draft-headers'.") (deffoo nndraft-request-expire-articles (articles group &optional server force) (nndraft-possibly-change-group group) (let* ((nnmh-allow-delete-final t) + (nnmail-expiry-target + (or (gnus-group-find-parameter + (gnus-group-prefixed-name "nndraft" (list 'nndraft server)) + 'expiry-target t) + nnmail-expiry-target)) (res (nnoo-parent-function 'nndraft 'nnmh-request-expire-articles (list articles group server force))) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 8c3e6ea9a57..a99ee088330 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -96,7 +96,7 @@ some servers.") (defstruct nnimap group process commands capabilities select-result newlinep server - last-command-time) + last-command-time greeting) (defvar nnimap-object nil) @@ -119,7 +119,6 @@ some servers.") (erase-buffer) (when (nnimap-possibly-change-group group server) (with-current-buffer (nnimap-buffer) - (nnimap-send-command "SELECT %S" (utf7-encode group t)) (erase-buffer) (nnimap-wait-for-response (nnimap-send-command @@ -318,6 +317,9 @@ some servers.") (nnheader-report 'nnimap "%s" (buffer-substring (point) (line-end-position))) + (setf (nnimap-greeting nnimap-object) + (buffer-substring (line-beginning-position) + (line-end-position))) (when (eq nnimap-stream 'starttls) (nnimap-command "STARTTLS") (starttls-negotiate (nnimap-process nnimap-object))) @@ -419,10 +421,13 @@ some servers.") article))) ;; Check that we really got an article. (goto-char (point-min)) - (unless (looking-at "\\* [0-9]+ FETCH") + (unless (re-search-forward "\\* [0-9]+ FETCH" nil t) (setq result nil)) (when result - (goto-char (point-min)) + ;; Remove any data that may have arrived before the FETCH data. + (beginning-of-line) + (unless (bobp) + (delete-region (point-min) (point))) (let ((bytes (nnimap-get-length))) (delete-region (line-beginning-position) (progn (forward-line 1) (point))) @@ -626,7 +631,7 @@ some servers.") articles) ((and force (eq nnmail-expiry-target 'delete)) - (unless (nnimap-delete-article articles) + (unless (nnimap-delete-article (gnus-compress-sequence articles)) (message "Article marked for deletion, but not expunged.")) nil) (t @@ -640,7 +645,7 @@ some servers.") (if (null deletable-articles) articles (if (eq nnmail-expiry-target 'delete) - (nnimap-delete-article deletable-articles) + (nnimap-delete-article (gnus-compress-sequence deletable-articles)) (setq deletable-articles (nnimap-process-expiry-targets deletable-articles group server))) @@ -667,7 +672,7 @@ some servers.") ;; Change back to the current group again. (nnimap-possibly-change-group group server) (setq deleted-articles (nreverse deleted-articles)) - (nnimap-delete-article deleted-articles) + (nnimap-delete-article (gnus-compress-sequence deleted-articles)) deleted-articles)) (defun nnimap-find-expired-articles (group) diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el index cdd540a993b..984144e0d9a 100644 --- a/lisp/gnus/nnmh.el +++ b/lisp/gnus/nnmh.el @@ -258,9 +258,6 @@ as unread by Gnus.") &optional server force) (nnmh-possibly-change-directory newsgroup server) (let ((is-old t) - (nnmail-expiry-target - (or (gnus-group-find-parameter newsgroup 'expiry-target t) - nnmail-expiry-target)) article rest mod-time) (nnheader-init-server-buffer) -- 2.39.5