diff lisp/gnus/nndb.el @ 82951:0fde48feb604

Import Gnus 5.10 from the v5_10 branch of the Gnus repository.

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/gnus/nndb.el	Thu Jul 22 16:45:51 2004 +0000
@@ -0,0 +1,331 @@
+;;; nndb.el --- nndb access for Gnus
+
+;; Copyright (C) 1997, 1998, 2000, 2003 Free Software Foundation, Inc.
+
+;; Author: Masanobu UMEDA <[e-mail]>
+;;         Kai Grossjohann <[e-mail]>
+;;         Joe Hildebrand <[e-mail]>
+;;         David Blacka <[e-mail]>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; This was based upon Kai Grossjohan's shamessly snarfed code and
+;;; further modified by Joe Hildebrand.  It has been updated for Red
+;;; Gnus.
+
+;; TODO:
+;;
+;; * Fix bug where server connection can be lost and impossible to regain
+;;   This hasn't happened to me in a while; think it was fixed in Rgnus
+;;
+;; * make it handle different nndb servers seemlessly
+;;
+;; * Optimize expire if FORCE
+;;
+;; * Optimize move (only expire once)
+;;
+;; * Deal with add/deletion of groups
+;;
+;; * make the backend TOUCH an article when marked as expireable (will
+;;   make article expire 'expiry' days after that moment).
+
+;;-
+;; Register nndb with known select methods.
+
+(gnus-declare-backend "nndb" 'mail 'respool 'address 'prompt-address)
+
+;;; Code:
+
+(require 'nnmail)
+(require 'nnheader)
+(require 'nntp)
+(eval-when-compile (require 'cl))
+
+(eval-and-compile
+  (unless (fboundp 'open-network-stream)
+    (require 'tcp)))
+
+(eval-when-compile (require 'cl))
+
+(eval-and-compile
+  (autoload 'news-setup "rnewspost")
+  (autoload 'news-reply-mode "rnewspost")
+  (autoload 'cancel-timer "timer")
+  (autoload 'telnet "telnet" nil t)
+  (autoload 'telnet-send-input "telnet" nil t)
+  (autoload 'gnus-declare-backend "gnus-start"))
+
+;; Declare nndb as derived from nntp
+
+(nnoo-declare nndb nntp)
+
+;; Variables specific to nndb
+
+;;- currently not used but just in case...
+(defvoo nndb-deliver-program "nndel"
+  "*The program used to put a message in an NNDB group.")
+
+(defvoo nndb-server-side-expiry nil
+  "If t, expiry calculation will occur on the server side.")
+
+(defvoo nndb-set-expire-date-on-mark nil
+  "If t, the expiry date for a given article will be set to the time
+it was marked as expireable; otherwise the date will be the time the
+article was posted to nndb")
+
+;; Variables copied from nntp
+
+(defvoo nndb-server-opened-hook '(nntp-send-authinfo-from-file)
+  "Like nntp-server-opened-hook."
+  nntp-server-opened-hook)
+
+(defvoo nndb-address "localhost"
+  "*The name of the NNDB server."
+  nntp-address)
+
+(defvoo nndb-port-number 9000
+  "*Port number to connect to."
+  nntp-port-number)
+
+;; change to 'news if you are actually using nndb for news
+(defvoo nndb-article-type 'mail)
+
+(defvoo nndb-status-string nil "" nntp-status-string)
+
+
+
+(defconst nndb-version "nndb 0.7"
+  "Version numbers of this version of NNDB.")
+
+
+;;; Interface functions.
+
+(nnoo-define-basics nndb)
+
+;;------------------------------------------------------------------
+
+;; this function turns the lisp list into a string list.  There is
+;; probably a more efficient way to do this.
+(defun nndb-build-article-string (articles)
+  (let (art-string art)
+    (while articles
+      (setq art (pop articles))
+      (setq art-string (concat art-string art " ")))
+    art-string))
+
+(defun nndb-build-expire-rest-list (total expire)
+  (let (art rest)
+    (while total
+      (setq art (pop total))
+      (if (memq art expire)
+	  ()
+	(push art rest)))
+    rest))
+
+
+;;
+(deffoo nndb-request-type (group &optional article)
+  nndb-article-type)
+
+;; nndb-request-update-info does not exist and is not needed
+
+;; nndb-request-update-mark does not exist; it should be used to TOUCH
+;; articles as they are marked exipirable
+(defun nndb-touch-article (group article)
+  (nntp-send-command nil "X-TOUCH" article))
+
+(deffoo nndb-request-update-mark
+    (group article mark)
+  "Sets the expiry date for ARTICLE in GROUP to now, if the mark is 'E'"
+  (if (and nndb-set-expire-date-on-mark (string-equal mark "E"))
+      (nndb-touch-article group article))
+  mark)
+
+;; nndb-request-create-group -- currently this isn't necessary; nndb
+;;   creates groups on demand.
+
+;; todo -- use some other time than the creation time of the article
+;;         best is time since article has been marked as expirable
+
+(defun nndb-request-expire-articles-local
+  (articles &optional group server force)
+  "Let gnus do the date check and issue the delete commands."
+  (let (msg art delete-list (num-delete 0) rest)
+    (nntp-possibly-change-group group server)
+    (while articles
+      (setq art (pop articles))
+      (nntp-send-command "^\\([23]\\|^423\\).*\n" "X-DATE" art)
+      (setq msg (nndb-status-message))
+      (if (string-match "^423" msg)
+	  ()
+	(or (string-match "'\\(.+\\)'" msg)
+	    (error "Not a valid response for X-DATE command: %s"
+		   msg))
+	(if (nnmail-expired-article-p
+	     group
+	     (date-to-time (substring msg (match-beginning 1) (match-end 1)))
+	     force)
+	    (progn
+	      (setq delete-list (concat delete-list " " (int-to-string art)))
+	      (setq num-delete  (1+ num-delete)))
+	  (push art rest))))
+    (if (> (length delete-list) 0)
+	(progn
+	  (nnheader-message 5 "Deleting %s article(s) from %s"
+			    (int-to-string num-delete) group)
+	  (nntp-send-command "^[23].*\n" "X-DELETE" delete-list))
+      )
+
+    (nnheader-message 5 "")
+    (nconc rest articles)))
+
+(defun nndb-get-remote-expire-response ()
+  (let (list)
+    (set-buffer nntp-server-buffer)
+    (goto-char (point-min))
+    (if (looking-at "^[34]")
+       ;; x-expire returned error--presume no articles were expirable)
+	(setq list nil)
+      ;; otherwise, pull all of the following numbers into the list
+      (re-search-forward "follows\r?\n?" nil t)
+      (while (re-search-forward "^[0-9]+$" nil t)
+      (push (string-to-int (match-string 0)) list)))
+    list))
+
+(defun nndb-request-expire-articles-remote
+  (articles &optional group server force)
+  "Let the nndb backend expire articles"
+  (let (days art-string delete-list (num-delete 0))
+    (nntp-possibly-change-group group server)
+
+    ;; first calculate the wait period in days
+    (setq days (or (and nnmail-expiry-wait-function
+			(funcall nnmail-expiry-wait-function group))
+    nnmail-expiry-wait))
+    ;; now handle the special cases
+    (cond (force
+    (setq days 0))
+	  ((eq days 'never)
+	   ;; This isn't an expirable group.
+	  (setq days -1))
+	  ((eq days 'immediate)
+	  (setq days 0)))
+
+
+    ;; build article string
+    (setq art-string (concat days " " (nndb-build-article-string articles)))
+    (nntp-send-command "^\.\r?\n\\|^[345].*\n" "X-EXPIRE" art-string)
+
+    (setq delete-list (nndb-get-remote-expire-response))
+    (setq num-delete (length delete-list))
+    (if (> num-delete 0)
+	(nnheader-message 5 "Deleting %s article(s) from %s"
+			  (int-to-string num-delete) group))
+
+    (nndb-build-expire-rest-list articles delete-list)))
+
+(deffoo nndb-request-expire-articles
+    (articles &optional group server force)
+  "Expires ARTICLES from GROUP on SERVER.
+If FORCE, delete regardless of exiration date, otherwise use normal
+expiry mechanism."
+  (if nndb-server-side-expiry
+      (nndb-request-expire-articles-remote articles group server force)
+    (nndb-request-expire-articles-local articles group server force)))
+
+(deffoo nndb-request-move-article
+    (article group server accept-form &optional last)
+  "Move ARTICLE (a number) from GROUP on SERVER.
+Evals ACCEPT-FORM in current buffer, where the article is.
+Optional LAST is ignored."
+  ;; we guess that the second arg in accept-form is the new group,
+  ;; which it will be for nndb, which is all that matters anyway
+  (let ((new-group (nth 1 accept-form)) result)
+    (nntp-possibly-change-group group server)
+
+    ;; use the move command for nndb-to-nndb moves
+    (if (string-match "^nndb" new-group)
+	(let ((new-group-name (gnus-group-real-name new-group)))
+	  (nntp-send-command "^[23].*\n" "X-MOVE" article new-group-name)
+	  (cons new-group article))
+      ;; else move normally
+      (let ((artbuf (get-buffer-create " *nndb move*")))
+      (and
+       (nndb-request-article article group server artbuf)
+       (save-excursion
+	 (set-buffer artbuf)
+	 (insert-buffer-substring nntp-server-buffer)
+	 (setq result (eval accept-form))
+	 (kill-buffer (current-buffer))
+	 result)
+       (nndb-request-expire-articles (list article)
+				     group
+				     server
+				     t))
+      result)
+      )))
+
+(deffoo nndb-request-accept-article (group server &optional last)
+  "The article in the current buffer is put into GROUP."
+  (nntp-possibly-change-group group server)
+  (let (art msg)
+    (when (nntp-send-command "^[23].*\r?\n" "ACCEPT" group)
+      (nnheader-insert "")
+      (nntp-send-buffer "^[23].*\n"))
+
+    (set-buffer nntp-server-buffer)
+    (setq msg (buffer-string))
+    (or (string-match "^\\([0-9]+\\)" msg)
+	(error "nndb: %s" msg))
+    (setq art (substring msg (match-beginning 1) (match-end 1)))
+    (nnheader-message 5 "nndb: accepted %s" art)
+    (list art)))
+
+(deffoo nndb-request-replace-article (article group buffer)
+  "ARTICLE is the number of the article in GROUP to be replaced with the contents of the BUFFER."
+  (set-buffer buffer)
+  (when (nntp-send-command "^[23].*\r?\n" "X-REPLACE" (int-to-string article))
+    (nnheader-insert "")
+    (nntp-send-buffer "^[23.*\n")
+    (list (int-to-string article))))
+
+			    ; nndb-request-delete-group does not exist
+					; todo -- maybe later
+
+			    ; nndb-request-rename-group does not exist
+					; todo -- maybe later
+
+;; -- standard compatability functions
+
+(deffoo nndb-status-message (&optional server)
+  "Return server status as a string."
+  (set-buffer nntp-server-buffer)
+  (buffer-string))
+
+;; Import stuff from nntp
+
+(nnoo-import nndb
+  (nntp))
+
+(provide 'nndb)
+
+;;; arch-tag: 83bd6fb4-58d9-4fed-a901-c6c625ad5f8a
+;;; nndb.el ends here