* gnus-art.el (gnus-sticky-article): Don't perform gnus-configure-windows here;
[gnus] / lisp / gnus-art.el
index 9560886..da17dd8 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
 ;;;
@@ -5451,10 +5535,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."
@@ -7919,18 +8014,15 @@ For example:
        point (inhibit-read-only t))
     (if region
        (goto-char (car region)))
-    (save-restriction
-      (narrow-to-region (point) (point))
-      (with-current-buffer (mm-handle-multipart-original-buffer handle)
-       (let* ((mm-verify-option 'known)
-              (mm-decrypt-option 'known)
-              (nparts (mm-possibly-verify-or-decrypt (cdr handle) handle)))
-         (unless (eq nparts (cdr handle))
-           (mm-destroy-parts (cdr handle))
-           (setcdr handle nparts))))
-      (setq point (point))
-      (gnus-mime-display-security handle)
-      (goto-char (point-max)))
+    (setq point (point))
+    (with-current-buffer (mm-handle-multipart-original-buffer handle)
+      (let* ((mm-verify-option 'known)
+            (mm-decrypt-option 'known)
+            (nparts (mm-possibly-verify-or-decrypt (cdr handle) handle)))
+       (unless (eq nparts (cdr handle))
+         (mm-destroy-parts (cdr handle))
+         (setcdr handle nparts))))
+    (gnus-mime-display-security handle)
     (when region
       (delete-region (point) (cdr region))
       (set-marker (car region) nil)
@@ -8019,7 +8111,7 @@ For example:
                (1- (point))
              (point)))
     (when gnus-article-button-face
-      (gnus-overlay-put (gnus-make-overlay b e)
+      (gnus-overlay-put (gnus-make-overlay b e nil t)
                         'face gnus-article-button-face))
     (widget-convert-button
      'link b e
@@ -8052,7 +8144,8 @@ For example:
     (mm-set-handle-multipart-parameter
      handle 'gnus-region
      (cons (set-marker (make-marker) (point-min))
-          (set-marker (make-marker) (point-max))))))
+          (set-marker (make-marker) (point-max))))
+    (goto-char (point-max))))
 
 (defun gnus-mime-security-run-function (function)
   "Run FUNCTION with the security part under point."