(require 'gnus-spec)
(require 'gnus-int)
(require 'browse-url)
+(require 'mm-bodies)
(defgroup gnus-article nil
"Article display."
: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
: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
(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))
((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)
(process-send-region "article-x-face" beg end)
(process-send-eof "article-x-face"))))))))))
-(defun gnus-hack-decode-rfc1522 ()
- "Emergency hack function for avoiding problems when decoding."
- (let ((buffer-read-only nil))
- (goto-char (point-min))
- ;; Remove encoded TABs.
- (while (search-forward "=09" nil t)
- (replace-match " " t t))
- ;; Remove encoded newlines.
- (goto-char (point-min))
- (while (search-forward "=10" nil t)
- (replace-match " " t t))))
+(defun gnus-article-decode-mime-words ()
+ "Decode all MIME-encoded words in the article."
+ (interactive)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (let ((inhibit-point-motion-hooks t)
+ buffer-read-only)
+ (rfc2047-decode-region (point-min) (point-max)))))
+
+(defun gnus-article-decode-charset (&optional prompt)
+ "Decode charset-encoded text in the article.
+If PROMPT (the prefix), prompt for a coding system to use."
+ (interactive "P")
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (save-restriction
+ (message-narrow-to-head)
+ (let* ((inhibit-point-motion-hooks t)
+ (ct (message-fetch-field "Content-Type" t))
+ (cte (message-fetch-field "Content-Transfer-Encoding" t))
+ (charset (cond
+ (prompt
+ (mm-read-coding-system "Charset to decode: "))
+ (ct
+ (mm-content-type-charset ct))
+ (gnus-newsgroup-name
+ (gnus-group-find-parameter
+ gnus-newsgroup-name 'charset))))
+ buffer-read-only)
+ (goto-char (point-max))
+ (widen)
+ (narrow-to-region (point) (point-max))
+ (mm-decode-body
+ charset (and cte (intern (downcase (gnus-strip-whitespace cte)))))))))
(defalias 'gnus-decode-rfc1522 'article-decode-rfc1522)
(defalias 'gnus-article-decode-rfc1522 'article-decode-rfc1522)
(defun article-decode-rfc1522 ()
- "Hack to remove QP encoding from headers."
- (let ((case-fold-search t)
- (inhibit-point-motion-hooks t)
- (buffer-read-only nil)
- string)
+ "Remove QP encoding from headers."
+ (let ((inhibit-point-motion-hooks t)
+ (buffer-read-only nil))
(save-restriction
- (narrow-to-region
- (goto-char (point-min))
- (or (search-forward "\n\n" nil t) (point-max)))
- (goto-char (point-min))
- (while (re-search-forward
- "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t)
- (setq string (match-string 1))
- (save-restriction
- (narrow-to-region (match-beginning 0) (match-end 0))
- (delete-region (point-min) (point-max))
- (insert string)
- (article-mime-decode-quoted-printable
- (goto-char (point-min)) (point-max))
- (subst-char-in-region (point-min) (point-max) ?_ ? )
- (goto-char (point-max)))
- (goto-char (point-min))))))
+ (message-narrow-to-head)
+ (rfc2047-decode-region (point-min) (point-max)))))
(defun article-de-quoted-unreadable (&optional force)
- "Do a naive translation of a quoted-printable-encoded article.
-This is in no way, shape or form meant as a replacement for real MIME
-processing, but is simply a stop-gap measure until MIME support is
-written.
+ "Translate a quoted-printable-encoded article.
If FORCE, decode the article whether it is marked as quoted-printable
or not."
(interactive (list 'force))
(save-excursion
- (let ((case-fold-search t)
- (buffer-read-only nil)
+ (let ((buffer-read-only nil)
(type (gnus-fetch-field "content-transfer-encoding")))
(gnus-article-decode-rfc1522)
(when (or force
(and type (string-match "quoted-printable" (downcase type))))
(goto-char (point-min))
(search-forward "\n\n" nil 'move)
- (article-mime-decode-quoted-printable (point) (point-max))))))
+ (quoted-printable-decode-region (point) (point-max))))))
(defun article-mime-decode-quoted-printable-buffer ()
"Decode Quoted-Printable in the current buffer."
- (article-mime-decode-quoted-printable (point-min) (point-max)))
-
-(defun article-mime-decode-quoted-printable (from to)
- "Decode Quoted-Printable in the region between FROM and TO."
- (interactive "r")
- (goto-char from)
- (while (search-forward "=" to t)
- (cond ((eq (following-char) ?\n)
- (delete-char -1)
- (delete-char 1))
- ((looking-at "[0-9A-F][0-9A-F]")
- (subst-char-in-region
- (1- (point)) (point) ?=
- (hexl-hex-string-to-integer
- (buffer-substring (point) (+ 2 (point)))))
- (delete-char 2))
- ((looking-at "=")
- (delete-char 1))
- ((gnus-message 3 "Malformed MIME quoted-printable message")))))
+ (quoted-printable-decode-region (point-min) (point-max)))
(defun article-hide-pgp (&optional arg)
"Toggle hiding of any PGP headers and signatures in the current article.
(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
;; 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))))
+ (concat "Date: " (current-time-string (date-to-time date))))
;; Convert to Universal Time.
((eq type 'ut)
(concat "Date: "
- (condition-case ()
- (timezone-make-date-arpa-standard date nil "UT")
- (error date))))
+ (current-time-string
+ (let ((e (parse-time-string date)))
+ (setcar (last e) 0)
+ (encode-time e)))))
;; 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"))))
+ (funcall gnus-article-time-format (date-to-time date))
(concat
"Date: "
- (format-time-string gnus-article-time-format
- (ignore-errors
- (gnus-encode-date
- (timezone-make-date-arpa-standard
- date nil "UT")))))))
+ (format-time-string gnus-article-time-format (date-to-time date)))))
;; 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"))))))
+ (format-time-string "%Y%M%DT%h%m%s" (date-to-time date))))
;; 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-time (subtract-time now (date-to-time date)))
(real-sec (and real-time
(+ (* (float (car real-time)) 65536)
(cadr real-time))))
(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)
(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)
(buffer-disable-undo (current-buffer))
(setq buffer-read-only t)
(set-syntax-table gnus-article-mode-syntax-table)
+ (mm-enable-multibyte)
(gnus-run-hooks 'gnus-article-mode-hook))
(defun gnus-article-setup-buffer ()
(setq gnus-summary-buffer (current-buffer))
(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
;; Hooks for getting information from the article.
;; This hook must be called before being narrowed.
(let (buffer-read-only)
- (gnus-run-hooks 'internal-hook)
+ (gnus-run-hooks 'gnus-tmp-internal-hook)
(gnus-run-hooks 'gnus-article-prepare-hook)
;; Decode MIME message.
(when gnus-show-mime
(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.
(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
projects / gnus / blobdiff