:group 'gnus-article-mime
:type 'boolean)
-(defcustom gnus-mime-recompute-hierarchical-structure nil
- "Non-nil means recompute article's hierarchical MIME structure.
-The hierarchy numbers will be displayed in MIME buttons."
- :group 'gnus-article-mime
- :type 'boolean)
-
(defcustom gnus-body-boundary-delimiter "_"
"String used to delimit header and body.
This variable is used by `gnus-article-treat-body-boundary' which can
:type 'function)
(defcustom gnus-mime-multipart-functions nil
- "An alist of MIME types to functions to display them.
-Consider using `gnus-mime-accumulate-hierarchy' for each MIME handle
-when defining your function. For example:
-
-\(setq gnus-mime-multipart-functions
- (list (cons \"multipart/examples\"
- (lambda (handles)
- (dolist (handle (cdr handles))
- (gnus-mime-accumulate-hierarchy handle)
- (function-to-display-an-example handle))))))"
+ "An alist of MIME types to functions to display them."
:version "21.1"
:group 'gnus-article-mime
:type '(repeat (cons :format "%v" (string :tag "MIME type") function)))
(defvar gnus-article-mime-handle-alist nil)
(defvar article-lapsed-timer nil)
(defvar gnus-article-current-summary nil)
-(defvar gnus-article-mime-hierarchy nil)
-(defvar gnus-article-mime-hierarchy-next nil)
(defvar gnus-article-mode-syntax-table
(let ((table (copy-syntax-table text-mode-syntax-table)))
(save-restriction
(mail-narrow-to-head)
(while (gnus-article-goto-header "Face")
- (push (mail-header-field-value) faces))))
+ (setq faces (nconc faces (list (mail-header-field-value)))))))
(while (setq face (pop faces))
(let ((png (gnus-convert-face-to-png face))
image)
(article-really-strip-banner
(gnus-parameter-banner gnus-newsgroup-name)))
(when gnus-article-address-banner-alist
- (article-really-strip-banner
- (let ((from (save-restriction
- (widen)
- (article-narrow-to-head)
- (mail-fetch-field "from"))))
- (when (and from
- (setq from
- (caar (mail-header-parse-addresses from))))
- (catch 'found
- (dolist (pair gnus-article-address-banner-alist)
- (when (string-match (car pair) from)
- (throw 'found (cdr pair)))))))))))))
+ ;; It is necessary to encode from fields before checking,
+ ;; because `mail-header-parse-addresses' does not work
+ ;; (reliably) on decoded headers. And more, it is
+ ;; impossible to use `gnus-fetch-original-field' here,
+ ;; because `article-strip-banner' may be called in draft
+ ;; buffers to preview them.
+ (let ((from (save-restriction
+ (widen)
+ (article-narrow-to-head)
+ (mail-fetch-field "from"))))
+ (when (and from
+ (setq from
+ (caar (mail-header-parse-addresses
+ (mail-encode-encoded-word-string from)))))
+ (catch 'found
+ (dolist (pair gnus-article-address-banner-alist)
+ (when (string-match (car pair) from)
+ (throw 'found
+ (article-really-strip-banner (cdr pair)))))))))))))
(defun article-really-strip-banner (banner)
"Strip the banner specified by the argument."
(make-local-variable 'gnus-article-image-alist)
(make-local-variable 'gnus-article-charset)
(make-local-variable 'gnus-article-ignored-charsets)
- (make-local-variable 'gnus-article-mime-hierarchy)
(gnus-set-default-directory)
(buffer-disable-undo)
(setq buffer-read-only t)
(setq gnus-article-buffer name)
(setq gnus-original-article-buffer original)
(setq gnus-article-mime-handle-alist nil)
- (setq gnus-article-mime-hierarchy nil
- gnus-article-mime-hierarchy-next nil)
;; This might be a variable local to the summary buffer.
(unless gnus-single-article-buffer
(save-excursion
(setq gnus-article-mime-handles nil))
;; Set it to nil in article-buffer!
(setq gnus-article-mime-handle-alist nil)
- (setq gnus-article-mime-hierarchy nil)
(buffer-disable-undo)
(setq buffer-read-only t)
;; This list just keeps growing if we don't reset it.
(or (mail-content-type-get (mm-handle-disposition data) 'filename)
none))
(type (mm-handle-media-type data)))
+ (unless data
+ (error "No MIME part under point"))
(with-current-buffer (mm-handle-buffer data)
(let ((bsize (format "%s" (buffer-size))))
(erase-buffer)
(setq b (point))
(gnus-eval-format
gnus-mime-button-line-format gnus-mime-button-line-format-alist
- (prog1
- `(keymap ,gnus-mime-button-map
- gnus-callback gnus-mm-display-part
- gnus-part ,gnus-tmp-id
- article-type annotation
- gnus-data ,handle)
- (when gnus-mime-recompute-hierarchical-structure
- (setq gnus-tmp-id (mapconcat 'number-to-string
- (car (nth (1- gnus-tmp-id)
- gnus-article-mime-hierarchy))
- ".")))))
+ `(keymap ,gnus-mime-button-map
+ gnus-callback gnus-mm-display-part
+ gnus-part ,gnus-tmp-id
+ article-type annotation
+ gnus-data ,handle))
(setq e (if (bolp)
;; Exclude a newline.
(1- (point))
:group 'gnus-article-mime
:type 'boolean)
-(defun gnus-mime-accumulate-hierarchy (handle &optional single)
- "Accumulate the MIME hierarchy."
- (when gnus-mime-recompute-hierarchical-structure
- (prog1
- (setq gnus-article-mime-hierarchy
- (nconc
- gnus-article-mime-hierarchy
- (list
- (cons
- (or
- gnus-article-mime-hierarchy-next
- (if gnus-article-mime-hierarchy
- (let ((last (1- (length gnus-article-mime-hierarchy))))
- (prog1
- (setq last
- (copy-sequence
- (car (nth last
- gnus-article-mime-hierarchy))))
- (setq last (nthcdr (1- (length last)) last))
- (setcar last (1+ (car last)))))
- (list 1)))
- ;; A placeholder which may be replaced with `handle'.
- nil))))
- (if (and single
- (not (member (mm-handle-media-type handle)
- '("message/rfc822"))))
- (let ((last (copy-sequence
- (car (nth (1- (length gnus-article-mime-hierarchy))
- gnus-article-mime-hierarchy)))))
- (setq gnus-article-mime-hierarchy-next last
- last (nthcdr (1- (length last)) last))
- (setcar last (1+ (car last))))
- (setq gnus-article-mime-hierarchy-next nil)))))
-
-(defun gnus-mime-enter-multipart ()
- (when gnus-mime-recompute-hierarchical-structure
- (setq gnus-article-mime-hierarchy-next
- (cond (gnus-article-mime-hierarchy-next
- (nconc gnus-article-mime-hierarchy-next (list 1)))
- (gnus-article-mime-hierarchy
- (append (car (nth (1- (length gnus-article-mime-hierarchy))
- gnus-article-mime-hierarchy))
- (list 1)))
- (t
- (list 1))))))
-
-(defun gnus-mime-leave-multipart ()
- (when gnus-mime-recompute-hierarchical-structure
- (setq gnus-article-mime-hierarchy-next
- (when gnus-article-mime-hierarchy
- (let ((last (car (nth (1- (length gnus-article-mime-hierarchy))
- gnus-article-mime-hierarchy))))
- (when (cdr last)
- (prog1
- (setq last (butlast last))
- (setq last (nthcdr (1- (length last)) last))
- (setcar last (1+ (car last))))))))))
-
(defun gnus-mime-display-part (handle)
- (if (not (stringp (car handle)))
- ;; Single part.
- (progn
- (gnus-mime-accumulate-hierarchy handle t)
- (gnus-mime-display-single handle))
- (gnus-mime-enter-multipart)
- (prog1
- (cond
- ;; User-defined multipart
- ((cdr (assoc (car handle) gnus-mime-multipart-functions))
- (gnus-mime-accumulate-hierarchy handle)
- (funcall (cdr (assoc (car handle) gnus-mime-multipart-functions))
- handle))
- ;; multipart/alternative
- ((and (equal (car handle) "multipart/alternative")
- (not (or gnus-mime-display-multipart-as-mixed
- gnus-mime-display-multipart-alternative-as-mixed)))
- (gnus-mime-accumulate-hierarchy handle)
- (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
- ((and (equal (car handle) "multipart/related")
- (not (or gnus-mime-display-multipart-as-mixed
- gnus-mime-display-multipart-related-as-mixed)))
- ;;;!!!We should find the start part, but we just default
- ;;;!!!to the first part.
- ;;(gnus-mime-display-part (cadr handle))
- ;;;!!! Most multipart/related is an HTML message plus images.
- ;;;!!! Unfortunately we are unable to let W3 display those
- ;;;!!! included images, so we just display it as a mixed multipart.
- ;;(gnus-mime-display-mixed (cdr handle))
- ;;;!!! No, w3 can display everything just fine.
- (gnus-mime-display-part (cadr handle)))
- ((equal (car handle) "multipart/signed")
- (gnus-mime-accumulate-hierarchy handle)
- (gnus-add-wash-type 'signed)
- (gnus-mime-display-security handle))
- ((equal (car handle) "multipart/encrypted")
- (gnus-mime-accumulate-hierarchy handle)
- (gnus-add-wash-type 'encrypted)
- (gnus-mime-display-security handle))
- ;; Other multiparts are handled like multipart/mixed.
- (t
- (gnus-mime-display-mixed (cdr handle))))
- (gnus-mime-leave-multipart))))
+ (cond
+ ;; Single part.
+ ((not (stringp (car handle)))
+ (gnus-mime-display-single handle))
+ ;; User-defined multipart
+ ((cdr (assoc (car handle) gnus-mime-multipart-functions))
+ (funcall (cdr (assoc (car handle) gnus-mime-multipart-functions))
+ handle))
+ ;; multipart/alternative
+ ((and (equal (car handle) "multipart/alternative")
+ (not (or gnus-mime-display-multipart-as-mixed
+ gnus-mime-display-multipart-alternative-as-mixed)))
+ (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
+ ((and (equal (car handle) "multipart/related")
+ (not (or gnus-mime-display-multipart-as-mixed
+ gnus-mime-display-multipart-related-as-mixed)))
+ ;;;!!!We should find the start part, but we just default
+ ;;;!!!to the first part.
+ ;;(gnus-mime-display-part (cadr handle))
+ ;;;!!! Most multipart/related is an HTML message plus images.
+ ;;;!!! Unfortunately we are unable to let W3 display those
+ ;;;!!! included images, so we just display it as a mixed multipart.
+ ;;(gnus-mime-display-mixed (cdr handle))
+ ;;;!!! No, w3 can display everything just fine.
+ (gnus-mime-display-part (cadr handle)))
+ ((equal (car handle) "multipart/signed")
+ (gnus-add-wash-type 'signed)
+ (gnus-mime-display-security handle))
+ ((equal (car handle) "multipart/encrypted")
+ (gnus-add-wash-type 'encrypted)
+ (gnus-mime-display-security 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))
(gnus-add-text-properties
(setq from (point))
(progn
- (insert (format "%s. "
- (if gnus-mime-recompute-hierarchical-structure
- (mapconcat
- 'number-to-string
- (car (nth (1- id)
- gnus-article-mime-hierarchy))
- ".")
- id)))
+ (insert (format "%d. " id))
(point))
`(gnus-callback
(lambda (handles)
projects / gnus / blobdiff