x-face-mule-gnus-article-display-x-face))
'function))))
;;:version "21.1"
+ :group 'gnus-picon
:group 'gnus-article-washing)
(defcustom gnus-article-x-face-too-ugly nil
string))
(defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces")
- "*Defines the location of the faces database.
+ "Defines the location of the faces database.
For information on obtaining this database of pretty pictures, please
see http://www.cs.indiana.edu/picons/ftp/index.html"
- :type 'directory
+ :type '(repeat directory)
+ :link '(url-link :tag "download"
+ "http://www.cs.indiana.edu/picons/ftp/index.html")
+ :link '(custom-manual "(gnus)Picons")
:group 'gnus-picon)
(defun gnus-picons-installed-p ()
("toggle display" . gnus-article-press-button)
("toggle display" . gnus-article-view-part-as-charset)
("view as type" . gnus-mime-view-part-as-type)
- ("internalize type" . gnus-mime-internalize-part)
- ("externalize type" . gnus-mime-externalize-part))
+ ("view internally" . gnus-mime-view-part-internally)
+ ("view externally" . gnus-mime-view-part-externally))
"An alist of actions that run on the MIME attachment."
:group 'gnus-article-mime
:type '(repeat (cons (string :tag "name")
(function))))
-(defcustom gnus-mime-action-alist
- '(("save to file" . gnus-mime-save-part)
- ("display as text" . gnus-mime-inline-part)
- ("view the part" . gnus-mime-view-part)
- ("pipe to command" . gnus-mime-pipe-part)
- ("toggle display" . gnus-article-press-button)
- ("view as type" . gnus-mime-view-part-as-type)
- ("internalize type" . gnus-mime-internalize-part)
- ("externalize type" . gnus-mime-externalize-part))
- "An alist of actions that run on the MIME attachment."
- :version "21.1"
- :group 'gnus-article-mime
- :type '(repeat (cons (string :tag "name")
- (function))))
-
;;;
;;; The treatment variables
;;;
See Info node `(gnus)Customizing Articles' and Info node
`(gnus)Picons' for details."
:group 'gnus-article-treat
+ :group 'gnus-picon
+ :link '(info-link "(gnus)Customizing Articles")
+ :link '(info-link "(gnus)Picons")
:type gnus-article-treat-head-custom)
(put 'gnus-treat-from-picon 'highlight t)
See Info node `(gnus)Customizing Articles' and Info node
`(gnus)Picons' for details."
:group 'gnus-article-treat
+ :group 'gnus-picon
+ :link '(info-link "(gnus)Customizing Articles")
+ :link '(info-link "(gnus)Picons")
:type gnus-article-treat-head-custom)
(put 'gnus-treat-mail-picon 'highlight t)
See Info node `(gnus)Customizing Articles' and Info node
`(gnus)Picons' for details."
:group 'gnus-article-treat
+ :group 'gnus-picon
+ :link '(info-link "(gnus)Customizing Articles")
+ :link '(info-link "(gnus)Picons")
:type gnus-article-treat-head-custom)
(put 'gnus-treat-newsgroups-picon 'highlight t)
:group 'mime-security
:type gnus-article-treat-custom)
+(defcustom gnus-treat-monafy nil
+ "Display body part with mona font.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See Info node `(gnus)Customizing Articles' for details."
+ :group 'gnus-article-treat
+ :group 'mime-security
+ :type gnus-article-treat-custom)
+
(defvar gnus-article-encrypt-protocol-alist
'(("PGP" . mml2015-self-encrypt)))
'((gnus-treat-decode-article-as-default-mime-charset
gnus-article-decode-article-as-default-mime-charset)
(gnus-treat-x-pgp-sig gnus-article-verify-x-pgp-sig)
+ (gnus-treat-monafy gnus-article-monafy)
(gnus-treat-strip-banner gnus-article-strip-banner)
(gnus-treat-strip-headers-in-body gnus-article-strip-headers-in-body)
(gnus-treat-buttonize gnus-article-add-buttons)
(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 ?> ")" table)
- (modify-syntax-entry ?< "(" table)
+ (modify-syntax-entry ?> ")<" table)
+ (modify-syntax-entry ?< "(>" table)
table)
"Syntax table used in article mode buffers.
Initialized from `text-mode-syntax-table.")
(let ((buffer-read-only nil))
(goto-char (point-min))
(while (re-search-forward
- "^\\(\\(https?\\|ftp\\)://\\S-+\\)\n\\(\\S-+\\)" nil t)
+ "^\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t)
(replace-match "\\1\\3" t)))))
(defun article-wash-html (&optional read-charset)
(let ((w3-strict-width (window-width))
(url-standalone-mode t)
(url-gateway-unplugged t)
- (w3-honor-stylesheets nil)
- (w3-delay-image-loads t))
- (condition-case var
+ (w3-honor-stylesheets nil))
+ (condition-case ()
(w3-region (point-min) (point-max))
(error))))
mml2015-use
(mml2015-clear-verify-function))
(with-temp-buffer
- (insert-buffer gnus-original-article-buffer)
+ (insert-buffer-substring gnus-original-article-buffer)
(setq items (split-string sig))
(message-narrow-to-head)
(let ((inhibit-point-motion-hooks t)
(if (gnus-buffer-live-p gnus-original-article-buffer)
(canlock-verify gnus-original-article-buffer)))
+(defun article-monafy ()
+ "Display body part with mona font."
+ (interactive)
+ (unless (if (featurep 'xemacs)
+ (find-face 'gnus-mona-face)
+ (facep 'gnus-mona-face))
+ (require 'navi2ch-mona)
+ (set-face-font (make-face 'gnus-mona-face) navi2ch-mona-font))
+ (save-excursion
+ (let ((buffer-read-only nil))
+ (article-goto-body)
+ (gnus-overlay-put
+ (gnus-make-overlay (point) (point-max))
+ 'face 'gnus-mona-face))))
+
(eval-and-compile
(mapcar
(lambda (func)
'(article-hide-headers
article-verify-x-pgp-sig
article-verify-cancel-lock
+ article-monafy
article-hide-boring-headers
article-toggle-headers
article-treat-overstrike
gnus-article-mime-handle-alist))
(gnus-set-mode-line 'article))
(article-goto-body)
+ (unless (bobp)
+ (forward-line -1))
(set-window-point (get-buffer-window (current-buffer)) (point))
(gnus-configure-windows 'article)
t))))))
(gnus-mime-save-part-and-strip "\C-o" "Save and Strip")
(gnus-mime-copy-part "c" "View As Text, In Other Buffer")
(gnus-mime-inline-part "i" "View As Text, In This Buffer")
- (gnus-mime-internalize-part "E" "View Internally")
- (gnus-mime-externalize-part "e" "View Externally")
+ (gnus-mime-view-part-internally "E" "View Internally")
+ (gnus-mime-view-part-externally "e" "View Externally")
(gnus-mime-print-part "p" "Print")
(gnus-mime-pipe-part "|" "Pipe To Command...")
(gnus-mime-action-on-part "." "Take action on the part")))
(gnus-article-check-buffer)
(let* ((handle (or handle (get-text-property (point) 'gnus-data)))
(contents (and handle (mm-get-part handle)))
- (file (make-temp-name (expand-file-name "mm." mm-tmp-directory)))
+ (file (mm-make-temp-file (expand-file-name "mm." mm-tmp-directory)))
(printer (mailcap-mime-info (mm-handle-type handle) "print")))
(when contents
(if printer
(gnus-newsgroup-ignored-charsets 'gnus-all))
(gnus-article-press-button)))))
-(defun gnus-mime-externalize-part (&optional handle)
+(defun gnus-mime-view-part-externally (&optional handle)
"View the MIME part under point with an external viewer."
(interactive)
(gnus-article-check-buffer)
(mm-remove-part handle)
(mm-display-part handle)))))
-(defun gnus-mime-internalize-part (&optional handle)
+(defun gnus-mime-view-part-internally (&optional handle)
"View the MIME part under point with an internal viewer.
If no internal viewer is available, use an external viewer."
(interactive)
(interactive "p")
(gnus-article-part-wrapper n 'gnus-mime-view-part-as-charset))
-(defun gnus-article-externalize-part (n)
+(defun gnus-article-view-part-externally (n)
"View MIME part N externally, which is the numerical prefix."
(interactive "p")
- (gnus-article-part-wrapper n 'gnus-mime-externalize-part))
+ (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."
;; may change the point. So we set the window point.
(set-window-point window point)))
(let* ((handles (or ihandles (mm-dissect-buffer
- gnus-article-no-strict-mime)
+ nil gnus-article-loose-mime)
(mm-uu-dissect)))
buffer-read-only handle name type b e display)
(when (and (not ihandles)
(autoload 'nneething-get-file-name "nneething"))
(defun gnus-request-article-this-buffer (article group)
- "Get an article and insert it into this buffer.
-T-gnus change: Insert an article into `gnus-original-article-buffer'."
+ "Get an article and insert it into this buffer."
(let (do-update-line sparse-header)
- ;; The current buffer is `gnus-article-buffer'.
(prog1
(save-excursion
(erase-buffer)
(file-directory-p dir))
(setq article 'nneething)
(gnus-group-enter-directory dir))))))))
- (setq gnus-original-article (cons group article))
-
- ;; The current buffer is `gnus-original-article-buffer'.
- (if (get-buffer gnus-original-article-buffer)
- (set-buffer gnus-original-article-buffer)
- (set-buffer (gnus-get-buffer-create gnus-original-article-buffer))
- (set-buffer-multibyte nil)
- (buffer-disable-undo)
- (setq major-mode 'gnus-original-article-mode)
- (setq buffer-read-only nil))
(cond
;; Refuse to select canceled articles.
(assq article gnus-newsgroup-reads)))
gnus-canceled-mark))
nil)
+ ;; We first check `gnus-original-article-buffer'.
+ ((and (get-buffer gnus-original-article-buffer)
+ (numberp article)
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (and (equal (car gnus-original-article) group)
+ (eq (cdr gnus-original-article) article))))
+ (insert-buffer-substring gnus-original-article-buffer)
+ 'article)
;; Check the backlog.
((and gnus-keep-backlog
(gnus-backlog-request-article group article (current-buffer)))
(let ((gnus-override-method gnus-override-method)
(methods (and (stringp article)
gnus-refer-article-method))
+ (backend (car (gnus-find-method-for-group
+ gnus-newsgroup-name)))
result
(buffer-read-only nil))
(if (or (not (listp methods))
(gnus-kill-all-overlays)
(let ((gnus-newsgroup-name group))
(gnus-check-group-server))
- (when (gnus-request-article article group (current-buffer))
+ (cond
+ ((gnus-request-article article group (current-buffer))
(when (numberp article)
(gnus-async-prefetch-next group article
gnus-summary-buffer)
(gnus-backlog-enter-article
group article (current-buffer))))
(setq result 'article))
- (if (not result)
- (if methods
- (setq gnus-override-method (pop methods))
- (setq result 'done))))
+ (methods
+ (setq gnus-override-method (pop methods)))
+ ((not (string-match "^400 "
+ (nnheader-get-report backend)))
+ ;; If we get 400 server disconnect, reconnect and
+ ;; retry; otherwise, assume the article has expired.
+ (setq result 'done))))
(and (eq result 'article) 'article)))
;; It was a pseudo.
(t article)))
;; Associate this article with the current summary buffer.
(setq gnus-article-current-summary gnus-summary-buffer)
- ;; Copy the requested article from `gnus-original-article-buffer'.
- (unless (equal (buffer-name (current-buffer))
- (buffer-name (get-buffer gnus-original-article-buffer)))
- (insert-buffer gnus-original-article-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)
+ (equal (buffer-name (current-buffer))
+ (buffer-name (get-buffer gnus-article-buffer))))
+ (save-excursion
+ (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)
+ (setq major-mode 'gnus-original-article-mode)
+ (setq buffer-read-only t))
+ (let (buffer-read-only)
+ (erase-buffer)
+ (insert-buffer-substring gnus-article-buffer))
+ (setq gnus-original-article (cons group article)))
- ;; Decode charsets.
- (run-hooks 'gnus-article-decode-hook)
- ;; Mark article as decoded or not.
- (setq gnus-article-decoded-p gnus-article-decode-hook)
+ ;; Decode charsets.
+ (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
'(message-font-lock-keywords t))
(set (make-local-variable 'mail-header-separator) "")
(easy-menu-add message-mode-field-menu message-mode-map)
- (mml-mode)
(setq buffer-read-only nil)
(buffer-enable-undo)
(widen))
(winconf gnus-prev-winconf))
(remove-hook 'gnus-article-mode-hook
'gnus-article-mime-edit-article-unwind)
+ (widen) ;; Widen it in case that users narrowed the buffer.
(funcall func arg)
(set-buffer buf)
;; The cache and backlog have to be flushed somewhat.
(window-start (window-start)))
(erase-buffer)
(if (gnus-buffer-live-p gnus-original-article-buffer)
- (insert-buffer gnus-original-article-buffer))
+ (insert-buffer-substring gnus-original-article-buffer))
(let ((winconf gnus-prev-winconf))
(gnus-article-mode)
(set-window-configuration winconf)
'gnus-article-mime-edit-exit
gnus-article-edit-mode-map)
(erase-buffer)
- (insert-buffer gnus-original-article-buffer)
+ (insert-buffer-substring gnus-original-article-buffer)
(let ((ofn (symbol-function 'mime-edit-decode-single-part-in-buffer)))
(fset 'mime-edit-decode-single-part-in-buffer
(lambda (&rest args)
;; This is how URLs _should_ be embedded in text...
("<URL: *\\([^<>]*\\)>" 1 t gnus-button-embedded-url 1)
;; Raw URLs.
- (,gnus-button-url-regexp 0 t browse-url 0))
+ (gnus-button-url-regexp 0 t browse-url 0))
"*Alist of regexps matching buttons in article bodies.
Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where
CALLBACK can also be a variable, in that case the value of that
variable it the real callback function."
:group 'gnus-article-buttons
- :type '(repeat (list regexp
+ :type '(repeat (list (choice regexp variable)
(integer :tag "Button")
(sexp :tag "Form")
(function :tag "Callback")
(article-goto-body)
(setq beg (point))
(while (setq entry (pop alist))
- (setq regexp (car entry))
+ (setq regexp (eval (car entry)))
(goto-char beg)
(while (re-search-forward regexp nil t)
(let* ((start (and entry (match-beginning (nth 1 entry))))
(entry nil))
(while alist
(setq entry (pop alist))
- (if (looking-at (car entry))
+ (if (looking-at (eval (car entry)))
(setq alist nil)
(setq entry nil)))
entry))
projects / elisp / gnus.git- / blobdiff