'empty Headers with no content.
'newsgroups Newsgroup identical to Gnus group.
'to-address To identical to To-address.
+ 'to-list To identical to To-list.
+ 'cc-list CC identical to To-list.
'followup-to Followup-to identical to Newsgroups.
'reply-to Reply-to identical to From.
'date Date less than four days old.
:type '(set (const :tag "Headers with no content." empty)
(const :tag "Newsgroups identical to Gnus group." newsgroups)
(const :tag "To identical to To-address." to-address)
+ (const :tag "To identical to To-list." to-list)
+ (const :tag "CC identical to To-list." cc-list)
(const :tag "Followup-to identical to Newsgroups." followup-to)
(const :tag "Reply-to identical to From." reply-to)
(const :tag "Date less than four days old." date)
(defcustom gnus-article-decode-hook
'(article-decode-charset article-decode-encoded-words
- article-decode-group-name)
+ article-decode-group-name article-decode-idna-rhs)
"*Hook run to decode charsets in articles."
:group 'gnus-article-headers
:type 'hook)
(defcustom gnus-mime-action-alist
'(("save to file" . gnus-mime-save-part)
("save and strip" . gnus-mime-save-part-and-strip)
+ ("delete part" . gnus-mime-delete-part)
("display as text" . gnus-mime-inline-part)
("view the part" . gnus-mime-view-part)
("pipe to command" . gnus-mime-pipe-part)
(defvar gnus-inhibit-treatment nil
"Whether to inhibit treatment.")
-(defcustom gnus-treat-highlight-signature '(or last (typep "text/x-vcard"))
+(defcustom gnus-treat-highlight-signature '(or t (typep "text/x-vcard"))
"Highlight the signature.
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles'."
(defvar gnus-article-wash-function nil
"Function used for converting HTML into text.")
+(defcustom gnus-use-idna (condition-case nil (require 'idna) (file-error))
+ "Whether IDNA decoding of headers is used when viewing messages.
+This requires GNU Libidn, and by default only enabled if it is found."
+ :group 'gnus-article-headers
+ :type 'boolean)
+
;;; Internal variables
(defvar gnus-english-month-names
(while (re-search-forward "^[^: \t]+:[ \t]*\n[^ \t]" nil t)
(forward-line -1)
(gnus-article-hide-text-type
- (progn (beginning-of-line) (point))
+ (gnus-point-at-bol)
(progn
(end-of-line)
(if (re-search-forward "^[^ \t]" nil t)
(nth 1 (mail-extract-address-components to))
to-address)))
(gnus-article-hide-header "to"))))
+ ((eq elem 'to-list)
+ (let ((to (message-fetch-field "to"))
+ (to-list
+ (gnus-parameter-to-list
+ (if (boundp 'gnus-newsgroup-name)
+ gnus-newsgroup-name ""))))
+ (when (and to to-list
+ (ignore-errors
+ (gnus-string-equal
+ ;; only one address in To
+ (nth 1 (mail-extract-address-components to))
+ to-list)))
+ (gnus-article-hide-header "to"))))
+ ((eq elem 'cc-list)
+ (let ((cc (message-fetch-field "cc"))
+ (to-list
+ (gnus-parameter-to-list
+ (if (boundp 'gnus-newsgroup-name)
+ gnus-newsgroup-name ""))))
+ (when (and cc to-list
+ (ignore-errors
+ (gnus-string-equal
+ ;; only one address in CC
+ (nth 1 (mail-extract-address-components cc))
+ to-list)))
+ (gnus-article-hide-header "cc"))))
((eq elem 'followup-to)
(when (gnus-string-equal
(message-fetch-field "followup-to")
(goto-char (point-min))
(when (re-search-forward (concat "^" header ":") nil t)
(gnus-article-hide-text-type
- (progn (beginning-of-line) (point))
+ (gnus-point-at-bol)
(progn
(end-of-line)
(if (re-search-forward "^[^ \t]" nil t)
(while (not (eobp))
(save-restriction
(mail-header-narrow-to-field)
- (let ((header (buffer-substring (point-min) (point-max))))
+ (let ((header (buffer-string)))
(with-temp-buffer
(insert header)
(goto-char (point-min))
(mm-decode-body
charset (and cte (intern (downcase
(gnus-strip-whitespace cte))))
- (car ctl)))))))
+ (car ctl) prompt))))))
(defun article-decode-encoded-words ()
"Remove encoded-word encoding from headers."
(nnmail-fetch-field "Followup-To"))
gnus-newsgroup-name method))))))
+(defun article-decode-idna-rhs ()
+ "Decode IDNA strings in RHS in From:, To: and Cc: headers in current buffer."
+ (when gnus-use-idna
+ (save-restriction
+ (let ((inhibit-point-motion-hooks t)
+ buffer-read-only)
+ (article-narrow-to-head)
+ (goto-char (point-min))
+ (while (re-search-forward "\\(xn--.*\\)[ \t\n\r,>]" nil t)
+ (let (ace unicode)
+ (when (save-match-data
+ (and (setq ace (match-string 1))
+ (save-excursion
+ (and (re-search-backward "^[^ \t]" nil t)
+ (looking-at "From\\|To\\|Cc")))
+ (save-excursion (backward-char)
+ (message-idna-inside-rhs-p))
+ (setq unicode (idna-to-unicode ace))))
+ (unless (string= ace unicode)
+ (replace-match unicode nil nil nil 1)))))))))
+
(defun article-de-quoted-unreadable (&optional force read-charset)
"Translate a quoted-printable-encoded article.
If FORCE, decode the article whether it is marked as quoted-printable
(let ((w3m-safe-url-regexp (if mm-inline-text-html-with-images
nil
"\\`cid:"))
- (w3m-display-inline-images mm-inline-text-html-with-images)
w3m-force-redisplay)
(w3m-region (point-min) (point-max)))
(when mm-inline-text-html-with-w3m-keymap
(gnus-mime-view-part-as-charset "C" "View As charset...")
(gnus-mime-save-part "o" "Save...")
(gnus-mime-save-part-and-strip "\C-o" "Save and Strip")
+ (gnus-mime-delete-part "d" "Delete part")
(gnus-mime-copy-part "c" "View As Text, In Other Buffer")
(gnus-mime-inline-part "i" "View As Text, In This Buffer")
(gnus-mime-view-part-internally "E" "View Internally")
,@(mapcar (lambda (c)
(vector (caddr c) (car c) :enable t)) gnus-mime-button-commands)))
+(eval-when-compile
+ (define-compiler-macro popup-menu (&whole form
+ menu &optional position prefix)
+ (if (and (fboundp 'popup-menu)
+ (not (memq 'popup-menu (assoc "lmenu" load-history))))
+ form
+ ;; Gnus is probably running under Emacs 20.
+ `(let* ((menu (cdr ,menu))
+ (response (x-popup-menu
+ t (list (car menu)
+ (cons "" (mapcar (lambda (c)
+ (cons (caddr c) (car c)))
+ (cdr menu)))))))
+ (if response
+ (call-interactively (nth 3 (assq response menu))))))))
+
(defun gnus-mime-button-menu (event prefix)
"Construct a context-sensitive menu of MIME commands."
(interactive "e\nP")
,(gnus-group-read-only-p)
,gnus-summary-buffer no-highlight))))))
+(defun gnus-mime-delete-part ()
+ "Delete the MIME part under point.
+Replace it with some information about the removed part."
+ (interactive)
+ (gnus-article-check-buffer)
+ (let* ((data (get-text-property (point) 'gnus-data))
+ (handles gnus-article-mime-handles)
+ (none "(none)")
+ (description
+ (or
+ (mail-decode-encoded-word-string (or (mm-handle-description data)
+ none))))
+ (filename
+ (or (mail-content-type-get (mm-handle-disposition data) 'filename)
+ none))
+ (type (mm-handle-media-type data)))
+ (if (mm-multiple-handles gnus-article-mime-handles)
+ (error "This function is not implemented"))
+ (with-current-buffer (mm-handle-buffer data)
+ (let ((bsize (format "%s" (buffer-size))))
+ (erase-buffer)
+ (insert
+ (concat
+ "<#part type=text/plain nofile=yes disposition=attachment"
+ " description=\"Deleted attachment (" bsize " Byte)\">"
+ ",----\n"
+ "| The following attachment has been deleted:\n"
+ "|\n"
+ "| Type: " type "\n"
+ "| Filename: " filename "\n"
+ "| Size (encoded): " bsize " Byte\n"
+ "| Description: " description "\n"
+ "`----\n"
+ "<#/part>"))
+ (setcdr data
+ (cdr (mm-make-handle nil `("text/plain"))))))
+ (set-buffer gnus-summary-buffer)
+ ;; FIXME: maybe some of the following code (borrowed from
+ ;; `gnus-mime-save-part-and-strip') isn't necessary?
+ (gnus-article-edit-article
+ `(lambda ()
+ (erase-buffer)
+ (let ((mail-parse-charset (or gnus-article-charset
+ ',gnus-newsgroup-charset))
+ (mail-parse-ignored-charsets
+ (or gnus-article-ignored-charsets
+ ',gnus-newsgroup-ignored-charsets))
+ (mbl mml-buffer-list))
+ (setq mml-buffer-list nil)
+ (insert-buffer gnus-original-article-buffer)
+ (mime-to-mml ',handles)
+ (setq gnus-article-mime-handles nil)
+ (let ((mbl1 mml-buffer-list))
+ (setq mml-buffer-list mbl)
+ (set (make-local-variable 'mml-buffer-list) mbl1))
+ ;; LOCAL argument of add-hook differs between GNU Emacs
+ ;; and XEmacs. make-local-hook makes sure they are local.
+ (make-local-hook 'kill-buffer-hook)
+ (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
+ `(lambda (no-highlight)
+ (let ((mail-parse-charset (or gnus-article-charset
+ ',gnus-newsgroup-charset))
+ (message-options message-options)
+ (message-options-set-recipient)
+ (mail-parse-ignored-charsets
+ (or gnus-article-ignored-charsets
+ ',gnus-newsgroup-ignored-charsets)))
+ (mml-to-mime)
+ (mml-destroy-buffers)
+ (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-summary-buffer no-highlight))))
+ ;; Not in `gnus-mime-save-part-and-strip':
+ (gnus-article-edit-done)
+ (gnus-summary-expand-window)
+ (gnus-summary-show-article))
+
(defun gnus-mime-save-part ()
"Save the MIME part under point."
(interactive)
(interactive
(list (completing-read "Action: " gnus-mime-action-alist nil t)))
(gnus-article-check-buffer)
- (let ((action-pair (assoc action gnus-mime-action-alistq)))
+ (let ((action-pair (assoc action gnus-mime-action-alist)))
(if action-pair
(funcall (cdr action-pair)))))
(if (window-live-p window)
(select-window window)))))
(goto-char point)
- (delete-region (gnus-point-at-bol) (progn (forward-line 1) (point)))
+ (gnus-delete-line)
(gnus-insert-mime-button
handle id (list (mm-handle-displayed-p handle)))
(goto-char point))))
(defun gnus-article-goto-part (n)
"Go to MIME part N."
- (let ((point (text-property-any (point-min) (point-max) 'gnus-part n)))
- (when point
- (goto-char point))))
+ (gnus-goto-char (text-property-any (point-min) (point-max) 'gnus-part n)))
(defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed)
(let ((gnus-tmp-name
gnus-part ,gnus-tmp-id
article-type annotation
gnus-data ,handle))
- (setq e (point))
+ (setq e (if (bolp)
+ ;; Exclude a newline.
+ (1- (point))
+ (point)))
(widget-convert-button
'link b e
:mime-handle handle
"Read article specified by message-id around point."
(interactive)
(save-excursion
- (re-search-backward "<?news:\\|<" (point-at-bol) t)
- (cond ((re-search-forward
- gnus-button-mid-or-mail-regexp (point-at-eol) t)
- (let ((msg-id (concat "<" (match-string 0) ">")))
- (set-buffer gnus-summary-buffer)
- (gnus-summary-refer-article msg-id)))
- (t
- (error "No references around point")))))
+ (re-search-backward "[ \t]\\|^" (gnus-point-at-bol) t)
+ (re-search-forward "<?news:<?\\|<" (gnus-point-at-eol) t)
+ (if (re-search-forward "[^@ ]+@[^ \t>]+" (gnus-point-at-eol) t)
+ (let ((msg-id (concat "<" (match-string 0) ">")))
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-refer-article msg-id))
+ (error "No references around point"))))
(defun gnus-article-show-summary ()
"Reconfigure windows to show summary buffer."
(gnus-cache-request-article article group))
'article)
;; Check the agent cache.
- ((and gnus-agent gnus-agent-cache gnus-plugged
- (numberp article)
- (gnus-agent-request-article article group))
+ ((gnus-agent-request-article article group)
'article)
;; Get the article and put into the article buffer.
((or (stringp article)
(-3.0
. "[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9].*@")
;; "[0-9]{12,}.*\@"
+ ;; compensation for TDMA dated mail addresses:
+ (25.0 . "-dated-[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]+.*@")
;;
(-20.0 . "\\.fsf@") ;; Gnus
(-20.0 . "^slrn")
gnus-callback gnus-article-button-prev-page
article-type annotation))
(widget-convert-button
- 'link b (point)
+ 'link b (if (bolp)
+ ;; Exclude a newline.
+ (1- (point))
+ (point))
:action 'gnus-button-prev-page
:button-keymap gnus-prev-page-map)))
gnus-callback gnus-article-button-next-page
article-type annotation))
(widget-convert-button
- 'link b (point)
+ 'link b (if (bolp)
+ ;; Exclude a newline.
+ (1- (point))
+ (point))
:action 'gnus-button-next-page
:button-keymap gnus-next-page-map)))
(search-forward field nil t))
(prog2
(message-narrow-to-field)
- (buffer-substring (point-min) (point-max))
+ (buffer-string)
(delete-region (point-min) (point-max))
(widen))))
'("Content-Type:" "Content-Transfer-Encoding:"
gnus-mime-details ,gnus-mime-security-button-pressed
article-type annotation
gnus-data ,handle))
- (setq e (point))
+ (setq e (if (bolp)
+ ;; Exclude a newline.
+ (1- (point))
+ (point)))
(widget-convert-button
'link b e
:mime-handle handle
projects / gnus / blobdiff