X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=94849bb4fc4f883945189c8934d44dfa499fd84c;hb=9b741e050b400987d68ff761c6cc3276c932839c;hp=5a29e9a3ba1df5f3eedc8bfa1abac335a9189c7a;hpb=bb39fc7a397d0811a5891d60b07ecacc69b6dc59;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 5a29e9a..94849bb 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -278,6 +278,7 @@ asynchronously. The compressed face will be piped to this command." 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 @@ -754,10 +755,13 @@ be controlled by `gnus-treat-body-boundary'." 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 () @@ -1190,6 +1194,9 @@ Valid values are nil, t, `head', `last', an integer or a predicate. 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) @@ -1202,6 +1209,9 @@ Valid values are nil, t, `head', `last', an integer or a predicate. 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) @@ -1214,6 +1224,9 @@ Valid values are nil, t, `head', `last', an integer or a predicate. 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) @@ -1375,8 +1388,8 @@ It is a string, such as \"PGP\". If nil, ask user." (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.") @@ -2283,7 +2296,7 @@ If READ-CHARSET, ask for a coding system." (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) @@ -2327,9 +2340,8 @@ If READ-CHARSET, ask for a coding system." (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)))) @@ -3362,7 +3374,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is 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) @@ -3861,6 +3873,8 @@ If ALL-HEADERS is non-nil, no headers are hidden." 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)))))) @@ -4248,7 +4262,7 @@ General format specifiers can also be used. See (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 @@ -5293,10 +5307,8 @@ If given a prefix, show the hidden text instead." (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) @@ -5349,16 +5361,6 @@ T-gnus change: Insert an article into `gnus-original-article-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. @@ -5371,6 +5373,15 @@ T-gnus change: Insert an article into `gnus-original-article-buffer'." (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))) @@ -5397,6 +5408,8 @@ T-gnus change: Insert an article into `gnus-original-article-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)) @@ -5415,7 +5428,8 @@ T-gnus change: Insert an article into `gnus-original-article-buffer'." (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) @@ -5423,10 +5437,13 @@ T-gnus change: Insert an article into `gnus-original-article-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))) @@ -5434,15 +5451,27 @@ T-gnus change: Insert an article into `gnus-original-article-buffer'." ;; 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 @@ -5549,7 +5578,6 @@ This is an extended text-mode. '(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)) @@ -5596,6 +5624,7 @@ groups." (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. @@ -5629,7 +5658,7 @@ groups." (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) @@ -5699,7 +5728,7 @@ after replacing with the original article." '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) @@ -5790,7 +5819,7 @@ after replacing with the original article." ;; This is how URLs _should_ be embedded in text... ("]*\\)>" 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 @@ -5804,7 +5833,7 @@ PAR: is a number of a regexp grouping whose text will be passed to CALLBACK. 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") @@ -6032,7 +6061,7 @@ specified by `gnus-button-alist'." (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)))) @@ -6141,7 +6170,7 @@ specified by `gnus-button-alist'." (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))