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 (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 ;;- maybe this should be mail??
 107 ;;-(defun nndb-request-type (group &optional article)
 108 ;;-  'news)
 109
 110 ;;------------------------------------------------------------------
 111 ;;- only new stuff below
 112
 113 ; nndb-request-update-info does not exist and is not needed
 114
 115 ; nndb-request-update-mark does not exist and is not needed
 116
 117 ; nndb-request-scan does not exist
 118 ; get new mail from somewhere -- maybe this is not needed?
 119 ; --> todo
 120
 121 (deffoo nndb-request-create-group (group &optional server)
 122   "Creates a group if it doesn't exist yet."
 123   (nntp-send-command "^[23].*\n" "MKGROUP" group))
 124
 125 ; todo -- use some other time than the creation time of the article
 126 ; best is time since article has been marked as expirable
 127 (deffoo nndb-request-expire-articles
 128   (articles &optional group server force)
 129   "Expires ARTICLES from GROUP on SERVER.
 130 If FORCE, delete regardless of exiration date, otherwise use normal
 131 expiry mechanism."
 132   (let (msg art)
 133     (nntp-possibly-change-server group server) ;;-
 134     (while articles
 135       (setq art (pop articles))
 136       (nntp-send-command "^\\([23]\\|^423\\).*\n" "DATE" art)
 137       (setq msg (nndb-status-message))
 138       ;; CCC we shouldn't be using the variable nndb-status-string?
 139       (if (string-match "^423" (nnheader-get-report 'nndb))
 140           ()
 141         (or (string-match "\\([0-9]+\\) \\([0-9]+\\)$" msg)
 142             (error "Not a valid response for DATE command: %s"
 143                    msg))
 144         (if (nnmail-expired-article-p
 145              group
 146              (list (string-to-int
 147                     (substring msg (match-beginning 1) (match-end 1)))
 148                    (string-to-int
 149                     (substring msg (match-beginning 2) (match-end 2))))
 150              force)
 151             (nnheader-message 5 "Deleting article %s in %s..."
 152                               art group)
 153           (nntp-send-command "^[23].*\n" "DELETE" art))))))
 154
 155 (deffoo nndb-request-move-article
 156   (article group server accept-form &optional last)
 157   "Move ARTICLE (a number) from GROUP on SERVER.
 158 Evals ACCEPT-FORM in current buffer, where the article is.
 159 Optional LAST is ignored."
 160   (let ((artbuf (get-buffer-create " *nndb move*"))
 161         result)
 162     (and
 163      (nndb-request-article article group server artbuf)
 164      (save-excursion
 165        (set-buffer artbuf)
 166        (setq result (eval accept-form))
 167        (kill-buffer (current-buffer))
 168        result)
 169      (nndb-request-expire-articles (list article)
 170                                    group
 171                                    server
 172                                    t))
 173     result))
 174
 175 (deffoo nndb-request-accept-article (group server &optional last)
 176   "The article in the current buffer is put into GROUP."
 177   (nntp-possibly-change-server group server) ;;-
 178   (let (art statmsg)
 179     (when (nntp-send-command "^[23].*\r?\n" "ACCEPT" group)
 180       (nnheader-insert "")
 181       (nntp-encode-text)
 182       (nntp-send-region-to-server (point-min) (point-max))
 183       ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not
 184       ;;  appended to end of the status message.
 185       (nntp-wait-for-response "^[23].*\n")
 186       (setq statmsg (nntp-status-message))
 187       (or (string-match "^\\([0-9]+\\)" statmsg)
 188           (error "nndb: %s" statmsg))
 189       (setq art (substring statmsg
 190                            (match-beginning 1)
 191                            (match-end 1)))
 192       (message "nndb: accepted %s" art)
 193       (list art))))
 194
 195 (deffoo nndb-request-replace-article (article group buffer)
 196   "ARTICLE is the number of the article in GROUP to be replaced
 197 with the contents of the BUFFER."
 198   (set-buffer buffer)
 199   (let (art statmsg)
 200     (when (nntp-send-command "^[23].*\r?\n" "REPLACE" (int-to-string article))
 201       (nnheader-insert "")
 202       (nntp-encode-text)
 203       (nntp-send-region-to-server (point-min) (point-max))
 204       ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not
 205       ;;  appended to end of the status message.
 206       (nntp-wait-for-response "^[23].*\n")
 207 ;      (setq statmsg (nntp-status-message))
 208 ;      (or (string-match "^\\([0-9]+\\)" statmsg)
 209 ;          (error "nndb: %s" statmsg))
 210 ;      (setq art (substring statmsg
 211 ;                           (match-beginning 1)
 212 ;                           (match-end 1)))
 213 ;      (message "nndb: replaced %s" art)
 214       (list (int-to-string article)))))
 215
 216 ; nndb-request-delete-group does not exist
 217 ; todo -- maybe later
 218
 219 ; nndb-request-rename-group does not exist
 220 ; todo -- maybe later
 221
 222 ;; Import stuff from nntp
 223
 224
 225
 226 ;; Import other stuff from nntp as is.
 227
 228 (nnoo-import nndb
 229   (nntp))
 230
 231 (provide 'nndb)
 232
 233