;;; gnus-sum.el --- summary mode commands for Semi-gnus
-;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
(require 'gnus-util)
(require 'mime-view)
+;; Avoid byte-compile warnings.
+(eval-when-compile
+ (defvar gnus-article-decoded-p)
+ (defvar gnus-decode-encoded-word-function)
+ )
+
(autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t)
(autoload 'gnus-set-summary-default-charset "gnus-i18n" nil 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
(cons :value ("" "") regexp (repeat string))
(sexp :value nil))))
-(defcustom gnus-unread-mark ?
+(defcustom gnus-unread-mark ? ;Whitespace
"*Mark used for unread articles."
:group 'gnus-summary-marks
:type 'character)
:group 'gnus-summary-marks
:type 'character)
-(defcustom gnus-empty-thread-mark ?
+(defcustom gnus-empty-thread-mark ? ;Whitespace
"*There is no thread under the article."
:group 'gnus-summary-marks
:type 'character)
:group 'gnus-extract-view
:type 'boolean)
+(defcustom gnus-auto-expirable-marks
+ (list gnus-killed-mark gnus-del-mark gnus-catchup-mark
+ gnus-low-score-mark gnus-ancient-mark gnus-read-mark
+ gnus-souped-mark gnus-duplicate-mark)
+ "*The list of marks converted into expiration if a group is auto-expirable."
+ :group 'gnus-summary
+ :type '(repeat character))
+
+(defcustom gnus-inhibit-user-auto-expire t
+ "*If non-nil, user marking commands will not mark an article as expirable, even if the group has auto-expire turned on."
+ :group 'gnus-summary
+ :type 'boolean)
+
(defcustom gnus-view-pseudos nil
"*If `automatic', pseudo-articles will be viewed automatically.
If `not-confirm', pseudos will be viewed automatically, and the user
:group 'gnus-summary-visual
:type 'hook)
-(defcustom gnus-structured-field-decoder
- #'eword-decode-and-unfold-structured-field
- "Function to decode non-ASCII characters in structured field for summary."
- :group 'gnus-various
- :type 'function)
-
-(defcustom gnus-unstructured-field-decoder
- (function
- (lambda (string)
- (eword-decode-unstructured-field-body
- (std11-unfold-string string) 'must-unfold)
- ))
- "Function to decode non-ASCII characters in unstructured field for summary."
- :group 'gnus-various
- :type 'function)
-
-(defcustom gnus-parse-headers-hook
- '(gnus-set-summary-default-charset)
+(defcustom gnus-parse-headers-hook '(gnus-set-summary-default-charset)
"*A hook called before parsing the headers."
:group 'gnus-various
:type 'hook)
The function is called with one parameter, the article header vector,
which it may alter in any way.")
+(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)
+
+(defcustom gnus-group-charset-alist
+ '(("^hk\\>\\|^tw\\>\\|\\<big5\\>" cn-big5)
+ ("^cn\\>\\|\\<chinese\\>" cn-gb-2312)
+ ("^fj\\>\\|^japan\\>" iso-2022-jp-2)
+ ("^relcom\\>" koi8-r)
+ (".*" iso-8859-1))
+ "Alist of regexps (to match group names) and default charsets to be used."
+ :type '(repeat (list (regexp :tag "Group")
+ (symbol :tag "Charset")))
+ :group 'gnus-charset)
+
;;; Internal variables
(defvar gnus-scores-exclude-files nil)
(defvar gnus-page-broken nil)
+(defvar gnus-inhibit-mime-unbuttonizing nil)
(defvar gnus-original-article nil)
(defvar gnus-article-internal-prepare-hook nil)
(?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s)
(?s gnus-tmp-subject-or-nil ?s)
(?n gnus-tmp-name ?s)
- (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from)))
- ?s)
- (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from))
+ (?A (std11-address-string
+ (car (mime-read-field 'From gnus-tmp-header))) ?s)
+ (?a (or (std11-full-name-string
+ (car (mime-read-field 'From gnus-tmp-header)))
gnus-tmp-from) ?s)
(?F gnus-tmp-from ?s)
(?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s)
(?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)
(defvar gnus-have-all-headers nil)
(defvar gnus-last-article nil)
(defvar gnus-newsgroup-history nil)
+(defvar gnus-newsgroup-charset nil)
(defconst gnus-summary-local-variables
'(gnus-newsgroup-name
(gnus-newsgroup-expunged-tally . 0)
gnus-cache-removable-articles gnus-newsgroup-cached
gnus-newsgroup-data gnus-newsgroup-data-reverse
- gnus-newsgroup-limit gnus-newsgroup-limits)
+ gnus-newsgroup-limit gnus-newsgroup-limits
+ gnus-newsgroup-charset)
"Variables that are buffer-local to the summary buffers.")
;; Byte-compiler warning.
(defvar gnus-article-mode-map)
-;; 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.")
-
-(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))
-
;; Subject simplification.
(defun gnus-simplify-whitespace (str)
"\C-d" gnus-summary-enter-digest-group
"\M-\C-d" gnus-summary-read-document
"\M-\C-e" gnus-summary-edit-parameters
+ "\M-\C-g" gnus-summary-customize-parameters
"\C-c\C-b" gnus-bug
"*" gnus-cache-enter-article
"\M-*" gnus-cache-remove-article
"o" gnus-article-treat-overstrike
"e" gnus-article-emphasize
"w" gnus-article-fill-cited-article
+ "Q" gnus-article-fill-long-lines
"c" gnus-article-remove-cr
"f" gnus-article-display-x-face
"l" gnus-summary-stop-page-breaking
"m" gnus-article-strip-multiple-blank-lines
"a" gnus-article-strip-blank-lines
"A" gnus-article-strip-all-blank-lines
- "s" gnus-article-strip-leading-space)
+ "s" gnus-article-strip-leading-space
+ "e" gnus-article-strip-trailing-space)
(gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map)
"v" gnus-version
"h" gnus-summary-save-article-folder
"v" gnus-summary-save-article-vm
"p" gnus-summary-pipe-output
- "s" gnus-soup-add-article))
+ "s" gnus-soup-add-article)
+
+ (gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map)
+ "b" gnus-summary-display-buttonized
+ "m" gnus-summary-repair-multipart
+ "v" gnus-article-view-part
+ "o" gnus-article-save-part
+ "c" gnus-article-copy-part
+ "e" gnus-article-externalize-part
+ "|" gnus-article-pipe-part)
+ )
(defun gnus-summary-make-menu-bar ()
(gnus-turn-off-edit-menu 'summary)
["Trailing" gnus-article-remove-trailing-blank-lines t]
["All of the above" gnus-article-strip-blank-lines t]
["All" gnus-article-strip-all-blank-lines t]
- ["Leading space" gnus-article-strip-leading-space t])
+ ["Leading space" gnus-article-strip-leading-space t]
+ ["Trailing space" gnus-article-strip-trailing-space t])
["Overstrike" gnus-article-treat-overstrike t]
["Dumb quotes" gnus-article-treat-dumbquotes t]
["Emphasis" gnus-article-emphasize t]
["Word wrap" gnus-article-fill-cited-article t]
+ ["Fill long lines" gnus-article-fill-long-lines t]
["CR" gnus-article-remove-cr t]
["Show X-Face" gnus-article-display-x-face t]
["UnHTMLize" gnus-article-treat-html t]
["Edit local kill file" gnus-summary-edit-local-kill t]
["Edit main kill file" gnus-summary-edit-global-kill t]
["Edit group parameters" gnus-summary-edit-parameters t]
+ ["Customize group parameters" gnus-summary-customize-parameters t]
["Send a bug report" gnus-bug t]
("Exit"
["Catchup and exit" gnus-summary-catchup-and-exit 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" <)
(make-local-variable 'gnus-summary-dummy-line-format)
(make-local-variable 'gnus-summary-dummy-line-format-spec)
(make-local-variable 'gnus-summary-mark-positions)
- (make-local-hook 'post-command-hook)
- (add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
(make-local-hook 'pre-command-hook)
(add-hook 'pre-command-hook 'gnus-set-global-variables nil t)
(gnus-run-hooks 'gnus-summary-mode-hook)
(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.
(original gnus-original-article-buffer)
(gac gnus-article-current)
(reffed gnus-reffed-article-number)
- (score-file gnus-current-score-file))
+ (score-file gnus-current-score-file)
+ (default-charset gnus-newsgroup-charset))
(save-excursion
(set-buffer gnus-group-buffer)
(setq gnus-newsgroup-name name
gnus-article-buffer article-buffer
gnus-original-article-buffer original
gnus-reffed-article-number reffed
- gnus-current-score-file score-file)
+ gnus-current-score-file score-file
+ gnus-newsgroup-charset default-charset)
;; The article buffer also has local variables.
(when (gnus-buffer-live-p gnus-article-buffer)
(set-buffer gnus-article-buffer)
(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. :-)
+ ;; All non-existent numbers are the last article. :-)
+ t
(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)
+ (make-full-mail-header 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))))
+ (mail-parse-charset gnus-newsgroup-charset))
+ (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
(if (or (null gnus-summary-default-score)
(<= (abs (- gnus-tmp-score gnus-summary-default-score))
gnus-summary-zcore-fuzz))
- ?
+ ? ;Whitespace
(if (< gnus-tmp-score gnus-summary-default-score)
gnus-score-below-mark gnus-score-over-mark)))
(gnus-tmp-replied
(setq gnus-tmp-name gnus-tmp-from))
(unless (numberp gnus-tmp-lines)
(setq gnus-tmp-lines 0))
- (gnus-put-text-property
+ (gnus-put-text-property-excluding-characters-with-faces
(point)
(progn (eval gnus-summary-line-format-spec) (point))
'gnus-number gnus-tmp-number)
(if (or (null gnus-summary-default-score)
(<= (abs (- score gnus-summary-default-score))
gnus-summary-zcore-fuzz))
- ?
+ ? ;Whitespace
(if (< score gnus-summary-default-score)
gnus-score-below-mark gnus-score-over-mark))
'score))
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)
(let ((eol (gnus-point-at-eol))
(buffer (current-buffer))
- header rawtext decoded)
+ header)
;; overview: [num subject from date id refs chars lines misc]
(unwind-protect
(setq header
(make-full-mail-header
number ; number
- (progn
- (setq rawtext (gnus-nov-field) ; subject
- decoded (funcall
- gnus-unstructured-field-decoder rawtext))
- (if (string= rawtext decoded)
- rawtext
- (put-text-property 0 (length decoded) 'raw-text rawtext decoded)
- decoded))
- (progn
- (setq rawtext (gnus-nov-field) ; from
- decoded (funcall
- gnus-structured-field-decoder rawtext))
- (if (string= rawtext decoded)
- rawtext
- (put-text-property 0 (length decoded) 'raw-text rawtext decoded)
- decoded))
+ (gnus-nov-field) ; subject
+ (gnus-nov-field) ; from
(gnus-nov-field) ; date
(or (gnus-nov-field)
(nnheader-generate-fake-message-id)) ; id
(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))
(defsubst gnus-article-sort-by-author (h1 h2)
"Sort articles by root author."
(string-lessp
- (let ((extract (funcall
- gnus-extract-address-components
- (mail-header-from h1))))
- (or (car extract) (cadr extract) ""))
- (let ((extract (funcall
- gnus-extract-address-components
- (mail-header-from h2))))
- (or (car extract) (cadr extract) ""))))
+ (let ((addr (mime-read-field 'From h1)))
+ (or (std11-full-name-string addr)
+ (std11-address-string addr)
+ ""))
+ (let ((addr (mime-read-field 'From h2)))
+ (or (std11-full-name-string addr)
+ (std11-address-string addr)
+ ""))
+ ))
(defun gnus-thread-sort-by-author (h1 h2)
"Sort threads by root author."
(> (gnus-thread-total-score h1) (gnus-thread-total-score h2)))
(defun gnus-thread-total-score (thread)
- ;; This function find the total score of THREAD.
+ ;; This function find the total score of THREAD.
(cond ((null thread)
0)
((consp thread)
(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 ...]...) ...])'
(if (or (null gnus-summary-default-score)
(<= (abs (- gnus-tmp-score gnus-summary-default-score))
gnus-summary-zcore-fuzz))
- ?
+ ? ;Whitespace
(if (< gnus-tmp-score gnus-summary-default-score)
gnus-score-below-mark gnus-score-over-mark))
gnus-tmp-replied
(setq gnus-newsgroup-name group)
(setq gnus-newsgroup-unselected nil)
(setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
+ (gnus-summary-setup-default-charset)
;; Adjust and set lists of article marks.
(when info
;; Retrieve the headers and read them in.
(gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name)
(setq gnus-newsgroup-headers
- (if (eq 'nov
- (setq gnus-headers-retrieved-by
- (gnus-retrieve-headers
- articles gnus-newsgroup-name
- ;; We might want to fetch old headers, but
- ;; not if there is only 1 article.
- (and (or (and
- (not (eq gnus-fetch-old-headers 'some))
- (not (numberp gnus-fetch-old-headers)))
- (> (length articles) 1))
- gnus-fetch-old-headers))))
- (gnus-get-newsgroup-headers-xover
- articles nil nil gnus-newsgroup-name t)
- (gnus-get-newsgroup-headers)))
+ (gnus-retrieve-parsed-headers
+ articles gnus-newsgroup-name
+ ;; We might want to fetch old headers, but
+ ;; not if there is only 1 article.
+ (and (or (and (not (eq gnus-fetch-old-headers 'some))
+ (not (numberp gnus-fetch-old-headers)))
+ (> (length articles) 1))
+ gnus-fetch-old-headers)))
(gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name)
;; Kludge to avoid having cached articles nixed out in virtual groups.
out))
(defun gnus-adjust-marked-articles (info)
- "Set all article lists and remove all marks that are no longer legal."
+ "Set all article lists and remove all marks that are no longer valid."
(let* ((marked-lists (gnus-info-marks info))
(active (gnus-active (gnus-info-group info)))
(min (car active))
(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))
(setq arts (cdr arts)))
(setq list (cdr all))))
+ (when (gnus-check-backend-function 'request-set-mark
+ gnus-newsgroup-name)
+ ;; score & bookmark are not proper flags (they are cons cells)
+ ;; cache is a internal gnus flag
+ (unless (memq (cdr type) '(cache score bookmark))
+ (let* ((old (cdr (assq (cdr type) (gnus-info-marks info))))
+ (del (gnus-remove-from-range old list))
+ (add (gnus-remove-from-range list old)))
+ (if add
+ (push (list add 'add (list (cdr type))) delta-marks))
+ (if del
+ (push (list del 'del (list (cdr type))) delta-marks)))))
+
(push (cons (cdr type)
(if (memq (cdr type) uncompressed) list
(gnus-compress-sequence
(set symbol (sort list '<)) t)))
newmarked)))
+ (if delta-marks
+ (gnus-request-set-mark gnus-newsgroup-name delta-marks))
+
;; Enter these new marks into the info of the group.
(if (nthcdr 3 info)
(setcar (nthcdr 3 info) newmarked)
"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
(active (gnus-active group))
ninfo)
(when entry
- ;; First peel off all illegal article numbers.
+ ;; First peel off all invalid article numbers.
(when active
(let ((ids articles)
id first)
(or dependencies
(save-excursion (set-buffer gnus-summary-buffer)
gnus-newsgroup-dependencies)))
- headers id end ref)
+ headers id end ref
+ (mail-parse-charset gnus-newsgroup-charset))
(save-excursion
(set-buffer nntp-server-buffer)
;; Translate all TAB characters into SPACE characters.
(subst-char-in-region (point-min) (point-max) ?\t ? t)
+ (subst-char-in-region (point-min) (point-max) ?\r ? t)
(gnus-run-hooks 'gnus-parse-headers-hook)
(let ((case-fold-search t)
- rawtext decoded
- in-reply-to header p lines chars)
+ in-reply-to header p lines chars ctype)
(goto-char (point-min))
;; Search to the beginning of the next header. Error messages
;; do not begin with 2 or 3.
;; doesn't always go hand in hand.
(setq
header
- (vector
+ (make-full-mail-header
;; Number.
(prog1
(read cur)
(progn
(goto-char p)
(if (search-forward "\nsubject: " nil t)
- (progn
- (setq rawtext (nnheader-header-value)
- decoded (funcall
- gnus-unstructured-field-decoder rawtext))
- (if (string-equal rawtext decoded)
- rawtext
- (put-text-property 0 (length decoded) 'raw-text rawtext decoded)
- decoded))
+ (buffer-substring (match-end 0) (std11-field-end))
"(none)"))
;; From.
(progn
(goto-char p)
(if (search-forward "\nfrom: " nil t)
- (progn
- (setq rawtext (nnheader-header-value)
- decoded (funcall
- gnus-structured-field-decoder rawtext))
- (if (string-equal rawtext decoded)
- rawtext
- (put-text-property 0 (length decoded) 'raw-text rawtext decoded)
- decoded))
+ (buffer-substring (match-end 0) (std11-field-end))
"(nobody)"))
;; Date.
(progn
(goto-char p)
(if (search-forward "\ndate: " nil t)
- (nnheader-header-value) ""))
+ (buffer-substring (match-end 0) (std11-field-end))
+ ""))
;; Message-ID.
(progn
(goto-char p)
(progn
(setq end (point))
(prog1
- (nnheader-header-value)
+ (buffer-substring (match-end 0) (std11-field-end))
(setq ref
(buffer-substring
(progn
- (end-of-line)
+ ;; (end-of-line)
(search-backward ">" end t)
(1+ (point)))
(progn
;; were no references and the in-reply-to header looks
;; promising.
(if (and (search-forward "\nin-reply-to: " nil t)
- (setq in-reply-to (nnheader-header-value))
+ (setq in-reply-to
+ (buffer-substring (match-end 0)
+ (std11-field-end)))
(string-match "<[^>]+>" in-reply-to))
(let (ref2)
(setq ref (substring in-reply-to (match-beginning 0)
(progn
(goto-char p)
(and (search-forward "\nxref: " nil t)
- (nnheader-header-value)))))
+ (buffer-substring (match-end 0) (std11-field-end))))
+ ;; 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)
+ (buffer-substring (match-end 0)
+ (std11-field-end)))
+ out))
+ (pop extra))
+ out))))
+ (goto-char p)
+ (if (and (search-forward "\ncontent-type: " nil t)
+ (setq ctype
+ (buffer-substring (match-end 0) (std11-field-end))))
+ (mime-entity-set-content-type-internal
+ header (mime-parse-Content-Type ctype)))
(when (equal id ref)
(setq ref nil))
;; Get the Xref when the users reads the articles since most/some
;; NNTP servers do not include Xrefs when using XOVER.
(setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
- (let ((cur nntp-server-buffer)
+ (let ((mail-parse-charset gnus-newsgroup-charset)
+ (cur nntp-server-buffer)
(dependencies (or dependencies gnus-newsgroup-dependencies))
number headers header)
(save-excursion
(set-buffer nntp-server-buffer)
+ (subst-char-in-region (point-min) (point-max) ?\r ? 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))
(mode major-mode)
(group-point nil)
(buf (current-buffer)))
+ (unless quit-config
+ ;; Do adaptive scoring, and possibly save score files.
+ (when gnus-newsgroup-adaptive
+ (gnus-score-adaptive))
+ (when gnus-use-scoring
+ (gnus-score-save)))
(gnus-run-hooks 'gnus-summary-prepare-exit-hook)
;; If we have several article buffers, we kill them at exit.
(unless gnus-single-article-buffer
;; Make all changes in this group permanent.
(unless quit-config
(gnus-run-hooks 'gnus-exit-group-hook)
- (gnus-summary-update-info)
- ;; Do adaptive scoring, and possibly save score files.
- (when gnus-newsgroup-adaptive
- (gnus-score-adaptive))
- (when gnus-use-scoring
- (gnus-score-save)))
+ (gnus-summary-update-info))
(gnus-close-group group)
;; Make sure where we were, and go to next newsgroup.
(set-buffer gnus-group-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)
+ (mapcar 'funcall
+ (delq 'gnus-summary-expire-articles
+ (copy-list gnus-summary-prepare-exit-hook)))
;; If we have several article buffers, we kill them at exit.
(unless gnus-single-article-buffer
(gnus-kill-buffer gnus-article-buffer)
(gnus-summary-recenter)
(gnus-summary-position-point))))
-(defun gnus-summary-preview-mime-message (arg)
+(defun gnus-summary-preview-mime-message ()
"MIME decode and play this message."
- (interactive "P")
- (or gnus-show-mime
- (let ((gnus-break-pages nil)
- (gnus-show-mime t))
- (gnus-summary-select-article t t)
- ))
- (select-window (get-buffer-window gnus-article-buffer))
- )
+ (interactive)
+ (let ((gnus-break-pages nil)
+ (gnus-show-mime t))
+ (gnus-summary-select-article gnus-show-all-headers t))
+ (select-window (get-buffer-window gnus-article-buffer)))
;;; Dead summaries.
(defun gnus-summary-describe-briefly ()
"Describe summary mode commands briefly."
(interactive)
- (gnus-message 6
- (substitute-command-keys "\\<gnus-summary-mode-map>\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help")))
+ (gnus-message 6 (substitute-command-keys "\\<gnus-summary-mode-map>\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help")))
;; Walking around group mode buffer from summary mode.
;; The requested article is different from the current article.
(prog1
(gnus-summary-display-article article all-headers)
- (setq did article))
+ (setq did article)
+ (when (or all-headers gnus-show-all-headers)
+ (gnus-article-show-all-headers)))
(when (or all-headers gnus-show-all-headers)
(gnus-article-show-all-headers))
'old))
(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 ()
(interactive)
(gnus-group-edit-group gnus-newsgroup-name 'params))
+(defun gnus-summary-customize-parameters ()
+ "Customize the group parameters of the current group."
+ (interactive)
+ (gnus-group-customize gnus-newsgroup-name))
+
(defun gnus-summary-enter-digest-group (&optional force)
"Enter an nndoc group based on the current article.
If FORCE, force a digest interpretation. If not, try
;; 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.
(if (not arg)
;; Select the article the normal way.
(gnus-summary-select-article nil 'force)
+ ;; 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)
;; Bind the article treatment functions to nil.
(let ((gnus-have-all-headers t)
gnus-article-display-hook
(insert-buffer-substring gnus-original-article-buffer 1 e)
(let ((article-inhibit-hiding t))
(gnus-run-hooks 'gnus-article-display-hook))
- (when (or (not hidden) (and (numberp arg) (< arg 0)))
- (gnus-article-hide-headers)))))
+ (if (or (not hidden) (and (numberp arg) (< arg 0)))
+ (let ((gnus-treat-hide-headers nil)
+ (gnus-treat-hide-boring-headers nil))
+ (gnus-treat-article 'head))
+ (gnus-treat-article 'head)))))
(defun gnus-summary-show-all-headers ()
"Make all header lines visible."
If ARG is a positive number, turn MIME processing on."
(interactive "P")
(setq gnus-show-mime
- (if (null arg) (not gnus-show-mime)
+ (if (null arg)
+ (not gnus-show-mime)
(> (prefix-numeric-value arg) 0)))
(gnus-summary-select-article t 'force))
gnus-newsgroup-name)) ; Server
(list 'gnus-request-accept-article
to-newsgroup (list 'quote select-method)
- (not articles)) ; Accept form
+ (not articles) t) ; Accept form
(not articles))) ; Only save nov last time
;; Copy the article.
((eq action 'copy)
;; Copy any marks over to the new group.
(let ((marks gnus-article-mark-lists)
(to-article (cdr art-group)))
+ (unless (gnus-group-auto-expirable-p to-group)
+ (setq marks (delete '(expirable . expire) marks)))
;; See whether the article is to be put in the cache.
(when gnus-use-cache
(defcustom gnus-summary-respool-default-method nil
"Default method for respooling an article.
If nil, use to the current newsgroup method."
- :type `(choice (gnus-select-method :value (nnml ""))
+ :type '(choice (gnus-select-method :value (nnml ""))
(const nil))
:group 'gnus-summary-mail)
;; Replace the article.
(let ((buf (current-buffer)))
(with-temp-buffer
- (insert-buffer buf)
+ (insert-buffer-substring buf)
(if (and (not read-only)
(not (gnus-request-replace-article
(cdr gnus-article-current) (car gnus-article-current)
- (current-buffer)
- (not gnus-article-decoded-p))))
+ (current-buffer))))
(error "Couldn't replace article")
;; Update the summary buffer.
(if (and references
(unless no-highlight
(save-excursion
(set-buffer gnus-article-buffer)
- (gnus-run-hooks 'gnus-article-display-hook)
+ ;;;!!! Fix this -- article should be rehighlighted.
+ ;;;(gnus-run-hooks 'gnus-article-display-hook)
(set-buffer gnus-original-article-buffer)
(gnus-request-article
(cdr gnus-article-current)
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
(setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
;; Check for auto-expiry.
(when (and gnus-newsgroup-auto-expire
- (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
- (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
- (= mark gnus-ancient-mark)
- (= mark gnus-read-mark) (= mark gnus-souped-mark)
- (= mark gnus-duplicate-mark)))
+ (memq mark gnus-auto-expirable-marks))
(setq mark gnus-expirable-mark)
;; Let the backend know about the mark change.
(setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
"Mark ARTICLE with MARK. MARK can be any character.
Four MARK strings are reserved: `? ' (unread), `?!' (ticked),
`??' (dormant) and `?E' (expirable).
-If MARK is nil, then the default character `?D' is used.
+If MARK is nil, then the default character `?r' is used.
If ARTICLE is nil, then the article on the current line will be
marked."
;; The mark might be a string.
(when (stringp mark)
(setq mark (aref mark 0)))
;; If no mark is given, then we check auto-expiring.
- (and (not no-expire)
- gnus-newsgroup-auto-expire
- (or (not mark)
- (and (gnus-characterp mark)
- (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
- (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
- (= mark gnus-read-mark) (= mark gnus-souped-mark)
- (= mark gnus-duplicate-mark))))
- (setq mark gnus-expirable-mark))
- (let* ((mark (or mark gnus-del-mark))
- (article (or article (gnus-summary-article-number)))
- (old-mark (gnus-summary-article-mark article)))
+ (when (null mark)
+ (setq mark gnus-del-mark))
+ (when (and (not no-expire)
+ gnus-newsgroup-auto-expire
+ (memq mark gnus-auto-expirable-marks))
+ (setq mark gnus-expirable-mark))
+ (let ((article (or article (gnus-summary-article-number)))
+ (old-mark (gnus-summary-article-mark article)))
;; Allow the backend to change the mark.
(setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
(if (eq mark old-mark)
(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."
The difference between N and the actual number of articles marked is
returned."
(interactive "p")
- (gnus-summary-mark-forward n gnus-del-mark t))
+ (gnus-summary-mark-forward n gnus-del-mark gnus-inhibit-user-auto-expire))
(defun gnus-summary-mark-as-read-backward (n)
"Mark the N articles as read backwards.
The difference between N and the actual number of articles marked is
returned."
(interactive "p")
- (gnus-summary-mark-forward (- n) gnus-del-mark t))
+ (gnus-summary-mark-forward
+ (- n) gnus-del-mark gnus-inhibit-user-auto-expire))
(defun gnus-summary-mark-as-read (&optional article mark)
"Mark current article as read.
(gnus-summary-article-header parent-article))))
(unless (and message-id (not (equal message-id "")))
(error "No message-id in desired parent"))
- ;; We don't want the article to be marked as read.
- (let (gnus-mark-article-hook)
- (gnus-summary-select-article t t nil current-article))
- (set-buffer gnus-original-article-buffer)
- (let ((buf (format "%s" (buffer-string))))
- (with-temp-buffer
- (insert buf)
- (goto-char (point-min))
- (if (re-search-forward "^References: " nil t)
- (progn
- (re-search-forward "^[^ \t]" nil t)
- (forward-line -1)
- (end-of-line)
- (insert " " message-id))
- (insert "References: " message-id "\n"))
- (unless (gnus-request-replace-article
- current-article (car gnus-article-current)
- (current-buffer))
- (error "Couldn't replace article"))))
+ (gnus-with-article current-article
+ (goto-char (point-min))
+ (if (re-search-forward "^References: " nil t)
+ (progn
+ (re-search-forward "^[^ \t]" nil t)
+ (forward-line -1)
+ (end-of-line)
+ (insert " " message-id))
+ (insert "References: " message-id "\n")))
(set-buffer gnus-summary-buffer)
(gnus-summary-unmark-all-processable)
(gnus-summary-update-article current-article)
(let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate)))
(article (intern (format "gnus-article-sort-by-%s" predicate)))
(gnus-thread-sort-functions
- (list
- (if (not reverse)
- thread
- `(lambda (t1 t2)
- (,thread t2 t1)))))
+ (if (not reverse)
+ thread
+ `(lambda (t1 t2)
+ (,thread t2 t1))))
(gnus-article-sort-functions
- (list
- (if (not reverse)
- article
- `(lambda (t1 t2)
- (,article t2 t1)))))
+ (if (not reverse)
+ article
+ `(lambda (t1 t2)
+ (,article t2 t1))))
(buffer-read-only)
(gnus-summary-prepare-hook nil))
;; We do the sorting by regenerating the threads.
If N is nil and any articles have been marked with the process mark,
save those articles instead."
(interactive "P")
- (let ((gnus-default-article-saver 'rmail-output-to-rmail-file))
+ (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail))
(gnus-summary-save-article arg)))
(defun gnus-summary-save-article-file (&optional arg)
(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
(lambda (f)
(if (equal f " ")
f
- (mm-quote-arg f)))
+ (gnus-quote-arg-for-sh-or-csh f)))
files " ")))))
(setq ps (cdr ps)))))
(if (and gnus-view-pseudos (not not-view))
(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-info-set-read ',info ',(gnus-info-read info))
(gnus-get-unread-articles-in-group ',info (gnus-active ,group))
(gnus-group-update-group ,group t))))
+ ;; Propagate the read marks to the backend.
+ (if (gnus-check-backend-function 'request-set-mark group)
+ (let ((del (gnus-remove-from-range (gnus-info-read info) read))
+ (add (gnus-remove-from-range read (gnus-info-read info))))
+ (when (or add del)
+ (gnus-request-set-mark
+ group (delq nil (list (if add (list add 'add '(read)))
+ (if del (list del 'del '(read)))))))))
;; 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))))
;;; @ end
;;;
+(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)))
+
(gnus-ems-redefine)
(provide 'gnus-sum)
projects / elisp / gnus.git- / blobdiff