Mercurial > hg > xemacs-beta

comparison lisp/gnus/nndb.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 0293115a14e9
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
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
97
98 (defconst nndb-version "nndb 0.3"
99 "Version numbers of this version of NNDB.")
100
101
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