cgit.sxemacs.org Git - gnus/blob - lisp/nndb.el

   1 ;;; nndb.el --- nndb access for Gnus
   2 ;; Copyright (C) 1996 Free Software Foundation, Inc.
   3
   4 ;; Author: Kai Grossjohann <grossjohann@ls6.informatik.uni-dortmund.de>
   5 ;; Keywords: news
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25
  26 ;; I have shamelessly snarfed the code of nntp.el from sgnus.
  27 ;;              Kai
  28
  29
  30 ;;-
  31 ;; Register nndb with known select methods.
  32
  33 (require 'gnus)
  34 (require 'gnus-load)
  35 (require 'nnmail)
  36
  37 (setq gnus-valid-select-methods
  38       (cons '("nndb" mail address respool prompt-address)
  39             gnus-valid-select-methods))
  40
  41
  42 ;;; Code:
  43
  44 (require 'nnheader)
  45 (require 'nntp)
  46 (eval-when-compile (require 'cl))
  47
  48 (eval-and-compile
  49   (unless (fboundp 'open-network-stream)
  50     (require 'tcp)))
  51
  52 (eval-when-compile (require 'cl))
  53
  54 (eval-and-compile
  55   (autoload 'news-setup "rnewspost")
  56   (autoload 'news-reply-mode "rnewspost")
  57   (autoload 'cancel-timer "timer")
  58   (autoload 'telnet "telnet" nil t)
  59   (autoload 'telnet-send-input "telnet" nil t)
  60   (autoload 'timezone-parse-date "timezone"))
  61
  62 ;; Declare nndb as derived from nntp
  63
  64 (nnoo-declare nndb nntp)
  65
  66 ;; Variables specific to nndb
  67
  68 ;;- currently not used but just in case...
  69 (defvoo nndb-deliver-program "nndel"
  70   "*The program used to put a message in an NNDB group.")
  71
  72 ;; Variables copied from nntp
  73
  74 (defvoo nndb-server-opened-hook '(nntp-send-authinfo-from-file)
  75   "Like nntp-server-opened-hook."
  76   nntp-server-opened-hook)
  77
  78 ;(defvoo nndb-rlogin-parameters '("telnet" "${NNDBSERVER:=localhost}" "9000")
  79 ;  "*Parameters to nndb-open-login.  Like nntp-rlogin-parameters."
  80 ;  nntp-rlogin-parameters)
  81
  82 ;(defvoo nndb-rlogin-user-name nil
  83 ;  "*User name for rlogin connect method."
  84 ;  nntp-rlogin-user-name)
  85
  86 (defvoo nndb-address "localhost"
  87   "*The name of the NNDB server."
  88   nntp-address)
  89
  90 (defvoo nndb-port-number 9000
  91   "*Port number to connect to."
  92   nntp-port-number)
  93
  94 ;(defvoo nndb-current-group ""
  95 ;  "Like nntp-current-group."
  96 ;  nntp-current-group)
  97
  98 (defvoo nndb-status-string nil "" nntp-status-string)
  99
 100 \f
 101
 102 (defconst nndb-version "nndb 0.3"
 103   "Version numbers of this version of NNDB.")
 104
 105 \f
 106 ;;; Interface functions.
 107
 108 (nnoo-define-basics nndb)
 109
 110 ;; Import other stuff from nntp as is.
 111
 112 (nnoo-import nndb
 113   (nntp))
 114
 115 ;;- maybe this should be mail??
 116 ;;-(defun nndb-request-type (group &optional article)
 117 ;;-  'news)
 118
 119 ;;------------------------------------------------------------------
 120 ;;- only new stuff below
 121
 122 ; nndb-request-update-info does not exist and is not needed
 123
 124 ; nndb-request-update-mark does not exist and is not needed
 125
 126 ; nndb-request-scan does not exist
 127 ; get new mail from somewhere -- maybe this is not needed?
 128 ; --> todo
 129
 130 (deffoo nndb-request-create-group (group &optional server)
 131   "Creates a group if it doesn't exist yet."
 132   (nntp-send-command "^[23].*\n" "MKGROUP" group))
 133
 134 ; todo -- use some other time than the creation time of the article
 135 ; best is time since article has been marked as expirable
 136 (deffoo nndb-request-expire-articles
 137   (articles &optional group server force)
 138   "Expires ARTICLES from GROUP on SERVER.
 139 If FORCE, delete regardless of exiration date, otherwise use normal
 140 expiry mechanism."
 141   (let (msg art)
 142     (nntp-possibly-change-group group server) ;;-
 143     (while articles
 144       (setq art (pop articles))
 145       (nntp-send-command "^\\([23]\\|^423\\).*\n" "DATE" art)
 146       (setq msg (nndb-status-message))
 147       ;; CCC we shouldn't be using the variable nndb-status-string?
 148       (if (string-match "^423" (nnheader-get-report 'nndb))
 149           ()
 150         (or (string-match "\\([0-9]+\\) \\([0-9]+\\)$" msg)
 151             (error "Not a valid response for DATE command: %s"
 152                    msg))
 153         (if (nnmail-expired-article-p
 154              group
 155              (list (string-to-int
 156                     (substring msg (match-beginning 1) (match-end 1)))
 157                    (string-to-int
 158                     (substring msg (match-beginning 2) (match-end 2))))
 159              force)
 160             (nnheader-message 5 "Deleting article %s in %s..."
 161                               art group)
 162           (nntp-send-command "^[23].*\n" "DELETE" art))))))
 163
 164 (deffoo nndb-request-move-article
 165   (article group server accept-form &optional last)
 166   "Move ARTICLE (a number) from GROUP on SERVER.
 167 Evals ACCEPT-FORM in current buffer, where the article is.
 168 Optional LAST is ignored."
 169   (let ((artbuf (get-buffer-create " *nndb move*"))
 170         result)
 171     (and
 172      (nndb-request-article article group server artbuf)
 173      (save-excursion
 174        (set-buffer artbuf)
 175        (setq result (eval accept-form))
 176        (kill-buffer (current-buffer))
 177        result)
 178      (nndb-request-expire-articles (list article)
 179                                    group
 180                                    server
 181                                    t))
 182     result))
 183
 184 (deffoo nndb-request-accept-article (group server &optional last)
 185   "The article in the current buffer is put into GROUP."
 186   (nntp-possibly-change-group group server) ;;-
 187   (let (art statmsg)
 188     (when (nntp-send-command "^[23].*\r?\n" "ACCEPT" group)
 189       (nnheader-insert "")
 190       (nntp-encode-text)
 191       (nntp-send-buffer "^[23].*\n")
 192       (setq statmsg (nntp-status-message))
 193       (or (string-match "^\\([0-9]+\\)" statmsg)
 194           (error "nndb: %s" statmsg))
 195       (setq art (substring statmsg
 196                            (match-beginning 1)
 197                            (match-end 1)))
 198       (message "nndb: accepted %s" art)
 199       (list art))))
 200
 201 (deffoo nndb-request-replace-article (article group buffer)
 202   "ARTICLE is the number of the article in GROUP to be replaced
 203 with the contents of the BUFFER."
 204   (set-buffer buffer)
 205   (let (art statmsg)
 206     (when (nntp-send-command "^[23].*\r?\n" "REPLACE" (int-to-string article))
 207       (nnheader-insert "")
 208       (nntp-encode-text)
 209       (nntp-send-buffer "^[23].*\n")
 210 ;      (setq statmsg (nntp-status-message))
 211 ;      (or (string-match "^\\([0-9]+\\)" statmsg)
 212 ;          (error "nndb: %s" statmsg))
 213 ;      (setq art (substring statmsg
 214 ;                           (match-beginning 1)
 215 ;                           (match-end 1)))
 216 ;      (message "nndb: replaced %s" art)
 217       (list (int-to-string article)))))
 218
 219 ; nndb-request-delete-group does not exist
 220 ; todo -- maybe later
 221
 222 ; nndb-request-rename-group does not exist
 223 ; todo -- maybe later
 224
 225 (provide 'nndb)
 226
 227