Mercurial > hg > xemacs-beta

comparison lisp/gnus/nndb.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents ec9a17fef872
children 0d2f883870bc
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;;; nndb.el --- nndb access for Gnus 1 ;;; nndb.el --- nndb access for Gnus
2 ;; Copyright (C) 1996,97 Free Software Foundation, Inc. 2 ;; Copyright (C) 1996 Free Software Foundation, Inc.
3 3
4 ;; Author: Kai Grossjohann <grossjohann@ls6.informatik.uni-dortmund.de> 4 ;; Author: Kai Grossjohann <grossjohann@ls6.informatik.uni-dortmund.de>
5 ;; Keywords: news 5 ;; Keywords: news
6 6
7 ;; This file is part of GNU Emacs. 7 ;; This file is part of GNU Emacs.
27 ;; Kai 27 ;; Kai
28 28
29 29
30 ;;- 30 ;;-
31 ;; Register nndb with known select methods. 31 ;; Register nndb with known select methods.
32
33 (require 'gnus)
34 (require 'nnmail)
35 32
36 (setq gnus-valid-select-methods 33 (setq gnus-valid-select-methods
37 (cons '("nndb" mail address respool prompt-address) 34 (cons '("nndb" mail address respool prompt-address)
38 gnus-valid-select-methods)) 35 gnus-valid-select-methods))
39 36
124 121
125 ; nndb-request-scan does not exist 122 ; nndb-request-scan does not exist
126 ; get new mail from somewhere -- maybe this is not needed? 123 ; get new mail from somewhere -- maybe this is not needed?
127 ; --> todo 124 ; --> todo
128 125
129 (deffoo nndb-request-create-group (group &optional server args) 126 (deffoo nndb-request-create-group (group &optional server)
130 "Creates a group if it doesn't exist yet." 127 "Creates a group if it doesn't exist yet."
131 (nntp-send-command "^[23].*\n" "MKGROUP" group)) 128 (nntp-send-command "^[23].*\n" "MKGROUP" group))
132 129
133 ; todo -- use some other time than the creation time of the article 130 ; todo -- use some other time than the creation time of the article
134 ; best is time since article has been marked as expirable 131 ; best is time since article has been marked as expirable
135 (deffoo nndb-request-expire-articles 132 (deffoo nndb-request-expire-articles
136 (articles &optional group server force) 133 (articles &optional group server force)
137 "Expires ARTICLES from GROUP on SERVER. 134 "Expires ARTICLES from GROUP on SERVER.
138 If FORCE, delete regardless of expiration date, otherwise use normal 135 If FORCE, delete regardless of exiration date, otherwise use normal
139 expiry mechanism." 136 expiry mechanism."
140 (let (msg art) 137 (let (msg art)
141 (nntp-possibly-change-group group server) ;;- 138 (nntp-possibly-change-server group server) ;;-
142 (while articles 139 (while articles
143 (setq art (pop articles)) 140 (setq art (pop articles))
144 (nntp-send-command "^\\([23]\\|^423\\).*\n" "DATE" art) 141 (nntp-send-command "^\\([23]\\|^423\\).*\n" "DATE" art)
145 (setq msg (nndb-status-message)) 142 (setq msg (nndb-status-message))
146 ;; CCC we shouldn't be using the variable nndb-status-string? 143 ;; CCC we shouldn't be using the variable nndb-status-string?
147 (if (string-match "^423" (nnheader-get-report 'nndb)) 144 (if (string-match "^423" (nnheader-get-report 'nndb))
148 () 145 ()
149 (unless (string-match "\\([0-9]+\\) \\([0-9]+\\)$" msg) 146 (or (string-match "\\([0-9]+\\) \\([0-9]+\\)$" msg)
150 (error "Not a valid response for DATE command: %s" 147 (error "Not a valid response for DATE command: %s"
151 msg)) 148 msg))
152 (if (nnmail-expired-article-p 149 (if (nnmail-expired-article-p
153 group 150 group
154 (list (string-to-int 151 (list (string-to-int
155 (substring msg (match-beginning 1) (match-end 1))) 152 (substring msg (match-beginning 1) (match-end 1)))
156 (string-to-int 153 (string-to-int
177 (nndb-request-expire-articles (list article) 174 (nndb-request-expire-articles (list article)
178 group 175 group
179 server 176 server
180 t)) 177 t))
181 result)) 178 result))
182 179
183 (deffoo nndb-request-accept-article (group server &optional last) 180 (deffoo nndb-request-accept-article (group server &optional last)
184 "The article in the current buffer is put into GROUP." 181 "The article in the current buffer is put into GROUP."
185 (nntp-possibly-change-group group server) ;;- 182 (nntp-possibly-change-server group server) ;;-
186 (let (art statmsg) 183 (let (art statmsg)
187 (when (nntp-send-command "^[23].*\r?\n" "ACCEPT" group) 184 (when (nntp-send-command "^[23].*\r?\n" "ACCEPT" group)
188 (nnheader-insert "") 185 (nnheader-insert "")
189 (nntp-encode-text) 186 (nntp-encode-text)
190 (nntp-send-buffer "^[23].*\n") 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)) 191 (setq statmsg (nntp-status-message))
192 (unless (string-match "^\\([0-9]+\\)" statmsg) 192 (or (string-match "^\\([0-9]+\\)" statmsg)
193 (error "nndb: %s" statmsg)) 193 (error "nndb: %s" statmsg))
194 (setq art (substring statmsg 194 (setq art (substring statmsg
195 (match-beginning 1) 195 (match-beginning 1)
196 (match-end 1))) 196 (match-end 1)))
197 (message "nndb: accepted %s" art) 197 (message "nndb: accepted %s" art)
198 (list art)))) 198 (list art))))
199 199
200 (deffoo nndb-request-replace-article (article group buffer) 200 (deffoo nndb-request-replace-article (article group buffer)
201 "ARTICLE is the number of the article in GROUP to be replaced 201 "ARTICLE is the number of the article in GROUP to be replaced
202 with the contents of the BUFFER." 202 with the contents of the BUFFER."
203 (set-buffer buffer) 203 (set-buffer buffer)
204 (let (art statmsg) 204 (let (art statmsg)
205 (when (nntp-send-command "^[23].*\r?\n" "REPLACE" (int-to-string article)) 205 (when (nntp-send-command "^[23].*\r?\n" "REPLACE" (int-to-string article))
206 (nnheader-insert "") 206 (nnheader-insert "")
207 (nntp-encode-text) 207 (nntp-encode-text)
208 (nntp-send-buffer "^[23].*\n") 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")
209 ; (setq statmsg (nntp-status-message)) 212 ; (setq statmsg (nntp-status-message))
210 ; (or (string-match "^\\([0-9]+\\)" statmsg) 213 ; (or (string-match "^\\([0-9]+\\)" statmsg)
211 ; (error "nndb: %s" statmsg)) 214 ; (error "nndb: %s" statmsg))
212 ; (setq art (substring statmsg 215 ; (setq art (substring statmsg
213 ; (match-beginning 1) 216 ; (match-beginning 1)