:group 'gnus-article-treat
:type gnus-article-treat-custom)
-(defcustom gnus-treat-decode-message-body-as-default-mime-charset nil
- "Decode the message body as `default-mime-charset'.
-Recommended values are nil or `nomime'.
-See the manual for details."
+(defcustom gnus-treat-decode-article-as-default-mime-charset nil
+ "Decode an article as `default-mime-charset'. For instance, if you want to
+attempt to decode an article even if the value of `gnus-show-mime' is nil,
+you could set this variable to something like: nil for don't decode, t for
+decode the body, '(or header t) for the whole article, etc."
:group 'gnus-article-treat
- :type '(choice (const :tag "Off" nil)
- (const :tag "On" nomime)))
+ :type '(radio (const :tag "Off" nil)
+ (const :tag "Decode body" t)
+ (const :tag "Decode all" (or head t))))
;;; Internal variables
(gnus-treat-display-smileys gnus-smiley-display)
(gnus-treat-display-picons gnus-article-display-picons)
(gnus-treat-play-sounds gnus-earcon-display)
- (gnus-treat-decode-message-body-as-default-mime-charset
- gnus-article-decode-message-body-as-default-mime-charset)))
+ (gnus-treat-decode-article-as-default-mime-charset
+ gnus-article-decode-article-as-default-mime-charset)))
(defvar gnus-article-mime-handle-alist nil)
(defvar article-lapsed-timer nil)
(point-max)))
'boring-headers))))
+(defun article-toggle-headers (&optional arg)
+ "Toggle hiding of headers. If given a negative prefix, always show;
+if given a positive prefix, always hide."
+ (interactive (gnus-article-hidden-arg))
+ (let ((force (when (numberp arg)
+ (cond ((> arg 0) 'always-hide)
+ ((< arg 0) 'always-show))))
+ (window (get-buffer-window gnus-article-buffer))
+ (header-end (point-min))
+ header-start field-end field-start
+ (inhibit-point-motion-hooks t)
+ (inhibit-read-only t)
+ buffer-read-only)
+ (save-restriction
+ (widen)
+ (while (and (setq header-start
+ (text-property-any header-end (point-max)
+ 'article-treated-header t))
+ (setq header-end
+ (text-property-not-all header-start (point-max)
+ 'article-treated-header t)))
+ (setq field-end header-start)
+ (cond
+ (;; Hide exposed invisible fields.
+ (and (not (eq 'always-show force))
+ (setq field-start
+ (text-property-any field-end header-end
+ 'exposed-invisible-field t)))
+ (while (and field-start
+ (setq field-end (text-property-not-all
+ field-start header-end
+ 'exposed-invisible-field t)))
+ (add-text-properties field-start field-end gnus-hidden-properties)
+ (setq field-start (text-property-any field-end header-end
+ 'exposed-invisible-field t)))
+ (put-text-property header-start header-end
+ 'exposed-invisible-field nil))
+ (;; Expose invisible fields.
+ (and (not (eq 'always-hide force))
+ (setq field-start
+ (text-property-any field-end header-end 'invisible t)))
+ (while (and field-start
+ (setq field-end (text-property-not-all
+ field-start header-end
+ 'invisible t)))
+ ;; If the invisible text is not terminated with newline, we
+ ;; won't expose it. Because it may be created by x-face-mule.
+ ;; BTW, XEmacs sometimes fail in putting a invisible text
+ ;; property with `gnus-article-hide-text' (really?). In that
+ ;; case, the invisible text might be started from the middle of
+ ;; a line so we will expose the sort of thing.
+ (when (or (not (or (eq header-start field-start)
+ (eq ?\n (char-before field-start))))
+ (eq ?\n (char-before field-end)))
+ (remove-text-properties field-start field-end
+ gnus-hidden-properties)
+ (put-text-property field-start field-end
+ 'exposed-invisible-field t))
+ (setq field-start (text-property-any field-end header-end
+ 'invisible t))))
+ (;; Hide fields.
+ (not (eq 'always-show force))
+ (narrow-to-region header-start header-end)
+ (article-hide-headers)
+ ;; Re-display X-Face image under XEmacs.
+ (when (and (featurep 'xemacs)
+ (gnus-functionp gnus-article-x-face-command))
+ (let ((func (cadr (assq 'gnus-treat-display-xface
+ gnus-treatment-function-alist)))
+ (condition 'head))
+ (when (and func
+ (gnus-treat-predicate gnus-treat-display-xface))
+ (funcall func)
+ (put-text-property header-start header-end 'read-only nil))))
+ (widen))
+ ))
+ (goto-char (point-min))
+ (when window
+ (set-window-start window (point-min))))))
+
(defvar gnus-article-normalized-header-length 40
"Length of normalized headers.")
(process-send-region "article-x-face" beg end)
(process-send-eof "article-x-face"))))))))))
-(autoload 'x-face-mule-x-face-decode-message-header "x-face-mule")
-
-(defun gnus-article-display-x-face-with-x-face-mule (&rest args)
- "Decode and show X-Face with the function
-`x-face-mule-x-face-decode-message-header'. The buffer is expected to be
-narrowed to just the headers of the article."
- (when (featurep 'xemacs)
- (error "`%s' won't work under XEmacs."
- 'gnus-article-display-x-face-with-x-face-mule))
- (condition-case err
- (x-face-mule-x-face-decode-message-header)
- (error (error "%s"
- (if (featurep 'x-face-mule)
- "Please install x-face-mule 0.24 or later."
- err)))))
-
(defun article-decode-mime-words ()
"Decode all MIME-encoded words in the article."
(interactive)
(let ((buffer-read-only nil))
;; Delete any old X-Sent headers.
(when (setq date-pos
- (next-single-property-change (point-min)
- 'article-date-lapsed))
+ (text-property-any (point-min) (point-max)
+ 'article-date-lapsed t))
(goto-char (setq date-pos (set-marker (make-marker) date-pos)))
(delete-region (match-beginning 0)
(progn (forward-line 1) (point))))
(apply ',afunc args))))))))
'(article-hide-headers
article-hide-boring-headers
+ article-toggle-headers
article-treat-overstrike
article-fill-long-lines
article-capitalize-sentences
(easy-menu-define
gnus-article-treatment-menu gnus-article-mode-map ""
'("Treatment"
- ["Hide headers" gnus-article-hide-headers t]
+ ["Hide headers" gnus-article-toggle-headers t]
["Hide signature" gnus-article-hide-signature t]
["Hide citation" gnus-article-hide-citation t]
["Treat overstrike" gnus-article-treat-overstrike t]
(defun gnus-article-display-traditional-message ()
"Article display method for traditional message."
(set-buffer gnus-article-buffer)
- (let ((inhibit-read-only t)
- buffer-read-only)
+ (let (buffer-read-only)
(erase-buffer)
(insert-buffer-substring gnus-original-article-buffer)))
(get-text-property 1 'mime-view-entity)
(get-text-property (point) 'mime-view-entity)))
(number (or number 0))
- start content-type treat-type ids)
+ next type ids)
(save-restriction
(narrow-to-region (point)
(if (search-forward "\n\n" nil t)
(point)
(point-max)))
(gnus-treat-article 'head)
- (goto-char (setq start (point-max))))
+ (put-text-property (point-min) (point-max) 'article-treated-header t)
+ (goto-char (point-max)))
(while (and (not (eobp))
entity
- (progn (mime-preview-move-to-next)
- (> (point) start)))
- (setq content-type (mime-entity-content-type entity)
- treat-type (format "%s/%s"
- (mime-content-type-primary-type
- content-type)
- (mime-content-type-subtype
- content-type)))
- (save-restriction
- (if (string-equal treat-type "message/rfc822")
- (progn
- (narrow-to-region start (point-max))
- (gnus-article-prepare-mime-display number))
- (narrow-to-region start (point))
- (setq start (point)
- ids (length (mime-entity-node-id entity))
- entity (get-text-property start 'mime-view-entity)
- number (1+ number))
+ (setq next (next-single-property-change (point)
+ 'mime-view-entity)))
+ (setq type (mime-entity-content-type entity)
+ type (format "%s/%s"
+ (mime-content-type-primary-type type)
+ (mime-content-type-subtype type)))
+ (if (string-equal type "message/rfc822")
+ (save-restriction
+ (narrow-to-region (point) (point-max))
+ (gnus-article-prepare-mime-display number)
+ (goto-char (point-max)))
+ (setq ids (length (mime-entity-node-id entity))
+ entity (get-text-property next 'mime-view-entity)
+ number (1+ number))
+ (save-restriction
+ (narrow-to-region (point) next)
(if (or (null entity)
(< (length (mime-entity-node-id entity)) ids))
- (gnus-treat-article 'last number number treat-type)
- (gnus-treat-article nil number nil treat-type)))
- (goto-char (point-max))))
+ (gnus-treat-article 'last number number type)
+ (gnus-treat-article t number nil type))
+ (goto-char (point-max)))))
(unless (eobp)
(save-restriction
(narrow-to-region (point) (point-max))
(if entity
(progn
- (setq content-type (mime-entity-content-type entity)
- treat-type (format "%s/%s"
- (mime-content-type-primary-type
- content-type)
- (mime-content-type-subtype
- content-type)))
- (if (string-equal treat-type "message/rfc822")
+ (setq type (mime-entity-content-type entity)
+ type (format "%s/%s"
+ (mime-content-type-primary-type type)
+ (mime-content-type-subtype type)))
+ (if (string-equal type "message/rfc822")
(gnus-article-prepare-mime-display number)
(incf number)
- (gnus-treat-article 'last number number treat-type)))
+ (gnus-treat-article 'last number number type)))
(gnus-treat-article t))))))
;;;###autoload
(funcall (if gnus-show-mime
(progn
(setq mime-message-structure gnus-current-headers)
+ (mime-buffer-entity-set-buffer-internal
+ mime-message-structure
+ gnus-original-article-buffer)
+ (mime-entity-set-representation-type-internal
+ mime-message-structure 'mime-buffer-entity)
+ (luna-send mime-message-structure
+ 'initialize-instance
+ mime-message-structure)
gnus-article-display-method-for-mime)
gnus-article-display-method-for-traditional)))
;; Associate this article with the current summary buffer.
(setq gnus-article-current-summary gnus-summary-buffer)
;; Call the treatment functions.
- (save-restriction
- (widen)
- (if gnus-show-mime
- (let (mime-preview-over-to-next-method-alist)
- (gnus-article-prepare-mime-display))
- (std11-narrow-to-header)
- (gnus-treat-article 'head)
- (goto-char (point-max))
+ (let ((inhibit-read-only t)
+ buffer-read-only)
+ (save-restriction
(widen)
- (narrow-to-region (point) (point-max))
- (gnus-treat-article t)))
+ (if gnus-show-mime
+ (gnus-article-prepare-mime-display)
+ (narrow-to-region (goto-char (point-min))
+ (if (search-forward "\n\n" nil t)
+ (point)
+ (point-max)))
+ (gnus-treat-article 'head)
+ (put-text-property (point-min) (point-max) 'article-treated-header t)
+ (goto-char (point-max))
+ (widen)
+ (narrow-to-region (point) (point-max))
+ (gnus-treat-article t))
+ (put-text-property (point-min) (point-max) 'read-only nil)))
;; Perform the article display hooks. Incidentally, this hook is
;; an obsolete variable by now.
(gnus-run-hooks 'gnus-article-display-hook))
-(defun gnus-article-decode-message-body-as-default-mime-charset ()
- "Decode the message body as `default-mime-charset'."
- (let (buffer-read-only)
- (decode-mime-charset-region (point) (point-max)
+(defun gnus-article-decode-article-as-default-mime-charset ()
+ "Decode an article as `default-mime-charset'. It won't work if the
+value of the variable `gnus-show-mime' is non-nil."
+ (unless gnus-show-mime
+ (decode-mime-charset-region (point-min) (point-max)
(with-current-buffer gnus-summary-buffer
default-mime-charset))))
+(autoload 'x-face-mule-x-face-decode-message-header "x-face-mule")
+
+(defun gnus-article-display-x-face-with-x-face-mule (&rest args)
+ "Decode and show X-Face with the function
+`x-face-mule-x-face-decode-message-header'. The buffer is expected to be
+narrowed to just the headers of the article."
+ (when (featurep 'xemacs)
+ (error "`%s' won't work under XEmacs."
+ 'gnus-article-display-x-face-with-x-face-mule))
+ (when window-system
+ (condition-case err
+ (x-face-mule-x-face-decode-message-header)
+ (error (error "%s"
+ (if (featurep 'x-face-mule)
+ "Please install x-face-mule 0.24 or later."
+ err))))))
+
;;;
;;; Gnus MIME viewing functions
;;;
(defun gnus-treat-predicate (val)
(cond
((eq val 'mime)
- (and gnus-show-mime t))
- ((eq val 'nomime)
- (not gnus-show-mime))
+ (not (not gnus-show-mime)))
((null val)
nil)
((listp val)
projects / elisp / gnus.git- / blobdiff