;;; gnus-art.el --- article mode commands for Semi-gnus
-;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
(const :tag "Followup-to identical to newsgroups." followup-to)
(const :tag "Reply-to identical to from." reply-to)
(const :tag "Date less than four days old." date)
- (const :tag "Very long To header." long-to)
- (const :tag "Multiple To headers." many-to))
+ (const :tag "Very long To and/or Cc header." long-to)
+ (const :tag "Multiple To and/or Cc headers." many-to))
:group 'gnus-article-hiding)
(defcustom gnus-signature-separator '("^-- $" "^-- *$")
4))
(gnus-article-hide-header "date"))))
((eq elem 'long-to)
- (let ((to (message-fetch-field "to")))
+ (let ((to (message-fetch-field "to"))
+ (cc (message-fetch-field "cc")))
(when (> (length to) 1024)
- (gnus-article-hide-header "to"))))
+ (gnus-article-hide-header "to"))
+ (when (> (length cc) 1024)
+ (gnus-article-hide-header "cc"))))
((eq elem 'many-to)
- (let ((to-count 0))
+ (let ((to-count 0)
+ (cc-count 0))
(goto-char (point-min))
(while (re-search-forward "^to:" nil t)
(setq to-count (1+ to-count)))
(forward-line -1)
(narrow-to-region (point) (point-max))
(gnus-article-hide-header "to"))
- (setq to-count (1- to-count)))))))))))))
+ (setq to-count (1- to-count))))
+ (goto-char (point-min))
+ (while (re-search-forward "^cc:" nil t)
+ (setq cc-count (1+ cc-count)))
+ (when (> cc-count 1)
+ (while (> cc-count 0)
+ (goto-char (point-min))
+ (save-restriction
+ (re-search-forward "^cc:" nil nil cc-count)
+ (forward-line -1)
+ (narrow-to-region (point) (point-max))
+ (gnus-article-hide-header "cc"))
+ (setq cc-count (1- cc-count)))))))))))))
(defun gnus-article-hide-header (header)
(save-excursion
(not (string-match gnus-article-x-face-too-ugly
from))))
;; Has to be present.
- (re-search-forward "^X-Face: " nil t))
+ (re-search-forward "^X-Face:[ \t]*" nil t))
;; This used to try to do multiple faces (`while' instead of
;; `when' above), but (a) sending multiple EOFs to xv doesn't
;; work (b) it can crash some versions of Emacs (c) are
(mm-read-coding-system "Charset to decode: "))
(ctl
(mail-content-type-get ctl 'charset))))
+ (when cte
+ (setq cte (mail-header-strip cte)))
(if (and ctl (not (string-match "/" (car ctl))))
(setq ctl nil))
(goto-char (point-max)))
(when (or force
(and type (string-match "quoted-printable" (downcase type))))
(article-goto-body)
- (save-restriction
- (narrow-to-region (point) (point-max))
- (quoted-printable-decode-region (point-min) (point-max))
- (when charset
- (mm-decode-body charset)))))))
+ (quoted-printable-decode-region (point) (point-max) charset)))))
(eval-when-compile
(require 'rfc1843))
"s" gnus-article-show-summary
"\C-c\C-m" gnus-article-mail
"?" gnus-article-describe-briefly
- "e" gnus-summary-article-edit
+ "e" gnus-summary-edit-article
"<" beginning-of-buffer
">" end-of-buffer
"\C-c\C-i" gnus-info-find-node
(make-local-variable 'gnus-article-mime-handles)
(make-local-variable 'gnus-article-decoded-p)
(make-local-variable 'gnus-article-mime-handle-alist)
- (make-local-variable 'gnus-article-washed-types)
+ (make-local-variable 'gnus-article-wash-types)
(gnus-set-default-directory)
(buffer-disable-undo)
(setq buffer-read-only t)
(if (get-buffer name)
(save-excursion
(set-buffer name)
- (kill-all-local-variables)
(buffer-disable-undo)
(setq buffer-read-only t)
(unless (eq major-mode 'gnus-article-mode)
(message "Message marked for downloading"))
(gnus-summary-mark-article article gnus-canceled-mark)
(unless (memq article gnus-newsgroup-sparse)
- (gnus-error 1
- "No such article (may have expired or been canceled)")))))
+ (gnus-error 1 "No such article (may have expired or been canceled)")))))
(if (or (eq result 'pseudo)
(eq result 'nneething))
(progn
(let ((data (get-text-property (point) 'gnus-data)))
(mm-interactively-view-part data)))
-(defun gnus-mime-view-part-as-type ()
+(defun gnus-mime-view-part-as-type-internal ()
+ (gnus-article-check-buffer)
+ (let* ((name (mail-content-type-get
+ (mm-handle-type (get-text-property (point) 'gnus-data))
+ 'name))
+ (def-type (and name (mm-default-file-encoding name))))
+ (and def-type (cons def-type 0))))
+
+(defun gnus-mime-view-part-as-type (mime-type)
"Choose a MIME media type, and view the part as such."
(interactive
- (list (completing-read "View as MIME type: "
- (mapcar 'list (mailcap-mime-types)))))
+ (list (completing-read
+ "View as MIME type: "
+ (mapcar (lambda (i) (list i i)) (mailcap-mime-types))
+ nil nil
+ (gnus-mime-view-part-as-type-internal))))
(gnus-article-check-buffer)
(let ((handle (get-text-property (point) 'gnus-data)))
- (gnus-mm-display-part handle)))
+ (gnus-mm-display-part
+ (mm-make-handle (mm-handle-buffer handle)
+ (cons mime-type (cdr (mm-handle-type handle)))
+ (mm-handle-encoding handle)
+ (mm-handle-undisplayer handle)
+ (mm-handle-disposition handle)
+ (mm-handle-description handle)
+ (mm-handle-cache handle)
+ (mm-handle-id handle)))))
(defun gnus-mime-copy-part (&optional handle)
"Put the the MIME part under point into a new buffer."
(t
(if start
(set-window-start (selected-window) start)
- (scroll-up lines))
+ (let (window-pixel-scroll-increment)
+ (scroll-up lines)))
nil))))
(defun gnus-article-prev-page (&optional lines)
(gnus-narrow-to-page -1))
(t
(condition-case nil
- (scroll-down lines)
+ (let (window-pixel-scroll-increment)
+ (scroll-down lines))
(beginning-of-buffer
(goto-char (point-min))))))))
;; We disable the pick minor mode commands.
(let (gnus-pick-mode)
(setq func (lookup-key (current-local-map) keys))))
- (if (not func)
+ (if (or (not func)
+ (numberp func))
(ding)
(unless (member keys nosave-in-article)
(set-buffer gnus-article-current-summary))
(gnus-cache-request-article article group))
'article)
;; Get the article and put into the article buffer.
- ((or (stringp article) (numberp article))
+ ((or (stringp article)
+ (numberp article))
(let ((gnus-override-method gnus-override-method)
(methods (and (stringp article)
gnus-refer-article-method))
(buffer-read-only nil))
(setq methods
(if (listp methods)
- (delq 'current methods)
+ methods
(list methods)))
- (if (and (null gnus-override-method) methods)
- (setq gnus-override-method (pop methods)))
+ (when (and (null gnus-override-method)
+ methods)
+ (setq gnus-override-method (pop methods)))
(while (not result)
+ (when (eq gnus-override-method 'current)
+ (setq gnus-override-method gnus-current-select-method))
(erase-buffer)
(gnus-kill-all-overlays)
(let ((gnus-newsgroup-name group))
;;; Internal Variables:
-(defcustom gnus-button-url-regexp "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?\\([-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,]\\|\\w\\)+\\([-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)"
+(defcustom gnus-button-url-regexp "\\b\\(\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?\\([-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,]\\|\\w\\)+\\([-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)\\)\\|[-a-zA-Z0-9_]+\\.[-a-zA-Z0-9_]+\\(\\.[-a-zA-Z0-9_]+[-a-zA-Z0-9_/]+\\)+"
"Regular expression that matches URLs."
:group 'gnus-article-buttons
:type 'regexp)
(gnus-run-hooks 'gnus-part-display-hook)
(unless gnus-inhibit-treatment
(while (setq elem (pop alist))
- (setq val (symbol-value (car elem)))
+ (with-current-buffer gnus-summary-buffer
+ (setq val (symbol-value (car elem))))
(when (and (or (consp val)
treated-type)
(gnus-treat-predicate val)
projects / elisp / gnus.git- / blobdiff