Mercurial > hg > xemacs-beta

comparison lisp/gnus/nnkiboze.el @ 16:0293115a14e9 r19-15b91

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