cgit.sxemacs.org Git - gnus/blob - lisp/nnkiboze.el

   1 ;;;; nnkiboze.el --- select virtual news access for (ding) Gnus
   2 ;; Copyright (C) 1995 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
   5 ;; Keywords: news
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  21 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  22
  23 ;;; Commentary:
  24
  25 ;; The other access methods (nntp, nnspool, etc) are general news
  26 ;; access methods. This module relies on Gnus and can not be used
  27 ;; separately.
  28
  29 ;;; Code:
  30
  31 (require 'nntp)
  32 (require 'nnheader)
  33 (require 'gnus)
  34 (require 'gnus-score)
  35
  36 (defvar nnkiboze-directory
  37   (expand-file-name (or gnus-article-save-directory "~/News/"))
  38   "nnkiboze will put its files in this directory.")
  39
  40 \f
  41
  42 (defconst nnkiboze-version "nnkiboze 0.0"
  43   "Version numbers of this version of nnkiboze.")
  44
  45 (defvar nnkiboze-current-group nil)
  46 (defvar nnkiboze-current-score-group "")
  47 (defvar nnkiboze-status-string "")
  48
  49 \f
  50
  51 ;;; Interface functions.
  52
  53 (defun nnkiboze-retrieve-headers (articles &optional group server)
  54   (nnkiboze-possibly-change-newsgroups group)
  55   (if (or gnus-nov-is-evil)
  56       nil
  57     (let ((first (car articles))
  58           (last (progn (while (cdr articles) (setq articles (cdr articles)))
  59                        (car articles)))
  60           (nov (nnkiboze-nov-file-name)))
  61       (if (file-exists-p nov)
  62           (save-excursion
  63             (set-buffer nntp-server-buffer)
  64             (erase-buffer)
  65             (insert-file-contents nov)
  66             (goto-char (point-min))
  67             (while (and (not (eobp)) (< first (read (current-buffer))))
  68               (forward-line 1))
  69             (beginning-of-line)
  70             (if (not (eobp)) (delete-region 1 (point)))
  71             (while (and (not (eobp)) (>= last (read (current-buffer))))
  72               (forward-line 1))
  73             (beginning-of-line)
  74             (if (not (eobp)) (delete-region (point) (point-max)))
  75             'nov)))))
  76
  77 (defun nnkiboze-open-server (newsgroups &optional something)
  78   "Open a virtual newsgroup that contains NEWSGROUPS."
  79   (gnus-make-directory nnkiboze-directory)
  80   (nnheader-init-server-buffer))
  81
  82 (defun nnkiboze-close-server (&rest dum)
  83   "Close news server."
  84   t)
  85
  86 (fset 'nnkiboze-request-quit (symbol-function 'nnkiboze-close-server))
  87
  88 (defun nnkiboze-server-opened (&optional server)
  89   "Return server process status, T or NIL.
  90 If the stream is opened, return T, otherwise return NIL."
  91   (and nntp-server-buffer
  92        (get-buffer nntp-server-buffer)))
  93
  94 (defun nnkiboze-status-message (&optional server)
  95   "Return server status response as string."
  96   nnkiboze-status-string)
  97
  98 (defun nnkiboze-request-article (article &optional newsgroup server buffer)
  99   "Select article by message number."
 100   (nnkiboze-possibly-change-newsgroups newsgroup)
 101   (if (not (numberp article))
 102       ;; This is a real cludge. It might not work at times, but it
 103       ;; does no harm I think. The only alternative is to offer no
 104       ;; article fetching by message-id at all.
 105       (nntp-request-article article newsgroup gnus-nntp-server buffer)
 106     (let* ((header (gnus-get-header-by-number article))
 107            (xref (header-xref header))
 108            igroup iarticle)
 109       (or xref (error "nnkiboze: No xref"))
 110       (or (string-match " \\([^ ]+\\):\\([0-9]+\\)" xref)
 111           (error "nnkiboze: Malformed xref"))
 112       (setq igroup (substring xref (match-beginning 1) (match-end 1)))
 113       (setq iarticle (string-to-int
 114                       (substring xref (match-beginning 2) (match-end 2))))
 115       (and (gnus-request-group igroup t)
 116            (gnus-request-article iarticle igroup buffer)))))
 117
 118 (defun nnkiboze-request-group (group &optional server dont-check)
 119   "Make GROUP the current newsgroup."
 120   (nnkiboze-possibly-change-newsgroups group)
 121   (if dont-check
 122       ()
 123     (let (beg end total)
 124       (save-excursion
 125         (set-buffer nntp-server-buffer)
 126         (erase-buffer)
 127         (insert-file-contents (nnkiboze-nov-file-name))
 128         (if (zerop (buffer-size))
 129             (insert (format "211 0 0 0 %s\n" group))
 130           (goto-char (point-min))
 131           (and (looking-at "[0-9]+") (setq beg (read (current-buffer))))
 132           (goto-char (point-max))
 133           (and (re-search-backward "^[0-9]" nil t)
 134                (setq end (read (current-buffer))))
 135           (setq total (count-lines (point-min) (point-max)))
 136           (erase-buffer)
 137           (insert (format "211 %d %d %d %s\n" total beg end group))))))
 138   t)
 139
 140 (defun nnkiboze-close-group (group &optional server)
 141   (nnkiboze-possibly-change-newsgroups group)
 142   ;; Remove NOV lines of articles that are marked as read.
 143   (save-excursion
 144     (let ((unreads gnus-newsgroup-unreads)
 145           (unselected gnus-newsgroup-unselected))
 146       (set-buffer (get-buffer-create "*nnkiboze work*"))
 147       (buffer-disable-undo (current-buffer))
 148       (erase-buffer)
 149       (let ((cur (current-buffer))
 150             article)
 151         (insert-file-contents (nnkiboze-nov-file-name))
 152         (goto-char (point-min))
 153         (while (looking-at "[0-9]+")
 154           (if (or (memq (setq article (read cur)) unreads)
 155                   (memq article unselected))
 156               (forward-line 1)
 157             (delete-region (progn (beginning-of-line) (point))
 158                            (progn (forward-line 1) (point)))))
 159         (write-file (nnkiboze-nov-file-name))
 160         (kill-buffer (current-buffer)))))
 161   (setq nnkiboze-current-group nil))
 162
 163 (defun nnkiboze-request-list (&optional server)
 164   (setq nnkiboze-status-string "nnkiboze: LIST is not implemented.")
 165   nil)
 166
 167 (defun nnkiboze-request-newgroups (date &optional server)
 168   "List new groups."
 169   (setq nnkiboze-status-string "NEWGROUPS is not supported.")
 170   nil)
 171
 172 (defun nnkiboze-request-list-newsgroups (&optional server)
 173   (setq nnkiboze-status-string "nnkiboze: LIST NEWSGROUPS is not implemented.")
 174   nil)
 175
 176 (fset 'nnkiboze-request-post 'nntp-request-post)
 177
 178 (fset 'nnkiboze-request-post-buffer 'nntp-request-post-buffer)
 179
 180 \f
 181 ;;; Internal functions.
 182
 183 (defun nnkiboze-possibly-change-newsgroups (group)
 184   (setq nnkiboze-current-group group))
 185
 186 (defun nnkiboze-prefixed-name (group)
 187   (gnus-group-prefixed-name group '(nnkiboze "")))
 188
 189 ;;;###autoload
 190 (defun nnkiboze-generate-groups ()
 191   "Usage: emacs -batch -l nnkiboze -f nnkiboze-generate-groups
 192 Finds out what articles are to be part of the nnkiboze groups."
 193   (interactive)
 194   (let ((nnmail-spool-file nil)
 195         (gnus-use-dribble-file nil)
 196         (gnus-read-active-file t)
 197         (gnus-expert-user t))
 198     (gnus))
 199   (let* ((gnus-newsrc-alist (gnus-copy-sequence gnus-newsrc-alist))
 200          (newsrc gnus-newsrc-alist))
 201     (while newsrc
 202       (if (string-match "nnkiboze" (car (car newsrc)))
 203           (nnkiboze-generate-group (car (car newsrc))))
 204       (setq newsrc (cdr newsrc)))))
 205
 206 (defun nnkiboze-score-file (group)
 207   (list (expand-file-name
 208          (concat gnus-kill-files-directory nnkiboze-current-score-group
 209                  "." gnus-score-file-suffix))))
 210
 211 (defun nnkiboze-generate-group (group)
 212   (let* ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))
 213          (newsrc-file (concat nnkiboze-directory group ".newsrc"))
 214          (nov-file (concat nnkiboze-directory group ".nov"))
 215          (regexp (nth 1 (nth 4 info)))
 216          (gnus-expert-user t)
 217          (gnus-large-newsgroup nil)
 218          (gnus-score-find-score-files-function 'nnkiboze-score-file)
 219          method nnkiboze-newsrc nov-buffer gname newsrc active
 220          ginfo lowest)
 221     (setq nnkiboze-current-score-group group)
 222     (or info (error "No such group: %s" group))
 223     (and (file-exists-p newsrc-file) (load newsrc-file))
 224     (save-excursion
 225       (set-buffer (setq nov-buffer (find-file-noselect nov-file)))
 226       (buffer-disable-undo (current-buffer)))
 227     (mapatoms
 228      (lambda (group)
 229        (if (and (string-match regexp (setq gname (symbol-name group)))
 230                 (not (assoc gname nnkiboze-newsrc)))
 231            (setq nnkiboze-newsrc
 232                  (cons (cons gname (1- (car (symbol-value group))))
 233                        nnkiboze-newsrc))))
 234      gnus-active-hashtb)
 235     (setq newsrc nnkiboze-newsrc)
 236     (while newsrc
 237       (if (not (setq active (gnus-gethash
 238                              (car (car newsrc)) gnus-active-hashtb)))
 239           (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc))
 240         (switch-to-buffer gnus-group-buffer)
 241         (gnus-group-jump-to-group (car (car newsrc)))
 242         (if (and (setq ginfo (nth 2 (gnus-gethash (gnus-group-group-name)
 243                                                   gnus-newsrc-hashtb)))
 244                  (nth 3 ginfo))
 245             (setcar (nthcdr 3 ginfo) nil))
 246         (if (not (and (or (not ginfo)
 247                           (> (length (gnus-list-of-unread-articles
 248                                       (car ginfo))) 0))
 249                       (progn
 250                         (gnus-group-select-group nil)
 251                         (eq major-mode 'gnus-summary-mode))))
 252             ()
 253           (setq lowest (cdr (car newsrc)))
 254           (setq method (gnus-find-method-for-group gnus-newsgroup-name))
 255           (and (eq method gnus-select-method) (setq method nil))
 256           (while gnus-newsgroup-scored
 257             (if (> (car (car gnus-newsgroup-scored)) lowest)
 258                 (nnkiboze-enter-nov
 259                  nov-buffer
 260                  (gnus-get-header-by-number (car (car gnus-newsgroup-scored)))
 261                  (if method
 262                      (gnus-group-prefixed-name gnus-newsgroup-name method)
 263                    gnus-newsgroup-name)))
 264             (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored)))
 265           (gnus-summary-quit)))
 266       (setcdr (car newsrc) (car active))
 267       (setq newsrc (cdr newsrc)))
 268     (set-buffer nov-buffer)
 269     (save-buffer)
 270     (kill-buffer (current-buffer))
 271     (set-buffer (get-buffer-create "*nnkiboze work*"))
 272     (buffer-disable-undo (current-buffer))
 273     (erase-buffer)
 274     (insert "(setq nnkiboze-newsrc '" (prin1-to-string nnkiboze-newsrc)
 275             ")\n")
 276     (write-file newsrc-file)
 277     (kill-buffer (current-buffer))
 278     (switch-to-buffer gnus-group-buffer)
 279     (gnus-group-list-groups 5 nil)))
 280
 281 (defun nnkiboze-enter-nov (buffer header group)
 282   (save-excursion
 283     (set-buffer buffer)
 284     (goto-char (point-max))
 285     (let ((xref (header-xref header))
 286           (prefix (gnus-group-real-prefix group))
 287           (first t)
 288           article)
 289       (if (zerop (forward-line -1))
 290           (progn
 291             (setq article (1+ (read (current-buffer))))
 292             (forward-line 1))
 293         (setq article 1))
 294       (insert (int-to-string article) "\t"
 295               (or (header-subject header) "") "\t"
 296               (or (header-from header) "") "\t"
 297               (or (header-date header) "") "\t"
 298               (or (header-id header) "") "\t"
 299               (or (header-references header) "") "\t"
 300               (int-to-string (or (header-chars header) 0)) "\t"
 301               (int-to-string (or (header-lines header) 0)) "\t")
 302       (if (or (not xref) (equal "" xref))
 303           (insert "Xref " (system-name) " " group ":"
 304                   (int-to-string (header-number header))
 305                   "\t\n")
 306         (insert (header-xref header) "\t\n")
 307         (search-backward "\t" nil t)
 308         (search-backward "\t" nil t)
 309         (while (re-search-forward
 310                 "[^ ]+:[0-9]+"
 311                 (save-excursion (end-of-line) (point)) t)
 312           (if first
 313               ;; The first xref has to be the group this article
 314               ;; really came for - this is the article nnkiboze
 315               ;; will to request when it is asked for the article.
 316               (save-excursion
 317                 (goto-char (match-beginning 0))
 318                 (insert prefix group ":"
 319                         (int-to-string (header-number header)) " ")
 320                 (setq first nil)))
 321           (save-excursion
 322             (goto-char (match-beginning 0))
 323             (insert prefix)))))))
 324
 325 (defun nnkiboze-nov-file-name ()
 326   (concat nnkiboze-directory
 327           (nnkiboze-prefixed-name nnkiboze-current-group) ".nov"))
 328
 329 (provide 'nnkiboze)
 330
 331 ;;; nnkiboze.el ends here