Mercurial > hg > xemacs-beta

comparison lisp/gnus/nndb.el @ 16:0293115a14e9 r19-15b91

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b91
author cvs
date Mon, 13 Aug 2007 08:49:20 +0200
parents 376386a54a3c
children ec9a17fef872
comparison
equal deleted inserted replaced
15:ad457d5f7d04 16:0293115a14e9
1 ;;; nndb.el --- nndb access for Gnus 1 ;;; nndb.el --- nndb access for Gnus
2 ;; Copyright (C) 1996 Free Software Foundation, Inc. 2 ;; Copyright (C) 1996,97 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)
32 35
33 (setq gnus-valid-select-methods 36 (setq gnus-valid-select-methods
34 (cons '("nndb" mail address respool prompt-address) 37 (cons '("nndb" mail address respool prompt-address)
35 gnus-valid-select-methods)) 38 gnus-valid-select-methods))
36 39
121 124
122 ; nndb-request-scan does not exist 125 ; nndb-request-scan does not exist
123 ; get new mail from somewhere -- maybe this is not needed? 126 ; get new mail from somewhere -- maybe this is not needed?
124 ; --> todo 127 ; --> todo
125 128
126 (deffoo nndb-request-create-group (group &optional server) 129 (deffoo nndb-request-create-group (group &optional server args)
127 "Creates a group if it doesn't exist yet." 130 "Creates a group if it doesn't exist yet."
128 (nntp-send-command "^[23].*\n" "MKGROUP" group)) 131 (nntp-send-command "^[23].*\n" "MKGROUP" group))
129 132
130 ; todo -- use some other time than the creation time of the article 133 ; todo -- use some other time than the creation time of the article
131 ; best is time since article has been marked as expirable 134 ; best is time since article has been marked as expirable
132 (deffoo nndb-request-expire-articles 135 (deffoo nndb-request-expire-articles
133 (articles &optional group server force) 136 (articles &optional group server force)
134 "Expires ARTICLES from GROUP on SERVER. 137 "Expires ARTICLES from GROUP on SERVER.
135 If FORCE, delete regardless of exiration date, otherwise use normal 138 If FORCE, delete regardless of expiration date, otherwise use normal
136 expiry mechanism." 139 expiry mechanism."
137 (let (msg art) 140 (let (msg art)
138 (nntp-possibly-change-server group server) ;;- 141 (nntp-possibly-change-group group server) ;;-
139 (while articles 142 (while articles
140 (setq art (pop articles)) 143 (setq art (pop articles))
141 (nntp-send-command "^\\([23]\\|^423\\).*\n" "DATE" art) 144 (nntp-send-command "^\\([23]\\|^423\\).*\n" "DATE" art)
142 (setq msg (nndb-status-message)) 145 (setq msg (nndb-status-message))
143 ;; CCC we shouldn't be using the variable nndb-status-string? 146 ;; CCC we shouldn't be using the variable nndb-status-string?
144 (if (string-match "^423" (nnheader-get-report 'nndb)) 147 (if (string-match "^423" (nnheader-get-report 'nndb))
145 () 148 ()
146 (or (string-match "\\([0-9]+\\) \\([0-9]+\\)$" msg) 149 (unless (string-match "\\([0-9]+\\) \\([0-9]+\\)$" msg)
147 (error "Not a valid response for DATE command: %s" 150 (error "Not a valid response for DATE command: %s"
148 msg)) 151 msg))
149 (if (nnmail-expired-article-p 152 (if (nnmail-expired-article-p
150 group 153 group
151 (list (string-to-int 154 (list (string-to-int
152 (substring msg (match-beginning 1) (match-end 1))) 155 (substring msg (match-beginning 1) (match-end 1)))
153 (string-to-int 156 (string-to-int
177 t)) 180 t))
178 result)) 181 result))
179 182
180 (deffoo nndb-request-accept-article (group server &optional last) 183 (deffoo nndb-request-accept-article (group server &optional last)
181 "The article in the current buffer is put into GROUP." 184 "The article in the current buffer is put into GROUP."
182 (nntp-possibly-change-server group server) ;;- 185 (nntp-possibly-change-group group server) ;;-
183 (let (art statmsg) 186 (let (art statmsg)
184 (when (nntp-send-command "^[23].*\r?\n" "ACCEPT" group) 187 (when (nntp-send-command "^[23].*\r?\n" "ACCEPT" group)
185 (nnheader-insert "") 188 (nnheader-insert "")
186 (nntp-encode-text) 189 (nntp-encode-text)
187 (nntp-send-region-to-server (point-min) (point-max)) 190 (nntp-send-buffer "^[23].*\n")
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 (or (string-match "^\\([0-9]+\\)" statmsg) 192 (unless (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))))
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-region-to-server (point-min) (point-max)) 208 (nntp-send-buffer "^[23].*\n")
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)) 209 ; (setq statmsg (nntp-status-message))
213 ; (or (string-match "^\\([0-9]+\\)" statmsg) 210 ; (or (string-match "^\\([0-9]+\\)" statmsg)
214 ; (error "nndb: %s" statmsg)) 211 ; (error "nndb: %s" statmsg))
215 ; (setq art (substring statmsg 212 ; (setq art (substring statmsg
216 ; (match-beginning 1) 213 ; (match-beginning 1)