Commit | Line | Data |
---|---|---|
526baa41 LMI |
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 |