X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=ea588c9633314fd69b53286119e9a2ac94e84c23;hb=e405b22c6b46721607c5e6c712a4705c23dee751;hp=c0481bdbb280486a01597617f2d076e7b5e96b36;hpb=233165c363e3df9378f06a3d5633e3f74518479f;p=gnus diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index c0481bdbb..ea588c963 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -1,5 +1,5 @@ ;;; gnus-art.el --- article mode commands for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -214,6 +214,7 @@ By default, if you set this t, then Gnus will display citations and signatures, but will never scroll down to show you a page consisting only of boring text. Boring text is controlled by `gnus-article-boring-faces'." + :version "22.1" :type 'boolean :group 'gnus-article-hiding) @@ -320,27 +321,56 @@ advertisements. For example: (symbol :tag "Item in `gnus-article-banner-alist'" none) regexp (const :tag "None" nil)))) + :version "22.1" :group 'gnus-article-washing) +(defmacro gnus-emphasis-custom-with-format (&rest body) + `(let ((format "\ +\\(\\s-\\|^\\|\\=\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\ +\\(\\([-,.;:!?\"]\\|\\s)\\)+\\s-\\|[?!.]\\s-\\|\\s)\\|\\s-\\)")) + ,@body)) + +(defun gnus-emphasis-custom-value-to-external (value) + (gnus-emphasis-custom-with-format + (if (consp (car value)) + (list (format format (car (car value)) (cdr (car value))) + 2 + (if (nth 1 value) 2 3) + (nth 2 value)) + value))) + +(defun gnus-emphasis-custom-value-to-internal (value) + (gnus-emphasis-custom-with-format + (let ((regexp (concat "\\`" + (format (regexp-quote format) + "\\([^()]+\\)" "\\([^()]+\\)") + "\\'")) + pattern) + (if (string-match regexp (setq pattern (car value))) + (list (cons (match-string 1 pattern) (match-string 2 pattern)) + (= (nth 2 value) 2) + (nth 3 value)) + value)))) + (defcustom gnus-emphasis-alist - (let ((format - "\\(\\s-\\|^\\|\\=\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\([-,.;:!?\"]\\|\\s)\\)+\\s-\\|[?!.]\\s-\\|\\s)\\|\\s-\\)") - (types - '(("\\*" "\\*" bold) + (let ((types + '(("\\*" "\\*" bold nil 2) ("_" "_" underline) ("/" "/" italic) ("_/" "/_" underline-italic) ("_\\*" "\\*_" underline-bold) ("\\*/" "/\\*" bold-italic) ("_\\*/" "/\\*_" underline-bold-italic)))) - `(,@(mapcar - (lambda (spec) - (list - (format format (car spec) (cadr spec)) - 2 3 (intern (format "gnus-emphasis-%s" (nth 2 spec))))) - types) - ("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)" - 2 3 gnus-emphasis-underline))) + (nconc + (gnus-emphasis-custom-with-format + (mapcar (lambda (spec) + (list (format format (car spec) (cadr spec)) + (or (nth 3 spec) 2) + (or (nth 4 spec) 3) + (intern (format "gnus-emphasis-%s" (nth 2 spec))))) + types)) + '(("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)" + 2 3 gnus-emphasis-underline)))) "*Alist that says how to fontify certain phrases. Each item looks like this: @@ -351,11 +381,43 @@ is a number that says what regular expression grouping used to find the entire emphasized word. The third is a number that says what regexp grouping should be displayed and highlighted. The fourth is the face used for highlighting." - :type '(repeat (list :value ("" 0 0 default) - regexp - (integer :tag "Match group") - (integer :tag "Emphasize group") - face)) + :type + '(repeat + (menu-choice + :format "%[Customizing Style%]\n%v" + :indent 2 + (group :tag "Default" + :value ("" 0 0 default) + :value-create + (lambda (widget) + (let ((value (widget-get + (cadr (widget-get (widget-get widget :parent) + :args)) + :value))) + (if (not (eq (nth 2 value) 'default)) + (widget-put + widget + :value + (gnus-emphasis-custom-value-to-external value)))) + (widget-group-value-create widget)) + regexp + (integer :format "Match group: %v") + (integer :format "Emphasize group: %v") + face) + (group :tag "Simple" + :value (("_" . "_") nil default) + (cons :format "%v" + (regexp :format "Start regexp: %v") + (regexp :format "End regexp: %v")) + (boolean :format "Show start and end patterns: %[%v%]\n" + :on " On " :off " Off ") + face))) + :get (lambda (symbol) + (mapcar 'gnus-emphasis-custom-value-to-internal + (default-value symbol))) + :set (lambda (symbol value) + (set-default symbol (mapcar 'gnus-emphasis-custom-value-to-external + value))) :group 'gnus-article-emphasis) (defcustom gnus-emphasize-whitespace-regexp "^[ \t]+\\|[ \t]*\n" @@ -507,17 +569,19 @@ you could set this variable to something like: '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\") (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\")) -This variable is an alist where the where the key is the match and the -value is a list of possible files to save in if the match is non-nil. +This variable is an alist where the key is the match and the +value is a list of possible files to save in if the match is +non-nil. If the match is a string, it is used as a regexp match on the article. If the match is a symbol, that symbol will be funcalled -from the buffer of the article to be saved with the newsgroup as the -parameter. If it is a list, it will be evaled in the same buffer. +from the buffer of the article to be saved with the newsgroup as +the parameter. If it is a list, it will be evaled in the same +buffer. -If this form or function returns a string, this string will be used as -a possible file name; and if it returns a non-nil list, that list will -be used as possible file names." +If this form or function returns a string, this string will be +used as a possible file name; and if it returns a non-nil list, +that list will be used as possible file names." :group 'gnus-article-saving :type '(repeat (choice (list :value (fun) function) (cons :value ("" "") regexp (repeat string)) @@ -563,6 +627,13 @@ The following additional specs are available: :type 'hook :group 'gnus-article-various) +(defcustom gnus-copy-article-ignored-headers nil + "List of headers to be removed when copying an article. +Each element is a regular expression." + :version "22.0" ;; No Gnus + :type '(repeat regexp) + :group 'gnus-article-various) + (make-obsolete-variable 'gnus-article-hide-pgp-hook "This variable is obsolete in Gnus 5.10.") @@ -745,7 +816,7 @@ If set, this variable overrides `gnus-unbuttonized-mime-types'. To see e.g. security buttons you could set this to `(\"multipart/signed\")'. This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil." - :version "21.1" + :version "22.1" :group 'gnus-article-mime :type '(repeat regexp)) @@ -754,7 +825,7 @@ This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil." When nil (the default value), then some MIME parts do not get buttons, as described by the variables `gnus-buttonized-mime-types' and `gnus-unbuttonized-mime-types'." - :version "21.3" + :version "22.1" :group 'gnus-article-mime :type 'boolean) @@ -762,6 +833,7 @@ as described by the variables `gnus-buttonized-mime-types' and "String used to delimit header and body. This variable is used by `gnus-article-treat-body-boundary' which can be controlled by `gnus-treat-body-boundary'." + :version "22.1" :group 'gnus-article-various :type '(choice (item :tag "None" :value nil) string)) @@ -771,6 +843,7 @@ be controlled by `gnus-treat-body-boundary'." "Defines the location of the faces database. For information on obtaining this database of pretty pictures, please see http://www.cs.indiana.edu/picons/ftp/index.html" + :version "22.1" :type '(repeat directory) :link '(url-link :tag "download" "http://www.cs.indiana.edu/picons/ftp/index.html") @@ -910,6 +983,7 @@ See Info node `(gnus)Customizing Articles' for details." "Remove carriage returns. Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' for details." + :version "22.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) @@ -918,6 +992,7 @@ See Info node `(gnus)Customizing Articles' for details." "Remove newlines from within URLs. Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' for details." + :version "22.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) @@ -926,6 +1001,7 @@ See Info node `(gnus)Customizing Articles' for details." "Remove leading whitespace in headers. Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' for details." + :version "22.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) @@ -1045,6 +1121,7 @@ See Info node `(gnus)Customizing Articles' for details." "Display the Date in a format that can be read aloud in English. Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' for details." + :version "22.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-head-custom) @@ -1120,6 +1197,7 @@ See Info node `(gnus)Customizing Articles' for details." "Unfold folded header lines. Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' for details." + :version "22.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) @@ -1128,6 +1206,7 @@ See Info node `(gnus)Customizing Articles' for details." "Fold headers. Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' for details." + :version "22.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) @@ -1136,6 +1215,7 @@ See Info node `(gnus)Customizing Articles' for details." "Fold the Newsgroups and Followup-To headers. Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' for details." + :version "22.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) @@ -1209,7 +1289,7 @@ Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' and Info node `(gnus)X-Face' for details." :group 'gnus-article-treat - :version "21.1" + :version "22.1" :link '(custom-manual "(gnus)Customizing Articles") :link '(custom-manual "(gnus)X-Face") :type gnus-article-treat-head-custom) @@ -1240,6 +1320,7 @@ See Info node `(gnus)Customizing Articles' and Info node Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' and Info node `(gnus)Picons' for details." + :version "22.1" :group 'gnus-article-treat :group 'gnus-picon :link '(custom-manual "(gnus)Customizing Articles") @@ -1255,6 +1336,7 @@ See Info node `(gnus)Customizing Articles' and Info node Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' and Info node `(gnus)Picons' for details." + :version "22.1" :group 'gnus-article-treat :group 'gnus-picon :link '(custom-manual "(gnus)Customizing Articles") @@ -1270,6 +1352,7 @@ See Info node `(gnus)Customizing Articles' and Info node Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' and Info node `(gnus)Picons' for details." + :version "22.1" :group 'gnus-article-treat :group 'gnus-picon :link '(custom-manual "(gnus)Customizing Articles") @@ -1278,14 +1361,15 @@ See Info node `(gnus)Customizing Articles' and Info node (put 'gnus-treat-newsgroups-picon 'highlight t) (defcustom gnus-treat-body-boundary - (if (or gnus-treat-newsgroups-picon - gnus-treat-mail-picon - gnus-treat-from-picon) + (if (and (eq window-system 'x) + (or gnus-treat-newsgroups-picon + gnus-treat-mail-picon + gnus-treat-from-picon)) 'head nil) "Draw a boundary at the end of the headers. Valid values are nil and `head'. See Info node `(gnus)Customizing Articles' for details." - :version "21.1" + :version "22.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-head-custom) @@ -1303,6 +1387,7 @@ See Info node `(gnus)Customizing Articles' for details." "Format as HTML. Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' for details." + :version "22.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) @@ -1338,6 +1423,7 @@ See Info node `(gnus)Customizing Articles' for details." To automatically treat X-PGP-Sig, set it to head. Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' for details." + :version "22.1" :group 'gnus-article-treat :group 'mime-security :link '(custom-manual "(gnus)Customizing Articles") @@ -1351,6 +1437,7 @@ See Info node `(gnus)Customizing Articles' for details." (defcustom gnus-article-encrypt-protocol "PGP" "The protocol used for encrypt articles. It is a string, such as \"PGP\". If nil, ask user." + :version "22.1" :type 'string :group 'mime-security) @@ -1362,11 +1449,13 @@ It is a string, such as \"PGP\". If nil, ask user." (executable-find idna-program)) "Whether IDNA decoding of headers is used when viewing messages. This requires GNU Libidn, and by default only enabled if it is found." + :version "22.1" :group 'gnus-article-headers :type 'boolean) (defcustom gnus-article-over-scroll nil "If non-nil, allow scrolling the article buffer even when there no more text." + :version "22.1" :group 'gnus-article :type 'boolean) @@ -1477,7 +1566,7 @@ Initialized from `text-mode-syntax-table.") `(save-excursion (set-buffer gnus-article-buffer) (save-restriction - (let ((buffer-read-only nil) + (let ((inhibit-read-only t) (inhibit-point-motion-hooks t) (case-fold-search t)) (article-narrow-to-head) @@ -1489,7 +1578,7 @@ Initialized from `text-mode-syntax-table.") (defmacro gnus-with-article-buffer (&rest forms) `(save-excursion (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) ,@forms))) (put 'gnus-with-article-buffer 'lisp-indent-function 0) @@ -1575,7 +1664,7 @@ Initialized from `text-mode-syntax-table.") (interactive) ;; This function might be inhibited. (unless gnus-inhibit-hiding - (let ((buffer-read-only nil) + (let ((inhibit-read-only nil) (case-fold-search t) (max (1+ (length gnus-sorted-header-list))) (inhibit-point-motion-hooks t) @@ -1645,13 +1734,10 @@ always hide." (not gnus-show-all-headers)) (save-excursion (save-restriction - (let ((buffer-read-only nil) - (list gnus-boring-article-headers) - (inhibit-point-motion-hooks t) - elem) + (let ((inhibit-read-only t) + (inhibit-point-motion-hooks t)) (article-narrow-to-head) - (while list - (setq elem (pop list)) + (dolist (elem gnus-boring-article-headers) (goto-char (point-min)) (cond ;; Hide empty headers. @@ -1799,7 +1885,7 @@ always hide." (defun article-normalize-headers () "Make all header lines 40 characters long." (interactive) - (let ((buffer-read-only nil) + (let ((inhibit-read-only t) column) (save-excursion (save-restriction @@ -1843,7 +1929,7 @@ FROM is a string of characters to translate from; to is a string of characters to translate to." (save-excursion (when (article-goto-body) - (let ((buffer-read-only nil) + (let ((inhibit-read-only t) (x (make-string 225 ?x)) (i -1)) (while (< (incf i) (length x)) @@ -1859,9 +1945,8 @@ characters to translate to." MAP is an alist where the elements are on the form (\"from\" \"to\")." (save-excursion (when (article-goto-body) - (let ((buffer-read-only nil) - elem) - (while (setq elem (pop map)) + (let ((inhibit-read-only t)) + (dolist (elem map) (save-excursion (while (search-forward (car elem) nil t) (replace-match (cadr elem))))))))) @@ -1871,7 +1956,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (interactive) (save-excursion (when (article-goto-body) - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (while (search-forward "\b" nil t) (let ((next (char-after)) (previous (char-after (- (point) 2)))) @@ -1897,7 +1982,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (interactive) (save-excursion (when (article-goto-body) - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (ansi-color-apply-on-region (point) (point-max)))))) (defun gnus-article-treat-unfold-headers () @@ -1987,7 +2072,7 @@ unfolded." "Fill lines that are wider than the window width." (interactive) (save-excursion - (let ((buffer-read-only nil) + (let ((inhibit-read-only t) (width (window-width (get-buffer-window (current-buffer))))) (save-restriction (article-goto-body) @@ -2007,7 +2092,7 @@ unfolded." "Capitalize the first word in each sentence." (interactive) (save-excursion - (let ((buffer-read-only nil) + (let ((inhibit-read-only t) (paragraph-start "^[\n\^L]")) (article-goto-body) (while (not (eobp)) @@ -2018,7 +2103,7 @@ unfolded." "Remove trailing CRs and then translate remaining CRs into LFs." (interactive) (save-excursion - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (goto-char (point-min)) (while (re-search-forward "\r+$" nil t) (replace-match "" t t)) @@ -2030,7 +2115,7 @@ unfolded." "Remove all trailing blank lines from the article." (interactive) (save-excursion - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (goto-char (point-max)) (delete-region (point) @@ -2070,7 +2155,7 @@ unfolded." (mail-narrow-to-head) (while (gnus-article-goto-header "Face") (setq faces (nconc faces (list (mail-header-field-value))))))) - (while (setq face (pop faces)) + (dolist (face faces) (let ((png (gnus-convert-face-to-png face)) image) (when png @@ -2166,7 +2251,7 @@ unfolded." If PROMPT (the prefix), prompt for a coding system to use." (interactive "P") (let ((inhibit-point-motion-hooks t) (case-fold-search t) - buffer-read-only + (inhibit-read-only t) (mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets (save-excursion (condition-case nil @@ -2216,7 +2301,7 @@ If PROMPT (the prefix), prompt for a coding system to use." (set-buffer gnus-summary-buffer) (error)) gnus-newsgroup-ignored-charsets)) - buffer-read-only) + (inhibit-read-only t)) (save-restriction (article-narrow-to-head) (funcall gnus-decode-header-function (point-min) (point-max))))) @@ -2224,7 +2309,7 @@ If PROMPT (the prefix), prompt for a coding system to use." (defun article-decode-group-name () "Decode group names in `Newsgroups:'." (let ((inhibit-point-motion-hooks t) - buffer-read-only + (inhibit-read-only t) (method (gnus-find-method-for-group gnus-newsgroup-name))) (when (and (or gnus-group-name-charset-method-alist gnus-group-name-charset-group-alist) @@ -2268,7 +2353,7 @@ If PROMPT (the prefix), prompt for a coding system to use." (when gnus-use-idna (save-restriction (let ((inhibit-point-motion-hooks t) - buffer-read-only) + (inhibit-read-only t)) (article-narrow-to-head) (goto-char (point-min)) (while (re-search-forward "@.*\\(xn--[-A-Za-z0-9.]*\\)[ \t\n\r,>]" nil t) @@ -2289,7 +2374,7 @@ or not. If READ-CHARSET, ask for a coding system." (interactive (list 'force current-prefix-arg)) (save-excursion - (let ((buffer-read-only nil) type charset) + (let ((inhibit-read-only t) type charset) (if (gnus-buffer-live-p gnus-original-article-buffer) (with-current-buffer gnus-original-article-buffer (setq type @@ -2319,7 +2404,7 @@ If FORCE, decode the article whether it is marked as base64 not. If READ-CHARSET, ask for a coding system." (interactive (list 'force current-prefix-arg)) (save-excursion - (let ((buffer-read-only nil) type charset) + (let ((inhibit-read-only t) type charset) (if (gnus-buffer-live-p gnus-original-article-buffer) (with-current-buffer gnus-original-article-buffer (setq type @@ -2354,17 +2439,17 @@ If READ-CHARSET, ask for a coding system." (interactive) (require 'rfc1843) (save-excursion - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (rfc1843-decode-region (point-min) (point-max))))) (defun article-unsplit-urls () "Remove the newlines that some other mailers insert into URLs." (interactive) (save-excursion - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (goto-char (point-min)) (while (re-search-forward - "^\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t) + "\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t) (replace-match "\\1\\3" t))) (when (interactive-p) (gnus-treat-article nil)))) @@ -2375,7 +2460,7 @@ If READ-CHARSET, ask for a coding system." If READ-CHARSET, ask for a coding system." (interactive "P") (save-excursion - (let ((buffer-read-only nil) + (let ((inhibit-read-only t) charset) (when (gnus-buffer-live-p gnus-original-article-buffer) (with-current-buffer gnus-original-article-buffer @@ -2441,7 +2526,7 @@ The `gnus-list-identifiers' variable specifies what to do." (regexp (if (consp gnus-list-identifiers) (mapconcat 'identity gnus-list-identifiers " *\\|") gnus-list-identifiers)) - buffer-read-only) + (inhibit-read-only t)) (when regexp (save-excursion (save-restriction @@ -2463,7 +2548,7 @@ always hide." (interactive (gnus-article-hidden-arg)) (unless (gnus-article-check-hidden-text 'pem arg) (save-excursion - (let (buffer-read-only end) + (let ((inhibit-read-only t) end) (goto-char (point-min)) ;; Hide the horrendously ugly "header". (when (and (search-forward @@ -2520,7 +2605,7 @@ always hide." (save-restriction (let ((inhibit-point-motion-hooks t) (gnus-signature-limit nil) - buffer-read-only) + (inhibit-read-only t)) (article-goto-body) (cond ((eq banner 'signature) @@ -2559,7 +2644,7 @@ always hide." (unless (gnus-article-check-hidden-text 'signature arg) (save-excursion (save-restriction - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (when (gnus-article-narrow-to-signature) (gnus-article-hide-text-type (point-min) (point-max) 'signature)))))) @@ -2579,7 +2664,7 @@ always hide." (interactive) (save-excursion (let ((inhibit-point-motion-hooks t) - buffer-read-only) + (inhibit-read-only t)) (when (article-goto-body) (while (and (not (eobp)) (looking-at "[ \t]*$")) @@ -2614,7 +2699,7 @@ Point is left at the beginning of the narrowed-to region." (interactive) (save-excursion (let ((inhibit-point-motion-hooks t) - buffer-read-only) + (inhibit-read-only t)) ;; First make all blank lines empty. (article-goto-body) (while (re-search-forward "^[ \t]+$" nil t) @@ -2633,7 +2718,7 @@ Point is left at the beginning of the narrowed-to region." (interactive) (save-excursion (let ((inhibit-point-motion-hooks t) - buffer-read-only) + (inhibit-read-only t)) (article-goto-body) (while (re-search-forward "^[ \t]+" nil t) (replace-match "" t t))))) @@ -2643,7 +2728,7 @@ Point is left at the beginning of the narrowed-to region." (interactive) (save-excursion (let ((inhibit-point-motion-hooks t) - buffer-read-only) + (inhibit-read-only t)) (article-goto-body) (while (re-search-forward "[ \t]+$" nil t) (replace-match "" t t))))) @@ -2660,7 +2745,7 @@ Point is left at the beginning of the narrowed-to region." (interactive) (save-excursion (let ((inhibit-point-motion-hooks t) - buffer-read-only) + (inhibit-read-only t)) (article-goto-body) (while (re-search-forward "^[ \t]*\n" nil t) (replace-match "" t t))))) @@ -2749,7 +2834,7 @@ means show, 0 means toggle." (defun gnus-article-show-hidden-text (type &optional dummy) "Show all hidden text of type TYPE. Originally it is hide instead of DUMMY." - (let ((buffer-read-only nil) + (let ((inhibit-read-only t) (inhibit-point-motion-hooks t)) (gnus-remove-text-properties-when 'article-type type @@ -2814,7 +2899,7 @@ should replace the \"Date:\" one, or should be added below it." (forward-line 1)) (when (and date (not (string= date ""))) (goto-char (point-min)) - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) ;; Delete any old Date headers. (while (re-search-forward date-regexp nil t) (if pos @@ -3029,7 +3114,7 @@ This format is defined by the `gnus-article-time-format' variable." ;; "Show all hidden text in the article buffer." ;; (interactive) ;; (save-excursion -;; (let ((buffer-read-only nil)) +;; (let ((inhibit-read-only t)) ;; (gnus-article-unhide-text (point-min) (point-max))))) (defun article-remove-leading-whitespace () @@ -3037,7 +3122,7 @@ This format is defined by the `gnus-article-time-format' variable." (interactive) (save-excursion (save-restriction - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (article-narrow-to-head) (goto-char (point-min)) (while (re-search-forward "^[^ :]+: \\([ \t]+\\)" nil t) @@ -3054,7 +3139,7 @@ This format is defined by the `gnus-article-time-format' variable." gnus-article-emphasis-alist) (error)) gnus-emphasis-alist)) - (buffer-read-only nil) + (inhibit-read-only t) (props (append '(article-type emphasis) gnus-hidden-properties)) regexp elem beg invisible visible face) @@ -3446,7 +3531,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is (mm-handle-multipart-ctl-parameter mm-security-handle 'gnus-info))))) (when info - (let (buffer-read-only bface eface) + (let ((inhibit-read-only t) bface eface) (save-restriction (message-narrow-to-head) (goto-char (point-max)) @@ -3656,6 +3741,8 @@ commands: (make-local-variable 'gnus-article-image-alist) (make-local-variable 'gnus-article-charset) (make-local-variable 'gnus-article-ignored-charsets) + ;; Prevent recent Emacsen from displaying non-break space as "\ ". + (set (make-local-variable 'show-nonbreak-escape) nil) (gnus-set-default-directory) (buffer-disable-undo) (setq buffer-read-only t @@ -3689,14 +3776,19 @@ commands: (mm-enable-multibyte) (setq major-mode 'gnus-original-article-mode) (make-local-variable 'gnus-original-article)) - (if (get-buffer name) + (if (and (get-buffer name) + (with-current-buffer name + (if gnus-article-edit-mode + (if (y-or-n-p "Article mode edit in progress; discard? ") + (progn + (set-buffer-modified-p nil) + (gnus-kill-buffer name) + (message "") + nil) + (error "Action aborted")) + t))) (save-excursion (set-buffer name) - (when (and gnus-article-edit-mode - (buffer-modified-p) - (not - (y-or-n-p "Article mode edit in progress; discard? "))) - (error "Action aborted")) (set (make-local-variable 'gnus-article-edit-mode) nil) (when gnus-article-mime-handles (mm-destroy-parts gnus-article-mime-handles) @@ -3754,7 +3846,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (when (and (boundp 'transient-mark-mode) transient-mark-mode) (setq mark-active nil)) - (if (not (setq result (let ((buffer-read-only nil)) + (if (not (setq result (let ((inhibit-read-only t)) (gnus-request-article-this-buffer article group)))) ;; There is no such article. @@ -3849,7 +3941,8 @@ If ALL-HEADERS is non-nil, no headers are hidden." ;; Hooks for getting information from the article. ;; This hook must be called before being narrowed. (let ((gnus-article-buffer (current-buffer)) - buffer-read-only) + buffer-read-only + (inhibit-read-only t)) (unless (eq major-mode 'gnus-article-mode) (gnus-article-mode)) (setq buffer-read-only nil @@ -3949,7 +4042,7 @@ General format specifiers can also be used. See Info node (mm-remove-parts handles) (goto-char (point-min)) (or (search-forward "\n\n") (goto-char (point-max))) - (let (buffer-read-only) + (let ((inhibit-read-only t)) (delete-region (point) (point-max)) (mm-display-parts handles)))))) @@ -4136,60 +4229,63 @@ Deleting parts may malfunction or destroy the article; continue? ") (mm-merge-handles gnus-article-mime-handles handle)) (gnus-mm-display-part handle)))) -(eval-when-compile - (require 'jka-compr)) - -;; jka-compr.el uses a "sh -c" to direct stderr to err-file, but these days -;; emacs can do that itself. -;; -(defun gnus-mime-jka-compr-maybe-uncompress () - "Uncompress the current buffer if `auto-compression-mode' is enabled. -The uncompress method used is derived from `buffer-file-name'." - (when (and (fboundp 'jka-compr-installed-p) - (jka-compr-installed-p)) - (let ((info (jka-compr-get-compression-info buffer-file-name))) - (when info - (let ((basename (file-name-nondirectory buffer-file-name)) - (args (jka-compr-info-uncompress-args info)) - (prog (jka-compr-info-uncompress-program info)) - (message (jka-compr-info-uncompress-message info)) - (err-file (jka-compr-make-temp-name))) - (if message - (message "%s %s..." message basename)) - (unwind-protect - (unless (memq (apply 'call-process-region - (point-min) (point-max) - prog - t (list t err-file) nil - args) - jka-compr-acceptable-retval-list) - (jka-compr-error prog args basename message err-file)) - (jka-compr-delete-temp-file err-file))))))) - -(defun gnus-mime-copy-part (&optional handle) +(defun gnus-mime-copy-part (&optional handle arg) "Put the MIME part under point into a new buffer. If `auto-compression-mode' is enabled, compressed files like .gz and .bz2 are decompressed." - (interactive) + (interactive (list nil current-prefix-arg)) (gnus-article-check-buffer) - (let* ((handle (or handle (get-text-property (point) 'gnus-data))) - (contents (and handle (mm-get-part handle))) - (base (and handle - (file-name-nondirectory - (or - (mail-content-type-get (mm-handle-type handle) 'name) - (mail-content-type-get (mm-handle-disposition handle) - 'filename) - "*decoded*")))) - (buffer (and base (generate-new-buffer base)))) - (when contents - (switch-to-buffer buffer) - (insert contents) + (unless handle + (setq handle (get-text-property (point) 'gnus-data))) + (when handle + (let ((filename (or (mail-content-type-get (mm-handle-disposition handle) + 'name) + (mail-content-type-get (mm-handle-disposition handle) + 'filename))) + contents dont-decode charset coding-system) + (mm-with-unibyte-buffer + (mm-insert-part handle) + (setq contents (or (condition-case nil + (mm-decompress-buffer filename nil 'sig) + (error + (setq dont-decode t) + nil)) + (buffer-string)))) + (setq filename (cond (filename (file-name-nondirectory filename)) + (dont-decode "*raw data*") + (t "*decoded*"))) + (cond + (dont-decode) + ((not arg) + (unless (setq charset (mail-content-type-get + (mm-handle-type handle) 'charset)) + (unless (setq coding-system (mm-with-unibyte-buffer + (insert contents) + (mm-find-buffer-file-coding-system))) + (setq charset gnus-newsgroup-charset)))) + ((numberp arg) + (setq charset (or (cdr (assq arg + gnus-summary-show-article-charset-alist)) + (mm-read-coding-system "Charset: "))))) + (switch-to-buffer (generate-new-buffer filename)) + (if (or coding-system + (and charset + (setq coding-system (mm-charset-to-coding-system charset)) + (not (eq charset 'ascii)))) + (progn + (mm-enable-multibyte) + (insert (mm-decode-coding-string contents coding-system)) + (setq buffer-file-coding-system + (if (boundp 'last-coding-system-used) + (symbol-value 'last-coding-system-used) + coding-system))) + (mm-disable-multibyte) + (insert contents) + (setq buffer-file-coding-system mm-binary-coding-system)) ;; We do it this way to make `normal-mode' set the appropriate mode. (unwind-protect (progn - (setq buffer-file-name (expand-file-name base)) - (gnus-mime-jka-compr-maybe-uncompress) + (setq buffer-file-name (expand-file-name filename)) (normal-mode)) (setq buffer-file-name nil)) (goto-char (point-min))))) @@ -4220,37 +4316,57 @@ are decompressed." (ps-despool filename))))) (defun gnus-mime-inline-part (&optional handle arg) - "Insert the MIME part under point into the current buffer." + "Insert the MIME part under point into the current buffer. +Compressed files like .gz and .bz2 are decompressed." (interactive (list nil current-prefix-arg)) (gnus-article-check-buffer) - (let* ((handle (or handle (get-text-property (point) 'gnus-data))) - contents charset - (b (point)) - buffer-read-only) - (when handle + (unless handle + (setq handle (get-text-property (point) 'gnus-data))) + (when handle + (let ((b (point)) + (inhibit-read-only t) + contents charset coding-system) (if (and (not arg) (mm-handle-undisplayer handle)) (mm-remove-part handle) - (setq contents (mm-get-part handle)) + (mm-with-unibyte-buffer + (mm-insert-part handle) + (setq contents + (or (mm-decompress-buffer + (or (mail-content-type-get (mm-handle-disposition handle) + 'name) + (mail-content-type-get (mm-handle-disposition handle) + 'filename)) + nil t) + (buffer-string)))) (cond ((not arg) - (setq charset (or (mail-content-type-get - (mm-handle-type handle) 'charset) - gnus-newsgroup-charset))) + (unless (setq charset (mail-content-type-get + (mm-handle-type handle) 'charset)) + (unless (setq coding-system + (mm-with-unibyte-buffer + (insert contents) + (mm-find-buffer-file-coding-system))) + (setq charset gnus-newsgroup-charset)))) ((numberp arg) (if (mm-handle-undisplayer handle) (mm-remove-part handle)) (setq charset (or (cdr (assq arg gnus-summary-show-article-charset-alist)) - (mm-read-coding-system "Charset: "))))) + (mm-read-coding-system "Charset: ")))) + (t + (if (mm-handle-undisplayer handle) + (mm-remove-part handle)))) (forward-line 2) - (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)) + (mm-insert-inline + handle + (if (or coding-system + (and charset + (setq coding-system + (mm-charset-to-coding-system charset)) + (not (eq charset 'ascii)))) + (mm-decode-coding-string contents coding-system) + (mm-string-to-multibyte contents))) (goto-char b))))) (defun gnus-mime-view-part-as-charset (&optional handle arg) @@ -4261,7 +4377,7 @@ specified charset." (let* ((handle (or handle (get-text-property (point) 'gnus-data))) contents charset (b (point)) - buffer-read-only) + (inhibit-read-only t)) (when handle (if (mm-handle-undisplayer handle) (mm-remove-part handle)) @@ -4300,7 +4416,7 @@ If no internal viewer is available, use an external viewer." (mail-parse-ignored-charsets (with-current-buffer gnus-summary-buffer gnus-newsgroup-ignored-charsets)) - buffer-read-only) + (inhibit-read-only t)) (when handle (if (mm-handle-undisplayer handle) (mm-remove-part handle) @@ -4361,8 +4477,8 @@ N is the numerical prefix." (defun gnus-article-mime-match-handle-first (condition) (if condition - (let ((alist gnus-article-mime-handle-alist) ihandle n) - (while (setq ihandle (pop alist)) + (let (n) + (dolist (ihandle gnus-article-mime-handle-alist) (if (and (cond ((functionp condition) (funcall condition (cdr ihandle))) @@ -4403,7 +4519,7 @@ N is the numerical prefix." "Display HANDLE and fix MIME button." (let ((id (get-text-property (point) 'gnus-part)) (point (point)) - buffer-read-only) + (inhibit-read-only t)) (forward-line 1) (prog1 (let ((window (selected-window)) @@ -4529,11 +4645,15 @@ N is the numerical prefix." ;; We have to do this since selecting the window ;; may change the point. So we set the window point. (set-window-point window point))) - (let* ((handles (or ihandles - (mm-dissect-buffer nil gnus-article-loose-mime) - (and gnus-article-emulate-mime - (mm-uu-dissect)))) - buffer-read-only handle name type b e display) + (let ((handles ihandles) + (inhibit-read-only t) + handle name type b e display) + (cond (handles) + ((setq handles (mm-dissect-buffer nil gnus-article-loose-mime)) + (when gnus-article-emulate-mime + (mm-uu-dissect-text-parts handles))) + (gnus-article-emulate-mime + (setq handles (mm-uu-dissect)))) (when (and (not ihandles) (not gnus-displaying-mime)) ;; Top-level call; we clean up. @@ -4579,6 +4699,7 @@ If t, it overrides nil values of (defcustom gnus-mime-display-multipart-alternative-as-mixed nil "Display \"multipart/alternative\" parts as \"multipart/mixed\"." + :version "22.1" :group 'gnus-article-mime :type 'boolean) @@ -4588,6 +4709,7 @@ If t, it overrides nil values of If displaying \"text/html\" is discouraged \(see `mm-discouraged-alternatives'\) images or other material inside a \"multipart/related\" part might be overlooked when this variable is nil." + :version "22.1" :group 'gnus-article-mime :type 'boolean) @@ -4692,7 +4814,7 @@ If displaying \"text/html\" is discouraged \(see (forward-line -1) (setq beg (point))) (gnus-article-insert-newline) - (mm-insert-inline handle (mm-get-part handle)) + (mm-display-inline handle) (goto-char (point-max)))) ;; Do highlighting. (save-excursion @@ -4726,7 +4848,7 @@ If displaying \"text/html\" is discouraged \(see (let* ((preferred (or preferred (mm-preferred-alternative handles))) (ihandles handles) (point (point)) - handle buffer-read-only from props begend not-pref) + handle (inhibit-read-only t) from props begend not-pref) (save-window-excursion (save-restriction (when ibegend @@ -4928,7 +5050,7 @@ If given a numerical ARG, move forward ARG pages." (widen) ;; Remove any old next/prev buttons. (when (gnus-visual-p 'page-marker) - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (gnus-remove-text-with-property 'gnus-prev) (gnus-remove-text-with-property 'gnus-next))) (if @@ -4948,12 +5070,12 @@ If given a numerical ARG, move forward ARG pages." (match-beginning 0) (point))) (when (and (gnus-visual-p 'page-marker) - (not (= (point-min) 1))) + (> (point-min) (save-restriction (widen) (point-min)))) (save-excursion (goto-char (point-min)) (gnus-insert-prev-page-button))) (when (and (gnus-visual-p 'page-marker) - (< (+ (point-max) 2) (buffer-size))) + (< (point-max) (save-restriction (widen) (point-max)))) (save-excursion (goto-char (point-max)) (gnus-insert-next-page-button)))))) @@ -5406,7 +5528,7 @@ If given a prefix, show the hidden text instead." (backend (car (gnus-find-method-for-group gnus-newsgroup-name))) result - (buffer-read-only nil)) + (inhibit-read-only t)) (if (or (not (listp methods)) (and (symbolp (car methods)) (assq (car methods) nnoo-definition-alist))) @@ -5458,7 +5580,7 @@ If given a prefix, show the hidden text instead." (buffer-disable-undo) (setq major-mode 'gnus-original-article-mode) (setq buffer-read-only t)) - (let (buffer-read-only) + (let ((inhibit-read-only t)) (erase-buffer) (insert-buffer-substring gnus-article-buffer)) (setq gnus-original-article (cons group article))) @@ -5556,7 +5678,7 @@ If given a prefix, show the hidden text instead." ["Body" message-goto-body t] ["Signature" message-goto-signature t])) -(define-derived-mode gnus-article-edit-mode text-mode "Article Edit" +(define-derived-mode gnus-article-edit-mode message-mode "Article Edit" "Major mode for editing articles. This is an extended text-mode. @@ -5595,7 +5717,10 @@ groups." "Start editing the contents of the current article buffer." (let ((winconf (current-window-configuration))) (set-buffer gnus-article-buffer) - (gnus-article-edit-mode) + (let ((message-auto-save-directory + ;; Don't associate the article buffer with a draft file. + nil)) + (gnus-article-edit-mode)) (funcall start-func) (set-buffer-modified-p nil) (gnus-configure-windows 'edit-article) @@ -5686,6 +5811,7 @@ groups." (defcustom gnus-button-valid-fqdn-regexp message-valid-fqdn-regexp "Regular expression that matches a valid FQDN." + :version "22.1" :group 'gnus-article-buttons :type 'regexp) @@ -5693,6 +5819,7 @@ groups." "Function to use for displaying man pages. The function must take at least one argument with a string naming the man page." + :version "22.1" :type '(choice (function-item :tag "Man" manual-entry) (function-item :tag "Woman" woman) (function :tag "Other")) @@ -5703,6 +5830,7 @@ man page." If the default site is too slow, try to find a CTAN mirror, see . 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/") @@ -5713,12 +5841,14 @@ the variable `gnus-button-handle-ctan'." (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"))) @@ -5732,6 +5862,7 @@ The function must take one argument, the string naming the URL." "\\)") "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) @@ -5741,6 +5872,7 @@ It should match all directories in the top level of `gnus-ctan-url'." gnus-button-valid-fqdn-regexp ">?\\)\\b") "Regular expression that matches a message ID or a mail address." + :version "22.1" :group 'gnus-article-buttons :type 'regexp) @@ -5752,6 +5884,7 @@ message ID or a mail address, respectively. If this variable is set to the symbol `ask', always query the user what do do. If it is a function, this function will be called with the string as it's only argument. The function must return `mid', `mail', `invalid' or `ask'." + :version "22.1" :group 'gnus-article-buttons :type '(choice (function-item :tag "Heuristic function" gnus-button-mid-or-mail-heuristic) @@ -5815,6 +5948,7 @@ must return `mid', `mail', `invalid' or `ask'." A negative RATE indicates a message IDs, whereas a positive indicates a mail address. The REGEXP is processed with `case-fold-search' set to nil." + :version "22.1" :group 'gnus-article-buttons :type '(repeat (cons (number :tag "Rate") (regexp :tag "Regexp")))) @@ -5999,6 +6133,7 @@ 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) @@ -6010,6 +6145,7 @@ positives are possible. Note that you can set this variable local to specific groups. Setting it higher in Unix 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) @@ -6021,6 +6157,7 @@ positives are possible. Note that you can set this variable local to specific groups. Setting it higher in Emacs or Gnus related 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) @@ -6030,6 +6167,7 @@ probably a good idea. See Info node `(gnus)Group Parameters' and the variable The higher the number, the more buttons will appear and the more false positives are possible." ;; mail addresses, MIDs, URLs for news, ... + :version "22.1" :group 'gnus-article-buttons :type 'integer) @@ -6038,6 +6176,7 @@ positives are possible." The higher the number, the more buttons will appear and the more false positives are possible." ;; stuff handled by `browse-url' or `gnus-button-embedded-url' + :version "22.1" :group 'gnus-article-buttons :type 'integer) @@ -6194,6 +6333,8 @@ variable it the real callback function." 0 (>= gnus-button-browse-level 0) browse-url 0) ("^[^:]+:" gnus-button-url-regexp 0 (>= gnus-button-browse-level 0) browse-url 0) + ("^OpenPGP:.*url=" gnus-button-url-regexp + 0 (>= gnus-button-browse-level 0) gnus-button-openpgp 0) ("^[^:]+:" "\\bmailto:\\([-a-z.@_+0-9%=?&/]+\\)" 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) ("^[^:]+:" "\\(<\\(url: \\)?\\(nntp\\|news\\):\\([^>\n ]*\\)>\\)" @@ -6270,9 +6411,8 @@ do the highlighting. See the documentation for those functions." "Highlight article headers as specified by `gnus-header-face-alist'." (interactive) (gnus-with-article-headers - (let ((alist gnus-header-face-alist) - entry regexp header-face field-face from hpoints fpoints) - (while (setq entry (pop alist)) + (let (regexp header-face field-face from hpoints fpoints) + (dolist (entry gnus-header-face-alist) (goto-char (point-min)) (setq regexp (concat "^\\(" (if (string-equal "" (nth 0 entry)) @@ -6370,11 +6510,9 @@ specified by `gnus-button-alist'." "Add buttons to the head of the article." (interactive) (gnus-with-article-headers - (let ((alist gnus-header-button-alist) - entry beg end) - (while alist + (let (beg end) + (dolist (entry gnus-header-button-alist) ;; Each alist entry. - (setq entry (pop alist)) (goto-char (point-min)) (while (re-search-forward (car entry) nil t) ;; Each header matching the entry. @@ -6540,10 +6678,10 @@ specified by `gnus-button-alist'." (if (string-match "\\([^#]+\\)#?\\(.*\\)" url) (gnus-info-find-node (concat "(" - (gnus-url-unhex-string + (gnus-url-unhex-string (match-string 1 url)) ")" - (or (gnus-url-unhex-string + (or (gnus-url-unhex-string (match-string 2 url)) "Top"))) (error "Can't parse %s" url))) @@ -6559,6 +6697,13 @@ specified by `gnus-button-alist'." (Info-directory) (Info-menu url)) +(defun gnus-button-openpgp (url) + "Retrieve and add an OpenPGP key given URL from an OpenPGP header." + (with-temp-buffer + (mm-url-insert-file-contents-external url) + (pgg-snarf-keys-region (point-min) (point-max)) + (pgg-display-output-buffer nil nil nil))) + (defun gnus-button-message-id (message-id) "Fetch MESSAGE-ID." (with-current-buffer gnus-summary-buffer @@ -6647,13 +6792,16 @@ specified by `gnus-button-alist'." (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)) (defun gnus-insert-prev-page-button () (let ((b (point)) - (buffer-read-only nil)) + (inhibit-read-only t)) (gnus-eval-format gnus-prev-page-line-format nil `(keymap ,gnus-prev-page-map @@ -6686,7 +6834,7 @@ specified by `gnus-button-alist'." (defun gnus-insert-next-page-button () (let ((b (point)) - (buffer-read-only nil)) + (inhibit-read-only t)) (gnus-eval-format gnus-next-page-line-format nil `(keymap ,gnus-next-page-map gnus-next t @@ -6721,7 +6869,7 @@ specified by `gnus-button-alist'." "List of methods used to decode headers. This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item -is FUNCTION, FUNCTION will be apply to all newsgroups. If item is a +is FUNCTION, FUNCTION will be applied to all newsgroups. If item is a \(REGEXP . FUNCTION), FUNCTION will be only apply to the newsgroups whose names match REGEXP. @@ -6860,7 +7008,7 @@ For example: (setq references (or (mail-header-references gnus-current-headers) "")) (set-buffer gnus-article-buffer) - (let* ((buffer-read-only nil) + (let* ((inhibit-read-only t) (headers (mapcar (lambda (field) (and (save-restriction @@ -6938,7 +7086,7 @@ For example: (defun gnus-mime-security-verify-or-decrypt (handle) (mm-remove-parts (cdr handle)) (let ((region (mm-handle-multipart-ctl-parameter handle 'gnus-region)) - point buffer-read-only) + point (inhibit-read-only t)) (if region (goto-char (car region))) (save-restriction @@ -6968,7 +7116,7 @@ For example: (not (get-text-property (point) 'gnus-mime-details))) (gnus-mime-security-button-line-format (get-text-property (point) 'gnus-line-format)) - buffer-read-only) + (inhibit-read-only t)) (forward-char -1) (while (eq (get-text-property (point) 'gnus-line-format) gnus-mime-security-button-line-format)