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

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