Mercurial > emacs

comparison lisp/gnus/nnkiboze.el @ 88155:d7ddb3e565de

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
sync with trunk
author Henrik Enberg <henrik.enberg@telia.com>
date Mon, 16 Jan 2006 00:03:54 +0000
parents 0d8b17d428b5
children
comparison
equal deleted inserted replaced
88154:8ce476d3ba36 88155:d7ddb3e565de
1 ;;; nnkiboze.el --- select virtual news access for Gnus 1 ;;; nnkiboze.el --- select virtual news access for Gnus
2 2
3 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 3 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2002, 2003, 2004,
4 ;; Free Software Foundation, Inc. 4 ;; 2005 Free Software Foundation, Inc.
5 5
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> 6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
7 ;; Keywords: news 7 ;; Keywords: news
8 8
9 ;; This file is part of GNU Emacs. 9 ;; This file is part of GNU Emacs.
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details. 19 ;; GNU General Public License for more details.
20 20
21 ;; You should have received a copy of the GNU General Public License 21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the 22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24 ;; Boston, MA 02111-1307, USA. 24 ;; Boston, MA 02110-1301, USA.
25 25
26 ;;; Commentary: 26 ;;; Commentary:
27 27
28 ;; The other access methods (nntp, nnspool, etc) are general news 28 ;; The other access methods (nntp, nnspool, etc) are general news
29 ;; access methods. This module relies on Gnus and can't be used 29 ;; access methods. This module relies on Gnus and can't be used
104 num group) 104 num group)
105 (unless xref 105 (unless xref
106 (error "nnkiboze: No xref")) 106 (error "nnkiboze: No xref"))
107 (unless (string-match " \\([^ ]+\\):\\([0-9]+\\)" xref) 107 (unless (string-match " \\([^ ]+\\):\\([0-9]+\\)" xref)
108 (error "nnkiboze: Malformed xref")) 108 (error "nnkiboze: Malformed xref"))
109 (setq num (string-to-int (match-string 2 xref)) 109 (setq num (string-to-number (match-string 2 xref))
110 group (match-string 1 xref)) 110 group (match-string 1 xref))
111 (or (with-current-buffer buffer 111 (or (with-current-buffer buffer
112 (gnus-cache-request-article num group)) 112 (or (and gnus-use-cache (gnus-cache-request-article num group))
113 (gnus-agent-request-article num group)))
113 (gnus-request-article num group buffer))))) 114 (gnus-request-article num group buffer)))))
114 115
115 (deffoo nnkiboze-request-scan (&optional group server) 116 (deffoo nnkiboze-request-scan (&optional group server)
117 (nnkiboze-possibly-change-group group)
116 (nnkiboze-generate-group (concat "nnkiboze:" group))) 118 (nnkiboze-generate-group (concat "nnkiboze:" group)))
117 119
118 (deffoo nnkiboze-request-group (group &optional server dont-check) 120 (deffoo nnkiboze-request-group (group &optional server dont-check)
119 "Make GROUP the current newsgroup." 121 "Make GROUP the current newsgroup."
120 (nnkiboze-possibly-change-group group) 122 (nnkiboze-possibly-change-group group)
225 "." gnus-score-file-suffix)))))) 227 "." gnus-score-file-suffix))))))
226 228
227 (defun nnkiboze-generate-group (group &optional inhibit-list-groups) 229 (defun nnkiboze-generate-group (group &optional inhibit-list-groups)
228 (let* ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) 230 (let* ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))
229 (newsrc-file (concat nnkiboze-directory 231 (newsrc-file (concat nnkiboze-directory
230 (nnheader-translate-file-chars 232 (nnheader-translate-file-chars
231 (concat group ".newsrc")))) 233 (concat group ".newsrc"))))
232 (nov-file (concat nnkiboze-directory 234 (nov-file (concat nnkiboze-directory
233 (nnheader-translate-file-chars 235 (nnheader-translate-file-chars
234 (concat group ".nov")))) 236 (concat group ".nov"))))
235 method nnkiboze-newsrc gname newsrc active 237 method nnkiboze-newsrc gname newsrc active
236 ginfo lowest glevel orig-info nov-buffer 238 ginfo lowest glevel orig-info nov-buffer
237 ;; Bind various things to nil to make group entry faster. 239 ;; Bind various things to nil to make group entry faster.
238 (gnus-expert-user t) 240 (gnus-expert-user t)
239 (gnus-large-newsgroup nil) 241 (gnus-large-newsgroup nil)
240 (gnus-score-find-score-files-function 'nnkiboze-score-file) 242 (gnus-score-find-score-files-function 'nnkiboze-score-file)
241 ;; Use only nnkiboze-score-file! 243 ;; Use only nnkiboze-score-file!
242 (gnus-score-use-all-scores nil) 244 (gnus-score-use-all-scores nil)
243 (gnus-use-scoring t) 245 (gnus-use-scoring t)
244 (gnus-verbose (min gnus-verbose 3)) 246 (gnus-verbose (min gnus-verbose 3))
245 gnus-select-group-hook gnus-summary-prepare-hook 247 gnus-select-group-hook gnus-summary-prepare-hook
246 gnus-thread-sort-functions gnus-show-threads 248 gnus-thread-sort-functions gnus-show-threads
247 gnus-visual gnus-suppress-duplicates num-unread) 249 gnus-visual gnus-suppress-duplicates num-unread)
248 (unless info 250 (unless info
249 (error "No such group: %s" group)) 251 (error "No such group: %s" group))
250 ;; Load the kiboze newsrc file for this group. 252 ;; Load the kiboze newsrc file for this group.
251 (when (file-exists-p newsrc-file) 253 (mm-with-unibyte
252 (load newsrc-file)) 254 (when (file-exists-p newsrc-file)
253 (let ((coding-system-for-write nnkiboze-file-coding-system)) 255 (load newsrc-file))
254 (with-temp-file nov-file 256 (let ((coding-system-for-write nnkiboze-file-coding-system))
255 (when (file-exists-p nov-file) 257 (gnus-make-directory (file-name-directory nov-file))
256 (insert-file-contents nov-file)) 258 (with-temp-file nov-file
257 (setq nov-buffer (current-buffer)) 259 (when (file-exists-p nov-file)
258 ;; Go through the active hashtb and add new all groups that match the 260 (insert-file-contents nov-file))
259 ;; kiboze regexp. 261 (setq nov-buffer (current-buffer))
260 (mapatoms 262 ;; Go through the active hashtb and add new all groups that match the
261 (lambda (group) 263 ;; kiboze regexp.
262 (and (string-match nnkiboze-regexp 264 (mapatoms
263 (setq gname (symbol-name group))) ; Match 265 (lambda (group)
264 (not (assoc gname nnkiboze-newsrc)) ; It isn't registered 266 (and (string-match nnkiboze-regexp
265 (numberp (car (symbol-value group))) ; It is active 267 (setq gname (symbol-name group))) ; Match
266 (or (> nnkiboze-level 7) 268 (not (assoc gname nnkiboze-newsrc)) ; It isn't registered
267 (and (setq glevel (nth 1 (nth 2 (gnus-gethash 269 (numberp (car (symbol-value group))) ; It is active
268 gname gnus-newsrc-hashtb)))) 270 (or (> nnkiboze-level 7)
269 (>= nnkiboze-level glevel))) 271 (and (setq glevel
270 (not (string-match "^nnkiboze:" gname)) ; Exclude kibozes 272 (nth 1 (nth 2 (gnus-gethash
271 (push (cons gname (1- (car (symbol-value group)))) 273 gname gnus-newsrc-hashtb))))
272 nnkiboze-newsrc))) 274 (>= nnkiboze-level glevel)))
273 gnus-active-hashtb) 275 (not (string-match "^nnkiboze:" gname)) ; Exclude kibozes
274 ;; `newsrc' is set to the list of groups that possibly are 276 (push (cons gname (1- (car (symbol-value group))))
275 ;; component groups to this kiboze group. This list has elements 277 nnkiboze-newsrc)))
276 ;; on the form `(GROUP . NUMBER)', where NUMBER is the highest 278 gnus-active-hashtb)
277 ;; number that has been kibozed in GROUP in this kiboze group. 279 ;; `newsrc' is set to the list of groups that possibly are
278 (setq newsrc nnkiboze-newsrc) 280 ;; component groups to this kiboze group. This list has elements
279 (while newsrc 281 ;; on the form `(GROUP . NUMBER)', where NUMBER is the highest
280 (if (not (setq active (gnus-gethash 282 ;; number that has been kibozed in GROUP in this kiboze group.
281 (caar newsrc) gnus-active-hashtb))) 283 (setq newsrc nnkiboze-newsrc)
282 ;; This group isn't active after all, so we remove it from 284 (while newsrc
283 ;; the list of component groups. 285 (if (not (setq active (gnus-gethash
284 (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc)) 286 (caar newsrc) gnus-active-hashtb)))
285 (setq lowest (cdar newsrc)) 287 ;; This group isn't active after all, so we remove it from
286 ;; Ok, we have a valid component group, so we jump to it. 288 ;; the list of component groups.
287 (switch-to-buffer gnus-group-buffer) 289 (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc))
288 (gnus-group-jump-to-group (caar newsrc)) 290 (setq lowest (cdar newsrc))
289 (gnus-message 3 "nnkiboze: Checking %s..." (caar newsrc)) 291 ;; Ok, we have a valid component group, so we jump to it.
290 (setq ginfo (gnus-get-info (gnus-group-group-name)) 292 (switch-to-buffer gnus-group-buffer)
291 orig-info (gnus-copy-sequence ginfo) 293 (gnus-group-jump-to-group (caar newsrc))
292 num-unread (car (gnus-gethash (caar newsrc) 294 (gnus-message 3 "nnkiboze: Checking %s..." (caar newsrc))
293 gnus-newsrc-hashtb))) 295 (setq ginfo (gnus-get-info (gnus-group-group-name))
294 (unwind-protect 296 orig-info (gnus-copy-sequence ginfo)
295 (progn 297 num-unread (car (gnus-gethash (caar newsrc)
296 ;; We set all list of article marks to nil. Since we operate 298 gnus-newsrc-hashtb)))
297 ;; on copies of the real lists, we can destroy anything we 299 (unwind-protect
298 ;; want here. 300 (progn
299 (when (nth 3 ginfo) 301 ;; We set all list of article marks to nil. Since we operate
300 (setcar (nthcdr 3 ginfo) nil)) 302 ;; on copies of the real lists, we can destroy anything we
301 ;; We set the list of read articles to be what we expect for 303 ;; want here.
302 ;; this kiboze group -- either nil or `(1 . LOWEST)'. 304 (when (nth 3 ginfo)
303 (when ginfo 305 (setcar (nthcdr 3 ginfo) nil))
304 (setcar (nthcdr 2 ginfo) 306 ;; We set the list of read articles to be what we expect for
305 (and (not (= lowest 1)) (cons 1 lowest)))) 307 ;; this kiboze group -- either nil or `(1 . LOWEST)'.
306 (when (and (or (not ginfo) 308 (when ginfo
307 (> (length (gnus-list-of-unread-articles 309 (setcar (nthcdr 2 ginfo)
308 (car ginfo))) 310 (and (not (= lowest 1)) (cons 1 lowest))))
309 0)) 311 (when (and (or (not ginfo)
310 (progn 312 (> (length (gnus-list-of-unread-articles
311 (ignore-errors 313 (car ginfo)))
312 (gnus-group-select-group nil)) 314 0))
313 (eq major-mode 'gnus-summary-mode))) 315 (progn
314 ;; We are now in the group where we want to be. 316 (ignore-errors
315 (setq method (gnus-find-method-for-group 317 (gnus-group-select-group nil))
316 gnus-newsgroup-name)) 318 (eq major-mode 'gnus-summary-mode)))
317 (when (eq method gnus-select-method) 319 ;; We are now in the group where we want to be.
318 (setq method nil)) 320 (setq method (gnus-find-method-for-group
319 ;; We go through the list of scored articles. 321 gnus-newsgroup-name))
320 (while gnus-newsgroup-scored 322 (when (eq method gnus-select-method)
321 (when (> (caar gnus-newsgroup-scored) lowest) 323 (setq method nil))
322 ;; If it has a good score, then we enter this article 324 ;; We go through the list of scored articles.
323 ;; into the kiboze group. 325 (while gnus-newsgroup-scored
324 (nnkiboze-enter-nov 326 (when (> (caar gnus-newsgroup-scored) lowest)
325 nov-buffer 327 ;; If it has a good score, then we enter this article
326 (gnus-summary-article-header 328 ;; into the kiboze group.
327 (caar gnus-newsgroup-scored)) 329 (nnkiboze-enter-nov
328 gnus-newsgroup-name)) 330 nov-buffer
329 (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored))) 331 (gnus-summary-article-header
330 ;; That's it. We exit this group. 332 (caar gnus-newsgroup-scored))
331 (when (eq major-mode 'gnus-summary-mode) 333 gnus-newsgroup-name))
332 (kill-buffer (current-buffer))))) 334 (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored)))
333 ;; Restore the proper info. 335 ;; That's it. We exit this group.
334 (when ginfo 336 (when (eq major-mode 'gnus-summary-mode)
335 (setcdr ginfo (cdr orig-info))) 337 (kill-buffer (current-buffer)))))
336 (setcar (gnus-gethash (caar newsrc) gnus-newsrc-hashtb) 338 ;; Restore the proper info.
337 num-unread))) 339 (when ginfo
338 (setcdr (car newsrc) (car active)) 340 (setcdr ginfo (cdr orig-info)))
339 (gnus-message 3 "nnkiboze: Checking %s...done" (caar newsrc)) 341 (setcar (gnus-gethash (caar newsrc) gnus-newsrc-hashtb)
340 (setq newsrc (cdr newsrc))))) 342 num-unread)))
341 ;; We save the kiboze newsrc for this group. 343 (setcdr (car newsrc) (cdr active))
342 (with-temp-file newsrc-file 344 (gnus-message 3 "nnkiboze: Checking %s...done" (caar newsrc))
343 (insert "(setq nnkiboze-newsrc '") 345 (setq newsrc (cdr newsrc)))))
344 (gnus-prin1 nnkiboze-newsrc) 346 ;; We save the kiboze newsrc for this group.
345 (insert ")\n"))) 347 (gnus-make-directory (file-name-directory newsrc-file))
348 (with-temp-file newsrc-file
349 (insert "(setq nnkiboze-newsrc '")
350 (gnus-prin1 nnkiboze-newsrc)
351 (insert ")\n")))
346 (unless inhibit-list-groups 352 (unless inhibit-list-groups
347 (save-excursion 353 (save-excursion
348 (set-buffer gnus-group-buffer) 354 (set-buffer gnus-group-buffer)
349 (gnus-group-list-groups))) 355 (gnus-group-list-groups)))
350 t) 356 t))
351 357
352 (defun nnkiboze-enter-nov (buffer header group) 358 (defun nnkiboze-enter-nov (buffer header group)
353 (save-excursion 359 (save-excursion
354 (set-buffer buffer) 360 (set-buffer buffer)
355 (goto-char (point-max)) 361 (goto-char (point-max))
385 (concat (nnkiboze-prefixed-name nnkiboze-current-group) 391 (concat (nnkiboze-prefixed-name nnkiboze-current-group)
386 (or suffix ".nov"))))) 392 (or suffix ".nov")))))
387 393
388 (provide 'nnkiboze) 394 (provide 'nnkiboze)
389 395
396 ;;; arch-tag: 66068271-bdc9-4801-bcde-779702e73a05
390 ;;; nnkiboze.el ends here 397 ;;; nnkiboze.el ends here