comparison lisp/gnus/nnkiboze.el @ 108:360340f9fd5f r20-1b6

Import from CVS: tag r20-1b6
author cvs
date Mon, 13 Aug 2007 09:18:39 +0200
parents 4be1180a9e89
children
comparison
equal deleted inserted replaced
107:523141596bda 108:360340f9fd5f
191 ;; 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
192 ;; so that we can mess all we want with these lists. 192 ;; so that we can mess all we want with these lists.
193 (while (setq info (pop newsrc)) 193 (while (setq info (pop newsrc))
194 (when (string-match "nnkiboze" (gnus-info-group info)) 194 (when (string-match "nnkiboze" (gnus-info-group info))
195 ;; For each kiboze group, we call this function to generate 195 ;; For each kiboze group, we call this function to generate
196 ;; it. 196 ;; it.
197 (nnkiboze-generate-group (gnus-info-group info)))))) 197 (nnkiboze-generate-group (gnus-info-group info))))))
198 198
199 (defun nnkiboze-score-file (group) 199 (defun nnkiboze-score-file (group)
200 (list (expand-file-name 200 (list (expand-file-name
201 (concat (file-name-as-directory gnus-kill-files-directory) 201 (concat (file-name-as-directory gnus-kill-files-directory)
212 ;; Bind various things to nil to make group entry faster. 212 ;; Bind various things to nil to make group entry faster.
213 (gnus-expert-user t) 213 (gnus-expert-user t)
214 (gnus-large-newsgroup nil) 214 (gnus-large-newsgroup nil)
215 (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)) 216 (gnus-verbose (min gnus-verbose 3))
217 gnus-select-group-hook gnus-summary-prepare-hook 217 gnus-select-group-hook gnus-summary-prepare-hook
218 gnus-thread-sort-functions gnus-show-threads 218 gnus-thread-sort-functions gnus-show-threads
219 gnus-visual gnus-suppress-duplicates) 219 gnus-visual gnus-suppress-duplicates)
220 (unless info 220 (unless info
221 (error "No such group: %s" group)) 221 (error "No such group: %s" group))
222 ;; Load the kiboze newsrc file for this group. 222 ;; Load the kiboze newsrc file for this group.
223 (when (file-exists-p newsrc-file) 223 (when (file-exists-p newsrc-file)
224 (load newsrc-file)) 224 (load newsrc-file))
225 (nnheader-temp-write nov-file 225 (nnheader-temp-write nov-file
226 (when (file-exists-p nov-file) 226 (when (file-exists-p nov-file)
227 (insert-file-contents nov-file)) 227 (insert-file-contents nov-file))
228 (setq nov-buffer (current-buffer)) 228 (setq nov-buffer (current-buffer))
229 ;; 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
230 ;; kiboze regexp. 230 ;; kiboze regexp.
231 (mapatoms 231 (mapatoms
232 (lambda (group) 232 (lambda (group)
233 (and (string-match nnkiboze-regexp 233 (and (string-match nnkiboze-regexp
234 (setq gname (symbol-name group))) ; Match 234 (setq gname (symbol-name group))) ; Match
246 ;; component groups to this kiboze group. This list has elements 246 ;; component groups to this kiboze group. This list has elements
247 ;; on the form `(GROUP . NUMBER)', where NUMBER is the highest 247 ;; on the form `(GROUP . NUMBER)', where NUMBER is the highest
248 ;; number that has been kibozed in GROUP in this kiboze group. 248 ;; number that has been kibozed in GROUP in this kiboze group.
249 (setq newsrc nnkiboze-newsrc) 249 (setq newsrc nnkiboze-newsrc)
250 (while newsrc 250 (while newsrc
251 (if (not (setq active (gnus-gethash 251 (if (not (setq active (gnus-gethash
252 (caar newsrc) gnus-active-hashtb))) 252 (caar newsrc) gnus-active-hashtb)))
253 ;; 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
254 ;; the list of component groups. 254 ;; the list of component groups.
255 (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc)) 255 (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc))
256 (setq lowest (cdar newsrc)) 256 (setq lowest (cdar newsrc))
257 ;; 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.
258 (switch-to-buffer gnus-group-buffer) 258 (switch-to-buffer gnus-group-buffer)
259 (gnus-group-jump-to-group (caar newsrc)) 259 (gnus-group-jump-to-group (caar newsrc))
260 (gnus-message 3 "nnkiboze: Checking %s..." (caar newsrc)) 260 (gnus-message 3 "nnkiboze: Checking %s..." (caar newsrc))
261 (setq ginfo (gnus-get-info (gnus-group-group-name)) 261 (setq ginfo (gnus-get-info (gnus-group-group-name))
262 orig-info (gnus-copy-sequence ginfo)) 262 orig-info (gnus-copy-sequence ginfo))
266 ;; on copies of the real lists, we can destroy anything we 266 ;; on copies of the real lists, we can destroy anything we
267 ;; want here. 267 ;; want here.
268 (when (nth 3 ginfo) 268 (when (nth 3 ginfo)
269 (setcar (nthcdr 3 ginfo) nil)) 269 (setcar (nthcdr 3 ginfo) nil))
270 ;; We set the list of read articles to be what we expect for 270 ;; We set the list of read articles to be what we expect for
271 ;; this kiboze group -- either nil or `(1 . LOWEST)'. 271 ;; this kiboze group -- either nil or `(1 . LOWEST)'.
272 (when ginfo 272 (when ginfo
273 (setcar (nthcdr 2 ginfo) 273 (setcar (nthcdr 2 ginfo)
274 (and (not (= lowest 1)) (cons 1 lowest)))) 274 (and (not (= lowest 1)) (cons 1 lowest))))
275 (when (and (or (not ginfo) 275 (when (and (or (not ginfo)
276 (> (length (gnus-list-of-unread-articles 276 (> (length (gnus-list-of-unread-articles
277 (car ginfo))) 277 (car ginfo)))
278 0)) 278 0))
279 (progn 279 (progn
280 (gnus-group-select-group nil) 280 (gnus-group-select-group nil)
281 (eq major-mode 'gnus-summary-mode))) 281 (eq major-mode 'gnus-summary-mode)))
282 ;; We are now in the group where we want to be. 282 ;; We are now in the group where we want to be.
283 (setq method (gnus-find-method-for-group 283 (setq method (gnus-find-method-for-group
284 gnus-newsgroup-name)) 284 gnus-newsgroup-name))
285 (when (eq method gnus-select-method) 285 (when (eq method gnus-select-method)
286 (setq method nil)) 286 (setq method nil))
287 ;; We go through the list of scored articles. 287 ;; We go through the list of scored articles.
288 (while gnus-newsgroup-scored 288 (while gnus-newsgroup-scored
289 (when (> (caar gnus-newsgroup-scored) lowest) 289 (when (> (caar gnus-newsgroup-scored) lowest)
290 ;; If it has a good score, then we enter this article 290 ;; If it has a good score, then we enter this article
291 ;; into the kiboze group. 291 ;; into the kiboze group.
292 (nnkiboze-enter-nov 292 (nnkiboze-enter-nov
293 nov-buffer 293 nov-buffer
294 (gnus-summary-article-header 294 (gnus-summary-article-header
295 (caar gnus-newsgroup-scored)) 295 (caar gnus-newsgroup-scored))
296 gnus-newsgroup-name)) 296 gnus-newsgroup-name))
297 (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored))) 297 (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored)))
298 ;; That's it. We exit this group. 298 ;; That's it. We exit this group.
299 (gnus-summary-exit-no-update))) 299 (gnus-summary-exit-no-update)))
307 (nnheader-temp-write newsrc-file 307 (nnheader-temp-write newsrc-file
308 (insert "(setq nnkiboze-newsrc '") 308 (insert "(setq nnkiboze-newsrc '")
309 (gnus-prin1 nnkiboze-newsrc) 309 (gnus-prin1 nnkiboze-newsrc)
310 (insert ")\n")) 310 (insert ")\n"))
311 t)) 311 t))
312 312
313 (defun nnkiboze-enter-nov (buffer header group) 313 (defun nnkiboze-enter-nov (buffer header group)
314 (save-excursion 314 (save-excursion
315 (set-buffer buffer) 315 (set-buffer buffer)
316 (goto-char (point-max)) 316 (goto-char (point-max))
317 (let ((xref (mail-header-xref header)) 317 (let ((xref (mail-header-xref header))
331 (goto-char (match-beginning 0)) 331 (goto-char (match-beginning 0))
332 (forward-char 1)) 332 (forward-char 1))
333 ;; The first Xref has to be the group this article 333 ;; The first Xref has to be the group this article
334 ;; really came for - this is the article nnkiboze 334 ;; really came for - this is the article nnkiboze
335 ;; will request when it is asked for the article. 335 ;; will request when it is asked for the article.
336 (insert group ":" 336 (insert group ":"
337 (int-to-string (mail-header-number header)) " ") 337 (int-to-string (mail-header-number header)) " ")
338 (while (re-search-forward " [^ ]+:[0-9]+" nil t) 338 (while (re-search-forward " [^ ]+:[0-9]+" nil t)
339 (goto-char (1+ (match-beginning 0))) 339 (goto-char (1+ (match-beginning 0)))
340 (insert prefix))))) 340 (insert prefix)))))
341 341