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 (setq gnus-valid-select-methods
  34       (cons '("nndb" mail address respool prompt-address)
  35             gnus-valid-select-methods))
  36
  37
  38 ;;; Code:
  39
  40 (require 'nnheader)
  41 (require 'nntp)
  42 (eval-when-compile (require 'cl))
  43
  44 (eval-and-compile
  45   (unless (fboundp 'open-network-stream)
  46     (require 'tcp)))
  47
  48 (eval-when-compile (require 'cl))
  49
  50 (eval-and-compile
  51   (autoload 'news-setup "rnewspost")
  52   (autoload 'news-reply-mode "rnewspost")
  53   (autoload 'cancel-timer "timer")
  54   (autoload 'telnet "telnet" nil t)
  55   (autoload 'telnet-send-input "telnet" nil t)
  56   (autoload 'timezone-parse-date "timezone"))
  57
  58 ;; Declare nndb as derived from nntp
  59
  60 (nnoo-declare nndb nntp)
  61
  62 ;; Variables specific to nndb
  63
  64 ;;- currently not used but just in case...
  65 (defvoo nndb-deliver-program "nndel"
  66   "*The program used to put a message in an NNDB group.")
  67
  68 ;; Variables copied from nntp
  69
  70 (defvoo nndb-server-opened-hook '(nntp-send-authinfo-from-file)
  71   "Like nntp-server-opened-hook."
  72   nntp-server-opened-hook)
  73
  74 ;(defvoo nndb-rlogin-parameters '("telnet" "${NNDBSERVER:=localhost}" "9000")
  75 ;  "*Parameters to nndb-open-login.  Like nntp-rlogin-parameters."
  76 ;  nntp-rlogin-parameters)
  77
  78 ;(defvoo nndb-rlogin-user-name nil
  79 ;  "*User name for rlogin connect method."
  80 ;  nntp-rlogin-user-name)
  81
  82 (defvoo nndb-address "localhost"
  83   "*The name of the NNDB server."
  84   nntp-address)
  85
  86 (defvoo nndb-port-number 9000
  87   "*Port number to connect to."
  88   nntp-port-number)
  89
  90 ;(defvoo nndb-current-group ""
  91 ;  "Like nntp-current-group."
  92 ;  nntp-current-group)
  93
  94 (defvoo nndb-status-string nil "" nntp-status-string)
  95
  96 \f
  97
  98 (defconst nndb-version "nndb 0.3"
  99   "Version numbers of this version of NNDB.")
 100
 101 \f
 102 ;;; Interface functions.
 103
 104 (nnoo-define-basics nndb)
 105
 106 ;; Import other stuff from nntp as is.
 107
 108 (nnoo-import nndb
 109   (nntp))
 110
 111 ;;- maybe this should be mail??
 112 ;;-(defun nndb-request-type (group &optional article)
 113 ;;-  'news)
 114
 115 ;;------------------------------------------------------------------
 116 ;;- only new stuff below
 117
 118 ; nndb-request-update-info does not exist and is not needed
 119
 120 ; nndb-request-update-mark does not exist and is not needed
 121
 122 ; nndb-request-scan does not exist
 123 ; get new mail from somewhere -- maybe this is not needed?
 124 ; --> todo
 125
 126 (deffoo nndb-request-create-group (group &optional server)
 127   "Creates a group if it doesn't exist yet."
 128   (nntp-send-command "^[23].*\n" "MKGROUP" group))
 129
 130 ; todo -- use some other time than the creation time of the article
 131 ; best is time since article has been marked as expirable
 132 (deffoo nndb-request-expire-articles
 133   (articles &optional group server force)
 134   "Expires ARTICLES from GROUP on SERVER.
 135 If FORCE, delete regardless of exiration date, otherwise use normal
 136 expiry mechanism."
 137   (let (msg art)
 138     (nntp-possibly-change-server group server) ;;-
 139     (while articles
 140       (setq art (pop articles))
 141       (nntp-send-command "^\\([23]\\|^423\\).*\n" "DATE" art)
 142       (setq msg (nndb-status-message))
 143       ;; CCC we shouldn't be using the variable nndb-status-string?
 144       (if (string-match "^423" (nnheader-get-report 'nndb))
 145           ()
 146         (or (string-match "\\([0-9]+\\) \\([0-9]+\\)$" msg)
 147             (error "Not a valid response for DATE command: %s"
 148                    msg))
 149         (if (nnmail-expired-article-p
 150              group
 151              (list (string-to-int
 152                     (substring msg (match-beginning 1) (match-end 1)))
 153                    (string-to-int
 154                     (substring msg (match-beginning 2) (match-end 2))))
 155              force)
 156             (nnheader-message 5 "Deleting article %s in %s..."
 157                               art group)
 158           (nntp-send-command "^[23].*\n" "DELETE" art))))))
 159
 160 (deffoo nndb-request-move-article
 161   (article group server accept-form &optional last)
 162   "Move ARTICLE (a number) from GROUP on SERVER.
 163 Evals ACCEPT-FORM in current buffer, where the article is.
 164 Optional LAST is ignored."
 165   (let ((artbuf (get-buffer-create " *nndb move*"))
 166         result)
 167     (and
 168      (nndb-request-article article group server artbuf)
 169      (save-excursion
 170        (set-buffer artbuf)
 171        (setq result (eval accept-form))
 172        (kill-buffer (current-buffer))
 173        result)
 174      (nndb-request-expire-articles (list article)
 175                                    group
 176                                    server
 177                                    t))
 178     result))
 179
 180 (deffoo nndb-request-accept-article (group server &optional last)
 181   "The article in the current buffer is put into GROUP."
 182   (nntp-possibly-change-server group server) ;;-
 183   (let (art statmsg)
 184     (when (nntp-send-command "^[23].*\r?\n" "ACCEPT" group)
 185       (nnheader-insert "")
 186       (nntp-encode-text)
 187       (nntp-send-region-to-server (point-min) (point-max))
 188       ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not
 189       ;;  appended to end of the status message.
 190       (nntp-wait-for-response "^[23].*\n")
 191       (setq statmsg (nntp-status-message))
 192       (or (string-match "^\\([0-9]+\\)" statmsg)
 193           (error "nndb: %s" statmsg))
 194       (setq art (substring statmsg
 195                            (match-beginning 1)
 196                            (match-end 1)))
 197       (message "nndb: accepted %s" art)
 198       (list art))))
 199
 200 (deffoo nndb-request-replace-article (article group buffer)
 201   "ARTICLE is the number of the article in GROUP to be replaced
 202 with the contents of the BUFFER."
 203   (set-buffer buffer)
 204   (let (art statmsg)
 205     (when (nntp-send-command "^[23].*\r?\n" "REPLACE" (int-to-string article))
 206       (nnheader-insert "")
 207       (nntp-encode-text)
 208       (nntp-send-region-to-server (point-min) (point-max))
 209       ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not
 210       ;;  appended to end of the status message.
 211       (nntp-wait-for-response "^[23].*\n")
 212 ;      (setq statmsg (nntp-status-message))
 213 ;      (or (string-match "^\\([0-9]+\\)" statmsg)
 214 ;          (error "nndb: %s" statmsg))
 215 ;      (setq art (substring statmsg
 216 ;                           (match-beginning 1)
 217 ;                           (match-end 1)))
 218 ;      (message "nndb: replaced %s" art)
 219       (list (int-to-string article)))))
 220
 221 ; nndb-request-delete-group does not exist
 222 ; todo -- maybe later
 223
 224 ; nndb-request-rename-group does not exist
 225 ; todo -- maybe later
 226
 227 (provide 'nndb)
 228
 229