]> code.delx.au - gnu-emacs/blobdiff - lisp/gnus/gnus-art.el
Merge from emacs--rel--22
[gnu-emacs] / lisp / gnus / gnus-art.el
index f34f8f7376ab0f97d21626335fc7276d1f97b177..0b3293f4bb97cbd1202d407d34216035e46014e1 100644 (file)
@@ -718,7 +718,7 @@ The following additional specs are available:
 (defcustom gnus-copy-article-ignored-headers nil
   "List of headers to be removed when copying an article.
 Each element is a regular expression."
-  :version "23.0" ;; No Gnus
+  :version "23.1" ;; No Gnus
   :type '(repeat regexp)
   :group 'gnus-article-various)
 
@@ -885,7 +885,7 @@ See the manual for the valid properties for various image types.
 Currently, `pbm' is used for X-Face images and `png' is used for Face
 images in Emacs.  Only the `:face' property is effective on the `xface'
 image type in XEmacs if it is built with the libcompface library."
-  :version "23.0" ;; No Gnus
+  :version "23.1" ;; No Gnus
   :group 'gnus-article-headers
   :type '(repeat (cons :format "%v" (symbol :tag "Image type") plist)))
 
@@ -1057,7 +1057,7 @@ used."
 When 0, point will be placed on the same part as before.  When
 positive (negative), move point forward (backwards) this many
 parts.  When nil, redisplay article."
-  :version "23.0" ;; No Gnus
+  :version "23.1" ;; No Gnus
   :group 'gnus-article-mime
   :type '(choice (const nil :tag "Redisplay article.")
                 (const 1 :tag "Next part.")
@@ -1362,7 +1362,7 @@ If it is a regexp, only long headers matching this regexp are unfolded.
 If it is t, all long headers are unfolded.
 
 This variable has no effect if `gnus-treat-unfold-headers' is nil."
-  :version "23.0" ;; No Gnus
+  :version "23.1" ;; No Gnus
   :group 'gnus-article-treat
   :type '(choice (const nil)
                 (const :tag "all" t)
@@ -1700,11 +1700,6 @@ Initialized from `text-mode-syntax-table.")
 
 (defvar gnus-save-article-buffer nil)
 
-(defvar gnus-article-mode-line-format-alist
-  (nconc '((?w (gnus-article-wash-status) ?s)
-          (?m (gnus-article-mime-part-status) ?s))
-        gnus-summary-mode-line-format-alist))
-
 (defvar gnus-number-of-articles-to-be-saved nil)
 
 (defvar gnus-inhibit-hiding nil)
@@ -1714,8 +1709,7 @@ Initialized from `text-mode-syntax-table.")
 ;;; Macros for dealing with the article buffer.
 
 (defmacro gnus-with-article-headers (&rest forms)
-  `(save-excursion
-     (set-buffer gnus-article-buffer)
+  `(with-current-buffer gnus-article-buffer
      (save-restriction
        (let ((inhibit-read-only t)
             (inhibit-point-motion-hooks t)
@@ -1727,8 +1721,7 @@ Initialized from `text-mode-syntax-table.")
 (put 'gnus-with-article-headers 'edebug-form-spec '(body))
 
 (defmacro gnus-with-article-buffer (&rest forms)
-  `(save-excursion
-     (set-buffer gnus-article-buffer)
+  `(with-current-buffer gnus-article-buffer
      (let ((inhibit-read-only t))
        ,@forms)))
 
@@ -2229,7 +2222,7 @@ unfolded."
   "Value of `truncate-lines' in Gnus Article buffer.
 Valid values are nil, t, `head', `first', `last', an integer or a
 predicate.  See Info node `(gnus)Customizing Articles'."
-  :version "23.0" ;; No Gnus
+  :version "23.1" ;; No Gnus
   :group 'gnus-article
   ;; :link '(custom-manual "(gnus)Customizing Articles")
   :type 'boolean)
@@ -2768,7 +2761,7 @@ exit from the summary buffer.  If it is the symbol `file', query
 on each file, if it is `ask' ask once when exiting from the
 summary buffer."
   :group 'gnus-article
-  :version "23.0" ;; No Gnus
+  :version "23.1" ;; No Gnus
   :type '(choice (const :tag "Don't delete" nil)
                 (const :tag "Don't ask" t)
                 (const :tag "Ask" ask)
@@ -3718,8 +3711,7 @@ This format is defined by the `gnus-article-time-format' variable."
           (or (symbol-value (get gnus-default-article-saver :headers))
               gnus-saved-headers gnus-visible-headers))
          (gnus-article-buffer save-buffer))
