(defcustom gnus-article-x-face-command
(cond
+ ;; Fixme: This isn't the right thing for mixed graphical and and
+ ;; non-graphical frames in a session.
+ ;; gnus-xmas.el overrides this for XEmacs.
((and (fboundp 'image-type-available-p)
- (or (image-type-available-p 'xpm)
- (image-type-available-p 'xbm)))
+ (image-type-available-p 'xbm))
'gnus-article-display-xface)
((and (not gnus-xemacs)
window-system
face))
:group 'gnus-article-emphasis)
+(defcustom gnus-emphasize-whitespace-regexp "^[ \t]+\\|[ \t]*\n"
+ "A regexp to describe whitespace which should not be emphasized.
+Typical values are \"^[ \\t]+\\\\|[ \\t]*\\n\" and \"[ \\t]+\\\\|[ \\t]*\\n\".
+The former avoids underlining of leading and trailing whitespace,
+and the latter avoids underlining any whitespace at all."
+ :group 'gnus-article-emphasis
+ :type 'regexp)
+
(defface gnus-emphasis-bold '((t (:bold t)))
"Face used for displaying strong emphasized text (*word*)."
:group 'gnus-article-emphasis)
(set-buffer gnus-summary-buffer)
(error))
gnus-newsgroup-ignored-charsets))
- ct cte ctl charset)
+ ct cte ctl charset format)
(save-excursion
(save-restriction
(article-narrow-to-head)
(prompt
(mm-read-coding-system "Charset to decode: "))
(ctl
- (mail-content-type-get ctl 'charset))))
+ (mail-content-type-get ctl 'charset)))
+ format (and ctl (mail-content-type-get ctl 'format)))
(when cte
(setq cte (mail-header-strip cte)))
(if (and ctl (not (string-match "/" (car ctl))))
(forward-line 1)
(save-restriction
(narrow-to-region (point) (point-max))
+ (when (and (eq mail-parse-charset 'gnus-decoded)
+ (eq (mm-body-7-or-8) '8bit))
+ ;; The text code could have been decoded.
+ (setq charset mail-parse-charset))
(when (and (or (not ctl)
- (equal (car ctl) "text/plain")))
+ (equal (car ctl) "text/plain"))
+ (not format)) ;; article with format will decode later.
(mm-decode-body
charset (and cte (intern (downcase
(gnus-strip-whitespace cte))))
(article-goto-body)
(quoted-printable-decode-region (point) (point-max) charset)))))
+(defun article-de-base64-unreadable (&optional force)
+ "Translate a base64 article.
+If FORCE, decode the article whether it is marked as base64 not."
+ (interactive (list 'force))
+ (save-excursion
+ (let ((buffer-read-only nil)
+ (type (gnus-fetch-field "content-transfer-encoding"))
+ (charset gnus-newsgroup-charset))
+ (when (or force
+ (and type (string-match "base64" (downcase type))))
+ (article-goto-body)
+ (save-restriction
+ (narrow-to-region (point) (point-max))
+ (base64-decode-region (point-min) (point-max))
+ (if (mm-coding-system-p charset)
+ (mm-decode-coding-region (point-min) (point-max) charset)))))))
+
(eval-when-compile
(require 'rfc1843))
(let ((buffer-read-only nil))
(rfc1843-decode-region (point-min) (point-max)))))
+(defun article-wash-html ()
+ "Format an html article."
+ (interactive)
+ (save-excursion
+ (let ((buffer-read-only nil)
+ (charset gnus-newsgroup-charset))
+ (article-goto-body)
+ (save-window-excursion
+ (save-restriction
+ (narrow-to-region (point) (point-max))
+ (mm-setup-w3)
+ (let ((w3-strict-width (window-width))
+ (url-standalone-mode t))
+ (condition-case var
+ (w3-region (point-min) (point-max))
+ (error))))))))
+
(defun article-hide-list-identifiers ()
"Remove list identifies from the Subject header.
The `gnus-list-identifiers' variable specifies what to do."
(when regexp
(goto-char (point-min))
(when (re-search-forward
- (concat "^Subject: +\\(Re: +\\)?\\(" regexp " *\\)")
+ (concat "^Subject: +\\(\\(\\(Re: +\\)?\\(" regexp
+ " *\\)\\)+\\(Re: +\\)?\\)")
nil t)
- (delete-region (match-beginning 2) (match-end 0)))))))))
+ (let ((s (or (match-string 3) (match-string 5))))
+ (delete-region (match-beginning 1) (match-end 1))
+ (when s
+ (goto-char (match-beginning 1))
+ (insert s))))))))))
(defun article-hide-pgp ()
"Remove any PGP headers and signatures in the current article."
(gnus-make-directory (file-name-directory file))
;; If we have read a directory, we append the default file name.
(when (file-directory-p file)
- (setq file (concat (file-name-as-directory file)
- (file-name-nondirectory default-name))))
+ (setq file (expand-file-name (file-name-nondirectory default-name)
+ (file-name-as-directory file))))
;; Possibly translate some characters.
(nnheader-translate-file-chars file)))))
(gnus-make-directory (file-name-directory result))
default
(or last-file default))))
-(defun gnus-Plain-save-name (newsgroup headers &optional last-file)
- "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
-If variable `gnus-use-long-file-name' is non-nil, it is
-~/News/News.group. Otherwise, it is like ~/News/news/group/news."
- (or last-file
- (expand-file-name
- (if (gnus-use-long-file-name 'not-save)
- (gnus-capitalize-newsgroup newsgroup)
- (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
- gnus-article-save-directory)))
-
(defun gnus-plain-save-name (newsgroup headers &optional last-file)
"Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
If variable `gnus-use-long-file-name' is non-nil, it is
(expand-file-name
(if (gnus-use-long-file-name 'not-save)
newsgroup
- (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
+ (expand-file-name "news" (gnus-newsgroup-directory-form newsgroup)))
gnus-article-save-directory)))
(eval-and-compile
gfunc (cdr func))
(setq afunc func
gfunc (intern (format "gnus-%s" func))))
- (fset gfunc
- (if (not (fboundp afunc))
- nil
- `(lambda (&optional interactive &rest args)
- ,(documentation afunc t)
- (interactive (list t))
- (save-excursion
- (set-buffer gnus-article-buffer)
- (if interactive
- (call-interactively ',afunc)
- (apply ',afunc args))))))))
+ (defalias gfunc
+ (if (fboundp afunc)
+ `(lambda (&optional interactive &rest args)
+ ,(documentation afunc t)
+ (interactive (list t))
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (if interactive
+ (call-interactively ',afunc)
+ (apply ',afunc args))))))))
'(article-hide-headers
article-hide-boring-headers
article-toggle-headers
article-remove-cr
article-display-x-face
article-de-quoted-unreadable
+ article-de-base64-unreadable
article-decode-HZ
+ article-wash-html
article-hide-list-identifiers
article-hide-pgp
article-strip-banner
;; Init original article buffer.
(save-excursion
(set-buffer (gnus-get-buffer-create gnus-original-article-buffer))
+ (set-buffer-multibyte nil)
(setq major-mode 'gnus-original-article-mode)
(make-local-variable 'gnus-original-article))
(if (get-buffer name)
(format " (%d parts)" (length (mime-entity-children entity)))
""))))
-(defvar gnus-mime-button-map nil)
-(unless gnus-mime-button-map
- (setq gnus-mime-button-map (make-sparse-keymap))
- (set-keymap-parent gnus-mime-button-map gnus-article-mode-map)
- (define-key gnus-mime-button-map gnus-mouse-2 'gnus-article-push-button)
- (define-key gnus-mime-button-map gnus-down-mouse-3 'gnus-mime-button-menu)
- (mapcar (lambda (c)
- (define-key gnus-mime-button-map (cadr c) (car c)))
- gnus-mime-button-commands))
+(defvar gnus-mime-button-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map gnus-article-mode-map)
+ (define-key map gnus-mouse-2 'gnus-article-push-button)
+ (define-key map gnus-down-mouse-3 'gnus-mime-button-menu)
+ (dolist (c gnus-mime-button-commands)
+ (define-key map (cadr c) (car c)))
+ map))
(defun gnus-mime-button-menu (event)
"Construct a context-sensitive menu of MIME commands."
(cons (caddr c) (car c)))
gnus-mime-button-commands))))))
(if response
- (funcall response))))))
+ (call-interactively response))))))
(defun gnus-mime-view-all-parts (&optional handles)
"View all the MIME parts."
(interactive
(list (completing-read
"View as MIME type: "
- (mapcar (lambda (i) (list i i)) (mailcap-mime-types))
+ (mapcar #'list (mailcap-mime-types))
nil nil
(gnus-mime-view-part-as-type-internal))))
(gnus-article-check-buffer)
(gnus-article-check-buffer)
(let* ((handle (or handle (get-text-property (point) 'gnus-data)))
(mm-user-display-methods nil)
- (mm-inline-large-images nil)
+ (mm-inlined-types nil)
(mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets
(save-excursion (set-buffer gnus-summary-buffer)
article-type annotation
gnus-data ,handle))
(setq e (point))
- (widget-convert-button 'link b e
- :mime-handle handle
- :action 'gnus-widget-press-button
- :button-keymap gnus-mime-button-map
- :help-echo
- (lambda (widget)
- ;; Needed to properly clear the message
- ;; due to a bug in wid-edit
- (setq help-echo-owns-message t)
- (format
- "Click to %s the MIME part; %s for more options"
- (if (mm-handle-displayed-p
- (widget-get widget :mime-handle))
- "hide" "show")
- (if gnus-xemacs "button3" "mouse-3"))))))
+ (widget-convert-button
+ 'link b e
+ :mime-handle handle
+ :action 'gnus-widget-press-button
+ :button-keymap gnus-mime-button-map
+ :help-echo
+ (lambda (widget/window &optional overlay pos)
+ ;; Needed to properly clear the message due to a bug in
+ ;; wid-edit (XEmacs only).
+ (if (boundp 'help-echo-owns-message)
+ (setq help-echo-owns-message t))
+ (format
+ "%S: %s the MIME part; %S: more options"
+ (aref gnus-mouse-2 0)
+ ;; XEmacs will get a single widget arg; Emacs 21 will get
+ ;; window, overlay, position.
+ (if (mm-handle-displayed-p
+ (if overlay
+ (with-current-buffer (overlay-buffer overlay)
+ (widget-get (widget-at (overlay-start overlay))
+ :mime-handle))
+ (widget-get widget/window :mime-handle)))
+ "hide" "show")
+ (aref gnus-down-mouse-3 0))))))
(defun gnus-widget-press-button (elems el)
(goto-char (widget-get elems :from))
(if gnus-show-mime ?m ? )
(if emphasis ?e ? )))))
-(fset 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers)
+(defalias 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers)
(defun gnus-article-maybe-hide-headers ()
"Hide unwanted headers if `gnus-have-all-headers' is nil.
gnus-newsgroup-name)))
(when (and (eq (car method) 'nneething)
(vectorp header))
- (let ((dir (concat
+ (let ((dir (expand-file-name
+ (mail-header-subject header)
(file-name-as-directory
(or (cadr (assq 'nneething-address method))
- (nth 1 method)))
- (mail-header-subject header))))
+ (nth 1 method))))))
(when (file-directory-p dir)
(setq article 'nneething)
(gnus-group-enter-directory dir))))))))
(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 t))
"Exit the article editing without updating."
(interactive)
;; We remove all text props from the article buffer.
- (let ((buf (format "%s" (buffer-string)))
+ (let ((buf (buffer-substring-no-properties (point-min) (point-max)))
(curbuf (current-buffer))
(p (point))
(window-start (window-start)))
;;; 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\\)\\)\\|[-a-zA-Z0-9_]+\\.[-a-zA-Z0-9_]+\\(\\.[-a-zA-Z0-9_]+[-a-zA-Z0-9_/]+\\)+"
+(defcustom gnus-button-url-regexp "\\b\\(\\(www\\.\\|\\(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\\)\\)"
"Regular expression that matches URLs."
:group 'gnus-article-buttons
:type 'regexp)