X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=0508d68e2f529197b4b60f44b19c6665d4f3b376;hb=42bb2fbbb706d756e17afc96e269aceccb97c967;hp=02fc34c378249d0318b083c461db80d7bf32f118;hpb=71daa7fc8bafb8087cd29f9ceb3c96eb6acaa56b;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 02fc34c..0508d68 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -1,7 +1,7 @@ ;;; gnus-art.el --- article mode commands for Semi-gnus ;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. -;; Author: Lars Magne Ingebrigtsen +;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko ;; Keywords: mail, news, MIME @@ -199,7 +199,7 @@ asynchronously. The compressed face will be piped to this command." (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. Each item looks like this: @@ -641,6 +641,7 @@ always hide." (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))) @@ -1382,13 +1383,14 @@ function and want to see what the date was before converting." (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. @@ -1583,7 +1585,6 @@ This format is defined by the `gnus-article-time-format' variable." "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 @@ -1599,7 +1600,6 @@ Directory to save to is default to `gnus-article-save-directory'." "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 @@ -1618,7 +1618,6 @@ Directory to save to is default to `gnus-article-save-directory'." "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 @@ -1637,14 +1636,12 @@ Directory to save to is default to `gnus-article-save-directory'." "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 @@ -1661,7 +1658,6 @@ The directory to save in defaults to `gnus-article-save-directory'." (defun gnus-summary-save-in-pipe (&optional command) "Pipe this article to subprocess." - (interactive) (setq command (cond ((eq command 'default) gnus-last-shell-command) @@ -1775,8 +1771,6 @@ If variable `gnus-use-long-file-name' is non-nil, it is (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 @@ -1852,10 +1846,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is ["Remove carriage return" gnus-article-remove-cr 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] @@ -1881,7 +1872,6 @@ commands: (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) @@ -1891,9 +1881,9 @@ commands: (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) - (set (make-local-variable 'gnus-article-current-summary) 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) @@ -1968,16 +1958,14 @@ commands: default-mime-charset)) ) (save-excursion - (mime-view-mode nil nil nil gnus-original-article-buffer - gnus-article-buffer - gnus-article-mode-map) + (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. -It is registered to variable `mime-view-content-header-filter-alist'." + "Header filter for gnus-article-mode." (let ((charset (save-excursion (set-buffer gnus-summary-buffer) default-mime-charset))) @@ -2301,67 +2289,68 @@ Argument LINES specifies lines to be scrolled down." "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")) + '("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) + keys new-sum-point) (save-excursion (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-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))) + (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)) - (summary gnus-article-current-summary) - func in-buffer) - (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)) - (set-buffer obuf) - (unless not-restore-window - (set-window-configuration owin)) - (unless (member keys up-to-top) + (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)))))))) + (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. @@ -2407,7 +2396,7 @@ If given a prefix, show the hidden text instead." (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))) @@ -2431,8 +2420,8 @@ If given a prefix, show the hidden text instead." (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) @@ -2444,7 +2433,7 @@ If given a prefix, show the hidden text instead." ((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))) @@ -2501,7 +2490,7 @@ If given a prefix, show the hidden text instead." (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) @@ -2554,7 +2543,6 @@ This is an extended text-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) @@ -2684,15 +2672,17 @@ groups." :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\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 t gnus-button-message-id 3) ("\\( \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... ("]*\\)>" 0 t gnus-button-embedded-url 1) @@ -3245,10 +3235,13 @@ forbidden in URL encoding." ;;; @ for mime-view ;;; -(defun gnus-content-header-filter () - "Header filter for mime-view. -It is registered to variable `mime-view-content-header-filter-alist'." - (eword-decode-header default-mime-charset)) +(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) @@ -3260,17 +3253,8 @@ It is registered to variable `mime-view-content-header-filter-alist'." (gnus-summary-select-article nil t) )) -(set-alist 'mime-raw-buffer-coding-system-alist - 'gnus-original-article-mode - 'raw-text) - -(set-alist 'mime-view-content-header-filter-alist - 'gnus-original-article-mode - #'gnus-content-header-filter) - -(set-alist 'mime-text-decoder-alist - 'gnus-original-article-mode - #'mime-text-decode-buffer) +(set-alist 'mime-raw-representation-type-alist + 'gnus-original-article-mode 'binary) (set-alist 'mime-preview-quitting-method-alist 'gnus-original-article-mode @@ -3280,6 +3264,17 @@ It is registered to variable `mime-view-content-header-filter-alist'." '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 ;;;