-      (save-excursion
-       (set-buffer save-buffer)
+      (with-current-buffer save-buffer
        (article-hide-headers 1 t))))
   (save-window-excursion
     (if (not gnus-default-article-saver)
@@ -4137,8 +4129,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
           `(lambda (&optional interactive &rest args)
              ,(documentation afunc t)
              (interactive (list t))
-             (save-excursion
-               (set-buffer gnus-article-buffer)
+             (with-current-buffer gnus-article-buffer
                (if interactive
                    (call-interactively ',afunc)
                  (apply ',afunc args))))))))
@@ -4215,6 +4206,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
   "F" gnus-article-followup-with-original
   "\C-hk" gnus-article-describe-key
   "\C-hc" gnus-article-describe-key-briefly
+  "\C-hb" gnus-article-describe-bindings
 
   "\C-d" gnus-article-read-summary-keys
   "\M-*" gnus-article-read-summary-keys
@@ -4344,8 +4336,7 @@ Internal variable.")
        (gnus-set-global-variables)))
     (gnus-article-setup-highlight-words)
     ;; Init original article buffer.
-    (save-excursion
-      (set-buffer (gnus-get-buffer-create gnus-original-article-buffer))
+    (with-current-buffer (gnus-get-buffer-create gnus-original-article-buffer)
       (mm-enable-multibyte)
       (setq major-mode 'gnus-original-article-mode)
       (make-local-variable 'gnus-original-article))
@@ -4360,8 +4351,7 @@ Internal variable.")
                         nil)
                     (error "Action aborted"))
                 t)))
-       (save-excursion
-         (set-buffer name)
+       (with-current-buffer name
          (set (make-local-variable 'gnus-article-edit-mode) nil)
          (when gnus-article-mime-handles
            (mm-destroy-parts gnus-article-mime-handles)
@@ -4375,8 +4365,7 @@ Internal variable.")
          (unless (eq major-mode 'gnus-article-mode)
            (gnus-article-mode))
          (current-buffer))
-      (save-excursion
-       (set-buffer (gnus-get-buffer-create name))
+      (with-current-buffer (gnus-get-buffer-create name)
        (gnus-article-mode)
        (make-local-variable 'gnus-summary-buffer)
        (setq gnus-summary-buffer
@@ -4391,8 +4380,7 @@ Internal variable.")
     (when article-window
       (set-window-start
        article-window
-       (save-excursion
-        (set-buffer gnus-article-buffer)
+       (with-current-buffer gnus-article-buffer
         (goto-char (point-min))
         (if (not line)
             (point-min)
@@ -4446,8 +4434,7 @@ If ALL-HEADERS is non-nil, no headers are hidden."
          (if (or (eq result 'pseudo)
                  (eq result 'nneething))
              (progn
-               (save-excursion
-                 (set-buffer summary-buffer)
+               (with-current-buffer summary-buffer
                  (push article gnus-newsgroup-history)
                  (setq gnus-last-article gnus-current-article
                        gnus-current-article 0
@@ -4467,8 +4454,7 @@ If ALL-HEADERS is non-nil, no headers are hidden."
                       (not (eq article gnus-current-article)))
              ;; Seems like a new article has been selected.
              ;; `gnus-current-article' must be an article number.
-             (save-excursion
-               (set-buffer summary-buffer)
+             (with-current-buffer summary-buffer
                (push article gnus-newsgroup-history)
                (setq gnus-last-article gnus-current-article
                      gnus-current-article article
@@ -5454,9 +5440,7 @@ N is the numerical prefix."
             (mail-content-type-get (mm-handle-type handle) 'url)
             ""))
        (gnus-tmp-type (mm-handle-media-type handle))
-       (gnus-tmp-description
-        (mail-decode-encoded-word-string (or (mm-handle-description handle)
-                                             "")))
+       (gnus-tmp-description (or (mm-handle-description handle) ""))
        (gnus-tmp-dots
         (if (if displayed (car displayed)
               (mm-handle-displayed-p handle))
@@ -6003,8 +5987,7 @@ the coding cookie."
 If given a numerical ARG, move forward ARG pages."
   (interactive "P")
   (setq arg (if arg (prefix-numeric-value arg) 0))
-  (save-excursion
-    (set-buffer gnus-article-buffer)
+  (with-current-buffer gnus-article-buffer
     (goto-char (point-min))
     (widen)
     ;; Remove any old next/prev buttons.
@@ -6241,14 +6224,14 @@ not have a face in `gnus-article-boring-faces'."
           "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
           "=" "^" "\M-^" "|"))
        (nosave-but-article
-        '("A\r"))
+        '("A " "A<" "A>" "AM" "AP" "AR" "AT" "A\C-?" "A\M-\r" "A\r" "Ab" "Ae"
+          "An" "Ap" [?A (meta return)] [?A delete]))
        (nosave-in-article
-        '("\C-d"))
+        '("AS" "\C-d"))
        (up-to-top
         '("n" "Gn" "p" "Gp"))
        keys new-sum-point)
-    (save-excursion
-      (set-buffer gnus-article-current-summary)
+    (with-current-buffer gnus-article-current-summary
       (let (gnus-pick-mode)
        (setq unread-command-events (nconc unread-command-events
                                           (list (or key last-command-event)))
@@ -6260,27 +6243,7 @@ not have a face in `gnus-article-boring-faces'."
 
     (cond
      ((eq (aref keys (1- (length keys))) ?\C-h)
-      (if (featurep 'xemacs)
-         (let ((keymap (with-current-buffer gnus-article-current-summary
-                         (copy-keymap (current-local-map)))))
-           (map-keymap
-            (lambda (key def)
-              (define-key keymap (vector ?S key) def))
-            gnus-article-send-map)
-           (with-temp-buffer
-             (setq major-mode 'gnus-article-mode)
-             (use-local-map keymap)
-             (describe-bindings (substring keys 0 -1))))
-       (let ((keymap (make-sparse-keymap))
-             (map (copy-keymap gnus-article-send-map)))
-         (define-key keymap "S" map)
-         (define-key map [t] nil)
-         (set-keymap-parent keymap
-                            (with-current-buffer gnus-article-current-summary
-                              (current-local-map)))
-         (with-temp-buffer
-           (use-local-map keymap)
-           (describe-bindings (substring keys 0 -1))))))
+      (gnus-article-describe-bindings (substring keys 0 -1)))
      ((or (member keys nosaves)
          (member keys nosave-but-article)
          (member keys nosave-in-article))
@@ -6368,9 +6331,7 @@ not have a face in `gnus-article-boring-faces'."
 
 (defun gnus-article-read-summary-send-keys ()
   (interactive)
-  (let ((unread-command-events (list (if (featurep 'xemacs)
-                                        (character-to-event ?S)
-                                      ?S))))
+  (let ((unread-command-events (list (gnus-character-to-event ?S))))
     (gnus-article-read-summary-keys)))
 
 (defun gnus-article-describe-key (key)
@@ -6381,8 +6342,7 @@ KEY is a string or a vector."
   (gnus-article-check-buffer)
   (if (memq (key-binding key t) '(gnus-article-read-summary-keys
                                  gnus-article-read-summary-send-keys))
-      (save-excursion
-       (set-buffer gnus-article-current-summary)
+      (with-current-buffer gnus-article-current-summary
        (setq unread-command-events
              (if (featurep 'xemacs)
                  (append key nil)
@@ -6404,8 +6364,7 @@ KEY is a string or a vector."
   (gnus-article-check-buffer)
   (if (memq (key-binding key t) '(gnus-article-read-summary-keys
                                  gnus-article-read-summary-send-keys))
-      (save-excursion
-       (set-buffer gnus-article-current-summary)
+      (with-current-buffer gnus-article-current-summary
        (setq unread-command-events
              (if (featurep 'xemacs)
                  (append key nil)
@@ -6418,6 +6377,46 @@ KEY is a string or a vector."
          (describe-key-briefly (read-key-sequence nil t) insert)))
     (describe-key-briefly key insert)))
 
+;;`gnus-agent-mode' in gnus-agent.el will define it.
+(defvar gnus-agent-summary-mode)
+(defvar gnus-draft-mode)
+
+(defun gnus-article-describe-bindings (&optional prefix)
+  "Show a list of all defined keys, and their definitions.
+The optional argument PREFIX, if non-nil, should be a key sequence;
+then we display only bindings that start with that prefix."
+  (interactive)
+  (gnus-article-check-buffer)
+  (let ((keymap (copy-keymap gnus-article-mode-map))
+       (map (copy-keymap gnus-article-send-map))
+       (sumkeys (where-is-internal 'gnus-article-read-summary-keys))
+       agent draft)
+    (define-key keymap "S" map)
+    (define-key map [t] nil)
+    (with-current-buffer gnus-article-current-summary
+      (set-keymap-parent map (key-binding "S"))
+      (let (def gnus-pick-mode)
+       (dolist (key sumkeys)
+         (when (setq def (key-binding key))
+           (define-key keymap key def))))
+      (when (boundp 'gnus-agent-summary-mode)
+       (setq agent gnus-agent-summary-mode))
+      (when (boundp 'gnus-draft-mode)
+       (setq draft gnus-draft-mode)))
+    (with-temp-buffer
+      (use-local-map keymap)
+      (set (make-local-variable 'gnus-agent-summary-mode) agent)
+      (set (make-local-variable 'gnus-draft-mode) draft)
+      (describe-bindings prefix))
+    (let ((item `((lambda (prefix)
+                   (with-current-buffer ,(current-buffer)
+                     (gnus-article-describe-bindings prefix)))
+                 ,prefix)))
+      (with-current-buffer (if (fboundp 'help-buffer)
+                              (let (help-xref-following) (help-buffer))
+                            "*Help*") ;; Emacs 21
+       (setq help-xref-stack-item item)))))
+
 (defun gnus-article-reply-with-original (&optional wide)
   "Start composing a reply mail to the current message.
 The text in the region will be yanked.  If the region isn't active,
@@ -6514,8 +6513,7 @@ If given a prefix, show the hidden text instead."
                     gnus-summary-buffer
                     (get-buffer gnus-summary-buffer)
                     (gnus-buffer-exists-p gnus-summary-buffer))
-           (save-excursion
-             (set-buffer gnus-summary-buffer)
+           (with-current-buffer gnus-summary-buffer
              (let ((header (gnus-summary-article-header article)))
                (when (< article 0)
                  (cond
@@ -6807,9 +6805,8 @@ groups."
       (gnus-backlog-remove-article
        (car gnus-article-current) (cdr gnus-article-current)))
     ;; Flush original article as well.
-    (save-excursion
-      (when (get-buffer gnus-original-article-buffer)
-       (set-buffer gnus-original-article-buffer)
+    (when (get-buffer gnus-original-article-buffer)
+      (with-current-buffer gnus-original-article-buffer
        (setq gnus-original-article nil)))
     (when gnus-use-cache
       (gnus-cache-update-article
@@ -7801,8 +7798,7 @@ url is put as the `gnus-button-url' overlay property on the button."
       (gnus-parse-news-url url)
     (cond
      (message-id
-      (save-excursion
-       (set-buffer gnus-summary-buffer)
+      (with-current-buffer gnus-summary-buffer
        (if server
            (let ((gnus-refer-article-method
                   (nconc (list (list 'nntp server))
@@ -7876,6 +7872,9 @@ url is put as the `gnus-button-url' overlay property on the button."
   (Info-directory)
   (Info-menu url))
 
+;; Called after pgg-snarf-keys-region, which autoloads pgg.el.
+(declare-function pgg-display-output-buffer "pgg" (start end status))
+
 (defun gnus-button-openpgp (url)
   "Retrieve and add an OpenPGP key given URL from an OpenPGP header."
   (with-temp-buffer
@@ -8192,8 +8191,7 @@ For example:
        (error "Can't encrypt the article in group %s"
               gnus-newsgroup-name))
     (gnus-summary-iterate n
-      (save-excursion
-       (set-buffer gnus-summary-buffer)
+      (with-current-buffer gnus-summary-buffer
        (let ((mail-parse-charset gnus-newsgroup-charset)
              (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)
              (summary-buffer gnus-summary-buffer)
@@ -8239,9 +8237,8 @@ For example:
          (when gnus-keep-backlog
            (gnus-backlog-remove-article
             (car gnus-article-current) (cdr gnus-article-current)))
-         (save-excursion
-           (when (get-buffer gnus-original-article-buffer)
-             (set-buffer gnus-original-article-buffer)
+          (when (get-buffer gnus-original-article-buffer)
+            (with-current-buffer gnus-original-article-buffer
              (setq gnus-original-article nil)))
          (when gnus-use-cache
            (gnus-cache-update-article
@@ -8492,5 +8489,5 @@ For example:
 
 (run-hooks 'gnus-art-load-hook)
 
-;;; arch-tag: 2654516f-6279-48f9-a83b-05c1fa450c33
+;; arch-tag: 2654516f-6279-48f9-a83b-05c1fa450c33
 ;;; gnus-art.el ends here