| 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 | |