(defcustom gnus-ignored-headers
'("^Path:" "^Expires:" "^Date-Received:" "^References:" "^Xref:" "^Lines:"
- "^Relay-Version:" "^Message-ID:" "^Approved:" "^Sender:" "^Received:"
+ "^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-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:"
+ "^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:"
:group 'gnus-article-headers
:type 'hook)
+(defcustom gnus-display-mime-function 'gnus-display-mime
+ "Function to display MIME articles."
+ :group 'gnus-article-headers
+ :type 'function)
+
+(defvar gnus-decode-header-function 'mail-decode-encoded-word-region
+ "Function used to decode headers.")
+
;;; Internal variables
+(defvar gnus-article-mime-handle-alist nil)
(defvar article-lapsed-timer nil)
(defvar gnus-article-current-summary nil)
(process-send-region "article-x-face" beg end)
(process-send-eof "article-x-face"))))))))))
-(defun gnus-article-decode-rfc1522 ()
- "Decode MIME encoded-words in header fields."
+(defun 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)
+ (mail-decode-encoded-word-region (point-min) (point-max)))))
+
+(defun 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
+ (save-restriction
+ (message-narrow-to-head)
+ (let* ((inhibit-point-motion-hooks t)
+ (case-fold-search t)
+ (ct (message-fetch-field "Content-Type" t))
+ (cte (message-fetch-field "Content-Transfer-Encoding" t))
+ (ctl (and ct (condition-case ()
+ (mail-header-parse-content-type ct)
+ (error nil))))
+ (charset (cond
+ (prompt
+ (mm-read-coding-system "Charset to decode: "))
+ (ctl
+ (mail-content-type-get ctl 'charset))
+ (gnus-newsgroup-name
+ (gnus-group-find-parameter
+ gnus-newsgroup-name 'charset))))
+ buffer-read-only)
+ (goto-char (point-max))
+ (widen)
+ (forward-line 1)
+ (narrow-to-region (point) (point-max))
+ (when (or (not ct)
+ (equal (car ctl) "text/plain"))
+ (mm-decode-body
+ charset (and cte (intern (downcase
+ (gnus-strip-whitespace cte))))))))))
+
+(defun article-decode-encoded-words ()
+ "Remove encoded-word encoding from headers."
(let (buffer-read-only)
(let ((charset (save-excursion
(set-buffer gnus-summary-buffer)
(eword-decode-header charset)
)))
+(defun article-de-quoted-unreadable (&optional force)
+ "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 ((buffer-read-only nil)
+ (type (gnus-fetch-field "content-transfer-encoding")))
+ (when (or force
+ (and type (string-match "quoted-printable" (downcase type))))
+ (goto-char (point-min))
+ (search-forward "\n\n" nil 'move)
+ (quoted-printable-decode-region (point) (point-max))))))
+
+(defun article-mime-decode-quoted-printable-buffer ()
+ "Decode Quoted-Printable in the current buffer."
+ (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.
If given a negative prefix, always show; if given a positive prefix,
(goto-char (point-min))
(search-forward "\n\n" nil t)
(while (re-search-forward "^[ \t]+$" nil t)
- (replace-match "" nil t))
+ (unless (gnus-annotation-in-region-p
+ (match-beginning 0) (match-end 0))
+ (replace-match "" nil t)))
;; Then replace multiple empty lines with a single empty line.
(goto-char (point-min))
(search-forward "\n\n" nil 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)))))))
+ (walk-windows
+ (lambda (w)
+ (set-buffer (window-buffer w))
+ (when (eq major-mode 'gnus-article-mode)
+ (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.
(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)
(make-local-variable 'gnus-button-marker-list)
(make-local-variable 'gnus-article-current-summary)
(gnus-set-default-directory)
- (buffer-disable-undo (current-buffer))
+ (buffer-disable-undo)
(setq buffer-read-only t)
(set-syntax-table gnus-article-mode-syntax-table)
(gnus-run-hooks 'gnus-article-mode-hook))
(substring name (match-end 0))))))
(setq gnus-article-buffer name)
(setq gnus-original-article-buffer original)
+ (setq gnus-article-mime-handle-alist nil)
;; This might be a variable local to the summary buffer.
(unless gnus-single-article-buffer
(save-excursion
(if (get-buffer name)
(save-excursion
(set-buffer name)
- (buffer-disable-undo (current-buffer))
+ (buffer-disable-undo)
(setq buffer-read-only t)
(unless (eq major-mode 'gnus-article-mode)
(gnus-article-mode))
(or all-headers gnus-show-all-headers))))
(when (or (numberp article)
(stringp article))
- (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)
- ;; 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))
+ (gnus-article-prepare-display)
;; Do page break.
(goto-char (point-min))
(setq gnus-page-broken
(set-window-point (get-buffer-window (current-buffer)) (point))
t))))))
+(defun gnus-article-prepare-display ()
+ "Make the current buffer look like a nice article."
+ (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)
+ ;; 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)))
+
+;;;
+;;; Gnus MIME viewing functions
+;;;
+
+(defvar gnus-mime-button-line-format "%{%([%p. %t%d%n]%)%}\n"
+ "The following specs can be used:
+%t The MIME type
+%n The `name' parameter
+%d The description, if any
+%l The length of the encoded part
+%p The part identifier")
+
+(defvar gnus-mime-button-line-format-alist
+ '((?t gnus-tmp-type ?s)
+ (?n gnus-tmp-name ?s)
+ (?d gnus-tmp-description ?s)
+ (?p gnus-tmp-id ?s)
+ (?l gnus-tmp-length ?d)))
+
+(defvar gnus-mime-button-map nil)
+(unless gnus-mime-button-map
+ (setq gnus-mime-button-map (copy-keymap gnus-article-mode-map))
+ (define-key gnus-mime-button-map gnus-mouse-2 'gnus-article-push-button)
+ (define-key gnus-mime-button-map "\r" 'gnus-article-press-button)
+ (define-key gnus-mime-button-map "\M-\r" 'gnus-mime-view-part)
+ (define-key gnus-mime-button-map "v" 'gnus-mime-view-part)
+ (define-key gnus-mime-button-map "o" 'gnus-mime-save-part)
+ (define-key gnus-mime-button-map "c" 'gnus-mime-copy-part)
+ (define-key gnus-mime-button-map "i" 'gnus-mime-inline-part)
+ (define-key gnus-mime-button-map "|" 'gnus-mime-pipe-part))
+
+(defun gnus-mime-view-all-parts ()
+ "View all the MIME parts."
+ (interactive)
+ (let ((handles gnus-article-mime-handles))
+ (while handles
+ (mm-display-part (pop handles)))))
+
+(defun gnus-mime-save-part ()
+ "Save the MIME part under point."
+ (interactive)
+ (let ((data (get-text-property (point) 'gnus-data)))
+ (mm-save-part data)))
+
+(defun gnus-mime-pipe-part ()
+ "Pipe the MIME part under point to a process."
+ (interactive)
+ (let ((data (get-text-property (point) 'gnus-data)))
+ (mm-pipe-part data)))
+
+(defun gnus-mime-view-part ()
+ "Interactively choose a view method for the MIME part under point."
+ (interactive)
+ (let ((data (get-text-property (point) 'gnus-data))
+ (url-standalone-mode (not gnus-plugged)))
+ (mm-interactively-view-part data)))
+
+(defun gnus-mime-copy-part ()
+ "Put the the MIME part under point into a new buffer."
+ (interactive)
+ (let* ((data (get-text-property (point) 'gnus-data))
+ (contents (mm-get-part data)))
+ (switch-to-buffer (generate-new-buffer "*decoded*"))
+ (insert contents)
+ (goto-char (point-min))))
+
+(defun gnus-mime-inline-part ()
+ "Insert the MIME part under point into the current buffer."
+ (interactive)
+ (let* ((data (get-text-property (point) 'gnus-data))
+ (contents (mm-get-part data))
+ (url-standalone-mode (not gnus-plugged))
+ (b (point))
+ buffer-read-only)
+ (if (mm-handle-undisplayer data)
+ (mm-remove-part data)
+ (forward-line 2)
+ (mm-insert-inline data contents)
+ (goto-char b))))
+
+(defun gnus-article-view-part (n)
+ "View MIME part N, which is the numerical prefix."
+ (interactive "p")
+ (save-current-buffer
+ (set-buffer gnus-article-buffer)
+ (when (> n (length gnus-article-mime-handle-alist))
+ (error "No such part"))
+ (let ((handle (cdr (assq n gnus-article-mime-handle-alist))))
+ (gnus-article-goto-part n)
+ (mm-display-part handle))))
+
+(defun gnus-article-goto-part (n)
+ "Go to MIME part N."
+ (goto-char (text-property-any (point-min) (point-max) 'gnus-part n)))
+
+(defun gnus-insert-mime-button (handle)
+ (let ((gnus-tmp-name (mail-content-type-get (mm-handle-type handle) 'name))
+ (gnus-tmp-type (car (mm-handle-type handle)))
+ (gnus-tmp-description (mm-handle-description handle))
+ (gnus-tmp-length (save-excursion
+ (set-buffer (mm-handle-buffer handle))
+ (buffer-size)))
+ (gnus-tmp-id (1+ (length gnus-article-mime-handle-alist)))
+ b e)
+ (push (cons gnus-tmp-id handle) gnus-article-mime-handle-alist)
+ (setq gnus-tmp-name
+ (if gnus-tmp-name
+ (concat " (" gnus-tmp-name ")")
+ ""))
+ (setq gnus-tmp-description
+ (if gnus-tmp-description
+ (concat " (" gnus-tmp-description ")")
+ ""))
+ (setq b (point))
+ (gnus-eval-format
+ gnus-mime-button-line-format gnus-mime-button-line-format-alist
+ `(local-map ,gnus-mime-button-map
+ keymap ,gnus-mime-button-map
+ gnus-callback mm-display-part
+ gnus-part ,gnus-tmp-id
+ gnus-type annotation
+ gnus-data ,handle))
+ (setq e (point))
+ (widget-convert-button 'link from to :action 'gnus-widget-press-button
+ :button-keymap gnus-widget-button-keymap)))
+
+(defun gnus-widget-press-button (elems el)
+ (goto-char (widget-get elems :from))
+ (let ((url-standalone-mode (not gnus-plugged)))
+ (gnus-article-press-button)))
+
+(defun gnus-display-mime ()
+ "Insert MIME buttons in the buffer."
+ (let (ct ctl)
+ (save-restriction
+ (mail-narrow-to-head)
+ (when (setq ct (mail-fetch-field "content-type"))
+ (setq ctl (condition-case ()
+ (mail-header-parse-content-type ct) (error nil)))))
+ (let* ((handles (mm-dissect-buffer))
+ handle name type b e)
+ (mapcar 'mm-destroy-part gnus-article-mime-handles)
+ (setq gnus-article-mime-handles handles
+ gnus-article-mime-handle-alist nil)
+ (when handles
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (delete-region (point) (point-max))
+ (if (not (equal (car ctl) "multipart/alternative"))
+ (while (setq handle (pop handles))
+ (gnus-insert-mime-button handle)
+ (insert "\n\n")
+ (when (and (mm-automatic-display-p
+ (car (mm-handle-type handle)))
+ (mm-inlinable-part-p (car (mm-handle-type handle)))
+ (or (not (mm-handle-disposition handle))
+ (equal (car (mm-handle-disposition handle))
+ "inline")))
+ (forward-line -2)
+ (mm-display-part handle t)
+ (goto-char (point-max))))
+ ;; Here we have multipart/alternative
+ (gnus-mime-display-alternative handles))))))
+
+(defun gnus-mime-display-alternative (handles &optional preferred)
+ (let* ((preferred (mm-preferred-alternative handles preferred))
+ (ihandles handles)
+ handle buffer-read-only)
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (delete-region (point) (point-max))
+ (mapcar 'mm-remove-part gnus-article-mime-handles)
+ (setq gnus-article-mime-handles handles)
+ (while (setq handle (pop handles))
+ (gnus-add-text-properties
+ (point)
+ (progn
+ (insert (format "[%c] %-18s"
+ (if (equal handle preferred) ?* ? )
+ (car (mm-handle-type handle))))
+ (point))
+ `(local-map ,gnus-mime-button-map
+ ,gnus-mouse-face-prop ,gnus-article-mouse-face
+ face ,gnus-article-button-face
+ keymap ,gnus-mime-button-map
+ gnus-callback
+ (lambda (handles)
+ (gnus-mime-display-alternative
+ ',ihandles ,(car (mm-handle-type handle))))
+ gnus-data ,handle))
+ (insert " "))
+ (insert "\n\n")
+ (when preferred
+ (mm-display-part preferred))))
+
(defun gnus-article-wash-status ()
"Return a string which display status of article washing."
(save-excursion
(if (get-buffer 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))
+ (buffer-disable-undo)
(setq major-mode 'gnus-original-article-mode)
(setq buffer-read-only t))
(let (buffer-read-only)
(erase-buffer)
(insert-buffer-substring gnus-article-buffer))
- (setq gnus-original-article (cons group article))))
+ (setq gnus-original-article (cons group article)))
+
+ ;; Decode charsets.
+ (run-hooks 'gnus-article-decode-hook)
+ ;; Mark article as decoded or not.
+ (setq gnus-article-decoded-p gnus-article-decode-hook))
- ;; Decode charsets.
- (run-hooks 'gnus-article-decode-hook)
-
;; Update sparse articles.
(when (and do-update-line
(or (numberp article)
(setq gnus-original-article nil)))
(set-window-configuration winconf)
;; Tippy-toe some to make sure that point remains where it was.
- (let ((buf (current-buffer)))
+ (save-current-buffer
(set-buffer curbuf)
(set-window-start (get-buffer-window (current-buffer)) window-start)
- (goto-char p)
- (set-buffer buf)))))
+ (goto-char p)))))
(defun gnus-article-edit-full-stops ()
"Interactively repair spacing at end of sentences."
("\\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)
+ ("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)
projects / elisp / gnus.git- / blobdiff