(defcustom gnus-ignored-headers
'("^Path:" "^Expires:" "^Date-Received:" "^References:" "^Xref:" "^Lines:"
- "^Relay-Version:" "^Message-ID:" "^Approved:" "^Sender:" "^Received:"
+ "^Relay-Version:" "^Message-ID:" "^Approved:" "^Sender:" "^Received:"
"^X-UIDL:" "^MIME-Version:" "^Return-Path:" "^In-Reply-To:"
"^Content-Type:" "^Content-Transfer-Encoding:" "^X-WebTV-Signature:"
"^X-MimeOLE:" "^X-MSMail-Priority:" "^X-Priority:" "^X-Loop:"
"^X-Complaints-To:" "^X-NNTP-Posting-Host:" "^X-Orig.*:"
"^Abuse-Reports-To:" "^Cache-Post-Path:" "^X-Article-Creation-Date:"
"^X-Poster:" "^X-Mail2News-Path:" "^X-Server-Date:" "^X-Cache:"
- "^Originator:" "^X-Problems-To:" "^X-Auth-User:" "^X-Post-Time:"
+ "^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:"
(defvar gnus-decode-header-function 'mail-decode-encoded-word-region
"Function used to decode headers.")
+(defvar gnus-article-dumbquotes-map
+ '(("\202" . ",")
+ ("\203" . "f")
+ ("\204" . ",,")
+ ("\213" . "<")
+ ("\214" . "OE")
+ ("\205" . "...")
+ ("\221" . "`")
+ ("\222" . "'")
+ ("\223" . "``")
+ ("\224" . "''")
+ ("\225" . "*")
+ ("\226" . "-")
+ ("\227" . "-")
+ ("\231" . "(TM)")
+ ("\233" . ">")
+ ("\234" . "oe")
+ ("\264" . "'"))
+ "Table for MS-to-Latin1 translation.")
+
;;; Internal variables
+(defvar gnus-article-mime-handle-alist nil)
(defvar article-lapsed-timer nil)
(defvar gnus-article-current-summary nil)
(defun article-treat-dumbquotes ()
"Translate M******** sm*rtq**t*s into proper text."
(interactive)
- (article-translate-characters "\221\222\223\224" "`'\"\""))
+ (article-translate-strings gnus-article-dumbquotes-map))
(defun article-translate-characters (from to)
"Translate all characters in the body of the article according to FROM and TO.
(incf i))
(translate-region (point) (point-max) x)))))
+(defun article-translate-strings (map)
+ "Translate all string in the body of the article according to MAP.
+MAP is an alist where the elements are on the form (\"from\" \"to\")."
+ (save-excursion
+ (goto-char (point-min))
+ (when (search-forward "\n\n" nil t)
+ (let ((buffer-read-only nil)
+ elem)
+ (while (setq elem (pop map))
+ (save-excursion
+ (while (search-forward (car elem) nil t)
+ (replace-match (cadr elem)))))))))
+
(defun article-treat-overstrike ()
"Translate overstrikes into bold text."
(interactive)
(save-restriction
(message-narrow-to-head)
(let* ((inhibit-point-motion-hooks t)
+ (case-fold-search t)
(ct (message-fetch-field "Content-Type" t))
(cte (message-fetch-field "Content-Transfer-Encoding" t))
(ctl (and ct (condition-case ()
buffer-read-only)
(goto-char (point-max))
(widen)
+ (forward-line 1)
(narrow-to-region (point) (point-max))
(when (or (not ct)
(equal (car ctl) "text/plain"))
(and type (string-match "quoted-printable" (downcase type))))
(goto-char (point-min))
(search-forward "\n\n" nil 'move)
- (quoted-printable-decode-region (point) (point-max))))))
+ (quoted-printable-decode-region (point) (point-max))
+ (when mm-default-coding-system
+ (mm-decode-body mm-default-coding-system))))))
(defun article-mime-decode-quoted-printable-buffer ()
"Decode Quoted-Printable in the current buffer."
;; Hide the "header".
(when (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t)
(delete-region (1+ (match-beginning 0)) (match-end 0))
+ ;; PGP 5 and GNU PG add a `Hash: <>' comment, hide that too
+ (when (looking-at "Hash:.*$")
+ (delete-region (point) (1+ (gnus-point-at-eol))))
(setq beg (point))
;; Hide the actual signature.
(and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t)
(let (deactivate-mark)
(save-excursion
(ignore-errors
- (when (gnus-buffer-live-p gnus-article-buffer)
- (set-buffer gnus-article-buffer)
- (goto-char (point-min))
- (when (re-search-forward "^X-Sent:" nil t)
- (article-date-lapsed t)))))))
+ (walk-windows
+ (lambda (w)
+ (set-buffer (window-buffer w))
+ (when (eq major-mode 'gnus-article-mode)
+ (goto-char (point-min))
+ (when (re-search-forward "^X-Sent:" nil t)
+ (article-date-lapsed t)))))))))
(defun gnus-start-date-timer (&optional n)
"Start a timer to update the X-Sent header in the article buffers.
(defun gnus-summary-save-in-pipe (&optional command)
"Pipe this article to subprocess."
(setq command
- (cond ((eq command 'default)
+ (cond ((and (eq command 'default)
+ gnus-last-shell-command)
gnus-last-shell-command)
(command command)
(t (read-string
" " gnus-article-goto-next-page
"\177" gnus-article-goto-prev-page
[delete] gnus-article-goto-prev-page
- "\r" widget-button-press
"\C-c^" gnus-article-refer-article
"h" gnus-article-show-summary
"s" gnus-article-show-summary
(make-local-variable 'gnus-button-marker-list)
(make-local-variable 'gnus-article-current-summary)
(make-local-variable 'gnus-article-mime-handles)
+ (make-local-variable 'gnus-article-decoded-p)
+ (make-local-variable 'gnus-article-mime-handle-alist)
(gnus-set-default-directory)
- (buffer-disable-undo (current-buffer))
+ (buffer-disable-undo)
(setq buffer-read-only t)
(set-syntax-table gnus-article-mode-syntax-table)
(mm-enable-multibyte)
(substring name (match-end 0))))))
(setq gnus-article-buffer name)
(setq gnus-original-article-buffer original)
+ (setq gnus-article-mime-handle-alist nil)
;; This might be a variable local to the summary buffer.
(unless gnus-single-article-buffer
(save-excursion
(if (get-buffer name)
(save-excursion
(set-buffer name)
- (buffer-disable-undo (current-buffer))
+ (buffer-disable-undo)
(setq buffer-read-only t)
(unless (eq major-mode 'gnus-article-mode)
(gnus-article-mode))
(set-buffer (gnus-get-buffer-create name))
(gnus-article-mode)
(make-local-variable 'gnus-summary-buffer)
+ (gnus-summary-set-local-parameters gnus-newsgroup-name)
(current-buffer)))))
;; Set article window start at LINE, where LINE is the number of lines
(or all-headers gnus-show-all-headers))))
(when (or (numberp article)
(stringp article))
- ;; Hooks for getting information from the article.
- ;; This hook must be called before being narrowed.
- (let (buffer-read-only)
- (gnus-run-hooks 'gnus-tmp-internal-hook)
- (gnus-run-hooks 'gnus-article-prepare-hook)
- (when gnus-display-mime-function
- (funcall gnus-display-mime-function))
- ;; Perform the article display hooks.
- (gnus-run-hooks 'gnus-article-display-hook))
+ (gnus-article-prepare-display)
;; Do page break.
(goto-char (point-min))
(setq gnus-page-broken
(set-window-point (get-buffer-window (current-buffer)) (point))
t))))))
+(defun gnus-article-prepare-display ()
+ "Make the current buffer look like a nice article."
+ ;; Hooks for getting information from the article.
+ ;; This hook must be called before being narrowed.
+ (let ((gnus-article-buffer (current-buffer))
+ buffer-read-only)
+ (unless (eq major-mode 'gnus-article-mode)
+ (gnus-article-mode))
+ (setq buffer-read-only nil)
+ (gnus-run-hooks 'gnus-tmp-internal-hook)
+ (gnus-run-hooks 'gnus-article-prepare-hook)
+ (when gnus-display-mime-function
+ (let ((url-standalone-mode (not gnus-plugged)))
+ (funcall gnus-display-mime-function)))
+ ;; Perform the article display hooks.
+ (gnus-run-hooks 'gnus-article-display-hook)))
+
;;;
;;; Gnus MIME viewing functions
;;;
-(defvar gnus-mime-button-line-format "%{%([%t%d%n]%)%}\n")
+(defvar gnus-mime-button-line-format "%{%([%p. %t%d%n]%)%}%e\n"
+ "The following specs can be used:
+%t The MIME type
+%n The `name' parameter
+%d The description, if any
+%l The length of the encoded part
+%p The part identifier
+%e Dots if the part isn't displayed")
+
(defvar gnus-mime-button-line-format-alist
'((?t gnus-tmp-type ?s)
(?n gnus-tmp-name ?s)
- (?d gnus-tmp-description ?s)))
+ (?d gnus-tmp-description ?s)
+ (?p gnus-tmp-id ?s)
+ (?l gnus-tmp-length ?d)
+ (?e gnus-tmp-dots ?s)))
+
+(defvar gnus-mime-button-commands
+ '((gnus-article-press-button "\r" "Toggle Display")
+ ;(gnus-mime-view-part "\M-\r" "View Interactively...")
+ (gnus-mime-view-part "v" "View Interactively...")
+ (gnus-mime-save-part "o" "Save...")
+ (gnus-mime-copy-part "c" "View In Buffer")
+ (gnus-mime-inline-part "i" "View Inline")
+ (gnus-mime-pipe-part "|" "Pipe To Command...")))
(defvar gnus-mime-button-map nil)
(unless gnus-mime-button-map
- (setq gnus-mime-button-map (copy-keymap gnus-article-mode-map))
+ (setq gnus-mime-button-map (make-sparse-keymap))
+ (set-keymap-parent gnus-mime-button-map gnus-article-mode-map)
(define-key gnus-mime-button-map gnus-mouse-2 'gnus-article-push-button)
- (define-key gnus-mime-button-map "\r" 'gnus-article-press-button)
- (define-key gnus-mime-button-map "\M-\r" 'gnus-mime-view-part)
- (define-key gnus-mime-button-map "v" 'gnus-mime-view-part)
- (define-key gnus-mime-button-map "o" 'gnus-mime-save-part)
- (define-key gnus-mime-button-map "c" 'gnus-mime-copy-part)
- (define-key gnus-mime-button-map "|" 'gnus-mime-pipe-part))
+ (define-key gnus-mime-button-map gnus-mouse-3 'gnus-mime-button-menu)
+ (mapcar (lambda (c)
+ (define-key gnus-mime-button-map (cadr c) (car c)))
+ gnus-mime-button-commands))
+
+(defun gnus-mime-button-menu (event)
+ "Construct a context-sensitive menu of MIME commands."
+ (interactive "e")
+ )
+
+(defun gnus-mime-view-all-parts ()
+ "View all the MIME parts."
+ (interactive)
+ (let ((handles gnus-article-mime-handles))
+ (while handles
+ (mm-display-part (pop handles)))))
(defun gnus-mime-save-part ()
"Save the MIME part under point."
(defun gnus-mime-view-part ()
"Interactively choose a view method for the MIME part under point."
(interactive)
- (let ((data (get-text-property (point) 'gnus-data)))
+ (let ((data (get-text-property (point) 'gnus-data))
+ (url-standalone-mode (not gnus-plugged)))
(mm-interactively-view-part data)))
(defun gnus-mime-copy-part ()
"Put the the MIME part under point into a new buffer."
(interactive)
- (let* ((data (get-text-property (point) 'gnus-data))
- (contents (mm-get-part data)))
- (switch-to-buffer (generate-new-buffer "*decoded*"))
+ (let* ((handle (get-text-property (point) 'gnus-data))
+ (contents (mm-get-part handle))
+ (buffer (generate-new-buffer
+ (file-name-nondirectory
+ (or
+ (mail-content-type-get (mm-handle-type handle) 'name)
+ (mail-content-type-get (mm-handle-type handle)
+ 'filename)
+ "*decoded*")))))
+ (set-buffer-major-mode buffer)
+ (switch-to-buffer buffer)
(insert contents)
(goto-char (point-min))))
-(defun gnus-insert-mime-button (handle)
+(defun gnus-mime-inline-part ()
+ "Insert the MIME part under point into the current buffer."
+ (interactive)
+ (let* ((data (get-text-property (point) 'gnus-data))
+ (contents (mm-get-part data))
+ (url-standalone-mode (not gnus-plugged))
+ (b (point))
+ buffer-read-only)
+ (if (mm-handle-undisplayer data)
+ (mm-remove-part data)
+ (forward-line 2)
+ (mm-insert-inline data contents)
+ (goto-char b))))
+
+(defun gnus-article-view-part (n)
+ "View MIME part N, which is the numerical prefix."
+ (interactive "p")
+ (save-current-buffer
+ (set-buffer gnus-article-buffer)
+ (when (> n (length gnus-article-mime-handle-alist))
+ (error "No such part"))
+ (let ((handle (cdr (assq n gnus-article-mime-handle-alist))))
+ (gnus-article-goto-part n)
+ (gnus-set-window-start)
+ (gnus-mm-display-part handle))))
+
+(defun gnus-mm-display-part (handle)
+ "Display HANDLE and fix MIME button."
+ (let ((id (get-text-property (point) 'gnus-part))
+ buffer-read-only)
+ (delete-region (gnus-point-at-bol) (progn (forward-line 1) (point)))
+ (gnus-insert-mime-button
+ handle id (list (not (mm-handle-displayed-p handle)))))
+ (mm-display-part handle))
+
+(defun gnus-article-goto-part (n)
+ "Go to MIME part N."
+ (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 (mail-content-type-get (mm-handle-type handle) 'name))
(gnus-tmp-type (car (mm-handle-type handle)))
(gnus-tmp-description (mm-handle-description handle))
+ (gnus-tmp-dots
+ (if (if displayed (car displayed)
+ (mm-handle-displayed-p handle))
+ "" "..."))
+ (gnus-tmp-length (save-excursion
+ (set-buffer (mm-handle-buffer handle))
+ (buffer-size)))
b e)
(setq gnus-tmp-name
- (if gnus-tmp-name
- (concat " (" gnus-tmp-name ")")
- ""))
+ (if gnus-tmp-name
+ (concat " (" gnus-tmp-name ")")
+ ""))
(setq gnus-tmp-description
- (if gnus-tmp-description
- (concat " (" gnus-tmp-description ")")
- ""))
+ (if gnus-tmp-description
+ (concat " (" gnus-tmp-description ")")
+ ""))
(setq b (point))
(gnus-eval-format
gnus-mime-button-line-format gnus-mime-button-line-format-alist
`(local-map ,gnus-mime-button-map
keymap ,gnus-mime-button-map
- gnus-callback mm-display-part
+ gnus-callback gnus-mm-display-part
+ gnus-part ,gnus-tmp-id
+ gnus-type annotation
gnus-data ,handle))
(setq e (point))
- (widget-convert-text 'link b e b e :action 'gnus-widget-press-button)))
+ (widget-convert-button 'link b e :action 'gnus-widget-press-button
+ :button-keymap gnus-mime-button-map)))
(defun gnus-widget-press-button (elems el)
(goto-char (widget-get elems :from))
- (gnus-article-press-button))
+ (let ((url-standalone-mode (not gnus-plugged)))
+ (gnus-article-press-button)))
(defun gnus-display-mime ()
"Insert MIME buttons in the buffer."
(save-restriction
(mail-narrow-to-head)
(when (setq ct (mail-fetch-field "content-type"))
- (setq ctl (mail-header-parse-content-type ct))))
+ (setq ctl (condition-case ()
+ (mail-header-parse-content-type ct) (error nil)))))
(let* ((handles (mm-dissect-buffer))
- handle name type b e)
+ handle name type b e display)
(mapcar 'mm-destroy-part gnus-article-mime-handles)
- (setq gnus-article-mime-handles handles)
+ (setq gnus-article-mime-handles handles
+ gnus-article-mime-handle-alist nil)
(when handles
(goto-char (point-min))
(search-forward "\n\n" nil t)
(delete-region (point) (point-max))
(if (not (equal (car ctl) "multipart/alternative"))
(while (setq handle (pop handles))
- (gnus-insert-mime-button handle)
- (insert "\n\n")
- (when (and (mm-automatic-display-p (car (mm-handle-type handle)))
+ (setq display nil)
+ (when (and (mm-automatic-display-p
+ (car (mm-handle-type handle)))
+ (mm-inlinable-part-p (car (mm-handle-type handle)))
(or (not (mm-handle-disposition handle))
(equal (car (mm-handle-disposition handle))
"inline")))
+ (setq display t))
+ (let ((id (1+ (length gnus-article-mime-handle-alist))))
+ (push (cons id handle) gnus-article-mime-handle-alist)
+ (gnus-insert-mime-button handle id (list display)))
+ (insert "\n\n")
+ (when display
(forward-line -2)
- (mm-display-part handle)
+ (mm-display-part handle t)
(goto-char (point-max))))
;; Here we have multipart/alternative
(gnus-mime-display-alternative handles))))))
(car (mm-handle-type handle))))
(point))
`(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-callback
(lambda (handles)
(if (get-buffer gnus-original-article-buffer)
(set-buffer gnus-original-article-buffer)
(set-buffer (gnus-get-buffer-create gnus-original-article-buffer))
- (buffer-disable-undo (current-buffer))
+ (buffer-disable-undo)
(setq major-mode 'gnus-original-article-mode)
(setq buffer-read-only t))
(let (buffer-read-only)
(setq gnus-original-article (cons group article)))
;; Decode charsets.
- (run-hooks 'gnus-article-decode-hook))
-
+ (run-hooks 'gnus-article-decode-hook)
+ ;; Mark article as decoded or not.
+ (setq gnus-article-decoded-p gnus-article-decode-hook))
+
;; Update sparse articles.
(when (and do-update-line
(or (numberp article)
(defvar gnus-article-edit-mode-map nil)
+;; Should we be using derived.el for this?
(unless gnus-article-edit-mode-map
- (setq gnus-article-edit-mode-map (copy-keymap text-mode-map))
+ (setq gnus-article-edit-mode-map (make-sparse-keymap))
+ (set-keymap-parent gnus-article-edit-mode-map text-mode-map)
(gnus-define-keys gnus-article-edit-mode-map
"\C-c\C-c" gnus-article-edit-done
(save-excursion
(set-buffer buf)
(let ((buffer-read-only nil))
- (funcall func arg)))
+ (funcall func arg))
+ ;; The cache and backlog have to be flushed somewhat.
+ (when gnus-keep-backlog
+ (gnus-backlog-remove-article
+ (car gnus-article-current) (cdr gnus-article-current)))
+ ;; Flush original article as well.
+ (save-excursion
+ (when (get-buffer gnus-original-article-buffer)
+ (set-buffer gnus-original-article-buffer)
+ (setq gnus-original-article nil)))
+ (when gnus-use-cache
+ (gnus-cache-update-article
+ (car gnus-article-current) (cdr gnus-article-current))))
(set-buffer buf)
(set-window-start (get-buffer-window buf) start)
(set-window-point (get-buffer-window buf) (point))))
(insert buf)
(let ((winconf gnus-prev-winconf))
(gnus-article-mode)
- ;; The cache and backlog have to be flushed somewhat.
- (when gnus-use-cache
- (gnus-cache-update-article
- (car gnus-article-current) (cdr gnus-article-current)))
- (when gnus-keep-backlog
- (gnus-backlog-remove-article
- (car gnus-article-current) (cdr gnus-article-current)))
- ;; Flush original article as well.
- (save-excursion
- (when (get-buffer gnus-original-article-buffer)
- (set-buffer gnus-original-article-buffer)
- (setq gnus-original-article nil)))
(set-window-configuration winconf)
;; Tippy-toe some to make sure that point remains where it was.
- (let ((buf (current-buffer)))
+ (save-current-buffer
(set-buffer curbuf)
(set-window-start (get-buffer-window (current-buffer)) window-start)
- (goto-char p)
- (set-buffer buf)))))
+ (goto-char p)))))
(defun gnus-article-edit-full-stops ()
"Interactively repair spacing at end of sentences."
("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2
t gnus-button-message-id 3)
("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>" 0 t gnus-url-mailto 2)
- ("mailto:\\([a-zA-Z.-@_+0-9%]+\\)" 0 t gnus-url-mailto 1)
+ ("mailto:\\([-a-zA-Z.@_+0-9%]+\\)" 0 t gnus-url-mailto 1)
("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 1)
;; This is how URLs _should_ be embedded in text...
("<URL: *\\([^>]*\\)>" 0 t gnus-button-embedded-url 1)
(list gnus-mouse-face-prop gnus-article-mouse-face))
(list 'gnus-callback fun)
(and data (list 'gnus-data data))))
- (widget-convert-text 'link from to from to
- :action 'gnus-widget-press-button))
+ (widget-convert-button 'link from to :action 'gnus-widget-press-button
+ :button-keymap gnus-widget-button-keymap))
;;; Internal functions:
projects / gnus / blobdiff