(require 'gnus-int)
(require 'gnus-undo)
(require 'gnus-util)
+(require 'mm-decode)
(autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t)
(defcustom gnus-kill-summary-on-exit t
(defcustom gnus-auto-select-first t
"*If nil, don't select the first unread article when entering a group.
If this variable is `best', select the highest-scored unread article
-in the group. If neither nil nor `best', select the first unread
-article.
+in the group. If t, select the first unread article.
+
+This variable can also be a function to place point on a likely
+subject line. Useful values include `gnus-summary-first-unread-subject',
+`gnus-summary-first-unread-article' and
+`gnus-summary-best-unread-article'.
If you want to prevent automatic selection of the first unread article
in some newsgroups, set the variable to nil in
:group 'gnus-group-select
:type '(choice (const :tag "none" nil)
(const best)
- (sexp :menu-tag "first" t)))
+ (sexp :menu-tag "first" t)
+ (function-item gnus-summary-first-unread-subject)
+ (function-item gnus-summary-first-unread-article)
+ (function-item gnus-summary-best-unread-article)))
(defcustom gnus-auto-select-next t
"*If non-nil, offer to go to the next group from the end of the previous.
:group 'gnus-summary-maneuvering
:type '(choice (const :tag "none" nil)
(const vertical)
+ (integer :tag "height")
(sexp :menu-tag "both" t)))
(defcustom gnus-show-all-headers nil
(defvar gnus-decode-encoded-word-function 'mail-decode-encoded-word-string
"Variable that says which function should be used to decode a string with encoded words.")
+(defcustom gnus-extra-headers nil
+ "*Extra headers to parse."
+ :group 'gnus-summary
+ :type '(repeat symbol))
+
+(defcustom gnus-ignored-from-addresses
+ (and user-mail-address (regexp-quote user-mail-address))
+ "*Regexp of From headers that may be suppressed in favor of To headers."
+ :group 'gnus-summary
+ :type 'regexp)
+
;;; Internal variables
(defvar gnus-article-mime-handles nil)
(?l (bbb-grouplens-score gnus-tmp-header) ?s)
(?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d)
(?U gnus-tmp-unread ?c)
+ (?f (gnus-summary-from-or-to-or-newsgroups gnus-tmp-header) ?s)
(?t (gnus-summary-number-of-articles-in-thread
(and (boundp 'thread) (car thread)) gnus-tmp-level)
?d)
;; MIME stuff.
-(defvar gnus-encoded-word-method-alist
- '(("chinese" mail-decode-encoded-word-string rfc1843-decode-string)
- (".*" mail-decode-encoded-word-string))
- "Alist of regexps (to match group names) and lists of functions to be applied.")
+(defvar gnus-decode-encoded-word-methods
+ '(mail-decode-encoded-word-string)
+ "List of methods used to decode encoded words.
+
+This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item is
+FUNCTION, FUNCTION will be apply to all newsgroups. If item is a
+(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups
+whose names match REGEXP.
+
+For example:
+((\"chinese\" . gnus-decode-encoded-word-string-by-guess)
+ mail-decode-encoded-word-string
+ (\"chinese\" . rfc1843-decode-string))
+")
+
+(defvar gnus-decode-encoded-word-methods-cache nil)
(defun gnus-multi-decode-encoded-word-string (string)
- "Apply the functions from `gnus-encoded-word-method-alist' that match."
- (let ((alist gnus-encoded-word-method-alist)
- elem)
- (while (setq elem (pop alist))
- (when (string-match (car elem) gnus-newsgroup-name)
- (pop elem)
- (while elem
- (setq string (funcall (pop elem) string)))
- (setq alist nil)))
- string))
+ "Apply the functions from `gnus-encoded-word-methods' that match."
+ (unless (and gnus-decode-encoded-word-methods-cache
+ (eq gnus-newsgroup-name
+ (car gnus-decode-encoded-word-methods-cache)))
+ (setq gnus-decode-encoded-word-methods-cache (list gnus-newsgroup-name))
+ (mapc '(lambda (x)
+ (if (symbolp x)
+ (nconc gnus-decode-encoded-word-methods-cache (list x))
+ (if (and gnus-newsgroup-name
+ (string-match (car x) gnus-newsgroup-name))
+ (nconc gnus-decode-encoded-word-methods-cache
+ (list (cdr x))))))
+ gnus-decode-encoded-word-methods))
+ (let ((xlist gnus-decode-encoded-word-methods-cache))
+ (pop xlist)
+ (while xlist
+ (setq string (funcall (pop xlist) string))))
+ string)
;; Subject simplification.
"L" gnus-summary-lower-score
"\M-i" gnus-symbolic-argument
"h" gnus-summary-select-article-buffer
-
+ "b" gnus-article-view-part
+
"V" gnus-summary-score-map
"X" gnus-uu-extract-map
"S" gnus-summary-send-map)
(gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map)
"w" gnus-article-decode-mime-words
- "c" gnus-article-decode-charset)
+ "c" gnus-article-decode-charset
+ "v" gnus-mime-view-all-parts
+ "b" gnus-article-view-part)
(gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map)
"z" gnus-article-date-ut
("MIME"
["Words" gnus-article-decode-mime-words t]
["Charset" gnus-article-decode-charset t]
- ["QP" gnus-article-de-quoted-unreadable t])
+ ["QP" gnus-article-de-quoted-unreadable t]
+ ["View all" gnus-mime-view-all-parts t])
("Date"
["Local" gnus-article-date-local t]
["ISO8601" gnus-article-date-iso8601 t]
("article body" "body" string)
("article head" "head" string)
("xref" "xref" string)
+ ("extra header" "extra" string)
("lines" "lines" number)
("followups to author" "followup" string)))
(types '((number ("less than" <)
(while (setq point (pop config))
(when (and (< point (point-max))
(goto-char point)
- (= (following-char) ?\n))
+ (eq (char-after) ?\n))
(subst-char-in-region point (1+ point) ?\n ?\r)))))
;; Various summary mode internalish functions.
(defun gnus-summary-last-article-p (&optional article)
"Return whether ARTICLE is the last article in the buffer."
(if (not (setq article (or article (gnus-summary-article-number))))
- t ; All non-existent numbers are the last article. :-)
+ t ; All non-existent numbers are the last article. :-)
(not (cdr (gnus-data-find-list article)))))
(defun gnus-make-thread-indent-array ()
(let ((gnus-summary-line-format-spec spec)
(gnus-newsgroup-downloadable '((0 . t))))
(gnus-summary-insert-line
- [0 "" "" "" "" "" 0 0 ""] 0 nil 128 t nil "" nil 1)
+ [0 "" "" "" "" "" 0 0 "" nil] 0 nil 128 t nil "" nil 1)
(goto-char (point-min))
(setq pos (list (cons 'unread (and (search-forward "\200" nil t)
(- (point) 2)))))
(point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
(list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
+(defun gnus-summary-from-or-to-or-newsgroups (header)
+ (let ((to (cdr (assq 'To (mail-header-extra header))))
+ (newsgroups (cdr (assq 'Newsgroups (mail-header-extra header)))))
+ (cond
+ ((and to
+ gnus-ignored-from-addresses
+ (string-match gnus-ignored-from-addresses
+ (mail-header-from header)))
+ (concat "-> "
+ (or (car (funcall gnus-extract-address-components
+ (funcall
+ gnus-decode-encoded-word-function to)))
+ (funcall gnus-decode-encoded-word-function to))))
+ ((and newsgroups
+ gnus-ignored-from-addresses
+ (string-match gnus-ignored-from-addresses
+ (mail-header-from header)))
+ (concat "=> " newsgroups))
+ (t
+ (or (car (funcall gnus-extract-address-components
+ (mail-header-from header)))
+ (mail-header-from header))))))
+
(defun gnus-summary-insert-line (gnus-tmp-header
gnus-tmp-level gnus-tmp-current
gnus-tmp-unread gnus-tmp-replied
kill-buffer no-display
select-articles)
(setq show-all nil
- select-articles nil)))))
+ select-articles nil)))))
(eq gnus-auto-select-next 'quietly))
(set-buffer gnus-group-buffer)
;; The entry function called above goes to the next
(not no-display)
gnus-newsgroup-unreads
gnus-auto-select-first)
- (unless (if (eq gnus-auto-select-first 'best)
- (gnus-summary-best-unread-article)
- (gnus-summary-first-unread-article))
- (gnus-configure-windows 'summary))
+ (progn
+ (gnus-configure-windows 'summary)
+ (cond
+ ((eq gnus-auto-select-first 'best)
+ (gnus-summary-best-unread-article))
+ ((eq gnus-auto-select-first t)
+ (gnus-summary-first-unread-article))
+ ((gnus-functionp gnus-auto-select-first)
+ (funcall gnus-auto-select-first))))
;; Don't select any articles, just move point to the first
;; article in the group.
(goto-char (point-min))
(setq heads nil)))))
gnus-newsgroup-dependencies)))
-;; The following macros and functions were written by Felix Lee
-;; <flee@cse.psu.edu>.
-
(defmacro gnus-nov-read-integer ()
'(prog1
- (if (= (following-char) ?\t)
+ (if (eq (char-after) ?\t)
0
(let ((num (ignore-errors (read buffer))))
(if (numberp num) num 0)))
(defmacro gnus-nov-field ()
'(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol)))
+(defmacro gnus-nov-parse-extra ()
+ '(let (out string)
+ (while (not (memq (char-after) '(?\n nil)))
+ (setq string (gnus-nov-field))
+ (when (string-match "^\\([^ :]+\\): " string)
+ (push (cons (intern (match-string 1 string))
+ (substring string (match-end 0)))
+ out)))
+ out))
+
;; This function has to be called with point after the article number
;; on the beginning of the line.
(defsubst gnus-nov-parse-line (number dependencies &optional force-new)
(gnus-nov-field) ; refs
(gnus-nov-read-integer) ; chars
(gnus-nov-read-integer) ; lines
- (unless (= (following-char) ?\n)
- (gnus-nov-field))))) ; misc
+ (unless (eq (char-after) ?\n)
+ (gnus-nov-field)) ; misc
+ (gnus-nov-parse-extra)))) ; extra
(widen))
(defvar gnus-tmp-root-expunged nil)
(defvar gnus-tmp-dummy-line nil)
+(defvar gnus-tmp-header)
+(defun gnus-extra-header (type &optional header)
+ "Return the extra header of TYPE."
+ (or (cdr (assq type (mail-header-extra (or header gnus-tmp-header))))
+ ""))
+
(defun gnus-summary-prepare-threads (threads)
"Prepare summary buffer from THREADS and indentation LEVEL.
THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])'
(let ((types gnus-article-mark-lists)
(info (gnus-get-info gnus-newsgroup-name))
(uncompressed '(score bookmark killed))
- type list newmarked symbol)
+ type list newmarked symbol delta-marks)
(when info
;; Add all marks lists that are non-nil to the list of marks lists.
(while (setq type (pop types))
"This function sets the mode line of the article or summary buffers.
If WHERE is `summary', the summary mode line format will be used."
;; Is this mode line one we keep updated?
- (when (memq where gnus-updated-mode-lines)
+ (when (and (memq where gnus-updated-mode-lines)
+ (symbol-value
+ (intern (format "gnus-%s-mode-line-format-spec" where))))
(let (mode-string)
(save-excursion
;; We evaluate this in the summary buffer since these
;; We might have to chop a bit of the string off...
(when (> (length mode-string) max-len)
(setq mode-string
- (concat (truncate-string mode-string (- max-len 3))
+ (concat (truncate-string-to-width mode-string (- max-len 3))
"...")))
;; Pad the mode string a bit.
(setq mode-string (format (format "%%-%ds" max-len) mode-string))))
(progn
(goto-char p)
(and (search-forward "\nxref: " nil t)
- (nnheader-header-value)))))
+ (nnheader-header-value)))
+ ;; Extra.
+ (when gnus-extra-headers
+ (let ((extra gnus-extra-headers)
+ out)
+ (while extra
+ (goto-char p)
+ (when (search-forward
+ (concat "\n" (symbol-name (car extra)) ": ") nil t)
+ (push (cons (car extra) (nnheader-header-value))
+ out))
+ (pop extra))
+ out))))
(when (equal id ref)
(setq ref nil))
number headers header)
(save-excursion
(set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (while (search-forward "\r" nil t)
+ (replace-match " " t t))
;; Allow the user to mangle the headers before parsing them.
(gnus-run-hooks 'gnus-parse-headers-hook)
(goto-char (point-min))
(save-restriction
(nnheader-narrow-to-headers)
(goto-char (point-min))
- (when (or (and (eq (downcase (following-char)) ?x)
+ (when (or (and (eq (downcase (char-after)) ?x)
(looking-at "Xref:"))
(search-forward "\nXref:" nil t))
(goto-char (1+ (match-end 0)))
(let* ((line (and (numberp old-header) old-header))
(old-header (and (vectorp old-header) old-header))
(header (cond ((and old-header use-old-header)
- old-header)
- ((and (numberp id)
- (gnus-number-to-header id))
- (gnus-number-to-header id))
- (t
- (gnus-read-header id))))
- (number (and (numberp id) id))
- d)
+ old-header)
+ ((and (numberp id)
+ (gnus-number-to-header id))
+ (gnus-number-to-header id))
+ (t
+ (gnus-read-header id))))
+ (number (and (numberp id) id))
+ d)
(when header
;; Rebuild the thread that this article is part of and go to the
;; article we have fetched.
;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu.
(let* ((top (cond ((< (window-height) 4) 0)
((< (window-height) 7) 1)
- (t 2)))
+ (t (if (numberp gnus-auto-center-summary)
+ gnus-auto-center-summary
+ 2))))
(height (1- (window-height)))
(bottom (save-excursion (goto-char (point-max))
(forward-line (- height))
(when (gnus-buffer-live-p gnus-article-buffer)
(save-excursion
(set-buffer gnus-article-buffer)
- (mapcar 'mm-destroy-part gnus-article-mime-handles)))
+ (mm-destroy-parts gnus-article-mime-handles)))
;; If we have several article buffers, we kill them at exit.
(unless gnus-single-article-buffer
(gnus-kill-buffer gnus-article-buffer)
gnus-expert-user
(gnus-y-or-n-p "Discard changes to this group and exit? "))
(gnus-async-halt-prefetch)
- (gnus-run-hooks 'gnus-summary-prepare-exit-hook)
+ (gnus-run-hooks (delq 'gnus-summary-expire-articles
+ (copy-list gnus-summary-prepare-exit-hook)))
(when (gnus-buffer-live-p gnus-article-buffer)
(save-excursion
(set-buffer gnus-article-buffer)
- (mapcar 'mm-destroy-part gnus-article-mime-handles)))
+ (mm-destroy-parts gnus-article-mime-handles)))
;; If we have several article buffers, we kill them at exit.
(unless gnus-single-article-buffer
(gnus-kill-buffer gnus-article-buffer)
(gnus-summary-display-article (gnus-summary-article-number)))
(gnus-summary-position-point)))
+(defun gnus-summary-first-unread-subject ()
+ "Place the point on the subject line of the first unread article.
+Return nil if there are no unread articles."
+ (interactive)
+ (prog1
+ (when (gnus-summary-first-subject t)
+ (gnus-summary-show-thread)
+ (gnus-summary-first-subject t))
+ (gnus-summary-position-point)))
+
(defun gnus-summary-first-article ()
"Select the first article.
Return nil if there are no articles."
(interactive)
(prog1
(when (gnus-summary-first-subject)
- (gnus-summary-show-thread)
- (gnus-summary-first-subject)
- (gnus-summary-display-article (gnus-summary-article-number)))
+ (gnus-summary-show-thread)
+ (gnus-summary-first-subject)
+ (gnus-summary-display-article (gnus-summary-article-number)))
(gnus-summary-position-point)))
(defun gnus-summary-best-unread-article ()
;; We have to require this here to make sure that the following
;; dynamic binding isn't shadowed by autoloading.
(require 'gnus-async)
+ (require 'gnus-art)
(let ((gnus-select-article-hook nil) ;Disable hook.
(gnus-article-display-hook nil)
(gnus-mark-article-hook nil) ;Inhibit marking as read.
(gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay.
(gnus-use-trees nil) ;Inhibit updating tree buffer.
(sum (current-buffer))
+ (gnus-display-mime-function nil)
(found nil)
- point gnus-display-mime-function)
+ point)
(gnus-save-hidden-threads
(gnus-summary-select-article)
(set-buffer gnus-article-buffer)
The difference between N and the actual number of articles marked is
returned."
(interactive "p")
+ (gnus-summary-show-thread)
(let ((backward (< n 0))
(gnus-summary-goto-unread
(and gnus-summary-goto-unread
(let ((forward (cdr (assq type gnus-summary-mark-positions)))
(buffer-read-only nil))
(re-search-backward "[\n\r]" (gnus-point-at-bol) 'move-to-limit)
- (when (looking-at "\r")
- (incf forward))
- (when (and forward
- (<= (+ forward (point)) (point-max)))
- ;; Go to the right position on the line.
- (goto-char (+ forward (point)))
- ;; Replace the old mark with the new mark.
- (subst-char-in-region (point) (1+ (point)) (following-char) mark)
- ;; Optionally update the marks by some user rule.
- (when (eq type 'unread)
- (gnus-data-set-mark
- (gnus-data-find (gnus-summary-article-number)) mark)
- (gnus-summary-update-line (eq mark gnus-unread-mark))))))
+ (when forward
+ (when (looking-at "\r")
+ (incf forward))
+ (when (<= (+ forward (point)) (point-max))
+ ;; Go to the right position on the line.
+ (goto-char (+ forward (point)))
+ ;; Replace the old mark with the new mark.
+ (subst-char-in-region (point) (1+ (point)) (char-after) mark)
+ ;; Optionally update the marks by some user rule.
+ (when (eq type 'unread)
+ (gnus-data-set-mark
+ (gnus-data-find (gnus-summary-article-number)) mark)
+ (gnus-summary-update-line (eq mark gnus-unread-mark)))))))
(defun gnus-mark-article-as-read (article &optional mark)
"Enter ARTICLE in the pertinent lists and remove it from others."
(defun gnus-valid-move-group-p (group)
(and (boundp group)
(symbol-name group)
+ (symbol-value group)
(memq 'respool
(assoc (symbol-name
(car (gnus-find-method-for-group
(setq unread (cdr unread)))
(when (<= prev (cdr active))
(push (cons prev (cdr active)) read))
+ (setq read (if (> (length read) 1) (nreverse read) read))
(if compute
- (if (> (length read) 1) (nreverse read) read)
+ read
(save-excursion
(set-buffer gnus-group-buffer)
(gnus-undo-register
(gnus-get-unread-articles-in-group ',info (gnus-active ,group))
(gnus-group-update-group ,group t))))
;; Enter this list into the group info.
- (gnus-info-set-read
- info (if (> (length read) 1) (nreverse read) read))
+ (gnus-info-set-read info read)
;; Set the number of unread articles in gnus-newsrc-hashtb.
(gnus-get-unread-articles-in-group info (gnus-active group))
t))))
projects / elisp / gnus.git- / blobdiff