(gnus-summary-kill-thread): Allow universal prefix zero
[gnus] / lisp / gnus-art.el
index 221229a..871983b 100644 (file)
@@ -4351,6 +4351,90 @@ If ALL-HEADERS is non-nil, no headers are hidden."
       (funcall gnus-display-mime-function))
     (gnus-run-hooks 'gnus-article-prepare-hook)))
 
+;;;
+;;; Gnus Sticky Article Mode
+;;;
+
+(define-derived-mode gnus-sticky-article-mode gnus-article-mode "StickyArticle"
+  "Mode for sticky articles."
+  ;; Release bindings that won't work.
+  (substitute-key-definition 'gnus-article-read-summary-keys 'undefined
+                            gnus-sticky-article-mode-map)
+  (substitute-key-definition 'gnus-article-refer-article 'undefined
+                            gnus-sticky-article-mode-map)
+  (dolist (k '("e" "h" "s" "F" "R"))
+    (define-key gnus-sticky-article-mode-map k nil))
+  (define-key gnus-sticky-article-mode-map "k" 'gnus-kill-sticky-article-buffer)
+  (define-key gnus-sticky-article-mode-map "q" 'bury-buffer)
+  (define-key gnus-sticky-article-mode-map "\C-hc" 'describe-key-briefly)
+  (define-key gnus-sticky-article-mode-map "\C-hk" 'describe-key))
+
+(defun gnus-sticky-article (arg)
+  "Make the current article sticky.
+If a prefix ARG is given, ask for a name for this sticky article buffer."
+  (interactive "P")
+  (gnus-summary-show-thread)
+  (gnus-summary-select-article nil nil 'pseudo)
+  (let (new-art-buf-name)
+    (gnus-eval-in-buffer-window gnus-article-buffer
+      (setq new-art-buf-name
+           (concat
+            "*Sticky Article: "
+            (if arg
+                (read-from-minibuffer "Sticky article buffer name: ")
+              (gnus-with-article-headers
+                (gnus-article-goto-header "subject")
+                (setq new-art-buf-name
+                      (buffer-substring-no-properties
+                       (line-beginning-position) (line-end-position)))
+                (goto-char (point-min))
+                (gnus-article-goto-header "from")
+                (setq new-art-buf-name
+                      (concat
+                       new-art-buf-name ", "
+                       (buffer-substring-no-properties
+                        (line-beginning-position) (line-end-position))))
+                (goto-char (point-min))
+                (gnus-article-goto-header "date")
+                (setq new-art-buf-name
+                      (concat
+                       new-art-buf-name ", "
+                       (buffer-substring-no-properties
+                        (line-beginning-position) (line-end-position))))))
+            "*"))
+      (if (and (gnus-buffer-live-p new-art-buf-name)
+              (with-current-buffer new-art-buf-name
+                (eq major-mode 'gnus-sticky-article-mode)))
+         (switch-to-buffer new-art-buf-name)
+       (setq new-art-buf-name (rename-buffer new-art-buf-name t)))
+      (gnus-sticky-article-mode))
+    (setq gnus-article-buffer new-art-buf-name))
+  (gnus-summary-recenter)
+  (gnus-summary-position-point))
+
+(defun gnus-kill-sticky-article-buffer (&optional buffer)
+  "Kill the given sticky article BUFFER.
+If none is given, assume the current buffer and kill it if it has
+`gnus-sticky-article-mode'."
+  (interactive)
+  (unless buffer
+    (setq buffer (current-buffer)))
+  (with-current-buffer buffer
+    (when (eq major-mode 'gnus-sticky-article-mode)
+      (gnus-kill-buffer buffer))))
+
+(defun gnus-kill-sticky-article-buffers (arg)
+  "Kill all sticky article buffers.
+If a prefix ARG is given, ask for confirmation."
+  (interactive "P")
+  (dolist (buf (gnus-buffers))
+    (with-current-buffer buf
+      (when (eq major-mode 'gnus-sticky-article-mode)
+       (if (not arg)
+           (gnus-kill-buffer buf)
+         (when (yes-or-no-p (concat "Kill buffer " (buffer-name buf) "? "))
+           (gnus-kill-buffer buf)))))))
+
 ;;;
 ;;; Gnus MIME viewing functions
 ;;;
@@ -4521,7 +4605,11 @@ and `gnus-mime-delete-part', and not provided at run-time normally."
     (gnus-summary-show-article)
     (when (and current-id (integerp gnus-auto-select-part))
       (gnus-article-jump-to-part
-       (+ current-id gnus-auto-select-part)))))
+       (if (text-property-any (point-min) (point-max)
+                             'gnus-part (+ current-id gnus-auto-select-part))
+          (+ current-id gnus-auto-select-part)
+        (with-current-buffer gnus-article-buffer
+          (length gnus-article-mime-handle-alist)))))))
 
 (defun gnus-mime-replace-part (file)
   "Replace MIME part under point with an external body."
@@ -4658,7 +4746,11 @@ Deleting parts may malfunction or destroy the article; continue? "))
                ;; Content-Disposition: attachment; filename=...
                (cdr (assq 'filename (cdr (mm-handle-disposition handle))))))
         (def-type (and name (mm-default-file-encoding name))))
-    (and def-type (cons def-type 0))))
+    (or (and def-type (cons def-type 0))
+       (and handle
+            (equal (mm-handle-media-supertype handle) "text")
+            '("text/plain" . 0))
+       '("application/octet-stream" . 0))))
 
 (defun gnus-mime-view-part-as-type (&optional mime-type pred)
   "Choose a MIME media type, and view the part as such.
@@ -4692,6 +4784,8 @@ available media-types."
                            (mm-handle-id handle)))
       (setq gnus-article-mime-handles
            (mm-merge-handles gnus-article-mime-handles handle))
+      (when (mm-handle-displayed-p handle)
+       (mm-remove-part handle))
       (gnus-mm-display-part handle))))
 
 (defun gnus-mime-copy-part (&optional handle arg)
@@ -4859,12 +4953,15 @@ specified charset."
        (gnus-newsgroup-ignored-charsets 'gnus-all)
        gnus-newsgroup-charset form preferred parts)
     (when handle
-      (if (mm-handle-undisplayer handle)
-         (mm-remove-part handle))
-      (when fun
-       (setq gnus-newsgroup-charset
-             (or (cdr (assq arg gnus-summary-show-article-charset-alist))
-                 (mm-read-coding-system "Charset: ")))
+      (when (prog1
+               (and fun
+                    (setq gnus-newsgroup-charset
+                          (or (cdr (assq
+                                    arg
+                                    gnus-summary-show-article-charset-alist))
+                              (mm-read-coding-system "Charset: "))))
+             (if (mm-handle-undisplayer handle)
+                 (mm-remove-part handle)))
        (gnus-mime-strip-charset-parameters handle)
        (when (and (consp (setq form (cdr-safe fun)))
                   (setq form (ignore-errors
@@ -5437,8 +5534,9 @@ If displaying \"text/html\" is discouraged \(see
            (gnus-article-insert-newline)
            (mm-insert-inline
             handle
-            (let ((charset (mail-content-type-get (mm-handle-type handle)
-                                                  'charset)))
+            (let ((charset (or (mail-content-type-get (mm-handle-type handle)
+                                                      'charset)
+                               (and (equal type "text/calendar") 'utf-8))))
               (cond ((not charset)
                      (mm-string-as-multibyte (mm-get-part handle)))
                     ((eq charset 'gnus-decoded)
@@ -5451,10 +5549,21 @@ If displaying \"text/html\" is discouraged \(see
          (save-excursion
            (save-restriction
              (narrow-to-region beg (point))
-             (gnus-treat-article
-              nil id
-              (gnus-article-mime-total-parts)
-              (mm-handle-media-type handle)))))))))
+             (if (eq handle gnus-article-mime-handles)
+                 ;; The format=flowed case.
+                 (gnus-treat-article nil 1 1 (mm-handle-media-type handle))
+               ;; Don't count signature parts that are never displayed.
+               ;; The part number should be re-calculated supposing this
+               ;; might be a message/rfc822 part.
+               (let (handles)
+                 (dolist (part gnus-article-mime-handles)
+                   (unless (or (stringp part)
+                               (equal (car (mm-handle-type part))
+                                      "application/pgp-signature"))
+                     (push part handles)))
+                 (gnus-treat-article
+                  nil (length (memq handle handles)) (length handles)
+                  (mm-handle-media-type handle)))))))))))
 
 (defun gnus-unbuttonized-mime-type-p (type)
   "Say whether TYPE is to be unbuttonized."
@@ -5920,7 +6029,7 @@ not have a face in `gnus-article-boring-faces'."
   "Execute the last keystroke in the summary buffer."
   (interactive)
   (let (func)
-    (pop-to-buffer gnus-article-current-summary nil (not (featurep 'xemacs)))
+    (pop-to-buffer gnus-article-current-summary)
     (setq func (lookup-key (current-local-map) (this-command-keys)))
     (call-interactively func)))
 
@@ -5963,8 +6072,7 @@ not have a face in `gnus-article-boring-faces'."
          (member keys nosave-in-article))
       (let (func)
        (save-window-excursion
-         (pop-to-buffer gnus-article-current-summary
-                        nil (not (featurep 'xemacs)))
+         (pop-to-buffer gnus-article-current-summary)
          ;; We disable the pick minor mode commands.
          (let (gnus-pick-mode)
            (setq func (lookup-key (current-local-map) keys))))
@@ -5976,15 +6084,14 @@ not have a face in `gnus-article-boring-faces'."
          (call-interactively func)
          (setq new-sum-point (point)))
        (when (member keys nosave-but-article)
-         (pop-to-buffer gnus-article-buffer nil (not (featurep 'xemacs))))))
+         (pop-to-buffer gnus-article-buffer))))
      (t
       ;; These commands should restore window configuration.
       (let ((obuf (current-buffer))
            (owin (current-window-configuration))
            win func in-buffer selected new-sum-start new-sum-hscroll err)
        (cond (not-restore-window
-              (pop-to-buffer gnus-article-current-summary
-                             nil (not (featurep 'xemacs)))
+              (pop-to-buffer gnus-article-current-summary)
               (setq win (selected-window)))
              ((setq win (get-buffer-window gnus-article-current-summary))
               (select-window win))