procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge from Gnus trunk.

Browse source
This commit is contained in:
Dave Love 2000-09-20 16:54:57 +00:00
parent 805b7fc074
commit 8b93df0128
10 changed files with 396 additions and 149 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

150
lisp/gnus/ChangeLog
View file

@ -1,8 +1,158 @@
2000-09-20 Dave Love <fx@gnu.org>
* mail-source.el (mail-source-delete-incoming): Set to t, assuming
we'll be careful merging development changes.
* gnus-start.el (gnus-1) <gnus-simple-splash>: Don't test for X
specifically.
* gnus-ems.el (gnus-smiley-display): Autoload from smiley-ems.
(mouse-set-point, set-face-foreground)
(set-face-background, x-popup-menu) [not window-system]: Don't zap
them.
* mm-decode.el (mm-valid-and-fit-image-p): Use display-graphic-p.
* gnus.el (gnus-version-number): Start 5.9 series. Avoid some
redundant autoloads.
2000-09-20 Gerd Moellmann <gerd@gnu.org>
* gnus-ems.el (gnus-article-display-xface): Don't convert PBM
to XBM; we always have PBM support.
2000-09-19 ShengHuo ZHU <zsh@cs.rochester.edu>
* gnus-group.el (gnus-group-make-kiboze-group): Makedir.
* nnheader.el (nnheader-parse-nov): Remove Xref in mail-header-xref.
* gnus-sum.el (gnus-nov-parse-line): Ditto.
* nnkiboze.el (nnkiboze-file-coding-system): New.
(nnkiboze-retrieve-headers): Use it.
(nnkiboze-request-group): Ditto.
(nnkiboze-close-group): Ditto.
(nnkiboze-generate-group): Ditto.
(nnkiboze-enter-nov): Insert first Xref properly.
2000-09-19 Dave Love <fx@gnu.org>
* nnmail.el (nnmail-cache-accepted-message-ids): Default to nil.
(nnmail-get-new-mail): Test `sources' in top-level conditional.
* mail-source.el (mail-sources): Change default to '((file)).
Add useful custom type.
2000-09-18 Kai Gro,A_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
* gnus-util.el (gnus-time-iso8601): Correct doc string (four digit
year).
(gnus-date-iso8601): Ditto.
2000-09-18 ShengHuo ZHU <zsh@cs.rochester.edu>
* mail-source.el (mail-source-fetch-imap): Disable multibyte.
2000-09-17 ShengHuo ZHU <zsh@cs.rochester.edu>
* rfc2047.el (rfc2047-q-encoding-alist): Remove = and _ from the
pattern. Avoid using 8 bit chars.
* qp.el (quoted-printable-encode-region): Avoid using 8 bit chars.
2000-09-16 ShengHuo ZHU <zsh@cs.rochester.edu>
* smiley.el (smiley-buffer-ems, smiley-create-glyph-ems,
smiley-toggle-extent-ems, smiley-toggle-extents-ems,
smiley-toggle-buffer-ems): New functions for Emacs 21. Toggle
functions are not implemented yet.
* dgnushack.el (dgnushack-compile): Remove smiley.el and
x-overlay.el from the FSF Emacs black list.
2000-09-15 ShengHuo ZHU <zsh@cs.rochester.edu>
* mm-decode.el (mm-inlined-types): Add application/emacs-lisp.
(mm-inline-media-tests): Ditto.
(mm-automatic-display): Ditto.
* mm-view.el (mm-display-inline-fontify): Generalize from
mm-display-patch-inline.
(mm-display-patch-inline): Use it.
(mm-display-elisp-inline): Ditto.
2000-09-15 ShengHuo ZHU <zsh@cs.rochester.edu>
* gnus-topic.el (gnus-topic-find-groups): Add recursive parameter.
(gnus-topic-unmark-topic): Ditto.
(gnus-topic-mark-topic): Ditto.
(gnus-topic-get-new-news-this-topic): Use it.
2000-09-15 09:01:40 ShengHuo ZHU <zsh@cs.rochester.edu>
* gnus-art.el (gnus-treat-display-xface): By default, Emacs 21
display xface.
2000-09-15 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-group.el (gnus-group-rename-group): Inhibit renaming of
zombie or killed groups.
2000-09-15 ShengHuo ZHU <zsh@cs.rochester.edu>
* mml.el (mml-preview): Reinsert unibyte content.
(mml-parse-1): Remove with-unibyte-current-buffer.
(mml-generate-mime-1): Ditto.
* gnus-msg.el (gnus-summary-mail-forward): Ditto.
* message.el (message-forward): Ditto.
2000-09-14 ShengHuo ZHU <zsh@cs.rochester.edu>
* gnus-art.el (article-de-quoted-unreadable): Guess charset from
original article buffer.
(article-de-base64-unreadable): Ditto.
(article-wash-html): Ditto.
2000-09-14 ShengHuo ZHU <zsh@cs.rochester.edu>
* gnus-msg.el (gnus-summary-mail-forward): Disable multibyte
unless forward-show-mml.
2000-09-14 ShengHuo ZHU <zsh@cs.rochester.edu>
* gnus-sum.el (gnus-summary-save-parts-type-history): New.
(gnus-summary-save-parts-last-directory): New.
(gnus-summary-save-parts): Save history.
2000-09-14 Ben Gertzfield <che@debian.org>
* gnus-sum.el (gnus-summary-save-parts-default-mime): New
variable.
(gnus-summary-save-parts): Use it.
2000-09-14 ShengHuo ZHU <zsh@cs.rochester.edu>
* gnus-art.el (gnus-article-setup-buffer): Clean handle-alist.
* gnus-sum.el (gnus-summary-exit): Ditto.
(gnus-summary-exit-no-update): Ditto.
(gnus-summary-show-article): Ditto.
2000-09-14 ShengHuo ZHU <zsh@cs.rochester.edu>
* nndoc.el (nndoc-dissect-mime-parts-sub): Remove
Content-Disposition.
2000-09-14 ShengHuo ZHU <zsh@cs.rochester.edu>
* webmail.el: Hotmail updated. Add X-Gnus-Webmail.
2000-09-14 ShengHuo ZHU <zsh@cs.rochester.edu>
* gnus-art.el (gnus-article-setup-buffer): Set
gnus-article-mime-handles to nil.
* gnus-sum.el (gnus-summary-exit): Ditto.
(gnus-summary-exit-no-update): Ditto.
(gnus-summary-show-article): Ditto.
(gnus-summary-save-parts): Use gnus-article-mime-handles if
dissected.
* mm-partial.el (mm-partial-find-parts): Remove redundancy.
2000-09-14 Dave Love <fx@gnu.org>
* gnus.el (gnus-charset):

57
lisp/gnus/gnus-art.el
View file

@ -871,8 +871,11 @@ See the manual for details."
:type gnus-article-treat-custom)
(put 'gnus-treat-overstrike 'highlight t)
(defcustom gnus-treat-display-xface (if (and gnus-xemacs (featurep 'xface))
'head nil)
(defcustom gnus-treat-display-xface
(and (or (and (fboundp 'image-type-available-p)
(image-type-available-p 'xbm))
(and gnus-xemacs (featurep 'xface)))
'head)
"Display X-Face headers.
Valid values are nil, t, `head', `last', an integer or a predicate.
See the manual for details."
@ -1510,9 +1513,21 @@ If FORCE, decode the article whether it is marked as quoted-printable
or not."
(interactive (list 'force))
(save-excursion
(let ((buffer-read-only nil)
(type (gnus-fetch-field "content-transfer-encoding"))
(charset gnus-newsgroup-charset))
(let ((buffer-read-only nil) type charset)
(if (gnus-buffer-live-p gnus-original-article-buffer)
(with-current-buffer gnus-original-article-buffer
(setq type
(gnus-fetch-field "content-transfer-encoding"))
(let* ((ct (gnus-fetch-field "content-type"))
(ctl (and ct
(ignore-errors
(mail-header-parse-content-type ct)))))
(setq charset (and ctl
(mail-content-type-get ctl 'charset)))
(if (stringp charset)
(setq charset (intern (downcase charset)))))))
(unless charset
(setq charset gnus-newsgroup-charset))
(when (or force
(and type (string-match "quoted-printable" (downcase type))))
(article-goto-body)
@ -1523,9 +1538,21 @@ or not."
If FORCE, decode the article whether it is marked as base64 not."
(interactive (list 'force))
(save-excursion
(let ((buffer-read-only nil)
(type (gnus-fetch-field "content-transfer-encoding"))
(charset gnus-newsgroup-charset))
(let ((buffer-read-only nil) type charset)
(if (gnus-buffer-live-p gnus-original-article-buffer)
(with-current-buffer gnus-original-article-buffer
(setq type
(gnus-fetch-field "content-transfer-encoding"))
(let* ((ct (gnus-fetch-field "content-type"))
(ctl (and ct
(ignore-errors
(mail-header-parse-content-type ct)))))
(setq charset (and ctl
(mail-content-type-get ctl 'charset)))
(if (stringp charset)
(setq charset (intern (downcase charset)))))))
(unless charset
(setq charset gnus-newsgroup-charset))
(when (or force
(and type (string-match "base64" (downcase type))))
(article-goto-body)
@ -1551,7 +1578,19 @@ If FORCE, decode the article whether it is marked as base64 not."
(interactive)
(save-excursion
(let ((buffer-read-only nil)
(charset gnus-newsgroup-charset))
charset)
(if (gnus-buffer-live-p gnus-original-article-buffer)
(with-current-buffer gnus-original-article-buffer
(let* ((ct (gnus-fetch-field "content-type"))
(ctl (and ct
(ignore-errors
(mail-header-parse-content-type ct)))))
(setq charset (and ctl
(mail-content-type-get ctl 'charset)))
(if (stringp charset)
(setq charset (intern (downcase charset)))))))
(unless charset
(setq charset gnus-newsgroup-charset))
(article-goto-body)
(save-window-excursion
(save-restriction

16
lisp/gnus/gnus-group.el
View file

@ -2046,10 +2046,12 @@ and NEW-NAME will be prompted for."
(gnus-message 6 "Renaming group %s to %s..." group new-name)
(prog1
(if (not (gnus-request-rename-group group new-name))
(if (progn
(gnus-group-goto-group group)
(not (when (< (gnus-group-group-level) gnus-level-zombie)
(gnus-request-rename-group group new-name))))
(gnus-error 3 "Couldn't rename group %s to %s" group new-name)
;; We rename the group internally by killing it...
(gnus-group-goto-group group)
(gnus-group-kill-group)
;; ... changing its name ...
(setcar (cdar gnus-list-of-killed-groups) new-name)
@ -2335,9 +2337,13 @@ score file entries for articles to include in the group."
(push (cons header regexps) scores))
scores)))
(gnus-group-make-group group "nnkiboze" address)
(with-temp-file (gnus-score-file-name (concat "nnkiboze:" group))
(let (emacs-lisp-mode-hook)
(pp scores (current-buffer)))))
(let* ((score-file (gnus-score-file-name (concat "nnkiboze:" group)))
(score-dir (file-name-directory score-file)))
(unless (file-exists-p score-dir)
(make-directory score-dir))
(with-temp-file score-file
(let (emacs-lisp-mode-hook)
(pp scores (current-buffer))))))
(defun gnus-group-add-to-virtual (n vgroup)
"Add the current group to a virtual group."

7
lisp/gnus/gnus-msg.el
View file

@ -723,19 +723,18 @@ If POST, post instead of mail."
text)
(save-excursion
(set-buffer gnus-original-article-buffer)
(mm-with-unibyte-current-buffer
(setq text (buffer-string))))
(setq text (buffer-string)))
(set-buffer
(gnus-get-buffer-create
(generate-new-buffer-name " *Gnus forward*")))
(erase-buffer)
(mm-disable-multibyte)
(unless message-forward-show-mml
(mm-disable-multibyte))
(insert text)
(goto-char (point-min))
(when (looking-at "From ")
(replace-match "X-From-Line: ") )
(when message-forward-show-mml
(mm-enable-multibyte)
(mime-to-mml))
(message-forward post)))))

25
lisp/gnus/gnus-sum.el
View file

@ -885,6 +885,14 @@ For example: ((1 . cn-gb-2312) (2 . big5))."
:type '(choice (const nil)
integer))
(defcustom gnus-summary-save-parts-default-mime "image/.*"
"*A regexp to match MIME parts when saving multiple parts of a message
with gnus-summary-save-parts (X m). This regexp will be used by default
when prompting the user for which type of files to save."
:group 'gnus-summary
:type 'regexp)
;;; Internal variables
(defvar gnus-article-mime-handles nil)
@ -902,6 +910,9 @@ For example: ((1 . cn-gb-2312) (2 . big5))."
(defvar gnus-sort-gathered-threads-function 'gnus-thread-sort-by-number
"Function called to sort the articles within a thread after it has been gathered together.")
(defvar gnus-summary-save-parts-type-history nil)
(defvar gnus-summary-save-parts-last-directory nil)
;; Avoid highlighting in kill files.
(defvar gnus-summary-inhibit-highlight nil)
(defvar gnus-newsgroup-selected-overlay nil)
@ -3300,7 +3311,9 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise."
(nnheader-nov-read-integer) ; chars
(nnheader-nov-read-integer) ; lines
(unless (eobp)
(nnheader-nov-field)) ; misc
(if (looking-at "Xref: ")
(goto-char (match-end 0)))
(nnheader-nov-field)) ; Xref
(nnheader-nov-parse-extra)))) ; extra
(widen))
@ -9195,8 +9208,14 @@ save those articles instead."
"Save parts matching TYPE to DIR.
If REVERSE, save parts that do not match TYPE."
(interactive
(list (read-string "Save parts of type: " "image/.*")
(read-file-name "Save to directory: " nil nil t)
(list (read-string "Save parts of type: "
(or (car gnus-summary-save-parts-type-history)
gnus-summary-save-parts-default-mime)
'gnus-summary-save-parts-type-history)
(setq gnus-summary-save-parts-last-directory
(read-file-name "Save to directory: "
gnus-summary-save-parts-last-directory
nil t))
current-prefix-arg))
(gnus-summary-iterate n
(let ((gnus-display-mime-function nil)

43
lisp/gnus/gnus-topic.el
View file

@ -192,8 +192,9 @@ If TOPIC, start with that topic."
(beginning-of-line)
(get-text-property (point) 'gnus-active)))
(defun gnus-topic-find-groups (topic &optional level all lowest)
"Return entries for all visible groups in TOPIC."
(defun gnus-topic-find-groups (topic &optional level all lowest recursive)
"Return entries for all visible groups in TOPIC.
If RECURSIVE is t, return groups in its subtopics too."
(let ((groups (cdr (assoc topic gnus-topic-alist)))
info clevel unread group params visible-groups entry active)
(setq lowest (or lowest 1))
@ -231,7 +232,18 @@ If TOPIC, start with that topic."
(cdr (assq 'visible params)))
;; Add this group to the list of visible groups.
(push (or entry group) visible-groups)))
(nreverse visible-groups)))
(setq visible-groups (nreverse visible-groups))
(when recursive
(if (eq recursive t)
(setq recursive (cdr (gnus-topic-find-topology topic))))
(mapcar (lambda (topic-topology)
(setq visible-groups
(nconc visible-groups
(gnus-topic-find-groups
(caar topic-topology)
level all lowest topic-topology))))
(cdr recursive)))
visible-groups))
(defun gnus-topic-previous-topic (topic)
"Return the previous topic on the same level as TOPIC."
@ -1292,30 +1304,37 @@ If PERMANENT, make it stay shown in subsequent sessions as well."
(setcar (cdr (cadr topic)) 'visible)
(gnus-group-list-groups)))))
(defun gnus-topic-mark-topic (topic &optional unmark)
"Mark all groups in the topic with the process mark."
(interactive (list (gnus-group-topic-name)))
(defun gnus-topic-mark-topic (topic &optional unmark recursive)
"Mark all groups in the TOPIC with the process mark.
If RECURSIVE is t, mark its subtopics too."
(interactive (list (gnus-group-topic-name)
nil
(and current-prefix-arg t)))
(if (not topic)
(call-interactively 'gnus-group-mark-group)
(save-excursion
(let ((groups (gnus-topic-find-groups topic gnus-level-killed t)))
(let ((groups (gnus-topic-find-groups topic gnus-level-killed t nil
recursive)))
(while groups
(funcall (if unmark 'gnus-group-remove-mark 'gnus-group-set-mark)
(gnus-info-group (nth 2 (pop groups)))))))))
(defun gnus-topic-unmark-topic (topic &optional unmark)
"Remove the process mark from all groups in the topic."
(interactive (list (gnus-group-topic-name)))
(defun gnus-topic-unmark-topic (topic &optional dummy recursive)
"Remove the process mark from all groups in the TOPIC.
If RECURSIVE is t, unmark its subtopics too."
(interactive (list (gnus-group-topic-name)
nil
(and current-prefix-arg t)))
(if (not topic)
(call-interactively 'gnus-group-unmark-group)
(gnus-topic-mark-topic topic t)))
(gnus-topic-mark-topic topic t recursive)))
(defun gnus-topic-get-new-news-this-topic (&optional n)
"Check for new news in the current topic."
(interactive "P")
(if (not (gnus-group-topic-p))
(gnus-group-get-new-news-this-group n)
(gnus-topic-mark-topic (gnus-group-topic-name))
(gnus-topic-mark-topic (gnus-group-topic-name) nil (and n t))
(gnus-group-get-new-news-this-group)))
(defun gnus-topic-move-matching (regexp topic &optional copyp)

4
lisp/gnus/gnus-util.el
View file

@ -311,11 +311,11 @@ Cache the result as a text property stored in DATE."
time)))))
(defsubst gnus-time-iso8601 (time)
"Return a string of TIME in YYMMDDTHHMMSS format."
"Return a string of TIME in YYYYMMDDTHHMMSS format."
(format-time-string "%Y%m%dT%H%M%S" time))
(defun gnus-date-iso8601 (date)
"Convert the DATE to YYMMDDTHHMMSS."
"Convert the DATE to YYYYMMDDTHHMMSS."
(condition-case ()
(gnus-time-iso8601 (gnus-date-get-time date))
(error "")))

4
lisp/gnus/nnheader.el
View file

@ -332,7 +332,9 @@ on your system, you could say something like:
(nnheader-nov-read-integer) ; lines
(if (eq (char-after) ?\n)
nil
(nnheader-nov-field)) ; misc
(if (looking-at "Xref: ")
(goto-char (match-end 0)))
(nnheader-nov-field)) ; Xref
(nnheader-nov-parse-extra)))) ; extra
(defun nnheader-insert-nov (header)

232
lisp/gnus/nnkiboze.el
View file

@ -36,6 +36,7 @@
(require 'gnus)
(require 'gnus-score)
(require 'nnoo)
(require 'mm-util)
(eval-when-compile (require 'cl))
(nnoo-declare nnkiboze)
@ -57,6 +58,9 @@
(defvoo nnkiboze-regexp nil
"Regexp for matching component groups.")
(defvoo nnkiboze-file-coding-system mm-text-coding-system
"Coding system for nnkiboze files.")
(defconst nnkiboze-version "nnkiboze 1.0")
@ -82,7 +86,8 @@
(save-excursion
(set-buffer nntp-server-buffer)
(erase-buffer)
(nnheader-insert-file-contents nov)
(let ((nnheader-file-coding-system nnkiboze-file-coding-system))
(nnheader-insert-file-contents nov))
(nnheader-nov-delete-outside-range
(car articles) (car (last articles)))
'nov))))))
@ -121,7 +126,8 @@
(nnkiboze-request-scan group))
(if (not (file-exists-p nov-file))
(nnheader-report 'nnkiboze "Can't select group %s" group)
(nnheader-insert-file-contents nov-file)
(let ((nnheader-file-coding-system nnkiboze-file-coding-system))
(nnheader-insert-file-contents nov-file))
(if (zerop (buffer-size))
(nnheader-insert "211 0 0 0 %s\n" group)
(goto-char (point-min))
@ -138,15 +144,17 @@
;; Remove NOV lines of articles that are marked as read.
(when (and (file-exists-p (nnkiboze-nov-file-name))
nnkiboze-remove-read-articles)
(with-temp-file (nnkiboze-nov-file-name)
(let ((cur (current-buffer)))
(nnheader-insert-file-contents (nnkiboze-nov-file-name))
(goto-char (point-min))
(while (not (eobp))
(if (not (gnus-article-read-p (read cur)))
(forward-line 1)
(gnus-delete-line))))))
(setq nnkiboze-current-group nil))
(let ((coding-system-for-write nnkiboze-file-coding-system))
(with-temp-file (nnkiboze-nov-file-name)
(let ((cur (current-buffer))
(nnheader-file-coding-system nnkiboze-file-coding-system))
(nnheader-insert-file-contents (nnkiboze-nov-file-name))
(goto-char (point-min))
(while (not (eobp))
(if (not (gnus-article-read-p (read cur)))
(forward-line 1)
(gnus-delete-line))))))
(setq nnkiboze-current-group nil)))
(deffoo nnkiboze-open-server (server &optional defs)
(unless (assq 'nnkiboze-regexp defs)
@ -233,93 +241,94 @@ Finds out what articles are to be part of the nnkiboze groups."
;; Load the kiboze newsrc file for this group.
(when (file-exists-p newsrc-file)
(load newsrc-file))
(with-temp-file nov-file
(when (file-exists-p nov-file)
(insert-file-contents nov-file))
(setq nov-buffer (current-buffer))
;; Go through the active hashtb and add new all groups that match the
;; kiboze regexp.
(mapatoms
(lambda (group)
(and (string-match nnkiboze-regexp
(setq gname (symbol-name group))) ; Match
(not (assoc gname nnkiboze-newsrc)) ; It isn't registered
(numberp (car (symbol-value group))) ; It is active
(or (> nnkiboze-level 7)
(and (setq glevel (nth 1 (nth 2 (gnus-gethash
gname gnus-newsrc-hashtb))))
(>= nnkiboze-level glevel)))
(not (string-match "^nnkiboze:" gname)) ; Exclude kibozes
(push (cons gname (1- (car (symbol-value group))))
nnkiboze-newsrc)))
gnus-active-hashtb)
;; `newsrc' is set to the list of groups that possibly are
;; component groups to this kiboze group. This list has elements
;; on the form `(GROUP . NUMBER)', where NUMBER is the highest
;; number that has been kibozed in GROUP in this kiboze group.
(setq newsrc nnkiboze-newsrc)
(while newsrc
(if (not (setq active (gnus-gethash
(caar newsrc) gnus-active-hashtb)))
;; This group isn't active after all, so we remove it from
;; the list of component groups.
(setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc))
(setq lowest (cdar newsrc))
;; Ok, we have a valid component group, so we jump to it.
(switch-to-buffer gnus-group-buffer)
(gnus-group-jump-to-group (caar newsrc))
(gnus-message 3 "nnkiboze: Checking %s..." (caar newsrc))
(setq ginfo (gnus-get-info (gnus-group-group-name))
orig-info (gnus-copy-sequence ginfo)
num-unread (car (gnus-gethash (caar newsrc)
gnus-newsrc-hashtb)))
(unwind-protect
(progn
;; We set all list of article marks to nil. Since we operate
;; on copies of the real lists, we can destroy anything we
;; want here.
(when (nth 3 ginfo)
(setcar (nthcdr 3 ginfo) nil))
;; We set the list of read articles to be what we expect for
;; this kiboze group -- either nil or `(1 . LOWEST)'.
(when ginfo
(setcar (nthcdr 2 ginfo)
(and (not (= lowest 1)) (cons 1 lowest))))
(when (and (or (not ginfo)
(> (length (gnus-list-of-unread-articles
(car ginfo)))
0))
(progn
(ignore-errors
(gnus-group-select-group nil))
(eq major-mode 'gnus-summary-mode)))
;; We are now in the group where we want to be.
(setq method (gnus-find-method-for-group
gnus-newsgroup-name))
(when (eq method gnus-select-method)
(setq method nil))
;; We go through the list of scored articles.
(while gnus-newsgroup-scored
(when (> (caar gnus-newsgroup-scored) lowest)
;; If it has a good score, then we enter this article
;; into the kiboze group.
(nnkiboze-enter-nov
nov-buffer
(gnus-summary-article-header
(caar gnus-newsgroup-scored))
gnus-newsgroup-name))
(setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored)))
;; That's it. We exit this group.
(when (eq major-mode 'gnus-summary-mode)
(kill-buffer (current-buffer)))))
;; Restore the proper info.
(when ginfo
(setcdr ginfo (cdr orig-info)))
(setcar (gnus-gethash (caar newsrc) gnus-newsrc-hashtb)
num-unread)))
(setcdr (car newsrc) (car active))
(gnus-message 3 "nnkiboze: Checking %s...done" (caar newsrc))
(setq newsrc (cdr newsrc))))
(let ((coding-system-for-write nnkiboze-file-coding-system))
(with-temp-file nov-file
(when (file-exists-p nov-file)
(insert-file-contents nov-file))
(setq nov-buffer (current-buffer))
;; Go through the active hashtb and add new all groups that match the
;; kiboze regexp.
(mapatoms
(lambda (group)
(and (string-match nnkiboze-regexp
(setq gname (symbol-name group))) ; Match
(not (assoc gname nnkiboze-newsrc)) ; It isn't registered
(numberp (car (symbol-value group))) ; It is active
(or (> nnkiboze-level 7)
(and (setq glevel (nth 1 (nth 2 (gnus-gethash
gname gnus-newsrc-hashtb))))
(>= nnkiboze-level glevel)))
(not (string-match "^nnkiboze:" gname)) ; Exclude kibozes
(push (cons gname (1- (car (symbol-value group))))
nnkiboze-newsrc)))
gnus-active-hashtb)
;; `newsrc' is set to the list of groups that possibly are
;; component groups to this kiboze group. This list has elements
;; on the form `(GROUP . NUMBER)', where NUMBER is the highest
;; number that has been kibozed in GROUP in this kiboze group.
(setq newsrc nnkiboze-newsrc)
(while newsrc
(if (not (setq active (gnus-gethash
(caar newsrc) gnus-active-hashtb)))
;; This group isn't active after all, so we remove it from
;; the list of component groups.
(setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc))
(setq lowest (cdar newsrc))
;; Ok, we have a valid component group, so we jump to it.
(switch-to-buffer gnus-group-buffer)
(gnus-group-jump-to-group (caar newsrc))
(gnus-message 3 "nnkiboze: Checking %s..." (caar newsrc))
(setq ginfo (gnus-get-info (gnus-group-group-name))
orig-info (gnus-copy-sequence ginfo)
num-unread (car (gnus-gethash (caar newsrc)
gnus-newsrc-hashtb)))
(unwind-protect
(progn
;; We set all list of article marks to nil. Since we operate
;; on copies of the real lists, we can destroy anything we
;; want here.
(when (nth 3 ginfo)
(setcar (nthcdr 3 ginfo) nil))
;; We set the list of read articles to be what we expect for
;; this kiboze group -- either nil or `(1 . LOWEST)'.
(when ginfo
(setcar (nthcdr 2 ginfo)
(and (not (= lowest 1)) (cons 1 lowest))))
(when (and (or (not ginfo)
(> (length (gnus-list-of-unread-articles
(car ginfo)))
0))
(progn
(ignore-errors
(gnus-group-select-group nil))
(eq major-mode 'gnus-summary-mode)))
;; We are now in the group where we want to be.
(setq method (gnus-find-method-for-group
gnus-newsgroup-name))
(when (eq method gnus-select-method)
(setq method nil))
;; We go through the list of scored articles.
(while gnus-newsgroup-scored
(when (> (caar gnus-newsgroup-scored) lowest)
;; If it has a good score, then we enter this article
;; into the kiboze group.
(nnkiboze-enter-nov
nov-buffer
(gnus-summary-article-header
(caar gnus-newsgroup-scored))
gnus-newsgroup-name))
(setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored)))
;; That's it. We exit this group.
(when (eq major-mode 'gnus-summary-mode)
(kill-buffer (current-buffer)))))
;; Restore the proper info.
(when ginfo
(setcdr ginfo (cdr orig-info)))
(setcar (gnus-gethash (caar newsrc) gnus-newsrc-hashtb)
num-unread)))
(setcdr (car newsrc) (car active))
(gnus-message 3 "nnkiboze: Checking %s...done" (caar newsrc))
(setq newsrc (cdr newsrc)))))
;; We save the kiboze newsrc for this group.
(with-temp-file newsrc-file
(insert "(setq nnkiboze-newsrc '")
@ -343,19 +352,22 @@ Finds out what articles are to be part of the nnkiboze groups."
(forward-line 1))
(setq article 1))
(mail-header-set-number oheader article)
(nnheader-insert-nov oheader)
(search-backward "\t" nil t 2)
(if (re-search-forward " [^ ]+:[0-9]+" nil t)
(goto-char (match-beginning 0))
(with-temp-buffer
(insert (mail-header-xref oheader))
(goto-char (point-min))
(if (re-search-forward " [^ ]+:[0-9]+" nil t)
(goto-char (match-beginning 0))
(forward-char 1))
;; The first Xref has to be the group this article
;; really came for - this is the article nnkiboze
;; will request when it is asked for the article.
(insert " " group ":"
(int-to-string (mail-header-number header)) " ")
(while (re-search-forward " [^ ]+:[0-9]+" nil t)
(goto-char (1+ (match-beginning 0)))
(insert prefix)))))
;; The first Xref has to be the group this article
;; really came for - this is the article nnkiboze
;; will request when it is asked for the article.
(insert " " group ":"
(int-to-string (mail-header-number header)) " ")
(while (re-search-forward " [^ ]+:[0-9]+" nil t)
(goto-char (1+ (match-beginning 0)))
(insert prefix))
(mail-header-set-xref oheader (buffer-string)))
(nnheader-insert-nov oheader))))
(defun nnkiboze-nov-file-name (&optional suffix)
(concat (file-name-as-directory nnkiboze-directory)

7
lisp/gnus/nnmail.el
View file

@ -185,7 +185,7 @@ The return value should be `delete' or a group name (a string)."
:group 'nnmail
:type 'boolean)
(defcustom nnmail-spool-file '((file))
(defcustom nnmail-spool-file nil
"*Where the mail backends will look for incoming mail.
This variable is a list of mail source specifiers.
This variable is obsolete; `mail-sources' should be used instead."
@ -226,7 +226,7 @@ links, you could set this variable to `copy-file' instead."
'(nnheader-ms-strip-cr)
nil)
"*Hook that will be run after the incoming mail has been transferred.
The incoming mail is moved from `nnmail-spool-file' (which normally is
The incoming mail is moved from the specified spool file (which normally is
something like \"/usr/spool/mail/$user\") to the user's home
directory. This hook is called after the incoming mail box has been
emptied, and can be used to call any mail box programs you have
@ -1513,7 +1513,8 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
(new 0)
(total 0)
incoming incomings source)
(when (nnmail-get-value "%s-get-new-mail" method)
(when (and (nnmail-get-value "%s-get-new-mail" method)
sources)
(while (setq source (pop sources))
;; Be compatible with old values.
(cond