New version.

1 files changed, 110 insertions, 70 deletions

diff --git a/lisp/nnkiboze.el b/lisp/nnkiboze.el
index 4260e5fc46f..b314d58d1a9 100644
--- a/lisp/nnkiboze.el
+++ b/lisp/nnkiboze.el
@@ -1,6 +1,5 @@
 ;;; nnkiboze.el --- select virtual news access for Gnus
-
-;; Copyright (C) 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
 ;; Keywords: news
@@ -34,25 +33,35 @@
 (require 'nnheader)
 (require 'gnus)
 (require 'gnus-score)
+(require 'nnoo)
+(eval-when-compile (require 'cl))
 
-(defvar nnkiboze-directory 
-  (expand-file-name (or gnus-article-save-directory "~/News/"))
+(nnoo-declare nnkiboze)
+(defvoo nnkiboze-directory gnus-directory
   "nnkiboze will put its files in this directory.")
 
+(defvoo nnkiboze-level 9
+  "*The maximum level to be searched for articles.")
+
+(defvoo nnkiboze-remove-read-articles t
+  "*If non-nil, nnkiboze will remove read articles from the kiboze group.")
+
 
 
 (defconst nnkiboze-version "nnkiboze 1.0"
   "Version numbers of this version of nnkiboze.")
 
-(defvar nnkiboze-current-group nil)
-(defvar nnkiboze-current-score-group "")
-(defvar nnkiboze-status-string "")
+(defvoo nnkiboze-current-group nil)
+(defvoo nnkiboze-current-score-group "")
+(defvoo nnkiboze-status-string "")
 
 
 
 ;;; Interface functions.
 
-(defun nnkiboze-retrieve-headers (articles &optional group server)
+(nnoo-define-basics nnkiboze)
+
+(deffoo nnkiboze-retrieve-headers (articles &optional group server fetch-old)
   (nnkiboze-possibly-change-newsgroups group)
   (if gnus-nov-is-evil
       nil
@@ -78,36 +87,22 @@
 	      (if (not (eobp)) (delete-region (point) (point-max)))
 	      'nov))))))
 
-(defun nnkiboze-open-server (newsgroups &optional something)
-  "Open a virtual newsgroup that contains NEWSGROUPS."
+(deffoo nnkiboze-open-server (newsgroups &optional something)
   (gnus-make-directory nnkiboze-directory)
   (nnheader-init-server-buffer))
 
-(defun nnkiboze-close-server (&rest dum)
-  "Close news server."
-  t)
-
-(defalias 'nnkiboze-request-quit (symbol-function 'nnkiboze-close-server))
-
-(defun nnkiboze-server-opened (&optional server)
-  "Return server process status, T or NIL.
-If the stream is opened, return T, otherwise return NIL."
+(deffoo nnkiboze-server-opened (&optional server)
   (and nntp-server-buffer
        (get-buffer nntp-server-buffer)))
 
-(defun nnkiboze-status-message (&optional server)
-  "Return server status response as string."
-  nnkiboze-status-string)
-
-(defun nnkiboze-request-article (article &optional newsgroup server buffer)
-  "Select article by message number."
+(deffoo nnkiboze-request-article (article &optional newsgroup server buffer)
   (nnkiboze-possibly-change-newsgroups newsgroup)
   (if (not (numberp article))
       ;; This is a real kludge. It might not work at times, but it
       ;; does no harm I think. The only alternative is to offer no
       ;; article fetching by message-id at all.
       (nntp-request-article article newsgroup gnus-nntp-server buffer)
-    (let* ((header (gnus-get-header-by-number article))
+    (let* ((header (gnus-summary-article-header article))
 	   (xref (mail-header-xref header))
 	   igroup iarticle)
       (or xref (error "nnkiboze: No xref"))
@@ -119,7 +114,7 @@ If the stream is opened, return T, otherwise return NIL."
       (and (gnus-request-group igroup t)
 	   (gnus-request-article iarticle igroup buffer)))))
 
-(defun nnkiboze-request-group (group &optional server dont-check)
+(deffoo nnkiboze-request-group (group &optional server dont-check)
   "Make GROUP the current newsgroup."
   (nnkiboze-possibly-change-newsgroups group)
   (if dont-check
@@ -144,15 +139,16 @@ If the stream is opened, return T, otherwise return NIL."
 	    (insert (format "211 %d %d %d %s\n" total beg end group)))))))
   t)
 
-(defun nnkiboze-close-group (group &optional server)
+(deffoo nnkiboze-close-group (group &optional server)
   (nnkiboze-possibly-change-newsgroups group)
   ;; Remove NOV lines of articles that are marked as read.
-  (if (or (not (file-exists-p (nnkiboze-nov-file-name)))
-	  (not (eq major-mode 'gnus-summary-mode)))
-      ()
+  (when (and (file-exists-p (nnkiboze-nov-file-name))
+	     nnkiboze-remove-read-articles
+	     (eq major-mode 'gnus-summary-mode))
     (save-excursion
       (let ((unreads gnus-newsgroup-unreads)
-	    (unselected gnus-newsgroup-unselected))
+	    (unselected gnus-newsgroup-unselected)
+            (version-control 'never))
 	(set-buffer (get-buffer-create "*nnkiboze work*"))
 	(buffer-disable-undo (current-buffer))
 	(erase-buffer)
@@ -170,22 +166,28 @@ If the stream is opened, return T, otherwise return NIL."
 	  (kill-buffer (current-buffer)))))
     (setq nnkiboze-current-group nil)))
 
-(defun nnkiboze-request-list (&optional server) 
-  (setq nnkiboze-status-string "nnkiboze: LIST is not implemented.")
-  nil)
+(deffoo nnkiboze-request-list (&optional server) 
+  (nnheader-report 'nnkiboze "LIST is not implemented."))
 
-(defun nnkiboze-request-newgroups (date &optional server)
+(deffoo nnkiboze-request-newgroups (date &optional server)
   "List new groups."
-  (setq nnkiboze-status-string "NEWGROUPS is not supported.")
-  nil)
+  (nnheader-report 'nnkiboze "NEWGROUPS is not supported."))
 
-(defun nnkiboze-request-list-newsgroups (&optional server)
-  (setq nnkiboze-status-string "nnkiboze: LIST NEWSGROUPS is not implemented.")
-  nil)
+(deffoo nnkiboze-request-list-newsgroups (&optional server)
+  (nnheader-report 'nnkiboze "LIST NEWSGROUPS is not implemented."))
 
-(defalias 'nnkiboze-request-post 'nntp-request-post)
-
-(defalias 'nnkiboze-request-post-buffer 'nntp-request-post-buffer)
+(deffoo nnkiboze-request-delete-group (group &optional force server)
+  (nnkiboze-possibly-change-newsgroups group)
+  (when force
+     (let ((files (list (nnkiboze-nov-file-name)
+			(concat nnkiboze-directory group ".newsrc")
+			(nnkiboze-score-file group))))
+       (while files
+	 (and (file-exists-p (car files))
+	      (file-writable-p (car files))
+	      (delete-file (car files)))
+	 (setq files (cdr files)))))
+  (setq nnkiboze-current-group nil))
 
 
 ;;; Internal functions.
@@ -207,16 +209,24 @@ Finds out what articles are to be part of the nnkiboze groups."
 	(gnus-expert-user t))
     (gnus))
   (let* ((gnus-newsrc-alist (gnus-copy-sequence gnus-newsrc-alist))
-	 (newsrc gnus-newsrc-alist))
+	 (newsrc gnus-newsrc-alist)
+	 gnus-newsrc-hashtb)
+    (gnus-make-hashtable-from-newsrc-alist)
+    ;; We have copied all the newsrc alist info over to local copies
+    ;; so that we can mess all we want with these lists.
     (while newsrc
-      (if (string-match "nnkiboze" (car (car newsrc)))
-	  (nnkiboze-generate-group (car (car newsrc))))
+      (if (string-match "nnkiboze" (caar newsrc))
+	  ;; For each kiboze group, we call this function to generate
+	  ;; it.  
+	  (nnkiboze-generate-group (caar newsrc)))
       (setq newsrc (cdr newsrc)))))
 
 (defun nnkiboze-score-file (group)
   (list (expand-file-name
-	 (concat gnus-kill-files-directory nnkiboze-current-score-group 
-		 "." gnus-score-file-suffix))))
+	 (concat (file-name-as-directory gnus-kill-files-directory)
+		 (nnheader-translate-file-chars
+		  (concat nnkiboze-current-score-group 
+			  "." gnus-score-file-suffix))))))
 
 (defun nnkiboze-generate-group (group) 
   (let* ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))
@@ -225,15 +235,18 @@ Finds out what articles are to be part of the nnkiboze groups."
 	 (regexp (nth 1 (nth 4 info)))
 	 (gnus-expert-user t)
 	 (gnus-large-newsgroup nil)
+	 (version-control 'never)
 	 (gnus-score-find-score-files-function 'nnkiboze-score-file)
  	 gnus-select-group-hook gnus-summary-prepare-hook 
 	 gnus-thread-sort-functions gnus-show-threads 
 	 gnus-visual
 	 method nnkiboze-newsrc nov-buffer gname newsrc active
-	 ginfo lowest)
+	 ginfo lowest glevel)
     (setq nnkiboze-current-score-group group)
     (or info (error "No such group: %s" group))
+    ;; Load the kiboze newsrc file for this group.
     (and (file-exists-p newsrc-file) (load newsrc-file))
+    ;; We also load the nov file for this group.
     (save-excursion
       (set-buffer (setq nov-buffer (find-file-noselect nov-file)))
       (buffer-disable-undo (current-buffer)))
@@ -241,50 +254,76 @@ Finds out what articles are to be part of the nnkiboze groups."
     ;; kiboze regexp.
     (mapatoms
      (lambda (group)
-       (if (and (string-match regexp (setq gname (symbol-name group))) ; Match
-		(not (assoc gname nnkiboze-newsrc)) ; It isn't registered
-		(numberp (car (symbol-value group))) ; It is active
-		(not (string-match "^nnkiboze:" gname))) ; Exclude kibozes
-	   (setq nnkiboze-newsrc 
-		 (cons (cons gname (1- (car (symbol-value group))))
-		       nnkiboze-newsrc))))
+       (and (string-match regexp (setq gname (symbol-name group))) ; Match
+	    (not (assoc gname nnkiboze-newsrc)) ; It isn't registered
+	    (numberp (car (symbol-value group))) ; It is active
+	    (or (> nnkiboze-level 7)
+		(and (setq glevel (nth 1 (nth 2 (gnus-gethash
+						 gname gnus-newsrc-hashtb))))
+		     (>= nnkiboze-level glevel)))
+	    (not (string-match "^nnkiboze:" gname)) ; Exclude kibozes
+	    (setq nnkiboze-newsrc 
+		  (cons (cons gname (1- (car (symbol-value group))))
+			nnkiboze-newsrc))))
      gnus-active-hashtb)
+    ;; `newsrc' is set to the list of groups that possibly are
+    ;; component groups to this kiboze group.  This list has elements
+    ;; on the form `(GROUP . NUMBER)', where NUMBER is the highest
+    ;; number that has been kibozed in GROUP in this kiboze group.
     (setq newsrc nnkiboze-newsrc)
     (while newsrc
       (if (not (setq active (gnus-gethash 
-			     (car (car newsrc)) gnus-active-hashtb)))
+			     (caar newsrc) gnus-active-hashtb)))
+	  ;; This group isn't active after all, so we remove it from
+	  ;; the list of component groups.
 	  (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc))
+	(setq lowest (cdar newsrc))
+	;; Ok, we have a valid component group, so we jump to it. 
 	(switch-to-buffer gnus-group-buffer)
-	(gnus-group-jump-to-group (car (car newsrc)))
-	(if (and (setq ginfo (nth 2 (gnus-gethash (gnus-group-group-name) 
-						  gnus-newsrc-hashtb)))
-		 (nth 3 ginfo))
-	    (setcar (nthcdr 3 ginfo) nil))
+	(gnus-group-jump-to-group (caar newsrc))
+	;; We set all list of article marks to nil.  Since we operate
+	;; on copies of the real lists, we can destroy anything we
+	;; want here.
+	(and (setq ginfo (nth 2 (gnus-gethash (gnus-group-group-name)
+					      gnus-newsrc-hashtb)))
+	     (nth 3 ginfo)
+	     (setcar (nthcdr 3 ginfo) nil))
+	;; We set the list of read articles to be what we expect for
+	;; this kiboze group -- either nil or `(1 . LOWEST)'. 
+	(and ginfo (setcar (nthcdr 2 ginfo)
+			   (and (not (= lowest 1)) (cons 1 lowest))))
 	(if (not (and (or (not ginfo)
 			  (> (length (gnus-list-of-unread-articles 
 				      (car ginfo))) 0))
 		      (progn
 			(gnus-group-select-group nil)
 			(eq major-mode 'gnus-summary-mode))))
-	    ()
-	  (setq lowest (cdr (car newsrc)))
+	    () ; No unread articles, or we couldn't enter this group.
+	  ;; We are now in the group where we want to be.
 	  (setq method (gnus-find-method-for-group gnus-newsgroup-name))
 	  (and (eq method gnus-select-method) (setq method nil))
+	  ;; We go through the list of scored articles.
 	  (while gnus-newsgroup-scored
-	    (if (> (car (car gnus-newsgroup-scored)) lowest)
+	    (if (> (caar gnus-newsgroup-scored) lowest)
+		;; If it has a good score, then we enter this article
+		;; into the kiboze group.
 		(nnkiboze-enter-nov 
 		 nov-buffer
-		 (gnus-get-header-by-number (car (car gnus-newsgroup-scored)))
+		 (gnus-summary-article-header 
+		  (caar gnus-newsgroup-scored))
 		 (if method
 		     (gnus-group-prefixed-name gnus-newsgroup-name method)
 		   gnus-newsgroup-name)))
 	    (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored)))
-	  (gnus-summary-quit)))
+	  ;; That's it.  We exit this group.
+	  (gnus-summary-exit-no-update)))
       (setcdr (car newsrc) (car active))
       (setq newsrc (cdr newsrc)))
+    ;; We save the nov file.
     (set-buffer nov-buffer)
     (save-buffer)
     (kill-buffer (current-buffer))
+    ;; We save the kiboze newsrc for this group.
     (set-buffer (get-buffer-create "*nnkiboze work*"))
     (buffer-disable-undo (current-buffer))
     (erase-buffer)
@@ -340,8 +379,9 @@ Finds out what articles are to be part of the nnkiboze groups."
 	    (insert prefix)))))))
 
 (defun nnkiboze-nov-file-name ()
-  (concat nnkiboze-directory
-	  (nnkiboze-prefixed-name nnkiboze-current-group) ".nov"))
+  (concat (file-name-as-directory nnkiboze-directory)
+	  (nnheader-translate-file-chars
+	   (concat (nnkiboze-prefixed-name nnkiboze-current-group) ".nov"))))
 
 (provide 'nnkiboze)