;;; gnus-sum.el --- summary mode commands for Gnus
-;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
This applies to marking commands as well as other commands that
\"naturally\" select the next article, like, for instance, `SPC' at
the end of an article.
-If nil, only the marking commands will go to the next (un)read article.
-If `never', commands that usually go to the next unread article, will
-go to the next article, whether it is read or not."
+
+If nil, the marking commands do NOT go to the next unread article
+(they go to the next article instead). If `never', commands that
+usually go to the next unread article, will go to the next article,
+whether it is read or not."
:group 'gnus-summary-marks
:link '(custom-manual "(gnus)Setting Marks")
:type '(choice (const :tag "off" nil)
:type 'boolean
:group 'gnus-summary-marks)
+(defcustom gnus-alter-articles-to-read-function nil
+ "Function to be called to alter the list of articles to be selected."
+ :type 'function
+ :group 'gnus-summary)
+
+(defcustom gnus-orphan-score nil
+ "*All orphans get this score added. Set in the score file."
+ :group 'gnus-score-default
+ :type '(choice (const nil)
+ integer))
+
;;; Internal variables
(defvar gnus-article-mime-handles nil)
gnus-score-alist gnus-current-score-file
(gnus-summary-expunge-below . global)
(gnus-summary-mark-below . global)
+ (gnus-orphan-score . global)
gnus-newsgroup-active gnus-scores-exclude-files
gnus-newsgroup-history gnus-newsgroup-ancient
gnus-newsgroup-sparse gnus-newsgroup-process-stack
"\M-\C-h" gnus-summary-hide-thread
"\M-\C-f" gnus-summary-next-thread
"\M-\C-b" gnus-summary-prev-thread
+ [(meta down)] gnus-summary-next-thread
+ [(meta up)] gnus-summary-prev-thread
"\M-\C-u" gnus-summary-up-thread
"\M-\C-d" gnus-summary-down-thread
"&" gnus-summary-execute-command
"C" gnus-article-capitalize-sentences
"c" gnus-article-remove-cr
"q" gnus-article-de-quoted-unreadable
+ "6" gnus-article-de-base64-unreadable
+ "Z" gnus-article-decode-HZ
+ "h" gnus-article-wash-html
"f" gnus-article-display-x-face
"l" gnus-summary-stop-page-breaking
"r" gnus-summary-caesar-message
["Words" gnus-article-decode-mime-words t]
["Charset" gnus-article-decode-charset t]
["QP" gnus-article-de-quoted-unreadable t]
+ ["Base64" gnus-article-de-base64-unreadable t]
["View all" gnus-mime-view-all-parts t])
("Date"
["Local" gnus-article-date-local t]
["CR" gnus-article-remove-cr t]
["Show X-Face" gnus-article-display-x-face t]
["Quoted-Printable" gnus-article-de-quoted-unreadable t]
+ ["Base64" gnus-article-de-base64-unreadable t]
["Rot 13" gnus-summary-caesar-message t]
["Unix pipe" gnus-summary-pipe-message t]
["Add buttons" gnus-article-add-buttons t]
["Stop page breaking" gnus-summary-stop-page-breaking t]
["Verbose header" gnus-summary-verbose-headers t]
["Toggle header" gnus-summary-toggle-header t]
+ ["Html" gnus-article-wash-html t]
["HZ" gnus-article-decode-HZ t])
("Output"
["Save in default format" gnus-summary-save-article t]
(memq article gnus-newsgroup-expirable)
;; Only insert the Subject string when it's different
;; from the previous Subject string.
- (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))
+ (if (and
+ gnus-show-threads
+ (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))
(while thread
(gnus-remove-thread-1 (car thread))
(setq thread (cdr thread))))
- (gnus-summary-show-all-threads)
(gnus-remove-thread-1 thread))))))))
(defun gnus-remove-thread-1 (thread)
(gnus-remove-thread-1 (pop thread)))
(when (setq d (gnus-data-find number))
(goto-char (gnus-data-pos d))
+ (gnus-summary-show-thread)
(gnus-data-remove
number
(- (gnus-point-at-bol)
gnus-list-identifiers
(mapconcat 'identity gnus-list-identifiers " *\\|"))))
(dolist (header gnus-newsgroup-headers)
- (when (string-match (concat "\\(Re: +\\)?\\(" regexp " *\\)")
+ (when (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp
+ " *\\)\\)+\\(Re: +\\)?\\)")
(mail-header-subject header))
(mail-header-set-subject
header (concat (substring (mail-header-subject header)
- 0 (match-beginning 2))
+ 0 (match-beginning 1))
+ (or
+ (match-string 3 (mail-header-subject header))
+ (match-string 5 (mail-header-subject header)))
(substring (mail-header-subject header)
- (match-end 2))))))))
+ (match-end 1))))))))
(defun gnus-select-newsgroup (group &optional read-all select-articles)
"Select newsgroup GROUP.
(gnus-sorted-intersection
gnus-newsgroup-unreads
(gnus-sorted-complement gnus-newsgroup-unreads articles)))
+ (when gnus-alter-articles-to-read-function
+ (setq gnus-newsgroup-unreads
+ (sort
+ (funcall gnus-alter-articles-to-read-function
+ gnus-newsgroup-name gnus-newsgroup-unreads)
+ '<)))
articles)))
(defun gnus-killed-articles (killed articles)
(let* ((mformat (symbol-value
(intern
(format "gnus-%s-mode-line-format-spec" where))))
- (gnus-tmp-group-name gnus-newsgroup-name)
+ (gnus-tmp-group-name (gnus-group-name-decode
+ gnus-newsgroup-name
+ (gnus-group-name-charset
+ nil
+ 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))
"Center point in window and redisplay frame.
Also do horizontal recentering."
(interactive "P")
- (when (and gnus-auto-center-summary
+ (when (and nil
+ gnus-auto-center-summary
(not (eq gnus-auto-center-summary 'vertical)))
(gnus-horizontal-recenter))
(recenter n))
displayed, no centering will be performed."
;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu.
+ (interactive)
(let* ((top (cond ((< (window-height) 4) 0)
((< (window-height) 7) 1)
(t (if (numberp gnus-auto-center-summary)
(rename-buffer
(concat (substring name 0 (match-beginning 0)) "Dead "
(substring name (match-beginning 0)))
- t))))
+ t)
+ (bury-buffer))))
(defun gnus-kill-or-deaden-summary (buffer)
"Kill or deaden the summary BUFFER."
force)
;; The requested article is different from the current article.
(progn
+ (when (gnus-buffer-live-p gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
+ (mm-enable-multibyte)))
(gnus-summary-display-article article all-headers)
+ (when (gnus-buffer-live-p gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
+ (if (not gnus-article-decoded-p) ;; a local variable
+ (mm-disable-multibyte))))
(when (or all-headers gnus-show-all-headers)
(gnus-article-show-all-headers))
(gnus-article-set-window-start
(if hidden
(let ((gnus-treat-hide-headers nil)
(gnus-treat-hide-boring-headers nil))
+ (setq gnus-article-wash-types
+ (delq 'headers gnus-article-wash-types))
(gnus-treat-article 'head))
- (gnus-treat-article 'head)))))))
+ (gnus-treat-article 'head)))
+ (gnus-set-mode-line 'article)))))
(defun gnus-summary-show-all-headers ()
"Make all header lines visible."
articles prefix))
(set (intern (format "gnus-current-%s-group" action)) to-newsgroup))
(setq to-method (or select-method
- (gnus-group-name-to-method to-newsgroup)))
+ (gnus-server-to-method
+ (gnus-group-method to-newsgroup))))
;; Check the method we are to move this article to...
(unless (gnus-check-backend-function
'request-accept-article (car to-method))
(gnus-message 1 "Couldn't %s article %s: %s"
(cadr (assq action names)) article
(nnheader-get-report (car to-method))))
- ((and (eq art-group 'junk)
- (eq action 'move))
- (gnus-summary-mark-article article gnus-canceled-mark)
- (gnus-message 4 "Deleted article %s" article))
+ ((eq art-group 'junk)
+ (when (eq action 'move)
+ (gnus-summary-mark-article article gnus-canceled-mark)
+ (gnus-message 4 "Deleted article %s" article)))
(t
(let* ((pto-group (gnus-group-prefixed-name
(car art-group) to-method))
(save-excursion
(set-buffer (gnus-get-buffer-create " *import file*"))
(erase-buffer)
- (insert-file-contents file)
+ (nnheader-insert-file-contents file)
(goto-char (point-min))
(unless (nnheader-article-p)
;; This doesn't look like an article, so we fudge some headers.
(gnus-set-mode-line 'summary)
not-deleted))
-(defun gnus-summary-edit-article (&optional force)
+(defun gnus-summary-edit-article (&optional arg)
"Edit the current article.
This will have permanent effect only in mail groups.
-If FORCE is non-nil, allow editing of articles even in read-only
+If ARG is nil, edit the decoded articles.
+If ARG is 1, edit the raw articles.
+If ARG is 2, edit the raw articles even in read-only groups.
+Otherwise, allow editing of articles even in read-only
groups."
(interactive "P")
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (let ((mail-parse-charset gnus-newsgroup-charset)
- (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets))
- (gnus-set-global-variables)
- (when (and (not force)
- (gnus-group-read-only-p))
- (error "The current newsgroup does not support article editing"))
- (gnus-summary-show-article t)
- (gnus-article-edit-article
- 'mime-to-mml
- `(lambda (no-highlight)
- (let ((mail-parse-charset ',gnus-newsgroup-charset)
- (mail-parse-ignored-charsets
- ',gnus-newsgroup-ignored-charsets))
- (mml-to-mime)
- (gnus-summary-edit-article-done
- ,(or (mail-header-references gnus-current-headers) "")
- ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight)))))))
+ (let (force raw)
+ (cond
+ ((null arg))
+ ((eq arg 1) (setq raw t))
+ ((eq arg 2) (setq raw t
+ force t))
+ (t (setq force t)))
+ (if (and raw (not force) (equal gnus-newsgroup-name "nndraft:drafts"))
+ (error "Can't edit the raw article in group nndraft:drafts."))
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (let ((mail-parse-charset gnus-newsgroup-charset)
+ (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets))
+ (gnus-set-global-variables)
+ (when (and (not force)
+ (gnus-group-read-only-p))
+ (error "The current newsgroup does not support article editing"))
+ (gnus-summary-show-article t)
+ (when (and (not raw) (gnus-buffer-live-p gnus-article-buffer))
+ (with-current-buffer gnus-article-buffer
+ (mm-enable-multibyte)))
+ (if (equal gnus-newsgroup-name "nndraft:drafts")
+ (setq raw t))
+ (gnus-article-edit-article
+ (if raw 'ignore
+ #'(lambda ()
+ (let ((mbl mml-buffer-list))
+ (setq mml-buffer-list nil)
+ (mime-to-mml)
+ (make-local-hook 'kill-buffer-hook)
+ (let ((mml-buffer-list mml-buffer-list))
+ (setq mml-buffer-list mbl)
+ (make-local-variable 'mml-buffer-list))
+ (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))))
+ `(lambda (no-highlight)
+ (let ((mail-parse-charset ',gnus-newsgroup-charset)
+ (mail-parse-ignored-charsets
+ ',gnus-newsgroup-ignored-charsets))
+ ,(if (not raw) '(progn
+ (mml-to-mime)
+ (mml-destroy-buffers)
+ (remove-hook 'kill-buffer-hook
+ 'mml-destroy-buffers t)
+ (kill-local-variable 'mml-buffer-list)))
+ (gnus-summary-edit-article-done
+ ,(or (mail-header-references gnus-current-headers) "")
+ ,(gnus-group-read-only-p)
+ ,gnus-summary-buffer no-highlight))))))))
(defalias 'gnus-summary-edit-article-postpone 'gnus-article-edit-exit)
(gnus-summary-catchup all))
(gnus-summary-next-group))
+;;;
+;;; with article
+;;;
+
+(defmacro gnus-with-article (article &rest forms)
+ "Select ARTICLE and perform FORMS in the original article buffer.
+Then replace the article with the result."
+ `(progn
+ ;; We don't want the article to be marked as read.
+ (let (gnus-mark-article-hook)
+ (gnus-summary-select-article t t nil ,article))
+ (set-buffer gnus-original-article-buffer)
+ ,@forms
+ (if (not (gnus-check-backend-function
+ 'request-replace-article (car gnus-article-current)))
+ (gnus-message 5 "Read-only group; not replacing")
+ (unless (gnus-request-replace-article
+ ,article (car gnus-article-current)
+ (current-buffer) t)
+ (error "Couldn't replace article")))
+ ;; The cache and backlog have to be flushed somewhat.
+ (when gnus-keep-backlog
+ (gnus-backlog-remove-article
+ (car gnus-article-current) (cdr gnus-article-current)))
+ (when gnus-use-cache
+ (gnus-cache-update-article
+ (car gnus-article-current) (cdr gnus-article-current)))))
+
+(put 'gnus-with-article 'lisp-indent-function 1)
+(put 'gnus-with-article 'edebug-form-spec '(form body))
+
;; Thread-based commands.
(defun gnus-summary-articles-in-thread (&optional article)
If N is nil and any articles have been marked with the process mark,
save those articles instead."
(interactive "P")
- (let ((gnus-default-article-saver 'rmail-output-to-rmail-file))
+ (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail))
(gnus-summary-save-article arg)))
(defun gnus-summary-save-article-file (&optional arg)
(mapcar (lambda (el) (list el))
(nreverse split-name))
nil nil nil
- 'gnus-group-history)))))
+ 'gnus-group-history))))
+ (to-method (gnus-server-to-method (gnus-group-method to-newsgroup))))
(when to-newsgroup
(if (or (string= to-newsgroup "")
(string= to-newsgroup prefix))
(unless to-newsgroup
(error "No group name entered"))
(or (gnus-active to-newsgroup)
- (gnus-activate-group to-newsgroup)
+ (gnus-activate-group to-newsgroup nil nil to-method)
(if (gnus-y-or-n-p (format "No such group: %s. Create it? "
to-newsgroup))
- (or (and (gnus-request-create-group
- to-newsgroup (gnus-group-name-to-method to-newsgroup))
+ (or (and (gnus-request-create-group to-newsgroup to-method)
(gnus-activate-group
- to-newsgroup nil nil
- (gnus-group-name-to-method to-newsgroup))
+ to-newsgroup nil nil to-method)
(gnus-subscribe-group to-newsgroup))
(error "Couldn't create group %s" to-newsgroup)))
(error "No such group: %s" to-newsgroup)))
to-newsgroup))
-(defun gnus-summary-save-parts (type dir n reverse)
+(defun gnus-summary-save-parts (type dir n &optional 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)
+ (read-file-name "Save to directory: " nil nil t)
current-prefix-arg))
(gnus-summary-iterate n
(let ((gnus-display-mime-function nil)
(gnus-summary-show-article))
(gnus-summary-show-article)))
-;;;
-;;; with article
-;;;
-
-(defmacro gnus-with-article (article &rest forms)
- "Select ARTICLE and perform FORMS in the original article buffer.
-Then replace the article with the result."
- `(progn
- ;; We don't want the article to be marked as read.
- (let (gnus-mark-article-hook)
- (gnus-summary-select-article t t nil ,article))
- (set-buffer gnus-original-article-buffer)
- ,@forms
- (if (not (gnus-check-backend-function
- 'request-replace-article (car gnus-article-current)))
- (gnus-message 5 "Read-only group; not replacing")
- (unless (gnus-request-replace-article
- ,article (car gnus-article-current)
- (current-buffer) t)
- (error "Couldn't replace article")))
- ;; The cache and backlog have to be flushed somewhat.
- (when gnus-keep-backlog
- (gnus-backlog-remove-article
- (car gnus-article-current) (cdr gnus-article-current)))
- (when gnus-use-cache
- (gnus-cache-update-article
- (car gnus-article-current) (cdr gnus-article-current)))))
-
-(put 'gnus-with-article 'lisp-indent-function 1)
-(put 'gnus-with-article 'edebug-form-spec '(form body))
-
;;;
;;; Generic summary marking commands
;;;
projects / gnus / blobdiff