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