(defcustom gnus-summary-mode-hook nil
"*A hook for Gnus summary mode.
This hook is run before any variables are set in the summary buffer."
- :options '(turn-on-gnus-mailing-list-mode)
+ :options '(turn-on-gnus-mailing-list-mode gnus-pick-mode)
:group 'gnus-summary-various
:type 'hook)
:group 'gnus-summary
:type '(choice boolean regexp))
+(defcustom gnus-summary-muttprint-program "muttprint"
+ "Command (and optional arguments) used to run Muttprint."
+ :group 'gnus-summary
+ :type 'string)
+
;;; Internal variables
(defvar gnus-summary-display-cache nil)
(?l (bbb-grouplens-score gnus-tmp-header) ?s)
(?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d)
(?U gnus-tmp-unread ?c)
- (?f (gnus-summary-from-or-to-or-newsgroups gnus-tmp-header) ?s)
+ (?f (gnus-summary-from-or-to-or-newsgroups gnus-tmp-header gnus-tmp-from)
+ ?s)
(?t (gnus-summary-number-of-articles-in-thread
(and (boundp 'thread) (car thread)) gnus-tmp-level)
?d)
?c)
(?u gnus-tmp-user-defined ?s)
(?P (gnus-pick-line-number) ?d)
- (?B gnus-tmp-thread-tree-header-string ?s))
+ (?B gnus-tmp-thread-tree-header-string ?s)
+ (user-date (gnus-user-date
+ ,(macroexpand '(mail-header-date gnus-tmp-header))) ?s))
"An alist of format specifications that can appear in summary lines.
These are paired with what variables they correspond with, along with
the type of the variable (string, integer, character, etc).")
"Variables that are buffer-local to the summary buffers.")
(defvar gnus-newsgroup-variables nil
- "Variables that have separate values in the newsgroups.")
+ "A list of variables that have separate values in different newsgroups.
+A list of newsgroup (summary buffer) local variables, or cons of
+variables and their default values (when the default values are not
+nil), that should be made global while the summary buffer is active.
+These variables can be used to set variables in the group parameters
+while still allowing them to affect operations done in other
+buffers. For example:
+
+\(setq gnus-newsgroup-variables
+ '(message-use-followup-to
+ (gnus-visible-headers .
+ \"^From:\\\\|^Newsgroups:\\\\|^Subject:\\\\|^Date:\\\\|^To:\")))
+")
;; Byte-compiler warning.
(eval-when-compile (defvar gnus-article-mode-map))
gnus-mouse-2 gnus-mouse-pick-article
"m" gnus-summary-mail-other-window
"a" gnus-summary-post-news
+ "i" gnus-summary-news-other-window
"x" gnus-summary-limit-to-unread
"s" gnus-summary-isearch-article
"t" gnus-article-toggle-headers
"\M-\C-e" gnus-summary-edit-parameters
"\M-\C-a" gnus-summary-customize-parameters
"\C-c\C-b" gnus-bug
+ "\C-c\C-n" gnus-namazu-search
"*" gnus-cache-enter-article
"\M-*" gnus-cache-remove-article
"\M-&" gnus-summary-universal-argument
"l" gnus-summary-stop-page-breaking
"r" gnus-summary-caesar-message
"t" gnus-article-toggle-headers
+ "g" gnus-summary-toggle-smiley
"v" gnus-summary-verbose-headers
"m" gnus-summary-toggle-mime
"a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive
"p" gnus-article-verify-x-pgp-sig
- "d" gnus-article-treat-dumbquotes
- "s" gnus-smiley-display)
+ "d" gnus-article-treat-dumbquotes)
(gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
"a" gnus-article-hide
"h" gnus-summary-save-article-folder
"v" gnus-summary-save-article-vm
"p" gnus-summary-pipe-output
+ "P" gnus-summary-muttprint
"s" gnus-soup-add-article)
(gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map)
["Toggle MIME" gnus-summary-toggle-mime t]
["Verbose header" gnus-summary-verbose-headers t]
["Toggle header" gnus-summary-toggle-header t]
- ["Toggle smileys" gnus-smiley-display t]
+ ["Toggle smiley" gnus-summary-toggle-smiley t]
["Verify X-PGP-Sig" gnus-article-verify-x-pgp-sig t]
["HZ" gnus-article-decode-HZ t])
("Output"
["Save body in file" gnus-summary-save-article-body-file t]
["Pipe through a filter" gnus-summary-pipe-output t]
["Add to SOUP packet" gnus-soup-add-article t]
+ ["Print with Muttprint" gnus-summary-muttprint t]
["Print" gnus-summary-print-article t])
("Backend"
["Respool article..." gnus-summary-respool-article t]
(easy-menu-define
gnus-summary-post-menu gnus-summary-mode-map ""
`("Post"
- ["Post an article" gnus-summary-post-news
+ ["Send a message (mail or news)" gnus-summary-post-news
,@(if (featurep 'xemacs) '(t)
'(:help "Post an article"))]
["Followup" gnus-summary-followup
["Resend message" gnus-summary-resend-message t]
["Send bounced mail" gnus-summary-resend-bounced-mail t]
["Send a mail" gnus-summary-mail-other-window t]
+ ["Create a local message" gnus-summary-news-other-window t]
["Uuencode and post" gnus-uu-post-news
,@(if (featurep 'xemacs) '(t)
'(:help "Post a uuencoded article"))]
["Age..." gnus-summary-limit-to-age t]
["Extra..." gnus-summary-limit-to-extra t]
["Score" gnus-summary-limit-to-score t]
- ["Score" gnus-summary-limit-to-display-predicate t]
+ ["Display Predicate" gnus-summary-limit-to-display-predicate t]
["Unread" gnus-summary-limit-to-unread t]
["Non-dormant" gnus-summary-limit-exclude-dormant t]
["Articles" gnus-summary-limit-to-articles t]
(defun gnus-summary-buffer-name (group)
"Return the summary buffer name of GROUP."
- (concat "*Summary " group "*"))
+ (concat "*Summary " (gnus-group-decoded-name group) "*"))
(defun gnus-summary-setup-buffer (group)
"Initialize summary buffer."
(point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
(list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
-(defun gnus-summary-from-or-to-or-newsgroups (header)
- (let ((to (cdr (assq 'To (mail-header-extra header))))
- (newsgroups (cdr (assq 'Newsgroups (mail-header-extra header))))
- (default-mime-charset (with-current-buffer gnus-summary-buffer
+(defun gnus-summary-extract-address-component (from)
+ (or (car (funcall gnus-extract-address-components from))
+ from))
+
+(defun gnus-summary-from-or-to-or-newsgroups (header gnus-tmp-from)
+ (let ((default-mime-charset (with-current-buffer gnus-summary-buffer
default-mime-charset)))
- (cond
- ((and to
- gnus-ignored-from-addresses
- (string-match gnus-ignored-from-addresses
- (mail-header-from header)))
- (concat "-> "
- (or (car (funcall gnus-extract-address-components
- (funcall
- gnus-decode-encoded-word-function to)))
- (funcall gnus-decode-encoded-word-function to))))
- ((and newsgroups
- gnus-ignored-from-addresses
- (string-match gnus-ignored-from-addresses
- (mail-header-from header)))
- (concat "=> " newsgroups))
- (t
- (or (car (funcall gnus-extract-address-components
- (mail-header-from header)))
- (mail-header-from header))))))
+ ;; Is it really necessary to do this next part for each summary line?
+ ;; Luckily, doesn't seem to slow things down much.
+ (or
+ (and gnus-ignored-from-addresses
+ (string-match gnus-ignored-from-addresses gnus-tmp-from)
+ (let ((extra-headers (mail-header-extra header))
+ to
+ newsgroups)
+ (cond
+ ((setq to (cdr (assq 'To extra-headers)))
+ (concat "-> "
+ (gnus-summary-extract-address-component
+ (funcall gnus-decode-encoded-word-function to))))
+ ((setq newsgroups (cdr (assq 'Newsgroups extra-headers)))
+ (concat "=> " newsgroups)))))
+ (gnus-summary-extract-address-component gnus-tmp-from))))
(defun gnus-summary-insert-line (gnus-tmp-header
gnus-tmp-level gnus-tmp-current
articles fetched-articles cached)
(unless (gnus-check-server
- (setq gnus-current-select-method
- (gnus-find-method-for-group group)))
+ (set (make-local-variable 'gnus-current-select-method)
+ (gnus-find-method-for-group group)))
(error "Couldn't open server"))
(or (and entry (not (eq (car entry) t))) ; Either it's active...
(let ((display (gnus-group-find-parameter group 'display)))
(setq gnus-newsgroup-display
(cond
+ ((not (zerop (or (car-safe read-all) 0)))
+ ;; The user entered the group with C-u SPC/RET, let's show
+ ;; all articles.
+ 'gnus-not-ignore)
((eq display 'all)
'gnus-not-ignore)
((arrayp display)
(gnus-summary-display-make-predicate (mapcar 'identity display)))
+ ((numberp display)
+ ;; The following is probably the "correct" solution, but
+ ;; it makes Gnus fetch all headers and then limit the
+ ;; articles (which is slow), so instead we hack the
+ ;; select-articles parameter instead. -- Simon Josefsson
+ ;; <jas@kth.se>
+ ;;
+ ;; (gnus-byte-compile
+ ;; `(lambda () (> number ,(- (cdr (gnus-active group))
+ ;; display)))))
+ (setq select-articles
+ (gnus-uncompress-range
+ (cons (let ((tmp (- (cdr (gnus-active group)) display)))
+ (if (> tmp 0)
+ tmp
+ 1))
+ (cdr (gnus-active group)))))
+ nil)
(t
nil))))
(or (cadr (assq mark gnus-article-special-mark-lists))
'list))
+(defun gnus-article-unpropagatable-p (mark)
+ "Return whether MARK should be propagated to backend."
+ (memq mark gnus-article-unpropagated-mark-lists))
+
(defun gnus-adjust-marked-articles (info)
"Set all article lists and remove all marks that are no longer valid."
(let* ((marked-lists (gnus-info-marks info))
"Enter the various lists of marked articles into the newsgroup info list."
(let ((types gnus-article-mark-lists)
(info (gnus-get-info gnus-newsgroup-name))
- (uncompressed '(score bookmark killed seen))
type list newmarked symbol delta-marks)
(when info
;; Add all marks lists to the list of marks lists.
(gnus-add-to-range list gnus-newsgroup-unseen)
(gnus-compress-sequence gnus-newsgroup-articles))))
- (unless (memq (cdr type) uncompressed)
+ (when (eq (gnus-article-mark-to-type (cdr type)) 'list)
(setq list (gnus-compress-sequence (set symbol (sort list '<)) t)))
- (when (gnus-check-backend-function
- 'request-set-mark gnus-newsgroup-name)
- ;; propagate flags to server, with the following exceptions:
- ;; uncompressed:s are not proper flags (they are cons cells)
- ;; cache is a internal gnus flag
- ;; download are local to one gnus installation (well)
- ;; unsend are for nndraft groups only
- ;; xxx: generality of this? this suits nnimap anyway
- (unless (memq (cdr type) (append '(cache download unsend)
- 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)))
- (when add
- (push (list add 'add (list (cdr type))) delta-marks))
- (when del
- (push (list del 'del (list (cdr type))) delta-marks)))))
+ (when (and (gnus-check-backend-function
+ '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)))
+ (when add
+ (push (list add 'add (list (cdr type))) delta-marks))
+ (when del
+ (push (list del 'del (list (cdr type))) delta-marks))))
(when list
(push (cons (cdr type) list) newmarked)))
(gnus-info-set-marks ',info ',(gnus-info-marks info) t)
(gnus-info-set-read ',info ',(gnus-info-read info))
(gnus-get-unread-articles-in-group ',info (gnus-active ,group))
+ (gnus-request-set-mark ,group (list (list ',range 'del '(read))))
(gnus-group-update-group ,group t))))
;; Add the read articles to the range.
(gnus-info-set-read info range)
(gnus-summary-limit nil 'pop)
(gnus-summary-position-point)))
-(defun gnus-summary-limit-to-subject (subject &optional header)
- "Limit the summary buffer to articles that have subjects that match a regexp."
- (interactive "sLimit to subject (regexp): ")
+(defun gnus-summary-limit-to-subject (subject &optional header not-matching)
+ "Limit the summary buffer to articles that have subjects that match a regexp.
+If NOT-MATCHING, excluding articles that have subjects that match a regexp."
+ (interactive
+ (list (read-string (if current-prefix-arg
+ "Exclude subject (regexp): "
+ "Limit to subject (regexp): "))
+ nil current-prefix-arg))
(unless header
(setq header "subject"))
(when (not (equal "" subject))
(prog1
(let ((articles (gnus-summary-find-matching
- (or header "subject") subject 'all)))
+ (or header "subject") subject 'all nil nil
+ not-matching)))
(unless articles
(error "Found no matches for \"%s\"" subject))
(gnus-summary-limit articles))
(gnus-summary-position-point))))
-(defun gnus-summary-limit-to-author (from)
- "Limit the summary buffer to articles that have authors that match a regexp."
- (interactive "sLimit to author (regexp): ")
- (gnus-summary-limit-to-subject from "from"))
+(defun gnus-summary-limit-to-author (from &optional not-matching)
+ "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): "))
+ current-prefix-arg))
+ (gnus-summary-limit-to-subject from "from" not-matching))
(defun gnus-summary-limit-to-age (age &optional younger-p)
"Limit the summary buffer to articles that are older than (or equal) AGE days.
(gnus-summary-limit (nreverse articles)))
(gnus-summary-position-point)))
-(defun gnus-summary-limit-to-extra (header regexp)
+(defun gnus-summary-limit-to-extra (header regexp &optional not-matching)
"Limit the summary buffer to articles that match an 'extra' header."
(interactive
(let ((header
(intern
(gnus-completing-read
(symbol-name (car gnus-extra-headers))
- "Limit extra header:"
+ (if current-prefix-arg
+ "Exclude extra header:"
+ "Limit 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)))))
+ (read-string (format "%s header %s (regexp): "
+ (if current-prefix-arg "Exclude" "Limit to")
+ header))
+ current-prefix-arg)))
(when (not (equal "" regexp))
(prog1
(let ((articles (gnus-summary-find-matching
- (cons 'extra header) regexp 'all)))
+ (cons 'extra header) regexp 'all nil nil
+ not-matching)))
(unless articles
(error "Found no matches for \"%s\"" regexp))
(gnus-summary-limit articles))
"Limit the summary buffer to the predicated in the `display' group parameter."
(interactive)
(unless gnus-newsgroup-display
- (error "There is no `diplay' group parameter"))
+ (error "There is no `display' group parameter"))
(let (articles)
(dolist (number gnus-newsgroup-articles)
(when (funcall gnus-newsgroup-display)
(gnus-summary-limit articles))
(gnus-summary-position-point)))
-(defun gnus-summary-limit-to-score (&optional score)
+(defun gnus-summary-limit-to-score (score)
"Limit to articles with score at or above SCORE."
- (interactive "P")
- (setq score (if score
- (prefix-numeric-value score)
- (or gnus-summary-default-score 0)))
+ (interactive "NLimit to articles with score of at least: ")
(let ((data gnus-newsgroup-data)
articles)
(while data
(nreverse articles)))
(defun gnus-summary-find-matching (header regexp &optional backward unread
- not-case-fold)
+ not-case-fold not-matching)
"Return a list of all articles that match REGEXP on HEADER.
The search stars on the current article and goes forwards unless
BACKWARD is non-nil. If BACKWARD is `all', do all articles.
If UNREAD is non-nil, only unread articles will
be taken into consideration. If NOT-CASE-FOLD, case won't be folded
-in the comparisons."
+in the comparisons. If NOT-MATCHING, return a list of all articles that
+not match REGEXP on HEADER."
(let ((case-fold-search (not not-case-fold))
articles d func)
(if (consp header)
(when (and (or (not unread) ; We want all articles...
(gnus-data-unread-p d)) ; Or just unreads.
(vectorp (gnus-data-header d)) ; It's not a pseudo.
- (string-match regexp
- (funcall func (gnus-data-header d)))) ; Match.
+ (if not-matching
+ (not (string-match
+ regexp
+ (funcall func (gnus-data-header d))))
+ (string-match regexp
+ (funcall func (gnus-data-header d)))))
(push (gnus-data-number d) articles))) ; Success!
(nreverse articles)))
(when gnus-page-broken
(gnus-narrow-to-page))))
+(defun gnus-summary-print-truncate-and-quote (string &optional len)
+ "Truncate to LEN and quote all \"(\"'s in STRING."
+ (gnus-replace-in-string (if (and len (> (length string) len))
+ (substring string 0 len)
+ string)
+ "[()]" "\\\\\\&"))
+
(defun gnus-summary-print-article (&optional filename n)
"Generate and print a PostScript image of the N next (mail) articles.
(let ((ps-left-header
(list
(concat "("
- (mail-header-subject gnus-current-headers) ")")
+ (gnus-summary-print-truncate-and-quote
+ (mail-header-subject gnus-current-headers)
+ 66) ")")
(concat "("
- (mail-header-from gnus-current-headers) ")")))
+ (gnus-summary-print-truncate-and-quote
+ (mail-header-from gnus-current-headers)
+ 45) ")")))
(ps-right-header
(list
"/pagenumberstring load"
(ps-despool filename))
(defun gnus-summary-show-article (&optional arg)
- "Force re-fetching of the current article.
+ "Force redisplaying of the current article.
If ARG (the prefix) is a number, show the article with the charset
defined in `gnus-summary-show-article-charset-alist', or the charset
input.
If ARG (the prefix) is non-nil and not a number, show the raw article
-without any article massaging functions being run."
+without any article massaging functions being run. Normally, the key strokes
+are `C-u g'."
(interactive "P")
(cond
((numberp arg)
"View as charset: "
(save-excursion
(set-buffer gnus-article-buffer)
- (detect-coding-region (point) (point-max) t)))))
+ (let ((coding-systems
+ (detect-coding-region (point) (point-max))))
+ (or (car-safe coding-systems)
+ coding-systems))))))
(gnus-newsgroup-ignored-charsets 'gnus-all))
(gnus-summary-select-article nil 'force)
(let ((deps gnus-newsgroup-dependencies)
- head header)
+ head header lines)
(save-excursion
(set-buffer gnus-original-article-buffer)
(save-restriction
(message-narrow-to-head)
- (setq head (buffer-string)))
+ (setq head (buffer-string))
+ (goto-char (point-min))
+ (unless (re-search-forward "^lines:[ \t]\\([0-9]+\\)" nil t)
+ (goto-char (point-max))
+ (widen)
+ (setq lines (1- (count-lines (point) (point-max))))))
(with-temp-buffer
(insert (format "211 %d Article retrieved.\n"
(cdr gnus-article-current)))
(insert head)
+ (if lines (insert (format "Lines: %d\n" lines)))
(insert ".\n")
(let ((nntp-server-buffer (current-buffer)))
(setq header (car (gnus-get-newsgroup-headers deps t))))))
(mail-header-xref (gnus-summary-article-header article))
" ")))
(setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name)
- ":" article))
+ ":" (number-to-string article)))
(unless xref
(setq xref (list (system-name))))
(setq new-xref
(gnus-request-accept-article
to-newsgroup select-method (not articles))))
(setq new-xref (concat new-xref " " (car art-group)
- ":" (cdr art-group)))
+ ":"
+ (number-to-string (cdr art-group))))
;; Now we have the new Xrefs header, so we insert
;; it and replace the new article.
(nnheader-replace-header "Xref" new-xref)
(gnus-summary-mark-article article gnus-canceled-mark))))
(gnus-summary-remove-process-mark article))
;; Re-activate all groups that have been moved to.
- (while to-groups
- (save-excursion
- (set-buffer gnus-group-buffer)
- (when (gnus-group-goto-group (car to-groups) t)
- (gnus-group-get-new-news-this-group 1 t))
- (pop to-groups)))
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (let ((gnus-group-marked to-groups))
+ (gnus-group-get-new-news-this-group nil t)))
(gnus-kill-buffer copy-buf)
(gnus-summary-position-point)
(gnus-summary-move-article n nil nil 'crosspost))
(defcustom gnus-summary-respool-default-method nil
- "Default method for respooling an article.
+ "Default method type for respooling an article.
If nil, use to the current newsgroup method."
- :type '(choice (gnus-select-method :value (nnml ""))
- (const nil))
+ :type 'symbol
:group 'gnus-summary-mail)
(defun gnus-summary-respool-article (&optional n method)
(execute-kbd-macro (concat (this-command-keys) key))
(gnus-article-edit-done))
+(defun gnus-summary-toggle-smiley (&optional arg)
+ "Toggle the display of smilies as small graphical icons."
+ (interactive "P")
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (gnus-smiley-display arg)))
+
;;; Respooling
(defun gnus-summary-respool-query (&optional silent trace)
(gnus-message 1 "Article %d is unsaveable" article))
;; This is a real article.
(save-window-excursion
- (gnus-summary-select-article t nil nil article))
+ (let ((gnus-display-mime-function nil)
+ (gnus-article-prepare-hook nil))
+ (gnus-summary-select-article t nil nil article)))
(save-excursion
(set-buffer save-buffer)
(erase-buffer)
(let ((gnus-default-article-saver 'gnus-summary-save-body-in-file))
(gnus-summary-save-article arg)))
+(defun gnus-summary-muttprint (&optional arg)
+ "Print the current article using Muttprint.
+If N is a positive number, save the N next articles.
+If N is a negative number, save the N previous articles.
+If N is nil and any articles have been marked with the process mark,
+save those articles instead."
+ (interactive "P")
+ (require 'gnus-art)
+ (let ((gnus-default-article-saver 'gnus-summary-pipe-to-muttprint))
+ (gnus-summary-save-article arg t)))
+
(defun gnus-summary-pipe-message (program)
"Pipe the current article through PROGRAM."
(interactive "sProgram: ")
projects / elisp / gnus.git- / blobdiff