# HG changeset patch # User Dave Love # Date 972688263 0 # Node ID ce95094f21e7eec27268e74ce8b99a85c5183e62 # Parent 8d46095169e82d1819190d0d70d118e03d4c771b 2000-10-27 John Wiegley * gnus-art.el (gnus-treat-hide-citation-maybe): Added this variable to correspond with `gnus-article-hide-citation-maybe'. (gnus-treatment-function-alist): Added entry for the above correlation. 2000-10-27 Richard M. Alderson III * gnus-art.el (gnus-read-save-file-name): expand-file-name. 2000-10-27 Kai Gro?ohann * gnus-art.el (article-strip-banner): Use gnus-group-find-parameter rather than gnus-group-get-parameter, to allow inheritance on the banner. From elkin@tverd.astro.spbu.ru. 2000-10-27 ShengHuo ZHU * gnus-art.el (gnus-request-article-this-buffer): gnus-refer-article-method might be a single method. (gnus-article-mime-total-parts): New function. (gnus-mm-display-part): Use it. (gnus-mime-display-single): Ditto. (gnus-mime-display-alternative): Ditto. (gnus-mime-inline-part): Check validity of charset. (gnus-treat-display-smileys): Default value in Emacs 21. * gnus-art.el: Define dynamic variables in eval-when-compile. (gnus-article-prepare): Configure it again. (gnus-insert-mime-button): Use gnus-overlay-buffer, gnus-overlay-start. (gnus-article-prepare): Configure windows before gnus-article-prepare-display is called. Otherwise, BBDB's popup window might be overrided. (gnus-mime-inline-part): Use prefix argument only when it is called interactively. (gnus-mime-action-alist): New variable. (gnus-mime-action-on-part): Use it. (gnus-mime-button-commands): Add command ".". (gnus-mime-inline-part): Support prefix argument. (gnus-article-banner-alist): New variable. (article-strip-banner): Use it. diff -r 8d46095169e8 -r ce95094f21e7 lisp/gnus/gnus-art.el --- a/lisp/gnus/gnus-art.el Fri Oct 27 23:01:20 2000 +0000 +++ b/lisp/gnus/gnus-art.el Fri Oct 27 23:11:03 2000 +0000 @@ -2,6 +2,7 @@ ;; Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen +;; Maintainer: bugs@gnu.org ;; Keywords: news ;; This file is part of GNU Emacs. @@ -205,7 +206,10 @@ (if (and (fboundp 'image-type-available-p) (image-type-available-p 'xbm)) 'gnus-article-display-xface - "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | display -") + (if gnus-article-compface-xbm + "{ echo '/* Width=48, Height=48 */'; uncompface; } | display -" + "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | \ +display -")) "*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." @@ -219,6 +223,13 @@ :type '(choice regexp (const nil)) :group 'gnus-article-washing) +(defcustom gnus-article-banner-alist nil + "Banner alist for stripping. +For example, + ((egroups . \"^[ \\t\\n]*-------------------+\\\\( eGroups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))" + :type '(repeat (cons symbol regexp)) + :group 'gnus-article-washing) + (defcustom gnus-emphasis-alist (let ((format "\\(\\s-\\|^\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\s-\\|[-,;:\"]\\s-\\|[?!.]+\\s-\\|\\s)\\)") @@ -595,8 +606,8 @@ ("\223" "``") ("\224" "\"") ("\225" "*") - ("\226" "---") - ("\227" "-") + ("\226" "-") + ("\227" "--") ("\231" "(TM)") ("\233" ">") ("\234" "oe") @@ -647,6 +658,20 @@ :value undisplayed-alternative) (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." + :group 'gnus-article-mime + :type '(repeat (cons (string :tag "name") + (function)))) + ;;; ;;; The treatment variables ;;; @@ -747,6 +772,13 @@ :group 'gnus-article-treat :type gnus-article-treat-custom) +(defcustom gnus-treat-hide-citation-maybe nil + "Hide cited text. +Valid values are nil, t, `head', `last', an integer or a predicate. +See the manual for details." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + (defcustom gnus-treat-strip-list-identifiers 'head "Strip list identifiers from `gnus-list-identifiers`. Valid values are nil, t, `head', `last', an integer or a predicate. @@ -873,7 +905,8 @@ (defcustom gnus-treat-display-xface (and (or (and (fboundp 'image-type-available-p) - (image-type-available-p 'xbm)) + (image-type-available-p 'xbm) + (string-match "^0x" (shell-command-to-string "uncompface"))) (and (featurep 'xemacs) (featurep 'xface))) 'head) "Display X-Face headers. @@ -883,9 +916,12 @@ :type gnus-article-treat-head-custom) (put 'gnus-treat-display-xface 'highlight t) -(defcustom gnus-treat-display-smileys (if (and (featurep 'xemacs) - (featurep 'xpm)) - t nil) +(defcustom gnus-treat-display-smileys + (if (or (and (featurep 'xemacs) + (featurep 'xpm)) + (and (fboundp 'image-type-available-p) + (image-type-available-p 'pbm))) + t nil) "Display smileys. Valid values are nil, t, `head', `last', an integer or a predicate. See the manual for details." @@ -950,6 +986,7 @@ (gnus-treat-hide-boring-headers gnus-article-hide-boring-headers) (gnus-treat-hide-signature gnus-article-hide-signature) (gnus-treat-hide-citation gnus-article-hide-citation) + (gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe) (gnus-treat-strip-list-identifiers gnus-article-hide-list-identifiers) (gnus-treat-strip-pgp gnus-article-hide-pgp) (gnus-treat-strip-pem gnus-article-hide-pem) @@ -1697,7 +1734,7 @@ (save-excursion (save-restriction (let ((inhibit-point-motion-hooks t) - (banner (gnus-group-get-parameter gnus-newsgroup-name 'banner)) + (banner (gnus-group-find-parameter gnus-newsgroup-name 'banner)) (gnus-signature-limit nil) buffer-read-only beg end) (when banner @@ -1708,6 +1745,10 @@ (widen) (forward-line -1) (delete-region (point) (point-max)))) + ((symbolp banner) + (if (setq banner (cdr (assq banner gnus-article-banner-alist))) + (while (re-search-forward banner nil t) + (delete-region (match-beginning 0) (match-end 0))))) ((stringp banner) (while (re-search-forward banner nil t) (delete-region (match-beginning 0) (match-end 0)))))))))) @@ -2333,7 +2374,7 @@ (setq file (expand-file-name (file-name-nondirectory default-name) (file-name-as-directory file)))) ;; Possibly translate some characters. - (nnheader-translate-file-chars file))))) + (nnheader-translate-file-chars file)))))) (gnus-make-directory (file-name-directory result)) (set variable result))) @@ -2816,6 +2857,8 @@ (gnus-set-global-variables) (setq gnus-have-all-headers (or all-headers gnus-show-all-headers)))) + (save-excursion + (gnus-configure-windows 'article)) (when (or (numberp article) (stringp article)) (gnus-article-prepare-display) @@ -2881,7 +2924,8 @@ (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-pipe-part "|" "Pipe To Command..."))) + (gnus-mime-pipe-part "|" "Pipe To Command...") + (gnus-mime-action-on-part "." "Take action on the part"))) (defun gnus-article-mime-part-status () (if gnus-article-mime-handle-alist-1 @@ -2999,19 +3043,35 @@ (setq buffer-file-name nil)) (goto-char (point-min)))) -(defun gnus-mime-inline-part (&optional handle) +(defun gnus-mime-inline-part (&optional handle arg) "Insert the MIME part under point into the current buffer." - (interactive) + (interactive (list nil current-prefix-arg)) (gnus-article-check-buffer) (let* ((handle (or handle (get-text-property (point) 'gnus-data))) - contents + contents charset (b (point)) buffer-read-only) (if (mm-handle-undisplayer handle) (mm-remove-part handle) (setq contents (mm-get-part handle)) + (cond + ((not arg) + (setq charset (or (mail-content-type-get + (mm-handle-type handle) 'charset) + gnus-newsgroup-charset))) + ((numberp arg) + (setq charset + (or (cdr (assq arg + gnus-summary-show-article-charset-alist)) + (read-coding-system "Charset: "))))) (forward-line 2) - (mm-insert-inline handle contents) + (mm-insert-inline handle + (if (and charset + (setq charset (mm-charset-to-coding-system + charset)) + (not (eq charset 'ascii))) + (mm-decode-coding-string contents charset) + contents)) (goto-char b)))) (defun gnus-mime-externalize-part (&optional handle) @@ -3045,6 +3105,16 @@ (mm-remove-part handle) (mm-display-part handle)))) +(defun gnus-mime-action-on-part (&optional action) + "Do something with the MIME attachment at \(point\)." + (interactive + (list (completing-read "Action: " gnus-mime-action-alist))) + (gnus-article-check-buffer) + (let ((action-pair (assoc action gnus-mime-action-alist))) + (if action-pair + (funcall (cdr action-pair))))) + + (defun gnus-article-part-wrapper (n function) (save-current-buffer (set-buffer gnus-article-buffer) @@ -3120,6 +3190,11 @@ (when (eq (gnus-mm-display-part handle) 'internal) (gnus-set-window-start))))))) +(defsubst gnus-article-mime-total-parts () + (if (bufferp (car gnus-article-mime-handles)) + 1 ;; single part + (1- (length gnus-article-mime-handles)))) + (defun gnus-mm-display-part (handle) "Display HANDLE and fix MIME button." (let ((id (get-text-property (point) 'gnus-part)) @@ -3153,7 +3228,7 @@ (narrow-to-region (point) (point-max)) (gnus-treat-article nil id - (1- (length gnus-article-mime-handles)) + (gnus-article-mime-total-parts) (mm-handle-media-type handle))))) (select-window window)))) (goto-char point) @@ -3223,8 +3298,8 @@ ;; window, overlay, position. (if (mm-handle-displayed-p (if overlay - (with-current-buffer (overlay-buffer overlay) - (widget-get (widget-at (overlay-start overlay)) + (with-current-buffer (gnus-overlay-buffer overlay) + (widget-get (widget-at (gnus-overlay-start overlay)) :mime-handle)) (widget-get widget/window :mime-handle))) "hide" "show") @@ -3341,7 +3416,8 @@ (setq display t) (when (equal (mm-handle-media-supertype handle) "text") (setq text t))) - (let ((id (1+ (length gnus-article-mime-handle-alist)))) + (let ((id (1+ (length gnus-article-mime-handle-alist))) + beg) (push (cons id handle) gnus-article-mime-handle-alist) (when (or (not display) (not (gnus-unbuttonized-mime-type-p type))) @@ -3350,8 +3426,8 @@ handle id (list (or display (and not-attachment text)))) (gnus-article-insert-newline) ;(gnus-article-insert-newline) - (setq move t))) - (let ((beg (point))) + (setq move t)) + (setq beg (point)) (cond (display (when move @@ -3377,8 +3453,8 @@ (save-restriction (narrow-to-region beg (point)) (gnus-treat-article - nil (length gnus-article-mime-handle-alist) - (1- (length gnus-article-mime-handles)) + nil id + (gnus-article-mime-total-parts) (mm-handle-media-type handle))))))))) (defun gnus-unbuttonized-mime-type-p (type) @@ -3480,7 +3556,7 @@ (narrow-to-region (car begend) (point-max)) (gnus-treat-article nil (length gnus-article-mime-handle-alist) - (1- (length gnus-article-mime-handles)) + (gnus-article-mime-total-parts) (mm-handle-media-type handle)))))) (goto-char (point-max)) (setcdr begend (point-marker))))) @@ -3885,10 +3961,10 @@ gnus-refer-article-method)) result (buffer-read-only nil)) - (setq methods - (if (listp methods) - methods - (list methods))) + (if (or (not (listp methods)) + (and (symbolp (car methods)) + (assq (car methods) nnoo-definition-alist))) + (setq methods (list methods))) (when (and (null gnus-override-method) methods) (setq gnus-override-method (pop methods))) @@ -4547,16 +4623,14 @@ (message-goto-subject)))) (defun gnus-button-mailto (address) - ;; Mail to ADDRESS. + "Mail to ADDRESS." (set-buffer (gnus-copy-article-buffer)) (message-reply address)) -(defun gnus-button-reply (address) - ;; Reply to ADDRESS. - (message-reply address)) +(defalias 'gnus-button-reply 'message-reply) (defun gnus-button-embedded-url (address) - "Browse ADDRESS." + "Activate ADDRESS with `browse-url'." (browse-url (gnus-strip-whitespace address))) ;;; Next/prev buttons in the article buffer. @@ -4696,11 +4770,13 @@ (funcall (cadr elem))))))) ;; Dynamic variables. -(defvar part-number) -(defvar total-parts) -(defvar type) -(defvar condition) -(defvar length) +(eval-when-compile + (defvar part-number) + (defvar total-parts) + (defvar type) + (defvar condition) + (defvar length)) + (defun gnus-treat-predicate (val) (cond ((null val)