+(defun gnus-summary-setup-default-charset ()
+ "Setup newsgroup default charset."
+ (let ((name (and gnus-newsgroup-name
+ (gnus-group-real-name gnus-newsgroup-name))))
+ (setq gnus-newsgroup-charset
+ (or (and gnus-newsgroup-name
+ (or (gnus-group-find-parameter gnus-newsgroup-name
+ 'charset)
+ (let ((alist gnus-group-charset-alist)
+ elem (charset nil))
+ (while (setq elem (pop alist))
+ (when (and name
+ (string-match (car elem) name))
+ (setq alist nil
+ charset (cadr elem))))
+ charset)))
+ gnus-default-charset))))
+
+;;;
+;;; 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)
+ (goto-char (point-max))
+ (widen)
+ (when (search-forward "\n--" nil t)
+ (let ((separator (buffer-substring (point) (gnus-point-at-eol))))
+ (message-narrow-to-head)
+ (message-remove-header "Mime-Version")
+ (message-remove-header "Content-Type")
+ (goto-char (point-max))
+ (insert (format "Content-Type: multipart/mixed; boundary=\"%s\"\n"
+ separator))
+ (insert "Mime-Version: 1.0\n")
+ (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)))
+
+;;;
+;;; with article
+;;;
+
+(defmacro gnus-with-article (article &rest forms)
+ "Select ARTICLE and perform FORMS in the original article buffer.
+Then replace the article with the result."
+ `(progn
+ ;; We don't want the article to be marked as read.
+ (let (gnus-mark-article-hook)
+ (gnus-summary-select-article t t nil ,article))
+ (set-buffer gnus-original-article-buffer)
+ ,@forms
+ (if (not (gnus-check-backend-function
+ 'request-replace-article (car gnus-article-current)))
+ (gnus-message 5 "Read-only group; not replacing")
+ (unless (gnus-request-replace-article
+ ,article (car gnus-article-current)
+ (current-buffer) t)
+ (error "Couldn't replace article")))
+ ;; The cache and backlog have to be flushed somewhat.
+ (when gnus-keep-backlog
+ (gnus-backlog-remove-article
+ (car gnus-article-current) (cdr gnus-article-current)))
+ (when gnus-use-cache
+ (gnus-cache-update-article
+ (car gnus-article-current) (cdr gnus-article-current)))))
+
+(put 'gnus-with-article 'lisp-indent-function 1)
+(put 'gnus-with-article 'edebug-form-spec '(form body))
+
+;;;
+;;; 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 (cadr 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))
+
+;; Added by Shenghuo Zhu <zsh@cs.rochester.edu>
+(defun gnus-summary-setup-highlight-words (&optional highlight-words)
+ "Setup newsgroup emphasis alist."
+ (let ((name (and gnus-newsgroup-name
+ (gnus-group-real-name gnus-newsgroup-name))))
+ (setq gnus-newsgroup-emphasis-alist
+ (nconc
+ (let ((alist gnus-group-highlight-words-alist) elem highlight)
+ (while (setq elem (pop alist))
+ (when (and name (string-match (car elem) name))
+ (setq alist nil
+ highlight (copy-list (cdr elem)))))
+ highlight)
+ (copy-list highlight-words)
+ (if gnus-newsgroup-name
+ (copy-list (gnus-group-find-parameter
+ gnus-newsgroup-name 'highlight-words t)))
+ gnus-emphasis-alist))))
+
+(gnus-summary-make-all-marking-commands)
+
projects / elisp / gnus.git- / blobdiff