X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-sum.el;h=1d8ad8e6acb7112569e2646650807290d7746f7a;hb=68f412fcdd68a5d0c322fd69a5e4cf07c1209e2b;hp=6dbe7bfef0f428f33fc5b7ad46dc8e3ba2fd0a2e;hpb=0e5ff0576e476bca5def0a28865b5211bde637c1;p=gnus diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 6dbe7bfef..1d8ad8e6a 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -1,6 +1,6 @@ ;;; gnus-sum.el --- summary mode commands for Gnus -;; Copyright (C) 1996-2013 Free Software Foundation, Inc. +;; Copyright (C) 1996-2015 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -24,9 +24,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) (eval-when-compile (require 'cl)) (eval-when-compile @@ -897,6 +894,7 @@ subthreads, customize `gnus-subthread-sort-functions'." "*List of functions used for sorting subthreads in the summary buffer. By default, subthreads are sorted the same as threads, i.e., according to the value of `gnus-thread-sort-functions'." + :version "24.4" :group 'gnus-summary-sort :type '(choice (const :tag "Sort subthreads like threads" gnus-thread-sort-functions) @@ -1162,9 +1160,9 @@ which it may alter in any way." 'mail-decode-encoded-address-string "Function used to decode addresses with encoded words.") -(defcustom gnus-extra-headers '(To Cc Keywords Gcc Newsgroups) +(defcustom gnus-extra-headers '(To Cc Keywords Gcc Newsgroups X-GM-LABELS) "*Extra headers to parse." - :version "24.1" ; added Cc Keywords Gcc + :version "25.1" :group 'gnus-summary :type '(repeat symbol)) @@ -2187,6 +2185,7 @@ increase the score of each group you read." (gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map) "w" gnus-article-decode-mime-words "c" gnus-article-decode-charset + "h" gnus-mime-buttonize-attachments-in-header "v" gnus-mime-view-all-parts "b" gnus-article-view-part) @@ -2393,6 +2392,8 @@ increase the score of each group you read." ["QP" gnus-article-de-quoted-unreadable t] ["Base64" gnus-article-de-base64-unreadable t] ["View MIME buttons" gnus-summary-display-buttonized t] + ["View MIME buttons in header" + gnus-mime-buttonize-attachments-in-header t] ["View all" gnus-mime-view-all-parts t] ["Verify and Decrypt" gnus-summary-force-verify-and-decrypt t] ["Encrypt body" gnus-article-encrypt-body @@ -2423,6 +2424,7 @@ increase the score of each group you read." ["Lapsed" gnus-article-date-lapsed t] ["User-defined" gnus-article-date-user t]) ("Display" + ["Display HTML images" gnus-article-show-images t] ["Remove images" gnus-article-remove-images t] ["Toggle smiley" gnus-treat-smiley t] ["Show X-Face" gnus-article-display-x-face t] @@ -4023,6 +4025,8 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; The group was successfully selected. (t (gnus-set-global-variables) + (when (boundp 'spam-install-hooks) + (spam-initialize)) ;; Save the active value in effect when the group was entered. (setq gnus-newsgroup-active (gnus-copy-sequence @@ -5617,7 +5621,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (mm-decode-coding-string group charset) (mm-decode-coding-string (gnus-status-message group) charset)))) - (unless (gnus-request-group group t) + (unless (gnus-request-group group t nil (gnus-get-info group)) (when (derived-mode-p 'gnus-summary-mode) (gnus-kill-buffer (current-buffer))) (error "Couldn't request group %s: %s" @@ -7215,6 +7219,7 @@ If FORCE (the prefix), also save the .newsrc file(s)." (gnus-dribble-save))) (declare-function gnus-cache-write-active "gnus-cache" (&optional force)) +(declare-function gnus-article-stop-animations "gnus-art" ()) (defun gnus-summary-exit (&optional temporary leave-hidden) "Exit reading current newsgroup, and then return to group selection mode. @@ -7319,7 +7324,6 @@ If FORCE (the prefix), also save the .newsrc file(s)." (unless quit-config (setq gnus-newsgroup-name nil))))) -(declare-function gnus-article-stop-animations "gnus-art" ()) (declare-function gnus-stop-downloads "gnus-art" ()) (defalias 'gnus-summary-quit 'gnus-summary-exit-no-update) @@ -7331,6 +7335,7 @@ If FORCE (the prefix), also save the .newsrc file(s)." (gnus-group-is-exiting-without-update-p t) (quit-config (gnus-group-quit-config group))) (when (or no-questions + (gnus-ephemeral-group-p group) gnus-expert-user (gnus-y-or-n-p "Discard changes to this group and exit? ")) (gnus-async-halt-prefetch) @@ -9063,25 +9068,62 @@ non-numeric or nil fetch the number specified by the (regexp-opt ',(append refs (list id subject))))))) (gnus-fetch-headers (list last) (if (numberp limit) (* 2 limit) limit) t)))) - article-ids) + article-ids new-unreads) (when (listp new-headers) (dolist (header new-headers) - (push (mail-header-number header) article-ids) - (when (member (mail-header-number header) gnus-newsgroup-unselected) - (push (mail-header-number header) gnus-newsgroup-unreads) - (setq gnus-newsgroup-unselected - (delete (mail-header-number header) - gnus-newsgroup-unselected)))) + (push (mail-header-number header) article-ids)) + (setq article-ids (nreverse article-ids)) + (setq new-unreads + (gnus-sorted-intersection gnus-newsgroup-unselected article-ids)) + (setq gnus-newsgroup-unselected + (gnus-sorted-ndifference gnus-newsgroup-unselected new-unreads)) + (setq gnus-newsgroup-unreads + (gnus-sorted-nunion gnus-newsgroup-unreads new-unreads)) (setq gnus-newsgroup-headers (gnus-delete-duplicate-headers (gnus-merge 'list gnus-newsgroup-headers new-headers 'gnus-article-sort-by-number))) (setq gnus-newsgroup-articles - (gnus-sorted-nunion gnus-newsgroup-articles (nreverse article-ids))) + (gnus-sorted-nunion gnus-newsgroup-articles article-ids)) (gnus-summary-limit-include-thread id))) (gnus-summary-show-thread)) +(defun gnus-summary-open-group-with-article (message-id) + "Open a group containing the article with the given MESSAGE-ID." + (interactive "sMessage-ID: ") + (require 'nndoc) + (with-temp-buffer + ;; Prepare a dummy article + (erase-buffer) + (insert "From nobody Tue Sep 13 22:05:34 2011\n\n") + + ;; Prepare pretty modelines for summary and article buffers + (let ((gnus-summary-mode-line-format "Found %G") + (gnus-article-mode-line-format + ;; Group names just get in the way here, especially the + ;; abbreviated ones + (if (string-match "%[gG]" gnus-article-mode-line-format) + (concat (substring gnus-article-mode-line-format + 0 (match-beginning 0)) + (substring gnus-article-mode-line-format (match-end 0))) + gnus-article-mode-line-format))) + + ;; Build an ephemeral group containing the dummy article (hidden) + (gnus-group-read-ephemeral-group + message-id + `(nndoc ,message-id + (nndoc-address ,(current-buffer)) + (nndoc-article-type mbox)) + :activate + (cons (current-buffer) gnus-current-window-configuration) + (not :request-only) + '(-1) ; :select-articles + (not :parameters) + 0)) ; :number + ;; Fetch the desired article + (gnus-summary-refer-article message-id))) + (defun gnus-summary-refer-article (message-id) "Fetch an article specified by MESSAGE-ID." (interactive "sMessage-ID: ") @@ -9202,6 +9244,7 @@ To control what happens when you exit the group, see the (gnus-fetch-field "from"))) (setq params (append + params (list (cons 'to-address (funcall gnus-decode-encoded-address-function to-address)))))) @@ -9294,7 +9337,7 @@ Obeys the standard process/prefix convention." ((gnus-group-read-ephemeral-group (setq vgroup (format "nnvirtual:%s-%s" gnus-newsgroup-name - (format-time-string "%Y%m%dT%H%M%S" (current-time)))) + (format-time-string "%Y%m%dT%H%M%S"))) `(nnvirtual ,vgroup (nnvirtual-component-groups ,groups)) t (cons (current-buffer) 'summary))) @@ -9744,6 +9787,8 @@ If ARG is a negative number, turn header display off." (declare-function article-narrow-to-head "gnus-art" ()) (declare-function gnus-article-hidden-text-p "gnus-art" (type)) (declare-function gnus-delete-wash-type "gnus-art" (type)) +(declare-function gnus-mime-buttonize-attachments-in-header + "gnus-art" (&optional interactive)) (defun gnus-summary-toggle-header (&optional arg) "Show the headers if they are hidden, or hide them if they are shown. @@ -9775,7 +9820,10 @@ If ARG is a negative number, hide the unwanted header lines." (gnus-treat-hide-boring-headers nil)) (gnus-delete-wash-type 'headers) (gnus-treat-article 'head)) - (gnus-treat-article 'head)) + (gnus-treat-article 'head) + ;; Add attachment buttons to the header. + (when gnus-mime-display-attachment-buttons-in-header + (gnus-mime-buttonize-attachments-in-header))) (widen) (if window (set-window-start window (goto-char (point-min)))) @@ -9822,9 +9870,12 @@ invalid IDNA string (`xn--bar' is invalid). You must have GNU Libidn (URL `http://www.gnu.org/software/libidn/') installed for this command to work." (interactive "P") - (if (not (and (condition-case nil (require 'idna) - (file-error)) - (mm-coding-system-p 'utf-8) + (if (not (and (mm-coding-system-p 'utf-8) + (condition-case nil + (require 'idna) + (file-error) + (invalid-operation)) + (symbol-value 'idna-program) (executable-find (symbol-value 'idna-program)))) (gnus-message 5 "GNU Libidn not installed properly (`idn' or `idna.el' missing)") @@ -10400,13 +10451,19 @@ This will be the case if the article has both been mailed and posted." (when (and (not (memq article es)) (gnus-data-find article)) (gnus-summary-mark-article article gnus-canceled-mark) - (run-hook-with-args 'gnus-summary-article-expire-hook - 'delete - (gnus-data-header - (assoc article (gnus-data-list nil))) - gnus-newsgroup-name - nil - nil))))))) + (run-hook-with-args + 'gnus-summary-article-expire-hook + 'delete + (gnus-data-header (assoc article (gnus-data-list nil))) + gnus-newsgroup-name + (cond + ((stringp nnmail-expiry-target) nnmail-expiry-target) + ((eq nnmail-expiry-target 'delete) nil) + (t + (let ((rescall (funcall nnmail-expiry-target + gnus-newsgroup-name))) + (if (stringp rescall) rescall nil)))) + nil))))))) (gnus-message 6 "Expiring articles...done"))))) (defun gnus-summary-expire-articles-now () @@ -10569,7 +10626,7 @@ groups." (let ((lines (count-lines (point) (point-max))) (length (- (point-max) (point))) (case-fold-search t) - (body (copy-marker (point)))) + (body (point-marker))) (goto-char (point-min)) (when (re-search-forward "^content-length:[ \t]\\([0-9]+\\)" body t) (delete-region (match-beginning 1) (match-end 1)) @@ -10657,13 +10714,31 @@ groups." ;;; Respooling +(defvar nnimap-split-fancy) +(defvar nnimap-split-methods) + (defun gnus-summary-respool-query (&optional silent trace) "Query where the respool algorithm would put this article." (interactive) (let (gnus-mark-article-hook) (gnus-summary-select-article) (with-current-buffer gnus-original-article-buffer - (let ((groups (nnmail-article-group 'identity trace))) + (let ((groups + (if (eq (car (gnus-find-method-for-group gnus-newsgroup-name)) + 'nnimap) + ;; nnimap has its own splitting variables. + (let ((nnmail-split-methods + (cond + ((eq nnimap-split-methods 'default) + nnmail-split-methods) + (nnimap-split-methods + nnimap-split-methods) + (nnimap-split-fancy + 'nnmail-split-fancy))) + (nnmail-split-fancy (or nnimap-split-fancy + nnmail-split-fancy))) + (nnmail-article-group 'identity trace)) + (nnmail-article-group 'identity trace)))) (unless silent (if groups (message "This message would go to %s"