/[emacs]/emacs/lisp/gnus/gnus-int.el
ViewVC logotype

Diff of /emacs/lisp/gnus/gnus-int.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.7.6.3 by miles, Tue Sep 21 09:34:07 2004 UTC revision 1.7.6.4 by miles, Fri Oct 22 10:13:32 2004 UTC
# Line 33  Line 33 
33  (require 'gnus-range)  (require 'gnus-range)
34    
35  (autoload 'gnus-agent-expire "gnus-agent")  (autoload 'gnus-agent-expire "gnus-agent")
36    (autoload 'gnus-agent-regenerate-group "gnus-agent")
37  (autoload 'gnus-agent-read-servers-validate-native "gnus-agent")  (autoload 'gnus-agent-read-servers-validate-native "gnus-agent")
38    
39  (defcustom gnus-open-server-hook nil  (defcustom gnus-open-server-hook nil
# Line 176  If it is down, start it up (again)." Line 177  If it is down, start it up (again)."
177      (setq method (gnus-server-to-method method)))      (setq method (gnus-server-to-method method)))
178    ;; Check cache of constructed names.    ;; Check cache of constructed names.
179    (let* ((method-sym (if gnus-agent    (let* ((method-sym (if gnus-agent
180                           (gnus-agent-get-function method)                           (inline (gnus-agent-get-function method))
181                         (car method)))                         (car method)))
182           (method-fns (get method-sym 'gnus-method-functions))           (method-fns (get method-sym 'gnus-method-functions))
183           (func (let ((method-fnlist-elt (assq function method-fns)))           (func (let ((method-fnlist-elt (assq function method-fns)))
# Line 570  If GROUP is nil, all groups on GNUS-COMM Line 571  If GROUP is nil, all groups on GNUS-COMM
571                            (nth 1 gnus-command-method) accept-function last)))                            (nth 1 gnus-command-method) accept-function last)))
572      (when (and result gnus-agent      (when (and result gnus-agent
573                 (gnus-agent-method-p gnus-command-method))                 (gnus-agent-method-p gnus-command-method))
574        (gnus-agent-expire (list article) group 'force))        (gnus-agent-unfetch-articles group (list article)))
575      result))      result))
576            
577  (defun gnus-request-accept-article (group &optional gnus-command-method last  (defun gnus-request-accept-article (group &optional gnus-command-method last
# Line 580  If GROUP is nil, all groups on GNUS-COMM Line 581  If GROUP is nil, all groups on GNUS-COMM
581      (setq gnus-command-method (gnus-server-to-method gnus-command-method)))      (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
582    (when (and (not gnus-command-method)    (when (and (not gnus-command-method)
583               (stringp group))               (stringp group))
584      (setq gnus-command-method (gnus-group-name-to-method group)))      (setq gnus-command-method (or (gnus-find-method-for-group group)
585                                      (gnus-group-name-to-method group))))
586    (goto-char (point-max))    (goto-char (point-max))
587    (unless (bolp)    (unless (bolp)
588      (insert "\n"))      (insert "\n"))
# Line 592  If GROUP is nil, all groups on GNUS-COMM Line 594  If GROUP is nil, all groups on GNUS-COMM
594          (let ((mail-parse-charset message-default-charset))          (let ((mail-parse-charset message-default-charset))
595            (mail-encode-encoded-word-buffer)))            (mail-encode-encoded-word-buffer)))
596        (message-encode-message-body)))        (message-encode-message-body)))
597    (let ((gnus-command-method (or gnus-command-method  (let ((gnus-command-method (or gnus-command-method
598                                   (gnus-find-method-for-group group))))                                   (gnus-find-method-for-group group)))
599      (funcall (gnus-get-function gnus-command-method 'request-accept-article)          (result
600               (if (stringp group) (gnus-group-real-name group) group)           (funcall
601               (cadr gnus-command-method)            (gnus-get-function gnus-command-method 'request-accept-article)
602               last)))            (if (stringp group) (gnus-group-real-name group) group)
603              (cadr gnus-command-method)
604              last)))
605        (when (and gnus-agent (gnus-agent-method-p gnus-command-method))
606          (gnus-agent-regenerate-group group (list (cdr result))))
607        result))
608    
609  (defun gnus-request-replace-article (article group buffer &optional no-encode)  (defun gnus-request-replace-article (article group buffer &optional no-encode)
610    (unless no-encode    (unless no-encode
# Line 608  If GROUP is nil, all groups on GNUS-COMM Line 615  If GROUP is nil, all groups on GNUS-COMM
615          (let ((mail-parse-charset message-default-charset))          (let ((mail-parse-charset message-default-charset))
616            (mail-encode-encoded-word-buffer)))            (mail-encode-encoded-word-buffer)))
617        (message-encode-message-body)))        (message-encode-message-body)))
618    (let ((func (car (gnus-group-name-to-method group))))    (let* ((func (car (gnus-group-name-to-method group)))
619      (funcall (intern (format "%s-request-replace-article" func))           (result (funcall (intern (format "%s-request-replace-article" func))
620               article (gnus-group-real-name group) buffer)))                            article (gnus-group-real-name group) buffer)))
621        (when (and gnus-agent (gnus-agent-method-p gnus-command-method))
622          (gnus-agent-regenerate-group group (list article)))
623        result))
624    
625  (defun gnus-request-associate-buffer (group)  (defun gnus-request-associate-buffer (group)
626    (let ((gnus-command-method (gnus-find-method-for-group group)))    (let ((gnus-command-method (gnus-find-method-for-group group)))
# Line 633  If GROUP is nil, all groups on GNUS-COMM Line 643  If GROUP is nil, all groups on GNUS-COMM
643               (gnus-group-real-name group) (nth 1 gnus-command-method) args)))               (gnus-group-real-name group) (nth 1 gnus-command-method) args)))
644    
645  (defun gnus-request-delete-group (group &optional force)  (defun gnus-request-delete-group (group &optional force)
646    (let ((gnus-command-method (gnus-find-method-for-group group)))    (let* ((gnus-command-method (gnus-find-method-for-group group))
647      (funcall (gnus-get-function gnus-command-method 'request-delete-group)           (result
648               (gnus-group-real-name group) force (nth 1 gnus-command-method))))            (funcall (gnus-get-function gnus-command-method 'request-delete-group)
649                       (gnus-group-real-name group) force (nth 1 gnus-command-method))))
650        (when result
651          (gnus-cache-delete-group group)
652          (gnus-agent-delete-group group))
653        result))
654    
655  (defun gnus-request-rename-group (group new-name)  (defun gnus-request-rename-group (group new-name)
656    (let ((gnus-command-method (gnus-find-method-for-group group)))    (let* ((gnus-command-method (gnus-find-method-for-group group))
657      (funcall (gnus-get-function gnus-command-method 'request-rename-group)           (result
658               (gnus-group-real-name group)            (funcall (gnus-get-function gnus-command-method 'request-rename-group)
659               (gnus-group-real-name new-name) (nth 1 gnus-command-method))))                     (gnus-group-real-name group)
660                       (gnus-group-real-name new-name) (nth 1 gnus-command-method))))
661        (when result
662          (gnus-cache-rename-group group new-name)
663          (gnus-agent-rename-group group new-name))
664        result))
665    
666  (defun gnus-close-backends ()  (defun gnus-close-backends ()
667    ;; Send a close request to all backends that support such a request.    ;; Send a close request to all backends that support such a request.

Legend:
Removed from v.1.7.6.3  
changed lines
  Added in v.1.7.6.4

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26