X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=871983bec6aa4f2752d928729a6b73596caa2320;hb=4258e532258754537d9751a3de585c8710ea9a9e;hp=221229a3ac944a2a111843eac7d73117dc2a0ab3;hpb=142f61b4f0709a21cb14d6c08d0f69f030f2318b;p=gnus diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 221229a3a..871983bec 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -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))