;;; Code:
-;; For Emacs < 22.2.
+;; For Emacs <22.2 and XEmacs.
(eval-and-compile
(unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(eval-when-compile
:group 'gnus-article-various)
(make-obsolete-variable 'gnus-article-hide-pgp-hook nil
- "Gnus 5.10 (Emacs-22.1)")
+ "Gnus 5.10 (Emacs 22.1)")
(defface gnus-button
'((t (:weight bold)))
:type gnus-article-treat-custom)
(make-obsolete-variable 'gnus-treat-display-xface
- 'gnus-treat-display-x-face "22.1")
+ 'gnus-treat-display-x-face "Emacs 22.1")
(defcustom gnus-treat-display-x-face
(and (not noninteractive)
:type gnus-article-treat-head-custom)
(put 'gnus-treat-newsgroups-picon 'highlight t)
-(defcustom gnus-treat-from-gravatar
- (when (display-images-p) 'head)
+(defcustom gnus-treat-from-gravatar nil
"Display gravatars in the From header.
Valid values are nil, t, `head', `first', `last', an integer or a
predicate. See Info node `(gnus)Customizing Articles' and Info
:type gnus-article-treat-head-custom)
(put 'gnus-treat-from-gravatar 'highlight t)
-(defcustom gnus-treat-mail-gravatar
- (when (display-images-p) 'head)
+(defcustom gnus-treat-mail-gravatar nil
"Display gravatars in To and Cc headers.
Valid values are nil, t, `head', `first', `last', an integer or a
predicate. See Info node `(gnus)Customizing Articles' and Info
:link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
-(defcustom gnus-treat-play-sounds nil
- "Play sounds.
-Valid values are nil, t, `head', `first', `last', an integer or a
-predicate. See Info node `(gnus)Customizing Articles'."
- :version "21.1"
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-custom)
-
(defcustom gnus-treat-x-pgp-sig nil
"Verify X-PGP-Sig.
To automatically treat X-PGP-Sig, set it to head.
:group 'gnus-article
:type 'boolean)
+(defcustom gnus-blocked-images "."
+ "Images that have URLs matching this regexp will be blocked."
+ :version "24.1"
+ :group 'gnus-art
+ :type 'regexp)
+
;;; Internal variables
(defvar gnus-english-month-names
(gnus-treat-hide-signature gnus-article-hide-signature)
(gnus-treat-strip-list-identifiers gnus-article-hide-list-identifiers)
(gnus-treat-leading-whitespace gnus-article-remove-leading-whitespace)
- (gnus-treat-strip-pem gnus-article-hide-pem)
(gnus-treat-from-picon gnus-treat-from-picon)
(gnus-treat-mail-picon gnus-treat-mail-picon)
(gnus-treat-newsgroups-picon gnus-treat-newsgroups-picon)
+ (gnus-treat-strip-pem gnus-article-hide-pem)
(gnus-treat-from-gravatar gnus-treat-from-gravatar)
(gnus-treat-mail-gravatar gnus-treat-mail-gravatar)
(gnus-treat-highlight-headers gnus-article-highlight-headers)
(gnus-treat-hide-citation gnus-article-hide-citation)
(gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe)
(gnus-treat-highlight-citation gnus-article-highlight-citation)
- (gnus-treat-body-boundary gnus-article-treat-body-boundary)
- (gnus-treat-play-sounds gnus-earcon-display)))
+ (gnus-treat-body-boundary gnus-article-treat-body-boundary)))
(defvar gnus-article-mime-handle-alist nil)
(defvar article-lapsed-timer nil)
(insert "X-Boundary: ")
(gnus-add-text-properties start (point) '(invisible t intangible t))
(insert (let (str)
- (while (>= (1- (window-width)) (length str))
+ (while (>= (window-width) (length str))
(setq str (concat str gnus-body-boundary-delimiter)))
- (substring str 0 (1- (window-width))))
+ (substring str 0 (window-width)))
"\n")
(gnus-put-text-property start (point) 'gnus-decoration 'header)))))
"Save %s in rmail file" filename
gnus-rmail-save-name gnus-newsgroup-name
gnus-current-headers 'gnus-newsgroup-last-rmail))
- (gnus-eval-in-buffer-window gnus-save-article-buffer
+ (with-current-buffer gnus-save-article-buffer
(save-excursion
(save-restriction
(widen)
"Save %s in Unix mail file" filename
gnus-mail-save-name gnus-newsgroup-name
gnus-current-headers 'gnus-newsgroup-last-mail))
- (gnus-eval-in-buffer-window gnus-save-article-buffer
+ (with-current-buffer gnus-save-article-buffer
(save-excursion
(save-restriction
(widen)
"Save %s in file" filename
gnus-file-save-name gnus-newsgroup-name
gnus-current-headers 'gnus-newsgroup-last-file))
- (gnus-eval-in-buffer-window gnus-save-article-buffer
+ (with-current-buffer gnus-save-article-buffer
(save-excursion
(save-restriction
(widen)
"Save %s body in file" filename
gnus-file-save-name gnus-newsgroup-name
gnus-current-headers 'gnus-newsgroup-last-file))
- (gnus-eval-in-buffer-window gnus-save-article-buffer
+ (with-current-buffer gnus-save-article-buffer
(save-excursion
(save-restriction
(widen)
(if default
(setq command default)
(error "A command is required")))
- (gnus-eval-in-buffer-window save-buffer
+ (with-current-buffer save-buffer
(save-restriction
(widen)
(shell-command-on-region (point-min) (point-max) command nil)))
(unless data
(error "No MIME part under point"))
(with-current-buffer (mm-handle-buffer data)
- (let ((bsize (format "%s" (buffer-size))))
+ (let ((bsize (buffer-size)))
(erase-buffer)
(insert
(concat
"|\n"
"| Type: " type "\n"
"| Filename: " filename "\n"
- "| Size (encoded): " bsize " Byte\n"
+ "| Size (encoded): " (format "%s byte%s\n"
+ bsize (if (= bsize 1)
+ ""
+ "s"))
(when description
(concat "| Description: " description "\n"))
"`----\n"))
(unless mime-type
(setq mime-type
(let ((default (gnus-mime-view-part-as-type-internal)))
- (completing-read
- (format "View as MIME type (default %s): "
- (car default))
- (mapcar #'list (mailcap-mime-types))
- pred nil nil nil
+ (gnus-completing-read
+ "View as MIME type"
+ (if pred
+ (gnus-remove-if-not pred (mailcap-mime-types))
+ (mailcap-mime-types))
+ nil nil nil
(car default)))))
(gnus-article-check-buffer)
(let ((handle (get-text-property (point) 'gnus-data)))
(mm-enable-external t))
(if (not (stringp method))
(gnus-mime-view-part-as-type
- nil (lambda (types) (stringp (mailcap-mime-info (car types)))))
+ nil (lambda (type) (stringp (mailcap-mime-info type))))
(when handle
(if (mm-handle-undisplayer handle)
(mm-remove-part handle)
(inhibit-read-only t))
(if (not (mm-inlinable-p handle))
(gnus-mime-view-part-as-type
- nil (lambda (types) (mm-inlinable-p handle (car types))))
+ nil (lambda (type) (mm-inlinable-p handle type)))
(when handle
(if (mm-handle-undisplayer handle)
(mm-remove-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 nil t)))
+ (list (gnus-completing-read "Action" (mapcar 'car gnus-mime-action-alist) t)))
(gnus-article-check-buffer)
(let ((action-pair (assoc action gnus-mime-action-alist)))
(if action-pair
(gnus-backlog-remove-article
(car gnus-article-current) (cdr gnus-article-current)))
;; Flush original article as well.
- (when (get-buffer gnus-original-article-buffer)
- (with-current-buffer gnus-original-article-buffer
- (setq gnus-original-article nil)))
+ (gnus-flush-original-article-buffer)
(when gnus-use-cache
(gnus-cache-update-article
(car gnus-article-current) (cdr gnus-article-current)))
(set-window-point (get-buffer-window buf) (point)))
(gnus-summary-show-article))
+(defun gnus-flush-original-article-buffer ()
+ (when (get-buffer gnus-original-article-buffer)
+ (with-current-buffer gnus-original-article-buffer
+ (setq gnus-original-article nil))))
+
(defun gnus-article-edit-exit ()
"Exit the article editing without updating."
(interactive)
(function :tag "Other"))
:group 'gnus-article-buttons)
-(defcustom gnus-ctan-url "http://tug.ctan.org/tex-archive/"
- "Top directory of a CTAN \(Comprehensive TeX Archive Network\) archive.
-If the default site is too slow, try to find a CTAN mirror, see
-<URL:http://tug.ctan.org/tex-archive/CTAN.sites?action=/index.html>. See also
-the variable `gnus-button-handle-ctan'."
- :version "22.1"
- :group 'gnus-article-buttons
- :link '(custom-manual "(gnus)Group Parameters")
- :type '(choice (const "http://www.tex.ac.uk/tex-archive/")
- (const "http://tug.ctan.org/tex-archive/")
- (const "http://www.dante.de/CTAN/")
- (string :tag "Other")))
-
-(defcustom gnus-button-ctan-handler 'browse-url
- "Function to use for displaying CTAN links.
-The function must take one argument, the string naming the URL."
- :version "22.1"
- :type '(choice (function-item :tag "Browse Url" browse-url)
- (function :tag "Other"))
- :group 'gnus-article-buttons)
-
-(defcustom gnus-button-handle-ctan-bogus-regexp "^/?tex-archive/\\|^/"
- "Bogus strings removed from CTAN URLs."
- :version "22.1"
- :group 'gnus-article-buttons
- :type '(choice (const "^/?tex-archive/\\|/")
- (regexp :tag "Other")))
-
-(defcustom gnus-button-ctan-directory-regexp
- (regexp-opt
- (list "archive-tools" "biblio" "bibliography" "digests" "documentation"
- "dviware" "fonts" "graphics" "help" "indexing" "info" "language"
- "languages" "macros" "nonfree" "obsolete" "support" "systems"
- "tds" "tools" "usergrps" "web") t)
- "Regular expression for ctan directories.
-It should match all directories in the top level of `gnus-ctan-url'."
- :version "22.1"
- :group 'gnus-article-buttons
- :type 'regexp)
-
(defcustom gnus-button-mid-or-mail-regexp
(concat "\\b\\(<?" gnus-button-valid-localpart-regexp "@"
gnus-button-valid-fqdn-regexp
(gnus-message 1 "Cannot locale library `%s'." url)
(find-file-read-only file))))
-(defun gnus-button-handle-ctan (url)
- "Call `browse-url' when pushing a CTAN URL button."
- (funcall
- gnus-button-ctan-handler
- (concat
- gnus-ctan-url
- (gnus-replace-in-string url gnus-button-handle-ctan-bogus-regexp ""))))
-
-(defcustom gnus-button-tex-level 5
- "*Integer that says how many TeX-related buttons Gnus will show.
-The higher the number, the more buttons will appear and the more false
-positives are possible. Note that you can set this variable local to
-specific groups. Setting it higher in TeX groups is probably a good idea.
-See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on
-how to set variables in specific groups."
- :version "22.1"
- :group 'gnus-article-buttons
- :link '(custom-manual "(gnus)Group Parameters")
- :type 'integer)
-
(defcustom gnus-button-man-level 5
"*Integer that says how many man-related buttons Gnus will show.
The higher the number, the more buttons will appear and the more false
0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
("\\bmailto:\\([^ \n\t]+\\)"
0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
- ;; CTAN
- ((concat "\\bCTAN:[ \t\n]?[^>)!;:,'\n\t ]*\\("
- gnus-button-ctan-directory-regexp
- "[^][>)!;:,'\n\t ]+\\)")
- 0 (>= gnus-button-tex-level 1) gnus-button-handle-ctan 1)
- ((concat "\\btex-archive/\\("
- gnus-button-ctan-directory-regexp
- "/[-_.a-z0-9/]+[-_./a-z0-9]+[/a-z0-9]\\)")
- 1 (>= gnus-button-tex-level 6) gnus-button-handle-ctan 1)
- ((concat
- "\\b\\("
- gnus-button-ctan-directory-regexp
- "/[-_.a-z0-9]+/[-_./a-z0-9]+[/a-z0-9]\\)")
- 1 (>= gnus-button-tex-level 8) gnus-button-handle-ctan 1)
;; Info Konqueror style <info:/foo/bar baz>.
;; Must come before " Gnus home-grown style".
("\\binfo://?\\([^'\">\n\t]+\\)"
(defvar gnus-next-page-map
(let ((map (make-sparse-keymap)))
- (unless (>= emacs-major-version 21)
- ;; XEmacs doesn't care.
- (set-keymap-parent map gnus-article-mode-map))
(define-key map gnus-mouse-2 'gnus-button-next-page)
(define-key map "\r" 'gnus-button-next-page)
map))
(interactive
(list
(or gnus-article-encrypt-protocol
- (completing-read "Encrypt protocol: "
- gnus-article-encrypt-protocol-alist
- nil t))
+ (gnus-completing-read "Encrypt protocol"
+ (mapcar 'car gnus-article-encrypt-protocol-alist)
+ t))
current-prefix-arg))
;; User might hit `K E' instead of `K e', so prompt once.
(when (and gnus-article-encrypt-protocol
(when gnus-keep-backlog
(gnus-backlog-remove-article
(car gnus-article-current) (cdr gnus-article-current)))
- (when (get-buffer gnus-original-article-buffer)
- (with-current-buffer gnus-original-article-buffer
- (setq gnus-original-article nil)))
+ (gnus-flush-original-article-buffer)
(when gnus-use-cache
(gnus-cache-update-article
(car gnus-article-current) (cdr gnus-article-current))))))))
projects / gnus / blobdiff