"^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:"
- "^X-Received:" "^Content-length:" "X-precedence:")
+ "^X-Received:" "^Content-length:" "X-precedence:"
+ "^X-Authenticated-User:" "^X-Comment" "^X-Report:" "^X-Abuse-Info:"
+ "^X-HTTP-Proxy:" "^X-Mydeja-Info:" "^X-Copyright" "^X-No-Markup:"
+ "^X-Abuse-Info:")
"*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."
(defcustom gnus-article-banner-alist nil
"Banner alist for stripping.
-For example,
+For example,
((egroups . \"^[ \\t\\n]*-------------------+\\\\( eGroups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))"
:version "21.1"
:type '(repeat (cons symbol regexp))
:group 'gnus-article-washing)
-(defcustom gnus-article-banner-alist nil
- "Banner alist for stripping.
-For example,
- ((egroups . \"^[ \\t\\n]*-------------------+\\\\( eGroups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))"
- :version "21.1"
- :type '(repeat (cons symbol regexp))
- :group 'gnus-article-washing)
+(gnus-define-group-parameter
+ banner
+ :variable-document
+ "Alist of regexps (to match group names) and banner."
+ :variable-group gnus-article-washing
+ :parameter-type
+ '(choice :tag "Banner"
+ :value nil
+ (const :tag "Remove signature" signature)
+ (symbol :tag "Item in `gnus-article-banner-alist'" none)
+ regexp
+ (const :tag "None" nil))
+ :parameter-document
+ "If non-nil, specify how to remove `banners' from articles.
+
+Symbol `signature' means to remove signatures delimited by
+`gnus-signature-separator'. Any other symbol is used to look up a
+regular expression to match the banner in `gnus-article-banner-alist'.
+A string is used as a regular expression to match the banner
+directly.")
(defcustom gnus-emphasis-alist
(let ((format
:type 'hook
:group 'gnus-article-various)
+(when (featurep 'xemacs)
+ ;; Extracted from gnus-xmas-define in order to preserve user settings
+ (when (fboundp 'turn-off-scroll-in-place)
+ (add-hook 'gnus-article-mode-hook 'turn-off-scroll-in-place))
+ ;; Extracted from gnus-xmas-redefine in order to preserve user settings
+ (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add))
+
(defcustom gnus-article-menu-hook nil
"*Hook run after the creation of the article mode menu."
:type 'hook
(defcustom gnus-article-mime-match-handle-function 'undisplayed-alternative
"Function called with a MIME handle as the argument.
This is meant for people who want to view first matched part.
-For `undisplayed-alternative' (default), the first undisplayed
-part or alternative part is used. For `undisplayed', the first
-undisplayed part is used. For a function, the first part which
+For `undisplayed-alternative' (default), the first undisplayed
+part or alternative part is used. For `undisplayed', the first
+undisplayed part is used. For a function, the first part which
the function return `t' is used. For `nil', the first part is
used."
:version "21.1"
:group 'gnus-article-mime
- :type '(choice
+ :type '(choice
(item :tag "first" :value nil)
(item :tag "undisplayed" :value undisplayed)
- (item :tag "undisplayed or alternative"
+ (item :tag "undisplayed or alternative"
:value undisplayed-alternative)
(function)))
:type gnus-article-treat-head-custom)
(put 'gnus-treat-buttonize-head 'highlight t)
-(defcustom gnus-treat-emphasize 50000
+(defcustom gnus-treat-emphasize
+ (and (or window-system
+ (featurep 'xemacs)
+ (>= (string-to-number emacs-version) 21))
+ 50000)
"Emphasize text.
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-head-custom)
+(defcustom gnus-treat-date-english nil
+ "Display the Date in a format that can be read aloud in English.
+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-head-custom)
+
(defcustom gnus-treat-date-lapsed nil
"Display the Date header in a way that says how much time has elapsed.
Valid values are nil, t, `head', `last', an integer or a predicate.
:type gnus-article-treat-custom)
(put 'gnus-treat-overstrike 'highlight t)
-(defcustom gnus-treat-display-xface
+(defcustom gnus-treat-display-xface
(and (or (and (fboundp 'image-type-available-p)
(image-type-available-p 'xbm)
(string-match "^0x" (shell-command-to-string "uncompface")))
:type gnus-article-treat-head-custom)
(put 'gnus-treat-display-xface 'highlight t)
-(defcustom gnus-treat-display-smileys
+(defcustom gnus-treat-display-smileys
(if (or (and (featurep 'xemacs)
(featurep 'xpm))
(and (fboundp 'image-type-available-p)
;;; Internal variables
+(defvar gnus-english-month-names
+ '("January" "February" "March" "April" "May" "June" "July" "August"
+ "September" "October" "November" "December"))
+
(defvar article-goto-body-goes-to-point-min-p nil)
(defvar gnus-article-wash-types nil)
(defvar gnus-article-emphasis-alist nil)
(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-date-ut gnus-article-date-ut)
+ (gnus-treat-date-local gnus-article-date-local)
+ (gnus-treat-date-english gnus-article-date-english)
+ (gnus-treat-date-lapsed gnus-article-date-lapsed)
+ (gnus-treat-date-original gnus-article-date-original)
+ (gnus-treat-date-user-defined gnus-article-date-user)
+ (gnus-treat-date-iso8601 gnus-article-date-iso8601)
(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-highlight-headers gnus-article-highlight-headers)
(gnus-treat-highlight-citation gnus-article-highlight-citation)
(gnus-treat-highlight-signature gnus-article-highlight-signature)
- (gnus-treat-date-ut gnus-article-date-ut)
- (gnus-treat-date-local gnus-article-date-local)
- (gnus-treat-date-lapsed gnus-article-date-lapsed)
- (gnus-treat-date-original gnus-article-date-original)
- (gnus-treat-date-user-defined gnus-article-date-user)
- (gnus-treat-date-iso8601 gnus-article-date-iso8601)
(gnus-treat-strip-trailing-blank-lines
gnus-article-remove-trailing-blank-lines)
(gnus-treat-strip-leading-blank-lines
(defvar gnus-article-mode-syntax-table
(let ((table (copy-syntax-table text-mode-syntax-table)))
;; This causes the citation match run O(2^n).
- ;; (modify-syntax-entry ?- "w" table)
+ ;; (modify-syntax-entry ?- "w" table)
(modify-syntax-entry ?> ")" table)
(modify-syntax-entry ?< "(" table)
table)
(forward-line 1))))))
(defun article-treat-dumbquotes ()
- "Translate M******** sm*rtq**t*s into proper text.
+ "Translate M****s*** 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."
+not, so it should only be used interactively.
+
+Sm*rtq**t*s are M****s***'s unilateral extension to the character map
+in an attempt to provide more quoting characters. If you see
+something like \\222 or \\264 where you're expecting some kind of
+apostrophe or quotation mark, then try this wash."
(interactive)
(article-translate-strings gnus-article-dumbquotes-map))
(delete-process "article-x-face"))
(let ((inhibit-point-motion-hooks t)
(case-fold-search t)
+ (x-faces "")
from last)
+ (when (gnus-buffer-live-p gnus-original-article-buffer)
+ (with-current-buffer gnus-original-article-buffer
+ (save-restriction
+ (article-narrow-to-head)
+ (while (re-search-forward "^X-Face:" nil t)
+ (setq x-faces
+ (concat
+ x-faces
+ (buffer-substring (match-beginning 0)
+ (1- (re-search-forward
+ "^\\($\\|[^ \t]\\)" nil t)))))))))
(save-restriction
(article-narrow-to-head)
- (goto-char (point-min))
(setq from (message-fetch-field "from"))
+ (when (gnus-buffer-live-p gnus-original-article-buffer)
+ (message-remove-header "X-Face")
+ (goto-char (point-min))
+ (insert x-faces))
(goto-char (point-min))
(while (and gnus-article-x-face-command
(not last)
(not (string-match gnus-article-x-face-too-ugly
from))))
;; Has to be present.
- (re-search-forward "^X-Face: " nil t))
+ (re-search-forward "^X-Face:[\t ]*" nil t))
;; This used to try to do multiple faces (`while' instead of
;; `when' above), but (a) sending multiple EOFs to xv doesn't
;; work (b) it can crash some versions of Emacs (c) are
(let ((inhibit-point-motion-hooks t)
buffer-read-only
(mail-parse-charset gnus-newsgroup-charset)
- (mail-parse-ignored-charsets
+ (mail-parse-ignored-charsets
(save-excursion (set-buffer gnus-summary-buffer)
gnus-newsgroup-ignored-charsets)))
(mail-decode-encoded-word-region (point-min) (point-max)))))
(let ((inhibit-point-motion-hooks t) (case-fold-search t)
buffer-read-only
(mail-parse-charset gnus-newsgroup-charset)
- (mail-parse-ignored-charsets
+ (mail-parse-ignored-charsets
(save-excursion (condition-case nil
(set-buffer gnus-summary-buffer)
(error))
format (and ctl (mail-content-type-get ctl 'format)))
(when cte
(setq cte (mail-header-strip cte)))
- (if (and ctl (not (string-match "/" (car ctl))))
+ (if (and ctl (not (string-match "/" (car ctl))))
(setq ctl nil))
(goto-char (point-max)))
(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
+ (mail-parse-ignored-charsets
(save-excursion (condition-case nil
(set-buffer gnus-summary-buffer)
(error))
(setq type
(gnus-fetch-field "content-transfer-encoding"))
(let* ((ct (gnus-fetch-field "content-type"))
- (ctl (and ct
+ (ctl (and ct
(ignore-errors
(mail-header-parse-content-type ct)))))
(setq charset (and ctl
(mail-content-type-get ctl 'charset)))
(if (stringp charset)
(setq charset (intern (downcase charset)))))))
- (unless charset
+ (unless charset
(setq charset gnus-newsgroup-charset))
(when (or force
(and type (let ((case-fold-search t))
(setq type
(gnus-fetch-field "content-transfer-encoding"))
(let* ((ct (gnus-fetch-field "content-type"))
- (ctl (and ct
+ (ctl (and ct
(ignore-errors
(mail-header-parse-content-type ct)))))
(setq charset (and ctl
(mail-content-type-get ctl 'charset)))
(if (stringp charset)
(setq charset (intern (downcase charset)))))))
- (unless charset
+ (unless charset
(setq charset gnus-newsgroup-charset))
(when (or force
(and type (let ((case-fold-search t))
(if (gnus-buffer-live-p gnus-original-article-buffer)
(with-current-buffer gnus-original-article-buffer
(let* ((ct (gnus-fetch-field "content-type"))
- (ctl (and ct
+ (ctl (and ct
(ignore-errors
(mail-header-parse-content-type ct)))))
(setq charset (and ctl
(mail-content-type-get ctl 'charset)))
(if (stringp charset)
(setq charset (intern (downcase charset)))))))
- (unless charset
+ (unless charset
(setq charset gnus-newsgroup-charset))
(article-goto-body)
(save-window-excursion
(when regexp
(goto-char (point-min))
(when (re-search-forward
- (concat "^Subject: +\\(\\(\\(Re: +\\)?\\(" regexp
+ (concat "^Subject: +\\(\\(\\(Re: +\\)?\\(" regexp
" *\\)\\)+\\(Re: +\\)?\\)")
nil t)
(let ((s (or (match-string 3) (match-string 5))))
(save-excursion
(save-restriction
(let ((inhibit-point-motion-hooks t)
- (banner (gnus-group-find-parameter gnus-newsgroup-name 'banner))
+ (banner (gnus-parameter-banner gnus-newsgroup-name))
(gnus-signature-limit nil)
buffer-read-only beg end)
(when banner
(> arg 0))
nil)
((< arg 0)
- (gnus-article-show-hidden-text type))
+ (gnus-article-show-hidden-text type)
+ t)
(t
(if (eq hide 'hidden)
- (gnus-article-show-hidden-text type)
+ (progn
+ (gnus-article-show-hidden-text type)
+ t)
nil)))))))
(defun gnus-article-hidden-text-p (type)
Originally it is hide instead of DUMMY."
(let ((buffer-read-only nil)
(inhibit-point-motion-hooks t))
- (gnus-remove-text-properties-when
+ (gnus-remove-text-properties-when
'article-type type
- (point-min) (point-max)
+ (point-min) (point-max)
(cons 'article-type (cons type
gnus-hidden-properties)))))
((eq type 'local)
(let ((tz (car (current-time-zone time))))
(format "Date: %s %s%02d%02d" (current-time-string time)
- (if (> tz 0) "+" "-") (/ (abs tz) 3600)
+ (if (> tz 0) "+" "-") (/ (abs tz) 3600)
(/ (% (abs tz) 3600) 60))))
;; Convert to Universal Time.
((eq type 'ut)
"Date: "
(format-time-string "%Y%m%dT%H%M%S" time)
(format "%s%02d%02d"
- (if (> tz 0) "+" "-") (/ (abs tz) 3600)
+ (if (> tz 0) "+" "-") (/ (abs tz) 3600)
(/ (% (abs tz) 3600) 60)))))
;; Do an X-Sent lapsed format.
((eq type 'lapsed)
(if (> real-sec 0)
" ago"
" in the future"))))))
+ ;; Display the date in proper English
+ ((eq type 'english)
+ (let ((dtime (decode-time time)))
+ (concat
+ "Date: the "
+ (number-to-string (nth 3 dtime))
+ (let ((digit (% (nth 3 dtime) 10)))
+ (cond
+ ((memq (nth 3 dtime) '(11 12 13)) "th")
+ ((= digit 1) "st")
+ ((= digit 2) "nd")
+ ((= digit 3) "rd")
+ (t "th")))
+ " of "
+ (nth (1- (nth 4 dtime)) gnus-english-month-names)
+ " "
+ (number-to-string (nth 5 dtime))
+ " at "
+ (format "%02d" (nth 2 dtime))
+ ":"
+ (format "%02d" (nth 1 dtime)))))
(t
(error "Unknown conversion type: %s" type)))))
(interactive (list t))
(article-date-ut 'local highlight))
+(defun article-date-english (&optional highlight)
+ "Convert the current article date to something that is proper English."
+ (interactive (list t))
+ (article-date-ut 'english highlight))
+
(defun article-date-original (&optional highlight)
"Convert the current article date to what it was originally.
This is only useful if you have used some other date conversion
(interactive (gnus-article-hidden-arg))
(unless (gnus-article-check-hidden-text 'emphasis arg)
(save-excursion
- (let ((alist (or
+ (let ((alist (or
(condition-case nil
- (with-current-buffer gnus-summary-buffer
- gnus-article-emphasis-alist)
+ (with-current-buffer gnus-summary-buffer
+ gnus-article-emphasis-alist)
(error))
gnus-emphasis-alist))
(buffer-read-only nil)
(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
+ (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))
highlight)
(copy-sequence highlight-words)
(if gnus-newsgroup-name
- (copy-sequence (gnus-group-find-parameter
+ (copy-sequence (gnus-group-find-parameter
gnus-newsgroup-name 'highlight-words t)))
gnus-emphasis-alist)))))
(let ((sig (with-current-buffer gnus-original-article-buffer
(gnus-fetch-field "X-PGP-Sig")))
items info headers)
- (when (and sig
+ (when (and sig
mml2015-use
(mml2015-clear-verify-function))
(with-temp-buffer
(case-fold-search t))
;; Don't verify multiple headers.
(setq headers (mapconcat (lambda (header)
- (concat header ": "
+ (concat header ": "
(mail-fetch-field header) "\n"))
(split-string (nth 1 items) ",") "")))
(delete-region (point-min) (point-max))
(let ((coding-system-for-write (or gnus-newsgroup-charset
'iso-8859-1)))
(funcall (mml2015-clear-verify-function)))
- (setq info
- (or (mm-handle-multipart-ctl-parameter
+ (setq info
+ (or (mm-handle-multipart-ctl-parameter
mm-security-handle 'gnus-details)
- (mm-handle-multipart-ctl-parameter
+ (mm-handle-multipart-ctl-parameter
mm-security-handle 'gnus-info)))))
(when info
(let (buffer-read-only bface eface)
article-strip-blank-lines
article-strip-all-blank-lines
article-date-local
+ article-date-english
article-date-iso8601
article-date-original
article-date-ut
(substitute-key-definition
'undefined 'gnus-article-read-summary-keys gnus-article-mode-map)
-(eval-when-compile
+(eval-when-compile
(defvar gnus-article-commands-menu))
(defun gnus-article-make-menu-bar ()
(mm-destroy-parts gnus-article-mime-handles)
(setq gnus-article-mime-handles nil))
;; Set it to nil in article-buffer!
- (setq gnus-article-mime-handle-alist nil)
+ (setq gnus-article-mime-handle-alist nil)
(buffer-disable-undo)
(setq buffer-read-only t)
(unless (eq major-mode 'gnus-article-mode)
(defvar gnus-mime-button-map
(let ((map (make-sparse-keymap)))
- ;; Not for Emacs 21: fixme better.
- ;; (set-keymap-parent map gnus-article-mode-map)
+ (unless (>= (string-to-number emacs-version) 21)
+ ;; XEmacs doesn't care.
+ (set-keymap-parent map gnus-article-mode-map))
(define-key map gnus-mouse-2 'gnus-article-push-button)
(define-key map gnus-down-mouse-3 'gnus-mime-button-menu)
(dolist (c gnus-mime-button-commands)
(set-buffer gnus-article-buffer)
(let ((handles (or handles gnus-article-mime-handles))
(mail-parse-charset gnus-newsgroup-charset)
- (mail-parse-ignored-charsets
+ (mail-parse-ignored-charsets
(with-current-buffer gnus-summary-buffer
gnus-newsgroup-ignored-charsets)))
- (mm-remove-parts handles)
- (goto-char (point-min))
- (or (search-forward "\n\n") (goto-char (point-max)))
- (let (buffer-read-only)
- (delete-region (point) (point-max)))
- (mm-display-parts handles))))
+ (when handles
+ (mm-remove-parts handles)
+ (goto-char (point-min))
+ (or (search-forward "\n\n") (goto-char (point-max)))
+ (let (buffer-read-only)
+ (delete-region (point) (point-max)))
+ (mm-display-parts handles)))))
(defun gnus-mime-save-part-and-strip ()
"Save the MIME part under point then replace it with an external body."
(interactive)
(gnus-article-check-buffer)
- (let* ((data (get-text-property (point) 'gnus-data))
- (file (mm-save-part data))
+ (let* ((data (get-text-property (point) 'gnus-data))
+ (file (and data (mm-save-part data)))
param)
(when file
(with-current-buffer (mm-handle-buffer data)
(insert "Content-Transfer-Encoding: binary\n")
(insert "\n"))
(setcdr data
- (cdr (mm-make-handle nil
+ (cdr (mm-make-handle nil
`("message/external-body"
(access-type . "LOCAL-FILE")
(name . ,file)))))
(set-buffer gnus-summary-buffer)
(gnus-article-edit-article
- `(lambda ()
+ `(lambda ()
(erase-buffer)
- (let ((mail-parse-charset (or gnus-article-charset
+ (let ((mail-parse-charset (or gnus-article-charset
',gnus-newsgroup-charset))
- (mail-parse-ignored-charsets
+ (mail-parse-ignored-charsets
(or gnus-article-ignored-charsets
',gnus-newsgroup-ignored-charsets))
(mbl mml-buffer-list))
',gnus-newsgroup-charset))
(message-options message-options)
(message-options-set-recipient)
- (mail-parse-ignored-charsets
+ (mail-parse-ignored-charsets
(or gnus-article-ignored-charsets
',gnus-newsgroup-ignored-charsets)))
(mml-to-mime)
(mml-destroy-buffers)
- (remove-hook 'kill-buffer-hook
+ (remove-hook 'kill-buffer-hook
'mml-destroy-buffers t)
(kill-local-variable 'mml-buffer-list))
(gnus-summary-edit-article-done
,(or (mail-header-references gnus-current-headers) "")
- ,(gnus-group-read-only-p)
+ ,(gnus-group-read-only-p)
,gnus-summary-buffer no-highlight))))))
(defun gnus-mime-save-part ()
(interactive)
(gnus-article-check-buffer)
(let ((data (get-text-property (point) 'gnus-data)))
- (mm-save-part data)))
+ (when 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)))
+ (when data
+ (mm-pipe-part data))))
(defun gnus-mime-view-part ()
"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)))
+ (when data
+ (push (setq data (copy-sequence data)) gnus-article-mime-handles)
+ (mm-interactively-view-part data))))
(defun gnus-mime-view-part-as-type-internal ()
(gnus-article-check-buffer)
(def-type (and name (mm-default-file-encoding name))))
(and def-type (cons def-type 0))))
-(defun gnus-mime-view-part-as-type (mime-type)
+(defun gnus-mime-view-part-as-type (&optional mime-type)
"Choose a MIME media type, and view the part as such."
- (interactive
- (list (completing-read
- "View as MIME type: "
- (mapcar #'list (mailcap-mime-types))
- nil nil
- (gnus-mime-view-part-as-type-internal))))
+ (interactive)
+ (unless mime-type
+ (setq mime-type (completing-read
+ "View as MIME type: "
+ (mapcar #'list (mailcap-mime-types))
+ nil nil
+ (gnus-mime-view-part-as-type-internal))))
(gnus-article-check-buffer)
(let ((handle (get-text-property (point) 'gnus-data)))
- (gnus-mm-display-part
- (mm-make-handle (mm-handle-buffer handle)
- (cons mime-type (cdr (mm-handle-type handle)))
- (mm-handle-encoding handle)
- (mm-handle-undisplayer handle)
- (mm-handle-disposition handle)
- (mm-handle-description handle)
- (mm-handle-cache handle)
- (mm-handle-id handle)))))
+ (when handle
+ (setq handle
+ (mm-make-handle (mm-handle-buffer handle)
+ (cons mime-type (cdr (mm-handle-type handle)))
+ (mm-handle-encoding handle)
+ (mm-handle-undisplayer handle)
+ (mm-handle-disposition handle)
+ (mm-handle-description handle)
+ (mm-handle-cache handle)
+ (mm-handle-id handle)))
+ (push handle gnus-article-mime-handles)
+ (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)))
- (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)
- ;; 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))))
+ (contents (and handle (mm-get-part handle)))
+ (base (and handle
+ (file-name-nondirectory
+ (or
+ (mail-content-type-get (mm-handle-type handle) 'name)
+ (mail-content-type-get (mm-handle-type handle)
+ 'filename)
+ "*decoded*"))))
+ (buffer (and base (generate-new-buffer base))))
+ (when contents
+ (switch-to-buffer buffer)
+ (insert contents)
+ ;; 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 (&optional handle arg)
"Insert the MIME part under point into the current buffer."
contents charset
(b (point))
buffer-read-only)
- (if (and (not arg) (mm-handle-undisplayer handle))
- (mm-remove-part handle)
- (setq contents (mm-get-part handle))
- (cond
- ((not arg)
- (setq charset (or (mail-content-type-get
- (mm-handle-type handle) 'charset)
- gnus-newsgroup-charset)))
- ((numberp arg)
- (if (mm-handle-undisplayer handle)
- (mm-remove-part handle))
- (setq charset
- (or (cdr (assq arg
- gnus-summary-show-article-charset-alist))
- (read-coding-system "Charset: ")))))
- (forward-line 2)
- (mm-insert-inline handle
- (if (and charset
- (setq charset (mm-charset-to-coding-system
- charset))
- (not (eq charset 'ascii)))
- (mm-decode-coding-string contents charset)
- contents))
- (goto-char b))))
+ (when handle
+ (if (and (not arg) (mm-handle-undisplayer handle))
+ (mm-remove-part handle)
+ (setq contents (mm-get-part handle))
+ (cond
+ ((not arg)
+ (setq charset (or (mail-content-type-get
+ (mm-handle-type handle) 'charset)
+ gnus-newsgroup-charset)))
+ ((numberp arg)
+ (if (mm-handle-undisplayer handle)
+ (mm-remove-part handle))
+ (setq charset
+ (or (cdr (assq arg
+ gnus-summary-show-article-charset-alist))
+ (read-coding-system "Charset: ")))))
+ (forward-line 2)
+ (mm-insert-inline handle
+ (if (and charset
+ (setq charset (mm-charset-to-coding-system
+ charset))
+ (not (eq charset 'ascii)))
+ (mm-decode-coding-string contents charset)
+ contents))
+ (goto-char b)))))
(defun gnus-mime-view-part-as-charset (&optional handle arg)
"Insert the MIME part under point into the current buffer."
contents charset
(b (point))
buffer-read-only)
- (if (mm-handle-undisplayer handle)
- (mm-remove-part handle))
- (let ((gnus-newsgroup-charset
- (or (cdr (assq arg
- gnus-summary-show-article-charset-alist))
- (read-coding-system "Charset: ")))
+ (when handle
+ (if (mm-handle-undisplayer handle)
+ (mm-remove-part handle))
+ (let ((gnus-newsgroup-charset
+ (or (cdr (assq arg
+ gnus-summary-show-article-charset-alist))
+ (read-coding-system "Charset: ")))
(gnus-newsgroup-ignored-charsets 'gnus-all))
- (gnus-article-press-button))))
+ (gnus-article-press-button)))))
(defun gnus-mime-externalize-part (&optional handle)
"View the MIME part under point with an external viewer."
(mm-user-display-methods nil)
(mm-inlined-types nil)
(mail-parse-charset gnus-newsgroup-charset)
- (mail-parse-ignored-charsets
+ (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))))
+ (when handle
+ (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.
(mm-inlined-types '(".*"))
(mm-inline-large-images t)
(mail-parse-charset gnus-newsgroup-charset)
- (mail-parse-ignored-charsets
+ (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))))
+ (when handle
+ (if (mm-handle-undisplayer handle)
+ (mm-remove-part handle)
+ (mm-display-part handle)))))
(defun gnus-mime-action-on-part (&optional action)
"Do something with the MIME attachment at \(point\)."
(if condition
(let ((alist gnus-article-mime-handle-alist) ihandle n)
(while (setq ihandle (pop alist))
- (if (and (cond
+ (if (and (cond
((functionp condition)
(funcall condition (cdr ihandle)))
- ((eq condition 'undisplayed)
+ ((eq condition 'undisplayed)
(not (or (mm-handle-undisplayer (cdr ihandle))
(equal (mm-handle-media-type (cdr ihandle))
"multipart/alternative"))))
(interactive "P")
(save-current-buffer
(set-buffer gnus-article-buffer)
- (or (numberp n) (setq n (gnus-article-mime-match-handle-first
+ (or (numberp n) (setq n (gnus-article-mime-match-handle-first
gnus-article-mime-match-handle-function)))
(when (> n (length gnus-article-mime-handle-alist))
(error "No such part"))
(prog1
(let ((window (selected-window))
(mail-parse-charset gnus-newsgroup-charset)
- (mail-parse-ignored-charsets
+ (mail-parse-ignored-charsets
(save-excursion (set-buffer gnus-summary-buffer)
gnus-newsgroup-ignored-charsets)))
(save-excursion
(gnus-eval-format
gnus-mime-button-line-format gnus-mime-button-line-format-alist
`(keymap ,gnus-mime-button-map
- ;; Not for Emacs 21: fixme better.
- ;; local-map ,gnus-mime-button-map
- gnus-callback gnus-mm-display-part
- gnus-part ,gnus-tmp-id
- article-type annotation
- gnus-data ,handle))
+ ,@(if (>= (string-to-number emacs-version) 21)
+ nil
+ (list 'local-map gnus-mime-button-map))
+ gnus-callback gnus-mm-display-part
+ gnus-part ,gnus-tmp-id
+ article-type annotation
+ gnus-data ,handle))
(setq e (point))
(widget-convert-button
'link b e
;;;!!!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
+ ;;;!!! 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)))
+ ;;(gnus-mime-display-mixed (cdr handle))
+ ;;;!!! No, w3 can display everything just fine.
+ (gnus-mime-display-part (cadr handle)))
((equal (car handle) "multipart/signed")
(or (memq 'signed gnus-article-wash-types)
(push 'signed gnus-article-wash-types))
;(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)
+ (gnus-article-insert-newline)
+ ;(gnus-article-insert-newline)
;; Remember modify the number of forward lines.
(setq move t))
(setq beg (point))
(forward-line -1)
(setq beg (point)))
(let ((mail-parse-charset gnus-newsgroup-charset)
- (mail-parse-ignored-charsets
+ (mail-parse-ignored-charsets
(save-excursion (condition-case ()
(set-buffer gnus-summary-buffer)
(error))
(save-restriction
(narrow-to-region beg (point))
(gnus-treat-article
- nil id
+ nil id
(gnus-article-mime-total-parts)
(mm-handle-media-type handle)))))))))
',gnus-article-mime-handle-alist))
(gnus-mime-display-alternative
',ihandles ',not-pref ',begend ,id))
- ;; Not for Emacs 21: fixme better.
- ;; local-map ,gnus-mime-button-map
+ ,@(if (>= (string-to-number emacs-version) 21)
+ nil ;; XEmacs doesn't care
+ (list '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-article-mime-handle-alist))
(gnus-mime-display-alternative
',ihandles ',handle ',begend ,id))
- ;; Not for Emacs 21: fixme better.
- ;; local-map ,gnus-mime-button-map
+ ,@(if (>= (string-to-number emacs-version) 21)
+ nil ;; XEmacs doesn't care
+ (list 'local-map gnus-mime-button-map))
,gnus-mouse-face-prop ,gnus-article-mouse-face
face ,gnus-article-button-face
keymap ,gnus-mime-button-map
(if (stringp (car preferred))
(gnus-display-mime preferred)
(let ((mail-parse-charset gnus-newsgroup-charset)
- (mail-parse-ignored-charsets
+ (mail-parse-ignored-charsets
(save-excursion (set-buffer gnus-summary-buffer)
gnus-newsgroup-ignored-charsets)))
(mm-display-part preferred)
(setq keys (if (featurep 'xemacs)
(events-to-keys (read-key-sequence nil))
(read-key-sequence nil)))))
-
+
(message "")
(if (or (member keys nosaves)
((or (stringp article)
(numberp article))
(let ((gnus-override-method gnus-override-method)
- (methods (and (stringp article)
+ (methods (and (stringp article)
gnus-refer-article-method))
result
(buffer-read-only nil))
(gnus-check-group-server))
(when (gnus-request-article article group (current-buffer))
(when (numberp article)
- (gnus-async-prefetch-next group article
+ (gnus-async-prefetch-next group article
gnus-summary-buffer)
(when gnus-keep-backlog
(gnus-backlog-enter-article
(defun gnus-article-encrypt-body (protocol &optional n)
"Encrypt the article body."
- (interactive
+ (interactive
(list
(or gnus-article-encrypt-protocol
(completing-read "Encrypt protocol: "
- gnus-article-encrypt-protocol-alist
+ gnus-article-encrypt-protocol-alist
nil t))
current-prefix-arg))
(let ((func (cdr (assoc protocol gnus-article-encrypt-protocol-alist))))
(let* ((buffer-read-only nil)
(headers
(mapcar (lambda (field)
- (and (save-restriction
+ (and (save-restriction
(message-narrow-to-head)
(goto-char (point-min))
(search-forward field nil t))
(defvar gnus-mime-security-button-map
(let ((map (make-sparse-keymap)))
- (set-keymap-parent map gnus-article-mode-map)
+ (unless (>= (string-to-number emacs-version) 21)
+ (set-keymap-parent map gnus-article-mode-map))
(define-key map gnus-mouse-2 'gnus-article-push-button)
(define-key map "\r" 'gnus-article-press-button)
map))
(mm-remove-parts (cdr handle))
(let ((region (mm-handle-multipart-ctl-parameter handle 'gnus-region))
buffer-read-only)
- (when region
+ (when region
(delete-region (car region) (cdr region))
(set-marker (car region) nil)
(set-marker (cdr region) nil)))
(if details
(if gnus-mime-security-show-details-inline
(let ((gnus-mime-security-button-pressed t)
- (gnus-mime-security-button-line-format
+ (gnus-mime-security-button-line-format
(get-text-property (point) 'gnus-line-format))
buffer-read-only)
(forward-char -1)
(forward-char -1))
(forward-char)
(delete-region (point)
- (or (text-property-not-all
+ (or (text-property-not-all
(point) (point-max)
- 'gnus-line-format
+ 'gnus-line-format
gnus-mime-security-button-line-format)
(point-max)))
(gnus-insert-mime-security-button handle))
(defun gnus-insert-mime-security-button (handle &optional displayed)
(let* ((protocol (mm-handle-multipart-ctl-parameter handle 'protocol))
(gnus-tmp-type
- (concat
+ (concat
(or (nth 2 (assoc protocol mm-verify-function-alist))
(nth 2 (assoc protocol mm-decrypt-function-alist))
"Unknown")
(setq gnus-tmp-details
(if gnus-tmp-details
(concat "\n" gnus-tmp-details) ""))
- (setq gnus-tmp-pressed-details
+ (setq gnus-tmp-pressed-details
(if gnus-mime-security-button-pressed gnus-tmp-details ""))
(unless (bolp)
(insert "\n"))
(setq b (point))
(gnus-eval-format
- gnus-mime-security-button-line-format
+ gnus-mime-security-button-line-format
gnus-mime-security-button-line-format-alist
- `(local-map ,gnus-mime-security-button-map
- keymap ,gnus-mime-security-button-map
- gnus-callback gnus-mime-security-press-button
- gnus-line-format ,gnus-mime-security-button-line-format
- article-type annotation
- gnus-data ,handle))
+ `(keymap ,gnus-mime-security-button-map
+ ,@(if (>= (string-to-number emacs-version) 21)
+ nil ;; XEmacs doesn't care
+ (list 'local-map gnus-mime-security-button-map))
+ gnus-callback gnus-mime-security-press-button
+ gnus-line-format ,gnus-mime-security-button-line-format
+ article-type annotation
+ gnus-data ,handle))
(setq e (point))
(widget-convert-button
'link b e
(gnus-mime-display-mixed (cdr handle))
(unless (bolp)
(insert "\n"))
- (let ((gnus-mime-security-button-line-format
+ (let ((gnus-mime-security-button-line-format
gnus-mime-security-button-end-line-format))
(gnus-insert-mime-security-button handle))
- (mm-set-handle-multipart-parameter handle 'gnus-region
- (cons (set-marker (make-marker)
- (point-min))
- (set-marker (make-marker)
- (point-max))))))
+ (mm-set-handle-multipart-parameter
+ handle 'gnus-region
+ (cons (set-marker (make-marker) (point-min))
+ (set-marker (make-marker) (point-max))))))
(gnus-ems-redefine)
projects / gnus / blobdiff