;;; gnus-art.el --- article mode commands for Gnus
-;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; This file is part of GNU Emacs.
"^Date-Received:" "^References:" "^Control:" "^Xref:" "^Lines:"
"^Posted:" "^Relay-Version:" "^Message-ID:" "^Nf-ID:" "^Nf-From:"
"^Approved:" "^Sender:" "^Received:" "^Mail-from:")
- "All headers that start with this regexp will be hidden.
+ "*All headers that start with this regexp will be hidden.
This variable can also be a list of regexps of headers to be ignored.
If `gnus-visible-headers' is non-nil, this variable will be ignored."
:type '(choice :custom-show nil
:group 'gnus-article-hiding)
(defcustom gnus-visible-headers
- "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From"
- "All headers that do not match this regexp will be hidden.
+ "From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:\\|X-Sent:"
+ "*All headers that do not match this regexp will be hidden.
This variable can also be a list of regexp of headers to remain visible.
If this variable is non-nil, `gnus-ignored-headers' will be ignored."
:type '(repeat :value-to-internal (lambda (widget value)
(defcustom gnus-sorted-header-list
'("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:"
"^Followup-To:" "^To:" "^Cc:" "^Date:" "^Organization:")
- "This variable is a list of regular expressions.
+ "*This variable is a list of regular expressions.
If it is non-nil, headers that match the regular expressions will
be placed first in the article buffer in the sequence specified by
this list."
will be called without any parameters, and if it returns nil, there is
no signature in the buffer. If it is a string, it will be used as a
regexp. If it matches, the text in question is not a signature."
- :type '(choice integer number function regexp)
+ :type '(choice (integer :value 200)
+ (number :value 4.0)
+ (function :value fun)
+ (regexp :value ".*"))
:group 'gnus-article-signature)
(defcustom gnus-hidden-properties '(invisible t intangible t)
(defcustom gnus-article-x-face-command
"{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
- "String or function to be executed to display an X-Face header.
+ "*String or function to be executed to display an X-Face header.
If it is a string, the command will be executed in a sub-shell
asynchronously. The compressed face will be piped to this command."
:type 'string ;Leave function case to Lisp.
(lambda (spec)
(list
(format format (car spec) (cadr spec))
- 2 3 (intern (format "gnus-emphasis-%s" (caddr spec)))))
+ 2 3 (intern (format "gnus-emphasis-%s" (nth 2 spec)))))
types)))
- "Alist that says how to fontify certain phrases.
+ "*Alist that says how to fontify certain phrases.
Each item looks like this:
(\"_\\\\(\\\\w+\\\\)_\" 0 1 'underline)
(defcustom gnus-article-time-format "%a, %b %d %Y %T %Z"
"Format for display of Date headers in article bodies.
-See `format-time-string' for the possible values."
- :type 'string
+See `format-time-string' for the possible values.
+
+The variable can also be function, which should return a complete Date
+header. The function is called with one argument, the time, which can
+be fed to `format-time-string'."
+ :type '(choice string symbol)
:link '(custom-manual "(gnus)Article Date")
:group 'gnus-article-washing)
:group 'gnus-article-saving
:type '(choice (item always)
(item :tag "never" nil)
- (sexp :tag "once" :format "%t")))
+ (sexp :tag "once" :format "%t\n" :value t)))
(defcustom gnus-saved-headers gnus-visible-headers
"Headers to keep if `gnus-save-all-headers' is nil.
(defcustom gnus-split-methods
'((gnus-article-archive-name)
(gnus-article-nndoc-name))
- "Variable used to suggest where articles are to be saved.
+ "*Variable used to suggest where articles are to be saved.
For instance, if you would like to save articles related to Gnus in
the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\",
you could set this variable to something like:
a possible file name; and if it returns a non-nil list, that list will
be used as possible file names."
:group 'gnus-article-saving
- :type '(repeat (choice (list function)
- (cons regexp (repeat string))
- sexp)))
+ :type '(repeat (choice (list :value (fun) function)
+ (cons :value ("" "") regexp (repeat string))
+ (sexp :value nil))))
(defcustom gnus-strict-mime t
"*If nil, MIME-decode even if there is no Mime-Version header."
(defface gnus-header-from-face
'((((class color)
(background dark))
- (:foreground "spring green" :bold t))
+ (:foreground "spring green"))
(((class color)
(background light))
- (:foreground "red3" :bold t))
+ (:foreground "red3"))
(t
- (:bold t :italic t)))
+ (:italic t)))
"Face used for displaying from headers."
:group 'gnus-article-headers
:group 'gnus-article-highlight)
(defface gnus-header-subject-face
'((((class color)
(background dark))
- (:foreground "SeaGreen3" :bold t))
+ (:foreground "SeaGreen3"))
(((class color)
(background light))
- (:foreground "red4" :bold t))
+ (:foreground "red4"))
(t
(:bold t :italic t)))
"Face used for displaying subject headers."
(defface gnus-header-newsgroups-face
'((((class color)
(background dark))
- (:foreground "yellow" :bold t :italic t))
+ (:foreground "yellow" :italic t))
(((class color)
(background light))
- (:foreground "MidnightBlue" :bold t :italic t))
+ (:foreground "MidnightBlue" :italic t))
(t
- (:bold t :italic t)))
+ (:italic t)))
"Face used for displaying newsgroups headers."
:group 'gnus-article-headers
:group 'gnus-article-highlight)
("Subject" nil gnus-header-subject-face)
("Newsgroups:.*," nil gnus-header-newsgroups-face)
("" gnus-header-name-face gnus-header-content-face))
- "Controls highlighting of article header.
+ "*Controls highlighting of article header.
An alist of the form (HEADER NAME CONTENT).
;;; Internal variables
(defvar article-lapsed-timer nil)
+(defvar gnus-article-current-summary nil)
(defvar gnus-article-mode-syntax-table
(let ((table (copy-syntax-table text-mode-syntax-table)))
(defvar gnus-save-article-buffer nil)
(defvar gnus-article-mode-line-format-alist
- (nconc '((?w (gnus-article-wash-status) ?s))
- gnus-summary-mode-line-format-alist))
+ (nconc '((?w (gnus-article-wash-status) ?s))
+ gnus-summary-mode-line-format-alist))
(defvar gnus-number-of-articles-to-be-saved nil)
(save-excursion
(save-restriction
(let ((buffer-read-only nil)
+ (case-fold-search t)
(props (nconc (list 'article-type 'headers)
gnus-hidden-properties))
(max (1+ (length gnus-sorted-header-list)))
(nnheader-narrow-to-headers)
(setq from (message-fetch-field "from"))
(goto-char (point-min))
- (while (and gnus-article-x-face-command
- (or force
- ;; Check whether this face is censored.
- (not gnus-article-x-face-too-ugly)
- (and gnus-article-x-face-too-ugly from
- (not (string-match gnus-article-x-face-too-ugly
- from))))
- ;; Has to be present.
- (re-search-forward "^X-Face: " nil t))
+ ;; This used to try to do multiple faces (`while' instead of
+ ;; `when' below), but (a) sending multiple EOFs to xv doesn't
+ ;; work (b) it can crash some versions of Emacs (c) are
+ ;; multiple faces really something to encourage?
+ (when (and gnus-article-x-face-command
+ (or force
+ ;; Check whether this face is censored.
+ (not gnus-article-x-face-too-ugly)
+ (and gnus-article-x-face-too-ugly from
+ (not (string-match gnus-article-x-face-too-ugly
+ from))))
+ ;; Has to be present.
+ (re-search-forward "^X-Face: " nil t))
;; We now have the area of the buffer where the X-Face is stored.
(save-excursion
(let ((beg (point))
(goto-char (point-min))
;; Hide the "header".
(when (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t)
- (gnus-article-hide-text-type (1+ (match-beginning 0))
- (match-end 0) 'pgp)
+ (delete-region (1+ (match-beginning 0)) (match-end 0))
(setq beg (point))
;; Hide the actual signature.
(and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t)
(setq end (1+ (match-beginning 0)))
- (gnus-article-hide-text-type
+ (delete-region
end
(if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t)
(match-end 0)
;; Perhaps we shouldn't hide to the end of the buffer
;; if there is no end to the signature?
- (point-max))
- 'pgp))
+ (point-max))))
;; Hide "- " PGP quotation markers.
(when (and beg end)
(narrow-to-region beg end)
(goto-char (point-min))
(while (re-search-forward "^- " nil t)
- (gnus-article-hide-text-type
- (match-beginning 0) (match-end 0) 'pgp))
+ (delete-region
+ (match-beginning 0) (match-end 0)))
(widen))
- (run-hooks 'gnus-article-hide-pgp-hook))))))
+ (gnus-run-hooks 'gnus-article-hide-pgp-hook))))))
(defun article-hide-pem (&optional arg)
"Toggle hiding of any PEM headers and signatures in the current article.
(article-remove-trailing-blank-lines)
(article-strip-multiple-blank-lines))
+(defun article-strip-all-blank-lines ()
+ "Strip all blank lines."
+ (interactive)
+ (save-excursion
+ (let ((inhibit-point-motion-hooks t)
+ buffer-read-only)
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (while (re-search-forward "^[ \t]*\n" nil t)
+ (replace-match "" t t)))))
+
(defvar mime::preview/content-list)
(defvar mime::preview-content-info/point-min)
(defun gnus-article-narrow-to-signature ()
"Narrow to the signature; return t if a signature is found, else nil."
(widen)
- (when (and (boundp 'mime::preview/content-list)
- mime::preview/content-list)
- ;; We have a MIMEish article, so we use the MIME data to narrow.
- (let ((pcinfo (car (last mime::preview/content-list))))
- (ignore-errors
- (narrow-to-region
- (funcall (intern "mime::preview-content-info/point-min") pcinfo)
- (point-max)))))
-
- (when (gnus-article-search-signature)
- (forward-line 1)
- ;; Check whether we have some limits to what we consider
- ;; to be a signature.
- (let ((limits (if (listp gnus-signature-limit) gnus-signature-limit
- (list gnus-signature-limit)))
- limit limited)
- (while (setq limit (pop limits))
- (if (or (and (integerp limit)
- (< (- (point-max) (point)) limit))
- (and (floatp limit)
- (< (count-lines (point) (point-max)) limit))
- (and (gnus-functionp limit)
- (funcall limit))
- (and (stringp limit)
- (not (re-search-forward limit nil t))))
- () ; This limit did not succeed.
- (setq limited t
- limits nil)))
- (unless limited
- (narrow-to-region (point) (point-max))
- t))))
+ (let ((inhibit-point-motion-hooks t))
+ (when (and (boundp 'mime::preview/content-list)
+ mime::preview/content-list)
+ ;; We have a MIMEish article, so we use the MIME data to narrow.
+ (let ((pcinfo (car (last mime::preview/content-list))))
+ (ignore-errors
+ (narrow-to-region
+ (funcall (intern "mime::preview-content-info/point-min") pcinfo)
+ (point-max)))))
+
+ (when (gnus-article-search-signature)
+ (forward-line 1)
+ ;; Check whether we have some limits to what we consider
+ ;; to be a signature.
+ (let ((limits (if (listp gnus-signature-limit) gnus-signature-limit
+ (list gnus-signature-limit)))
+ limit limited)
+ (while (setq limit (pop limits))
+ (if (or (and (integerp limit)
+ (< (- (point-max) (point)) limit))
+ (and (floatp limit)
+ (< (count-lines (point) (point-max)) limit))
+ (and (gnus-functionp limit)
+ (funcall limit))
+ (and (stringp limit)
+ (not (re-search-forward limit nil t))))
+ () ; This limit did not succeed.
+ (setq limited t
+ limits nil)))
+ (unless limited
+ (narrow-to-region (point) (point-max))
+ t)))))
(defun gnus-article-search-signature ()
"Search the current buffer for the signature separator.
header))
(date-regexp "^Date:[ \t]\\|^X-Sent:[ \t]")
(inhibit-point-motion-hooks t)
- bface eface)
+ bface eface newline)
(when (and date (not (string= date "")))
(save-excursion
(save-restriction
(delete-region (progn (beginning-of-line) (point))
(progn (end-of-line) (point)))
(beginning-of-line))
- (goto-char (point-max)))
+ (goto-char (point-max))
+ (setq newline t))
(insert (article-make-date-line date type))
;; Do highlighting.
(beginning-of-line)
(put-text-property (match-beginning 1) (1+ (match-end 1))
'face bface)
(put-text-property (match-beginning 2) (match-end 2)
- 'face eface))))))))
+ 'face eface))
+ (when newline
+ (end-of-line)
+ (insert "\n"))))))))
(defun article-make-date-line (date type)
"Return a DATE line of TYPE."
(concat "Date: " date))
;; Let the user define the format.
((eq type 'user)
+ (if (gnus-functionp gnus-article-time-format)
+ (funcall
+ gnus-article-time-format
+ (ignore-errors
+ (gnus-encode-date
+ (timezone-make-date-arpa-standard
+ date nil "UT"))))
+ (concat
+ "Date: "
+ (format-time-string gnus-article-time-format
+ (ignore-errors
+ (gnus-encode-date
+ (timezone-make-date-arpa-standard
+ date nil "UT")))))))
+ ;; ISO 8601.
+ ((eq type 'iso8601)
(concat
"Date: "
- (format-time-string gnus-article-time-format
+ (format-time-string "%Y%M%DT%h%m%s"
(ignore-errors
(gnus-encode-date
(timezone-make-date-arpa-standard
num prev)
(cond
((null real-time)
- "X-Sent: Unknown\n")
+ "X-Sent: Unknown")
((zerop sec)
- "X-Sent: Now\n")
+ "X-Sent: Now")
(t
(concat
"X-Sent: "
(defun article-update-date-lapsed ()
"Function to be run from a timer to update the lapsed time line."
- (save-excursion
- (when (gnus-buffer-live-p gnus-article-buffer)
- (set-buffer gnus-article-buffer)
- (goto-char (point-min))
- (when (re-search-forward "^X-Sent:" nil t)
- (article-date-lapsed t)))))
-
-(defun gnus-start-date-timer ()
- "Start a timer to update the X-Sent header in the article buffers."
- (interactive)
+ (let (deactivate-mark)
+ (save-excursion
+ (ignore-errors
+ (when (gnus-buffer-live-p gnus-article-buffer)
+ (set-buffer gnus-article-buffer)
+ (goto-char (point-min))
+ (when (re-search-forward "^X-Sent:" nil t)
+ (article-date-lapsed t)))))))
+
+(defun gnus-start-date-timer (&optional n)
+ "Start a timer to update the X-Sent header in the article buffers.
+The numerical prefix says how frequently (in seconds) the function
+is to run."
+ (interactive "p")
+ (unless n
+ (setq n 1))
(gnus-stop-date-timer)
(setq article-lapsed-timer
- (nnheader-run-at-time 1 1 'article-update-date-lapsed)))
+ (nnheader-run-at-time 1 n 'article-update-date-lapsed)))
(defun gnus-stop-date-timer ()
"Stop the X-Sent timer."
(interactive)
(when article-lapsed-timer
- (nnheader-delete-timer article-lapsed-timer)
+ (nnheader-cancel-timer article-lapsed-timer)
(setq article-lapsed-timer nil)))
(defun article-date-user (&optional highlight)
(interactive (list t))
(article-date-ut 'user highlight))
+(defun article-date-iso8601 (&optional highlight)
+ "Convert the current article date to ISO8601."
+ (interactive (list t))
+ (article-date-ut 'iso8601 highlight))
+
(defun article-show-all ()
"Show all hidden text in the article buffer."
(interactive)
(gnus-number-of-articles-to-be-saved
(when (eq gnus-prompt-before-saving t)
num))) ; Magic
- (set-buffer gnus-summary-buffer)
+ (set-buffer gnus-article-current-summary)
(funcall gnus-default-article-saver filename)))))
(defun gnus-read-save-file-name (prompt &optional filename
"Append this article to Rmail file.
Optional argument FILENAME specifies file name.
Directory to save to is default to `gnus-article-save-directory'."
- (interactive)
(setq filename (gnus-read-save-file-name
"Save %s in rmail file:" filename
gnus-rmail-save-name gnus-newsgroup-name
(save-excursion
(save-restriction
(widen)
- (gnus-output-to-rmail filename)))))
+ (gnus-output-to-rmail filename))))
+ filename)
(defun gnus-summary-save-in-mail (&optional filename)
"Append this article to Unix mail file.
Optional argument FILENAME specifies file name.
Directory to save to is default to `gnus-article-save-directory'."
- (interactive)
(setq filename (gnus-read-save-file-name
"Save %s in Unix mail file:" filename
gnus-mail-save-name gnus-newsgroup-name
(if (and (file-readable-p filename)
(mail-file-babyl-p filename))
(gnus-output-to-rmail filename t)
- (gnus-output-to-mail filename))))))
+ (gnus-output-to-mail filename)))))
+ filename)
(defun gnus-summary-save-in-file (&optional filename overwrite)
"Append this article to file.
Optional argument FILENAME specifies file name.
Directory to save to is default to `gnus-article-save-directory'."
- (interactive)
(setq filename (gnus-read-save-file-name
"Save %s in file:" filename
gnus-file-save-name gnus-newsgroup-name
(when (and overwrite
(file-exists-p filename))
(delete-file filename))
- (gnus-output-to-file filename)))))
+ (gnus-output-to-file filename))))
+ filename)
(defun gnus-summary-write-to-file (&optional filename)
"Write this article to a file.
Optional argument FILENAME specifies file name.
The directory to save in defaults to `gnus-article-save-directory'."
- (interactive)
(gnus-summary-save-in-file nil t))
(defun gnus-summary-save-body-in-file (&optional filename)
"Append this article body to a file.
Optional argument FILENAME specifies file name.
The directory to save in defaults to `gnus-article-save-directory'."
- (interactive)
(setq filename (gnus-read-save-file-name
"Save %s body in file:" filename
gnus-file-save-name gnus-newsgroup-name
(goto-char (point-min))
(when (search-forward "\n\n" nil t)
(narrow-to-region (point) (point-max)))
- (gnus-output-to-file filename)))))
+ (gnus-output-to-file filename))))
+ filename)
(defun gnus-summary-save-in-pipe (&optional command)
"Pipe this article to subprocess."
- (interactive)
(setq command
(cond ((eq command 'default)
gnus-last-shell-command)
article-strip-multiple-blank-lines
article-strip-leading-space
article-strip-blank-lines
+ article-strip-all-blank-lines
article-date-local
+ article-date-iso8601
article-date-original
article-date-ut
article-date-user
["Scroll backwards" gnus-article-goto-prev-page t]
["Show summary" gnus-article-show-summary t]
["Fetch Message-ID at point" gnus-article-refer-article t]
- ["Mail to address at point" gnus-article-mail t]))
+ ["Mail to address at point" gnus-article-mail t]
+ ["Send a bug report" gnus-bug t]))
(easy-menu-define
gnus-article-treatment-menu gnus-article-mode-map ""
["Remove carriage return" gnus-article-remove-cr t]
["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t]))
- (when nil
- (when (boundp 'gnus-summary-article-menu)
- (define-key gnus-article-mode-map [menu-bar commands]
- (cons "Commands" gnus-summary-article-menu))))
+ ;; Note "Commands" menu is defined in gnus-sum.el for consistency
(when (boundp 'gnus-summary-post-menu)
(define-key gnus-article-mode-map [menu-bar post]
(cons "Post" gnus-summary-post-menu)))
- (run-hooks 'gnus-article-menu-hook)))
+ (gnus-run-hooks 'gnus-article-menu-hook)))
(defun gnus-article-mode ()
"Major mode for displaying an article.
(interactive)
(when (gnus-visual-p 'article-menu 'menu)
(gnus-article-make-menu-bar))
- (kill-all-local-variables)
(gnus-simplify-mode-line)
(setq mode-name "Article")
(setq major-mode 'gnus-article-mode)
(use-local-map gnus-article-mode-map)
(gnus-update-format-specifications nil 'article-mode)
(set (make-local-variable 'page-delimiter) gnus-page-delimiter)
- (set (make-local-variable 'gnus-page-broken) nil)
- (set (make-local-variable 'gnus-button-marker-list) nil)
+ (make-local-variable 'gnus-page-broken)
+ (make-local-variable 'gnus-button-marker-list)
+ (make-local-variable 'gnus-article-current-summary)
(gnus-set-default-directory)
(buffer-disable-undo (current-buffer))
(setq buffer-read-only t)
(set-syntax-table gnus-article-mode-syntax-table)
- (run-hooks 'gnus-article-mode-hook))
+ (gnus-run-hooks 'gnus-article-mode-hook))
(defun gnus-article-setup-buffer ()
"Initialize the article buffer."
(unless (eq major-mode 'gnus-summary-mode)
(set-buffer gnus-summary-buffer))
(setq gnus-summary-buffer (current-buffer))
- ;; Make sure the connection to the server is alive.
- (unless (gnus-server-opened
- (gnus-find-method-for-group gnus-newsgroup-name))
- (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
- (gnus-request-group gnus-newsgroup-name t))
(let* ((gnus-article (if header (mail-header-number header) article))
(summary-buffer (current-buffer))
(internal-hook gnus-article-internal-prepare-hook)
(cons gnus-newsgroup-name article))
(set-buffer gnus-summary-buffer)
(setq gnus-current-article article)
- (gnus-summary-mark-article article gnus-canceled-mark))
- (unless (memq article gnus-newsgroup-sparse)
- (gnus-error
- 1 "No such article (may have expired or been canceled)")))
+ (if (eq (gnus-article-mark article) gnus-undownloaded-mark)
+ (progn
+ (gnus-summary-set-agent-mark article)
+ (message "Message marked for downloading"))
+ (gnus-summary-mark-article article gnus-canceled-mark)
+ (unless (memq article gnus-newsgroup-sparse)
+ (gnus-error 1
+ "No such article (may have expired or been canceled)")))))
(if (or (eq result 'pseudo) (eq result 'nneething))
(progn
(save-excursion
(unless (vectorp gnus-current-headers)
(setq gnus-current-headers nil))
(gnus-summary-goto-subject gnus-current-article)
- (gnus-summary-show-thread)
- (run-hooks 'gnus-mark-article-hook)
+ (when (gnus-summary-show-thread)
+ ;; If the summary buffer really was folded, the
+ ;; previous goto may not actually have gone to
+ ;; the right article, but the thread root instead.
+ ;; So we go again.
+ (gnus-summary-goto-subject gnus-current-article))
+ (gnus-run-hooks 'gnus-mark-article-hook)
(gnus-set-mode-line 'summary)
(when (gnus-visual-p 'article-highlight 'highlight)
- (run-hooks 'gnus-visual-mark-article-hook))
+ (gnus-run-hooks 'gnus-visual-mark-article-hook))
;; Set the global newsgroup variables here.
;; Suggested by Jim Sisolak
;; <sisolak@trans4.neep.wisc.edu>.
(gnus-set-global-variables)
(setq gnus-have-all-headers
- (or all-headers gnus-show-all-headers))
- (and gnus-use-cache
- (vectorp (gnus-summary-article-header article))
- (gnus-cache-possibly-enter-article
- group article
- (gnus-summary-article-header article)
- (memq article gnus-newsgroup-marked)
- (memq article gnus-newsgroup-dormant)
- (memq article gnus-newsgroup-unreads)))))
+ (or all-headers gnus-show-all-headers))))
(when (or (numberp article)
(stringp article))
;; Hooks for getting information from the article.
;; This hook must be called before being narrowed.
(let (buffer-read-only)
- (run-hooks 'internal-hook)
- (run-hooks 'gnus-article-prepare-hook)
+ (gnus-run-hooks 'internal-hook)
+ (gnus-run-hooks 'gnus-article-prepare-hook)
;; Decode MIME message.
(when gnus-show-mime
(if (or (not gnus-strict-mime)
(gnus-fetch-field "Mime-Version"))
- (funcall gnus-show-mime-method)
+ (let ((coding-system-for-write 'binary)
+ (coding-system-for-read 'binary))
+ (funcall gnus-show-mime-method))
(funcall gnus-decode-encoded-word-method)))
;; Perform the article display hooks.
- (run-hooks 'gnus-article-display-hook))
+ (gnus-run-hooks 'gnus-article-display-hook))
;; Do page break.
(goto-char (point-min))
(setq gnus-page-broken
(gnus-set-mode-line 'article)
(gnus-configure-windows 'article)
(goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (set-window-point (get-buffer-window (current-buffer)) (point))
t))))))
(defun gnus-article-wash-status ()
(if mime ?m ? )
(if emphasis ?e ? )))))
-(defun gnus-article-hide-headers-if-wanted ()
+(fset 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers)
+
+(defun gnus-article-maybe-hide-headers ()
"Hide unwanted headers if `gnus-have-all-headers' is nil.
Provided for backwards compatibility."
(or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers)
(error "There is no summary buffer for this article buffer")
(gnus-article-set-globals)
(gnus-configure-windows 'article)
- (gnus-summary-goto-subject gnus-current-article)))
+ (gnus-summary-goto-subject gnus-current-article)
+ (gnus-summary-position-point)))
(defun gnus-article-describe-briefly ()
"Describe article mode commands briefly."
(let ((obuf (current-buffer))
(owin (current-window-configuration))
func)
- (switch-to-buffer gnus-summary-buffer 'norecord)
+ (switch-to-buffer gnus-article-current-summary 'norecord)
(setq func (lookup-key (current-local-map) (this-command-keys)))
(call-interactively func)
(set-buffer obuf)
"Execute the last keystroke in the summary buffer."
(interactive)
(let (func)
- (pop-to-buffer gnus-summary-buffer 'norecord)
+ (pop-to-buffer gnus-article-current-summary 'norecord)
(setq func (lookup-key (current-local-map) (this-command-keys)))
(call-interactively func)))
"Read a summary buffer key sequence and execute it from the article buffer."
(interactive "P")
(let ((nosaves
- '("q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F"
- "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
- "=" "^" "\M-^" "|"))
- (nosave-but-article
- '("A\r"))
- (nosave-in-article
- '("\C-d"))
- keys)
+ '("q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F"
+ "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
+ "=" "^" "\M-^" "|"))
+ (nosave-but-article
+ '("A\r"))
+ (nosave-in-article
+ '("\C-d"))
+ (up-to-top
+ '("n" "Gn" "p" "Gp"))
+ keys new-sum-point)
(save-excursion
- (set-buffer gnus-summary-buffer)
+ (set-buffer gnus-article-current-summary)
(let (gnus-pick-mode)
- (push (or key last-command-event) unread-command-events)
- (setq keys (read-key-sequence nil))))
+ (push (or key last-command-event) unread-command-events)
+ (setq keys (read-key-sequence nil))))
(message "")
(if (or (member keys nosaves)
- (member keys nosave-but-article)
- (member keys nosave-in-article))
- (let (func)
- (save-window-excursion
- (pop-to-buffer gnus-summary-buffer 'norecord)
- ;; We disable the pick minor mode commands.
- (let (gnus-pick-mode)
- (setq func (lookup-key (current-local-map) keys))))
- (if (not func)
- (ding)
- (unless (member keys nosave-in-article)
- (set-buffer gnus-summary-buffer))
- (call-interactively func))
- (when (member keys nosave-but-article)
- (pop-to-buffer gnus-article-buffer 'norecord)))
+ (member keys nosave-but-article)
+ (member keys nosave-in-article))
+ (let (func)
+ (save-window-excursion
+ (pop-to-buffer gnus-article-current-summary 'norecord)
+ ;; We disable the pick minor mode commands.
+ (let (gnus-pick-mode)
+ (setq func (lookup-key (current-local-map) keys))))
+ (if (not func)
+ (ding)
+ (unless (member keys nosave-in-article)
+ (set-buffer gnus-article-current-summary))
+ (call-interactively func)
+ (setq new-sum-point (point)))
+ (when (member keys nosave-but-article)
+ (pop-to-buffer gnus-article-buffer 'norecord)))
;; These commands should restore window configuration.
(let ((obuf (current-buffer))
- (owin (current-window-configuration))
- (opoint (point))
- func in-buffer)
- (if not-restore-window
- (pop-to-buffer gnus-summary-buffer 'norecord)
- (switch-to-buffer gnus-summary-buffer 'norecord))
- (setq in-buffer (current-buffer))
- ;; We disable the pick minor mode commands.
- (if (setq func (let (gnus-pick-mode)
- (lookup-key (current-local-map) keys)))
- (call-interactively func)
- (ding))
- (when (eq in-buffer (current-buffer))
- (set-buffer obuf)
- (unless not-restore-window
- (set-window-configuration owin))
- (set-window-point (get-buffer-window (current-buffer)) opoint))))))
+ (owin (current-window-configuration))
+ (opoint (point))
+ (summary gnus-article-current-summary)
+ func in-buffer selected)
+ (if not-restore-window
+ (pop-to-buffer summary 'norecord)
+ (switch-to-buffer summary 'norecord))
+ (setq in-buffer (current-buffer))
+ ;; We disable the pick minor mode commands.
+ (if (setq func (let (gnus-pick-mode)
+ (lookup-key (current-local-map) keys)))
+ (progn
+ (call-interactively func)
+ (setq new-sum-point (point)))
+ (ding))
+ (when (eq in-buffer (current-buffer))
+ (setq selected (gnus-summary-select-article))
+ (set-buffer obuf)
+ (unless not-restore-window
+ (set-window-configuration owin))
+ (unless (or (not (eq selected 'old)) (member keys up-to-top))
+ (set-window-point (get-buffer-window (current-buffer))
+ opoint))
+ (let ((win (get-buffer-window gnus-article-current-summary)))
+ (when win
+ (set-window-point win new-sum-point))))))))
(defun gnus-article-hide (&optional arg force)
"Hide all the gruft in the current article.
This means that PGP stuff, signatures, cited text and (some)
headers will be hidden.
If given a prefix, show the hidden text instead."
- (interactive (list current-prefix-arg 'force))
+ (interactive (append (gnus-article-hidden-arg) (list 'force)))
(gnus-article-hide-headers arg)
(gnus-article-hide-pgp arg)
(gnus-article-hide-citation-maybe arg force)
(gnus-article-hide-signature arg))
(defun gnus-article-maybe-highlight ()
- "Do some article highlighting if `article-visual' is non-nil."
+ "Do some article highlighting if article highlighting is requested."
(when (gnus-visual-p 'article-highlight 'highlight)
(gnus-article-highlight-some)))
+(defun gnus-check-group-server ()
+ ;; Make sure the connection to the server is alive.
+ (unless (gnus-server-opened
+ (gnus-find-method-for-group gnus-newsgroup-name))
+ (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
+ (gnus-request-group gnus-newsgroup-name t)))
+
(defun gnus-request-article-this-buffer (article group)
"Get an article and insert it into this buffer."
- (let (do-update-line)
+ (let (do-update-line sparse-header)
(prog1
(save-excursion
(erase-buffer)
(gnus-kill-all-overlays)
(setq group (or group gnus-newsgroup-name))
- ;; Open server if it has closed.
- (gnus-check-server (gnus-find-method-for-group group))
-
;; Using `gnus-request-article' directly will insert the article into
;; `nntp-server-buffer' - so we'll save some time by not having to
;; copy it from the server buffer into the article buffer.
(when (and (numberp article)
gnus-summary-buffer
(get-buffer gnus-summary-buffer)
- (buffer-name (get-buffer gnus-summary-buffer)))
+ (gnus-buffer-exists-p gnus-summary-buffer))
(save-excursion
(set-buffer gnus-summary-buffer)
(let ((header (gnus-summary-article-header article)))
(setq do-update-line article)
(setq article (mail-header-id header))
(let ((gnus-override-method gnus-refer-article-method))
- (gnus-read-header article))
+ (setq sparse-header (gnus-read-header article)))
(setq gnus-newsgroup-sparse
(delq article gnus-newsgroup-sparse)))
((vectorp header)
(let ((method (gnus-find-method-for-group
gnus-newsgroup-name)))
- (if (not (eq (car method) 'nneething))
- ()
+ (when (and (eq (car method) 'nneething)
+ (vectorp header))
(let ((dir (concat (file-name-as-directory (nth 1 method))
(mail-header-subject header))))
(when (file-directory-p dir)
((and (numberp article)
gnus-summary-buffer
(get-buffer gnus-summary-buffer)
- (buffer-name (get-buffer gnus-summary-buffer))
+ (gnus-buffer-exists-p gnus-summary-buffer)
(eq (cdr (save-excursion
(set-buffer gnus-summary-buffer)
(assq article gnus-newsgroup-reads)))
;; Check asynchronous pre-fetch.
((gnus-async-request-fetched-article group article (current-buffer))
(gnus-async-prefetch-next group article gnus-summary-buffer)
+ (when (and (numberp article) gnus-keep-backlog)
+ (gnus-backlog-enter-article group article (current-buffer)))
'article)
;; Check the cache.
((and gnus-use-cache
(buffer-read-only nil))
(erase-buffer)
(gnus-kill-all-overlays)
+ (gnus-check-group-server)
(when (gnus-request-article article group (current-buffer))
(when (numberp article)
(gnus-async-prefetch-next group article gnus-summary-buffer)
;; It was a pseudo.
(t article)))
+ ;; Associate this article with the current summary buffer.
+ (setq gnus-article-current-summary gnus-summary-buffer)
+
;; Take the article from the original article buffer
;; and place it in the buffer it's supposed to be in.
(when (and (get-buffer gnus-article-buffer)
- ;;(numberp article)
(equal (buffer-name (current-buffer))
(buffer-name (get-buffer gnus-article-buffer))))
(save-excursion
(if (get-buffer gnus-original-article-buffer)
- (set-buffer (get-buffer gnus-original-article-buffer))
+ (set-buffer gnus-original-article-buffer)
(set-buffer (get-buffer-create gnus-original-article-buffer))
(buffer-disable-undo (current-buffer))
(setq major-mode 'gnus-original-article-mode)
(stringp article)))
(let ((buf (current-buffer)))
(set-buffer gnus-summary-buffer)
- (gnus-summary-update-article do-update-line)
+ (gnus-summary-update-article do-update-line sparse-header)
(gnus-summary-goto-subject do-update-line nil t)
(set-window-point (get-buffer-window (current-buffer) t)
(point))
\\{gnus-article-edit-mode-map}"
(interactive)
- (kill-all-local-variables)
(setq major-mode 'gnus-article-edit-mode)
(setq mode-name "Article Edit")
(use-local-map gnus-article-edit-mode-map)
(setq buffer-read-only nil)
(buffer-enable-undo)
(widen)
- (run-hooks 'text-mode 'gnus-article-edit-mode-hook))
+ (gnus-run-hooks 'text-mode-hook 'gnus-article-edit-mode-hook))
(defun gnus-article-edit (&optional force)
"Edit the current article.
(when (and (not force)
(gnus-group-read-only-p))
(error "The current newsgroup does not support article editing"))
+ (gnus-article-date-original)
(gnus-article-edit-article
`(lambda (no-highlight)
(gnus-summary-edit-article-done
(let ((winconf (current-window-configuration)))
(set-buffer gnus-article-buffer)
(gnus-article-edit-mode)
+ (gnus-article-delete-text-of-type 'annotation)
(gnus-set-text-properties (point-min) (point-max) nil)
(gnus-configure-windows 'edit-article)
(setq gnus-article-edit-done-function exit-func)
(defun gnus-article-edit-done (&optional arg)
"Update the article edits and exit."
(interactive "P")
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (when (search-forward "\n\n" nil 1)
+ (let ((lines (count-lines (point) (point-max)))
+ (length (- (point-max) (point)))
+ (case-fold-search t)
+ (body (copy-marker (point))))
+ (goto-char (point-min))
+ (when (re-search-forward "^content-length:[ \t]\\([0-9]+\\)" body t)
+ (delete-region (match-beginning 1) (match-end 1))
+ (insert (number-to-string length)))
+ (goto-char (point-min))
+ (when (re-search-forward
+ "^x-content-length:[ \t]\\([0-9]+\\)" body t)
+ (delete-region (match-beginning 1) (match-end 1))
+ (insert (number-to-string length)))
+ (goto-char (point-min))
+ (when (re-search-forward "^lines:[ \t]\\([0-9]+\\)" body t)
+ (delete-region (match-beginning 1) (match-end 1))
+ (insert (number-to-string lines)))))))
(let ((func gnus-article-edit-done-function)
(buf (current-buffer))
(start (window-start)))
:type 'regexp)
(defcustom gnus-button-alist
- `(("<\\(url: ?\\)?news:\\([^>\n\t ]*@[^>\n\t ]*\\)>" 0 t
+ `(("<\\(url:[>\n\t ]*?\\)?news:[>\n\t ]*\\([^>\n\t ]*@[^>\n\t ]*\\)>" 0 t
gnus-button-message-id 2)
("\\bnews:\\([^>\n\t ]*@[^>\n\t ]*\\)" 0 t gnus-button-message-id 1)
- ("\\(\\b<\\(url: ?\\)?news:\\(//\\)?\\([^>\n\t ]*\\)>\\)" 1 t
+ ("\\(\\b<\\(url:[>\n\t ]*\\)?news:[>\n\t ]*\\(//\\)?\\([^>\n\t ]*\\)>\\)"
+ 1 t
gnus-button-fetch-group 4)
("\\bnews:\\(//\\)?\\([^'\">\n\t ]+\\)" 0 t gnus-button-fetch-group 2)
- ("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2
+ ("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2
t gnus-button-message-id 3)
("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>" 0 t gnus-url-mailto 2)
+ ("mailto:\\([a-zA-Z.-@_+0-9%]+\\)" 0 t gnus-url-mailto 1)
("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 1)
;; This is how URLs _should_ be embedded in text...
("<URL: *\\([^>]*\\)>" 0 t gnus-button-embedded-url 1)
;; Raw URLs.
(,gnus-button-url-regexp 0 t gnus-button-url 0))
- "Alist of regexps matching buttons in article bodies.
+ "*Alist of regexps matching buttons in article bodies.
Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where
REGEXP: is the string matching text around the button,
("^[^:]+:" ,gnus-button-url-regexp 0 t gnus-button-url 0)
("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t
gnus-button-message-id 3))
- "Alist of headers and regexps to match buttons in article heads.
+ "*Alist of headers and regexps to match buttons in article heads.
This alist is very similar to `gnus-button-alist', except that each
alist has an additional HEADER element first in each entry:
(match-string 3 address)
"nntp")))))))
-(defun gnus-split-string (string pattern)
- "Return a list of substrings of STRING which are separated by PATTERN."
- (let (parts (start 0))
- (while (string-match pattern string start)
- (setq parts (cons (substring string start (match-beginning 0)) parts)
- start (match-end 0)))
- (nreverse (cons (substring string start) parts))))
-
(defun gnus-url-parse-query-string (query &optional downcase)
(let (retval pairs cur key val)
(setq pairs (gnus-split-string query "&"))
(defun gnus-button-url (address)
"Browse ADDRESS."
- (funcall browse-url-browser-function address))
+ ;; In Emacs 20, `browse-url-browser-function' may be an alist.
+ (if (listp browse-url-browser-function)
+ (browse-url address)
+ (funcall browse-url-browser-function address)))
(defun gnus-button-embedded-url (address)
"Browse ADDRESS."
- (funcall browse-url-browser-function (gnus-strip-whitespace address)))
+ ;; In Emacs 20, `browse-url-browser-function' may be an alist.
+ (if (listp browse-url-browser-function)
+ (browse-url (gnus-strip-whitespace address))
+ (funcall browse-url-browser-function (gnus-strip-whitespace address))))
;;; Next/prev buttons in the article buffer.
(gnus-eval-format
gnus-prev-page-line-format nil
`(gnus-prev t local-map ,gnus-prev-page-map
- gnus-callback gnus-article-button-prev-page))))
+ gnus-callback gnus-article-button-prev-page
+ gnus-type annotation))))
(defvar gnus-next-page-map nil)
(unless gnus-next-page-map
(defun gnus-insert-next-page-button ()
(let ((buffer-read-only nil))
(gnus-eval-format gnus-next-page-line-format nil
- `(gnus-next t local-map ,gnus-next-page-map
- gnus-callback
- gnus-article-button-next-page))))
+ `(gnus-next
+ t local-map ,gnus-next-page-map
+ gnus-callback gnus-article-button-next-page
+ gnus-type annotation))))
(defun gnus-article-button-next-page (arg)
"Go to the next page."