If the match is a string, it is used as a regexp match on the
article. If the match is a symbol, that symbol will be funcalled
-from the buffer of the article to be saved with the newsgroup as
-the parameter. If it is a list, it will be evaled in the same
-buffer.
+from the buffer of the article to be saved with the newsgroup as the
+parameter. If it is a list, it will be evaled in the same buffer.
-If this form or function returns a string, this string will be
-used as a possible file name; and if it returns a non-nil list,
-that list will be used as possible file names."
+If this form or function returns a string, this string will be used as a
+possible file name; and if it returns a non-nil list, that list will be
+used as possible file names."
:group 'gnus-article-saving
:type '(repeat (choice (list :value (fun) function)
(cons :value ("" "") regexp (repeat string))
(goto-char (setq end start)))))
(defun article-decode-group-name ()
- "Decode group names in `Newsgroups:'."
+ "Decode group names in Newsgroups, Followup-To and Xref headers."
(let ((inhibit-point-motion-hooks t)
(inhibit-read-only t)
- (method (gnus-find-method-for-group gnus-newsgroup-name)))
+ (method (gnus-find-method-for-group gnus-newsgroup-name))
+ regexp)
(when (and (or gnus-group-name-charset-method-alist
gnus-group-name-charset-group-alist)
(gnus-buffer-live-p gnus-original-article-buffer))
(save-restriction
(article-narrow-to-head)
- (with-current-buffer gnus-original-article-buffer
- (goto-char (point-min)))
- (while (re-search-forward
- "^Newsgroups:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" nil t)
- (replace-match (save-match-data
- (gnus-decode-newsgroups
- ;; XXX how to use data in article buffer?
- (with-current-buffer gnus-original-article-buffer
- (re-search-forward
- "^Newsgroups:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]"
- nil t)
- (match-string 1))
- gnus-newsgroup-name method))
- t t nil 1))
- (goto-char (point-min))
- (with-current-buffer gnus-original-article-buffer
- (goto-char (point-min)))
- (while (re-search-forward
- "^Followup-To:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" nil t)
- (replace-match (save-match-data
- (gnus-decode-newsgroups
- ;; XXX how to use data in article buffer?
- (with-current-buffer gnus-original-article-buffer
- (re-search-forward
- "^Followup-To:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]"
- nil t)
- (match-string 1))
- gnus-newsgroup-name method))
- t t nil 1))))))
+ (dolist (header '("Newsgroups" "Followup-To" "Xref"))
+ (with-current-buffer gnus-original-article-buffer
+ (goto-char (point-min)))
+ (setq regexp (concat "^" header
+ ":\\([^\n]*\\(?:\n[\t ]+[^\n]+\\)*\\)\n"))
+ (while (re-search-forward regexp nil t)
+ (replace-match (save-match-data
+ (gnus-decode-newsgroups
+ ;; XXX how to use data in article buffer?
+ (with-current-buffer gnus-original-article-buffer
+ (re-search-forward regexp nil t)
+ (match-string 1))
+ gnus-newsgroup-name method))
+ t t nil 1))
+ (goto-char (point-min)))))))
(autoload 'idna-to-unicode "idna")
(funcall gnus-display-mime-function))
(gnus-run-hooks 'gnus-article-prepare-hook)))
+;;;
+;;; Gnus Sticky Article Mode
+;;;
+
+(define-derived-mode gnus-sticky-article-mode gnus-article-mode "StickyArticle"
+ "Mode for sticky articles."
+ ;; Release bindings that won't work.
+ (substitute-key-definition 'gnus-article-read-summary-keys 'undefined
+ gnus-sticky-article-mode-map)
+ (substitute-key-definition 'gnus-article-refer-article 'undefined
+ gnus-sticky-article-mode-map)
+ (dolist (k '("e" "h" "s" "F" "R"))
+ (define-key gnus-sticky-article-mode-map k nil))
+ (define-key gnus-sticky-article-mode-map "k" 'gnus-kill-sticky-article-buffer)
+ (define-key gnus-sticky-article-mode-map "q" 'bury-buffer)
+ (define-key gnus-sticky-article-mode-map "\C-hc" 'describe-key-briefly)
+ (define-key gnus-sticky-article-mode-map "\C-hk" 'describe-key))
+
+(defun gnus-sticky-article (arg)
+ "Make the current article sticky.
+If a prefix ARG is given, ask for a name for this sticky article buffer."
+ (interactive "P")
+ (gnus-summary-show-thread)
+ (gnus-summary-select-article nil nil 'pseudo)
+ (let (new-art-buf-name)
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (setq new-art-buf-name
+ (concat
+ "*Sticky Article: "
+ (if arg
+ (read-from-minibuffer "Sticky article buffer name: ")
+ (gnus-with-article-headers
+ (gnus-article-goto-header "subject")
+ (setq new-art-buf-name
+ (buffer-substring-no-properties
+ (line-beginning-position) (line-end-position)))
+ (goto-char (point-min))
+ (gnus-article-goto-header "from")
+ (setq new-art-buf-name
+ (concat
+ new-art-buf-name ", "
+ (buffer-substring-no-properties
+ (line-beginning-position) (line-end-position))))
+ (goto-char (point-min))
+ (gnus-article-goto-header "date")
+ (setq new-art-buf-name
+ (concat
+ new-art-buf-name ", "
+ (buffer-substring-no-properties
+ (line-beginning-position) (line-end-position))))))
+ "*"))
+ (if (and (gnus-buffer-live-p new-art-buf-name)
+ (with-current-buffer new-art-buf-name
+ (eq major-mode 'gnus-sticky-article-mode)))
+ (switch-to-buffer new-art-buf-name)
+ (setq new-art-buf-name (rename-buffer new-art-buf-name t)))
+ (gnus-sticky-article-mode))
+ (setq gnus-article-buffer new-art-buf-name))
+ (gnus-summary-recenter)
+ (gnus-summary-position-point))
+
+(defun gnus-kill-sticky-article-buffer (&optional buffer)
+ "Kill the given sticky article BUFFER.
+If none is given, assume the current buffer and kill it if it has
+`gnus-sticky-article-mode'."
+ (interactive)
+ (unless buffer
+ (setq buffer (current-buffer)))
+ (with-current-buffer buffer
+ (when (eq major-mode 'gnus-sticky-article-mode)
+ (gnus-kill-buffer buffer))))
+
+(defun gnus-kill-sticky-article-buffers (arg)
+ "Kill all sticky article buffers.
+If a prefix ARG is given, ask for confirmation."
+ (interactive "P")
+ (dolist (buf (gnus-buffers))
+ (with-current-buffer buf
+ (when (eq major-mode 'gnus-sticky-article-mode)
+ (if (not arg)
+ (gnus-kill-buffer buf)
+ (when (yes-or-no-p (concat "Kill buffer " (buffer-name buf) "? "))
+ (gnus-kill-buffer buf)))))))
+
;;;
;;; Gnus MIME viewing functions
;;;
(gnus-summary-show-article)
(when (and current-id (integerp gnus-auto-select-part))
(gnus-article-jump-to-part
- (+ current-id gnus-auto-select-part)))))
+ (if (text-property-any (point-min) (point-max)
+ 'gnus-part (+ current-id gnus-auto-select-part))
+ (+ current-id gnus-auto-select-part)
+ (with-current-buffer gnus-article-buffer
+ (length gnus-article-mime-handle-alist)))))))
(defun gnus-mime-replace-part (file)
"Replace MIME part under point with an external body."
;; Content-Disposition: attachment; filename=...
(cdr (assq 'filename (cdr (mm-handle-disposition handle))))))
(def-type (and name (mm-default-file-encoding name))))
- (and def-type (cons def-type 0))))
+ (or (and def-type (cons def-type 0))
+ (and handle
+ (equal (mm-handle-media-supertype handle) "text")
+ '("text/plain" . 0))
+ '("application/octet-stream" . 0))))
(defun gnus-mime-view-part-as-type (&optional mime-type pred)
"Choose a MIME media type, and view the part as such.
(mm-handle-id handle)))
(setq gnus-article-mime-handles
(mm-merge-handles gnus-article-mime-handles handle))
+ (when (mm-handle-displayed-p handle)
+ (mm-remove-part handle))
(gnus-mm-display-part handle))))
(defun gnus-mime-copy-part (&optional handle arg)
(gnus-newsgroup-ignored-charsets 'gnus-all)
gnus-newsgroup-charset form preferred parts)
(when handle
- (if (mm-handle-undisplayer handle)
- (mm-remove-part handle))
- (when fun
- (setq gnus-newsgroup-charset
- (or (cdr (assq arg gnus-summary-show-article-charset-alist))
- (mm-read-coding-system "Charset: ")))
+ (when (prog1
+ (and fun
+ (setq gnus-newsgroup-charset
+ (or (cdr (assq
+ arg
+ gnus-summary-show-article-charset-alist))
+ (mm-read-coding-system "Charset: "))))
+ (if (mm-handle-undisplayer handle)
+ (mm-remove-part handle)))
(gnus-mime-strip-charset-parameters handle)
(when (and (consp (setq form (cdr-safe fun)))
(setq form (ignore-errors
(unless (with-current-buffer gnus-summary-buffer
(eq gnus-current-article (gnus-summary-article-number)))
(error "You should select the right article first"))
+ (if n
+ (setq n (prefix-numeric-value n))
+ (let ((pt (point)))
+ (setq n (or (get-text-property pt 'gnus-part)
+ (and (not (bobp))
+ (get-text-property (1- pt) 'gnus-part))
+ (get-text-property (prog2
+ (forward-line 1)
+ (point)
+ (goto-char pt))
+ 'gnus-part)
+ (get-text-property
+ (or (and (setq pt (previous-single-property-change
+ pt 'gnus-part))
+ (1- pt))
+ (next-single-property-change (point) 'gnus-part)
+ (point))
+ 'gnus-part)
+ 1))))
;; Check whether the specified part exists.
(when (> n (length gnus-article-mime-handle-alist))
(error "No such part")))
(defun gnus-article-pipe-part (n)
"Pipe MIME part N, which is the numerical prefix."
- (interactive "p")
+ (interactive "P")
(gnus-article-part-wrapper n 'mm-pipe-part))
(defun gnus-article-save-part (n)
"Save MIME part N, which is the numerical prefix."
- (interactive "p")
+ (interactive "P")
(gnus-article-part-wrapper n 'mm-save-part))
(defun gnus-article-interactively-view-part (n)
"View MIME part N interactively, which is the numerical prefix."
- (interactive "p")
+ (interactive "P")
(gnus-article-part-wrapper n 'mm-interactively-view-part))
(defun gnus-article-copy-part (n)
"Copy MIME part N, which is the numerical prefix."
- (interactive "p")
+ (interactive "P")
(gnus-article-part-wrapper n 'gnus-mime-copy-part))
(defun gnus-article-view-part-as-charset (n)
"View MIME part N using a specified charset.
N is the numerical prefix."
- (interactive "p")
+ (interactive "P")
(gnus-article-part-wrapper n 'gnus-mime-view-part-as-charset))
(defun gnus-article-view-part-externally (n)
"View MIME part N externally, which is the numerical prefix."
- (interactive "p")
+ (interactive "P")
(gnus-article-part-wrapper n 'gnus-mime-view-part-externally))
(defun gnus-article-inline-part (n)
"Inline MIME part N, which is the numerical prefix."
- (interactive "p")
+ (interactive "P")
(gnus-article-part-wrapper n 'gnus-mime-inline-part))
(defun gnus-article-save-part-and-strip (n)
"Save MIME part N and replace it with an external body.
N is the numerical prefix."
- (interactive "p")
+ (interactive "P")
(gnus-article-part-wrapper n 'gnus-mime-save-part-and-strip t))
(defun gnus-article-replace-part (n)
"Replace MIME part N with an external body.
N is the numerical prefix."
- (interactive "p")
+ (interactive "P")
(gnus-article-part-wrapper n 'gnus-mime-replace-part t t))
(defun gnus-article-delete-part (n)
"Delete MIME part N and add some information about the removed part.
N is the numerical prefix."
- (interactive "p")
+ (interactive "P")
(gnus-article-part-wrapper n 'gnus-mime-delete-part t))
(defun gnus-article-view-part-as-type (n)
"Choose a MIME media type, and view part N as such.
N is the numerical prefix."
- (interactive "p")
+ (interactive "P")
(gnus-article-part-wrapper n 'gnus-mime-view-part-as-type t))
(defun gnus-article-mime-match-handle-first (condition)
(1- (point))
(point)))
(when gnus-article-button-face
- (gnus-overlay-put (gnus-make-overlay b e)
- 'face gnus-article-button-face))
+ (gnus-overlay-put (gnus-make-overlay b e nil t)
+ 'face gnus-article-button-face))
(widget-convert-button
'link b e
:mime-handle handle
(gnus-article-insert-newline)
(mm-insert-inline
handle
- (let ((charset (mail-content-type-get (mm-handle-type handle)
- 'charset)))
+ (let ((charset (or (mail-content-type-get (mm-handle-type handle)
+ 'charset)
+ (and (equal type "text/calendar") 'utf-8))))
(cond ((not charset)
(mm-string-as-multibyte (mm-get-part handle)))
((eq charset 'gnus-decoded)
(save-excursion
(save-restriction
(narrow-to-region beg (point))
- (gnus-treat-article
- nil id
- (gnus-article-mime-total-parts)
- (mm-handle-media-type handle)))))))))
+ (if (eq handle gnus-article-mime-handles)
+ ;; The format=flowed case.
+ (gnus-treat-article nil 1 1 (mm-handle-media-type handle))
+ ;; Don't count signature parts that are never displayed.
+ ;; The part number should be re-calculated supposing this
+ ;; might be a message/rfc822 part.
+ (let (handles)
+ (dolist (part gnus-article-mime-handles)
+ (unless (or (stringp part)
+ (equal (car (mm-handle-type part))
+ "application/pgp-signature"))
+ (push part handles)))
+ (gnus-treat-article
+ nil (length (memq handle handles)) (length handles)
+ (mm-handle-media-type handle)))))))))))
(defun gnus-unbuttonized-mime-type-p (type)
"Say whether TYPE is to be unbuttonized."
"Execute the last keystroke in the summary buffer."
(interactive)
(let (func)
- (pop-to-buffer gnus-article-current-summary nil 'norecord)
+ (pop-to-buffer gnus-article-current-summary)
(setq func (lookup-key (current-local-map) (this-command-keys)))
(call-interactively func)))
(message "")
- (if (or (member keys nosaves)
- (member keys nosave-but-article)
- (member keys nosave-in-article))
- (let (func)
- (save-window-excursion
- (pop-to-buffer gnus-article-current-summary nil 'norecord)
- ;; We disable the pick minor mode commands.
- (let (gnus-pick-mode)
- (setq func (lookup-key (current-local-map) keys))))
- (if (or (not func)
- (numberp func))
- (ding)
- (unless (member keys nosave-in-article)
- (set-buffer gnus-article-current-summary))
- (call-interactively func)
- (setq new-sum-point (point)))
- (when (member keys nosave-but-article)
- (pop-to-buffer gnus-article-buffer nil 'norecord)))
+ (cond
+ ((eq (aref keys (1- (length keys))) ?\C-h)
+ (with-current-buffer gnus-article-current-summary
+ (describe-bindings (substring keys 0 -1))))
+ ((or (member keys nosaves)
+ (member keys nosave-but-article)
+ (member keys nosave-in-article))
+ (let (func)
+ (save-window-excursion
+ (pop-to-buffer gnus-article-current-summary)
+ ;; We disable the pick minor mode commands.
+ (let (gnus-pick-mode)
+ (setq func (lookup-key (current-local-map) keys))))
+ (if (or (not func)
+ (numberp func))
+ (ding)
+ (unless (member keys nosave-in-article)
+ (set-buffer gnus-article-current-summary))
+ (call-interactively func)
+ (setq new-sum-point (point)))
+ (when (member keys nosave-but-article)
+ (pop-to-buffer gnus-article-buffer))))
+ (t
;; These commands should restore window configuration.
(let ((obuf (current-buffer))
(owin (current-window-configuration))
- win func in-buffer selected new-sum-start new-sum-hscroll)
+ win func in-buffer selected new-sum-start new-sum-hscroll err)
(cond (not-restore-window
- (pop-to-buffer gnus-article-current-summary nil 'norecord)
+ (pop-to-buffer gnus-article-current-summary)
(setq win (selected-window)))
((setq win (get-buffer-window gnus-article-current-summary))
(select-window win))
;; We disable the pick minor mode commands.
(if (and (setq func (let (gnus-pick-mode)
(lookup-key (current-local-map) keys)))
- (functionp func))
+ (functionp func)
+ (condition-case code
+ (progn
+ (call-interactively func)
+ t)
+ (error
+ (setq err code)
+ nil)))
(progn
- (call-interactively func)
(when (eq win (selected-window))
(setq new-sum-point (point)
new-sum-start (window-start win)
(set-window-configuration owin))
(when (and (eq selected 'old)
new-sum-point)
- (article-goto-body)
(set-window-start (get-buffer-window (current-buffer))
1)
(set-window-point (get-buffer-window (current-buffer))
- (1- (point))))
+ (if (article-goto-body)
+ (1- (point))
+ (point))))
(when (and (not not-restore-window)
new-sum-point
(with-current-buffer (window-buffer win)
(set-window-start win new-sum-start)
(set-window-hscroll win new-sum-hscroll))))
(set-window-configuration owin)
- (ding))))))
+ (if err
+ (signal (car err) (cdr err))
+ (ding))))))))
(defun gnus-article-describe-key (key)
"Display documentation of the function invoked by KEY. KEY is a string."
point (inhibit-read-only t))
(if region
(goto-char (car region)))
- (save-restriction
- (narrow-to-region (point) (point))
- (with-current-buffer (mm-handle-multipart-original-buffer handle)
- (let* ((mm-verify-option 'known)
- (mm-decrypt-option 'known)
- (nparts (mm-possibly-verify-or-decrypt (cdr handle) handle)))
- (unless (eq nparts (cdr handle))
- (mm-destroy-parts (cdr handle))
- (setcdr handle nparts))))
- (setq point (point))
- (gnus-mime-display-security handle)
- (goto-char (point-max)))
+ (setq point (point))
+ (with-current-buffer (mm-handle-multipart-original-buffer handle)
+ (let* ((mm-verify-option 'known)
+ (mm-decrypt-option 'known)
+ (nparts (mm-possibly-verify-or-decrypt (cdr handle) handle)))
+ (unless (eq nparts (cdr handle))
+ (mm-destroy-parts (cdr handle))
+ (setcdr handle nparts))))
+ (gnus-mime-display-security handle)
(when region
(delete-region (point) (cdr region))
(set-marker (car region) nil)
(1- (point))
(point)))
(when gnus-article-button-face
- (gnus-overlay-put (gnus-make-overlay b e)
+ (gnus-overlay-put (gnus-make-overlay b e nil t)
'face gnus-article-button-face))
(widget-convert-button
'link b e
(mm-set-handle-multipart-parameter
handle 'gnus-region
(cons (set-marker (make-marker) (point-min))
- (set-marker (make-marker) (point-max))))))
+ (set-marker (make-marker) (point-max))))
+ (goto-char (point-max))))
(defun gnus-mime-security-run-function (function)
"Run FUNCTION with the security part under point."
projects / gnus / blobdiff