Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus-srvr.el @ 24:4103f0995bd7 r19-15b95

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b95
author cvs
date Mon, 13 Aug 2007 08:51:03 +0200
parents 8fc7fe29b841
children 441bb1e64a06
comparison
equal deleted inserted replaced
23:0edd3412f124 24:4103f0995bd7
240 (oentry (assoc (gnus-server-to-method server) 240 (oentry (assoc (gnus-server-to-method server)
241 gnus-opened-servers))) 241 gnus-opened-servers)))
242 (when entry 242 (when entry
243 (gnus-dribble-enter 243 (gnus-dribble-enter
244 (concat "(gnus-server-set-info \"" server "\" '" 244 (concat "(gnus-server-set-info \"" server "\" '"
245 (prin1-to-string (cdr entry)) ") 245 (prin1-to-string (cdr entry)) ")\n")))
246 ")))
247 (when (or entry oentry) 246 (when (or entry oentry)
248 ;; Buffer may be narrowed. 247 ;; Buffer may be narrowed.
249 (save-restriction 248 (save-restriction
250 (widen) 249 (widen)
251 (when (gnus-server-goto-server server) 250 (when (gnus-server-goto-server server)
399 (gnus-server-list-servers)) 398 (gnus-server-list-servers))
400 399
401 (defun gnus-server-copy-server (from to) 400 (defun gnus-server-copy-server (from to)
402 (interactive 401 (interactive
403 (list 402 (list
404 (unless (gnus-server-server-name) 403 (or (gnus-server-server-name)
405 (error "No server on the current line")) 404 (error "No server on the current line"))
406 (read-string "Copy to: "))) 405 (read-string "Copy to: ")))
407 (unless from 406 (unless from
408 (error "No server on current line")) 407 (error "No server on current line"))
409 (unless (and to (not (string= to ""))) 408 (unless (and to (not (string= to "")))
410 (error "No name to copy to")) 409 (error "No name to copy to"))
411 (when (assoc to gnus-server-alist) 410 (when (assoc to gnus-server-alist)
412 (error "%s already exists" to)) 411 (error "%s already exists" to))
413 (unless (assoc from gnus-server-alist) 412 (unless (gnus-server-to-method from)
414 (error "%s: no such server" from)) 413 (error "%s: no such server" from))
415 (let ((to-entry (gnus-copy-sequence (assoc from gnus-server-alist)))) 414 (let ((to-entry (cons from (gnus-copy-sequence
415 (gnus-server-to-method from)))))
416 (setcar to-entry to) 416 (setcar to-entry to)
417 (setcar (nthcdr 2 to-entry) to) 417 (setcar (nthcdr 2 to-entry) to)
418 (push to-entry gnus-server-killed-servers) 418 (push to-entry gnus-server-killed-servers)
419 (gnus-server-yank-server))) 419 (gnus-server-yank-server)))
420 420
733 (unless server 733 (unless server
734 (error "No server on the current line")) 734 (error "No server on the current line"))
735 (if (not (gnus-check-backend-function 735 (if (not (gnus-check-backend-function
736 'request-regenerate (car (gnus-server-to-method server)))) 736 'request-regenerate (car (gnus-server-to-method server))))
737 (error "This backend doesn't support regeneration") 737 (error "This backend doesn't support regeneration")
738 (gnus-message 5 "Requesing regeneration of %s..." server) 738 (gnus-message 5 "Requesting regeneration of %s..." server)
739 (when (gnus-request-regenerate server) 739 (if (gnus-request-regenerate server)
740 (gnus-message 5 "Requesing regeneration of %s...done" server))))) 740 (gnus-message 5 "Requesting regeneration of %s...done" server)
741 (gnus-message 5 "Couldn't regenerate %s" server)))))
741 742
742 (provide 'gnus-srvr) 743 (provide 'gnus-srvr)
743 744
744 ;;; gnus-srvr.el ends here. 745 ;;; gnus-srvr.el ends here.