(const more)
(sexp :menu-tag "all" t)))
-(defcustom gnus-summary-thread-gathering-function 'gnus-gather-threads-by-subject
+(defcustom gnus-summary-thread-gathering-function
+ 'gnus-gather-threads-by-subject
"Function used for gathering loose threads.
There are two pre-defined functions: `gnus-gather-threads-by-subject',
which only takes Subjects into consideration; and
:group 'gnus-article-headers
:type 'boolean)
+(defcustom gnus-summary-ignore-duplicates nil
+ "*If non-nil, ignore articles with identical Message-ID headers."
+ :group 'gnus-summary
+ :type 'boolean)
+
(defcustom gnus-single-article-buffer t
"*If non-nil, display all articles in the same buffer.
If nil, each group will get its own article buffer."
;;; Internal variables
(defvar gnus-scores-exclude-files nil)
-
-(defvar gnus-summary-display-table
- ;; Change the display table. Odd characters have a tendency to mess
- ;; up nicely formatted displays - we make all possible glyphs
- ;; display only a single character.
-
- ;; We start from the standard display table, if any.
- (let ((table (or (copy-sequence standard-display-table)
- (make-display-table)))
- ;; Nix out all the control chars...
- (i 32))
- (while (>= (setq i (1- i)) 0)
- (aset table i [??]))
- ;; ... but not newline and cr, of course. (cr is necessary for the
- ;; selective display).
- (aset table ?\n nil)
- (aset table ?\r nil)
- ;; We nix out any glyphs over 126 that are not set already.
- (let ((i 256))
- (while (>= (setq i (1- i)) 127)
- ;; Only modify if the entry is nil.
- (or (aref table i)
- (aset table i [??]))))
- table)
- "Display table used in summary mode buffers.")
+(defvar gnus-page-broken nil)
(defvar gnus-original-article nil)
(defvar gnus-article-internal-prepare-hook nil)
"t" gnus-article-remove-trailing-blank-lines
"l" gnus-article-strip-leading-blank-lines
"m" gnus-article-strip-multiple-blank-lines
- "a" gnus-article-strip-blank-lines)
+ "a" gnus-article-strip-blank-lines
+ "s" gnus-article-strip-leading-space)
(gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map)
"v" gnus-version
["Leading" gnus-article-strip-leading-blank-lines t]
["Multiple" gnus-article-strip-multiple-blank-lines t]
["Trailing" gnus-article-remove-trailing-blank-lines t]
- ["All of the above" gnus-article-strip-blank-lines t])
+ ["All of the above" gnus-article-strip-blank-lines t]
+ ["Leading space" gnus-article-strip-leading-space t])
["Overstrike" gnus-article-treat-overstrike t]
["Emphasis" gnus-article-emphasize t]
["Word wrap" gnus-article-fill-cited-article t]
(setq truncate-lines t)
(setq selective-display t)
(setq selective-display-ellipses t) ;Display `...'
- (setq buffer-display-table gnus-summary-display-table)
+ (gnus-summary-set-display-table)
(gnus-set-default-directory)
(setq gnus-newsgroup-name group)
(make-local-variable 'gnus-summary-line-format)
(make-local-variable 'gnus-summary-line-format-spec)
(make-local-variable 'gnus-summary-mark-positions)
(make-local-hook 'post-command-hook)
- (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
+ (add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
(run-hooks 'gnus-summary-mode-hook)
(gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy)
(gnus-update-summary-mark-positions))
(mouse-set-point e)
(gnus-summary-next-page nil t))
+(defun gnus-summary-set-display-table ()
+ ;; Change the display table. Odd characters have a tendency to mess
+ ;; up nicely formatted displays - we make all possible glyphs
+ ;; display only a single character.
+
+ ;; We start from the standard display table, if any.
+ (let ((table (or (copy-sequence standard-display-table)
+ (make-display-table)))
+ (i 32))
+ ;; Nix out all the control chars...
+ (while (>= (setq i (1- i)) 0)
+ (aset table i [??]))
+ ;; ... but not newline and cr, of course. (cr is necessary for the
+ ;; selective display).
+ (aset table ?\n nil)
+ (aset table ?\r nil)
+ ;; We nix out any glyphs over 126 that are not set already.
+ (let ((i 256))
+ (while (>= (setq i (1- i)) 127)
+ ;; Only modify if the entry is nil.
+ (unless (aref table i)
+ (aset table i [??]))))
+ (setq buffer-display-table table)))
+
(defun gnus-summary-setup-buffer (group)
"Initialize summary buffer."
(let ((buffer (concat "*Summary " group "*")))
If SHOW-ALL is non-nil, already read articles are also listed.
If NO-ARTICLE is non-nil, no article is selected initially.
If NO-DISPLAY, don't generate a summary buffer."
+ (let (result)
+ (while (and group
+ (null (setq result
+ (let ((gnus-auto-select-next nil))
+ (gnus-summary-read-group-1
+ group show-all no-article
+ kill-buffer no-display))))
+ (eq gnus-auto-select-next 'quietly))
+ (set-buffer gnus-group-buffer)
+ (if (not (equal group (gnus-group-group-name)))
+ (setq group (gnus-group-group-name))
+ (setq group nil)))
+ result))
+
+(defun gnus-summary-read-group-1 (group show-all no-article
+ kill-buffer no-display)
;; Killed foreign groups can't be entered.
(when (and (not (gnus-group-native-p group))
(not (gnus-gethash group gnus-newsrc-hashtb)))
(not no-display))
(progn
;; This newsgroup is empty.
- (gnus-summary-catchup-and-exit nil t) ;Without confirmations.
+ (gnus-summary-catchup-and-exit nil t)
(gnus-message 6 "No unread news")
(when kill-buffer
(gnus-kill-or-deaden-summary kill-buffer))
(select-window (get-buffer-window gnus-group-buffer t))
(when (gnus-group-goto-group group)
(recenter))
- (select-window owin))))
- ;; Mark this buffer as "prepared".
- (setq gnus-newsgroup-prepared t)
- t))))
+ (select-window owin)))
+ ;; Mark this buffer as "prepared".
+ (setq gnus-newsgroup-prepared t)
+ t)))))
(defun gnus-summary-prepare ()
"Generate the summary buffer."
(defun gnus-thread-loop-p (root thread)
"Say whether ROOT is in THREAD."
- (let ((th (cdr thread)))
- (while (and th
- (not (eq (caar th) root)))
- (pop th))
- (if th
- ;; We have found a loop.
- (let (ref-dep)
- (setcdr thread (delq (car th) (cdr thread)))
- (if (boundp (setq ref-dep (intern "none"
- gnus-newsgroup-dependencies)))
- (setcdr (symbol-value ref-dep)
- (nconc (cdr (symbol-value ref-dep))
- (list (car th))))
- (set ref-dep (list nil (car th))))
- 1)
- ;; Recurse down into the sub-threads and look for loops.
- (apply '+
- (mapcar
- (lambda (thread) (gnus-thread-loop-p root thread))
- (cdr thread))))))
+ (let ((stack (list thread))
+ (infloop 0)
+ th)
+ (while (setq thread (pop stack))
+ (setq th (cdr thread))
+ (while (and th
+ (not (eq (caar th) root)))
+ (pop th))
+ (if th
+ ;; We have found a loop.
+ (let (ref-dep)
+ (setcdr thread (delq (car th) (cdr thread)))
+ (if (boundp (setq ref-dep (intern "none"
+ gnus-newsgroup-dependencies)))
+ (setcdr (symbol-value ref-dep)
+ (nconc (cdr (symbol-value ref-dep))
+ (list (car th))))
+ (set ref-dep (list nil (car th))))
+ (setq infloop 1
+ stack nil))
+ ;; Push all the subthreads onto the stack.
+ (push (cdr thread) stack)))
+ infloop))
(defun gnus-make-threads ()
"Go through the dependency hashtb and find the roots. Return all threads."
(prog1
(save-excursion
(set-buffer nntp-server-buffer)
- (goto-char (point-min))
- (while (and (not found) (search-forward id nil t))
- (beginning-of-line)
- (setq found (looking-at
- (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s"
- (regexp-quote id))))
- (or found (beginning-of-line 2)))
- (when found
- (beginning-of-line)
- (and
- (setq header (gnus-nov-parse-line
- (read (current-buffer)) deps))
- (gnus-parent-id (mail-header-references header)))))
+ (let ((case-fold-search nil))
+ (goto-char (point-min))
+ (while (and (not found)
+ (search-forward id nil t))
+ (beginning-of-line)
+ (setq found (looking-at
+ (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s"
+ (regexp-quote id))))
+ (or found (beginning-of-line 2)))
+ (when found
+ (beginning-of-line)
+ (and
+ (setq header (gnus-nov-parse-line
+ (read (current-buffer)) deps))
+ (gnus-parent-id (mail-header-references header))))))
(when header
(let ((number (mail-header-number header)))
(push number gnus-newsgroup-limit)
(memq article gnus-newsgroup-expirable)
;; Only insert the Subject string when it's different
;; from the previous Subject string.
- (unless (gnus-subject-equal
- (condition-case ()
- (mail-header-subject
- (gnus-data-header
- (cadr
- (gnus-data-find-list
- article
- (gnus-data-list t)))))
- (error ""))
- (mail-header-subject header))
+ (if (gnus-subject-equal
+ (condition-case ()
+ (mail-header-subject
+ (gnus-data-header
+ (cadr
+ (gnus-data-find-list
+ article
+ (gnus-data-list t)))))
+ ;; Error on the side of excessive subjects.
+ (error ""))
+ (mail-header-subject header))
+ ""
(mail-header-subject header))
nil (cdr (assq article gnus-newsgroup-scored))
(memq article gnus-newsgroup-processable))
(let ((extract (funcall
gnus-extract-address-components
(mail-header-from h1))))
- (or (car extract) (cdr extract)))
+ (or (car extract) (cadr extract) ""))
(let ((extract (funcall
gnus-extract-address-components
(mail-header-from h2))))
- (or (car extract) (cdr extract)))))
+ (or (car extract) (cadr extract) ""))))
(defun gnus-thread-sort-by-author (h1 h2)
"Sort threads by root author."
"Select newsgroup GROUP.
If READ-ALL is non-nil, all articles in the group are selected."
(let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
+ ;;!!! Dirty hack; should be removed.
+ (gnus-summary-ignore-duplicates
+ (if (eq (car (gnus-find-method-for-group group)) 'nnvirtual)
+ t
+ gnus-summary-ignore-duplicates))
(info (nth 2 entry))
articles fetched-articles cached)
;; All articles have to be subsets of the active articles.
(cond
;; Adjust "simple" lists.
- ((memq mark '(tick dormant expirable reply save))
+ ((memq mark '(tick dormant expire reply save))
(while articles
(when (or (< (setq article (pop articles)) min) (> article max))
(set var (delq article (symbol-value var))))))
type list newmarked symbol)
(when info
;; Add all marks lists that are non-nil to the list of marks lists.
- (while types
- (setq type (pop types))
+ (while (setq type (pop types))
(when (setq list (symbol-value
(setq symbol
(intern (format "gnus-newsgroup-%s"
(car type))))))
+
+ ;; Get rid of the entries of the articles that have the
+ ;; default score.
+ (when (and (eq (cdr type) 'score)
+ gnus-save-score
+ list)
+ (let* ((arts list)
+ (prev (cons nil list))
+ (all prev))
+ (while arts
+ (if (or (not (consp (car arts)))
+ (= (cdar arts) gnus-summary-default-score))
+ (setcdr prev (cdr arts))
+ (setq prev arts))
+ (setq arts (cdr arts)))
+ (setq list (cdr all))))
+
(push (cons (cdr type)
(if (memq (cdr type) uncompressed) list
(gnus-compress-sequence
xref-hashtb)))))
(defun gnus-group-make-articles-read (group articles)
- "Update the info of GROUP to say that only ARTICLES are unread."
+ "Update the info of GROUP to say that ARTICLES are read."
(let* ((num 0)
(entry (gnus-gethash group gnus-newsrc-hashtb))
(info (nth 2 entry))
;; Message-ID.
(progn
(goto-char p)
- (setq id (if (search-forward "\nmessage-id: " nil t)
- (nnheader-header-value)
+ (setq id (if (search-forward "\nmessage-id:" nil t)
+ (buffer-substring
+ (1- (or (search-forward "<" nil t) (point)))
+ (or (search-forward ">" nil t) (point)))
;; If there was no message-id, we just fake one
;; to make subsequent routines simpler.
(nnheader-generate-fake-message-id))))
(progn
(goto-char p)
(if (search-forward "\nlines: " nil t)
- (if (numberp (setq lines (read cur)))
+ (if (numberp (setq lines (ignore-errors (read cur))))
lines 0)
0))
;; Xref.
(if (boundp (setq id-dep (intern id dependencies)))
(if (and (car (symbol-value id-dep))
(not force-new))
- ;; An article with this Message-ID has already been seen,
- ;; so we rename the Message-ID.
- (progn
+ ;; An article with this Message-ID has already been seen.
+ (if gnus-summary-ignore-duplicates
+ ;; We ignore this one, except we add
+ ;; any additional Xrefs (in case the two articles
+ ;; came from different servers).
+ (progn
+ (mail-header-set-xref
+ (car (symbol-value id-dep))
+ (concat (or (mail-header-xref
+ (car (symbol-value id-dep)))
+ "")
+ (or (mail-header-xref header) "")))
+ (setq header nil))
+ ;; We rename the Message-ID.
(set
(setq id-dep (intern (setq id (nnmail-message-id))
dependencies))
(if (boundp (setq id-dep (intern id dependencies)))
(if (and (car (symbol-value id-dep))
(not force-new))
- ;; An article with this Message-ID has already been seen,
- ;; so we rename the Message-ID.
- (progn
+ ;; An article with this Message-ID has already been seen.
+ (if gnus-summary-ignore-duplicates
+ ;; We ignore this one, except we add any additional
+ ;; Xrefs (in case the two articles came from different
+ ;; servers.
+ (progn
+ (mail-header-set-xref
+ (car (symbol-value id-dep))
+ (concat (or (mail-header-xref
+ (car (symbol-value id-dep)))
+ "")
+ (or (mail-header-xref header) "")))
+ (setq header nil))
+ ;; We rename the Message-ID.
(set
(setq id-dep (intern (setq id (nnmail-message-id))
dependencies))
(run-hooks 'gnus-exit-group-hook)
(gnus-summary-update-info))
(gnus-close-group group)
- ;; Make sure where I was, and go to next newsgroup.
+ ;; Make sure where we were, and go to next newsgroup.
(set-buffer gnus-group-buffer)
(unless quit-config
(gnus-group-jump-to-group group))
(progn
(gnus-message 5 "Returning to the group buffer")
(setq entered t)
- (set-buffer current-buffer)
- (gnus-summary-exit)
+ (when (gnus-buffer-live-p current-buffer)
+ (set-buffer current-buffer)
+ (gnus-summary-exit))
(run-hooks 'gnus-group-no-more-groups-hook))
;; We try to enter the target group.
(gnus-group-jump-to-group target-group)
gnus-killed-mark gnus-kill-file-mark
gnus-low-score-mark gnus-expirable-mark
gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark
- gnus-duplicate-mark)
+ gnus-duplicate-mark gnus-souped-mark)
'reverse)))
(defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-exclude-marks)
(gnus-summary-position-point)
n)))
-(defun gnus-summary-refer-article (message-id)
- "Fetch an article specified by MESSAGE-ID."
- (interactive "sMessage-ID: ")
+(defun gnus-summary-refer-article (message-id &optional arg)
+ "Fetch an article specified by MESSAGE-ID.
+If ARG (the prefix), fetch the article using `gnus-refer-article-method'
+or `gnus-select-method', no matter what backend the article comes from."
+ (interactive "sMessage-ID: \nP")
(when (and (stringp message-id)
(not (zerop (length message-id))))
;; Construct the correct Message-ID if necessary.
(mail-header-number header)))))
(if header
(prog1
- ;; The article is present in the buffer, to we just go to it.
+ ;; The article is present in the buffer, so we just go to it.
(gnus-summary-goto-article
- (mail-header-number header) nil header)
+ (mail-header-number header) nil t)
(when sparse
(gnus-summary-update-article (mail-header-number header))))
;; We fetch the article
(let ((gnus-override-method
- (and (gnus-news-group-p gnus-newsgroup-name)
- gnus-refer-article-method))
+ (cond ((gnus-news-group-p gnus-newsgroup-name)
+ gnus-refer-article-method)
+ (arg
+ (or gnus-refer-article-method gnus-select-method))
+ (t nil)))
number)
;; Start the special refer-article method, if necessary.
(when (and gnus-refer-article-method
gnus-current-article)))
(ogroup gnus-newsgroup-name)
(params (append (gnus-info-params (gnus-get-info ogroup))
- (list (cons 'to-group ogroup))))
+ (list (cons 'to-group ogroup))
+ (list (cons 'save-article-group ogroup))))
(case-fold-search t)
(buf (current-buffer))
dig)
(gnus-eval-in-buffer-window gnus-article-buffer
(widen)
(goto-char (point-min))
- (when gnus-break-pages
+ (when gnus-page-broken
(gnus-narrow-to-page))))
(defun gnus-summary-end-of-article ()
(widen)
(goto-char (point-max))
(recenter -3)
- (when gnus-break-pages
+ (when gnus-page-broken
(gnus-narrow-to-page))))
(defun gnus-summary-print-article (&optional filename)
gnus-article-display-hook
gnus-article-prepare-hook
gnus-break-pages
+ gnus-show-mime
gnus-visual)
(gnus-summary-select-article nil 'force)))
(gnus-summary-goto-subject gnus-current-article)
- ; (gnus-configure-windows 'article)
(gnus-summary-position-point))
(defun gnus-summary-verbose-headers (&optional arg)
(set-buffer copy-buf)
;; First put the article in the destination group.
(gnus-request-article-this-buffer article gnus-newsgroup-name)
- (setq art-group
- (gnus-request-accept-article
- to-newsgroup select-method (not articles)))
- (setq new-xref (concat new-xref " " (car art-group)
- ":" (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-request-replace-article
- (cdr art-group) to-newsgroup (current-buffer))
- art-group)))))
- (if (not art-group)
- (gnus-message 1 "Couldn't %s article %s"
- (cadr (assq action names)) article)
+ (when (consp (setq art-group
+ (gnus-request-accept-article
+ to-newsgroup select-method (not articles))))
+ (setq new-xref (concat new-xref " " (car art-group)
+ ":" (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-request-replace-article
+ (cdr art-group) to-newsgroup (current-buffer))
+ art-group))))))
+ (cond
+ ((not art-group)
+ (gnus-message 1 "Couldn't %s article %s"
+ (cadr (assq action names)) article))
+ ((and (eq art-group 'junk)
+ (eq action 'move))
+ (gnus-summary-mark-article article gnus-canceled-mark)
+ (gnus-message 4 "Deleted article %s" article))
+ (t
(let* ((entry
(or
(gnus-gethash (car art-group) gnus-newsrc-hashtb)
;; Copy the marks to other group.
(gnus-add-marked-articles
to-group (cdar marks) (list to-article) info))
- (setq marks (cdr marks)))))
+ (setq marks (cdr marks)))
+
+ (gnus-dribble-enter
+ (concat "(gnus-group-set-info '"
+ (gnus-prin1-to-string (gnus-get-info to-group))
+ ")"))))
;; Update the Xref header in this article to point to
;; the new crossposted article we have just created.
(gnus-summary-goto-subject article)
(when (eq action 'move)
- (gnus-summary-mark-article article gnus-canceled-mark)))
+ (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
- (gnus-activate-group (pop 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))
+ (pop to-groups)))
(gnus-kill-buffer copy-buf)
(gnus-summary-position-point)
;;; Respooling
-(defun gnus-summary-respool-query ()
+(defun gnus-summary-respool-query (&optional silent)
"Query where the respool algorithm would put this article."
(interactive)
(gnus-set-global-variables)
(set-buffer gnus-original-article-buffer)
(save-restriction
(message-narrow-to-head)
- (message "This message would go to %s"
- (mapconcat 'car (nnmail-article-group 'identity) ", "))))))
+ (let ((groups (nnmail-article-group 'identity)))
+ (unless silent
+ (if groups
+ (message "This message would go to %s"
+ (mapconcat 'car groups ", "))
+ (message "This message would go to no groups"))
+ groups))))))
;; Summary marking commands.
(gnus-article-setup-buffer)
(set-buffer gnus-article-buffer)
(setq buffer-read-only nil)
- (let ((command (if automatic command (read-string "Command: " command)))
- ;; Just binding this here doesn't help, because there might
- ;; be output from the process after exiting the scope of
- ;; this `let'.
- ;; (buffer-read-only nil)
- )
+ (let ((command (if automatic command (read-string "Command: " command))))
(erase-buffer)
(insert "$ " command "\n\n")
(if gnus-view-pseudo-asynchronously
- (start-process "gnus-execute" nil shell-file-name
+ (start-process "gnus-execute" (current-buffer) shell-file-name
shell-command-switch command)
(call-process shell-file-name nil t nil
shell-command-switch command)))))
(push (cons prev (cdr active)) read))
(save-excursion
(set-buffer gnus-group-buffer)
+ (gnus-undo-boundary)
(gnus-undo-register
`(progn
(gnus-info-set-marks ',info ',(gnus-info-marks info) t)
(lambda (buf) (switch-to-buffer buf) (gnus-summary-exit))
buffers)))))
+(gnus-ems-redefine)
+
(provide 'gnus-sum)
(run-hooks 'gnus-sum-load-hook)
projects / gnus / blobdiff