1;;; nnkiboze.el --- select virtual news access for Gnus 2 3;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> 7;; Keywords: news 8 9;; This file is part of GNU Emacs. 10 11;; GNU Emacs is free software; you can redistribute it and/or modify 12;; it under the terms of the GNU General Public License as published by 13;; the Free Software Foundation; either version 2, or (at your option) 14;; any later version. 15 16;; GNU Emacs is distributed in the hope that it will be useful, 17;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; GNU General Public License for more details. 20 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 23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 24;; Boston, MA 02110-1301, USA. 25 26;;; Commentary: 27 28;; The other access methods (nntp, nnspool, etc) are general news 29;; access methods. This module relies on Gnus and can't be used 30;; separately. 31 32;;; Code: 33 34(require 'nntp) 35(require 'nnheader) 36(require 'gnus) 37(require 'gnus-score) 38(require 'nnoo) 39(require 'mm-util) 40(eval-when-compile (require 'cl)) 41 42(nnoo-declare nnkiboze) 43(defvoo nnkiboze-directory (nnheader-concat gnus-directory "kiboze/") 44 "nnkiboze will put its files in this directory.") 45 46(defvoo nnkiboze-level 9 47 "The maximum level to be searched for articles.") 48 49(defvoo nnkiboze-remove-read-articles t 50 "If non-nil, nnkiboze will remove read articles from the kiboze group.") 51 52(defvoo nnkiboze-ephemeral nil 53 "If non-nil, don't store any data anywhere.") 54 55(defvoo nnkiboze-scores nil 56 "Score rules for generating the nnkiboze group.") 57 58(defvoo nnkiboze-regexp nil 59 "Regexp for matching component groups.") 60 61(defvoo nnkiboze-file-coding-system mm-text-coding-system 62 "Coding system for nnkiboze files.") 63 64 65 66(defconst nnkiboze-version "nnkiboze 1.0") 67 68(defvoo nnkiboze-current-group nil) 69(defvoo nnkiboze-status-string "") 70 71(defvoo nnkiboze-headers nil) 72 73 74 75;;; Interface functions. 76 77(nnoo-define-basics nnkiboze) 78 79(deffoo nnkiboze-retrieve-headers (articles &optional group server fetch-old) 80 (nnkiboze-possibly-change-group group) 81 (unless gnus-nov-is-evil 82 (if (stringp (car articles)) 83 'headers 84 (let ((nov (nnkiboze-nov-file-name))) 85 (when (file-exists-p nov) 86 (save-excursion 87 (set-buffer nntp-server-buffer) 88 (erase-buffer) 89 (let ((nnheader-file-coding-system nnkiboze-file-coding-system)) 90 (nnheader-insert-file-contents nov)) 91 (nnheader-nov-delete-outside-range 92 (car articles) (car (last articles))) 93 'nov)))))) 94 95(deffoo nnkiboze-request-article (article &optional newsgroup server buffer) 96 (nnkiboze-possibly-change-group newsgroup) 97 (if (not (numberp article)) 98 ;; This is a real kludge. It might not work at times, but it 99 ;; does no harm I think. The only alternative is to offer no 100 ;; article fetching by message-id at all. 101 (nntp-request-article article newsgroup gnus-nntp-server buffer) 102 (let* ((header (gnus-summary-article-header article)) 103 (xref (mail-header-xref header)) 104 num group) 105 (unless xref 106 (error "nnkiboze: No xref")) 107 (unless (string-match " \\([^ ]+\\):\\([0-9]+\\)" xref) 108 (error "nnkiboze: Malformed xref")) 109 (setq num (string-to-number (match-string 2 xref)) 110 group (match-string 1 xref)) 111 (or (with-current-buffer buffer 112 (or (and gnus-use-cache (gnus-cache-request-article num group)) 113 (gnus-agent-request-article num group))) 114 (gnus-request-article num group buffer))))) 115 116(deffoo nnkiboze-request-scan (&optional group server) 117 (nnkiboze-possibly-change-group group) 118 (nnkiboze-generate-group (concat "nnkiboze:" group))) 119 120(deffoo nnkiboze-request-group (group &optional server dont-check) 121 "Make GROUP the current newsgroup." 122 (nnkiboze-possibly-change-group group) 123 (if dont-check 124 t 125 (let ((nov-file (nnkiboze-nov-file-name)) 126 beg end total) 127 (save-excursion 128 (set-buffer nntp-server-buffer) 129 (erase-buffer) 130 (unless (file-exists-p nov-file) 131 (nnkiboze-request-scan group)) 132 (if (not (file-exists-p nov-file)) 133 (nnheader-report 'nnkiboze "Can't select group %s" group) 134 (let ((nnheader-file-coding-system nnkiboze-file-coding-system)) 135 (nnheader-insert-file-contents nov-file)) 136 (if (zerop (buffer-size)) 137 (nnheader-insert "211 0 0 0 %s\n" group) 138 (goto-char (point-min)) 139 (when (looking-at "[0-9]+") 140 (setq beg (read (current-buffer)))) 141 (goto-char (point-max)) 142 (when (re-search-backward "^[0-9]" nil t) 143 (setq end (read (current-buffer)))) 144 (setq total (count-lines (point-min) (point-max))) 145 (nnheader-insert "211 %d %d %d %s\n" total beg end group))))))) 146 147(deffoo nnkiboze-close-group (group &optional server) 148 (nnkiboze-possibly-change-group group) 149 ;; Remove NOV lines of articles that are marked as read. 150 (when (and (file-exists-p (nnkiboze-nov-file-name)) 151 nnkiboze-remove-read-articles) 152 (let ((coding-system-for-write nnkiboze-file-coding-system)) 153 (with-temp-file (nnkiboze-nov-file-name) 154 (let ((cur (current-buffer)) 155 (nnheader-file-coding-system nnkiboze-file-coding-system)) 156 (nnheader-insert-file-contents (nnkiboze-nov-file-name)) 157 (goto-char (point-min)) 158 (while (not (eobp)) 159 (if (not (gnus-article-read-p (read cur))) 160 (forward-line 1) 161 (gnus-delete-line)))))) 162 (setq nnkiboze-current-group nil))) 163 164(deffoo nnkiboze-open-server (server &optional defs) 165 (unless (assq 'nnkiboze-regexp defs) 166 (push `(nnkiboze-regexp ,server) 167 defs)) 168 (nnoo-change-server 'nnkiboze server defs)) 169 170(deffoo nnkiboze-request-delete-group (group &optional force server) 171 (nnkiboze-possibly-change-group group) 172 (when force 173 (let ((files (nconc 174 (nnkiboze-score-file group) 175 (list (nnkiboze-nov-file-name) 176 (nnkiboze-nov-file-name ".newsrc"))))) 177 (while files 178 (and (file-exists-p (car files)) 179 (file-writable-p (car files)) 180 (delete-file (car files))) 181 (setq files (cdr files))))) 182 (setq nnkiboze-current-group nil) 183 t) 184 185(nnoo-define-skeleton nnkiboze) 186 187 188;;; Internal functions. 189 190(defun nnkiboze-possibly-change-group (group) 191 (setq nnkiboze-current-group group)) 192 193(defun nnkiboze-prefixed-name (group) 194 (gnus-group-prefixed-name group '(nnkiboze ""))) 195 196;;;###autoload 197(defun nnkiboze-generate-groups () 198 "\"Usage: emacs -batch -l nnkiboze -f nnkiboze-generate-groups\". 199Finds out what articles are to be part of the nnkiboze groups." 200 (interactive) 201 (let ((nnmail-spool-file nil) 202 (mail-sources nil) 203 (gnus-use-dribble-file nil) 204 (gnus-read-active-file t) 205 (gnus-expert-user t)) 206 (gnus)) 207 (let* ((gnus-newsrc-alist (gnus-copy-sequence gnus-newsrc-alist)) 208 (newsrc (cdr gnus-newsrc-alist)) 209 gnus-newsrc-hashtb info) 210 (gnus-make-hashtable-from-newsrc-alist) 211 ;; We have copied all the newsrc alist info over to local copies 212 ;; so that we can mess all we want with these lists. 213 (while (setq info (pop newsrc)) 214 (when (string-match "nnkiboze" (gnus-info-group info)) 215 ;; For each kiboze group, we call this function to generate 216 ;; it. 217 (nnkiboze-generate-group (gnus-info-group info) t)))) 218 (save-excursion 219 (set-buffer gnus-group-buffer) 220 (gnus-group-list-groups))) 221 222(defun nnkiboze-score-file (group) 223 (list (expand-file-name 224 (concat (file-name-as-directory gnus-kill-files-directory) 225 (nnheader-translate-file-chars 226 (concat (nnkiboze-prefixed-name nnkiboze-current-group) 227 "." gnus-score-file-suffix)))))) 228 229(defun nnkiboze-generate-group (group &optional inhibit-list-groups) 230 (let* ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) 231 (newsrc-file (concat nnkiboze-directory 232 (nnheader-translate-file-chars 233 (concat group ".newsrc")))) 234 (nov-file (concat nnkiboze-directory 235 (nnheader-translate-file-chars 236 (concat group ".nov")))) 237 method nnkiboze-newsrc gname newsrc active 238 ginfo lowest glevel orig-info nov-buffer 239 ;; Bind various things to nil to make group entry faster. 240 (gnus-expert-user t) 241 (gnus-large-newsgroup nil) 242 (gnus-score-find-score-files-function 'nnkiboze-score-file) 243 ;; Use only nnkiboze-score-file! 244 (gnus-score-use-all-scores nil) 245 (gnus-use-scoring t) 246 (gnus-verbose (min gnus-verbose 3)) 247 gnus-select-group-hook gnus-summary-prepare-hook 248 gnus-thread-sort-functions gnus-show-threads 249 gnus-visual gnus-suppress-duplicates num-unread) 250 (unless info 251 (error "No such group: %s" group)) 252 ;; Load the kiboze newsrc file for this group. 253 (mm-with-unibyte 254 (when (file-exists-p newsrc-file) 255 (load newsrc-file)) 256 (let ((coding-system-for-write nnkiboze-file-coding-system)) 257 (gnus-make-directory (file-name-directory nov-file)) 258 (with-temp-file nov-file 259 (when (file-exists-p nov-file) 260 (insert-file-contents nov-file)) 261 (setq nov-buffer (current-buffer)) 262 ;; Go through the active hashtb and add new all groups that match the 263 ;; kiboze regexp. 264 (mapatoms 265 (lambda (group) 266 (and (string-match nnkiboze-regexp 267 (setq gname (symbol-name group))) ; Match 268 (not (assoc gname nnkiboze-newsrc)) ; It isn't registered 269 (numberp (car (symbol-value group))) ; It is active 270 (or (> nnkiboze-level 7) 271 (and (setq glevel 272 (nth 1 (nth 2 (gnus-gethash 273 gname gnus-newsrc-hashtb)))) 274 (>= nnkiboze-level glevel))) 275 (not (string-match "^nnkiboze:" gname)) ; Exclude kibozes 276 (push (cons gname (1- (car (symbol-value group)))) 277 nnkiboze-newsrc))) 278 gnus-active-hashtb) 279 ;; `newsrc' is set to the list of groups that possibly are 280 ;; component groups to this kiboze group. This list has elements 281 ;; on the form `(GROUP . NUMBER)', where NUMBER is the highest 282 ;; number that has been kibozed in GROUP in this kiboze group. 283 (setq newsrc nnkiboze-newsrc) 284 (while newsrc 285 (if (not (setq active (gnus-gethash 286 (caar newsrc) gnus-active-hashtb))) 287 ;; This group isn't active after all, so we remove it from 288 ;; the list of component groups. 289 (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc)) 290 (setq lowest (cdar newsrc)) 291 ;; Ok, we have a valid component group, so we jump to it. 292 (switch-to-buffer gnus-group-buffer) 293 (gnus-group-jump-to-group (caar newsrc)) 294 (gnus-message 3 "nnkiboze: Checking %s..." (caar newsrc)) 295 (setq ginfo (gnus-get-info (gnus-group-group-name)) 296 orig-info (gnus-copy-sequence ginfo) 297 num-unread (car (gnus-gethash (caar newsrc) 298 gnus-newsrc-hashtb))) 299 (unwind-protect 300 (progn 301 ;; We set all list of article marks to nil. Since we operate 302 ;; on copies of the real lists, we can destroy anything we 303 ;; want here. 304 (when (nth 3 ginfo) 305 (setcar (nthcdr 3 ginfo) nil)) 306 ;; We set the list of read articles to be what we expect for 307 ;; this kiboze group -- either nil or `(1 . LOWEST)'. 308 (when ginfo 309 (setcar (nthcdr 2 ginfo) 310 (and (not (= lowest 1)) (cons 1 lowest)))) 311 (when (and (or (not ginfo) 312 (> (length (gnus-list-of-unread-articles 313 (car ginfo))) 314 0)) 315 (progn 316 (ignore-errors 317 (gnus-group-select-group nil)) 318 (eq major-mode 'gnus-summary-mode))) 319 ;; We are now in the group where we want to be. 320 (setq method (gnus-find-method-for-group 321 gnus-newsgroup-name)) 322 (when (eq method gnus-select-method) 323 (setq method nil)) 324 ;; We go through the list of scored articles. 325 (while gnus-newsgroup-scored 326 (when (> (caar gnus-newsgroup-scored) lowest) 327 ;; If it has a good score, then we enter this article 328 ;; into the kiboze group. 329 (nnkiboze-enter-nov 330 nov-buffer 331 (gnus-summary-article-header 332 (caar gnus-newsgroup-scored)) 333 gnus-newsgroup-name)) 334 (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored))) 335 ;; That's it. We exit this group. 336 (when (eq major-mode 'gnus-summary-mode) 337 (kill-buffer (current-buffer))))) 338 ;; Restore the proper info. 339 (when ginfo 340 (setcdr ginfo (cdr orig-info))) 341 (setcar (gnus-gethash (caar newsrc) gnus-newsrc-hashtb) 342 num-unread))) 343 (setcdr (car newsrc) (cdr active)) 344 (gnus-message 3 "nnkiboze: Checking %s...done" (caar newsrc)) 345 (setq newsrc (cdr newsrc))))) 346 ;; We save the kiboze newsrc for this group. 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"))) 352 (unless inhibit-list-groups 353 (save-excursion 354 (set-buffer gnus-group-buffer) 355 (gnus-group-list-groups))) 356 t)) 357 358(defun nnkiboze-enter-nov (buffer header group) 359 (save-excursion 360 (set-buffer buffer) 361 (goto-char (point-max)) 362 (let ((prefix (gnus-group-real-prefix group)) 363 (oheader (copy-sequence header)) 364 article) 365 (if (zerop (forward-line -1)) 366 (progn 367 (setq article (1+ (read (current-buffer)))) 368 (forward-line 1)) 369 (setq article 1)) 370 (mail-header-set-number oheader article) 371 (with-temp-buffer 372 (insert (or (mail-header-xref oheader) "")) 373 (goto-char (point-min)) 374 (if (re-search-forward " [^ ]+:[0-9]+" nil t) 375 (goto-char (match-beginning 0)) 376 (or (eobp) (forward-char 1))) 377 ;; The first Xref has to be the group this article 378 ;; really came for - this is the article nnkiboze 379 ;; will request when it is asked for the article. 380 (insert " " group ":" 381 (int-to-string (mail-header-number header)) " ") 382 (while (re-search-forward " [^ ]+:[0-9]+" nil t) 383 (goto-char (1+ (match-beginning 0))) 384 (insert prefix)) 385 (mail-header-set-xref oheader (buffer-string))) 386 (nnheader-insert-nov oheader)))) 387 388(defun nnkiboze-nov-file-name (&optional suffix) 389 (concat (file-name-as-directory nnkiboze-directory) 390 (nnheader-translate-file-chars 391 (concat (nnkiboze-prefixed-name nnkiboze-current-group) 392 (or suffix ".nov"))))) 393 394(provide 'nnkiboze) 395 396;;; arch-tag: 66068271-bdc9-4801-bcde-779702e73a05 397;;; nnkiboze.el ends here 398