;;; gnus-art.el --- article mode commands for Semi-gnus
;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Keywords: mail, news, MIME
:group 'gnus-article)
(defcustom gnus-ignored-headers
- '("^Path:" "^Posting-Version:" "^Article-I.D.:" "^Expires:"
- "^Date-Received:" "^References:" "^Control:" "^Xref:" "^Lines:"
- "^Posted:" "^Relay-Version:" "^Message-ID:" "^Nf-ID:" "^Nf-From:"
- "^Approved:" "^Sender:" "^Received:" "^Mail-from:")
+ '("^Path:" "^Expires:" "^Date-Received:" "^References:" "^Xref:" "^Lines:"
+ "^Relay-Version:" "^Message-ID:" "^Approved:" "^Sender:" "^Received:"
+ "^X-UIDL:" "^MIME-Version:" "^Return-Path:" "^In-Reply-To:"
+ "^Content-Type:" "^Content-Transfer-Encoding:" "^X-WebTV-Signature:"
+ "^X-MimeOLE:" "^X-MSMail-Priority:" "^X-Priority:" "^X-Loop:"
+ "^X-Authentication-Warning:" "^X-MIME-Autoconverted:" "^X-Face:"
+ "^X-Attribution:" "^X-Originating-IP:" "^Delivered-To:"
+ "^NNTP-[-A-Za-z]+:" "^Distribution:" "^X-no-archive:" "^X-Trace:"
+ "^X-Complaints-To:" "^X-NNTP-Posting-Host:" "^X-Orig.*:"
+ "^Abuse-Reports-To:" "^Cache-Post-Path:" "^X-Article-Creation-Date:"
+ "^X-Poster:" "^X-Mail2News-Path:" "^X-Server-Date:" "^X-Cache:"
+ "^Originator:" "^X-Problems-To:" "^X-Auth-User:" "^X-Post-Time:"
+ "^X-Admin:" "^X-UID:" "^Resent-[-A-Za-z]+:" "^X-Mailing-List:"
+ "^Precedence:" "^Original-[-A-Za-z]+:" "^X-filename:" "^X-Orcpt:"
+ "^Old-Received:" "^X-Pgp-Fingerprint:" "^X-Pgp-Key-Id:"
+ "^X-Pgp-Public-Key-Url:" "^X-Auth:" "^X-From-Line:"
+ "^X-Gnus-Article-Number:" "^X-Majordomo:" "^X-Url:" "^X-Sender:"
+ "^X-Mailing-List:" "^MBOX-Line" "^Priority:" "^X-Pgp" "^X400-[-A-Za-z]+:"
+ "^Status:")
"*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."
: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:\\|X-Sent:"
+ "From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^\\(Mail-\\)?Followup-To:\\|^\\(Mail-\\)?Reply-To:\\|^Mail-Copies-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-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."
:group 'gnus-article-hiding)
(defcustom gnus-boring-article-headers '(empty followup-to reply-to)
- "*Headers that are only to be displayed if they have interesting data.
+ "Headers that are only to be displayed if they have interesting data.
Possible values in this list are `empty', `newsgroups', `followup-to',
`reply-to', `date', `long-to', and `many-to'."
:type '(set (const :tag "Headers with no content." empty)
:group 'gnus-article-hiding)
(defcustom gnus-signature-separator '("^-- $" "^-- *$")
- "*Regexp matching signature separator.
+ "Regexp matching signature separator.
This can also be a list of regexps. In that case, it will be checked
from head to tail looking for a separator. Searches will be done from
the end of the buffer."
:group 'gnus-article-signature)
(defcustom gnus-signature-limit nil
- "*Provide a limit to what is considered a signature.
+ "Provide a limit to what is considered a signature.
If it is a number, no signature may not be longer (in characters) than
that number. If it is a floating point number, no signature may be
longer (in lines) than that number. If it is a function, the function
:group 'gnus-article-signature)
(defcustom gnus-hidden-properties '(invisible t intangible t)
- "*Property list to use for hiding text."
+ "Property list to use for hiding text."
:type 'sexp
:group 'gnus-article-hiding)
:group 'gnus-article-washing)
(defcustom gnus-article-x-face-too-ugly nil
- "*Regexp matching posters whose face shouldn't be shown automatically."
+ "Regexp matching posters whose face shouldn't be shown automatically."
:type '(choice regexp (const nil))
:group 'gnus-article-washing)
(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.
Each item looks like this:
:group 'gnus-article-emphasis)
(defcustom gnus-article-time-format "%a, %b %d %Y %T %Z"
- "*Format for display of Date headers in article bodies.
+ "Format for display of Date headers in article bodies.
See `format-time-string' for the possible values.
The variable can also be function, which should return a complete Date
:group 'gnus-article-washing)
(eval-and-compile
- (autoload 'hexl-hex-string-to-integer "hexl")
- (autoload 'timezone-make-date-arpa-standard "timezone")
(autoload 'mail-extract-address-components "mail-extr"))
(defcustom gnus-save-all-headers 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.
+ "Headers to keep if `gnus-save-all-headers' is nil.
If `gnus-save-all-headers' is non-nil, this variable will be ignored.
If that variable is nil, however, all headers that match this regexp
will be kept while the rest will be deleted before saving."
:type 'regexp)
(defcustom gnus-default-article-saver 'gnus-summary-save-in-rmail
- "*A function to save articles in your favourite format.
+ "A function to save articles in your favourite format.
The function must be interactively callable (in other words, it must
be an Emacs command).
(function-item gnus-summary-write-to-file)))
(defcustom gnus-rmail-save-name 'gnus-plain-save-name
- "*A function generating a file name to save articles in Rmail format.
+ "A function generating a file name to save articles in Rmail format.
The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE."
:group 'gnus-article-saving
:type 'function)
(defcustom gnus-mail-save-name 'gnus-plain-save-name
- "*A function generating a file name to save articles in Unix mail format.
+ "A function generating a file name to save articles in Unix mail format.
The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE."
:group 'gnus-article-saving
:type 'function)
(defcustom gnus-folder-save-name 'gnus-folder-save-name
- "*A function generating a file name to save articles in MH folder.
+ "A function generating a file name to save articles in MH folder.
The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER."
:group 'gnus-article-saving
:type 'function)
(defcustom gnus-file-save-name 'gnus-numeric-save-name
- "*A function generating a file name to save articles in article format.
+ "A function generating a file name to save articles in article format.
The function is called with NEWSGROUP, HEADERS, and optional
LAST-FILE."
:group 'gnus-article-saving
(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."
+(defcustom gnus-article-display-method-for-mime
+ 'gnus-article-display-mime-message
+ "Function to display a MIME message.
+The function is called from the article buffer."
:group 'gnus-article-mime
- :type 'boolean)
+ :type 'function)
-(defcustom gnus-show-mime-method 'gnus-article-preview-mime-message
- "*Function to process a MIME message.
+(defcustom gnus-article-display-method-for-encoded-word
+ 'gnus-article-display-message-with-encoded-word
+ "*Function to display a message with MIME encoded-words.
The function is called from the article buffer."
:group 'gnus-article-mime
:type 'function)
-(defcustom gnus-decode-encoded-word-method 'gnus-article-decode-encoded-word
- "*Function to decode MIME encoded words.
+(defcustom gnus-article-display-method-for-traditional
+ 'gnus-article-display-traditional-message
+ "*Function to display a traditional message.
The function is called from the article buffer."
:group 'gnus-article-mime
:type 'function)
:type 'regexp
:group 'gnus-article-various)
-(defcustom gnus-article-mode-line-format "Gnus: %%b %S"
+(defcustom gnus-article-mode-line-format "Gnus: %g %S"
"*The format specification for the article mode line.
See `gnus-summary-mode-line-format' for a closer description."
:type 'string
:group 'gnus-article-various)
(defcustom gnus-article-button-face 'bold
- "*Face used for highlighting buttons in the article buffer.
+ "Face used for highlighting buttons in the article buffer.
An article button is a piece of text that you can activate by pressing
`RET' or `mouse-2' above it."
:group 'gnus-article-buttons)
(defcustom gnus-article-mouse-face 'highlight
- "*Face used for mouse highlighting in the article buffer.
+ "Face used for mouse highlighting in the article buffer.
Article buttons will be displayed in this face when the cursor is
above them."
:group 'gnus-article-buttons)
(defcustom gnus-signature-face 'gnus-signature-face
- "*Face used for highlighting a signature in the article buffer.
+ "Face used for highlighting a signature in the article buffer.
Obsolete; use the face `gnus-signature-face' for customizations instead."
:type 'face
:group 'gnus-article-highlight
(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)
(item :tag "skip" nil)
(face :value default)))))
+(defcustom gnus-article-decode-hook nil
+ "*Hook run to decode charsets in articles."
+ :group 'gnus-article-headers
+ :type 'hook)
+
;;; Internal variables
(defvar article-lapsed-timer nil)
b e (cons 'article-type (cons type gnus-hidden-properties))))
(defun gnus-article-unhide-text-type (b e type)
- "Hide text of TYPE between B and E."
+ "Unhide text of TYPE between B and E."
(remove-text-properties
b e (cons 'article-type (cons type gnus-hidden-properties)))
(when (memq 'intangible gnus-hidden-properties)
(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)))
(listp gnus-visible-headers))
(mapconcat 'identity gnus-visible-headers "\\|"))))
(inhibit-point-motion-hooks t)
- want-list beg)
+ beg)
;; First we narrow to just the headers.
(widen)
(goto-char (point-min))
from reply-to
(ignore-errors
(equal
- (nth 1 (mail-extract-address-components from))
- (nth 1 (mail-extract-address-components reply-to)))))
+ (nth 1 (funcall gnus-extract-address-components from))
+ (nth 1 (funcall gnus-extract-address-components reply-to)))))
(gnus-article-hide-header "reply-to"))))
((eq elem 'date)
(let ((date (message-fetch-field "date")))
(when (and date
- (< (gnus-days-between (current-time-string) date)
+ (< (days-between (current-time-string) date)
4))
(gnus-article-hide-header "date"))))
((eq elem 'long-to)
(defun article-treat-dumbquotes ()
"Translate M******** sm*rtq**t*s into proper text."
(interactive)
- (article-translate-characters "\221\222\223\223" "`'\"\""))
+ (article-translate-characters "\221\222\223\224" "`'\"\""))
(defun article-translate-characters (from to)
"Translate all characters in the body of the article according to FROM and TO.
(point)
(progn
(while (and (not (bobp))
- (looking-at "^[ \t]*$"))
+ (looking-at "^[ \t]*$")
+ (not (gnus-annotation-in-region-p
+ (point) (gnus-point-at-eol))))
(forward-line -1))
(forward-line 1)
(point))))))
(delete-process "article-x-face"))
(let ((inhibit-point-motion-hooks t)
(case-fold-search t)
- from)
+ from last)
(save-restriction
(nnheader-narrow-to-headers)
(setq from (message-fetch-field "from"))
(goto-char (point-min))
(while (and gnus-article-x-face-command
+ (not last)
(or force
;; Check whether this face is censored.
(not 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' above), 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 (stringp gnus-article-x-face-command)
+ (setq last t))
;; We now have the area of the buffer where the X-Face is stored.
(save-excursion
(let ((beg (point))
(defun gnus-article-decode-rfc1522 ()
"Decode MIME encoded-words in header fields."
(let (buffer-read-only)
- (eword-decode-header)
- ))
+ (let ((charset (save-excursion
+ (set-buffer gnus-summary-buffer)
+ default-mime-charset)))
+ (eword-decode-header charset)
+ )))
(defun article-hide-pgp (&optional arg)
"Toggle hiding of any PGP headers and signatures in the current article.
(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))
(gnus-run-hooks 'gnus-article-hide-pgp-hook))))))
(goto-char (point-min))
(search-forward "\n\n" nil t)
(while (re-search-forward "\n\n\n+" nil t)
- (replace-match "\n\n" t t)))))
+ (unless (gnus-annotation-in-region-p
+ (match-beginning 0) (match-end 0))
+ (replace-match "\n\n" t t))))))
(defun article-strip-leading-space ()
"Remove all white space from the beginning of the lines in the article."
(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 (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.
(setq b (point))
(point-max))
(setq e (point-max)))
- (nnheader-temp-write nil
+ (with-temp-buffer
(insert-buffer-substring gnus-article-buffer b e)
(require 'url)
(save-window-excursion
(defun gnus-article-hidden-text-p (type)
"Say whether the current buffer contains hidden text of type TYPE."
- (let ((start (point-min))
- (pos (text-property-any (point-min) (point-max) 'article-type type)))
+ (let ((pos (text-property-any (point-min) (point-max) 'article-type type)))
(while (and pos
(not (get-text-property pos 'invisible)))
(setq pos
(defun article-make-date-line (date type)
"Return a DATE line of TYPE."
- (cond
- ;; Convert to the local timezone. We have to slap a
- ;; `condition-case' round the calls to the timezone
- ;; functions since they aren't particularly resistant to
- ;; buggy dates.
- ((eq type 'local)
- (concat "Date: " (condition-case ()
- (timezone-make-date-arpa-standard date)
- (error date))))
- ;; Convert to Universal Time.
- ((eq type 'ut)
- (concat "Date: "
- (condition-case ()
- (timezone-make-date-arpa-standard date nil "UT")
- (error date))))
- ;; Get the original date from the article.
- ((eq type 'original)
- (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"))))
+ (let ((time (condition-case ()
+ (date-to-time date)
+ (error '(0 0)))))
+ (cond
+ ;; Convert to the local timezone. We have to slap a
+ ;; `condition-case' round the calls to the timezone
+ ;; functions since they aren't particularly resistant to
+ ;; buggy dates.
+ ((eq type 'local)
+ (let ((tz (car (current-time-zone))))
+ (format "Date: %s %s%04d" (current-time-string time)
+ (if (> tz 0) "+" "-") (abs (/ tz 36)))))
+ ;; Convert to Universal Time.
+ ((eq type 'ut)
+ (concat "Date: "
+ (current-time-string
+ (let* ((e (parse-time-string date))
+ (tm (apply 'encode-time e))
+ (ms (car tm))
+ (ls (- (cadr tm) (car (current-time-zone)))))
+ (cond ((< ls 0) (list (1- ms) (+ ls 65536)))
+ ((> ls 65535) (list (1+ ms) (- ls 65536)))
+ (t (list ms ls)))))
+ " UT"))
+ ;; Get the original date from the article.
+ ((eq type 'original)
+ (concat "Date: " (if (string-match "\n+$" date)
+ (substring date 0 (match-beginning 0))
+ date)))
+ ;; Let the user define the format.
+ ((eq type 'user)
+ (if (gnus-functionp gnus-article-time-format)
+ (funcall gnus-article-time-format time)
+ (concat
+ "Date: "
+ (format-time-string gnus-article-time-format time))))
+ ;; ISO 8601.
+ ((eq type 'iso8601)
(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 "%Y%M%DT%h%m%s"
- (ignore-errors
- (gnus-encode-date
- (timezone-make-date-arpa-standard
- date nil "UT"))))))
- ;; Do an X-Sent lapsed format.
- ((eq type 'lapsed)
- ;; If the date is seriously mangled, the timezone functions are
- ;; liable to bug out, so we ignore all errors.
- (let* ((now (current-time))
- (real-time
- (ignore-errors
- (gnus-time-minus
- (gnus-encode-date
- (timezone-make-date-arpa-standard
- (current-time-string now)
- (current-time-zone now) "UT"))
- (gnus-encode-date
- (timezone-make-date-arpa-standard
- date nil "UT")))))
- (real-sec (and real-time
- (+ (* (float (car real-time)) 65536)
- (cadr real-time))))
- (sec (and real-time (abs real-sec)))
- num prev)
- (cond
- ((null real-time)
- "X-Sent: Unknown")
- ((zerop sec)
- "X-Sent: Now")
- (t
- (concat
- "X-Sent: "
- ;; This is a bit convoluted, but basically we go
- ;; through the time units for years, weeks, etc,
- ;; and divide things to see whether that results
- ;; in positive answers.
- (mapconcat
- (lambda (unit)
- (if (zerop (setq num (ffloor (/ sec (cdr unit)))))
- ;; The (remaining) seconds are too few to
- ;; be divided into this time unit.
- ""
- ;; It's big enough, so we output it.
- (setq sec (- sec (* num (cdr unit))))
- (prog1
- (concat (if prev ", " "") (int-to-string
- (floor num))
- " " (symbol-name (car unit))
- (if (> num 1) "s" ""))
- (setq prev t))))
- article-time-units "")
- ;; If dates are odd, then it might appear like the
- ;; article was sent in the future.
- (if (> real-sec 0)
- " ago"
- " in the future"))))))
- (t
- (error "Unknown conversion type: %s" type))))
+ (format-time-string "%Y%M%DT%h%m%s" time)))
+ ;; Do an X-Sent lapsed format.
+ ((eq type 'lapsed)
+ ;; If the date is seriously mangled, the timezone functions are
+ ;; liable to bug out, so we ignore all errors.
+ (let* ((now (current-time))
+ (real-time (subtract-time now time))
+ (real-sec (and real-time
+ (+ (* (float (car real-time)) 65536)
+ (cadr real-time))))
+ (sec (and real-time (abs real-sec)))
+ num prev)
+ (cond
+ ((null real-time)
+ "X-Sent: Unknown")
+ ((zerop sec)
+ "X-Sent: Now")
+ (t
+ (concat
+ "X-Sent: "
+ ;; This is a bit convoluted, but basically we go
+ ;; through the time units for years, weeks, etc,
+ ;; and divide things to see whether that results
+ ;; in positive answers.
+ (mapconcat
+ (lambda (unit)
+ (if (zerop (setq num (ffloor (/ sec (cdr unit)))))
+ ;; The (remaining) seconds are too few to
+ ;; be divided into this time unit.
+ ""
+ ;; It's big enough, so we output it.
+ (setq sec (- sec (* num (cdr unit))))
+ (prog1
+ (concat (if prev ", " "") (int-to-string
+ (floor num))
+ " " (symbol-name (car unit))
+ (if (> num 1) "s" ""))
+ (setq prev t))))
+ article-time-units "")
+ ;; If dates are odd, then it might appear like the
+ ;; article was sent in the future.
+ (if (> real-sec 0)
+ " ago"
+ " in the future"))))))
+ (t
+ (error "Unknown conversion type: %s" type)))))
(defun article-date-local (&optional highlight)
"Convert the current article date to the local timezone."
(defun article-update-date-lapsed ()
"Function to be run from a timer to update the lapsed time line."
- (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))))))
+ (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.
(unless n
(setq n 1))
(gnus-stop-date-timer)
- (setq article-lapsed-timer
+ (setq article-lapsed-timer
(nnheader-run-at-time 1 n 'article-update-date-lapsed)))
(defun gnus-stop-date-timer ()
(if (not gnus-default-article-saver)
(error "No default saver is defined")
;; !!! Magic! The saving functions all save
- ;; `gnus-original-article-buffer' (or so they think), but we
+ ;; `gnus-save-article-buffer' (or so they think), but we
;; bind that variable to our save-buffer.
(set-buffer gnus-article-buffer)
(let* ((gnus-save-article-buffer save-buffer)
"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))))
+ (rmail-output-to-rmail-file 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
(widen)
(if (and (file-readable-p filename)
(mail-file-babyl-p filename))
- (gnus-output-to-rmail filename t)
+ (rmail-output-to-rmail-file filename t)
(gnus-output-to-mail filename)))))
filename)
"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
"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
(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-fill . gnus-article-word-wrap)
article-remove-cr
article-display-x-face
- article-de-quoted-unreadable
- article-mime-decode-quoted-printable
article-hide-pgp
article-hide-pem
article-hide-signature
["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 ""
["Hide signature" gnus-article-hide-signature t]
["Hide citation" gnus-article-hide-citation t]
["Treat overstrike" gnus-article-treat-overstrike t]
- ["Remove carriage return" gnus-article-remove-cr t]
- ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t]))
+ ["Remove carriage return" gnus-article-remove-cr 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]
(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)
- (set (make-local-variable 'gnus-article-current-summary) 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)
(gnus-set-global-variables)))
;; Init original article buffer.
(save-excursion
- (set-buffer (get-buffer-create gnus-original-article-buffer))
- (buffer-disable-undo (current-buffer))
+ (set-buffer (gnus-get-buffer-create gnus-original-article-buffer))
(setq major-mode 'gnus-original-article-mode)
- (gnus-add-current-to-buffer-list)
(make-local-variable 'gnus-original-article))
(if (get-buffer name)
(save-excursion
(set-buffer name)
(buffer-disable-undo (current-buffer))
(setq buffer-read-only t)
- (gnus-add-current-to-buffer-list)
(unless (eq major-mode 'gnus-article-mode)
(gnus-article-mode))
(current-buffer))
(save-excursion
- (set-buffer (get-buffer-create name))
- (gnus-add-current-to-buffer-list)
+ (set-buffer (gnus-get-buffer-create name))
(gnus-article-mode)
(make-local-variable 'gnus-summary-buffer)
(current-buffer)))))
;;; @@ article filters
;;;
-(defun gnus-article-preview-mime-message ()
+
+(defun gnus-article-display-mime-message ()
+ "Article display method for MIME message."
+ ;; called from `gnus-original-article-buffer'.
+ (let ((default-mime-charset (save-excursion
+ (set-buffer gnus-summary-buffer)
+ default-mime-charset)))
+ (mime-display-message mime-message-structure
+ gnus-article-buffer nil gnus-article-mode-map))
+ ;; `mime-display-message' changes current buffer to `gnus-article-buffer'.
(make-local-variable 'mime-button-mother-dispatcher)
(setq mime-button-mother-dispatcher
(function gnus-article-push-button))
- (let ((default-mime-charset
- (save-excursion
- (set-buffer gnus-summary-buffer)
- default-mime-charset))
- )
- (save-excursion
- (mime-view-mode nil nil nil gnus-original-article-buffer
- gnus-article-buffer
- gnus-article-mode-map)
- ))
- (run-hooks 'gnus-mime-article-prepare-hook)
- )
+ (run-hooks 'gnus-mime-article-prepare-hook))
-(defun gnus-article-decode-encoded-word ()
- "Header filter for gnus-article-mode.
-It is registered to variable `mime-view-content-header-filter-alist'."
- (goto-char (point-min))
+(defun gnus-article-display-traditional-message ()
+ "Article display method for traditional message."
+ (set-buffer gnus-article-buffer)
+ (let (buffer-read-only)
+ (erase-buffer)
+ (insert-buffer-substring gnus-original-article-buffer)))
+
+(defun gnus-article-display-message-with-encoded-word ()
+ "Article display method for message with encoded-words."
(let ((charset (save-excursion
(set-buffer gnus-summary-buffer)
default-mime-charset)))
- (save-restriction
- (std11-narrow-to-header)
+ (gnus-article-display-traditional-message)
+ (let (buffer-read-only)
+ (eword-decode-header charset)
(goto-char (point-min))
- (while (re-search-forward "^[^ \t:]+:" nil t)
- (let ((start (match-beginning 0))
- (end (std11-field-end))
- )
- (save-restriction
- (narrow-to-region start end)
- (decode-mime-charset-region start end charset)
- (goto-char (point-max))
- )))
- (eword-decode-header)
- )
- (decode-mime-charset-region (point) (point-max) charset)
- (mime-maybe-hide-echo-buffer)
- )
- (run-hooks 'gnus-mime-article-prepare-hook)
- )
+ (if (search-forward "\n\n" nil t)
+ (decode-mime-charset-region (match-end 0) (point-max) charset)))
+ (mime-maybe-hide-echo-buffer))
+ (gnus-run-hooks 'gnus-mime-article-prepare-hook))
(defun gnus-article-prepare (article &optional all-headers header)
"Prepare ARTICLE in article mode 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)
+ (gnus-tmp-internal-hook gnus-article-internal-prepare-hook)
(group gnus-newsgroup-name)
result)
(save-excursion
(gnus-article-setup-buffer)
- (set-buffer gnus-article-buffer)
+ (set-buffer gnus-original-article-buffer)
;; Deactivate active regions.
(when (and (boundp 'transient-mark-mode)
transient-mark-mode)
(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 (or (eq result 'pseudo) (eq result 'nneething))
+ (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
(set-buffer summary-buffer)
(unless (vectorp gnus-current-headers)
(setq gnus-current-headers nil))
(gnus-summary-goto-subject gnus-current-article)
- (gnus-summary-show-thread)
+ (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)
;; <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)
- (gnus-run-hooks 'internal-hook)
+ (let ((method
+ (if gnus-show-mime
+ (progn
+ (mime-parse-buffer)
+ gnus-article-display-method-for-mime)
+ gnus-article-display-method-for-traditional)))
+ ;; Hooks for getting information from the article.
+ ;; This hook must be called before being narrowed.
+ (gnus-run-hooks 'gnus-tmp-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)
- (funcall gnus-decode-encoded-word-method)))
+ ;; Display message.
+ (funcall method)
+ ;; Associate this article with the current summary buffer.
+ (setq gnus-article-current-summary summary-buffer)
;; Perform the article display hooks.
(gnus-run-hooks 'gnus-article-display-hook))
;; Do page break.
(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)
(defun gnus-output-to-file (file-name)
"Append the current article to a file named FILE-NAME."
(let ((artbuf (current-buffer)))
- (nnheader-temp-write nil
+ (with-temp-buffer
(insert-buffer-substring artbuf)
;; Append newline at end of the buffer as separator, and then
;; save it to file.
(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."
"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"))
+ '("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)
+ keys new-sum-point)
(save-excursion
(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-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))
- (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-article-current-summary 'norecord)
- (switch-to-buffer gnus-article-current-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)))
- (call-interactively func)
- (ding))
- (when (eq in-buffer (current-buffer))
- (set-buffer obuf)
- (unless not-restore-window
- (set-window-configuration owin))
- (unless (member keys up-to-top)
+ (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)))))))
+ 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))
- ()
- (let ((dir (concat (file-name-as-directory (nth 1 method))
- (mail-header-subject header))))
+ (when (and (eq (car method) 'nneething)
+ (vectorp header))
+ (let ((dir (concat
+ (file-name-as-directory
+ (or (cadr (assq 'nneething-address method))
+ (nth 1 method)))
+ (mail-header-subject header))))
(when (file-directory-p dir)
(setq article 'nneething)
(gnus-group-enter-directory 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)))
gnus-canceled-mark))
nil)
- ;; We first check `gnus-original-article-buffer'.
- ((and (get-buffer gnus-original-article-buffer)
- (numberp article)
- (save-excursion
- (set-buffer gnus-original-article-buffer)
- (and (equal (car gnus-original-article) group)
- (eq (cdr gnus-original-article) article))))
- (insert-buffer-substring gnus-original-article-buffer)
- 'article)
;; Check the backlog.
((and gnus-keep-backlog
(gnus-backlog-request-article group article (current-buffer)))
(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)
;; 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)
(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 (get-buffer-create gnus-original-article-buffer))
+ (set-buffer gnus-original-article-buffer)
+ (set-buffer (gnus-get-buffer-create gnus-original-article-buffer))
(buffer-disable-undo (current-buffer))
(setq major-mode 'gnus-original-article-mode)
- (setq buffer-read-only t)
- (gnus-add-current-to-buffer-list))
+ (setq buffer-read-only t))
(let (buffer-read-only)
(erase-buffer)
(insert-buffer-substring gnus-article-buffer))
(setq gnus-original-article (cons group article))))
+ ;; Decode charsets.
+ (run-hooks 'gnus-article-decode-hook)
+
;; Update sparse articles.
(when (and do-update-line
(or (numberp article)
(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))
;;;
(defcustom gnus-article-edit-mode-hook nil
- "*Hook run in article edit mode buffers."
+ "Hook run in article edit mode buffers."
:group 'gnus-article-various
:type 'hook)
\\{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)
(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)
;;; Internal Variables:
(defcustom gnus-button-url-regexp "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?\\([-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,]\\|\\w\\)+\\([-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)"
- "*Regular expression that matches URLs."
+ "Regular expression that matches URLs."
:group 'gnus-article-buttons
: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\\| +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)
(let* ((pos (posn-point (event-start event)))
(data (get-text-property pos 'gnus-data))
(fun (get-text-property pos 'gnus-callback)))
+ (goto-char pos)
(when fun
(funcall fun data))))
(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 "&"))
+ (setq pairs (split-string query "&"))
(while pairs
(setq cur (car pairs)
pairs (cdr pairs))
;; Send mail to someone
(when (string-match "mailto:/*\\(.*\\)" url)
(setq url (substring url (match-beginning 1) nil)))
- (let (to args source-url subject func)
+ (let (to args subject func)
(if (string-match (regexp-quote "?") url)
(setq to (gnus-url-unhex-string (substring url 0 (match-beginning 0)))
args (gnus-url-parse-query-string
(setq to (gnus-url-unhex-string url)))
(setq args (cons (list "to" to) args)
subject (cdr-safe (assoc "subject" args)))
- (message-mail)
- (while args
- (setq func (intern-soft (concat "message-goto-" (downcase (caar args)))))
- (if (fboundp func)
- (funcall func)
- (message-position-on-field (caar args)))
- (insert (mapconcat 'identity (cdar args) ", "))
- (setq args (cdr args)))
- (if subject
- (message-goto-body)
- (message-goto-subject))))
+ (gnus-setup-message 'reply
+ (message-mail)
+ (while args
+ (setq func (intern-soft (concat "message-goto-" (downcase (caar args)))))
+ (if (fboundp func)
+ (funcall func)
+ (message-position-on-field (caar args)))
+ (insert (mapconcat 'identity (cdar args) ", "))
+ (setq args (cdr args)))
+ (if subject
+ (message-goto-body)
+ (message-goto-subject)))))
(defun gnus-button-mailto (address)
;; Mail to ADDRESS.
(set-buffer (gnus-copy-article-buffer))
- (message-reply address))
+ (gnus-setup-message 'reply
+ (message-reply address)))
(defun gnus-button-reply (address)
;; Reply to ADDRESS.
- (message-reply address))
+ (gnus-setup-message 'reply
+ (message-reply address)))
(defun gnus-button-url (address)
"Browse ADDRESS."
(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."
;;; @ for mime-view
;;;
-(defun gnus-content-header-filter ()
- "Header filter for mime-view.
-It is registered to variable `mime-view-content-header-filter-alist'."
- (goto-char (point-min))
- (while (re-search-forward "^[^ \t:]+:" nil t)
- (let ((start (match-beginning 0))
- (end (std11-field-end))
- )
- (save-restriction
- (narrow-to-region start end)
- (decode-mime-charset-region start end default-mime-charset)
- (goto-char (point-max))
- )))
- (eword-decode-header)
+(defun gnus-article-header-presentation-method (entity situation)
+ (mime-insert-decoded-header entity)
)
-(defun mime-view-quitting-method-for-gnus ()
- (if (not gnus-show-mime)
- (mime-view-kill-buffer))
- (delete-other-windows)
- (gnus-article-show-summary)
- (if (or (not gnus-show-mime)
- (null gnus-have-all-headers))
- (gnus-summary-select-article nil t)
- ))
-
-(set-alist 'mime-view-content-header-filter-alist
+(set-alist 'mime-header-presentation-method-alist
'gnus-original-article-mode
- (function gnus-content-header-filter))
+ #'gnus-article-header-presentation-method)
+
+(defun gnus-mime-preview-quitting-method ()
+ (if gnus-show-mime
+ (gnus-article-show-summary)
+ (mime-preview-kill-buffer)
+ (delete-other-windows)
+ (gnus-article-show-summary)
+ (gnus-summary-select-article nil t)
+ ))
-(set-alist 'mime-text-decoder-alist
- 'gnus-original-article-mode
- (function mime-text-decode-buffer))
+(set-alist 'mime-preview-quitting-method-alist
+ 'gnus-original-article-mode #'gnus-mime-preview-quitting-method)
-(set-alist 'mime-view-quitting-method-alist
- 'gnus-original-article-mode
- (function mime-view-quitting-method-for-gnus))
+(defun gnus-following-method (buf)
+ (set-buffer buf)
+ (message-followup)
+ (message-yank-original)
+ (kill-buffer buf)
+ (goto-char (point-min))
+ )
-(set-alist 'mime-view-show-summary-method
- 'gnus-original-article-mode
- (function mime-view-quitting-method-for-gnus))
+(set-alist 'mime-preview-following-method-alist
+ 'gnus-original-article-mode #'gnus-following-method)
;;; @ end