X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-int.el;h=b6f011546c55270cf2fbb80256b33776b5cd12d1;hb=27688c4fe73986a46e3f2cb9051170f41ef82f4c;hp=96694cbb680ca19112a68461c237482a0d9b1655;hpb=76555b4d4973718c0352da56c67095cbc541d2b4;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el index 96694cb..b6f0115 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -20,8 +20,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -48,6 +48,7 @@ If the server is covered by Gnus agent, the possible values are `denied', set the server denied; `offline', set the server offline; nil, ask user. If the server is not covered by Gnus agent, set the server denied." + :version "22.1" :group 'gnus-start :type '(choice (const :tag "Ask" nil) (const :tag "Deny server" denied) @@ -74,7 +75,7 @@ If CONFIRM is non-nil, the user will be asked for an NNTP server." ;; Read server name with completion. (setq gnus-nntp-server (completing-read "NNTP server: " - (mapcar (lambda (server) (list server)) + (mapcar 'list (cons (list gnus-nntp-server) gnus-secondary-servers)) nil nil gnus-nntp-server))) @@ -177,7 +178,7 @@ If it is down, start it up (again)." (setq method (gnus-server-to-method method))) ;; Check cache of constructed names. (let* ((method-sym (if gnus-agent - (gnus-agent-get-function method) + (inline (gnus-agent-get-function method)) (car method))) (method-fns (get method-sym 'gnus-method-functions)) (func (let ((method-fnlist-elt (assq function method-fns))) @@ -339,7 +340,7 @@ name. The method this group uses will be queried." (when (stringp gnus-command-method) (setq gnus-command-method (inline (gnus-server-to-method gnus-command-method)))) - (funcall (inline (gnus-get-function gnus-command-method 'request-group)) + (funcall (inline (gnus-get-function gnus-command-method 'request-group)) (gnus-group-real-name group) (nth 1 gnus-command-method) dont-check))) @@ -562,15 +563,15 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." not-deleted)) (defun gnus-request-move-article (article group server accept-function - &optional last) + &optional last move-is-internal) (let* ((gnus-command-method (gnus-find-method-for-group group)) (result (funcall (gnus-get-function gnus-command-method 'request-move-article) article (gnus-group-real-name group) - (nth 1 gnus-command-method) accept-function last))) + (nth 1 gnus-command-method) accept-function last move-is-internal))) (when (and result gnus-agent (gnus-agent-method-p gnus-command-method)) - (gnus-agent-expire (list article) group 'force)) + (gnus-agent-unfetch-articles group (list article))) result)) (defun gnus-request-accept-article (group &optional gnus-command-method last @@ -587,8 +588,8 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." (insert "\n")) (let ((gnus-command-method (or gnus-command-method (gnus-find-method-for-group group))) - (result - (funcall + (result + (funcall (gnus-get-function gnus-command-method 'request-accept-article) (if (stringp group) (gnus-group-real-name group) group) (cadr gnus-command-method) @@ -626,15 +627,25 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." (gnus-group-real-name group) (nth 1 gnus-command-method) args))) (defun gnus-request-delete-group (group &optional force) - (let ((gnus-command-method (gnus-find-method-for-group group))) - (funcall (gnus-get-function gnus-command-method 'request-delete-group) - (gnus-group-real-name group) force (nth 1 gnus-command-method)))) + (let* ((gnus-command-method (gnus-find-method-for-group group)) + (result + (funcall (gnus-get-function gnus-command-method 'request-delete-group) + (gnus-group-real-name group) force (nth 1 gnus-command-method)))) + (when result + (gnus-cache-delete-group group) + (gnus-agent-delete-group group)) + result)) (defun gnus-request-rename-group (group new-name) - (let ((gnus-command-method (gnus-find-method-for-group group))) - (funcall (gnus-get-function gnus-command-method 'request-rename-group) - (gnus-group-real-name group) - (gnus-group-real-name new-name) (nth 1 gnus-command-method)))) + (let* ((gnus-command-method (gnus-find-method-for-group group)) + (result + (funcall (gnus-get-function gnus-command-method 'request-rename-group) + (gnus-group-real-name group) + (gnus-group-real-name new-name) (nth 1 gnus-command-method)))) + (when result + (gnus-cache-rename-group group new-name) + (gnus-agent-rename-group group new-name)) + result)) (defun gnus-close-backends () ;; Send a close request to all backends that support such a request.