Mercurial > hg > xemacs-beta

comparison lisp/gnus/nnkiboze.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents ec9a17fef872
children 0d2f883870bc
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;;; nnkiboze.el --- select virtual news access for Gnus 1 ;;; nnkiboze.el --- select virtual news access for Gnus
2 ;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. 2 ;; Copyright (C) 1995,96 Free Software Foundation, Inc.
3 3
4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no> 4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
5 ;; Keywords: news 5 ;; Keywords: news
6 6
7 ;; This file is part of GNU Emacs. 7 ;; This file is part of GNU Emacs.
22 ;; Boston, MA 02111-1307, USA. 22 ;; Boston, MA 02111-1307, USA.
23 23
24 ;;; Commentary: 24 ;;; Commentary:
25 25
26 ;; The other access methods (nntp, nnspool, etc) are general news 26 ;; The other access methods (nntp, nnspool, etc) are general news
27 ;; access methods. This module relies on Gnus and can't be used 27 ;; access methods. This module relies on Gnus and can not be used
28 ;; separately. 28 ;; separately.
29 29
30 ;;; Code: 30 ;;; Code:
31 31
32 (require 'nntp) 32 (require 'nntp)
35 (require 'gnus-score) 35 (require 'gnus-score)
36 (require 'nnoo) 36 (require 'nnoo)
37 (eval-when-compile (require 'cl)) 37 (eval-when-compile (require 'cl))
38 38
39 (nnoo-declare nnkiboze) 39 (nnoo-declare nnkiboze)
40 (defvoo nnkiboze-directory (nnheader-concat gnus-directory "kiboze/") 40 (defvoo nnkiboze-directory gnus-directory
41 "nnkiboze will put its files in this directory.") 41 "nnkiboze will put its files in this directory.")
42 42
43 (defvoo nnkiboze-level 9 43 (defvoo nnkiboze-level 9
44 "The maximum level to be searched for articles.") 44 "*The maximum level to be searched for articles.")
45 45
46 (defvoo nnkiboze-remove-read-articles t 46 (defvoo nnkiboze-remove-read-articles t
47 "If non-nil, nnkiboze will remove read articles from the kiboze group.") 47 "*If non-nil, nnkiboze will remove read articles from the kiboze group.")
48
49 (defvoo nnkiboze-ephemeral nil
50 "If non-nil, don't store any data anywhere.")
51
52 (defvoo nnkiboze-scores nil
53 "Score rules for generating the nnkiboze group.")
54
55 (defvoo nnkiboze-regexp nil
56 "Regexp for matching component groups.")
57 48
58 49
59 50
60 (defconst nnkiboze-version "nnkiboze 1.0") 51 (defconst nnkiboze-version "nnkiboze 1.0"
52 "Version numbers of this version of nnkiboze.")
61 53
62 (defvoo nnkiboze-current-group nil) 54 (defvoo nnkiboze-current-group nil)
55 (defvoo nnkiboze-current-score-group "")
63 (defvoo nnkiboze-status-string "") 56 (defvoo nnkiboze-status-string "")
64 57
65 (defvoo nnkiboze-headers nil)
66
67 58
68 59
69 ;;; Interface functions. 60 ;;; Interface functions.
70 61
71 (nnoo-define-basics nnkiboze) 62 (nnoo-define-basics nnkiboze)
72 63
73 (deffoo nnkiboze-retrieve-headers (articles &optional group server fetch-old) 64 (deffoo nnkiboze-retrieve-headers (articles &optional group server fetch-old)
74 (nnkiboze-possibly-change-group group) 65 (nnkiboze-possibly-change-newsgroups group)
75 (unless gnus-nov-is-evil 66 (if gnus-nov-is-evil
67 nil
76 (if (stringp (car articles)) 68 (if (stringp (car articles))
77 'headers 69 'headers
78 (let ((nov (nnkiboze-nov-file-name))) 70 (let ((first (car articles))
79 (when (file-exists-p nov) 71 (last (progn (while (cdr articles) (setq articles (cdr articles)))
80 (save-excursion 72 (car articles)))
81 (set-buffer nntp-server-buffer) 73 (nov (nnkiboze-nov-file-name)))
82 (erase-buffer) 74 (if (file-exists-p nov)
83 (nnheader-insert-file-contents nov) 75 (save-excursion
84 (nnheader-nov-delete-outside-range 76 (set-buffer nntp-server-buffer)
85 (car articles) (car (last articles))) 77 (erase-buffer)
86 'nov)))))) 78 (insert-file-contents nov)
79 (goto-char (point-min))
80 (while (and (not (eobp)) (< first (read (current-buffer))))
81 (forward-line 1))
82 (beginning-of-line)
83 (if (not (eobp)) (delete-region 1 (point)))
84 (while (and (not (eobp)) (>= last (read (current-buffer))))
85 (forward-line 1))
86 (beginning-of-line)
87 (if (not (eobp)) (delete-region (point) (point-max)))
88 'nov))))))
89
90 (deffoo nnkiboze-open-server (newsgroups &optional something)
91 (gnus-make-directory nnkiboze-directory)
92 (nnheader-init-server-buffer))
93
94 (deffoo nnkiboze-server-opened (&optional server)
95 (and nntp-server-buffer
96 (get-buffer nntp-server-buffer)))
87 97
88 (deffoo nnkiboze-request-article (article &optional newsgroup server buffer) 98 (deffoo nnkiboze-request-article (article &optional newsgroup server buffer)
89 (nnkiboze-possibly-change-group newsgroup) 99 (nnkiboze-possibly-change-newsgroups newsgroup)
90 (if (not (numberp article)) 100 (if (not (numberp article))
91 ;; This is a real kludge. It might not work at times, but it 101 ;; This is a real kludge. It might not work at times, but it
92 ;; does no harm I think. The only alternative is to offer no 102 ;; does no harm I think. The only alternative is to offer no
93 ;; article fetching by message-id at all. 103 ;; article fetching by message-id at all.
94 (nntp-request-article article newsgroup gnus-nntp-server buffer) 104 (nntp-request-article article newsgroup gnus-nntp-server buffer)
95 (let* ((header (gnus-summary-article-header article)) 105 (let* ((header (gnus-summary-article-header article))
96 (xref (mail-header-xref header))) 106 (xref (mail-header-xref header))
97 (unless xref 107 igroup iarticle)
98 (error "nnkiboze: No xref")) 108 (or xref (error "nnkiboze: No xref"))
99 (unless (string-match " \\([^ ]+\\):\\([0-9]+\\)" xref) 109 (or (string-match " \\([^ ]+\\):\\([0-9]+\\)" xref)
100 (error "nnkiboze: Malformed xref")) 110 (error "nnkiboze: Malformed xref"))
101 (gnus-request-article (string-to-int (match-string 2 xref)) 111 (setq igroup (substring xref (match-beginning 1) (match-end 1)))
102 (match-string 1 xref) 112 (setq iarticle (string-to-int
103 buffer)))) 113 (substring xref (match-beginning 2) (match-end 2))))
104 114 (and (gnus-request-group igroup t)
105 (deffoo nnkiboze-request-scan (&optional group server) 115 (gnus-request-article iarticle igroup buffer)))))
106 (nnkiboze-generate-group (concat "nnkiboze:" group)))
107 116
108 (deffoo nnkiboze-request-group (group &optional server dont-check) 117 (deffoo nnkiboze-request-group (group &optional server dont-check)
109 "Make GROUP the current newsgroup." 118 "Make GROUP the current newsgroup."
110 (nnkiboze-possibly-change-group group) 119 (nnkiboze-possibly-change-newsgroups group)
111 (if dont-check 120 (if dont-check
112 t 121 ()
113 (let ((nov-file (nnkiboze-nov-file-name)) 122 (let ((nov-file (nnkiboze-nov-file-name))
114 beg end total) 123 beg end total)
115 (save-excursion 124 (save-excursion
116 (set-buffer nntp-server-buffer) 125 (set-buffer nntp-server-buffer)
117 (erase-buffer) 126 (erase-buffer)
118 (if (not (file-exists-p nov-file)) 127 (if (not (file-exists-p nov-file))
119 (nnheader-report 'nnkiboze "Can't select group %s" group) 128 (insert (format "211 0 0 0 %s\n" group))
120 (nnheader-insert-file-contents nov-file) 129 (insert-file-contents nov-file)
121 (if (zerop (buffer-size)) 130 (if (zerop (buffer-size))
122 (nnheader-insert "211 0 0 0 %s\n" group) 131 (insert (format "211 0 0 0 %s\n" group))
123 (goto-char (point-min)) 132 (goto-char (point-min))
124 (when (looking-at "[0-9]+") 133 (and (looking-at "[0-9]+") (setq beg (read (current-buffer))))
125 (setq beg (read (current-buffer))))
126 (goto-char (point-max)) 134 (goto-char (point-max))
127 (when (re-search-backward "^[0-9]" nil t) 135 (and (re-search-backward "^[0-9]" nil t)
128 (setq end (read (current-buffer)))) 136 (setq end (read (current-buffer))))
129 (setq total (count-lines (point-min) (point-max))) 137 (setq total (count-lines (point-min) (point-max)))
130 (nnheader-insert "211 %d %d %d %s\n" total beg end group))))))) 138 (erase-buffer)
139 (insert (format "211 %d %d %d %s\n" total beg end group)))))))
140 t)
131 141
132 (deffoo nnkiboze-close-group (group &optional server) 142 (deffoo nnkiboze-close-group (group &optional server)
133 (nnkiboze-possibly-change-group group) 143 (nnkiboze-possibly-change-newsgroups group)
134 ;; Remove NOV lines of articles that are marked as read. 144 ;; Remove NOV lines of articles that are marked as read.
135 (when (and (file-exists-p (nnkiboze-nov-file-name)) 145 (when (and (file-exists-p (nnkiboze-nov-file-name))
136 nnkiboze-remove-read-articles) 146 nnkiboze-remove-read-articles
137 (nnheader-temp-write (nnkiboze-nov-file-name) 147 (eq major-mode 'gnus-summary-mode))
138 (let ((cur (current-buffer))) 148 (save-excursion
139 (nnheader-insert-file-contents (nnkiboze-nov-file-name)) 149 (let ((unreads gnus-newsgroup-unreads)
140 (goto-char (point-min)) 150 (unselected gnus-newsgroup-unselected)
141 (while (not (eobp)) 151 (version-control 'never))
142 (if (not (gnus-article-read-p (read cur))) 152 (set-buffer (get-buffer-create "*nnkiboze work*"))
143 (forward-line 1) 153 (buffer-disable-undo (current-buffer))
144 (gnus-delete-line)))))) 154 (erase-buffer)
145 (setq nnkiboze-current-group nil)) 155 (let ((cur (current-buffer))
146 156 article)
147 (deffoo nnkiboze-open-server (server &optional defs) 157 (insert-file-contents (nnkiboze-nov-file-name))
148 (unless (assq 'nnkiboze-regexp defs) 158 (goto-char (point-min))
149 (push `(nnkiboze-regexp ,server) 159 (while (looking-at "[0-9]+")
150 defs)) 160 (if (or (memq (setq article (read cur)) unreads)
151 (nnoo-change-server 'nnkiboze server defs)) 161 (memq article unselected))
162 (forward-line 1)
163 (delete-region (progn (beginning-of-line) (point))
164 (progn (forward-line 1) (point)))))
165 (write-file (nnkiboze-nov-file-name))
166 (kill-buffer (current-buffer)))))
167 (setq nnkiboze-current-group nil)))
168
169 (deffoo nnkiboze-request-list (&optional server)
170 (nnheader-report 'nnkiboze "LIST is not implemented."))
171
172 (deffoo nnkiboze-request-newgroups (date &optional server)
173 "List new groups."
174 (nnheader-report 'nnkiboze "NEWGROUPS is not supported."))
175
176 (deffoo nnkiboze-request-list-newsgroups (&optional server)
177 (nnheader-report 'nnkiboze "LIST NEWSGROUPS is not implemented."))
152 178
153 (deffoo nnkiboze-request-delete-group (group &optional force server) 179 (deffoo nnkiboze-request-delete-group (group &optional force server)
154 (nnkiboze-possibly-change-group group) 180 (nnkiboze-possibly-change-newsgroups group)
155 (when force 181 (when force
156 (let ((files (list (nnkiboze-nov-file-name) 182 (let ((files (list (nnkiboze-nov-file-name)
157 (concat nnkiboze-directory group ".newsrc") 183 (concat nnkiboze-directory group ".newsrc")
158 (nnkiboze-score-file group)))) 184 (nnkiboze-score-file group))))
159 (while files 185 (while files
161 (file-writable-p (car files)) 187 (file-writable-p (car files))
162 (delete-file (car files))) 188 (delete-file (car files)))
163 (setq files (cdr files))))) 189 (setq files (cdr files)))))
164 (setq nnkiboze-current-group nil)) 190 (setq nnkiboze-current-group nil))
165 191
166 (nnoo-define-skeleton nnkiboze)
167
168 192
169 ;;; Internal functions. 193 ;;; Internal functions.
170 194
171 (defun nnkiboze-possibly-change-group (group) 195 (defun nnkiboze-possibly-change-newsgroups (group)
172 (setq nnkiboze-current-group group)) 196 (setq nnkiboze-current-group group))
173 197
174 (defun nnkiboze-prefixed-name (group) 198 (defun nnkiboze-prefixed-name (group)
175 (gnus-group-prefixed-name group '(nnkiboze ""))) 199 (gnus-group-prefixed-name group '(nnkiboze "")))
176 200
183 (gnus-use-dribble-file nil) 207 (gnus-use-dribble-file nil)
184 (gnus-read-active-file t) 208 (gnus-read-active-file t)
185 (gnus-expert-user t)) 209 (gnus-expert-user t))
186 (gnus)) 210 (gnus))
187 (let* ((gnus-newsrc-alist (gnus-copy-sequence gnus-newsrc-alist)) 211 (let* ((gnus-newsrc-alist (gnus-copy-sequence gnus-newsrc-alist))
188 (newsrc (cdr gnus-newsrc-alist)) 212 (newsrc gnus-newsrc-alist)
189 gnus-newsrc-hashtb info) 213 gnus-newsrc-hashtb)
190 (gnus-make-hashtable-from-newsrc-alist) 214 (gnus-make-hashtable-from-newsrc-alist)
191 ;; We have copied all the newsrc alist info over to local copies 215 ;; We have copied all the newsrc alist info over to local copies
192 ;; so that we can mess all we want with these lists. 216 ;; so that we can mess all we want with these lists.
193 (while (setq info (pop newsrc)) 217 (while newsrc
194 (when (string-match "nnkiboze" (gnus-info-group info)) 218 (if (string-match "nnkiboze" (caar newsrc))
195 ;; For each kiboze group, we call this function to generate 219 ;; For each kiboze group, we call this function to generate
196 ;; it. 220 ;; it.
197 (nnkiboze-generate-group (gnus-info-group info)))))) 221 (nnkiboze-generate-group (caar newsrc)))
222 (setq newsrc (cdr newsrc)))))
198 223
199 (defun nnkiboze-score-file (group) 224 (defun nnkiboze-score-file (group)
200 (list (expand-file-name 225 (list (expand-file-name
201 (concat (file-name-as-directory gnus-kill-files-directory) 226 (concat (file-name-as-directory gnus-kill-files-directory)
202 (nnheader-translate-file-chars 227 (nnheader-translate-file-chars
203 (concat (nnkiboze-prefixed-name nnkiboze-current-group) 228 (concat nnkiboze-current-score-group
204 "." gnus-score-file-suffix)))))) 229 "." gnus-score-file-suffix))))))
205 230
206 (defun nnkiboze-generate-group (group) 231 (defun nnkiboze-generate-group (group)
207 (let* ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) 232 (let* ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))
208 (newsrc-file (concat nnkiboze-directory group ".newsrc")) 233 (newsrc-file (concat nnkiboze-directory group ".newsrc"))
209 (nov-file (concat nnkiboze-directory group ".nov")) 234 (nov-file (concat nnkiboze-directory group ".nov"))
210 method nnkiboze-newsrc gname newsrc active 235 (regexp (nth 1 (nth 4 info)))
211 ginfo lowest glevel orig-info nov-buffer
212 ;; Bind various things to nil to make group entry faster.
213 (gnus-expert-user t) 236 (gnus-expert-user t)
214 (gnus-large-newsgroup nil) 237 (gnus-large-newsgroup nil)
238 (version-control 'never)
215 (gnus-score-find-score-files-function 'nnkiboze-score-file) 239 (gnus-score-find-score-files-function 'nnkiboze-score-file)
216 (gnus-verbose (min gnus-verbose 3)) 240 gnus-select-group-hook gnus-summary-prepare-hook
217 gnus-select-group-hook gnus-summary-prepare-hook 241 gnus-thread-sort-functions gnus-show-threads
218 gnus-thread-sort-functions gnus-show-threads 242 gnus-visual
219 gnus-visual gnus-suppress-duplicates) 243 method nnkiboze-newsrc nov-buffer gname newsrc active
220 (unless info 244 ginfo lowest glevel)
221 (error "No such group: %s" group)) 245 (setq nnkiboze-current-score-group group)
246 (or info (error "No such group: %s" group))
222 ;; Load the kiboze newsrc file for this group. 247 ;; Load the kiboze newsrc file for this group.
223 (when (file-exists-p newsrc-file) 248 (and (file-exists-p newsrc-file) (load newsrc-file))
224 (load newsrc-file)) 249 ;; We also load the nov file for this group.
225 (nnheader-temp-write nov-file 250 (save-excursion
226 (when (file-exists-p nov-file) 251 (set-buffer (setq nov-buffer (find-file-noselect nov-file)))
227 (insert-file-contents nov-file)) 252 (buffer-disable-undo (current-buffer)))
228 (setq nov-buffer (current-buffer)) 253 ;; Go through the active hashtb and add new all groups that match the
229 ;; Go through the active hashtb and add new all groups that match the 254 ;; kiboze regexp.
230 ;; kiboze regexp. 255 (mapatoms
231 (mapatoms 256 (lambda (group)
232 (lambda (group) 257 (and (string-match regexp (setq gname (symbol-name group))) ; Match
233 (and (string-match nnkiboze-regexp 258 (not (assoc gname nnkiboze-newsrc)) ; It isn't registered
234 (setq gname (symbol-name group))) ; Match 259 (numberp (car (symbol-value group))) ; It is active
235 (not (assoc gname nnkiboze-newsrc)) ; It isn't registered 260 (or (> nnkiboze-level 7)
236 (numberp (car (symbol-value group))) ; It is active 261 (and (setq glevel (nth 1 (nth 2 (gnus-gethash
237 (or (> nnkiboze-level 7) 262 gname gnus-newsrc-hashtb))))
238 (and (setq glevel (nth 1 (nth 2 (gnus-gethash 263 (>= nnkiboze-level glevel)))
239 gname gnus-newsrc-hashtb)))) 264 (not (string-match "^nnkiboze:" gname)) ; Exclude kibozes
240 (>= nnkiboze-level glevel))) 265 (setq nnkiboze-newsrc
241 (not (string-match "^nnkiboze:" gname)) ; Exclude kibozes 266 (cons (cons gname (1- (car (symbol-value group))))
242 (push (cons gname (1- (car (symbol-value group)))) 267 nnkiboze-newsrc))))
243 nnkiboze-newsrc))) 268 gnus-active-hashtb)
244 gnus-active-hashtb) 269 ;; `newsrc' is set to the list of groups that possibly are
245 ;; `newsrc' is set to the list of groups that possibly are 270 ;; component groups to this kiboze group. This list has elements
246 ;; component groups to this kiboze group. This list has elements 271 ;; on the form `(GROUP . NUMBER)', where NUMBER is the highest
247 ;; on the form `(GROUP . NUMBER)', where NUMBER is the highest 272 ;; number that has been kibozed in GROUP in this kiboze group.
248 ;; number that has been kibozed in GROUP in this kiboze group. 273 (setq newsrc nnkiboze-newsrc)
249 (setq newsrc nnkiboze-newsrc) 274 (while newsrc
250 (while newsrc 275 (if (not (setq active (gnus-gethash
251 (if (not (setq active (gnus-gethash 276 (caar newsrc) gnus-active-hashtb)))
252 (caar newsrc) gnus-active-hashtb))) 277 ;; This group isn't active after all, so we remove it from
253 ;; This group isn't active after all, so we remove it from 278 ;; the list of component groups.
254 ;; the list of component groups. 279 (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc))
255 (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc)) 280 (setq lowest (cdar newsrc))
256 (setq lowest (cdar newsrc)) 281 ;; Ok, we have a valid component group, so we jump to it.
257 ;; Ok, we have a valid component group, so we jump to it. 282 (switch-to-buffer gnus-group-buffer)
258 (switch-to-buffer gnus-group-buffer) 283 (gnus-group-jump-to-group (caar newsrc))
259 (gnus-group-jump-to-group (caar newsrc)) 284 ;; We set all list of article marks to nil. Since we operate
260 (gnus-message 3 "nnkiboze: Checking %s..." (caar newsrc)) 285 ;; on copies of the real lists, we can destroy anything we
261 (setq ginfo (gnus-get-info (gnus-group-group-name)) 286 ;; want here.
262 orig-info (gnus-copy-sequence ginfo)) 287 (and (setq ginfo (nth 2 (gnus-gethash (gnus-group-group-name)
263 (unwind-protect 288 gnus-newsrc-hashtb)))
264 (progn 289 (nth 3 ginfo)
265 ;; We set all list of article marks to nil. Since we operate 290 (setcar (nthcdr 3 ginfo) nil))
266 ;; on copies of the real lists, we can destroy anything we 291 ;; We set the list of read articles to be what we expect for
267 ;; want here. 292 ;; this kiboze group -- either nil or `(1 . LOWEST)'.
268 (when (nth 3 ginfo) 293 (and ginfo (setcar (nthcdr 2 ginfo)
269 (setcar (nthcdr 3 ginfo) nil)) 294 (and (not (= lowest 1)) (cons 1 lowest))))
270 ;; We set the list of read articles to be what we expect for 295 (if (not (and (or (not ginfo)
271 ;; this kiboze group -- either nil or `(1 . LOWEST)'. 296 (> (length (gnus-list-of-unread-articles
272 (when ginfo 297 (car ginfo))) 0))
273 (setcar (nthcdr 2 ginfo) 298 (progn
274 (and (not (= lowest 1)) (cons 1 lowest)))) 299 (gnus-group-select-group nil)
275 (when (and (or (not ginfo) 300 (eq major-mode 'gnus-summary-mode))))
276 (> (length (gnus-list-of-unread-articles 301 () ; No unread articles, or we couldn't enter this group.
277 (car ginfo))) 302 ;; We are now in the group where we want to be.
278 0)) 303 (setq method (gnus-find-method-for-group gnus-newsgroup-name))
279 (progn 304 (and (eq method gnus-select-method) (setq method nil))
280 (gnus-group-select-group nil) 305 ;; We go through the list of scored articles.
281 (eq major-mode 'gnus-summary-mode))) 306 (while gnus-newsgroup-scored
282 ;; We are now in the group where we want to be. 307 (if (> (caar gnus-newsgroup-scored) lowest)
283 (setq method (gnus-find-method-for-group 308 ;; If it has a good score, then we enter this article
284 gnus-newsgroup-name)) 309 ;; into the kiboze group.
285 (when (eq method gnus-select-method) 310 (nnkiboze-enter-nov
286 (setq method nil)) 311 nov-buffer
287 ;; We go through the list of scored articles. 312 (gnus-summary-article-header
288 (while gnus-newsgroup-scored 313 (caar gnus-newsgroup-scored))
289 (when (> (caar gnus-newsgroup-scored) lowest) 314 (if method
290 ;; If it has a good score, then we enter this article 315 (gnus-group-prefixed-name gnus-newsgroup-name method)
291 ;; into the kiboze group. 316 gnus-newsgroup-name)))
292 (nnkiboze-enter-nov 317 (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored)))
293 nov-buffer 318 ;; That's it. We exit this group.
294 (gnus-summary-article-header 319 (gnus-summary-exit-no-update)))
295 (caar gnus-newsgroup-scored)) 320 (setcdr (car newsrc) (car active))
296 gnus-newsgroup-name)) 321 (setq newsrc (cdr newsrc)))
297 (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored))) 322 ;; We save the nov file.
298 ;; That's it. We exit this group. 323 (set-buffer nov-buffer)
299 (gnus-summary-exit-no-update))) 324 (save-buffer)
300 ;; Restore the proper info. 325 (kill-buffer (current-buffer))
301 (when ginfo
302 (setcdr ginfo (cdr orig-info)))))
303 (setcdr (car newsrc) (car active))
304 (gnus-message 3 "nnkiboze: Checking %s...done" (caar newsrc))
305 (setq newsrc (cdr newsrc))))
306 ;; We save the kiboze newsrc for this group. 326 ;; We save the kiboze newsrc for this group.
307 (nnheader-temp-write newsrc-file 327 (set-buffer (get-buffer-create "*nnkiboze work*"))
308 (insert "(setq nnkiboze-newsrc '") 328 (buffer-disable-undo (current-buffer))
309 (gnus-prin1 nnkiboze-newsrc) 329 (erase-buffer)
310 (insert ")\n")) 330 (insert "(setq nnkiboze-newsrc '" (prin1-to-string nnkiboze-newsrc)
311 t)) 331 ")\n")
312 332 (write-file newsrc-file)
333 (kill-buffer (current-buffer))
334 (switch-to-buffer gnus-group-buffer)
335 (gnus-group-list-groups 5 nil)))
336
313 (defun nnkiboze-enter-nov (buffer header group) 337 (defun nnkiboze-enter-nov (buffer header group)
314 (save-excursion 338 (save-excursion
315 (set-buffer buffer) 339 (set-buffer buffer)
316 (goto-char (point-max)) 340 (goto-char (point-max))
317 (let ((xref (mail-header-xref header)) 341 (let ((xref (mail-header-xref header))
318 (prefix (gnus-group-real-prefix group)) 342 (prefix (gnus-group-real-prefix group))
319 (oheader (copy-sequence header))
320 (first t) 343 (first t)
321 article) 344 article)
322 (if (zerop (forward-line -1)) 345 (if (zerop (forward-line -1))
323 (progn 346 (progn
324 (setq article (1+ (read (current-buffer)))) 347 (setq article (1+ (read (current-buffer))))
325 (forward-line 1)) 348 (forward-line 1))
326 (setq article 1)) 349 (setq article 1))
327 (mail-header-set-number oheader article) 350 (insert (int-to-string article) "\t"
328 (nnheader-insert-nov oheader) 351 (or (mail-header-subject header) "") "\t"
329 (search-backward "\t" nil t 2) 352 (or (mail-header-from header) "") "\t"
330 (if (re-search-forward " [^ ]+:[0-9]+" nil t) 353 (or (mail-header-date header) "") "\t"
331 (goto-char (match-beginning 0)) 354 (or (mail-header-id header) "") "\t"
332 (forward-char 1)) 355 (or (mail-header-references header) "") "\t"
333 ;; The first Xref has to be the group this article 356 (int-to-string (or (mail-header-chars header) 0)) "\t"
334 ;; really came for - this is the article nnkiboze 357 (int-to-string (or (mail-header-lines header) 0)) "\t")
335 ;; will request when it is asked for the article. 358 (if (or (not xref) (equal "" xref))
336 (insert group ":" 359 (insert "Xref: " (system-name) " " group ":"
337 (int-to-string (mail-header-number header)) " ") 360 (int-to-string (mail-header-number header))
338 (while (re-search-forward " [^ ]+:[0-9]+" nil t) 361 "\t\n")
339 (goto-char (1+ (match-beginning 0))) 362 (insert (mail-header-xref header) "\t\n")
340 (insert prefix))))) 363 (search-backward "\t" nil t)
364 (search-backward "\t" nil t)
365 (while (re-search-forward
366 "[^ ]+:[0-9]+"
367 (save-excursion (end-of-line) (point)) t)
368 (if first
369 ;; The first xref has to be the group this article
370 ;; really came for - this is the article nnkiboze
371 ;; will request when it is asked for the article.
372 (save-excursion
373 (goto-char (match-beginning 0))
374 (insert prefix group ":"
375 (int-to-string (mail-header-number header)) " ")
376 (setq first nil)))
377 (save-excursion
378 (goto-char (match-beginning 0))
379 (insert prefix)))))))
341 380
342 (defun nnkiboze-nov-file-name () 381 (defun nnkiboze-nov-file-name ()
343 (concat (file-name-as-directory nnkiboze-directory) 382 (concat (file-name-as-directory nnkiboze-directory)
344 (nnheader-translate-file-chars 383 (nnheader-translate-file-chars
345 (concat (nnkiboze-prefixed-name nnkiboze-current-group) ".nov")))) 384 (concat (nnkiboze-prefixed-name nnkiboze-current-group) ".nov"))))