:type 'regexp
:group 'gnus-article-various)
-(defcustom gnus-article-mode-line-format "Gnus: %g %S"
+(defcustom gnus-article-mode-line-format "Gnus: %g %S%m"
"*The format specification for the article mode line.
-See `gnus-summary-mode-line-format' for a closer description."
+See `gnus-summary-mode-line-format' for a closer description.
+
+The following additional specs are available:
+
+%w The article washing status.
+%m The number of MIME parts in the article."
:type 'string
:group 'gnus-article-various)
(defcustom gnus-display-mime-function 'gnus-display-mime
"Function to display MIME articles."
- :group 'gnus-article-headers
+ :group 'gnus-article-mime
:type 'function)
(defvar gnus-decode-header-function 'mail-decode-encoded-word-region
(defcustom gnus-ignored-mime-types nil
"List of MIME types that should be ignored by Gnus."
- :group 'gnus-mime
+ :group 'gnus-article-mime
+ :type '(repeat regexp))
+
+(defcustom gnus-unbuttonized-mime-types '(".*/.*")
+ "List of MIME types that should not be given buttons when rendered."
+ :group 'gnus-article-mime
:type '(repeat regexp))
(defcustom gnus-treat-body-highlight-signature t
(integer :tag "Less")
(sexp :tag "Predicate")))
+(defcustom gnus-article-mime-part-function nil
+ "Function called with a MIME handle as the argument."
+ :group 'gnus-article-mime
+ :type 'function)
+
;;; Internal variables
+(defvar gnus-article-mime-handle-alist-1 nil)
(defvar gnus-treatment-function-alist
'((gnus-treat-body-highlight-signature gnus-article-highlight-signature nil)
))
(defvar gnus-save-article-buffer nil)
(defvar gnus-article-mode-line-format-alist
- (nconc '((?w (gnus-article-wash-status) ?s))
+ (nconc '((?w (gnus-article-wash-status) ?s)
+ (?m (gnus-article-mime-part-status) ?s))
gnus-summary-mode-line-format-alist))
(defvar gnus-number-of-articles-to-be-saved nil)
(max (1- b) (point-min))
b 'intangible (cddr (memq 'intangible props)))))
+(defmacro gnus-with-article (article &rest forms)
+ "Select ARTICLE and perform FORMS in the original article buffer.
+Then replace the article with the result."
+ `(progn
+ ;; We don't want the article to be marked as read.
+ (let (gnus-mark-article-hook)
+ (gnus-summary-select-article t t nil ,article))
+ (set-buffer gnus-original-article-buffer)
+ ,@forms
+ (if (not (gnus-check-backend-function
+ 'request-replace-article (car gnus-article-current)))
+ (gnus-message 5 "Read-only group; not replacing")
+ (unless (gnus-request-replace-article
+ ,article (car gnus-article-current)
+ (current-buffer) t)
+ (error "Couldn't replace article")))
+ ;; The cache and backlog have to be flushed somewhat.
+ (when gnus-keep-backlog
+ (gnus-backlog-remove-article
+ (car gnus-article-current) (cdr gnus-article-current)))
+ (when gnus-use-cache
+ (gnus-cache-update-article
+ (car gnus-article-current) (cdr gnus-article-current)))))
+
+(put 'gnus-with-article 'lisp-indent-function 1)
+(put 'gnus-with-article 'edebug-form-spec '(form body))
+
(defsubst gnus-article-unhide-text (b e)
"Remove hidden text properties from region between B and E."
(remove-text-properties b e gnus-hidden-properties)
(point-max)))
'boring-headers))))
+(defvar gnus-article-normalized-header-length 40
+ "Length of normalized headers.")
+
+(defun article-normalize-headers ()
+ "Make all header lines 40 characters long."
+ (interactive)
+ (let ((buffer-read-only nil)
+ column)
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-head)
+ (while (not (eobp))
+ (cond
+ ((< (setq column (- (gnus-point-at-eol) (point)))
+ gnus-article-normalized-header-length)
+ (end-of-line)
+ (insert (make-string
+ (- gnus-article-normalized-header-length column)
+ ? )))
+ ((> column gnus-article-normalized-header-length)
+ (gnus-put-text-property
+ (progn
+ (forward-char gnus-article-normalized-header-length)
+ (point))
+ (gnus-point-at-eol)
+ 'invisible t))
+ (t
+ ;; Do nothing.
+ ))
+ (forward-line 1))))))
+
(defun article-treat-dumbquotes ()
- "Translate M******** sm*rtq**t*s into proper text."
+ "Translate M******** sm*rtq**t*s into proper text.
+Note that this function guesses whether a character is a sm*rtq**t* or
+not, so it should only be used interactively."
(interactive)
(article-translate-strings gnus-article-dumbquotes-map))
FROM is a string of characters to translate from; to is a string of
characters to translate to."
(save-excursion
- (goto-char (point-min))
- (when (search-forward "\n\n" nil t)
+ (when (article-goto-body)
(let ((buffer-read-only nil)
(x (make-string 225 ?x))
(i -1))
"Translate all string in the body of the article according to MAP.
MAP is an alist where the elements are on the form (\"from\" \"to\")."
(save-excursion
- (goto-char (point-min))
- (when (search-forward "\n\n" nil t)
+ (when (article-goto-body)
(let ((buffer-read-only nil)
elem)
(while (setq elem (pop map))
"Translate overstrikes into bold text."
(interactive)
(save-excursion
- (goto-char (point-min))
- (when (search-forward "\n\n" nil t)
+ (when (article-goto-body)
(let ((buffer-read-only nil))
(while (search-forward "\b" nil t)
(let ((next (char-after))
(save-excursion
(let ((buffer-read-only nil))
(widen)
- (goto-char (point-min))
- (search-forward "\n\n" nil t)
+ (article-goto-body)
(end-of-line 1)
(let ((paragraph-start "^[>|#:<;* ]*[ \t]*$")
(adaptive-fill-regexp "[ \t]*\\([|#:<;>*]+ *\\)?")
(save-excursion
(set-buffer gnus-article-buffer)
(let ((inhibit-point-motion-hooks t)
- buffer-read-only)
+ buffer-read-only
+ (rfc2047-default-charset gnus-newsgroup-default-charset)
+ (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced))
(mail-decode-encoded-word-region (point-min) (point-max)))))
(defun article-decode-charset (&optional prompt)
(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))))
+ (mail-content-type-get ctl 'charset))))
+ (rfc2047-default-charset gnus-newsgroup-default-charset)
+ (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced)
buffer-read-only)
- (when charset
- (setq charset (downcase charset)))
(goto-char (point-max))
(widen)
(forward-line 1)
(narrow-to-region (point) (point-max))
- (when (or (not ctl)
- (equal (car ctl) "text/plain"))
+ (when (and (or (not ctl)
+ (equal (car ctl) "text/plain"))
+ (not (mm-uu-test)))
(mm-decode-body
charset (and cte (intern (downcase
(gnus-strip-whitespace cte))))
(defun article-decode-encoded-words ()
"Remove encoded-word encoding from headers."
(let ((inhibit-point-motion-hooks t)
- (buffer-read-only nil))
+ (rfc2047-default-charset gnus-newsgroup-default-charset)
+ buffer-read-only)
(save-restriction
(message-narrow-to-head)
(funcall gnus-decode-header-function (point-min) (point-max)))))
(interactive (list 'force))
(save-excursion
(let ((buffer-read-only nil)
- (type (gnus-fetch-field "content-transfer-encoding")))
+ (type (gnus-fetch-field "content-transfer-encoding"))
+ (charset
+ (or gnus-newsgroup-default-charset mm-default-coding-system))
+ (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced))
(when (or force
(and type (string-match "quoted-printable" (downcase type))))
- (goto-char (point-min))
- (search-forward "\n\n" nil 'move)
+ (article-goto-body)
(save-restriction
(narrow-to-region (point) (point-max))
(quoted-printable-decode-region (point-min) (point-max))
- (when mm-default-coding-system
- (mm-decode-body mm-default-coding-system)))))))
+ (when charset
+ (mm-decode-body charset)))))))
(defun article-hide-pgp (&optional arg)
"Toggle hiding of any PGP headers and signatures in the current article.
(save-excursion
(let ((inhibit-point-motion-hooks t)
buffer-read-only)
- (goto-char (point-min))
- (when (search-forward "\n\n" nil t)
+ (when (article-goto-body)
(while (and (not (eobp))
(looking-at "[ \t]*$"))
(gnus-delete-line))))))
+(defun article-goto-body ()
+ "Place point at the start of the body."
+ (goto-char (point-min))
+ (if (search-forward "\n\n" nil t)
+ t
+ (goto-char (point-max))
+ nil))
+
(defun article-strip-multiple-blank-lines ()
"Replace consecutive blank lines with one empty line."
(interactive)
(let ((inhibit-point-motion-hooks t)
buffer-read-only)
;; First make all blank lines empty.
- (goto-char (point-min))
- (search-forward "\n\n" nil t)
+ (article-goto-body)
(while (re-search-forward "^[ \t]+$" 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)
+ (article-goto-body)
(while (re-search-forward "\n\n\n+" nil t)
(unless (gnus-annotation-in-region-p
(match-beginning 0) (match-end 0))
(save-excursion
(let ((inhibit-point-motion-hooks t)
buffer-read-only)
- (goto-char (point-min))
- (search-forward "\n\n" nil t)
+ (article-goto-body)
(while (re-search-forward "^[ \t]+" nil t)
(replace-match "" t t)))))
+(defun article-strip-trailing-space ()
+ "Remove all white space from the end of the lines in the article."
+ (interactive)
+ (save-excursion
+ (let ((inhibit-point-motion-hooks t)
+ buffer-read-only)
+ (article-goto-body)
+ (while (re-search-forward "[ \t]+$" nil t)
+ (replace-match "" t t)))))
+
(defun article-strip-blank-lines ()
"Strip leading, trailing and multiple blank lines."
(interactive)
(save-excursion
(let ((inhibit-point-motion-hooks t)
buffer-read-only)
- (goto-char (point-min))
- (search-forward "\n\n" nil t)
+ (article-goto-body)
(while (re-search-forward "^[ \t]*\n" nil t)
(replace-match "" t t)))))
(props (append '(article-type emphasis)
gnus-hidden-properties))
regexp elem beg invisible visible face)
- (goto-char (point-min))
- (search-forward "\n\n" nil t)
+ (article-goto-body)
(setq beg (point))
(while (setq elem (pop alist))
(goto-char beg)
(save-excursion
(save-restriction
(widen)
- (goto-char (point-min))
- (when (search-forward "\n\n" nil t)
+ (when (article-goto-body)
(narrow-to-region (point) (point-max)))
(gnus-output-to-file filename))))
filename)
article-strip-leading-blank-lines
article-strip-multiple-blank-lines
article-strip-leading-space
+ article-strip-trailing-space
article-strip-blank-lines
article-strip-all-blank-lines
article-date-local
article-date-lapsed
article-emphasize
article-treat-dumbquotes
+ article-normalize-headers
(article-show-all . gnus-article-show-all-headers))))
\f
;;;
(gnus-configure-windows 'summary)
(gnus-configure-windows 'article))
(gnus-set-global-variables))
- (gnus-set-mode-line 'article))
+ (let ((gnus-article-mime-handle-alist-1
+ gnus-article-mime-handle-alist))
+ (gnus-set-mode-line 'article)))
;; The result from the `request' was an actual article -
;; or at least some text that is now displayed in the
;; article buffer.
(when gnus-break-pages
(gnus-narrow-to-page)
t)))
- (gnus-set-mode-line 'article)
+ (let ((gnus-article-mime-handle-alist-1
+ gnus-article-mime-handle-alist))
+ (gnus-set-mode-line 'article))
(gnus-configure-windows 'article)
- (goto-char (point-min))
- (search-forward "\n\n" nil t)
+ (article-goto-body)
(set-window-point (get-buffer-window (current-buffer)) (point))
t))))))
(gnus-run-hooks 'gnus-tmp-internal-hook)
(gnus-run-hooks 'gnus-article-prepare-hook)
(when gnus-display-mime-function
+ (mm-setup-w3)
(let ((url-standalone-mode (not gnus-plugged)))
(funcall gnus-display-mime-function)))
;; Perform the article display hooks.
;;; Gnus MIME viewing functions
;;;
-(defvar gnus-mime-button-line-format "%{%([%p. %t%d%n]%)%}%e\n"
+(defvar gnus-mime-button-line-format "%{%([%p. %d%T]%)%}%e\n"
"The following specs can be used:
%t The MIME type
+%T MIME type, along with additional info
%n The `name' parameter
%d The description, if any
%l The length of the encoded part
-%p The part identifier
+%p The part identifier number
%e Dots if the part isn't displayed")
(defvar gnus-mime-button-line-format-alist
'((?t gnus-tmp-type ?s)
+ (?T gnus-tmp-type-long ?s)
(?n gnus-tmp-name ?s)
(?d gnus-tmp-description ?s)
(?p gnus-tmp-id ?s)
(defvar gnus-mime-button-commands
'((gnus-article-press-button "\r" "Toggle Display")
- ;(gnus-mime-view-part "\M-\r" "View Interactively...")
(gnus-mime-view-part "v" "View Interactively...")
(gnus-mime-save-part "o" "Save...")
- (gnus-mime-copy-part "c" "View In Buffer")
- (gnus-mime-inline-part "i" "View Inline")
+ (gnus-mime-copy-part "c" "View As Text, In Other Buffer")
+ (gnus-mime-inline-part "i" "View As Text, In This Buffer")
+ (gnus-mime-internalize-part "E" "View Internally")
+ (gnus-mime-externalize-part "e" "View Externally")
(gnus-mime-pipe-part "|" "Pipe To Command...")))
+(defun gnus-article-mime-part-status ()
+ (if gnus-article-mime-handle-alist-1
+ (format " (%d parts)" (length gnus-article-mime-handle-alist-1))
+ ""))
+
(defvar gnus-mime-button-map nil)
(unless gnus-mime-button-map
(setq gnus-mime-button-map (make-sparse-keymap))
(defun gnus-mime-button-menu (event)
"Construct a context-sensitive menu of MIME commands."
(interactive "e")
+ (gnus-article-check-buffer)
(let ((response (x-popup-menu
t `("MIME Part"
("" ,@(mapcar (lambda (c)
(goto-char (posn-point pos))
(funcall response))))
-(defun gnus-mime-view-all-parts ()
+(defun gnus-mime-view-all-parts (&optional handles)
"View all the MIME parts."
(interactive)
- (let ((handles gnus-article-mime-handles))
- (while handles
- (mm-display-part (pop handles)))))
+ (save-current-buffer
+ (set-buffer gnus-article-buffer)
+ (let ((handles (or handles gnus-article-mime-handles))
+ (rfc2047-default-charset gnus-newsgroup-default-charset)
+ (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced))
+ (if (stringp (car handles))
+ (gnus-mime-view-all-parts (cdr handles))
+ (mapcar 'mm-display-part handles)))))
(defun gnus-mime-save-part ()
"Save the MIME part under point."
(interactive)
+ (gnus-article-check-buffer)
(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)
+ (gnus-article-check-buffer)
(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)
+ (gnus-article-check-buffer)
+ (mm-setup-w3)
(let ((data (get-text-property (point) 'gnus-data))
(url-standalone-mode (not gnus-plugged)))
(mm-interactively-view-part data)))
-(defun gnus-mime-copy-part ()
+(defun gnus-mime-copy-part (&optional handle)
"Put the the MIME part under point into a new buffer."
(interactive)
- (let* ((handle (get-text-property (point) 'gnus-data))
- (contents (mm-get-part handle))
- (buffer (generate-new-buffer
- (file-name-nondirectory
- (or
- (mail-content-type-get (mm-handle-type handle) 'name)
- (mail-content-type-get (mm-handle-type handle)
- 'filename)
- "*decoded*")))))
+ (gnus-article-check-buffer)
+ (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
+ (contents (mm-get-part handle))|
+ (base (file-name-nondirectory
+ (or
+ (mail-content-type-get (mm-handle-type handle) 'name)
+ (mail-content-type-get (mm-handle-type handle)
+ 'filename)
+ "*decoded*")))
+ (buffer (generate-new-buffer base)))
(switch-to-buffer buffer)
(insert contents)
- (normal-mode)
+ ;; We do it this way to make `normal-mode' set the appropriate mode.
+ (unwind-protect
+ (progn
+ (setq buffer-file-name (expand-file-name base))
+ (normal-mode))
+ (setq buffer-file-name nil))
(goto-char (point-min))))
-(defun gnus-mime-inline-part ()
+(defun gnus-mime-inline-part (&optional charset)
"Insert the MIME part under point into the current buffer."
- (interactive)
+ (interactive "P") ; For compatibility reasons we are not using "z".
+ (gnus-article-check-buffer)
+ (mm-setup-w3)
(let* ((data (get-text-property (point) 'gnus-data))
- (contents (mm-get-part data))
+ contents
(url-standalone-mode (not gnus-plugged))
(b (point))
buffer-read-only)
(if (mm-handle-undisplayer data)
(mm-remove-part data)
+ (setq contents (mm-get-part data))
(forward-line 2)
+ (when charset
+ (unless (symbolp charset)
+ (setq charset (mm-read-coding-system "Charset: ")))
+ (setq contents (mm-decode-coding-string contents charset)))
(mm-insert-inline data contents)
(goto-char b))))
+(defun gnus-mime-externalize-part (&optional handle)
+ "View the MIME part under point with an external viewer."
+ (interactive)
+ (gnus-article-check-buffer)
+ (mm-setup-w3)
+ (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
+ (url-standalone-mode (not gnus-plugged))
+ (mm-user-display-methods nil)
+ (mm-all-images-fit t)
+ (rfc2047-default-charset gnus-newsgroup-default-charset)
+ (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced))
+ (if (mm-handle-undisplayer handle)
+ (mm-remove-part handle)
+ (mm-display-part handle))))
+
+(defun gnus-mime-internalize-part (&optional handle)
+ "View the MIME part under point with an internal viewer."
+ (interactive)
+ (gnus-article-check-buffer)
+ (mm-setup-w3)
+ (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
+ (url-standalone-mode (not gnus-plugged))
+ (mm-user-display-methods '((".*" . inline)))
+ (mm-all-images-fit t)
+ (rfc2047-default-charset gnus-newsgroup-default-charset)
+ (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced))
+ (if (mm-handle-undisplayer handle)
+ (mm-remove-part handle)
+ (mm-display-part handle))))
+
+(defun gnus-article-part-wrapper (n function)
+ (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))))
+ (funcall function handle))))
+
+(defun gnus-article-pipe-part (n)
+ "Pipe MIME part N, which is the numerical prefix."
+ (interactive "p")
+ (gnus-article-part-wrapper n 'mm-pipe-part))
+
+(defun gnus-article-save-part (n)
+ "Save MIME part N, which is the numerical prefix."
+ (interactive "p")
+ (gnus-article-part-wrapper n 'mm-save-part))
+
+(defun gnus-article-interactively-view-part (n)
+ "Pipe MIME part N, which is the numerical prefix."
+ (interactive "p")
+ (gnus-article-part-wrapper n 'mm-interactively-view-part))
+
+(defun gnus-article-copy-part (n)
+ "Pipe MIME part N, which is the numerical prefix."
+ (interactive "p")
+ (gnus-article-part-wrapper n 'gnus-mime-copy-part))
+
+(defun gnus-article-externalize-part (n)
+ "Pipe MIME part N, which is the numerical prefix."
+ (interactive "p")
+ (gnus-article-part-wrapper n 'gnus-mime-externalize-part))
+
(defun gnus-article-view-part (n)
"View MIME part N, which is the numerical prefix."
(interactive "p")
(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)
- (if (equal (car handle) "multipart/alternative")
- (gnus-article-press-button)
- (when (eq (gnus-mm-display-part handle) 'internal)
- (gnus-set-window-start))))))
+ (when (gnus-article-goto-part n)
+ (if (equal (car handle) "multipart/alternative")
+ (gnus-article-press-button)
+ (when (eq (gnus-mm-display-part handle) 'internal)
+ (gnus-set-window-start)))))))
(defun gnus-mm-display-part (handle)
"Display HANDLE and fix MIME button."
(gnus-insert-mime-button
handle id (list (not (mm-handle-displayed-p handle))))
(prog1
- (mm-display-part handle)
+ (let ((window (selected-window))
+ (rfc2047-default-charset gnus-newsgroup-default-charset)
+ (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced))
+ (save-excursion
+ (unwind-protect
+ (let ((win (get-buffer-window (current-buffer) t)))
+ (if win
+ (select-window win))
+ (goto-char point)
+ (forward-line)
+ (mm-display-part handle))
+ (select-window window))))
(goto-char point))))
(defun gnus-article-goto-part (n)
"Go to MIME part N."
- (goto-char (text-property-any (point-min) (point-max) 'gnus-part n)))
+ (let ((point (text-property-any (point-min) (point-max) 'gnus-part n)))
+ (when point
+ (goto-char point))))
(defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed)
- (let ((gnus-tmp-name (mail-content-type-get (mm-handle-type handle) 'name))
+ (let ((gnus-tmp-name
+ (or (mail-content-type-get (mm-handle-type handle)
+ 'name)
+ (mail-content-type-get (mm-handle-disposition handle)
+ 'filename)
+ ""))
(gnus-tmp-type (car (mm-handle-type handle)))
- (gnus-tmp-description (mm-handle-description handle))
+ (gnus-tmp-description (or (mm-handle-description handle)
+ ""))
(gnus-tmp-dots
(if (if displayed (car displayed)
(mm-handle-displayed-p handle))
"" "..."))
- (gnus-tmp-length (save-excursion
- (set-buffer (mm-handle-buffer handle))
+ (gnus-tmp-length (with-current-buffer (mm-handle-buffer handle)
(buffer-size)))
- b e)
- (setq gnus-tmp-name
- (if gnus-tmp-name
- (concat " (" gnus-tmp-name ")")
- ""))
- (setq gnus-tmp-description
- (if gnus-tmp-description
- (concat " (" gnus-tmp-description ")")
- ""))
+ gnus-tmp-type-long b e)
+ (when (string-match ".*/" gnus-tmp-name)
+ (setq gnus-tmp-name (replace-match "" t t gnus-tmp-name)))
+ (setq gnus-tmp-type-long (concat gnus-tmp-type
+ (and (not (equal gnus-tmp-name ""))
+ (concat "; " gnus-tmp-name))))
+ (or (equal gnus-tmp-description "")
+ (setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long)))
+ (unless (bolp)
+ (insert "\n"))
(setq b (point))
(gnus-eval-format
gnus-mime-button-line-format gnus-mime-button-line-format-alist
article-type annotation
gnus-data ,handle))
(setq e (point))
- (widget-convert-button 'link b e :action 'gnus-widget-press-button
- :button-keymap gnus-mime-button-map)))
+ (widget-convert-button 'link b e
+ :mime-handle handle
+ :action 'gnus-widget-press-button
+ :button-keymap gnus-mime-button-map
+ :help-echo
+ (lambda (widget)
+ ;; Needed to properly clear the message
+ ;; due to a bug in wid-edit
+ (setq help-echo-owns-message t)
+ (format
+ "Click to %s the MIME part; %s for more options"
+ (if (mm-handle-displayed-p
+ (widget-get widget :mime-handle))
+ "hide" "show")
+ (if gnus-xemacs "button3" "mouse-3"))))))
(defun gnus-widget-press-button (elems el)
(goto-char (widget-get elems :from))
+ (mm-setup-w3)
(let ((url-standalone-mode (not gnus-plugged)))
(gnus-article-press-button)))
(defun gnus-display-mime (&optional ihandles)
"Insert MIME buttons in the buffer."
- (let* ((handles (or ihandles (mm-dissect-buffer) (mm-uu-dissect)))
- handle name type b e display)
- (when handles
- (unless ihandles
- ;; Top-level call; we clean up.
- (mm-destroy-parts gnus-article-mime-handles)
- (setq gnus-article-mime-handles handles
- gnus-article-mime-handle-alist nil)
- (goto-char (point-min))
- (search-forward "\n\n" nil t)
- (delete-region (point) (point-max)))
- (if (stringp (car handles))
- (if (equal (car handles) "multipart/alternative")
- (gnus-mime-display-alternative (cdr handles))
- (gnus-mime-display-mixed (cdr handles)))
- (gnus-mime-display-single handles)))))
+ (save-excursion
+ (save-selected-window
+ (let ((window (get-buffer-window gnus-article-buffer))
+ (point (point)))
+ (when window
+ (select-window window)
+ ;; We have to do this since selecting the window
+ ;; may change the point. So we set the window point.
+ (set-window-point window point)))
+ (let* ((handles (or ihandles (mm-dissect-buffer) (mm-uu-dissect)))
+ handle name type b e display)
+ (unless ihandles
+ ;; Top-level call; we clean up.
+ (mm-destroy-parts gnus-article-mime-handles)
+ (setq gnus-article-mime-handles handles
+ gnus-article-mime-handle-alist nil)
+ ;; We allow users to glean info from the handles.
+ (when gnus-article-mime-part-function
+ (gnus-mime-part-function handles)))
+ (when (and handles
+ (or (not (stringp (car handles)))
+ (cdr handles)))
+ (unless ihandles
+ ;; Clean up for mime parts.
+ (article-goto-body)
+ (delete-region (point) (point-max)))
+ (gnus-mime-display-part handles))))))
+
+(defun gnus-mime-display-part (handle)
+ (cond
+ ;; Single part.
+ ((not (stringp (car handle)))
+ (gnus-mime-display-single handle))
+ ;; multipart/alternative
+ ((equal (car handle) "multipart/alternative")
+ (let ((id (1+ (length gnus-article-mime-handle-alist))))
+ (push (cons id handle) gnus-article-mime-handle-alist)
+ (gnus-mime-display-alternative (cdr handle) nil nil id)))
+ ;; multipart/related
+ ((equal (car handle) "multipart/related")
+ ;;;!!!We should find the start part, but we just default
+ ;;;!!!to the first part.
+ (gnus-mime-display-part (cadr handle)))
+ ;; Other multiparts are handled like multipart/mixed.
+ (t
+ (gnus-mime-display-mixed (cdr handle)))))
+
+(defun gnus-mime-part-function (handles)
+ (if (stringp (car handles))
+ (mapcar 'gnus-mime-part-function (cdr handles))
+ (funcall gnus-article-mime-part-function handles)))
(defun gnus-mime-display-mixed (handles)
- (let (handle)
- (while (setq handle (pop handles))
- (if (stringp (car handle))
- (if (equal (car handle) "multipart/alternative")
- (let ((id (1+ (length gnus-article-mime-handle-alist))))
- (push (cons id handle) gnus-article-mime-handle-alist)
- (gnus-mime-display-alternative (cdr handle) nil nil id))
- (gnus-mime-display-mixed (cdr handle)))
- (gnus-mime-display-single handle)))))
+ (mapcar 'gnus-mime-display-part handles))
(defun gnus-mime-display-single (handle)
(let ((type (car (mm-handle-type handle)))
(ignored gnus-ignored-mime-types)
+ (not-attachment t)
+ (move nil)
display text)
(catch 'ignored
(progn
(while ignored
(when (string-match (pop ignored) type)
(throw 'ignored nil)))
- (if (and (mm-automatic-display-p type)
- (mm-inlinable-part-p type)
- (or (not (mm-handle-disposition handle))
- (equal (car (mm-handle-disposition handle))
- "inline")))
+ (if (and (setq not-attachment
+ (or (not (mm-handle-disposition handle))
+ (equal (car (mm-handle-disposition handle))
+ "inline")))
+ (mm-automatic-display-p type)
+ (or (mm-inlinable-part-p type)
+ (mm-automatic-external-display-p type)))
(setq display t)
(when (equal (car (split-string type "/"))
"text")
(setq text t)))
(let ((id (1+ (length gnus-article-mime-handle-alist))))
(push (cons id handle) gnus-article-mime-handle-alist)
- (gnus-insert-mime-button handle id (list (or display text))))
- (insert "\n\n")
+ (when (or (not display)
+ (not (gnus-unbuttonized-mime-type-p type)))
+ (gnus-article-insert-newline)
+ (gnus-insert-mime-button
+ handle id (list (or display
+ (and not-attachment text))))
+ (gnus-article-insert-newline)
+ (gnus-article-insert-newline)
+ (setq move t)))
(cond
(display
- (forward-line -2)
- (mm-display-part handle t)
+ (when move
+ (forward-line -2))
+ (let ((rfc2047-default-charset gnus-newsgroup-default-charset)
+ (mm-charset-iso-8859-1-forced
+ gnus-newsgroup-iso-8859-1-forced))
+ (mm-display-part handle t))
(goto-char (point-max)))
- (text
- (forward-line -2)
- (insert "\n")
+ ((and text not-attachment)
+ (when move
+ (forward-line -2))
+ (gnus-article-insert-newline)
(mm-insert-inline handle (mm-get-part handle))
(goto-char (point-max))))))))
+(defun gnus-unbuttonized-mime-type-p (type)
+ "Say whether TYPE is to be unbuttonized."
+ (unless gnus-inhibit-mime-unbuttonizing
+ (catch 'found
+ (let ((types gnus-unbuttonized-mime-types))
+ (while types
+ (when (string-match (pop types) type)
+ (throw 'found t)))))))
+
+(defun gnus-article-insert-newline ()
+ "Insert a newline, but mark it as undeletable."
+ (gnus-put-text-property
+ (point) (progn (insert "\n") (point)) 'gnus-undeletable t))
+
(defun gnus-mime-display-alternative (handles &optional preferred ibegend id)
- (let* ((preferred (mm-preferred-alternative handles preferred))
+ (let* ((preferred (or preferred (mm-preferred-alternative handles)))
(ihandles handles)
(point (point))
handle buffer-read-only from props begend not-pref)
- (save-restriction
- (when ibegend
- (narrow-to-region (car ibegend) (cdr ibegend))
- (delete-region (point-min) (point-max))
- (mm-remove-parts handles))
- (setq begend (list (point-marker)))
- ;; Do the toggle.
- (unless (setq not-pref (cadr (member preferred ihandles)))
- (setq not-pref (car ihandles)))
- (gnus-add-text-properties
- (setq from (point))
- (progn
- (insert (format "%d. " id))
- (point))
- `(gnus-callback
- (lambda (handles)
- (gnus-mime-display-alternative
- ',ihandles ,(if (stringp (car not-pref))
- (car not-pref)
- (car (mm-handle-type not-pref)))
- ',begend ,id))
- 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-part ,id
- gnus-data ,handle))
- (widget-convert-button 'link from (point)
- :action 'gnus-widget-press-button
- :button-keymap gnus-widget-button-keymap)
- ;; Do the handles
- (while (setq handle (pop handles))
- (gnus-add-text-properties
- (setq from (point))
- (progn
- (insert (format "[%c] %-18s"
- (if (equal handle preferred) ?* ? )
- (if (stringp (car handle))
- (car handle)
- (car (mm-handle-type handle)))))
- (point))
- `(gnus-callback
- (lambda (handles)
- (gnus-mime-display-alternative
- ',ihandles ,(if (stringp (car handle))
- (car handle)
- (car (mm-handle-type handle)))
- ',begend ,id))
- 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-part ,id
- gnus-data ,handle))
- (widget-convert-button 'link from (point)
- :action 'gnus-widget-press-button
- :button-keymap gnus-widget-button-keymap)
- (insert " "))
- (insert "\n\n")
- (when preferred
- (if (stringp (car preferred))
- (gnus-display-mime preferred)
- (mm-display-part preferred)
+ (save-window-excursion
+ (save-restriction
+ (when ibegend
+ (narrow-to-region (car ibegend)
+ (or (cdr ibegend)
+ (progn
+ (goto-char (car ibegend))
+ (forward-line 2)
+ (point))))
+ (delete-region (point-min) (point-max))
+ (mm-remove-parts handles))
+ (setq begend (list (point-marker)))
+ ;; Do the toggle.
+ (unless (setq not-pref (cadr (member preferred ihandles)))
+ (setq not-pref (car ihandles)))
+ (when (or ibegend
+ (not (gnus-unbuttonized-mime-type-p
+ "multipart/alternative")))
+ (gnus-add-text-properties
+ (setq from (point))
+ (progn
+ (insert (format "%d. " id))
+ (point))
+ `(gnus-callback
+ (lambda (handles)
+ (unless ,(not ibegend)
+ (setq gnus-article-mime-handle-alist
+ ',gnus-article-mime-handle-alist))
+ (gnus-mime-display-alternative
+ ',ihandles ',not-pref ',begend ,id))
+ 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-part ,id
+ gnus-data ,handle))
+ (widget-convert-button 'link from (point)
+ :action 'gnus-widget-press-button
+ :button-keymap gnus-widget-button-keymap)
+ ;; Do the handles
+ (while (setq handle (pop handles))
+ (gnus-add-text-properties
+ (setq from (point))
+ (progn
+ (insert (format "(%c) %-18s"
+ (if (equal handle preferred) ?* ? )
+ (if (stringp (car handle))
+ (car handle)
+ (car (mm-handle-type handle)))))
+ (point))
+ `(gnus-callback
+ (lambda (handles)
+ (unless ,(not ibegend)
+ (setq gnus-article-mime-handle-alist
+ ',gnus-article-mime-handle-alist))
+ (gnus-mime-display-alternative
+ ',ihandles ',handle ',begend ,id))
+ 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-part ,id
+ gnus-data ,handle))
+ (widget-convert-button 'link from (point)
+ :action 'gnus-widget-press-button
+ :button-keymap gnus-widget-button-keymap)
+ (insert " "))
+ (insert "\n\n"))
+ (when preferred
+ (if (stringp (car preferred))
+ (gnus-display-mime preferred)
+ (let ((rfc2047-default-charset gnus-newsgroup-default-charset)
+ (mm-charset-iso-8859-1-forced
+ gnus-newsgroup-iso-8859-1-forced))
+ (mm-display-part preferred)))
(goto-char (point-max))
(setcdr begend (point-marker)))))
(when ibegend
(setq func (lookup-key (current-local-map) (this-command-keys)))
(call-interactively func)))
+(defun gnus-article-check-buffer ()
+ "Beep if not in an article buffer."
+ (unless (equal major-mode 'gnus-article-mode)
+ (error "Command invoked outside of a Gnus article buffer")))
+
(defun gnus-article-read-summary-keys (&optional arg key not-restore-window)
"Read a summary buffer key sequence and execute it from the article buffer."
(interactive "P")
+ (gnus-article-check-buffer)
(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"
(save-excursion
(save-restriction
(widen)
- (goto-char (point-min))
- (when (search-forward "\n\n" nil 1)
+ (when (article-goto-body)
(let ((lines (count-lines (point) (point-max)))
(length (- (point-max) (point)))
(case-fold-search t)
:type 'regexp)
(defcustom gnus-button-alist
- `(("<\\(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)
+ `(("<\\(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:[>\n\t ]*\\)?news:[>\n\t ]*\\(//\\)?\\([^>\n\t ]*\\)>\\)"
1 t
gnus-button-fetch-group 4)
'gnus-callback nil))
(set-marker marker nil)))
;; We skip the headers.
- (goto-char (point-min))
- (unless (search-forward "\n\n" nil t)
- (goto-char (point-max)))
+ (article-goto-body)
(setq beg (point))
(while (setq entry (pop alist))
(setq regexp (car entry))
(select-window win)))
(defvar gnus-decode-header-methods
- '(mail-decode-encoded-word-region)
- "List of methods used to decode headers
+ '(gnus-decode-with-mail-decode-encoded-word-region)
+ "List of methods used to decode headers.
This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item is
FUNCTION, FUNCTION will be apply to all newsgroups. If item is a
(defvar gnus-decode-header-methods-cache nil)
+(defun gnus-decode-with-mail-decode-encoded-word-region (start end)
+ (let ((rfc2047-default-charset gnus-newsgroup-default-charset)
+ (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced))
+ (mail-decode-encoded-word-region start end)))
+
(defun gnus-multi-decode-header (start end)
"Apply the functions from `gnus-encoded-word-methods' that match."
(unless (and gnus-decode-header-methods-cache
projects / elisp / gnus.git- / blobdiff