;;; Code:
(eval-when-compile (require 'cl))
+(eval-when-compile (require 'gnus-clfns))
(require 'gnus)
(require 'gnus-group)
:type '(choice (const :tag "disable")
integer))
+(defcustom gnus-summary-default-high-score 0
+ "*Default threshold for a high scored article.
+An article will be highlighted as high scored if its score is greater
+than this score."
+ :group 'gnus-score-default
+ :type 'integer)
+
+(defcustom gnus-summary-default-low-score 0
+ "*Default threshold for a low scored article.
+An article will be highlighted as low scored if its score is smaller
+than this score."
+ :group 'gnus-score-default
+ :type 'integer)
+
(defcustom gnus-summary-zcore-fuzz 0
"*Fuzziness factor for the zcore in the summary buffer.
Articles with scores closer than this to `gnus-summary-default-score'
:type 'character)
(defcustom gnus-souped-mark ?F
- "*Mark used for killed articles."
+ "*Mark used for souped articles."
:group 'gnus-summary-marks
:type 'character)
:group 'gnus-summary-marks
:type 'character)
+(defcustom gnus-forwarded-mark ?O
+ "*Mark used for articles that have been forwarded."
+ :group 'gnus-summary-marks
+ :type 'character)
+
(defcustom gnus-cached-mark ?*
"*Mark used for articles that are in the cache."
:group 'gnus-summary-marks
(defcustom gnus-summary-highlight
'(((= mark gnus-canceled-mark)
. gnus-summary-cancelled-face)
- ((and (> score default)
+ ((and (> score default-high)
(or (= mark gnus-dormant-mark)
(= mark gnus-ticked-mark)))
. gnus-summary-high-ticked-face)
- ((and (< score default)
+ ((and (< score default-low)
(or (= mark gnus-dormant-mark)
(= mark gnus-ticked-mark)))
. gnus-summary-low-ticked-face)
((or (= mark gnus-dormant-mark)
(= mark gnus-ticked-mark))
. gnus-summary-normal-ticked-face)
- ((and (> score default) (= mark gnus-ancient-mark))
+ ((and (> score default-high) (= mark gnus-ancient-mark))
. gnus-summary-high-ancient-face)
- ((and (< score default) (= mark gnus-ancient-mark))
+ ((and (< score default-low) (= mark gnus-ancient-mark))
. gnus-summary-low-ancient-face)
((= mark gnus-ancient-mark)
. gnus-summary-normal-ancient-face)
- ((and (> score default) (= mark gnus-unread-mark))
+ ((and (> score default-high) (= mark gnus-unread-mark))
. gnus-summary-high-unread-face)
- ((and (< score default) (= mark gnus-unread-mark))
+ ((and (< score default-low) (= mark gnus-unread-mark))
. gnus-summary-low-unread-face)
- ((and (memq article gnus-newsgroup-incorporated)
- (= mark gnus-unread-mark))
- . gnus-summary-incorporated-face)
((= mark gnus-unread-mark)
. gnus-summary-normal-unread-face)
- ((and (> score default) (memq mark (list gnus-downloadable-mark
+ ((and (> score default-high) (memq mark (list gnus-downloadable-mark
gnus-undownloaded-mark)))
. gnus-summary-high-unread-face)
- ((and (< score default) (memq mark (list gnus-downloadable-mark
+ ((and (< score default-low) (memq mark (list gnus-downloadable-mark
gnus-undownloaded-mark)))
. gnus-summary-low-unread-face)
- ((memq mark (list gnus-downloadable-mark gnus-undownloaded-mark))
+ ((and (memq mark (list gnus-downloadable-mark gnus-undownloaded-mark))
+ (memq article gnus-newsgroup-unreads))
. gnus-summary-normal-unread-face)
- ((> score default)
+ ((memq mark (list gnus-downloadable-mark gnus-undownloaded-mark))
+ . gnus-summary-normal-read-face)
+ ((> score default-high)
. gnus-summary-high-read-face)
- ((< score default)
+ ((< score default-low)
. gnus-summary-low-read-face)
(t
. gnus-summary-normal-read-face))
You can use the following variables in the FORM field.
-score: The articles score
-default: The default article score.
-below: The score below which articles are automatically marked as read.
-mark: The articles mark."
+score: The article's score
+default: The default article score.
+default-high: The default score for high scored articles.
+default-low: The default score for low scored articles.
+below: The score below which articles are automatically marked as read.
+mark: The articles mark."
:group 'gnus-summary-visual
:type '(repeat (cons (sexp :tag "Form" nil)
face)))
:group 'gnus-summary
:type 'regexp)
-(gnus-define-group-parameter
- charset
- :function-document
- "Return the default charset of GROUP."
- :variable gnus-group-charset-alist
- :variable-default
- '(("\\(^\\|:\\)hk\\>\\|\\(^\\|:\\)tw\\>\\|\\<big5\\>" cn-big5)
- ("\\(^\\|:\\)cn\\>\\|\\<chinese\\>" cn-gb-2312)
- ("\\(^\\|:\\)fj\\>\\|\\(^\\|:\\)japan\\>" iso-2022-jp-2)
- ("\\(^\\|:\\)tnn\\>\\|\\(^\\|:\\)pin\\>\\|\\(^\\|:\\)sci.lang.japan" iso-2022-7bit)
- ("\\(^\\|:\\)relcom\\>" koi8-r)
- ("\\(^\\|:\\)fido7\\>" koi8-r)
- ("\\(^\\|:\\)\\(cz\\|hun\\|pl\\|sk\\|hr\\)\\>" iso-8859-2)
- ("\\(^\\|:\\)israel\\>" iso-8859-1)
- ("\\(^\\|:\\)han\\>" euc-kr)
- ("\\(^\\|:\\)alt.chinese.text.big5\\>" chinese-big5)
- ("\\(^\\|:\\)soc.culture.vietnamese\\>" vietnamese-viqr)
- ("\\(^\\|:\\)\\(comp\\|rec\\|alt\\|sci\\|soc\\|news\\|gnu\\|bofh\\)\\>" iso-8859-1)
- (".*" iso-8859-1))
- :variable-document
- "Alist of regexps (to match group names) and default charsets to be used when reading."
- :variable-group gnus-charset
- :variable-type '(repeat (list (regexp :tag "Group")
- (symbol :tag "Charset")))
- :parameter-type '(symbol :tag "Charset")
- :parameter-document "\
-The default charset to use in the group.")
-
(defcustom gnus-newsgroup-ignored-charsets '(unknown-8bit x-unknown)
"List of charsets that should be ignored.
When these charsets are used in the \"charset\" parameter, the
(defcustom gnus-alter-articles-to-read-function nil
"Function to be called to alter the list of articles to be selected."
- :type 'function
+ :type '(choice (const nil) function)
:group 'gnus-summary)
(defcustom gnus-orphan-score nil
:group 'gnus-summary
:type 'regexp)
+(defcustom gnus-read-all-available-headers nil
+ "Whether Gnus should parse all headers made available to it.
+This is mostly relevant for slow backends where the user may
+wish to widen the summary buffer to include all headers
+that were fetched. Say, for nnultimate groups."
+ :group 'gnus-summary
+ :type '(choice boolean regexp))
;;; Internal variables
(?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s)
(?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s)
(?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
- (?L gnus-tmp-lines ?d)
+ (?L gnus-tmp-lines ?s)
(?I gnus-tmp-indentation ?s)
(?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
(?R gnus-tmp-replied ?c)
(defvar gnus-newsgroup-replied nil
"List of articles that have been replied to in the current newsgroup.")
+(defvar gnus-newsgroup-forwarded nil
+ "List of articles that have been forwarded in the current newsgroup.")
+
(defvar gnus-newsgroup-expirable nil
"List of articles in the current newsgroup that can be expired.")
gnus-newsgroup-auto-expire gnus-newsgroup-unreads
gnus-newsgroup-unselected gnus-newsgroup-marked
gnus-newsgroup-reads gnus-newsgroup-saved
- gnus-newsgroup-replied gnus-newsgroup-expirable
+ gnus-newsgroup-replied gnus-newsgroup-forwarded
+ gnus-newsgroup-expirable
gnus-newsgroup-processable gnus-newsgroup-killed
gnus-newsgroup-downloadable gnus-newsgroup-undownloaded
gnus-newsgroup-unsendable
"\C-c\C-s\C-s" gnus-summary-sort-by-subject
"\C-c\C-s\C-d" gnus-summary-sort-by-date
"\C-c\C-s\C-i" gnus-summary-sort-by-score
+ "\C-c\C-s\C-o" gnus-summary-sort-by-original
"=" gnus-summary-expand-window
"\C-x\C-s" gnus-summary-reselect-current-group
"\M-g" gnus-summary-rescan-group
"S" gnus-summary-limit-include-expunged
"C" gnus-summary-catchup
"H" gnus-summary-catchup-to-here
+ "h" gnus-summary-catchup-from-here
"\C-c" gnus-summary-catchup-all
"k" gnus-summary-kill-same-subject-and-select
"K" gnus-summary-kill-same-subject
"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)
+ "C" gnus-summary-limit-mark-excluded-as-read
+ "o" gnus-summary-insert-old-articles
+ "N" gnus-summary-insert-new-articles)
(gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map)
"n" gnus-summary-next-unread-article
"q" gnus-summary-respool-query
"t" gnus-summary-respool-trace
"i" gnus-summary-import-article
+ "I" gnus-summary-create-article
"p" gnus-summary-article-posted-p)
(gnus-define-keys (gnus-summary-save-map "O" gnus-summary-mode-map)
"i" gnus-article-inline-part
"|" gnus-article-pipe-part))
+(defvar gnus-article-post-menu nil)
+
(defun gnus-summary-make-menu-bar ()
(gnus-turn-off-edit-menu 'summary)
(gnus-check-backend-function
'request-replace-article gnus-newsgroup-name)]
["Import file..." gnus-summary-import-article t]
+ ["Create article..." gnus-summary-create-article t]
["Check if posted" gnus-summary-article-posted-p t]
["Edit article" gnus-summary-edit-article
(not (gnus-group-read-only-p))]
["Fetch current thread" gnus-summary-refer-thread t]
["Fetch article with id..." gnus-summary-refer-article t]
["Setup Mailing List Params" gnus-mailing-list-insinuate t]
- ["Redisplay" gnus-summary-show-article t])))
+ ["Redisplay" gnus-summary-show-article t]
+ ["Raw article" gnus-summary-show-raw-article t])))
(easy-menu-define
gnus-summary-article-menu gnus-summary-mode-map ""
(cons "Article" innards))
'(:help "Mail a reply, quoting this article"))]
["Mail forward" gnus-summary-mail-forward t]
["Post forward" gnus-summary-post-forward t]
- ["Digest and mail" gnus-uu-digest-mail-forward t]
- ["Digest and post" gnus-uu-digest-post-forward t]
+ ["Digest and mail" gnus-summary-digest-mail-forward t]
+ ["Digest and post" gnus-summary-digest-post-forward t]
["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]
;;["Send bounced" gnus-resend-bounced-mail t])
))
+ (cond
+ ((not (keymapp gnus-summary-post-menu))
+ (setq gnus-article-post-menu gnus-summary-post-menu))
+ ((not gnus-article-post-menu)
+ ;; Don't share post menu.
+ (setq gnus-article-post-menu
+ (copy-keymap gnus-summary-post-menu))))
+ (define-key gnus-article-mode-map [menu-bar post]
+ (cons "Post" gnus-article-post-menu))
+
(easy-menu-define
gnus-summary-misc-menu gnus-summary-mode-map ""
`("Misc"
'(:help "Mark unread articles in this group as read"))]
["Catchup all" gnus-summary-catchup-all t]
["Catchup to here" gnus-summary-catchup-to-here t]
+ ["Catchup from here" gnus-summary-catchup-from-here t]
["Catchup region" gnus-summary-mark-region-as-read t]
["Mark excluded" gnus-summary-limit-mark-excluded-as-read t])
("Mark Various"
gnus-summary-limit-exclude-childless-dormant t]
;;["Hide thread" gnus-summary-limit-exclude-thread t]
["Hide marked" gnus-summary-limit-exclude-marks t]
- ["Show expunged" gnus-summary-show-all-expunged t])
+ ["Show expunged" gnus-summary-limit-include-expunged t])
("Process Mark"
["Set mark" gnus-summary-mark-as-processable t]
["Remove mark" gnus-summary-unmark-as-processable t]
["Sort by date" gnus-summary-sort-by-date t]
["Sort by score" gnus-summary-sort-by-score t]
["Sort by lines" gnus-summary-sort-by-lines t]
- ["Sort by characters" gnus-summary-sort-by-chars t])
+ ["Sort by characters" gnus-summary-sort-by-chars t]
+ ["Original sort" gnus-summary-sort-by-original t])
("Help"
["Fetch group FAQ" gnus-summary-fetch-faq t]
["Describe group" gnus-summary-describe-group t]
["Regenerate" gnus-summary-prepare t]
["Insert cached articles" gnus-summary-insert-cached-articles t]
["Toggle threading" gnus-summary-toggle-threads t])
+ ["See old articles" gnus-summary-insert-old-articles t]
+ ["See new articles" gnus-summary-insert-new-articles t]
["Filter articles..." gnus-summary-execute-command t]
["Run command on subjects..." gnus-summary-universal-argument t]
["Search articles forward..." gnus-summary-search-article-forward t]
(let ((gnus-summary-line-format-spec spec)
(gnus-newsgroup-downloadable '((0 . t))))
(gnus-summary-insert-line
- (make-full-mail-header 0 "" "nobody" "" "" "" 0 0 "" nil)
+ (make-full-mail-header 0 "" "nobody"
+ "05 Apr 2001 23:33:09 +0400"
+ "" "" 0 0 "" nil)
0 nil 128 t nil "" nil 1)
(goto-char (point-min))
(setq pos (list (cons 'unread (and (search-forward "\200" nil t)
(when (string= gnus-tmp-name "")
(setq gnus-tmp-name gnus-tmp-from))
(unless (numberp gnus-tmp-lines)
- (setq gnus-tmp-lines 0))
+ (setq gnus-tmp-lines -1))
+ (when (= gnus-tmp-lines -1)
+ (setq gnus-tmp-lines "?"))
(gnus-put-text-property-excluding-characters-with-faces
(point)
(progn (eval gnus-summary-line-format-spec) (point))
(defun gnus-summary-set-local-parameters (group)
"Go through the local params of GROUP and set all variable specs in that list."
(let ((params (gnus-group-find-parameter group))
+ (vars '(quit-config)) ; Ignore quit-config.
elem)
(while params
(setq elem (car params)
(and (consp elem) ; Has to be a cons.
(consp (cdr elem)) ; The cdr has to be a list.
(symbolp (car elem)) ; Has to be a symbol in there.
- (not (memq (car elem) '(quit-config))) ; Ignore quit-config.
+ (not (memq (car elem) vars))
(ignore-errors ; So we set it.
+ (push (car elem) vars)
(make-local-variable (car elem))
(set (car elem) (eval (nth 1 elem))))))))
;; (when (and (not (gnus-group-native-p group))
;; (not (gnus-gethash group gnus-newsrc-hashtb)))
;; (error "Dead non-native groups can't be entered"))
- (gnus-message 5 "Retrieving newsgroup: %s..." group)
+ (gnus-message 5 "Retrieving newsgroup: %s..."
+ (gnus-group-decoded-name group))
(let* ((new-group (gnus-summary-setup-buffer group))
(quit-config (gnus-group-quit-config group))
(did-select (and new-group (gnus-select-newsgroup
(gnus-handle-ephemeral-exit quit-config)))
(let ((grpinfo (gnus-get-info group)))
(if (null (gnus-info-read grpinfo))
- (gnus-message 3 "Group %s contains no messages" group)
+ (gnus-message 3 "Group %s contains no messages"
+ (gnus-group-decoded-name group))
(gnus-message 3 "Can't select group")))
nil)
;; The user did a `C-g' while prompting for number of articles,
(setq thread (gnus-remove-thread id)))
(setq old-pos (gnus-point-at-bol))
(setq current (save-excursion
- (and (zerop (forward-line -1))
+ (and (re-search-backward "[\r\n]" nil t)
(gnus-summary-article-number))))
;; If this is a gathered thread, we have to go some re-gathering.
(when (stringp (car thread))
gnus-cached-mark)
((memq number gnus-newsgroup-replied)
gnus-replied-mark)
+ ((memq number gnus-newsgroup-forwarded)
+ gnus-forwarded-mark)
((memq number gnus-newsgroup-saved)
gnus-saved-mark)
(t gnus-no-mark))
(when (string= gnus-tmp-name "")
(setq gnus-tmp-name gnus-tmp-from))
(unless (numberp gnus-tmp-lines)
- (setq gnus-tmp-lines 0))
+ (setq gnus-tmp-lines -1))
+ (when (= gnus-tmp-lines -1)
+ (setq gnus-tmp-lines "?"))
(gnus-put-text-property
(point)
(progn (eval gnus-summary-line-format-spec) (point))
(when changed
(mail-header-set-subject header subject))))))
+(defun gnus-fetch-headers (articles)
+ "Fetch headers of ARTICLES."
+ (let ((name (gnus-group-decoded-name gnus-newsgroup-name)))
+ (gnus-message 5 "Fetching headers for %s..." name)
+ (prog1
+ ;;;!!! FIXME: temporary fix for an infloop on nnimap.
+ (if (eq 'nnimap (car (gnus-find-method-for-group name)))
+ (if (eq 'nov
+ (setq gnus-headers-retrieved-by
+ (gnus-retrieve-headers
+ articles gnus-newsgroup-name
+ ;; We might want to fetch old headers, but
+ ;; not if there is only 1 article.
+ (and (or (and
+ (not (eq gnus-fetch-old-headers 'some))
+ (not (numberp gnus-fetch-old-headers)))
+ (> (length articles) 1))
+ gnus-fetch-old-headers))))
+ (gnus-get-newsgroup-headers-xover
+ articles nil nil gnus-newsgroup-name t)
+ (gnus-get-newsgroup-headers))
+ (gnus-retrieve-parsed-headers
+ articles gnus-newsgroup-name
+ ;; We might want to fetch old headers, but
+ ;; not if there is only 1 article.
+ (and (or (and (not (eq gnus-fetch-old-headers 'some))
+ (not (numberp gnus-fetch-old-headers)))
+ (> (length articles) 1))
+ gnus-fetch-old-headers)))
+ (gnus-message 5 "Fetching headers for %s...done" name))))
+
(defun gnus-select-newsgroup (group &optional read-all select-articles)
"Select newsgroup GROUP.
If READ-ALL is non-nil, all articles in the group are selected.
(gnus-make-hashtable (length articles)))
(gnus-set-global-variables)
;; Retrieve the headers and read them in.
- (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name)
- (setq gnus-newsgroup-headers
- ;;;!!! FIXME: temporary fix for an infloop on nnimap.
- (if (eq 'nnimap (car (gnus-find-method-for-group group)))
- (if (eq 'nov
- (setq
- gnus-headers-retrieved-by
- (gnus-retrieve-headers
- articles gnus-newsgroup-name
- ;; We might want to fetch old headers, but
- ;; not if there is only 1 article.
- (and (or (and
- (not (eq gnus-fetch-old-headers 'some))
- (not (numberp gnus-fetch-old-headers)))
- (> (length articles) 1))
- gnus-fetch-old-headers))))
- (gnus-get-newsgroup-headers-xover
- articles nil nil gnus-newsgroup-name t)
- (gnus-get-newsgroup-headers))
- (gnus-retrieve-parsed-headers
- articles gnus-newsgroup-name
- ;; We might want to fetch old headers, but
- ;; not if there is only 1 article.
- (and (or (and (not (eq gnus-fetch-old-headers 'some))
- (not (numberp gnus-fetch-old-headers)))
- (> (length articles) 1))
- gnus-fetch-old-headers))))
- (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name)
+ (setq gnus-newsgroup-headers (gnus-fetch-headers articles))
;; Suppress duplicates?
(when gnus-suppress-duplicates
(let* ((mformat (symbol-value
(intern
(format "gnus-%s-mode-line-format-spec" where))))
- (gnus-tmp-group-name (gnus-group-name-decode
- gnus-newsgroup-name
- (gnus-group-name-charset
- nil
- gnus-newsgroup-name)))
+ (gnus-tmp-group-name (gnus-group-decoded-name
+ gnus-newsgroup-name))
(gnus-tmp-article-number (or gnus-current-article 0))
(gnus-tmp-unread gnus-newsgroup-unreads)
(gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads))
;; Subject.
(progn
(goto-char p)
- (if (search-forward "\nsubject: " nil t)
+ (if (search-forward "\nsubject:" nil t)
(nnheader-header-value)
"(none)"))
;; From.
(progn
(goto-char p)
- (if (or (search-forward "\nfrom: " nil t)
- (search-forward "\nfrom:" nil t))
+ (if (search-forward "\nfrom:" nil t)
(nnheader-header-value)
"(nobody)"))
;; Date.
(progn
(goto-char p)
- (if (search-forward "\ndate: " nil t)
- (nnheader-header-value)
- ""))
+ (if (search-forward "\ndate:" nil t)
+ (nnheader-header-value) ""))
;; Message-ID.
(progn
(goto-char p)
;; References.
(progn
(goto-char p)
- (if (search-forward "\nreferences: " nil t)
+ (if (search-forward "\nreferences:" nil t)
(progn
(setq end (point))
(prog1
;; Get the references from the in-reply-to header if there
;; were no references and the in-reply-to header looks
;; promising.
- (if (and (search-forward "\nin-reply-to: " nil t)
+ (if (and (search-forward "\nin-reply-to:" nil t)
(setq in-reply-to (nnheader-header-value))
(string-match "<[^>]+>" in-reply-to))
(let (ref2)
(goto-char p)
(if (search-forward "\nchars: " nil t)
(if (numberp (setq chars (ignore-errors (read cur))))
- chars 0)
- 0))
+ chars -1)
+ -1))
;; Lines.
(progn
(goto-char p)
(if (search-forward "\nlines: " nil t)
(if (numberp (setq lines (ignore-errors (read cur))))
- lines 0)
- 0))
+ lines -1)
+ -1))
;; Xref.
(progn
(goto-char p)
- (and (search-forward "\nxref: " nil t)
+ (and (search-forward "\nxref:" nil t)
(nnheader-header-value)))
;; Extra.
(when gnus-extra-headers
(while extra
(goto-char p)
(when (search-forward
- (concat "\n" (symbol-name (car extra)) ": ") nil t)
+ (concat "\n" (symbol-name (car extra)) ":") nil t)
(push (cons (car extra) (nnheader-header-value)) out))
(pop extra))
out))))
(mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)
(cur nntp-server-buffer)
(dependencies (or dependencies gnus-newsgroup-dependencies))
+ (allp (cond
+ ((eq gnus-read-all-available-headers t)
+ t)
+ ((stringp gnus-read-all-available-headers)
+ (string-match gnus-read-all-available-headers group))
+ (t
+ nil)))
number headers header)
(save-excursion
(set-buffer nntp-server-buffer)
(goto-char (point-min))
(while (not (eobp))
(condition-case ()
- (while (and sequence (not (eobp)))
+ (while (and (or sequence allp)
+ (not (eobp)))
(setq number (read cur))
- (while (and sequence
- (< (car sequence) number))
- (setq sequence (cdr sequence)))
- (and sequence
- (eq number (car sequence))
- (progn
- (setq sequence (cdr sequence))
- (setq header (inline
- (gnus-nov-parse-line
- number dependencies force-new))))
- (push header headers))
+ (when (not allp)
+ (while (and sequence
+ (< (car sequence) number))
+ (setq sequence (cdr sequence))))
+ (when (and (or allp
+ (and sequence
+ (eq number (car sequence))))
+ (progn
+ (setq sequence (cdr sequence))
+ (setq header (inline
+ (gnus-nov-parse-line
+ number dependencies force-new)))))
+ (push header headers))
(forward-line 1))
(error
(gnus-error 4 "Strange nov line (%d)"
(nreverse headers)
;;;!!! FIXME: temporary fix for an infloop on nnimap.
(if (eq 'nnimap (car (gnus-find-method-for-group group)))
- (when (gnus-retrieve-headers sequence group)
+ (when (eq (gnus-retrieve-headers sequence group) 'headers)
(gnus-get-newsgroup-headers))
(gnus-retrieve-parsed-headers sequence group))))))))
(setq gnus-article-current nil))
(set-buffer buf)
(if (not gnus-kill-summary-on-exit)
- (gnus-deaden-summary)
+ (progn
+ (gnus-deaden-summary)
+ (setq mode nil))
;; We set all buffer-local variables to nil. It is unclear why
;; this is needed, but if we don't, buffer-local variables are
;; not garbage-collected, it seems. This would the lead to en
(set-buffer gnus-group-buffer)
(gnus-summary-clear-local-variables)
(let ((gnus-summary-local-variables gnus-newsgroup-variables))
- (gnus-summary-clear-local-variables))
- ;; Return to group mode buffer.
- (when (eq mode 'gnus-summary-mode)
- (gnus-kill-buffer buf)))
+ (gnus-summary-clear-local-variables)))
(setq gnus-current-select-method gnus-select-method)
(pop-to-buffer gnus-group-buffer)
(if (not quit-config)
(set-window-start (selected-window) (point))
(goto-char group-point)))
(gnus-handle-ephemeral-exit quit-config))
+ ;; Return to group mode buffer.
+ (when (eq mode 'gnus-summary-mode)
+ (gnus-kill-buffer buf))
;; Clear the current group name.
(unless quit-config
(setq gnus-newsgroup-name nil)))))
(gnus-summary-position-point))))
(defun gnus-summary-limit-include-thread (id)
- "Display all the hidden articles that in the current thread."
+ "Display all the hidden articles that is in the thread with ID in it.
+When called interactively, ID is the Message-ID of the current
+article."
(interactive (list (mail-header-id (gnus-summary-article-header))))
(let ((articles (gnus-articles-in-thread
(gnus-id-to-thread (gnus-root-id id)))))
(prog1
(gnus-summary-limit (nconc articles gnus-newsgroup-limit))
+ (gnus-summary-limit-include-matching-articles
+ "subject"
+ (regexp-quote (gnus-simplify-subject-re
+ (mail-header-subject (gnus-id-to-header id)))))
+ (gnus-summary-position-point))))
+
+(defun gnus-summary-limit-include-matching-articles (header regexp)
+ "Display all the hidden articles that have HEADERs that match REGEXP."
+ (interactive (list (read-string "Match on header: ")
+ (read-string "Regexp: ")))
+ (let ((articles (gnus-find-matching-articles header regexp)))
+ (prog1
+ (gnus-summary-limit (nconc articles gnus-newsgroup-limit))
(gnus-summary-position-point))))
(defun gnus-summary-limit-include-dormant ()
(gnus-summary-position-point)
t)))
+(defun gnus-find-matching-articles (header regexp)
+ "Return a list of all articles that match REGEXP on HEADER.
+This search includes all articles in the current group that Gnus has
+fetched headers for, whether they are displayed or not."
+ (let ((articles nil)
+ (func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))
+ (case-fold-search t))
+ (dolist (header gnus-newsgroup-headers)
+ (when (string-match regexp (funcall func header))
+ (push (mail-header-number header) articles)))
+ (nreverse articles)))
+
(defun gnus-summary-find-matching (header regexp &optional backward unread
not-case-fold)
"Return a list of all articles that match REGEXP on HEADER.
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."
- (let ((data (if (eq backward 'all) gnus-newsgroup-data
- (gnus-data-find-list
- (gnus-summary-article-number) (gnus-data-list backward))))
- (case-fold-search (not not-case-fold))
+ (let ((case-fold-search (not not-case-fold))
articles d func)
(if (consp header)
(if (eq (car header) 'extra)
(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...
- (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.
- (push (gnus-data-number d) articles)) ; Success!
- (setq data (cdr data)))
+ (dolist (d (if (eq backward 'all)
+ gnus-newsgroup-data
+ (gnus-data-find-list
+ (gnus-summary-article-number)
+ (gnus-data-list backward))))
+ (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.
+ (push (gnus-data-number d) articles))) ; Success!
(nreverse articles)))
(defun gnus-summary-execute-command (header regexp command &optional backward)
(list (let ((completion-ignore-case t))
(completing-read
"Header name: "
- (mapcar (lambda (string) (list string))
- '("Number" "Subject" "From" "Lines" "Date"
- "Message-ID" "Xref" "References" "Body"))
+ (mapcar (lambda (header) (list (format "%s" header)))
+ (append
+ '("Number" "Subject" "From" "Lines" "Date"
+ "Message-ID" "Xref" "References" "Body")
+ gnus-extra-headers))
nil 'require-match))
(read-string "Regexp: ")
(read-key-sequence "Command: ")
(mail-header-date gnus-current-headers) ")"))))
(gnus-run-hooks 'gnus-ps-print-hook)
(save-excursion
- (ps-spool-buffer-with-faces))))
+ (if window-system
+ (ps-spool-buffer-with-faces)
+ (ps-spool-buffer)))))
(kill-buffer buffer))))
(gnus-summary-remove-process-mark article))
(ps-despool filename))
gnus-article-prepare-hook
gnus-article-decode-hook
gnus-break-pages
- gnus-show-mime)
+ gnus-show-mime
+ (gnus-inhibit-treatment t))
(gnus-summary-select-article nil 'force))))
(gnus-summary-goto-subject gnus-current-article)
(gnus-summary-position-point))
+(defun gnus-summary-show-raw-article ()
+ "Show the raw article without any article massaging functions being run."
+ (interactive)
+ (gnus-summary-show-article t))
+
(defun gnus-summary-verbose-headers (&optional arg)
"Toggle permanent full header display.
If ARG is a positive number, turn header display on.
(defun gnus-summary-show-all-headers ()
"Make all header lines visible."
(interactive)
- (gnus-article-show-all-headers))
+ (gnus-summary-toggle-header 1))
(defun gnus-summary-toggle-mime (&optional arg)
"Toggle MIME processing.
(gnus-summary-move-article n nil method)
(gnus-summary-copy-article n nil method)))
-(defun gnus-summary-import-article (file)
+(defun gnus-summary-import-article (file &optional edit)
"Import an arbitrary file into a mail newsgroup."
- (interactive "fImport file: ")
+ (interactive "fImport file: \nP")
(let ((group gnus-newsgroup-name)
(now (current-time))
- atts lines)
+ atts lines group-art)
(unless (gnus-check-backend-function 'request-accept-article group)
(error "%s does not support article importing" group))
(or (file-readable-p file)
(erase-buffer)
(nnheader-insert-file-contents file)
(goto-char (point-min))
- (unless (nnheader-article-p)
+ (if (nnheader-article-p)
+ (save-restriction
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (narrow-to-region (point-min) (1- (point)))
+ (goto-char (point-min))
+ (unless (re-search-forward "^date:" nil t)
+ (goto-char (point-max))
+ (insert "Date: " (message-make-date (nth 5 atts)) "\n")))
;; This doesn't look like an article, so we fudge some headers.
(setq atts (file-attributes file)
lines (count-lines (point-min) (point-max)))
(insert "From: " (read-string "From: ") "\n"
"Subject: " (read-string "Subject: ") "\n"
- "Date: " (message-make-date (nth 5 atts))
- "\n"
+ "Date: " (message-make-date (nth 5 atts)) "\n"
"Message-ID: " (message-make-message-id) "\n"
"Lines: " (int-to-string lines) "\n"
"Chars: " (int-to-string (nth 7 atts)) "\n\n"))
- (gnus-request-accept-article group nil t)
- (kill-buffer (current-buffer)))))
+ (setq group-art (gnus-request-accept-article group nil t))
+ (kill-buffer (current-buffer)))
+ (setq gnus-newsgroup-active (gnus-activate-group group))
+ (forward-line 1)
+ (gnus-summary-goto-article (cdr group-art) nil t)
+ (when edit
+ (gnus-summary-edit-article))))
+
+(defun gnus-summary-create-article ()
+ "Create an article in a mail newsgroup."
+ (interactive)
+ (let ((group gnus-newsgroup-name)
+ (now (current-time))
+ group-art)
+ (unless (gnus-check-backend-function 'request-accept-article group)
+ (error "%s does not support article importing" group))
+ (save-excursion
+ (set-buffer (gnus-get-buffer-create " *import file*"))
+ (erase-buffer)
+ (goto-char (point-min))
+ ;; This doesn't look like an article, so we fudge some headers.
+ (insert "From: " (read-string "From: ") "\n"
+ "Subject: " (read-string "Subject: ") "\n"
+ "Date: " (message-make-date now) "\n"
+ "Message-ID: " (message-make-message-id) "\n")
+ (setq group-art (gnus-request-accept-article group nil t))
+ (kill-buffer (current-buffer)))
+ (setq gnus-newsgroup-active (gnus-activate-group group))
+ (forward-line 1)
+ (gnus-summary-goto-article (cdr group-art) nil t)
+ (gnus-summary-edit-article)))
(defun gnus-summary-article-posted-p ()
"Say whether the current (mail) article is available from news as well.
(error "No such mark type: %s" type)
(setq var (intern (format "gnus-newsgroup-%s" type)))
(set var (cons article (symbol-value var)))
- (if (memq type '(processable cached replied saved))
+ (if (memq type '(processable cached replied forwarded saved))
(gnus-summary-update-secondary-mark article)
;;; !!! This is bobus. We should find out what primary
;;; !!! mark we want to set.
(gnus-summary-mark-forward n gnus-expirable-mark))
(defun gnus-summary-mark-article-as-replied (article)
- "Mark ARTICLE replied and update the summary line."
- (push article gnus-newsgroup-replied)
- (let ((buffer-read-only nil))
- (when (gnus-summary-goto-subject article nil t)
- (gnus-summary-update-secondary-mark article))))
+ "Mark ARTICLE as replied to and update the summary line.
+ARTICLE can also be a list of articles."
+ (interactive (list (gnus-summary-article-number)))
+ (let ((articles (if (listp article) article (list article))))
+ (dolist (article articles)
+ (push article gnus-newsgroup-replied)
+ (let ((buffer-read-only nil))
+ (when (gnus-summary-goto-subject article nil t)
+ (gnus-summary-update-secondary-mark article))))))
+
+(defun gnus-summary-mark-article-as-forwarded (article)
+ "Mark ARTICLE as forwarded and update the summary line.
+ARTICLE can also be a list of articles."
+ (let ((articles (if (listp article) article (list article))))
+ (dolist (article articles)
+ (push article gnus-newsgroup-forwarded)
+ (let ((buffer-read-only nil))
+ (when (gnus-summary-goto-subject article nil t)
+ (gnus-summary-update-secondary-mark article))))))
(defun gnus-summary-set-bookmark (article)
"Set a bookmark in current article."
gnus-cached-mark)
((memq article gnus-newsgroup-replied)
gnus-replied-mark)
+ ((memq article gnus-newsgroup-forwarded)
+ gnus-forwarded-mark)
((memq article gnus-newsgroup-saved)
gnus-saved-mark)
(t gnus-no-mark))
(let ((scored gnus-newsgroup-scored)
headers h)
(while scored
- (unless (gnus-number-to-header (caar scored))
- (and (setq h (gnus-summary-article-header (caar scored)))
+ (unless (gnus-summary-article-header (caar scored))
+ (and (setq h (gnus-number-to-header (caar scored)))
(< (cdar scored) gnus-summary-expunge-below)
(push h headers)))
(setq scored (cdr scored)))
(when (not no-error)
(error "No expunged articles hidden"))
(goto-char (point-min))
+ (push gnus-newsgroup-limit gnus-newsgroup-limits)
+ (setq gnus-newsgroup-limit (copy-sequence gnus-newsgroup-limit))
+ (mapcar (lambda (x) (push (mail-header-number x)
+ gnus-newsgroup-limit))
+ headers)
(gnus-summary-prepare-unthreaded (nreverse headers))
(goto-char (point-min))
(gnus-summary-position-point)
t))))
-(defun gnus-summary-catchup (&optional all quietly to-here not-mark)
+(defun gnus-summary-catchup (&optional all quietly to-here not-mark reverse)
"Mark all unread articles in this newsgroup as read.
If prefix argument ALL is non-nil, ticked and dormant articles will
also be marked as read.
If QUIETLY is non-nil, no questions will be asked.
If TO-HERE is non-nil, it should be a point in the buffer. All
-articles before this point will be marked as read.
+articles before (after, if REVERSE is set) this point will be marked as read.
Note that this function will only catch up the unread article
in the current summary buffer limitation.
The number of articles marked as read is returned."
;; We actually mark all articles as canceled, which we
;; have to do when using auto-expiry or adaptive scoring.
(gnus-summary-show-all-threads)
- (when (gnus-summary-first-subject (not all) t)
- (while (and
- (if to-here (< (point) to-here) t)
- (gnus-summary-mark-article-as-read gnus-catchup-mark)
- (gnus-summary-find-next (not all) nil nil t))))
+ (if (and to-here reverse)
+ (progn
+ (goto-char to-here)
+ (while (and
+ (gnus-summary-mark-article-as-read gnus-catchup-mark)
+ (gnus-summary-find-next (not all) nil nil t))))
+ (when (gnus-summary-first-subject (not all) t)
+ (while (and
+ (if to-here (< (point) to-here) t)
+ (gnus-summary-mark-article-as-read gnus-catchup-mark)
+ (gnus-summary-find-next (not all) nil nil t)))))
(gnus-set-mode-line 'summary))
t))
(gnus-summary-position-point)))
(gnus-summary-catchup all t beg)))))
(gnus-summary-position-point))
+(defun gnus-summary-catchup-from-here (&optional all)
+ "Mark all unticked articles after the current one as read.
+If ALL is non-nil, also mark ticked and dormant articles as read."
+ (interactive "P")
+ (save-excursion
+ (gnus-save-hidden-threads
+ (let ((beg (point)))
+ ;; We check that there are unread articles.
+ (when (or all (gnus-summary-find-next))
+ (gnus-summary-catchup all t beg nil t)))))
+ (gnus-summary-position-point))
+
(defun gnus-summary-catchup-all (&optional quietly)
"Mark all articles in this newsgroup as read."
(interactive "P")
(defun gnus-summary-catchup-and-exit (&optional all quietly)
"Mark all unread articles in this group as read, then exit.
-If prefix argument ALL is non-nil, all articles are marked as read."
+If prefix argument ALL is non-nil, all articles are marked as read.
+If QUIETLY is non-nil, no questions will be asked."
(interactive "P")
(when (gnus-summary-catchup all quietly nil 'fast)
;; Select next newsgroup or exit.
(defun gnus-summary-up-thread (n)
"Go up thread N steps.
-If N is negative, go up instead.
+If N is negative, go down instead.
Returns the difference between N and how many steps down that were
taken."
(interactive "p")
(interactive "P")
(gnus-summary-sort 'chars reverse))
+(defun gnus-summary-sort-by-original (&optional reverse)
+ "Sort the summary buffer using the default sorting method.
+Argument REVERSE means reverse order."
+ (interactive "P")
+ (let* ((buffer-read-only)
+ (gnus-summary-prepare-hook nil))
+ ;; We do the sorting by regenerating the threads.
+ (gnus-summary-prepare)
+ ;; Hide subthreads if needed.
+ (when (and gnus-show-threads gnus-thread-hide-subtree)
+ (gnus-summary-hide-all-threads))))
+
(defun gnus-summary-sort (predicate reverse)
"Sort summary buffer by PREDICATE. REVERSE means reverse order."
(let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate)))
(require 'gnus-art)
(let ((gnus-default-article-saver 'gnus-summary-save-in-pipe))
(gnus-summary-save-article arg t))
- (gnus-configure-windows 'pipe))
+ (let ((buffer (get-buffer "*Shell Command Output*")))
+ (if (and buffer
+ (with-current-buffer buffer (> (point-max) (point-min))))
+ (gnus-configure-windows 'pipe))))
(defun gnus-summary-save-article-mail (&optional arg)
"Append the current article to an mail file.
(mark (or (gnus-summary-article-mark) gnus-unread-mark))
(inhibit-read-only t))
;; Eval the cars of the lists until we find a match.
- (let ((default gnus-summary-default-score))
+ (let ((default gnus-summary-default-score)
+ (default-high gnus-summary-default-high-score)
+ (default-low gnus-summary-default-low-score))
(while (and list
(not (eval (caar list))))
(setq list (cdr list))))
(defun gnus-offer-save-summaries ()
"Offer to save all active summary buffers."
- (save-excursion
- (let ((buflist (buffer-list))
- buffers bufname)
- ;; Go through all buffers and find all summaries.
- (while buflist
- (and (setq bufname (buffer-name (car buflist)))
- (string-match "Summary" bufname)
- (save-excursion
- (set-buffer bufname)
- ;; We check that this is, indeed, a summary buffer.
- (and (eq major-mode 'gnus-summary-mode)
- ;; Also make sure this isn't bogus.
- gnus-newsgroup-prepared
- ;; Also make sure that this isn't a dead summary buffer.
- (not gnus-dead-summary-mode)))
- (push bufname buffers))
- (setq buflist (cdr buflist)))
- ;; Go through all these summary buffers and offer to save them.
- (when buffers
+ (let (buffers)
+ ;; Go through all buffers and find all summaries.
+ (dolist (buffer (buffer-list))
+ (when (and (setq buffer (buffer-name buffer))
+ (string-match "Summary" buffer)
+ (save-excursion
+ (set-buffer buffer)
+ ;; We check that this is, indeed, a summary buffer.
+ (and (eq major-mode 'gnus-summary-mode)
+ ;; Also make sure this isn't bogus.
+ gnus-newsgroup-prepared
+ ;; Also make sure that this isn't a
+ ;; dead summary buffer.
+ (not gnus-dead-summary-mode))))
+ (push buffer buffers)))
+ ;; Go through all these summary buffers and offer to save them.
+ (when buffers
+ (save-excursion
(map-y-or-n-p
"Update summary buffer %s? "
(lambda (buf)
(gnus-set-mode-line 'summary)
n))
+(defun gnus-summary-insert-articles (articles)
+ (when (setq articles
+ (gnus-set-difference articles
+ (mapcar (lambda (h) (mail-header-number h))
+ gnus-newsgroup-headers)))
+ (setq gnus-newsgroup-headers
+ (merge 'list
+ gnus-newsgroup-headers
+ (gnus-fetch-headers articles)
+ 'gnus-article-sort-by-number))
+ ;; Suppress duplicates?
+ (when gnus-suppress-duplicates
+ (gnus-dup-suppress-articles))
+
+ ;; We might want to build some more threads first.
+ (when (and gnus-fetch-old-headers
+ (eq gnus-headers-retrieved-by 'nov))
+ (if (eq gnus-fetch-old-headers 'invisible)
+ (gnus-build-all-threads)
+ (gnus-build-old-threads)))
+ ;; Let the Gnus agent mark articles as read.
+ (when gnus-agent
+ (gnus-agent-get-undownloaded-list))
+ ;; Remove list identifiers from subject
+ (when gnus-list-identifiers
+ (gnus-summary-remove-list-identifiers))
+ ;; First and last article in this newsgroup.
+ (when gnus-newsgroup-headers
+ (setq gnus-newsgroup-begin
+ (mail-header-number (car gnus-newsgroup-headers))
+ gnus-newsgroup-end
+ (mail-header-number
+ (gnus-last-element gnus-newsgroup-headers))))
+ (when gnus-use-scoring
+ (gnus-possibly-score-headers))))
+
+(defun gnus-summary-insert-old-articles (&optional all)
+ "Insert all old articles in this group.
+If ALL is non-nil, already read articles become readable.
+If ALL is a number, fetch this number of articles."
+ (interactive "P")
+ (prog1
+ (let ((old (mapcar 'car gnus-newsgroup-data))
+ (i (car gnus-newsgroup-active))
+ older len)
+ (while (<= i (cdr gnus-newsgroup-active))
+ (or (memq i old) (push i older))
+ (incf i))
+ (setq len (length older))
+ (cond
+ ((null older) nil)
+ ((numberp all)
+ (if (< all len)
+ (setq older (subseq older 0 all))))
+ (all nil)
+ (t
+ (if (and (numberp gnus-large-newsgroup)
+ (> len gnus-large-newsgroup))
+ (let ((input
+ (read-string
+ (format
+ "How many articles from %s (default %d): "
+ (gnus-limit-string
+ (gnus-group-decoded-name gnus-newsgroup-name) 35)
+ len))))
+ (unless (string-match "^[ \t]*$" input)
+ (setq all (string-to-number input))
+ (if (< all len)
+ (setq older (subseq older 0 all))))))))
+ (if (not older)
+ (message "No old news.")
+ (gnus-summary-insert-articles older)
+ (gnus-summary-limit (gnus-union older old))))
+ (gnus-summary-position-point)))
+
+(defun gnus-summary-insert-new-articles ()
+ "Insert all new articles in this group."
+ (interactive)
+ (prog1
+ (let ((old (mapcar 'car gnus-newsgroup-data))
+ (old-active gnus-newsgroup-active)
+ (nnmail-fetched-sources (list t))
+ i new)
+ (setq gnus-newsgroup-active
+ (gnus-activate-group gnus-newsgroup-name 'scan))
+ (setq i (1+ (cdr old-active)))
+ (while (<= i (cdr gnus-newsgroup-active))
+ (push i new)
+ (incf i))
+ (if (not new)
+ (message "No gnus is bad news.")
+ (setq new (nreverse new))
+ (gnus-summary-insert-articles new)
+ (setq gnus-newsgroup-unreads
+ (append gnus-newsgroup-unreads new))
+ (gnus-summary-limit (gnus-union old new))))
+ (gnus-summary-position-point)))
+
(gnus-summary-make-all-marking-commands)
(gnus-ems-redefine)
projects / elisp / gnus.git- / blobdiff