X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnkiboze.el;h=fdb7c2f13d5061ff89a4052c65695fa9d960048a;hb=4c0bad76d2316c59b181d93baf04bb796ed439b0;hp=681b0067625368273e8684d276a84820067b4a68;hpb=83c5b41672a2fedae39e2a3f3e9ff3a1c8540eb7;p=gnus diff --git a/lisp/nnkiboze.el b/lisp/nnkiboze.el index 681b00676..fdb7c2f13 100644 --- a/lisp/nnkiboze.el +++ b/lisp/nnkiboze.el @@ -1,5 +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 ;; Keywords: news @@ -17,13 +17,14 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. ;;; Commentary: ;; The other access methods (nntp, nnspool, etc) are general news -;; access methods. This module relies on Gnus and can not be used +;; access methods. This module relies on Gnus and can't be used ;; separately. ;;; Code: @@ -32,168 +33,142 @@ (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 (nnheader-concat gnus-directory "kiboze/") "nnkiboze will put its files in this directory.") -(defvar nnkiboze-level 9 - "*The maximum level to be searched for articles.") +(defvoo nnkiboze-level 9 + "The maximum level to be searched for articles.") -(defvar nnkiboze-remove-read-articles t - "*If non-nil, nnkiboze will remove read articles from the kiboze group.") +(defvoo nnkiboze-remove-read-articles t + "If non-nil, nnkiboze will remove read articles from the kiboze group.") + +(defvoo nnkiboze-ephemeral nil + "If non-nil, don't store any data anywhere.") + +(defvoo nnkiboze-scores nil + "Score rules for generating the nnkiboze group.") + +(defvoo nnkiboze-regexp nil + "Regexp for matching component groups.") -(defconst nnkiboze-version "nnkiboze 1.0" - "Version numbers of this version of nnkiboze.") +(defconst nnkiboze-version "nnkiboze 1.0") + +(defvoo nnkiboze-current-group nil) +(defvoo nnkiboze-status-string "") -(defvar nnkiboze-current-group nil) -(defvar nnkiboze-current-score-group "") -(defvar nnkiboze-status-string "") +(defvoo nnkiboze-headers nil) ;;; Interface functions. -(defun nnkiboze-retrieve-headers (articles &optional group server fetch-old) - (nnkiboze-possibly-change-newsgroups group) - (if gnus-nov-is-evil - nil +(nnoo-define-basics nnkiboze) + + +(deffoo nnkiboze-retrieve-headers (articles &optional group server fetch-old) + (nnkiboze-possibly-change-group group) + (unless gnus-nov-is-evil (if (stringp (car articles)) 'headers - (let ((first (car articles)) - (last (progn (while (cdr articles) (setq articles (cdr articles))) - (car articles))) - (nov (nnkiboze-nov-file-name))) - (if (file-exists-p nov) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (insert-file-contents nov) - (goto-char (point-min)) - (while (and (not (eobp)) (< first (read (current-buffer)))) - (forward-line 1)) - (beginning-of-line) - (if (not (eobp)) (delete-region 1 (point))) - (while (and (not (eobp)) (>= last (read (current-buffer)))) - (forward-line 1)) - (beginning-of-line) - (if (not (eobp)) (delete-region (point) (point-max))) - 'nov)))))) - -(defun nnkiboze-open-server (newsgroups &optional something) - "Open a virtual newsgroup that contains NEWSGROUPS." - (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." - (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." - (nnkiboze-possibly-change-newsgroups newsgroup) + (let ((nov (nnkiboze-nov-file-name))) + (when (file-exists-p nov) + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer) + (insert-file-contents nov) + (nnheader-nov-delete-outside-range + (car articles) (car (last articles))) + 'nov)))))) + +(deffoo nnkiboze-request-article (article &optional newsgroup server buffer) + (nnkiboze-possibly-change-group newsgroup) (if (not (numberp article)) - ;; This is a real cludge. It might not work at times, but it - ;; does no harm I think. The only alternative is to offer no + ;; 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-summary-article-header article)) - (xref (mail-header-xref header)) - igroup iarticle) - (or xref (error "nnkiboze: No xref")) - (or (string-match " \\([^ ]+\\):\\([0-9]+\\)" xref) - (error "nnkiboze: Malformed xref")) - (setq igroup (substring xref (match-beginning 1) (match-end 1))) - (setq iarticle (string-to-int - (substring xref (match-beginning 2) (match-end 2)))) - (and (gnus-request-group igroup t) - (gnus-request-article iarticle igroup buffer))))) - -(defun nnkiboze-request-group (group &optional server dont-check) + (xref (mail-header-xref header))) + (unless xref + (error "nnkiboze: No xref")) + (unless (string-match " \\([^ ]+\\):\\([0-9]+\\)" xref) + (error "nnkiboze: Malformed xref")) + (gnus-request-article (string-to-int (match-string 2 xref)) + (match-string 1 xref) + buffer)))) + +(deffoo nnkiboze-request-scan (&optional group server) + (nnkiboze-generate-group (concat "nnkiboze:" group))) + +(deffoo nnkiboze-request-group (group &optional server dont-check) "Make GROUP the current newsgroup." - (nnkiboze-possibly-change-newsgroups group) + (nnkiboze-possibly-change-group group) (if dont-check - () + t (let ((nov-file (nnkiboze-nov-file-name)) beg end total) (save-excursion (set-buffer nntp-server-buffer) - (erase-buffer) (if (not (file-exists-p nov-file)) - (insert (format "211 0 0 0 %s\n" group)) + (nnheader-report 'nnkiboze "Can't select group %s" group) (insert-file-contents nov-file) (if (zerop (buffer-size)) - (insert (format "211 0 0 0 %s\n" group)) + (nnheader-insert "211 0 0 0 %s\n" group) (goto-char (point-min)) - (and (looking-at "[0-9]+") (setq beg (read (current-buffer)))) + (when (looking-at "[0-9]+") + (setq beg (read (current-buffer)))) (goto-char (point-max)) - (and (re-search-backward "^[0-9]" nil t) - (setq end (read (current-buffer)))) + (when (re-search-backward "^[0-9]" nil t) + (setq end (read (current-buffer)))) (setq total (count-lines (point-min) (point-max))) - (erase-buffer) - (insert (format "211 %d %d %d %s\n" total beg end group))))))) - t) + (nnheader-insert "211 %d %d %d %s\n" total beg end group))))))) -(defun nnkiboze-close-group (group &optional server) - (nnkiboze-possibly-change-newsgroups group) +(deffoo nnkiboze-close-group (group &optional server) + (nnkiboze-possibly-change-group group) ;; Remove NOV lines of articles that are marked as read. - (if (or (not (file-exists-p (nnkiboze-nov-file-name))) - (not nnkiboze-remove-read-articles)) - () - (save-excursion - (let ((unreads gnus-newsgroup-unreads) - (unselected gnus-newsgroup-unselected) - (version-control 'never)) - (set-buffer (get-buffer-create "*nnkiboze work*")) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (let ((cur (current-buffer)) - article) - (insert-file-contents (nnkiboze-nov-file-name)) - (goto-char (point-min)) - (while (looking-at "[0-9]+") - (if (or (memq (setq article (read cur)) unreads) - (memq article unselected)) - (forward-line 1) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point))))) - (write-file (nnkiboze-nov-file-name)) - (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) - -(defun nnkiboze-request-newgroups (date &optional server) - "List new groups." - (setq nnkiboze-status-string "NEWGROUPS is not supported.") - nil) - -(defun nnkiboze-request-list-newsgroups (&optional server) - (setq nnkiboze-status-string "nnkiboze: LIST NEWSGROUPS is not implemented.") - nil) - -(defalias 'nnkiboze-request-post 'nntp-request-post) + (when (and (file-exists-p (nnkiboze-nov-file-name)) + nnkiboze-remove-read-articles) + (nnheader-temp-write (nnkiboze-nov-file-name) + (let ((cur (current-buffer))) + (insert-file-contents (nnkiboze-nov-file-name)) + (goto-char (point-min)) + (while (not (eobp)) + (if (not (gnus-article-read-p (read cur))) + (forward-line 1) + (gnus-delete-line)))))) + (setq nnkiboze-current-group nil)) + +(deffoo nnkiboze-open-server (server &optional defs) + (unless (assq 'nnkiboze-regexp defs) + (push `(nnkiboze-regexp ,server) + defs)) + (nnoo-change-server 'nnkiboze server defs)) + +(deffoo nnkiboze-request-delete-group (group &optional force server) + (nnkiboze-possibly-change-group 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)) + +(nnoo-define-skeleton nnkiboze) ;;; Internal functions. -(defun nnkiboze-possibly-change-newsgroups (group) +(defun nnkiboze-possibly-change-group (group) (setq nnkiboze-current-group group)) (defun nnkiboze-prefixed-name (group) @@ -210,28 +185,28 @@ 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) - gnus-newsrc-hashtb) + (newsrc (cdr gnus-newsrc-alist)) + gnus-newsrc-hashtb info) (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))) - ;; For each kiboze group, we call this function to generate - ;; it. - (nnkiboze-generate-group (car (car newsrc)))) - (setq newsrc (cdr newsrc))))) + (while (setq info (pop newsrc)) + (when (string-match "nnkiboze" (gnus-info-group info)) + ;; For each kiboze group, we call this function to generate + ;; it. + (nnkiboze-generate-group (gnus-info-group info)))))) (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-prefixed-name nnkiboze-current-group) + "." gnus-score-file-suffix)))))) (defun nnkiboze-generate-group (group) (let* ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) (newsrc-file (concat nnkiboze-directory group ".newsrc")) (nov-file (concat nnkiboze-directory group ".nov")) - (regexp (nth 1 (nth 4 info))) (gnus-expert-user t) (gnus-large-newsgroup nil) (version-control 'never) @@ -241,7 +216,6 @@ Finds out what articles are to be part of the nnkiboze groups." gnus-visual method nnkiboze-newsrc nov-buffer gname newsrc active 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)) @@ -253,7 +227,8 @@ Finds out what articles are to be part of the nnkiboze groups." ;; kiboze regexp. (mapatoms (lambda (group) - (and (string-match regexp (setq gname (symbol-name group))) ; Match + (and (string-match nnkiboze-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) @@ -261,9 +236,8 @@ Finds out what articles are to be part of the nnkiboze groups." 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)))) + (push (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 @@ -272,14 +246,14 @@ Finds out what articles are to be part of the nnkiboze groups." (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 (cdr (car 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))) + (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. @@ -297,22 +271,20 @@ Finds out what articles are to be part of the nnkiboze groups." (progn (gnus-group-select-group nil) (eq major-mode 'gnus-summary-mode)))) - () ; No unread articles, or we couldn't enter this group. + () ; 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-summary-article-header - (car (car gnus-newsgroup-scored))) - (if method - (gnus-group-prefixed-name gnus-newsgroup-name method) - gnus-newsgroup-name))) + (caar gnus-newsgroup-scored)) + gnus-newsgroup-name)) (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored))) ;; That's it. We exit this group. (gnus-summary-exit-no-update))) @@ -323,13 +295,10 @@ Finds out what articles are to be part of the nnkiboze groups." (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) - (insert "(setq nnkiboze-newsrc '" (prin1-to-string nnkiboze-newsrc) - ")\n") - (write-file newsrc-file) - (kill-buffer (current-buffer)) + (nnheader-temp-write newsrc-file + (insert "(setq nnkiboze-newsrc '") + (gnus-prin1 nnkiboze-newsrc) + (insert ")\n")) (switch-to-buffer gnus-group-buffer) (gnus-group-list-groups 5 nil))) @@ -339,6 +308,7 @@ Finds out what articles are to be part of the nnkiboze groups." (goto-char (point-max)) (let ((xref (mail-header-xref header)) (prefix (gnus-group-real-prefix group)) + (oheader (copy-sequence header)) (first t) article) (if (zerop (forward-line -1)) @@ -346,40 +316,23 @@ Finds out what articles are to be part of the nnkiboze groups." (setq article (1+ (read (current-buffer)))) (forward-line 1)) (setq article 1)) - (insert (int-to-string article) "\t" - (or (mail-header-subject header) "") "\t" - (or (mail-header-from header) "") "\t" - (or (mail-header-date header) "") "\t" - (or (mail-header-id header) "") "\t" - (or (mail-header-references header) "") "\t" - (int-to-string (or (mail-header-chars header) 0)) "\t" - (int-to-string (or (mail-header-lines header) 0)) "\t") - (if (or (not xref) (equal "" xref)) - (insert "Xref: " (system-name) " " group ":" - (int-to-string (mail-header-number header)) - "\t\n") - (insert (mail-header-xref header) "\t\n") - (search-backward "\t" nil t) - (search-backward "\t" nil t) - (while (re-search-forward - "[^ ]+:[0-9]+" - (save-excursion (end-of-line) (point)) t) - (if first - ;; The first xref has to be the group this article - ;; really came for - this is the article nnkiboze - ;; will request when it is asked for the article. - (save-excursion - (goto-char (match-beginning 0)) - (insert prefix group ":" - (int-to-string (mail-header-number header)) " ") - (setq first nil))) - (save-excursion - (goto-char (match-beginning 0)) - (insert prefix))))))) + (mail-header-set-number oheader article) + (nnheader-insert-nov oheader) + (search-backward "\t" nil t 2) + (forward-char 1) + ;; The first Xref has to be the group this article + ;; really came for - this is the article nnkiboze + ;; will request when it is asked for the article. + (insert group ":" + (int-to-string (mail-header-number header)) " ") + (while (re-search-forward " [^ ]+:[0-9]+" nil t) + (goto-char (1+ (match-beginning 0))) + (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)