annotate lisp/gnus/nndb.el @ 87595:4c6c79916238

* configure.in: Remove references to unsupported systems. * notes/copyright: * MAINTAINERS: Remove references to files that have been removed. * os.texi (System Environment): Remove references to OSes that are not supported anymore. * PROBLEMS: * MACHINES: Remove references to systems not supported anymore. * makefile.w32-in: * Makefile.in: Remove references to Xenix. * gnus.el (gnus-use-long-file-name): Remove reference to xenix. * obsolete/x-apollo.el: Remove file for unsupported system. * term/x-win.el (vendor-specific-keysyms): Remove reference to Apollo. * progmodes/gud.el (gud-dgux-p): Remove. (dbx): Remove reference to dgux. * progmodes/ps-mode.el (ps-mode-print-function): * ps-print.el (ps-lp-system): * paths.el (rmail-spool-directory): * ls-lisp.el (ls-lisp-emulation): * lpr.el (lpr-lp-system): * dired.el (dired-chown-program): Remove references to dgux. * m/7300.h: * m/acorn.h: * m/alliant-2800.h: * m/alliant.h: * m/alliant1.h: * m/alliant4.h: * m/altos.h: * m/amdahl.h: * m/apollo.h: * m/att3b.h: * m/aviion-intel.h: * m/aviion.h: * m/celerity.h: * m/clipper.h: * m/cnvrgnt.h: * m/convex.h: * m/cydra5.h: * m/delta88k.h: * m/dpx2.h: * m/dual.h: * m/elxsi.h: * m/f301.h: * m/gould-np1.h: * m/gould.h: * m/i860.h: * m/ibmps2-aix.h: * m/ibmrt-aix.h: * m/ibmrt.h: * m/irist.h: * m/is386.h: * m/isi-ov.h: * m/mega68.h: * m/mg1.h: * m/news-r6.h: * m/news-risc.h: * m/news.h: * m/nh3000.h: * m/nh4000.h: * m/ns16000.h: * m/ns32000.h: * m/nu.h: * m/orion.h: * m/orion105.h: * m/paragon.h: * m/pfa50.h: * m/plexus.h: * m/pyramid.h: * m/pyrmips.h: * m/sh3el.h: * m/sps7.h: * m/sr2k.h: * m/stride.h: * m/sun1.h: * m/sun2.h: * m/sun3-68881.h: * m/sun3-fpa.h: * m/sun3-soft.h: * m/sun3.h: * m/sun386.h: * m/symmetry.h: * m/tad68k.h: * m/tahoe.h: * m/targon31.h: * m/tek4300.h: * m/tekxd88.h: * m/tower32.h: * m/tower32v3.h: * m/ustation.h: * m/wicat.h: * m/xps100.h: * s/cxux.h: * s/cxux7.h: * s/dgux.h: * s/dgux4.h: * s/dgux5-4-3.h: * s/dgux5-4r2.h: * s/esix.h: * s/esix5r4.h: * s/hiuxmpp.h: * s/hiuxwe2.h: * s/iris3-5.h: * s/iris3-6.h: * s/isc2-2.h: * s/isc3-0.h: * s/isc4-0.h: * s/isc4-1.h: * s/newsos5.h: * s/newsos6.h: * s/osf1.h: * s/osf5-0.h: * s/riscix1-1.h: * s/riscix12.h: * s/sco4.h: * s/sco5.h: * s/sunos4-0.h: * s/sunos4-1.h: * s/sunos413.h: * s/sunos4shr.h: * s/umax.h: * s/unipl5-2.h: * s/xenix.h: * cxux-crt0.s: * unexapollo.c: * unexconvex.c: * unexenix.c: * unexsni.c: Remove files for systems no longer supported. * m/intel386.h: Remove references to unsupported systems. * w32.c (get_emacs_configuration): Remove reference to i860. * sysdep.c: Remove dead code.

;;; nndb.el --- nndb access for Gnus

;; Copyright (C) 1997, 1998, 2000, 2002, 2003, 2004,
;;   2005, 2006, 2007 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 3, 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., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, 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).

;;; Code:

;; For Emacs < 22.2.
(eval-and-compile
  (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))

;;-
;; Register nndb with known select methods.

(require 'gnus-start)
(unless (assoc "nndb" gnus-valid-select-methods)
  (gnus-declare-backend "nndb" 'mail 'respool 'address 'prompt-address))

(require 'nnmail)
(require 'nnheader)
(require 'nntp)
(eval-when-compile (require 'cl))

;; 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-number (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)))

;; _Something_ defines it...
(declare-function nndb-request-article "nndb" t t)

(deffoo nndb-request-move-article
    (article group server accept-form &optional last move-is-internal)
  "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