-;;; gnus-art.el --- article mode commands for Gnus
-;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+;;; gnus-art.el --- article mode commands for Semi-gnus
+;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: mail, news, MIME
;; This file is part of GNU Emacs.
(require 'gnus-spec)
(require 'gnus-int)
(require 'browse-url)
+(require 'alist)
+(require 'mime-view)
(defgroup gnus-article nil
"Article display."
"^Date-Received:" "^References:" "^Control:" "^Xref:" "^Lines:"
"^Posted:" "^Relay-Version:" "^Message-ID:" "^Nf-ID:" "^Nf-From:"
"^Approved:" "^Sender:" "^Received:" "^Mail-from:")
- "All headers that start with this regexp will be hidden.
+ "*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."
:type '(choice :custom-show nil
:group 'gnus-article-hiding)
(defcustom gnus-visible-headers
- "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:\\|X-Sent:"
- "All headers that do not match this regexp will be hidden.
+ "From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:\\|X-Sent:"
+ "*All headers that do not match this regexp will be hidden.
This variable can also be a list of regexp of headers to remain visible.
If this variable is non-nil, `gnus-ignored-headers' will be ignored."
:type '(repeat :value-to-internal (lambda (widget value)
(defcustom gnus-sorted-header-list
'("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:"
"^Followup-To:" "^To:" "^Cc:" "^Date:" "^Organization:")
- "This variable is a list of regular expressions.
+ "*This variable is a list of regular expressions.
If it is non-nil, headers that match the regular expressions will
be placed first in the article buffer in the sequence specified by
this list."
will be called without any parameters, and if it returns nil, there is
no signature in the buffer. If it is a string, it will be used as a
regexp. If it matches, the text in question is not a signature."
- :type '(choice integer number function regexp)
+ :type '(choice (integer :value 200)
+ (number :value 4.0)
+ (function :value fun)
+ (regexp :value ".*"))
:group 'gnus-article-signature)
(defcustom gnus-hidden-properties '(invisible t intangible t)
(defcustom gnus-article-x-face-command
"{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
- "String or function to be executed to display an X-Face header.
+ "*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."
:type 'string ;Leave function case to Lisp.
(lambda (spec)
(list
(format format (car spec) (cadr spec))
- 2 3 (intern (format "gnus-emphasis-%s" (caddr spec)))))
+ 2 3 (intern (format "gnus-emphasis-%s" (nth 2 spec)))))
types)))
- "Alist that says how to fontify certain phrases.
+ "*Alist that says how to fontify certain phrases.
Each item looks like this:
(\"_\\\\(\\\\w+\\\\)_\" 0 1 'underline)
(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."
- :type 'string
+See `format-time-string' for the possible values.
+
+The variable can also be function, which should return a complete Date
+header. The function is called with one argument, the time, which can
+be fed to `format-time-string'."
+ :type '(choice string symbol)
:link '(custom-manual "(gnus)Article Date")
:group 'gnus-article-washing)
:group 'gnus-article-saving
:type '(choice (item always)
(item :tag "never" nil)
- (sexp :tag "once" :format "%t")))
+ (sexp :tag "once" :format "%t\n" :value t)))
(defcustom gnus-saved-headers gnus-visible-headers
"Headers to keep if `gnus-save-all-headers' is nil.
(defcustom gnus-split-methods
'((gnus-article-archive-name)
(gnus-article-nndoc-name))
- "Variable used to suggest where articles are to be saved.
+ "*Variable used to suggest where articles are to be saved.
For instance, if you would like to save articles related to Gnus in
the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\",
you could set this variable to something like:
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 function)
- (cons regexp (repeat string))
- sexp)))
+ :type '(repeat (choice (list :value (fun) function)
+ (cons :value ("" "") regexp (repeat string))
+ (sexp :value nil))))
(defcustom gnus-strict-mime t
"*If nil, MIME-decode even if there is no Mime-Version header."
:group 'gnus-article-mime
:type 'boolean)
-(defcustom gnus-show-mime-method 'metamail-buffer
+(defcustom gnus-show-mime-method 'gnus-article-preview-mime-message
"Function to process a MIME message.
The function is called from the article buffer."
:group 'gnus-article-mime
:type 'function)
-(defcustom gnus-decode-encoded-word-method 'gnus-article-de-quoted-unreadable
+(defcustom gnus-decode-encoded-word-method 'gnus-article-decode-encoded-word
"*Function to decode MIME encoded words.
The function is called from the article buffer."
:group 'gnus-article-mime
("Subject" nil gnus-header-subject-face)
("Newsgroups:.*," nil gnus-header-newsgroups-face)
("" gnus-header-name-face gnus-header-content-face))
- "Controls highlighting of article header.
+ "*Controls highlighting of article header.
An alist of the form (HEADER NAME CONTENT).
;;; Internal variables
(defvar article-lapsed-timer nil)
+(defvar gnus-article-current-summary nil)
(defvar gnus-article-mode-syntax-table
(let ((table (copy-syntax-table text-mode-syntax-table)))
(defvar gnus-save-article-buffer nil)
(defvar gnus-article-mode-line-format-alist
- (nconc '((?w (gnus-article-wash-status) ?s))
- gnus-summary-mode-line-format-alist))
+ (nconc '((?w (gnus-article-wash-status) ?s))
+ gnus-summary-mode-line-format-alist))
(defvar gnus-number-of-articles-to-be-saved nil)
(save-excursion
(save-restriction
(let ((buffer-read-only nil)
+ (case-fold-search t)
(props (nconc (list 'article-type 'headers)
gnus-hidden-properties))
(max (1+ (length gnus-sorted-header-list)))
(process-send-region "article-x-face" beg end)
(process-send-eof "article-x-face"))))))))))
-(defun gnus-hack-decode-rfc1522 ()
- "Emergency hack function for avoiding problems when decoding."
- (let ((buffer-read-only nil))
- (goto-char (point-min))
- ;; Remove encoded TABs.
- (while (search-forward "=09" nil t)
- (replace-match " " t t))
- ;; Remove encoded newlines.
- (goto-char (point-min))
- (while (search-forward "=10" nil t)
- (replace-match " " t t))))
-
-(defalias 'gnus-decode-rfc1522 'article-decode-rfc1522)
-(defalias 'gnus-article-decode-rfc1522 'article-decode-rfc1522)
-(defun article-decode-rfc1522 ()
- "Hack to remove QP encoding from headers."
- (let ((case-fold-search t)
- (inhibit-point-motion-hooks t)
- (buffer-read-only nil)
- string)
- (save-restriction
- (narrow-to-region
- (goto-char (point-min))
- (or (search-forward "\n\n" nil t) (point-max)))
- (goto-char (point-min))
- (while (re-search-forward
- "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t)
- (setq string (match-string 1))
- (save-restriction
- (narrow-to-region (match-beginning 0) (match-end 0))
- (delete-region (point-min) (point-max))
- (insert string)
- (article-mime-decode-quoted-printable
- (goto-char (point-min)) (point-max))
- (subst-char-in-region (point-min) (point-max) ?_ ? )
- (goto-char (point-max)))
- (goto-char (point-min))))))
-
-(defun article-de-quoted-unreadable (&optional force)
- "Do a naive translation of a quoted-printable-encoded article.
-This is in no way, shape or form meant as a replacement for real MIME
-processing, but is simply a stop-gap measure until MIME support is
-written.
-If FORCE, decode the article whether it is marked as quoted-printable
-or not."
- (interactive (list 'force))
- (save-excursion
- (let ((case-fold-search t)
- (buffer-read-only nil)
- (type (gnus-fetch-field "content-transfer-encoding")))
- (gnus-article-decode-rfc1522)
- (when (or force
- (and type (string-match "quoted-printable" (downcase type))))
- (goto-char (point-min))
- (search-forward "\n\n" nil 'move)
- (article-mime-decode-quoted-printable (point) (point-max))))))
-
-(defun article-mime-decode-quoted-printable-buffer ()
- "Decode Quoted-Printable in the current buffer."
- (article-mime-decode-quoted-printable (point-min) (point-max)))
-
-(defun article-mime-decode-quoted-printable (from to)
- "Decode Quoted-Printable in the region between FROM and TO."
- (interactive "r")
- (goto-char from)
- (while (search-forward "=" to t)
- (cond ((eq (following-char) ?\n)
- (delete-char -1)
- (delete-char 1))
- ((looking-at "[0-9A-F][0-9A-F]")
- (subst-char-in-region
- (1- (point)) (point) ?=
- (hexl-hex-string-to-integer
- (buffer-substring (point) (+ 2 (point)))))
- (delete-char 2))
- ((looking-at "=")
- (delete-char 1))
- ((gnus-message 3 "Malformed MIME quoted-printable message")))))
+(defun gnus-article-decode-rfc1522 ()
+ "Decode MIME encoded-words in header fields."
+ (let (buffer-read-only)
+ (let ((charset (save-excursion
+ (set-buffer gnus-summary-buffer)
+ default-mime-charset)))
+ (eword-decode-header charset)
+ )))
(defun article-hide-pgp (&optional arg)
"Toggle hiding of any PGP headers and signatures in the current article.
(gnus-article-hide-text-type
(match-beginning 0) (match-end 0) 'pgp))
(widen))
- (run-hooks 'gnus-article-hide-pgp-hook))))))
+ (gnus-run-hooks 'gnus-article-hide-pgp-hook))))))
(defun article-hide-pem (&optional arg)
"Toggle hiding of any PEM headers and signatures in the current article.
(article-remove-trailing-blank-lines)
(article-strip-multiple-blank-lines))
+(defun article-strip-all-blank-lines ()
+ "Strip all blank lines."
+ (interactive)
+ (save-excursion
+ (let ((inhibit-point-motion-hooks t)
+ buffer-read-only)
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (while (re-search-forward "^[ \t]*\n" nil t)
+ (replace-match "" t t)))))
+
(defvar mime::preview/content-list)
(defvar mime::preview-content-info/point-min)
(defun gnus-article-narrow-to-signature ()
(concat "Date: " date))
;; Let the user define the format.
((eq type 'user)
+ (if (gnus-functionp gnus-article-time-format)
+ (funcall
+ gnus-article-time-format
+ (ignore-errors
+ (gnus-encode-date
+ (timezone-make-date-arpa-standard
+ date nil "UT"))))
+ (concat
+ "Date: "
+ (format-time-string gnus-article-time-format
+ (ignore-errors
+ (gnus-encode-date
+ (timezone-make-date-arpa-standard
+ date nil "UT")))))))
+ ;; ISO 8601.
+ ((eq type 'iso8601)
(concat
"Date: "
- (format-time-string gnus-article-time-format
+ (format-time-string "%Y%M%DT%h%m%s"
(ignore-errors
(gnus-encode-date
(timezone-make-date-arpa-standard
(defun article-update-date-lapsed ()
"Function to be run from a timer to update the lapsed time line."
- (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))))))
+ (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)))))))
(defun gnus-start-date-timer (&optional n)
"Start a timer to update the X-Sent header in the article buffers.
(interactive (list t))
(article-date-ut 'user highlight))
+(defun article-date-iso8601 (&optional highlight)
+ "Convert the current article date to ISO8601."
+ (interactive (list t))
+ (article-date-ut 'iso8601 highlight))
+
(defun article-show-all ()
"Show all hidden text in the article buffer."
(interactive)
(gnus-number-of-articles-to-be-saved
(when (eq gnus-prompt-before-saving t)
num))) ; Magic
- (set-buffer gnus-summary-buffer)
+ (set-buffer gnus-article-current-summary)
(funcall gnus-default-article-saver filename)))))
(defun gnus-read-save-file-name (prompt &optional filename
"Append this article to Rmail file.
Optional argument FILENAME specifies file name.
Directory to save to is default to `gnus-article-save-directory'."
- (interactive)
(setq filename (gnus-read-save-file-name
"Save %s in rmail file:" filename
gnus-rmail-save-name gnus-newsgroup-name
"Append this article to Unix mail file.
Optional argument FILENAME specifies file name.
Directory to save to is default to `gnus-article-save-directory'."
- (interactive)
(setq filename (gnus-read-save-file-name
"Save %s in Unix mail file:" filename
gnus-mail-save-name gnus-newsgroup-name
"Append this article to file.
Optional argument FILENAME specifies file name.
Directory to save to is default to `gnus-article-save-directory'."
- (interactive)
(setq filename (gnus-read-save-file-name
"Save %s in file:" filename
gnus-file-save-name gnus-newsgroup-name
"Write this article to a file.
Optional argument FILENAME specifies file name.
The directory to save in defaults to `gnus-article-save-directory'."
- (interactive)
(gnus-summary-save-in-file nil t))
(defun gnus-summary-save-body-in-file (&optional filename)
"Append this article body to a file.
Optional argument FILENAME specifies file name.
The directory to save in defaults to `gnus-article-save-directory'."
- (interactive)
(setq filename (gnus-read-save-file-name
"Save %s body in file:" filename
gnus-file-save-name gnus-newsgroup-name
(defun gnus-summary-save-in-pipe (&optional command)
"Pipe this article to subprocess."
- (interactive)
(setq command
(cond ((eq command 'default)
gnus-last-shell-command)
(article-fill . gnus-article-word-wrap)
article-remove-cr
article-display-x-face
- article-de-quoted-unreadable
- article-mime-decode-quoted-printable
article-hide-pgp
article-hide-pem
article-hide-signature
article-strip-multiple-blank-lines
article-strip-leading-space
article-strip-blank-lines
+ article-strip-all-blank-lines
article-date-local
+ article-date-iso8601
article-date-original
article-date-ut
article-date-user
["Hide citation" gnus-article-hide-citation t]
["Treat overstrike" gnus-article-treat-overstrike t]
["Remove carriage return" gnus-article-remove-cr t]
- ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t]))
+ ))
- (when nil
- (when (boundp 'gnus-summary-article-menu)
- (define-key gnus-article-mode-map [menu-bar commands]
- (cons "Commands" gnus-summary-article-menu))))
+ ;; Note "Commands" menu is defined in gnus-sum.el for consistency
(when (boundp 'gnus-summary-post-menu)
(define-key gnus-article-mode-map [menu-bar post]
(cons "Post" gnus-summary-post-menu)))
- (run-hooks 'gnus-article-menu-hook)))
+ (gnus-run-hooks 'gnus-article-menu-hook)))
(defun gnus-article-mode ()
"Major mode for displaying an article.
(interactive)
(when (gnus-visual-p 'article-menu 'menu)
(gnus-article-make-menu-bar))
- (kill-all-local-variables)
(gnus-simplify-mode-line)
(setq mode-name "Article")
(setq major-mode 'gnus-article-mode)
(use-local-map gnus-article-mode-map)
(gnus-update-format-specifications nil 'article-mode)
(set (make-local-variable 'page-delimiter) gnus-page-delimiter)
- (set (make-local-variable 'gnus-page-broken) nil)
- (set (make-local-variable 'gnus-button-marker-list) nil)
+ (make-local-variable 'gnus-page-broken)
+ (make-local-variable 'gnus-button-marker-list)
+ (make-local-variable 'gnus-article-current-summary)
(gnus-set-default-directory)
(buffer-disable-undo (current-buffer))
(setq buffer-read-only t)
(set-syntax-table gnus-article-mode-syntax-table)
- (run-hooks 'gnus-article-mode-hook))
+ (gnus-run-hooks 'gnus-article-mode-hook))
(defun gnus-article-setup-buffer ()
"Initialize the article buffer."
(forward-line line)
(point)))))
+;;; @@ article filters
+;;;
+
+(defun gnus-article-preview-mime-message ()
+ (make-local-variable 'mime-button-mother-dispatcher)
+ (setq mime-button-mother-dispatcher
+ (function gnus-article-push-button))
+ (let ((default-mime-charset
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ default-mime-charset))
+ )
+ (save-excursion
+ (mime-view-buffer gnus-original-article-buffer gnus-article-buffer
+ nil gnus-article-mode-map)
+ ))
+ (run-hooks 'gnus-mime-article-prepare-hook)
+ )
+
+(defun gnus-article-decode-encoded-word ()
+ "Header filter for gnus-article-mode."
+ (let ((charset (save-excursion
+ (set-buffer gnus-summary-buffer)
+ default-mime-charset)))
+ (eword-decode-header charset)
+ (goto-char (point-min))
+ (if (search-forward "\n\n" nil t)
+ (decode-mime-charset-region (match-end 0) (point-max) charset))
+ (mime-maybe-hide-echo-buffer)
+ )
+ (gnus-run-hooks 'gnus-mime-article-prepare-hook)
+ )
+
(defun gnus-article-prepare (article &optional all-headers header)
"Prepare ARTICLE in article mode buffer.
ARTICLE should either be an article number or a Message-ID.
(cons gnus-newsgroup-name article))
(set-buffer gnus-summary-buffer)
(setq gnus-current-article article)
- (gnus-summary-mark-article article gnus-canceled-mark))
- (unless (memq article gnus-newsgroup-sparse)
- (gnus-error
- 1 "No such article (may have expired or been canceled)")))
+ (if (eq (gnus-article-mark article) gnus-undownloaded-mark)
+ (progn
+ (gnus-summary-set-agent-mark article)
+ (message "Message marked for downloading"))
+ (gnus-summary-mark-article article gnus-canceled-mark)
+ (unless (memq article gnus-newsgroup-sparse)
+ (gnus-error 1
+ "No such article (may have expired or been canceled)")))))
(if (or (eq result 'pseudo) (eq result 'nneething))
(progn
(save-excursion
(setq gnus-current-headers nil))
(gnus-summary-goto-subject gnus-current-article)
(gnus-summary-show-thread)
- (run-hooks 'gnus-mark-article-hook)
+ (gnus-run-hooks 'gnus-mark-article-hook)
(gnus-set-mode-line 'summary)
(when (gnus-visual-p 'article-highlight 'highlight)
- (run-hooks 'gnus-visual-mark-article-hook))
+ (gnus-run-hooks 'gnus-visual-mark-article-hook))
;; Set the global newsgroup variables here.
;; Suggested by Jim Sisolak
;; <sisolak@trans4.neep.wisc.edu>.
(gnus-set-global-variables)
(setq gnus-have-all-headers
- (or all-headers gnus-show-all-headers))
- (and gnus-use-cache
- (vectorp (gnus-summary-article-header article))
- (gnus-cache-possibly-enter-article
- group article
- (gnus-summary-article-header article)
- (memq article gnus-newsgroup-marked)
- (memq article gnus-newsgroup-dormant)
- (memq article gnus-newsgroup-unreads)))))
+ (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)
- (run-hooks 'internal-hook)
- (run-hooks 'gnus-article-prepare-hook)
+ (gnus-run-hooks 'internal-hook)
+ (gnus-run-hooks 'gnus-article-prepare-hook)
;; Decode MIME message.
(when gnus-show-mime
(if (or (not gnus-strict-mime)
(funcall gnus-show-mime-method)
(funcall gnus-decode-encoded-word-method)))
;; Perform the article display hooks.
- (run-hooks 'gnus-article-display-hook))
+ (gnus-run-hooks 'gnus-article-display-hook))
;; Do page break.
(goto-char (point-min))
(setq gnus-page-broken
(let ((obuf (current-buffer))
(owin (current-window-configuration))
func)
- (switch-to-buffer gnus-summary-buffer 'norecord)
+ (switch-to-buffer gnus-article-current-summary 'norecord)
(setq func (lookup-key (current-local-map) (this-command-keys)))
(call-interactively func)
(set-buffer obuf)
"Execute the last keystroke in the summary buffer."
(interactive)
(let (func)
- (pop-to-buffer gnus-summary-buffer 'norecord)
+ (pop-to-buffer gnus-article-current-summary 'norecord)
(setq func (lookup-key (current-local-map) (this-command-keys)))
(call-interactively func)))
"Read a summary buffer key sequence and execute it from the article buffer."
(interactive "P")
(let ((nosaves
- '("q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F"
- "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
- "=" "^" "\M-^" "|"))
- (nosave-but-article
- '("A\r"))
- (nosave-in-article
- '("\C-d"))
- keys)
+ '("q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F"
+ "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
+ "=" "^" "\M-^" "|"))
+ (nosave-but-article
+ '("A\r"))
+ (nosave-in-article
+ '("\C-d"))
+ (up-to-top
+ '("n" "Gn" "p" "Gp"))
+ keys new-sum-point)
(save-excursion
- (set-buffer gnus-summary-buffer)
+ (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))))
+ (push (or key last-command-event) unread-command-events)
+ (setq keys (read-key-sequence nil))))
(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-summary-buffer 'norecord)
- ;; We disable the pick minor mode commands.
- (let (gnus-pick-mode)
- (setq func (lookup-key (current-local-map) keys))))
- (if (not func)
- (ding)
- (unless (member keys nosave-in-article)
- (set-buffer gnus-summary-buffer))
- (call-interactively func))
- (when (member keys nosave-but-article)
- (pop-to-buffer gnus-article-buffer 'norecord)))
+ (member keys nosave-but-article)
+ (member keys nosave-in-article))
+ (let (func)
+ (save-window-excursion
+ (pop-to-buffer gnus-article-current-summary 'norecord)
+ ;; We disable the pick minor mode commands.
+ (let (gnus-pick-mode)
+ (setq func (lookup-key (current-local-map) keys))))
+ (if (not 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 'norecord)))
;; These commands should restore window configuration.
(let ((obuf (current-buffer))
- (owin (current-window-configuration))
- (opoint (point))
- func in-buffer)
- (if not-restore-window
- (pop-to-buffer gnus-summary-buffer 'norecord)
- (switch-to-buffer gnus-summary-buffer 'norecord))
- (setq in-buffer (current-buffer))
- ;; We disable the pick minor mode commands.
- (if (setq func (let (gnus-pick-mode)
- (lookup-key (current-local-map) keys)))
- (call-interactively func)
- (ding))
- (when (eq in-buffer (current-buffer))
- (set-buffer obuf)
- (unless not-restore-window
- (set-window-configuration owin))
- (set-window-point (get-buffer-window (current-buffer)) opoint))))))
+ (owin (current-window-configuration))
+ (opoint (point))
+ (summary gnus-article-current-summary)
+ func in-buffer selected)
+ (if not-restore-window
+ (pop-to-buffer summary 'norecord)
+ (switch-to-buffer summary 'norecord))
+ (setq in-buffer (current-buffer))
+ ;; We disable the pick minor mode commands.
+ (if (setq func (let (gnus-pick-mode)
+ (lookup-key (current-local-map) keys)))
+ (progn
+ (call-interactively func)
+ (setq new-sum-point (point)))
+ (ding))
+ (when (eq in-buffer (current-buffer))
+ (setq selected (gnus-summary-select-article))
+ (set-buffer obuf)
+ (unless not-restore-window
+ (set-window-configuration owin))
+ (unless (or (not (eq selected 'old)) (member keys up-to-top))
+ (set-window-point (get-buffer-window (current-buffer))
+ opoint))
+ (let ((win (get-buffer-window gnus-article-current-summary)))
+ (when win
+ (set-window-point win new-sum-point))))))))
(defun gnus-article-hide (&optional arg force)
"Hide all the gruft in the current article.
This means that PGP stuff, signatures, cited text and (some)
headers will be hidden.
If given a prefix, show the hidden text instead."
- (interactive (list current-prefix-arg 'force))
+ (interactive (append (gnus-article-hidden-arg) (list 'force)))
(gnus-article-hide-headers arg)
(gnus-article-hide-pgp arg)
(gnus-article-hide-citation-maybe arg force)
(when (and (numberp article)
gnus-summary-buffer
(get-buffer gnus-summary-buffer)
- (buffer-name (get-buffer gnus-summary-buffer)))
+ (gnus-buffer-exists-p gnus-summary-buffer))
(save-excursion
(set-buffer gnus-summary-buffer)
(let ((header (gnus-summary-article-header article)))
(let ((method (gnus-find-method-for-group
gnus-newsgroup-name)))
- (if (not (eq (car method) 'nneething))
- ()
+ (when (and (eq (car method) 'nneething)
+ (vectorp header))
(let ((dir (concat (file-name-as-directory (nth 1 method))
(mail-header-subject header))))
(when (file-directory-p dir)
((and (numberp article)
gnus-summary-buffer
(get-buffer gnus-summary-buffer)
- (buffer-name (get-buffer gnus-summary-buffer))
+ (gnus-buffer-exists-p gnus-summary-buffer)
(eq (cdr (save-excursion
(set-buffer gnus-summary-buffer)
(assq article gnus-newsgroup-reads)))
;; Check asynchronous pre-fetch.
((gnus-async-request-fetched-article group article (current-buffer))
(gnus-async-prefetch-next group article gnus-summary-buffer)
+ (when (and (numberp article) gnus-keep-backlog)
+ (gnus-backlog-enter-article group article (current-buffer)))
'article)
;; Check the cache.
((and gnus-use-cache
;; It was a pseudo.
(t article)))
+ ;; Associate this article with the current summary buffer.
+ (setq gnus-article-current-summary gnus-summary-buffer)
+
;; Take the article from the original article buffer
;; and place it in the buffer it's supposed to be in.
(when (and (get-buffer gnus-article-buffer)
- ;;(numberp article)
(equal (buffer-name (current-buffer))
(buffer-name (get-buffer gnus-article-buffer))))
(save-excursion
(if (get-buffer gnus-original-article-buffer)
- (set-buffer (get-buffer gnus-original-article-buffer))
+ (set-buffer gnus-original-article-buffer)
(set-buffer (get-buffer-create gnus-original-article-buffer))
(buffer-disable-undo (current-buffer))
(setq major-mode 'gnus-original-article-mode)
\\{gnus-article-edit-mode-map}"
(interactive)
- (kill-all-local-variables)
(setq major-mode 'gnus-article-edit-mode)
(setq mode-name "Article Edit")
(use-local-map gnus-article-edit-mode-map)
(setq buffer-read-only nil)
(buffer-enable-undo)
(widen)
- (run-hooks 'text-mode 'gnus-article-edit-mode-hook))
+ (gnus-run-hooks 'text-mode-hook 'gnus-article-edit-mode-hook))
(defun gnus-article-edit (&optional force)
"Edit the current article.
(when (and (not force)
(gnus-group-read-only-p))
(error "The current newsgroup does not support article editing"))
+ (gnus-article-date-original)
(gnus-article-edit-article
`(lambda (no-highlight)
(gnus-summary-edit-article-done
:type 'regexp)
(defcustom gnus-button-alist
- `(("<\\(url: ?\\)?news:\\([^>\n\t ]*@[^>\n\t ]*\\)>" 0 t
+ `(("<\\(url:[>\n\t ]*?\\)?news:[>\n\t ]*\\([^>\n\t ]*@[^>\n\t ]*\\)>" 0 t
gnus-button-message-id 2)
("\\bnews:\\([^>\n\t ]*@[^>\n\t ]*\\)" 0 t gnus-button-message-id 1)
- ("\\(\\b<\\(url: ?\\)?news:\\(//\\)?\\([^>\n\t ]*\\)>\\)" 1 t
+ ("\\(\\b<\\(url:[>\n\t ]*\\)?news:[>\n\t ]*\\(//\\)?\\([^>\n\t ]*\\)>\\)"
+ 1 t
gnus-button-fetch-group 4)
("\\bnews:\\(//\\)?\\([^'\">\n\t ]+\\)" 0 t gnus-button-fetch-group 2)
- ("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2
+ ("\\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 2)
("\\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)
;; Raw URLs.
(,gnus-button-url-regexp 0 t gnus-button-url 0))
- "Alist of regexps matching buttons in article bodies.
+ "*Alist of regexps matching buttons in article bodies.
Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where
REGEXP: is the string matching text around the button,
("^[^:]+:" ,gnus-button-url-regexp 0 t gnus-button-url 0)
("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t
gnus-button-message-id 3))
- "Alist of headers and regexps to match buttons in article heads.
+ "*Alist of headers and regexps to match buttons in article heads.
This alist is very similar to `gnus-button-alist', except that each
alist has an additional HEADER element first in each entry:
(defun gnus-button-url (address)
"Browse ADDRESS."
- (funcall browse-url-browser-function address))
+ ;; In Emacs 20, `browse-url-browser-function' may be an alist.
+ (if (listp browse-url-browser-function)
+ (browse-url address)
+ (funcall browse-url-browser-function address)))
(defun gnus-button-embedded-url (address)
"Browse ADDRESS."
- (funcall browse-url-browser-function (gnus-strip-whitespace address)))
+ ;; In Emacs 20, `browse-url-browser-function' may be an alist.
+ (if (listp browse-url-browser-function)
+ (browse-url (gnus-strip-whitespace address))
+ (funcall browse-url-browser-function (gnus-strip-whitespace address))))
;;; Next/prev buttons in the article buffer.
(gnus-article-prev-page)
(select-window win)))
+
+;;; @ for mime-view
+;;;
+
+(defun gnus-article-header-presentation-method (entity situation)
+ (mime-insert-decoded-header entity nil nil default-mime-charset)
+ )
+
+(set-alist 'mime-header-presentation-method-alist
+ 'gnus-original-article-mode
+ #'gnus-article-header-presentation-method)
+
+(defun mime-preview-quitting-method-for-gnus ()
+ (if (not gnus-show-mime)
+ (mime-preview-kill-buffer))
+ (delete-other-windows)
+ (gnus-article-show-summary)
+ (if (or (not gnus-show-mime)
+ (null gnus-have-all-headers))
+ (gnus-summary-select-article nil t)
+ ))
+
+(set-alist 'mime-raw-representation-type-alist
+ 'gnus-original-article-mode 'binary)
+
+(set-alist 'mime-preview-quitting-method-alist
+ 'gnus-original-article-mode
+ #'mime-preview-quitting-method-for-gnus)
+
+(set-alist 'mime-view-show-summary-method
+ 'gnus-original-article-mode
+ #'mime-preview-quitting-method-for-gnus)
+
+(defun gnus-following-method (buf)
+ (set-buffer buf)
+ (message-followup)
+ (message-yank-original)
+ (kill-buffer buf)
+ (goto-char (point-min))
+ )
+
+(set-alist 'mime-preview-following-method-alist
+ 'gnus-original-article-mode #'gnus-following-method)
+
+
+;;; @ end
+;;;
+
(gnus-ems-redefine)
(provide 'gnus-art)
projects / elisp / gnus.git- / blobdiff