X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnndb.el;fp=lisp%2Fnndb.el;h=0000000000000000000000000000000000000000;hb=85d086dab13c7c38268afe018a6fb28b45c1a0b5;hp=d8fb469cd19f08b4678ddc0f31df3a22e1032555;hpb=509a8e7082aea415f157fae31ccac13b8c68ed4f;p=elisp%2Fgnus.git- diff --git a/lisp/nndb.el b/lisp/nndb.el deleted file mode 100644 index d8fb469..0000000 --- a/lisp/nndb.el +++ /dev/null @@ -1,324 +0,0 @@ -;;; nndb.el --- nndb access for Gnus - -;; Copyright (C) 1997, 1998, 2000 Free Software Foundation, Inc. - -;; Author: Masanobu UMEDA -;; Kai Grossjohann -;; Joe Hildebrand -;; David Blacka -;; Keywords: news - -;; This file is NOT 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 - (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-substring (point-min) (point-max))) - (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-substring (point-min) (point-max))) - -;; Import stuff from nntp - -(nnoo-import nndb - (nntp)) - -(provide 'nndb) - -;;; nndb.el ends here