+
+;;; @ for mime-partial
+;;;
+
+(defun gnus-request-partial-message ()
+ (save-excursion
+ (let ((number (gnus-summary-article-number))
+ (group gnus-newsgroup-name)
+ (mother gnus-article-buffer))
+ (set-buffer (get-buffer-create " *Partial Article*"))
+ (erase-buffer)
+ (setq mime-preview-buffer mother)
+ (gnus-request-article-this-buffer number group)
+ (mime-parse-buffer)
+ )))
+
+(autoload 'mime-combine-message/partial-pieces-automatically
+ "mime-partial"
+ "Internal method to combine message/partial messages automatically.")
+
+(mime-add-condition
+ 'action '((type . message)(subtype . partial)
+ (major-mode . gnus-original-article-mode)
+ (method . mime-combine-message/partial-pieces-automatically)
+ (summary-buffer-exp . gnus-summary-buffer)
+ (request-partial-message-method . gnus-request-partial-message)
+ ))
+
+
+;;; @ for message/rfc822
+;;;
+
+(defun gnus-mime-extract-message/rfc822 (entity situation)
+ "Burst a forwarded article."
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (let* ((group (completing-read "Group: " gnus-active-hashtb nil t
+ gnus-newsgroup-name 'gnus-group-history))
+ (gnus-group-marked (list group))
+ article info)
+ (with-temp-buffer
+ (mime-insert-entity-content entity)
+ (setq article (gnus-request-accept-article group)))
+ (when (and (consp article)
+ (numberp (setq article (cdr article))))
+ (setq info (gnus-get-info group))
+ (gnus-info-set-read info
+ (gnus-remove-from-range (gnus-info-read info)
+ (list article)))
+ (when (string-equal group gnus-newsgroup-name)
+ (forward-line 1)
+ (let (gnus-show-threads)
+ (gnus-summary-goto-subject article t))
+ (gnus-summary-clear-mark-forward 1))
+ (set-buffer gnus-group-buffer)
+ (gnus-group-get-new-news-this-group nil t)))))
+
+(mime-add-condition
+ 'action '((type . message)(subtype . rfc822)
+ (major-mode . gnus-original-article-mode)
+ (method . gnus-mime-extract-message/rfc822)
+ (mode . "extract")
+ ))
+
+(mime-add-condition
+ 'action '((type . message)(subtype . news)
+ (major-mode . gnus-original-article-mode)
+ (method . gnus-mime-extract-message/rfc822)
+ (mode . "extract")
+ ))
+
+(defun gnus-mime-extract-multipart (entity situation)
+ (let ((children (mime-entity-children entity))
+ mime-acting-situation-to-override
+ f)
+ (while children
+ (mime-play-entity (car children)
+ (cons (assq 'mode situation)
+ mime-acting-situation-to-override))
+ (setq children (cdr children)))
+ (if (setq f (cdr (assq 'after-method
+ mime-acting-situation-to-override)))
+ (eval f)
+ )))
+
+(mime-add-condition
+ 'action '((type . multipart)
+ (method . gnus-mime-extract-multipart)
+ (mode . "extract")
+ )
+ 'with-default)
+
+
+;;; @ end
+;;;
+
+(defun gnus-summary-inherit-default-charset ()
+ "Import `default-mime-charset' from summary buffer.
+Also take care of `default-mime-charset-unlimited' if the LIMIT version
+of FLIM is used."
+ (if (buffer-live-p gnus-summary-buffer)
+ (let (d-m-c d-m-c-u)
+ (with-current-buffer gnus-summary-buffer
+ (setq d-m-c (if (local-variable-p 'default-mime-charset
+ gnus-summary-buffer)
+ default-mime-charset
+ t)
+ ;; LIMIT
+ d-m-c-u (if (local-variable-p 'default-mime-charset-unlimited
+ gnus-summary-buffer)
+ (symbol-value 'default-mime-charset-unlimited)
+ t)))
+ (if (eq t d-m-c)
+ (kill-local-variable 'default-mime-charset)
+ (set (make-local-variable 'default-mime-charset) d-m-c))
+ (if (eq t d-m-c-u)
+ (kill-local-variable 'default-mime-charset-unlimited)
+ (set (make-local-variable 'default-mime-charset-unlimited)
+ d-m-c-u)))))
+
+(defun gnus-summary-setup-default-charset ()
+ "Setup newsgroup default charset."
+ (if (member gnus-newsgroup-name '("nndraft:delayed" "nndraft:drafts"))
+ (progn
+ (setq gnus-newsgroup-charset nil)
+ (set (make-local-variable 'default-mime-charset) nil)
+ (when (boundp 'default-mime-charset-unlimited);; LIMIT
+ (set (make-local-variable 'default-mime-charset-unlimited) nil)))
+ (let ((ignored-charsets
+ (or gnus-newsgroup-ephemeral-ignored-charsets
+ (append
+ (and gnus-newsgroup-name
+ (gnus-parameter-ignored-charsets gnus-newsgroup-name))
+ gnus-newsgroup-ignored-charsets)))
+ charset)
+ (setq gnus-newsgroup-charset
+ (or gnus-newsgroup-ephemeral-charset
+ (when (and gnus-newsgroup-name
+ (setq charset (gnus-parameter-charset
+ gnus-newsgroup-name)))
+ (make-local-variable 'default-mime-charset)
+ (setq default-mime-charset charset))
+ gnus-default-charset))
+ (set (make-local-variable 'gnus-newsgroup-ignored-charsets)
+ ignored-charsets))))
+
+;;;
+;;; Mime Commands
+;;;
+
+(defun gnus-summary-display-buttonized (&optional show-all-parts)
+ "Display the current article buffer fully MIME-buttonized.
+If SHOW-ALL-PARTS (the prefix) is non-nil, all multipart/* parts are
+treated as multipart/mixed."
+ (interactive "P")
+ (require 'gnus-art)
+ (let ((gnus-unbuttonized-mime-types nil)
+ (gnus-mime-display-multipart-as-mixed show-all-parts))
+ (gnus-summary-show-article)))
+
+(defun gnus-summary-repair-multipart (article)
+ "Add a Content-Type header to a multipart article without one."
+ (interactive (list (gnus-summary-article-number)))
+ (gnus-with-article article
+ (message-narrow-to-head)
+ (message-remove-header "Mime-Version")
+ (goto-char (point-max))
+ (insert "Mime-Version: 1.0\n")
+ (widen)
+ (when (search-forward "\n--" nil t)
+ (let ((separator (buffer-substring (point) (point-at-eol))))
+ (message-narrow-to-head)
+ (message-remove-header "Content-Type")
+ (goto-char (point-max))
+ (insert (format "Content-Type: multipart/mixed; boundary=\"%s\"\n"
+ separator))
+ (widen))))
+ (let (gnus-mark-article-hook)
+ (gnus-summary-select-article t t nil article)))
+
+(defun gnus-summary-toggle-display-buttonized ()
+ "Toggle the buttonizing of the article buffer."
+ (interactive)
+ (require 'gnus-art)
+ (if (setq gnus-inhibit-mime-unbuttonizing
+ (not gnus-inhibit-mime-unbuttonizing))
+ (let ((gnus-unbuttonized-mime-types nil))
+ (gnus-summary-show-article))
+ (gnus-summary-show-article)))
+
+;;;
+;;; Intelli-mouse commmands
+;;;
+
+(defun gnus-wheel-summary-scroll (event)
+ (interactive "e")
+ (let ((amount (if (memq 'shift (event-modifiers event))
+ (car gnus-wheel-scroll-amount)
+ (cdr gnus-wheel-scroll-amount)))
+ (direction (- (* (static-if (featurep 'xemacs)
+ (event-button event)
+ (cond ((eq 'mouse-4 (event-basic-type event))
+ 4)
+ ((eq 'mouse-5 (event-basic-type event))
+ 5)))
+ 2) 9))
+ edge)
+ (gnus-summary-scroll-up (* amount direction))
+ (when (gnus-eval-in-buffer-window gnus-article-buffer
+ (save-restriction
+ (widen)
+ (and (if (< 0 direction)
+ (gnus-article-next-page 0)
+ (gnus-article-prev-page 0)
+ (bobp))
+ (if (setq edge (get-text-property
+ (point-min) 'gnus-wheel-edge))
+ (setq edge (* edge direction))
+ (setq edge -1))
+ (or (plusp edge)
+ (let ((buffer-read-only nil)
+ (inhibit-read-only t))
+ (put-text-property (point-min) (point-max)
+ 'gnus-wheel-edge direction)
+ nil))
+ (or (> edge gnus-wheel-edge-resistance)
+ (let ((buffer-read-only nil)
+ (inhibit-read-only t))
+ (put-text-property (point-min) (point-max)
+ 'gnus-wheel-edge
+ (* (1+ edge) direction))
+ nil))
+ (eq last-command 'gnus-wheel-summary-scroll))))
+ (gnus-summary-next-article nil nil (minusp direction)))))
+
+(defun gnus-wheel-install ()
+ "Enable mouse wheel support on summary window."
+ (when gnus-use-wheel
+ (let ((keys
+ '([(mouse-4)] [(shift mouse-4)] [(mouse-5)] [(shift mouse-5)])))
+ (dolist (key keys)
+ (define-key gnus-summary-mode-map key
+ 'gnus-wheel-summary-scroll)))))
+
+(add-hook 'gnus-summary-mode-hook 'gnus-wheel-install)
+
+;;;
+;;; Traditional PGP commmands
+;;;
+
+(defun gnus-summary-decrypt-article (&optional force)
+ "Decrypt the current article in traditional PGP way.
+This will have permanent effect only in mail groups.
+If FORCE is non-nil, allow editing of articles even in read-only
+groups."
+ (interactive "P")
+ (gnus-summary-select-article t)
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (unless (re-search-forward (car pgg-armor-header-lines) nil t)
+ (error "Not a traditional PGP message!"))
+ (let ((armor-start (match-beginning 0)))
+ (if (and (pgg-decrypt-region armor-start (point-max))
+ (or force (not (gnus-group-read-only-p))))
+ (let ((inhibit-read-only t)
+ buffer-read-only)
+ (delete-region armor-start
+ (progn
+ (re-search-forward "^-+END PGP" nil t)
+ (beginning-of-line 2)
+ (point)))
+ (insert-buffer-substring pgg-output-buffer))))))))
+
+(defun gnus-summary-verify-article ()
+ "Verify the current article in traditional PGP way."
+ (interactive)
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (goto-char (point-min))
+ (unless (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE" nil t)
+ (error "Not a traditional PGP message!"))
+ (re-search-forward "^-+END PGP" nil t)
+ (beginning-of-line 2)
+ (call-interactively (function pgg-verify-region))))
+
+;;;
+;;; Generic summary marking commands
+;;;
+
+(defvar gnus-summary-marking-alist
+ '((read gnus-del-mark "d")
+ (unread gnus-unread-mark "u")
+ (ticked gnus-ticked-mark "!")
+ (dormant gnus-dormant-mark "?")
+ (expirable gnus-expirable-mark "e"))
+ "An alist of names/marks/keystrokes.")
+
+(defvar gnus-summary-generic-mark-map (make-sparse-keymap))
+(defvar gnus-summary-mark-map)
+
+(defun gnus-summary-make-all-marking-commands ()
+ (define-key gnus-summary-mark-map "M" gnus-summary-generic-mark-map)
+ (dolist (elem gnus-summary-marking-alist)
+ (apply 'gnus-summary-make-marking-command elem)))
+
+(defun gnus-summary-make-marking-command (name mark keystroke)
+ (let ((map (make-sparse-keymap)))
+ (define-key gnus-summary-generic-mark-map keystroke map)
+ (dolist (lway `((next "next" next nil "n")
+ (next-unread "next unread" next t "N")
+ (prev "previous" prev nil "p")
+ (prev-unread "previous unread" prev t "P")
+ (nomove "" nil nil ,keystroke)))
+ (let ((func (gnus-summary-make-marking-command-1
+ mark (car lway) lway name)))
+ (setq func (eval func))
+ (define-key map (nth 4 lway) func)))))
+
+(defun gnus-summary-make-marking-command-1 (mark way lway name)
+ `(defun ,(intern
+ (format "gnus-summary-put-mark-as-%s%s"
+ name (if (eq way 'nomove)
+ ""
+ (concat "-" (symbol-name way)))))
+ (n)
+ ,(format
+ "Mark the current article as %s%s.
+If N, the prefix, then repeat N times.
+If N is negative, move in reverse order.
+The difference between N and the actual number of articles marked is
+returned."
+ name (car (cdr lway)))
+ (interactive "p")
+ (gnus-summary-generic-mark n ,mark ',(nth 2 lway) ,(nth 3 lway))))
+
+(defun gnus-summary-generic-mark (n mark move unread)
+ "Mark N articles with MARK."
+ (unless (eq major-mode 'gnus-summary-mode)
+ (error "This command can only be used in the summary buffer"))
+ (gnus-summary-show-thread)
+ (let ((nummove
+ (cond
+ ((eq move 'next) 1)
+ ((eq move 'prev) -1)
+ (t 0))))
+ (if (zerop nummove)
+ (setq n 1)
+ (when (< n 0)
+ (setq n (abs n)
+ nummove (* -1 nummove))))
+ (while (and (> n 0)
+ (gnus-summary-mark-article nil mark)
+ (zerop (gnus-summary-next-subject nummove unread t)))
+ (setq n (1- n)))
+ (when (/= 0 n)
+ (gnus-message 7 "No more %sarticles" (if mark "" "unread ")))
+ (gnus-summary-recenter)
+ (gnus-summary-position-point)
+ (gnus-set-mode-line 'summary)
+ n))
+
+(defun gnus-summary-insert-articles (articles)
+ (when (setq articles
+ (gnus-sorted-difference articles
+ (mapcar (lambda (h)
+ (mail-header-number h))
+ gnus-newsgroup-headers)))
+ (setq gnus-newsgroup-headers
+ (gnus-merge 'list
+ gnus-newsgroup-headers
+ (gnus-fetch-headers articles)
+ 'gnus-article-sort-by-number))
+ ;; Suppress duplicates?
+ (when gnus-suppress-duplicates
+ (gnus-dup-suppress-articles))
+
+ ;; We might want to build some more threads first.
+ (when (and gnus-fetch-old-headers
+ (eq gnus-headers-retrieved-by 'nov))
+ (if (eq gnus-fetch-old-headers 'invisible)
+ (gnus-build-all-threads)
+ (gnus-build-old-threads)))
+ ;; Let the Gnus agent mark articles as read.
+ (when gnus-agent
+ (gnus-agent-get-undownloaded-list))
+ ;; Remove list identifiers from subject
+ (when gnus-list-identifiers
+ (gnus-summary-remove-list-identifiers))
+ ;; First and last article in this newsgroup.
+ (when gnus-newsgroup-headers
+ (setq gnus-newsgroup-begin
+ (mail-header-number (car gnus-newsgroup-headers))
+ gnus-newsgroup-end
+ (mail-header-number
+ (gnus-last-element gnus-newsgroup-headers))))
+ (when gnus-use-scoring
+ (gnus-possibly-score-headers))))
+
+(defun gnus-summary-insert-old-articles (&optional all)
+ "Insert all old articles in this group.
+If ALL is non-nil, already read articles become readable.
+If ALL is a number, fetch this number of articles."
+ (interactive "P")
+ (prog1
+ (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<))
+ older len)
+ (setq older
+ ;; Some nntp servers lie about their active range. When
+ ;; this happens, the active range can be in the millions.
+ ;; Use a compressed range to avoid creating a huge list.
+ (gnus-range-difference (list gnus-newsgroup-active) old))
+ (setq len (gnus-range-length older))
+ (cond
+ ((null older) nil)
+ ((numberp all)
+ (if (< all len)
+ (let ((older-range (nreverse older)))
+ (setq older nil)
+
+ (while (> all 0)
+ (let* ((r (pop older-range))
+ (min (if (numberp r) r (car r)))
+ (max (if (numberp r) r (cdr r))))
+ (while (and (<= min max)
+ (> all 0))
+ (push max older)
+ (setq all (1- all)
+ max (1- max))))))
+ (setq older (gnus-uncompress-range older))))
+ (all
+ (setq older (gnus-uncompress-range older)))
+ (t
+ (when (and (numberp gnus-large-newsgroup)
+ (> len gnus-large-newsgroup))
+ (let* ((cursor-in-echo-area nil)
+ (initial (gnus-parameter-large-newsgroup-initial
+ gnus-newsgroup-name))
+ (input
+ (read-string
+ (format
+ "How many articles from %s (%s %d): "
+ (gnus-limit-string
+ (gnus-group-decoded-name gnus-newsgroup-name) 35)
+ (if initial "max" "default")
+ len)
+ (if initial
+ (cons (number-to-string initial)
+ 0)))))
+ (unless (string-match "^[ \t]*$" input)
+ (setq all (string-to-number input))
+ (if (< all len)
+ (let ((older-range (nreverse older)))
+ (setq older nil)
+
+ (while (> all 0)
+ (let* ((r (pop older-range))
+ (min (if (numberp r) r (car r)))
+ (max (if (numberp r) r (cdr r))))
+ (while (and (<= min max)
+ (> all 0))
+ (push max older)
+ (setq all (1- all)
+ max (1- max))))))))))
+ (setq older (gnus-uncompress-range older))))
+ (if (not older)
+ (message "No old news.")
+ (gnus-summary-insert-articles older)
+ (gnus-summary-limit (gnus-sorted-nunion old older))))
+ (gnus-summary-position-point)))
+
+(defun gnus-summary-insert-new-articles ()
+ "Insert all new articles in this group."
+ (interactive)
+ (prog1
+ (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<))
+ (old-active gnus-newsgroup-active)
+ (nnmail-fetched-sources (list t))
+ i new)
+ (setq gnus-newsgroup-active
+ (gnus-activate-group gnus-newsgroup-name 'scan))
+ (setq i (cdr gnus-newsgroup-active))
+ (while (> i (cdr old-active))
+ (push i new)
+ (decf i))
+ (if (not new)
+ (message "No gnus is bad news")
+ (gnus-summary-insert-articles new)
+ (setq gnus-newsgroup-unreads
+ (gnus-sorted-nunion gnus-newsgroup-unreads new))
+ (gnus-summary-limit (gnus-sorted-nunion old new))))
+ (gnus-summary-position-point)))
+
+(gnus-summary-make-all-marking-commands)
+