diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/gnus/ChangeLog | 71 | ||||
| -rw-r--r-- | lisp/gnus/gnus-art.el | 150 |
2 files changed, 184 insertions, 37 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 5c23210580..28d5d5fc56 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,14 @@ +2000-10-27 John Wiegley <[email protected]> + + * 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 <[email protected]> + + * gnus-art.el (gnus-read-save-file-name): expand-file-name. + 2000-10-27 Dave Love <[email protected]> * gnus.el: Don't require custom. Don't require message at top @@ -6,11 +17,42 @@ 2000-10-27 Kai Gro,A_(Bjohann <[email protected]> + * gnus-art.el (article-strip-banner): Use + gnus-group-find-parameter rather than gnus-group-get-parameter, to + allow inheritance on the banner. + From [email protected]. + * gnus-sum.el (gnus-get-split-value): Use first match only (Ed L Cashin <[email protected]>). 2000-10-27 Simon Josefsson <[email protected]> + * nnimap.el (nnimap-group-overview-filename): Create directory for + newfile (when use long filenames is nil). Copy+delete file if + rename didn't work. + (nnimap-group-overview-filename): `rename-file' and `copy-file' + doesn't return anything useful, use ignore-errors instead. + (nnimap-verify-uidvalidity): Delete overview file when + uid validity changes. + (nnimap-group-overview-filename): Store uidvalidity in filenames. + Rename old files into new format. + (nnimap-request-accept-article): Remove \n's from + From_ lines. + (nnimap-request-accept-article): Remove From[^:] lines. + (imap-starttls-p): Check for starttls binary. + (imap-starttls-open): More verbose. + (imap-gssapi-auth): Ditto. + (imap-kerberos4-auth): Ditto. + (imap-cram-md5-auth): Ditto. + (imap-login-auth): Ditto. + (imap-anonymous-auth): Ditto. + (imap-digest-md5-auth): Ditto. + (imap-open): Ditto. + (imap-digest-md5-p): Check capability first. + (imap-parse-flag-list): Correctly parse empty lists. + (imap-login-p): Support LOGINDISABLED. + (imap-parse-body): Work around bug in Sun SIMS. + * gnus-agent.el (gnus-agent-possibly-do-gcc): (gnus-agent-restore-gcc): (gnus-agent-possibly-save-gcc): New functions. @@ -34,6 +76,35 @@ 2000-10-27 ShengHuo ZHU <[email protected]> + * 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. + + * mailcap.el (mailcap-parse-mailcaps): Don't use parse-colon-path, + because they are files, not paths. + (mailcap-parse-mimetypes): Ditto. + (mailcap-mime-types): Use mailcap-mime-data. + * gnus.el (gnus-xmas-define): Defalias gnus-overlay-buffer, gnus-overlay-start. * gnus.el (gnus-agent-fetching): New variable. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 55801cfcab..0c327b8e79 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -2,6 +2,7 @@ ;; Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <[email protected]> +;; Maintainer: [email protected] ;; Keywords: news ;; This file is part of GNU Emacs. @@ -205,7 +206,10 @@ regexp. If it matches, the text in question is not a signature." (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 @@ asynchronously. The compressed face will be piped to this command." :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 @@ displayed by the first non-nil matching CONTENT face." ("\223" "``") ("\224" "\"") ("\225" "*") - ("\226" "---") - ("\227" "-") + ("\226" "-") + ("\227" "--") ("\231" "(TM)") ("\233" ">") ("\234" "oe") @@ -647,6 +658,20 @@ used." :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 @@ See the manual for details." :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 @@ See the manual for details." (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 @@ See the manual for details." :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 @@ See the manual for details." (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 @@ always hide." (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 @@ always hide." (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 @@ This format is defined by the `gnus-article-time-format' variable." (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 @@ If ALL-HEADERS is non-nil, no headers are hidden." (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 @@ If ALL-HEADERS is non-nil, no headers are hidden." (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 @@ If ALL-HEADERS is non-nil, no headers are hidden." (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 @@ In no internal viewer is available, use an external viewer." (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 @@ In no internal viewer is available, use an external viewer." (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 @@ In no internal viewer is available, use an external viewer." (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 @@ In no internal viewer is available, use an external viewer." ;; 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 @@ In no internal viewer is available, use an external viewer." (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 @@ In no internal viewer is available, use an external viewer." 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 @@ In no internal viewer is available, use an external viewer." (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 @@ In no internal viewer is available, use an external viewer." (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 @@ If given a prefix, show the hidden text instead." 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 @@ forbidden in URL encoding." (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 @@ For example: (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) |