X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-sum.el;h=70e1dbc63c8f4bc32390d82426c9a1382ca6e7e3;hp=dfd1421cfc4368f7b1fccb81fc027f094f667b5b;hb=88a72625d1e27f31be5f521ed8a7369e9f708884;hpb=ebaaf082873ffc21e45bec70c57b02a16d9ec201 diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index dfd1421cf..70e1dbc63 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-2012 Free Software Foundation, Inc. +;; Copyright (C) 1996-2013 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -451,7 +451,8 @@ current article is unread." :group 'gnus-summary-maneuvering :type 'boolean) -(defcustom gnus-auto-center-summary 2 +(defcustom gnus-auto-center-summary + (max (or (bound-and-true-p scroll-margin) 0) 2) "*If non-nil, always center the current summary buffer. In particular, if `vertical' do only vertical recentering. If non-nil and non-`vertical', do both horizontal and vertical recentering." @@ -1166,7 +1167,7 @@ using `gnus-ignored-from-addresses'." (defcustom gnus-summary-newsgroup-prefix "=> " "*String prefixed to the Newsgroup field in the summary -line when using `gnus-ignored-from-addresses'." +line when using the option `gnus-ignored-from-addresses'." :version "22.1" :group 'gnus-summary :type 'string) @@ -1243,13 +1244,6 @@ For example: ((1 . cn-gb-2312) (2 . big5))." :type 'boolean :group 'gnus-summary-marks) -(defcustom gnus-propagate-marks nil - "If non-nil, Gnus will store and retrieve marks from the backends. -This means that marks will be stored both in .newsrc.eld and in -the backend, and will slow operation down somewhat." - :type 'boolean - :group 'gnus-summary-marks) - (defcustom gnus-alter-articles-to-read-function nil "Function to be called to alter the list of articles to be selected." :type '(choice (const nil) function) @@ -1580,6 +1574,7 @@ This list will always be a subset of gnus-newsgroup-undownloaded.") gnus-newsgroup-killed gnus-newsgroup-unseen gnus-newsgroup-seen + gnus-newsgroup-unexist gnus-newsgroup-cached gnus-newsgroup-downloadable gnus-newsgroup-undownloaded @@ -1828,6 +1823,7 @@ increase the score of each group you read." (gnus-define-keys gnus-summary-mode-map " " gnus-summary-next-page + [?\S-\ ] gnus-summary-prev-page "\177" gnus-summary-prev-page [delete] gnus-summary-prev-page [backspace] gnus-summary-prev-page @@ -1920,7 +1916,7 @@ increase the score of each group you read." "a" gnus-summary-post-news "x" gnus-summary-limit-to-unread "s" gnus-summary-isearch-article - [tab] gnus-summary-widget-forward + "\t" gnus-summary-widget-forward [backtab] gnus-summary-widget-backward "t" gnus-summary-toggle-header "g" gnus-summary-show-article @@ -2067,6 +2063,7 @@ increase the score of each group you read." (gnus-define-keys (gnus-summary-article-map "A" gnus-summary-mode-map) " " gnus-summary-next-page "n" gnus-summary-next-page + [?\S-\ ] gnus-summary-prev-page "\177" gnus-summary-prev-page [delete] gnus-summary-prev-page "p" gnus-summary-prev-page @@ -2085,7 +2082,7 @@ increase the score of each group you read." "W" gnus-warp-to-article "g" gnus-summary-show-article "s" gnus-summary-isearch-article - [tab] gnus-summary-widget-forward + "\t" gnus-summary-widget-forward [backtab] gnus-summary-widget-backward "P" gnus-summary-print-article "S" gnus-sticky-article @@ -2976,12 +2973,6 @@ When FORCE, rebuild the tool bar." (setq gnus-summary-tool-bar-map map)))) (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map)) -(defun gnus-score-set-default (var value) - "A version of set that updates the GNU Emacs menu-bar." - (set var value) - ;; It is the message that forces the active status to be updated. - (message "")) - (defun gnus-make-score-map (type) "Make a summary score map of type TYPE." (if t @@ -3267,13 +3258,6 @@ The following commands are available: "Say whether this article is a sparse article or not." `(memq ,article gnus-newsgroup-ancient)) -(defun gnus-article-parent-p (number) - "Say whether this article is a parent or not." - (let ((data (gnus-data-find-list number))) - (and (cdr data) ; There has to be an article after... - (< (gnus-data-level (car data)) ; And it has to have a higher level. - (gnus-data-level (nth 1 data)))))) - (defun gnus-article-children (number) "Return a list of all children to NUMBER." (let* ((data (gnus-data-find-list number)) @@ -3295,14 +3279,6 @@ The following commands are available: "Say whether this article is intangible or not." '(get-text-property (point) 'gnus-intangible)) -(defun gnus-article-read-p (article) - "Say whether ARTICLE is read or not." - (not (or (memq article gnus-newsgroup-marked) - (memq article gnus-newsgroup-spam-marked) - (memq article gnus-newsgroup-unreads) - (memq article gnus-newsgroup-unselected) - (memq article gnus-newsgroup-dormant)))) - ;; Some summary mode macros. (defmacro gnus-summary-article-number () @@ -3523,8 +3499,8 @@ If the setup was successful, non-nil is returned." (set-buffer buffer) (setq gnus-summary-buffer (current-buffer)) (not gnus-newsgroup-prepared)) - ;; Fix by Sudish Joseph - (setq gnus-summary-buffer (set-buffer (gnus-get-buffer-create buffer))) + (set-buffer (gnus-get-buffer-create buffer)) + (setq gnus-summary-buffer (current-buffer)) (gnus-summary-mode group) (when (gnus-group-quit-config group) (set (make-local-variable 'gnus-single-article-buffer) nil)) @@ -3563,7 +3539,7 @@ buffer that was in action when the last article was fetched." (push (eval (car locals)) vlist)) (setq locals (cdr locals))) (setq vlist (nreverse vlist))) - (with-current-buffer gnus-group-buffer + (with-temp-buffer (setq gnus-newsgroup-name name gnus-newsgroup-marked marked gnus-newsgroup-spam-marked spam @@ -3582,11 +3558,7 @@ buffer that was in action when the last article was fetched." (if (consp (car locals)) (set (caar locals) (pop vlist)) (set (car locals) (pop vlist))) - (setq locals (cdr locals)))) - ;; The article buffer also has local variables. - (when (gnus-buffer-live-p gnus-article-buffer) - (set-buffer gnus-article-buffer) - (setq gnus-summary-buffer summary)))))) + (setq locals (cdr locals)))))))) (defun gnus-summary-article-unread-p (article) "Say whether ARTICLE is unread or not." @@ -3685,17 +3657,18 @@ buffer that was in action when the last article was fetched." (or (car (funcall gnus-extract-address-components from)) from)) -(defun gnus-summary-from-or-to-or-newsgroups (header gnus-tmp-from) +(defun gnus-summary-from-or-to-or-newsgroups (header from) (let ((mail-parse-charset gnus-newsgroup-charset) - (ignored-from-addresses (gnus-ignored-from-addresses)) - ; Is it really necessary to do this next part for each summary line? - ; Luckily, doesn't seem to slow things down much. - (mail-parse-ignored-charsets - (with-current-buffer gnus-summary-buffer - gnus-newsgroup-ignored-charsets))) + (ignored-from-addresses (gnus-ignored-from-addresses)) + ;; Is it really necessary to do this next part for each summary line? + ;; Luckily, doesn't seem to slow things down much. + (mail-parse-ignored-charsets + (with-current-buffer gnus-summary-buffer + gnus-newsgroup-ignored-charsets)) + (address (cadr (gnus-extract-address-components from)))) (or (and ignored-from-addresses - (string-match ignored-from-addresses gnus-tmp-from) + (string-match ignored-from-addresses address) (let ((extra-headers (mail-header-extra header)) to newsgroups) @@ -3714,9 +3687,7 @@ buffer that was in action when the last article was fetched." gnus-newsgroup-name)) 'nntp) (gnus-group-real-name gnus-newsgroup-name)))) (concat gnus-summary-newsgroup-prefix newsgroups))))) - (gnus-string-mark-left-to-right - (inline - (gnus-summary-extract-address-component gnus-tmp-from)))))) + (gnus-string-mark-left-to-right (gnus-summary-extract-address-component from))))) (defun gnus-summary-insert-line (gnus-tmp-header gnus-tmp-level gnus-tmp-current @@ -4093,9 +4064,10 @@ If SELECT-ARTICLES, only select those articles from GROUP." gnus-auto-select-first) (progn (let ((art (gnus-summary-article-number))) - (unless (and (not gnus-plugged) - (or (memq art gnus-newsgroup-undownloaded) - (memq art gnus-newsgroup-downloadable))) + (when (and art + gnus-plugged + (not (memq art gnus-newsgroup-undownloaded)) + (not (memq art gnus-newsgroup-downloadable))) (gnus-summary-goto-article art)))) ;; Don't select any articles. (gnus-summary-position-point) @@ -5678,7 +5650,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setq gnus-newsgroup-unselected (gnus-sorted-difference gnus-newsgroup-unreads articles)) (setq articles (gnus-articles-to-read group read-all))) - + (cond ((null articles) ;;(gnus-message 3 "Couldn't select newsgroup -- no articles to display") @@ -5688,7 +5660,9 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; Init the dependencies hash table. (setq gnus-newsgroup-dependencies (gnus-make-hashtable (length articles))) - (gnus-set-global-variables) + (if (gnus-buffer-live-p gnus-group-buffer) + (gnus-set-global-variables) + (set-default 'gnus-newsgroup-name gnus-newsgroup-name)) ;; Retrieve the headers and read them in. (setq gnus-newsgroup-headers (gnus-fetch-headers articles)) @@ -5934,17 +5908,6 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setq articles (cdr articles))) out)) -(defun gnus-uncompress-marks (marks) - "Uncompress the mark ranges in MARKS." - (let ((uncompressed '(score bookmark)) - out) - (while marks - (if (memq (caar marks) uncompressed) - (push (car marks) out) - (push (cons (caar marks) (gnus-uncompress-range (cdar marks))) out)) - (setq marks (cdr marks))) - out)) - (defun gnus-article-mark-to-type (mark) "Return the type of MARK." (or (cadr (assq mark gnus-article-special-mark-lists)) @@ -5972,7 +5935,6 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setq mark (car marks) mark-type (gnus-article-mark-to-type mark) var (intern (format "gnus-newsgroup-%s" (car (rassq mark types))))) - ;; We set the variable according to the type of the marks list, ;; and then adjust the marks to a subset of the active articles. (cond @@ -6294,10 +6256,9 @@ The resulting hash table is returned, or nil if no Xrefs were found." (info (nth 2 entry)) (active (gnus-active group)) (set-marks - (or gnus-propagate-marks - (gnus-method-option-p - (gnus-find-method-for-group group) - 'server-marks))) + (gnus-method-option-p + (gnus-find-method-for-group group) + 'server-marks)) range) (if (not entry) ;; Group that Gnus doesn't know exists, but still allow the @@ -6634,9 +6595,9 @@ too, instead of trying to fetch new headers." ;; article if ID is a number -- so that the next `P' or `N' ;; command will fetch the previous (or next) article even ;; if the one we tried to fetch this time has been canceled. - (when (> number gnus-newsgroup-end) + (unless (and gnus-newsgroup-end (< number gnus-newsgroup-end)) (setq gnus-newsgroup-end number)) - (when (< number gnus-newsgroup-begin) + (unless (and gnus-newsgroup-begin (> number gnus-newsgroup-begin)) (setq gnus-newsgroup-begin number)) (setq gnus-newsgroup-unselected (delq number gnus-newsgroup-unselected))) @@ -7262,7 +7223,8 @@ If FORCE (the prefix), also save the .newsrc file(s)." (gnus-summary-update-info)) (gnus-close-group group) ;; Make sure where we were, and go to next newsgroup. - (set-buffer gnus-group-buffer) + (when (buffer-live-p (get-buffer gnus-group-buffer)) + (set-buffer gnus-group-buffer)) (unless quit-config (gnus-group-jump-to-group group)) (gnus-run-hooks 'gnus-summary-exit-hook) @@ -7287,7 +7249,8 @@ If FORCE (the prefix), also save the .newsrc file(s)." (gnus-kill-buffer buf))) (setq gnus-current-select-method gnus-select-method) - (set-buffer gnus-group-buffer) + (when (gnus-buffer-live-p gnus-group-buffer) + (set-buffer gnus-group-buffer)) (if quit-config (gnus-handle-ephemeral-exit quit-config) (goto-char group-point) @@ -7366,7 +7329,8 @@ If FORCE (the prefix), also save the .newsrc file(s)." "Handle movement when leaving an ephemeral group. The state which existed when entering the ephemeral is reset." (if (not (buffer-live-p (car quit-config))) - (gnus-configure-windows 'group 'force) + (when (gnus-buffer-live-p gnus-group-buffer) + (gnus-configure-windows 'group 'force)) (set-buffer (car quit-config)) (unless (eq (cdr quit-config) 'group) (setq gnus-current-select-method @@ -7764,10 +7728,6 @@ be displayed." gnus-buttonized-mime-types))) (gnus-summary-select-article nil 'force))) -(defun gnus-summary-set-current-mark (&optional current-mark) - "Obsolete function." - nil) - (defun gnus-summary-next-article (&optional unread subject backward push) "Select the next article. If UNREAD, only unread articles are selected. @@ -7920,7 +7880,6 @@ If STOP is non-nil, just stop when reaching the end of the message. Also see the variable `gnus-article-skip-boring'." (interactive "P") - (setq gnus-summary-buffer (current-buffer)) (gnus-set-global-variables) (let ((article (gnus-summary-article-number)) (article-window (get-buffer-window gnus-article-buffer t)) @@ -8241,9 +8200,17 @@ If NOT-MATCHING, excluding articles that have subjects that match a regexp." "Limit the summary buffer to articles that have authors that match a regexp. If NOT-MATCHING, excluding articles that have authors that match a regexp." (interactive - (list (read-string (if current-prefix-arg - "Exclude author (regexp): " - "Limit to author (regexp): ")) + (list (let* ((header (gnus-summary-article-header)) + (default (and header (car (mail-header-parse-address + (mail-header-from header)))))) + (read-string (concat (if current-prefix-arg + "Exclude author (regexp" + "Limit to author (regexp") + (if default + (concat ", default \"" default "\"): ") + "): ")) + nil nil + default)) current-prefix-arg)) (gnus-summary-limit-to-subject from "from" not-matching)) @@ -9175,7 +9142,7 @@ To control what happens when you exit the group, see the (list (cons 'save-article-group ogroup)))) (case-fold-search t) (buf (current-buffer)) - dig to-address) + dig to-address charset) (with-current-buffer gnus-original-article-buffer ;; Have the digest group inherit the main mail address of ;; the parent article. @@ -9188,16 +9155,32 @@ To control what happens when you exit the group, see the to-address)))))) (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*")) (insert-buffer-substring gnus-original-article-buffer) - ;; Remove lines that may lead nndoc to misinterpret the - ;; document type. (narrow-to-region (goto-char (point-min)) (or (search-forward "\n\n" nil t) (point))) + ;; Remove lines that may lead nndoc to misinterpret the + ;; document type. (goto-char (point-min)) (delete-matching-lines "^Path:\\|^From ") + ;; Parse charset, and decode content transfer encoding. + (setq charset (mail-content-type-get + (mail-header-parse-content-type + (or (gnus-fetch-field "content-type") "")) + 'charset)) + (let ((encoding (gnus-fetch-field "content-transfer-encoding"))) + (when encoding + (message-remove-header "content-transfer-encoding") + (goto-char (point-max)) + (widen) + (narrow-to-region (point) (point-max)) + (mm-decode-content-transfer-encoding + (intern (downcase (mail-header-strip encoding)))))) (widen)) (unwind-protect - (if (let ((gnus-newsgroup-ephemeral-charset gnus-newsgroup-charset) + (if (let ((gnus-newsgroup-ephemeral-charset + (if charset + (intern (downcase (gnus-strip-whitespace charset))) + gnus-newsgroup-charset)) (gnus-newsgroup-ephemeral-ignored-charsets gnus-newsgroup-ignored-charsets)) (gnus-group-read-ephemeral-group @@ -10096,10 +10079,9 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." to-group 'expire (list to-article) info)) (when (and to-marks - (or gnus-propagate-marks - (gnus-method-option-p - (gnus-find-method-for-group to-group) - 'server-marks))) + (gnus-method-option-p + (gnus-find-method-for-group to-group) + 'server-marks)) (gnus-request-set-mark to-group (list (list (list to-article) 'add to-marks))))) @@ -10150,17 +10132,20 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (defun gnus-summary-push-marks-to-backend (article) (let ((set nil) + (del nil) (marks gnus-article-mark-lists)) (unless (memq article gnus-newsgroup-unreads) (push 'read set)) (while marks - (when (and (eq (gnus-article-mark-to-type (cdar marks)) 'list) - (memq article (symbol-value - (intern (format "gnus-newsgroup-%s" - (caar marks)))))) - (push (cdar marks) set)) + (if (and (eq (gnus-article-mark-to-type (cdar marks)) 'list) + (memq article (symbol-value + (intern (format "gnus-newsgroup-%s" + (caar marks)))))) + (push (cdar marks) set) + (push (cdar marks) del)) (pop marks)) - (gnus-request-set-mark gnus-newsgroup-name `(((,article) set ,set))))) + (gnus-request-set-mark gnus-newsgroup-name `(((,article) set ,set) + ((,article) del ,del))))) (defun gnus-summary-copy-article (&optional n to-newsgroup select-method) "Copy the current article to some other group. @@ -10313,16 +10298,19 @@ This will be the case if the article has both been mailed and posted." 'request-expire-articles gnus-newsgroup-name)) ;; This backend supports expiry. (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name)) - (expirable (if total - (progn - ;; We need to update the info for - ;; this group for `gnus-list-of-read-articles' - ;; to give us the right answer. - (gnus-run-hooks 'gnus-exit-group-hook) - (gnus-summary-update-info) - (gnus-list-of-read-articles gnus-newsgroup-name)) - (setq gnus-newsgroup-expirable - (sort gnus-newsgroup-expirable '<)))) + (expirable + (gnus-list-range-difference + (if total + (progn + ;; We need to update the info for + ;; this group for `gnus-list-of-read-articles' + ;; to give us the right answer. + (gnus-run-hooks 'gnus-exit-group-hook) + (gnus-summary-update-info) + (gnus-list-of-read-articles gnus-newsgroup-name)) + (setq gnus-newsgroup-expirable + (sort gnus-newsgroup-expirable '<))) + gnus-newsgroup-unexist)) (expiry-wait (if now 'immediate (gnus-group-find-parameter gnus-newsgroup-name 'expiry-wait))) @@ -11670,10 +11658,10 @@ If PREDICATE is supplied, threads that satisfy this predicate will not be hidden. Returns nil if no threads were there to be hidden." (interactive) + (beginning-of-line) (let ((start (point)) (starteol (line-end-position)) (article (gnus-summary-article-number))) - (goto-char start) ;; Go forward until either the buffer ends or the subthread ends. (when (and (not (eobp)) (or (zerop (gnus-summary-next-thread 1 t)) @@ -12434,6 +12422,13 @@ If REVERSE, save parts that do not match TYPE." (not (setq header (car (gnus-get-newsgroup-headers nil t))))) () ; Malformed head. (unless (gnus-summary-article-sparse-p (mail-header-number header)) + (when (and (bound-and-true-p gnus-registry-enabled) + (not (gnus-ephemeral-group-p (car where)))) + (gnus-registry-handle-action + (mail-header-id header) nil + (gnus-group-prefixed-name (car where) gnus-override-method) + (mail-header-subject header) + (mail-header-from header))) (when (and (stringp id) (or (not (string= (gnus-group-real-name group) @@ -12537,7 +12532,7 @@ If REVERSE, save parts that do not match TYPE." (memq article gnus-newsgroup-undownloaded) (not (memq article gnus-newsgroup-cached))))) (let ((face (funcall (gnus-summary-highlight-line-0)))) - (unless (eq face (get-text-property beg 'face)) + (unless (eq face (gnus-get-text-property-excluding-characters-with-faces beg 'face)) (gnus-put-text-property-excluding-characters-with-faces beg (point-at-eol) 'face (setq face (if (boundp face) (symbol-value face) face))) @@ -12581,10 +12576,9 @@ UNREAD is a sorted list." (save-excursion (let (setmarkundo) ;; Propagate the read marks to the backend. - (when (and (or gnus-propagate-marks - (gnus-method-option-p - (gnus-find-method-for-group group) - 'server-marks)) + (when (and (gnus-method-option-p + (gnus-find-method-for-group group) + 'server-marks) (gnus-check-backend-function 'request-set-mark group)) (let ((del (gnus-remove-from-range (gnus-info-read info) read)) (add (gnus-remove-from-range read (gnus-info-read info)))) @@ -12845,7 +12839,9 @@ If ALL is a number, fetch this number of articles." ;; Some nntp servers lie about their active range. When ;; this happens, the active range can be in the millions. ;; Use a compressed range to avoid creating a huge list. - (gnus-range-difference (list gnus-newsgroup-active) old)) + (gnus-range-difference + (gnus-range-difference (list gnus-newsgroup-active) old) + gnus-newsgroup-unexist)) (setq len (gnus-range-length older)) (cond ((null older) nil) @@ -12880,9 +12876,8 @@ If ALL is a number, fetch this number of articles." (if initial "max" "default") len) nil nil - (if initial - (cons (number-to-string initial) - 0))))) + (and initial + (number-to-string initial))))) (unless (string-match "^[ \t]*$" input) (setq all (string-to-number input)) (if (< all len)