X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-sum.el;h=04453673b32c1e15e77446cbd5c881bc3501d826;hb=f0e38408ebe4249827e9fc21cdf1556a636966d3;hp=8ef602df032dc00fa0fa22a1bb73ccf14b0b14df;hpb=30d9f23f0291edcefeca1958befadb992d2982b5;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 8ef602d..0445367 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -819,6 +819,17 @@ default charset will be used instead." :type '(repeat symbol) :group 'gnus-charset) +(defcustom gnus-group-highlight-words-alist nil + "Alist of group regexps and highlight regexps. +This variable uses the same syntax as `gnus-emphasis-alist'." + :type '(repeat (cons (regexp :tag "Group") + (repeat (list (regexp :tag "Highlight regexp") + (number :tag "Group for entire word" 0) + (number :tag "Group for displayed part" 0) + (symbol :tag "Face" + gnus-emphasis-highlight-words))))) + :group 'gnus-summary-visual) + ;;; Internal variables (defvar gnus-article-mime-handles nil) @@ -1008,6 +1019,7 @@ variable (string, integer, character, etc).") (defvar gnus-last-article nil) (defvar gnus-newsgroup-history nil) (defvar gnus-newsgroup-charset nil) +(defvar gnus-newsgroup-emphasis-alist nil) (defconst gnus-summary-local-variables '(gnus-newsgroup-name @@ -1041,7 +1053,7 @@ variable (string, integer, character, etc).") gnus-cache-removable-articles gnus-newsgroup-cached gnus-newsgroup-data gnus-newsgroup-data-reverse gnus-newsgroup-limit gnus-newsgroup-limits - gnus-newsgroup-charset) + gnus-newsgroup-charset gnus-newsgroup-emphasis-alist) "Variables that are buffer-local to the summary buffers.") ;; Byte-compiler warning. @@ -1376,6 +1388,7 @@ increase the score of each group you read." "T" gnus-summary-limit-include-thread "d" gnus-summary-limit-exclude-dormant "t" gnus-summary-limit-to-age + "x" gnus-summary-limit-to-extra "E" gnus-summary-limit-include-expunged "c" gnus-summary-limit-exclude-childless-dormant "C" gnus-summary-limit-mark-excluded-as-read) @@ -1446,11 +1459,13 @@ increase the score of each group you read." "e" gnus-summary-end-of-article "^" gnus-summary-refer-parent-article "r" gnus-summary-refer-parent-article + "D" gnus-summary-enter-digest-group "R" gnus-summary-refer-references "T" gnus-summary-refer-thread "g" gnus-summary-show-article "s" gnus-summary-isearch-article - "P" gnus-summary-print-article) + "P" gnus-summary-print-article + "t" gnus-article-babel) (gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map) "b" gnus-article-add-buttons @@ -1688,6 +1703,7 @@ increase the score of each group you read." ("Cache" ["Enter article" gnus-cache-enter-article t] ["Remove article" gnus-cache-remove-article t]) + ["Translate" gnus-article-babel t] ["Select article buffer" gnus-summary-select-article-buffer t] ["Enter digest buffer" gnus-summary-enter-digest-group t] ["Isearch article..." gnus-summary-isearch-article t] @@ -1778,6 +1794,7 @@ increase the score of each group you read." ["Subject..." gnus-summary-limit-to-subject t] ["Author..." gnus-summary-limit-to-author t] ["Age..." gnus-summary-limit-to-age t] + ["Extra..." gnus-summary-limit-to-extra t] ["Score" gnus-summary-limit-to-score t] ["Unread" gnus-summary-limit-to-unread t] ["Non-dormant" gnus-summary-limit-exclude-dormant t] @@ -2422,7 +2439,8 @@ marks of articles." (gac gnus-article-current) (reffed gnus-reffed-article-number) (score-file gnus-current-score-file) - (default-charset gnus-newsgroup-charset)) + (default-charset gnus-newsgroup-charset) + (emphasis-alist gnus-newsgroup-emphasis-alist)) (save-excursion (set-buffer gnus-group-buffer) (setq gnus-newsgroup-name name @@ -2436,7 +2454,8 @@ marks of articles." gnus-original-article-buffer original gnus-reffed-article-number reffed gnus-current-score-file score-file - gnus-newsgroup-charset default-charset) + gnus-newsgroup-charset default-charset + gnus-newsgroup-emphasis-alist emphasis-alist) ;; The article buffer also has local variables. (when (gnus-buffer-live-p gnus-article-buffer) (set-buffer gnus-article-buffer) @@ -4017,6 +4036,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setq gnus-newsgroup-unselected nil) (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group)) (gnus-summary-setup-default-charset) + (gnus-summary-setup-highlight-words) ;; Adjust and set lists of article marks. (when info @@ -4264,13 +4284,14 @@ If SELECT-ARTICLES, only select those articles from GROUP." (uncompressed '(score bookmark killed)) type list newmarked symbol delta-marks) (when info - ;; Add all marks lists that are non-nil to the list of marks lists. + ;; Add all marks lists to the list of marks lists. (while (setq type (pop types)) - (when (setq list (symbol-value + (setq list (symbol-value (setq symbol (intern (format "gnus-newsgroup-%s" (car type)))))) + (when list ;; Get rid of the entries of the articles that have the ;; default score. (when (and (eq (cdr type) 'score) @@ -4285,27 +4306,26 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setcdr prev (cdr arts)) (setq prev arts)) (setq arts (cdr arts))) - (setq list (cdr all)))) - - (when (gnus-check-backend-function 'request-set-mark - gnus-newsgroup-name) - ;; uncompressed:s are not proper flags (they are cons cells) - ;; cache is a internal gnus flag - (unless (memq (cdr type) (cons 'cache uncompressed)) - (let* ((old (cdr (assq (cdr type) (gnus-info-marks info)))) - (list (gnus-compress-sequence (sort list '<))) - (del (gnus-remove-from-range old list)) - (add (gnus-remove-from-range list old))) - (if add - (push (list add 'add (list (cdr type))) delta-marks)) - (if del - (push (list del 'del (list (cdr type))) delta-marks))))) + (setq list (cdr all))))) + + (or (memq (cdr type) uncompressed) + (setq list (gnus-compress-sequence (set symbol (sort list '<)) t))) + + (when (gnus-check-backend-function 'request-set-mark + gnus-newsgroup-name) + ;; uncompressed:s are not proper flags (they are cons cells) + ;; cache is a internal gnus flag + (unless (memq (cdr type) (cons 'cache uncompressed)) + (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))) + (if add + (push (list add 'add (list (cdr type))) delta-marks)) + (if del + (push (list del 'del (list (cdr type))) delta-marks))))) - (push (cons (cdr type) - (if (memq (cdr type) uncompressed) list - (gnus-compress-sequence - (set symbol (sort list '<)) t))) - newmarked))) + (when list + (push (cons (cdr type) list) newmarked))) (when delta-marks (unless (gnus-check-group gnus-newsgroup-name) @@ -4868,7 +4888,8 @@ executed with point over the summary line of the articles." `(let ((,articles (gnus-summary-work-articles ,arg))) (while ,articles (gnus-summary-goto-subject (car ,articles)) - ,@forms)))) + ,@forms + (pop ,articles))))) (put 'gnus-summary-iterate 'lisp-indent-function 1) (put 'gnus-summary-iterate 'edebug-form-spec '(form body)) @@ -6137,7 +6158,7 @@ If given a prefix, remove all limits." "Limit the summary buffer to articles that are older than (or equal) AGE days. If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to articles that are younger than AGE days." - (interactive "nTime in days: \nP") + (interactive "nLimit to articles older than (in days): \nP") (prog1 (let ((data gnus-newsgroup-data) (cutoff (days-to-time age)) @@ -6155,6 +6176,30 @@ articles that are younger than AGE days." (gnus-summary-limit (nreverse articles))) (gnus-summary-position-point))) +(defun gnus-summary-limit-to-extra (header regexp) + "Limit the summary buffer to articles that match an 'extra' header." + (interactive + (let ((header + (intern + (gnus-completing-read + (symbol-name (car gnus-extra-headers)) + "Score extra header:" + (mapcar (lambda (x) + (cons (symbol-name x) x)) + gnus-extra-headers) + nil + t)))) + (list header + (read-string (format "Limit to header %s (regexp): " header))))) + (when (not (equal "" regexp)) + (prog1 + (let ((articles (gnus-summary-find-matching + (cons 'extra header) regexp 'all))) + (unless articles + (error "Found no matches for \"%s\"" regexp)) + (gnus-summary-limit articles)) + (gnus-summary-position-point)))) + (defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) (make-obsolete 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) @@ -6870,11 +6915,18 @@ in the comparisons." (let ((data (if (eq backward 'all) gnus-newsgroup-data (gnus-data-find-list (gnus-summary-article-number) (gnus-data-list backward)))) - (func `(lambda (h) (,(intern (concat "mail-header-" header)) h))) (case-fold-search (not not-case-fold)) - articles d) - (unless (fboundp (intern (concat "mail-header-" header))) - (error "%s is not a valid header" header)) + articles d func) + (if (consp header) + (if (eq (car header) 'extra) + (setq func + `(lambda (h) + (or (cdr (assq ',(cdr header) (mail-header-extra h))) + ""))) + (error "%s is an invalid header" header)) + (unless (fboundp (intern (concat "mail-header-" header))) + (error "%s is not a valid header" header)) + (setq func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))) (while data (setq d (car data)) (and (or (not unread) ; We want all articles... @@ -7027,7 +7079,7 @@ If ARG is a negative number, hide the unwanted header lines." (inhibit-point-motion-hooks t) hidden e) (save-restriction - (message-narrow-to-head) + (article-narrow-to-head) (setq hidden (gnus-article-hidden-text-p 'headers))) (goto-char (point-min)) (when (search-forward "\n\n" nil t) @@ -7229,10 +7281,6 @@ and `request-accept' functions." (when gnus-use-cache (gnus-cache-possibly-enter-article to-group to-article - (let ((header (copy-sequence - (gnus-summary-article-header article)))) - (mail-header-set-number header to-article) - header) (memq article gnus-newsgroup-marked) (memq article gnus-newsgroup-dormant) (memq article gnus-newsgroup-unreads))) @@ -7900,7 +7948,6 @@ returned." (save-excursion (gnus-cache-possibly-enter-article gnus-newsgroup-name article - (gnus-summary-article-header article) (= mark gnus-ticked-mark) (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) @@ -7946,7 +7993,6 @@ marked." (save-excursion (gnus-cache-possibly-enter-article gnus-newsgroup-name article - (gnus-summary-article-header article) (= mark gnus-ticked-mark) (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) @@ -8789,11 +8835,8 @@ save those articles instead." (and (boundp group) (symbol-name group) (symbol-value group) - (memq 'respool - (assoc (symbol-name - (car (gnus-find-method-for-group - (symbol-name group)))) - gnus-valid-select-methods)))) + (gnus-get-function (gnus-find-method-for-group + (symbol-name group)) 'request-accept-article t))) (defun gnus-read-move-group-name (prompt default articles prefix) "Read a group name." @@ -8844,6 +8887,40 @@ save those articles instead." (error "No such group: %s" to-newsgroup))) to-newsgroup)) +(defun gnus-summary-save-parts (type dir n reverse) + "Save parts matching TYPE to DIR. +If REVERSE, save parts that do not match TYPE." + (interactive + (list (read-string "Save parts of type: " "image/.*") + (read-file-name "Save to directory: " t nil t) + current-prefix-arg)) + (gnus-summary-iterate n + (let ((gnus-display-mime-function nil) + (gnus-inhibit-treatment t)) + (gnus-summary-select-article)) + (save-excursion + (set-buffer gnus-article-buffer) + (let ((handles (or (mm-dissect-buffer) (mm-uu-dissect)))) + (when handles + (gnus-summary-save-parts-1 type dir handles reverse)))))) + +(defun gnus-summary-save-parts-1 (type dir handle reverse) + (if (stringp (car handle)) + (mapcar (lambda (h) (gnus-summary-save-parts-1 type dir h reverse)) + (cdr handle)) + (when (if reverse + (not (string-match type (car (mm-handle-type handle)))) + (string-match type (car (mm-handle-type handle)))) + (let ((file (expand-file-name + (file-name-nondirectory + (or + (mail-content-type-get + (mm-handle-disposition handle) 'filename) + (concat gnus-newsgroup-name "." gnus-current-article))) + dir))) + (unless (file-exists-p file) + (mm-save-part-to-file handle file)))))) + ;; Summary extract commands (defun gnus-summary-insert-pseudos (pslist &optional not-view) @@ -9347,6 +9424,25 @@ returned." (gnus-set-mode-line 'summary) n)) +;; Added by Shenghuo Zhu +(defun gnus-summary-setup-highlight-words (&optional highlight-words) + "Setup newsgroup emphasis alist." + (let ((name (and gnus-newsgroup-name + (gnus-group-real-name gnus-newsgroup-name)))) + (setq gnus-newsgroup-emphasis-alist + (nconc + (let ((alist gnus-group-highlight-words-alist) elem highlight) + (while (setq elem (pop alist)) + (when (and name (string-match (car elem) name)) + (setq alist nil + highlight (copy-list (cdr elem))))) + highlight) + (copy-list highlight-words) + (if gnus-newsgroup-name + (copy-list (gnus-group-find-parameter + gnus-newsgroup-name 'highlight-words t))) + gnus-emphasis-alist)))) + (gnus-summary-make-all-marking-commands) (gnus-ems-redefine)