Mercurial > emacs

comparison lisp/gnus/gnus-int.el @ 91085:880960b70474

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge from emacs--devo--0 Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-283
author Miles Bader <miles@gnu.org>
date Sun, 11 Nov 2007 00:56:44 +0000
parents f55f9811f5d7 a3c27999decb
children 53108e6cea98
comparison
equal deleted inserted replaced
91084:a4347a111894 91085:880960b70474
73 (setq gnus-nntp-server nil)) 73 (setq gnus-nntp-server nil))
74 (when confirm 74 (when confirm
75 ;; Read server name with completion. 75 ;; Read server name with completion.
76 (setq gnus-nntp-server 76 (setq gnus-nntp-server
77 (completing-read "NNTP server: " 77 (completing-read "NNTP server: "
78 (mapcar (lambda (server) (list server)) 78 (mapcar 'list
79 (cons (list gnus-nntp-server) 79 (cons (list gnus-nntp-server)
80 gnus-secondary-servers)) 80 gnus-secondary-servers))
81 nil nil gnus-nntp-server))) 81 nil nil gnus-nntp-server)))
82 82
83 (when (and gnus-nntp-server 83 (when (and gnus-nntp-server
207 207
208 (defun gnus-open-server (gnus-command-method) 208 (defun gnus-open-server (gnus-command-method)
209 "Open a connection to GNUS-COMMAND-METHOD." 209 "Open a connection to GNUS-COMMAND-METHOD."
210 (when (stringp gnus-command-method) 210 (when (stringp gnus-command-method)
211 (setq gnus-command-method (gnus-server-to-method gnus-command-method))) 211 (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
212 (let ((elem (assoc gnus-command-method gnus-opened-servers))) 212 (let ((elem (assoc gnus-command-method gnus-opened-servers))
213 (server (gnus-method-to-server-name gnus-command-method)))
213 ;; If this method was previously denied, we just return nil. 214 ;; If this method was previously denied, we just return nil.
214 (if (eq (nth 1 elem) 'denied) 215 (if (eq (nth 1 elem) 'denied)
215 (progn 216 (progn
216 (gnus-message 1 "Denied server") 217 (gnus-message 1 "Denied server %s" server)
217 nil) 218 nil)
218 ;; Open the server. 219 ;; Open the server.
219 (let* ((open-server-function (gnus-get-function gnus-command-method 'open-server)) 220 (let* ((open-server-function (gnus-get-function gnus-command-method 'open-server))
220 (result 221 (result
221 (condition-case err 222 (condition-case err
222 (funcall open-server-function 223 (funcall open-server-function
223 (nth 1 gnus-command-method) 224 (nth 1 gnus-command-method)
224 (nthcdr 2 gnus-command-method)) 225 (nthcdr 2 gnus-command-method))
225 (error 226 (error
226 (gnus-message 1 (format 227 (gnus-message 1 (format
227 "Unable to open server due to: %s" 228 "Unable to open server %s due to: %s"
228 (error-message-string err))) 229 server (error-message-string err)))
229 nil) 230 nil)
230 (quit 231 (quit
231 (gnus-message 1 "Quit trying to open server") 232 (gnus-message 1 "Quit trying to open server %s" server)
232 nil))) 233 nil)))
233 open-offline) 234 open-offline)
234 ;; If this hasn't been opened before, we add it to the list. 235 ;; If this hasn't been opened before, we add it to the list.
235 (unless elem 236 (unless elem
236 (setq elem (list gnus-command-method nil) 237 (setq elem (list gnus-command-method nil)
251 (setq open-offline (eq gnus-server-unopen-status 'offline)) 252 (setq open-offline (eq gnus-server-unopen-status 'offline))
252 gnus-server-unopen-status) 253 gnus-server-unopen-status)
253 ((and 254 ((and
254 (not gnus-batch-mode) 255 (not gnus-batch-mode)
255 (gnus-y-or-n-p 256 (gnus-y-or-n-p
256 (format "Unable to open %s:%s, go offline? " 257 (format
257 (car gnus-command-method) 258 "Unable to open server %s, go offline? "
258 (cadr gnus-command-method)))) 259 server)))
259 (setq open-offline t) 260 (setq open-offline t)
260 'offline) 261 'offline)
261 (t 262 (t
262 ;; This agentized server was still denied 263 ;; This agentized server was still denied
263 'denied))) 264 'denied)))
333 (when (stringp gnus-command-method) 334 (when (stringp gnus-command-method)
334 (setq gnus-command-method (gnus-server-to-method gnus-command-method))) 335 (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
335 (funcall (gnus-get-function gnus-command-method 'request-regenerate) 336 (funcall (gnus-get-function gnus-command-method 'request-regenerate)
336 (nth 1 gnus-command-method))) 337 (nth 1 gnus-command-method)))
337 338
339 (defun gnus-request-compact-group (group)
340 (let* ((method (gnus-find-method-for-group group))
341 (gnus-command-method method)
342 (result
343 (funcall (gnus-get-function gnus-command-method
344 'request-compact-group)
345 (gnus-group-real-name group)
346 (nth 1 gnus-command-method) t)))
347 result))
348
349 (defun gnus-request-compact (gnus-command-method)
350 "Request groups compaction from GNUS-COMMAND-METHOD."
351 (when (stringp gnus-command-method)
352 (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
353 (funcall (gnus-get-function gnus-command-method 'request-compact)
354 (nth 1 gnus-command-method)))
355
338 (defun gnus-request-group (group &optional dont-check gnus-command-method) 356 (defun gnus-request-group (group &optional dont-check gnus-command-method)
339 "Request GROUP. If DONT-CHECK, no information is required." 357 "Request GROUP. If DONT-CHECK, no information is required."
340 (let ((gnus-command-method 358 (let ((gnus-command-method
341 (or gnus-command-method (inline (gnus-find-method-for-group group))))) 359 (or gnus-command-method (inline (gnus-find-method-for-group group)))))
342 (when (stringp gnus-command-method) 360 (when (stringp gnus-command-method)
343 (setq gnus-command-method 361 (setq gnus-command-method
344 (inline (gnus-server-to-method gnus-command-method)))) 362 (inline (gnus-server-to-method gnus-command-method))))
345 (funcall (inline (gnus-get-function gnus-command-method 'request-group)) 363 (funcall (inline (gnus-get-function gnus-command-method 'request-group))
346 (gnus-group-real-name group) (nth 1 gnus-command-method) 364 (gnus-group-real-name group) (nth 1 gnus-command-method)
347 dont-check))) 365 dont-check)))
348 366
349 (defun gnus-list-active-group (group) 367 (defun gnus-list-active-group (group)
350 "Request active information on GROUP." 368 "Request active information on GROUP."
519 If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." 537 If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
520 (let ((gnus-command-method 538 (let ((gnus-command-method
521 (if group (gnus-find-method-for-group group) gnus-command-method)) 539 (if group (gnus-find-method-for-group group) gnus-command-method))
522 (gnus-inhibit-demon t) 540 (gnus-inhibit-demon t)
523 (mail-source-plugged gnus-plugged)) 541 (mail-source-plugged gnus-plugged))
524 (if (or gnus-plugged (not (gnus-agent-method-p gnus-command-method))) 542 (when (or gnus-plugged (not (gnus-agent-method-p gnus-command-method)))
525 (progn 543 (setq gnus-internal-registry-spool-current-method gnus-command-method)
526 (setq gnus-internal-registry-spool-current-method gnus-command-method) 544 (funcall (gnus-get-function gnus-command-method 'request-scan)
527 (funcall (gnus-get-function gnus-command-method 'request-scan) 545 (and group (gnus-group-real-name group))
528 (and group (gnus-group-real-name group)) 546 (nth 1 gnus-command-method)))))
529 (nth 1 gnus-command-method))))))
530 547
531 (defsubst gnus-request-update-info (info gnus-command-method) 548 (defsubst gnus-request-update-info (info gnus-command-method)
532 "Request that GNUS-COMMAND-METHOD update INFO." 549 "Request that GNUS-COMMAND-METHOD update INFO."
533 (when (stringp gnus-command-method) 550 (when (stringp gnus-command-method)
534 (setq gnus-command-method (gnus-server-to-method gnus-command-method))) 551 (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
564 (when expired-articles 581 (when expired-articles
565 (gnus-agent-expire expired-articles group 'force)))) 582 (gnus-agent-expire expired-articles group 'force))))
566 not-deleted)) 583 not-deleted))
567 584
568 (defun gnus-request-move-article (article group server accept-function 585 (defun gnus-request-move-article (article group server accept-function
569 &optional last) 586 &optional last move-is-internal)
570 (let* ((gnus-command-method (gnus-find-method-for-group group)) 587 (let* ((gnus-command-method (gnus-find-method-for-group group))
571 (result (funcall (gnus-get-function gnus-command-method 588 (result (funcall (gnus-get-function gnus-command-method
572 'request-move-article) 589 'request-move-article)
573 article (gnus-group-real-name group) 590 article (gnus-group-real-name group)
574 (nth 1 gnus-command-method) accept-function last))) 591 (nth 1 gnus-command-method) accept-function last move-is-internal)))
575 (when (and result gnus-agent 592 (when (and result gnus-agent
576 (gnus-agent-method-p gnus-command-method)) 593 (gnus-agent-method-p gnus-command-method))
577 (gnus-agent-unfetch-articles group (list article))) 594 (gnus-agent-unfetch-articles group (list article)))
578 result)) 595 result))
579 596
595 (save-restriction 612 (save-restriction
596 (message-narrow-to-head) 613 (message-narrow-to-head)
597 (let ((mail-parse-charset message-default-charset)) 614 (let ((mail-parse-charset message-default-charset))
598 (mail-encode-encoded-word-buffer))) 615 (mail-encode-encoded-word-buffer)))
599 (message-encode-message-body))) 616 (message-encode-message-body)))
600 (let ((gnus-command-method (or gnus-command-method 617 (let ((gnus-command-method (or gnus-command-method
601 (gnus-find-method-for-group group))) 618 (gnus-find-method-for-group group)))
602 (result 619 (result
603 (funcall 620 (funcall
604 (gnus-get-function gnus-command-method 'request-accept-article) 621 (gnus-get-function gnus-command-method 'request-accept-article)
605 (if (stringp group) (gnus-group-real-name group) group) 622 (if (stringp group) (gnus-group-real-name group) group)