"^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:"
- "^X-Pgp-Public-Key-Url:" "^X-Auth:" "^X-From-Line:"
+ "^Old-Received:" "^X-Pgp" "^X-Auth:" "^X-From-Line:"
"^X-Gnus-Article-Number:" "^X-Majordomo:" "^X-Url:" "^X-Sender:"
- "^X-Mailing-List:" "^MBOX-Line" "^Priority:" "^X-Pgp" "^X400-[-A-Za-z]+:"
- "^Status:" "^X-Gnus-Mail-Source:" "^Cancel-Lock:")
+ "^MBOX-Line" "^Priority:" "^X-Pgp" "^X400-[-A-Za-z]+:"
+ "^Status:" "^X-Gnus-Mail-Source:" "^Cancel-Lock:"
+ "^X-FTN" "^X-EXP32-SerialNo:" "^Encoding:" "^Importance:"
+ "^Autoforwarded:" "^Original-Encoded-Information-Types:" "^X-Ya-Pop3:"
+ "^X-Face-Version:" "^X-Vms-To:" "^X-ML-NAME:" "^X-ML-COUNT:"
+ "^Mailing-List:" "^X-finfo:" "^X-md5sum:" "^X-md5sum-Origin:"
+ "^X-Sun-Charset:" "^X-Accept-Language:" "^X-Envelope-Sender:"
+ "^List-[A-Za-z]+:" "^X-Listprocessor-Version:"
+ "^X-Received:" "^X-Distribute:" "^X-Sequence:" "^X-Juno-Line-Breaks:"
+ "^X-Notes-Item:" "^X-MS-TNEF-Correlator:" "^x-uunet-gateway:")
"*All headers that start with this regexp will be hidden.
This variable can also be a list of regexps of headers to be ignored.
If `gnus-visible-headers' is non-nil, this variable will be ignored."
:group 'gnus-article-hiding)
(defcustom gnus-article-x-face-command
- "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
+ "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | display -"
"*String or function to be executed to display an X-Face header.
If it is a string, the command will be executed in a sub-shell
asynchronously. The compressed face will be piped to this command."
Esample: (_/*word*/_)."
:group 'gnus-article-emphasis)
+(defface gnus-emphasis-highlight-words
+ '((t (:background "black" :foreground "yellow")))
+ "Face used for displaying highlighted words."
+ :group 'gnus-article-emphasis)
+
(defcustom gnus-article-time-format "%a, %b %d %Y %T %Z"
"Format for display of Date headers in article bodies.
See `format-time-string' for the possible values.
("\221" "`")
("\222" "'")
("\223" "``")
- ("\224" "''")
+ ("\224" "\"")
("\225" "*")
- ("\226" "-")
+ ("\226" "---")
("\227" "-")
("\231" "(TM)")
("\233" ">")
:type '(repeat regexp))
(defcustom gnus-unbuttonized-mime-types '(".*/.*")
- "List of MIME types that should not be given buttons when rendered."
+ "List of MIME types that should not be given buttons when rendered inline."
:group 'gnus-article-mime
:type '(repeat regexp))
(const :tag "Header" head)
(const :tag "Last" last)
(integer :tag "Less")
+ (repeat :tag "Groups" regexp)
(sexp :tag "Predicate")))
(defvar gnus-article-treat-head-custom
:group 'gnus-article-treat
:type gnus-article-treat-custom)
+(defcustom gnus-treat-strip-list-identifiers 'head
+ "Strip list identifiers from `gnus-list-identifiers`.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+ :group 'gnus-article-treat
+ :type gnus-article-treat-custom)
+
(defcustom gnus-treat-strip-pgp t
"Strip PGP signatures.
Valid values are nil, t, `head', `last', an integer or a predicate.
:group 'gnus-article-treat
:type gnus-article-treat-custom)
-(defcustom gnus-treat-strip-blank-lines nil
- "Strip all blank lines.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
- :group 'gnus-article-treat
- :type gnus-article-treat-custom)
-
(defcustom gnus-treat-overstrike t
"Treat overstrike highlighting.
Valid values are nil, t, `head', `last', an integer or a predicate.
:group 'gnus-article-treat
:type gnus-article-treat-custom)
+(defcustom gnus-treat-translate nil
+ "Translate articles from one language to another.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+ :group 'gnus-article-treat
+ :type gnus-article-treat-custom)
+
;;; Internal variables
(defvar article-goto-body-goes-to-point-min-p nil)
(defvar gnus-article-wash-types nil)
+(defvar gnus-article-emphasis-alist nil)
(defvar gnus-article-mime-handle-alist-1 nil)
(defvar gnus-treatment-function-alist
(gnus-treat-fill-long-lines gnus-article-fill-long-lines)
(gnus-treat-strip-cr gnus-article-remove-cr)
(gnus-treat-emphasize gnus-article-emphasize)
+ (gnus-treat-display-xface gnus-article-display-x-face)
(gnus-treat-hide-headers gnus-article-maybe-hide-headers)
(gnus-treat-hide-boring-headers gnus-article-hide-boring-headers)
(gnus-treat-hide-signature gnus-article-hide-signature)
(gnus-treat-hide-citation gnus-article-hide-citation)
+ (gnus-treat-strip-list-identifiers gnus-article-hide-list-identifiers)
(gnus-treat-strip-pgp gnus-article-hide-pgp)
(gnus-treat-strip-pem gnus-article-hide-pem)
(gnus-treat-highlight-headers gnus-article-highlight-headers)
gnus-article-strip-leading-blank-lines)
(gnus-treat-strip-multiple-blank-lines
gnus-article-strip-multiple-blank-lines)
- (gnus-treat-strip-blank-lines gnus-article-strip-blank-lines)
(gnus-treat-overstrike gnus-article-treat-overstrike)
(gnus-treat-buttonize-head gnus-article-add-buttons-to-head)
- (gnus-treat-display-xface gnus-article-display-x-face)
(gnus-treat-display-smileys gnus-smiley-display)
(gnus-treat-display-picons gnus-article-display-picons)
(gnus-treat-play-sounds gnus-earcon-display)))
(set-buffer gnus-article-buffer)
(let ((inhibit-point-motion-hooks t)
buffer-read-only
- (mail-parse-charset gnus-newsgroup-charset))
+ (mail-parse-charset gnus-newsgroup-charset)
+ (mail-parse-ignored-charsets
+ (save-excursion (set-buffer gnus-summary-buffer)
+ gnus-newsgroup-ignored-charsets)))
(mail-decode-encoded-word-region (point-min) (point-max)))))
(defun article-decode-charset (&optional prompt)
(ctl
(mail-content-type-get ctl 'charset))))
(mail-parse-charset gnus-newsgroup-charset)
+ (mail-parse-ignored-charsets
+ (save-excursion (condition-case nil
+ (set-buffer gnus-summary-buffer)
+ (error))
+ gnus-newsgroup-ignored-charsets))
buffer-read-only)
- (when (memq charset gnus-newsgroup-ignored-charsets)
- (setq charset nil))
+ (if (and ctl (not (string-match "/" (car ctl))))
+ (setq ctl nil))
(goto-char (point-max))
(widen)
(forward-line 1)
"Remove encoded-word encoding from headers."
(let ((inhibit-point-motion-hooks t)
(mail-parse-charset gnus-newsgroup-charset)
+ (mail-parse-ignored-charsets
+ (save-excursion (set-buffer gnus-summary-buffer)
+ gnus-newsgroup-ignored-charsets))
buffer-read-only)
(save-restriction
(article-narrow-to-head)
(when charset
(mm-decode-body charset)))))))
+(defun article-hide-list-identifiers ()
+ "Remove any list identifiers in `gnus-list-identifiers' from Subject
+header in the current article."
+ (interactive)
+ (save-excursion
+ (save-restriction
+ (let ((inhibit-point-motion-hooks t)
+ buffer-read-only)
+ (article-narrow-to-head)
+ (let ((regexp (if (stringp gnus-list-identifiers) gnus-list-identifiers
+ (mapconcat 'identity gnus-list-identifiers " *\\|"))))
+ (when regexp
+ (goto-char (point-min))
+ (when (re-search-forward
+ (concat "^Subject: +\\(Re: +\\)?\\(" regexp " *\\)")
+ nil t)
+ (delete-region (match-beginning 2) (match-end 0)))))))))
+
(defun article-hide-pgp ()
"Remove any PGP headers and signatures in the current article."
(interactive)
(while (re-search-forward banner nil t)
(delete-region (match-beginning 0) (match-end 0))))))))))
+(defun article-babel ()
+ "Translate article using an online translation service."
+ (interactive)
+ (require 'babel)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (when (article-goto-body)
+ (let* ((buffer-read-only nil)
+ (start (point))
+ (end (point-max))
+ (orig (buffer-substring start end))
+ (trans (babel-as-string orig)))
+ (save-restriction
+ (narrow-to-region start end)
+ (delete-region start end)
+ (insert trans))))))
+
(defun article-hide-signature (&optional arg)
"Hide the signature in the current article.
If given a negative prefix, always show; if given a positive prefix,
should replace the \"Date:\" one, or should be added below it."
(interactive (list 'ut t))
(let* ((header (or header
- (mail-header-date (save-excursion
- (set-buffer gnus-summary-buffer)
- gnus-current-headers))
(message-fetch-field "date")
""))
(tdate-regexp "^Date:[ \t]\\|^X-Sent:[ \t]")
(delete-region (progn (beginning-of-line) (point))
(progn (forward-line 1) (point))))
(setq newline nil))
- (insert (article-make-date-line date type))
+ (when (re-search-forward tdate-regexp nil t)
+ (forward-line 1))
+ (insert (article-make-date-line date (or type 'ut)))
(when newline
(insert "\n")
(forward-line -1))
;; buggy dates.
((eq type 'local)
(let ((tz (car (current-time-zone))))
- (format "Date: %s %s%04d" (current-time-string time)
- (if (> tz 0) "+" "-") (abs (/ tz 36)))))
+ (format "Date: %s %s%02d%02d" (current-time-string time)
+ (if (> tz 0) "+" "-") (/ tz 3600) (/ (% tz 3600) 60))))
;; Convert to Universal Time.
((eq type 'ut)
(concat "Date: "
(interactive (gnus-article-hidden-arg))
(unless (gnus-article-check-hidden-text 'emphasis arg)
(save-excursion
- (let ((alist gnus-emphasis-alist)
+ (let ((alist (or (with-current-buffer gnus-summary-buffer
+ gnus-article-emphasis-alist)
+ gnus-emphasis-alist))
(buffer-read-only nil)
(props (append '(article-type emphasis)
gnus-hidden-properties))
(match-beginning visible) (match-end visible) 'face face)
(goto-char (match-end invisible)))))))))
+(defun gnus-article-setup-highlight-words (&optional highlight-words)
+ "Setup newsgroup emphasis alist."
+ (unless gnus-article-emphasis-alist
+ (let ((name (and gnus-newsgroup-name
+ (gnus-group-real-name gnus-newsgroup-name))))
+ (make-local-variable 'gnus-article-emphasis-alist)
+ (setq gnus-article-emphasis-alist
+ (nconc
+ (let ((alist gnus-group-highlight-words-alist) elem highlight)
+ (while (setq elem (pop alist))
+ (when (and name (string-match (car elem) name))
+ (setq alist nil
+ highlight (copy-list (cdr elem)))))
+ highlight)
+ (copy-list highlight-words)
+ (if gnus-newsgroup-name
+ (copy-list (gnus-group-find-parameter
+ gnus-newsgroup-name 'highlight-words t)))
+ gnus-emphasis-alist)))))
+
(defvar gnus-summary-article-menu)
(defvar gnus-summary-post-menu)
article-display-x-face
article-de-quoted-unreadable
article-mime-decode-quoted-printable
+ article-hide-list-identifiers
article-hide-pgp
article-strip-banner
+ article-babel
article-hide-pem
article-hide-signature
article-strip-headers-in-body
(setq gnus-article-buffer name)
(setq gnus-original-article-buffer original)
(gnus-set-global-variables)))
+ (gnus-article-setup-highlight-words)
;; Init original article buffer.
(save-excursion
(set-buffer (gnus-get-buffer-create gnus-original-article-buffer))
(if (get-buffer name)
(save-excursion
(set-buffer name)
+ (kill-all-local-variables)
(buffer-disable-undo)
(setq buffer-read-only t)
(unless (eq major-mode 'gnus-article-mode)
(?e gnus-tmp-dots ?s)))
(defvar gnus-mime-button-commands
- '((gnus-article-press-button "\r" "Toggle Display")
- (gnus-mime-view-part "v" "View Interactively...")
- (gnus-mime-save-part "o" "Save...")
- (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...")))
+ '((gnus-article-press-button "\r" "Toggle Display")
+ (gnus-mime-view-part "v" "View Interactively...")
+ (gnus-mime-view-part-as-type "t" "View As Type...")
+ (gnus-mime-save-part "o" "Save...")
+ (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
(save-current-buffer
(set-buffer gnus-article-buffer)
(let ((handles (or handles gnus-article-mime-handles))
- (mail-parse-charset gnus-newsgroup-charset))
+ (mail-parse-charset gnus-newsgroup-charset)
+ (mail-parse-ignored-charsets
+ (save-excursion (set-buffer gnus-summary-buffer)
+ gnus-newsgroup-ignored-charsets)))
(if (stringp (car handles))
(gnus-mime-view-all-parts (cdr handles))
(mapcar 'mm-display-part handles)))))
(mm-pipe-part data)))
(defun gnus-mime-view-part ()
- "Interactively choose a view method for the MIME part under point."
+ "Interactively choose a viewing method for the MIME part under point."
(interactive)
(gnus-article-check-buffer)
(let ((data (get-text-property (point) 'gnus-data)))
(mm-interactively-view-part data)))
+(defun gnus-mime-view-part-as-media ()
+ "Choose a MIME media type, and view the part as such."
+ (interactive
+ (list (completing-read "View as MIME type: " mailcap-mime-types)))
+ (gnus-article-check-buffer)
+ (let ((handle (get-text-property (point) 'gnus-data)))
+ (gnus-mm-display-part handle)))
+
(defun gnus-mime-copy-part (&optional handle)
"Put the the MIME part under point into a new buffer."
(interactive)
(gnus-article-check-buffer)
(let* ((handle (or handle (get-text-property (point) 'gnus-data)))
(mm-user-display-methods nil)
- (mm-all-images-fit t)
- (mail-parse-charset gnus-newsgroup-charset))
+ (mm-inline-large-images nil)
+ (mail-parse-charset gnus-newsgroup-charset)
+ (mail-parse-ignored-charsets
+ (save-excursion (set-buffer gnus-summary-buffer)
+ gnus-newsgroup-ignored-charsets)))
(if (mm-handle-undisplayer handle)
(mm-remove-part handle)
(mm-display-part handle))))
(gnus-article-check-buffer)
(let* ((handle (or handle (get-text-property (point) 'gnus-data)))
(mm-user-display-methods '((".*" . inline)))
- (mm-all-images-fit t)
- (mail-parse-charset gnus-newsgroup-charset))
+ (mm-inline-large-images t)
+ (mail-parse-charset gnus-newsgroup-charset)
+ (mail-parse-ignored-charsets
+ (save-excursion (set-buffer gnus-summary-buffer)
+ gnus-newsgroup-ignored-charsets)))
(if (mm-handle-undisplayer handle)
(mm-remove-part handle)
(mm-display-part handle))))
(set-buffer gnus-article-buffer)
(when (> n (length gnus-article-mime-handle-alist))
(error "No such part"))
+ (gnus-article-goto-part n)
(let ((handle (cdr (assq n gnus-article-mime-handle-alist))))
(funcall function handle))))
(forward-line 1)
(prog1
(let ((window (selected-window))
- (mail-parse-charset gnus-newsgroup-charset))
+ (mail-parse-charset gnus-newsgroup-charset)
+ (mail-parse-ignored-charsets
+ (save-excursion (set-buffer gnus-summary-buffer)
+ gnus-newsgroup-ignored-charsets)))
(save-excursion
(unwind-protect
(let ((win (get-buffer-window (current-buffer) t))
(gnus-treat-article
nil id
(1- (length gnus-article-mime-handles))
- (car (mm-handle-type handle))))))
+ (mm-handle-media-type handle)))))
(select-window window))))
(goto-char point)
(delete-region (gnus-point-at-bol) (progn (forward-line 1) (point)))
(mail-content-type-get (mm-handle-disposition handle)
'filename)
""))
- (gnus-tmp-type (car (mm-handle-type handle)))
+ (gnus-tmp-type (mm-handle-media-type handle))
(gnus-tmp-description
(mail-decode-encoded-word-string (or (mm-handle-description handle)
"")))
(when (and (not ihandles)
(not gnus-displaying-mime))
;; 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)
+ (when gnus-article-mime-handles
+ (mm-destroy-parts gnus-article-mime-handles)
+ (setq gnus-article-mime-handle-alist nil)) ;; A trick.
+ (setq gnus-article-mime-handles handles)
;; We allow users to glean info from the handles.
(when gnus-article-mime-part-function
(gnus-mime-part-function handles)))
(narrow-to-region (point) (point-max))
(gnus-treat-article nil 1 1)
(widen)))
- ;; Highlight the headers.
- (save-excursion
- (save-restriction
- (article-goto-body)
- (narrow-to-region (point-min) (point))
- (gnus-treat-article 'head)))))))
+ (if (not ihandles)
+ ;; Highlight the headers.
+ (save-excursion
+ (save-restriction
+ (article-goto-body)
+ (narrow-to-region (point-min) (point))
+ (gnus-treat-article 'head))))))))
(defvar gnus-mime-display-multipart-as-mixed nil)
(mapcar 'gnus-mime-display-part handles))
(defun gnus-mime-display-single (handle)
- (let ((type (car (mm-handle-type handle)))
+ (let ((type (mm-handle-media-type handle))
(ignored gnus-ignored-mime-types)
(not-attachment t)
(move nil)
(or (not (mm-handle-disposition handle))
(equal (car (mm-handle-disposition handle))
"inline")
- (mm-attachment-override-p type)))
- (mm-automatic-display-p type)
- (or (mm-inlinable-part-p type)
+ (mm-attachment-override-p handle)))
+ (mm-automatic-display-p handle)
+ (or (mm-inlined-p handle)
(mm-automatic-external-display-p type)))
(setq display t)
- (when (equal (car (split-string type "/"))
- "text")
+ (when (equal (mm-handle-media-supertype handle) "text")
(setq text t)))
(let ((id (1+ (length gnus-article-mime-handle-alist))))
(push (cons id handle) gnus-article-mime-handle-alist)
(display
(when move
(forward-line -2))
- (let ((mail-parse-charset gnus-newsgroup-charset))
+ (let ((mail-parse-charset gnus-newsgroup-charset)
+ (mail-parse-ignored-charsets
+ (save-excursion (set-buffer gnus-summary-buffer)
+ gnus-newsgroup-ignored-charsets)))
(mm-display-part handle t))
(goto-char (point-max)))
((and text not-attachment)
(gnus-treat-article
nil (length gnus-article-mime-handle-alist)
(1- (length gnus-article-mime-handles))
- (car (mm-handle-type handle))))))))))
+ (mm-handle-media-type handle)))))))))
(defun gnus-unbuttonized-mime-type-p (type)
"Say whether TYPE is to be unbuttonized."
(progn
(insert (format "(%c) %-18s"
(if (equal handle preferred) ?* ? )
- (if (stringp (car handle))
- (car handle)
- (car (mm-handle-type handle)))))
+ (mm-handle-media-type handle)))
(point))
`(gnus-callback
(lambda (handles)
(when preferred
(if (stringp (car preferred))
(gnus-display-mime preferred)
- (let ((mail-parse-charset gnus-newsgroup-charset))
- (mm-display-part preferred)))
+ (let ((mail-parse-charset gnus-newsgroup-charset)
+ (mail-parse-ignored-charsets
+ (save-excursion (set-buffer gnus-summary-buffer)
+ gnus-newsgroup-ignored-charsets)))
+ (mm-display-part preferred)
+ ;; Do highlighting.
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (car begend) (point-max))
+ (gnus-treat-article
+ nil (length gnus-article-mime-handle-alist)
+ (1- (length gnus-article-mime-handles))
+ (mm-handle-media-type handle))))))
(goto-char (point-max))
(setcdr begend (point-marker)))))
(when ibegend
;; save it to file.
(goto-char (point-max))
(insert "\n")
- (append-to-file (point-min) (point-max) file-name)
+ (mm-append-to-file (point-min) (point-max) file-name)
t)))
(defun gnus-narrow-to-page (&optional arg)
(set-buffer gnus-article-current-summary)
(let (gnus-pick-mode)
(push (or key last-command-event) unread-command-events)
- (setq keys (read-key-sequence nil))))
+ (setq keys (if gnus-xemacs
+ (events-to-keys (read-key-sequence nil))
+ (read-key-sequence nil)))))
+
(message "")
(if (or (member keys nosaves)
If given a prefix, show the hidden text instead."
(interactive (append (gnus-article-hidden-arg) (list 'force)))
(gnus-article-hide-headers arg)
+ (gnus-article-hide-list-identifiers arg)
(gnus-article-hide-pgp arg)
(gnus-article-hide-citation-maybe arg force)
(gnus-article-hide-signature arg))
(set-buffer gnus-article-buffer)
(gnus-article-edit-mode)
(funcall start-func)
- ;;(gnus-article-delete-text-of-type 'annotation)
- ;;(gnus-set-text-properties (point-min) (point-max) nil)
(gnus-configure-windows 'edit-article)
(setq gnus-article-edit-done-function exit-func)
(setq gnus-prev-winconf winconf)
(eq part-number total-parts))
((numberp val)
(< length val))
+ ((and (listp val)
+ (stringp (car val)))
+ (apply 'gnus-or (mapcar `(lambda (s)
+ (string-match s ,(or gnus-newsgroup-name "")))
+ val)))
((listp val)
(let ((pred (pop val)))
(cond
((eq pred 'or)
(apply 'gnus-or (mapcar 'gnus-treat-predicate val)))
((eq pred 'and)
- (apply 'gnus-and (mapcar 'gnus-tread-predicate val)))
+ (apply 'gnus-and (mapcar 'gnus-treat-predicate val)))
((eq pred 'not)
(not (gnus-treat-predicate val)))
((eq pred 'typep)