;;; Code:
+(require 'gnus-load)
+(require 'gnus-spec)
(require 'gnus)
-(eval-when-compile (require 'cl))
+(require 'gnus-group)
+(require 'gnus-int)
+(require 'gnus-range)
(defvar gnus-server-mode-hook nil
"Hook run in `gnus-server-mode' buffers.")
(defvar gnus-server-mode-line-format "Gnus List of servers"
"The format specification for the server mode line.")
+(defvar gnus-server-exit-hook nil
+ "*Hook run when exiting the server buffer.")
+
;;; Internal variables.
(defvar gnus-inserted-opened-servers nil)
"*Hook run after the creation of the server mode menu.")
(defun gnus-server-make-menu-bar ()
- (gnus-visual-turn-off-edit-menu 'server)
- (or
- (boundp 'gnus-server-menu)
- (progn
- (easy-menu-define
- gnus-server-menu gnus-server-mode-map ""
- '("Server"
- ["Add" gnus-server-add-server t]
- ["Browse" gnus-server-read-server t]
- ["List" gnus-server-list-servers t]
- ["Kill" gnus-server-kill-server t]
- ["Yank" gnus-server-yank-server t]
- ["Copy" gnus-server-copy-server t]
- ["Edit" gnus-server-edit-server t]
- ["Exit" gnus-server-exit t]
- ))
-
- (easy-menu-define
- gnus-server-menu gnus-server-mode-map ""
- '("Connections"
- ["Open" gnus-server-open-server t]
- ["Close" gnus-server-close-server t]
- ["Deny" gnus-server-deny-servers t]
- ["Reset" gnus-server-remove-denials t]
- ))
-
- (run-hooks 'gnus-server-menu-hook))))
+ (gnus-turn-off-edit-menu 'server)
+ (unless (boundp 'gnus-server-server-menu)
+ (easy-menu-define
+ gnus-server-server-menu gnus-server-mode-map ""
+ '("Server"
+ ["Add" gnus-server-add-server t]
+ ["Browse" gnus-server-read-server t]
+ ["Scan" gnus-server-scan-server t]
+ ["List" gnus-server-list-servers t]
+ ["Kill" gnus-server-kill-server t]
+ ["Yank" gnus-server-yank-server t]
+ ["Copy" gnus-server-copy-server t]
+ ["Edit" gnus-server-edit-server t]
+ ["Exit" gnus-server-exit t]
+ ))
+
+ (easy-menu-define
+ gnus-server-connections-menu gnus-server-mode-map ""
+ '("Connections"
+ ["Open" gnus-server-open-server t]
+ ["Close" gnus-server-close-server t]
+ ["Deny" gnus-server-deny-server t]
+ "---"
+ ["Open All" gnus-server-open-all-servers t]
+ ["Close All" gnus-server-close-all-servers t]
+ ["Reset All" gnus-server-remove-denials t]
+ ))
+
+ (run-hooks 'gnus-server-menu-hook)))
(defvar gnus-server-mode-map nil)
(put 'gnus-server-mode 'mode-class 'special)
"c" gnus-server-copy-server
"a" gnus-server-add-server
"e" gnus-server-edit-server
+ "s" gnus-server-scan-server
"O" gnus-server-open-server
+ "\M-o" gnus-server-open-all-servers
"C" gnus-server-close-server
+ "\M-c" gnus-server-close-all-servers
"D" gnus-server-deny-server
- "R" gnus-server-remove-denials))
+ "R" gnus-server-remove-denials
+
+ "\C-c\C-i" gnus-info-find-node))
(defun gnus-server-mode ()
"Major mode for listing and editing servers.
(gnus-simplify-mode-line)
(setq major-mode 'gnus-server-mode)
(setq mode-name "Server")
- ; (gnus-group-set-mode-line)
+ (gnus-set-default-directory)
(setq mode-line-process nil)
(use-local-map gnus-server-mode-map)
(buffer-disable-undo (current-buffer))
(t
"(closed)"))))
(beginning-of-line)
- (add-text-properties
+ (gnus-add-text-properties
(point)
(prog1 (1+ (point))
;; Insert the text.
;; First we do the real list of servers.
(while alist
(push (cdr (setq server (pop alist))) done)
- (when (and server (car server))
+ (when (and server (car server) (cdr server))
(gnus-server-insert-server-line (car server) (cdr server))))
;; Then we insert the list of servers that have been opened in
;; this session.
(while opened
(unless (member (caar opened) done)
(gnus-server-insert-server-line
- (setq op-ser (format "%s:%s" (car (car (car opened)))
- (nth 1 (car (car opened)))))
- (car (car opened)))
+ (setq op-ser (format "%s:%s" (caaar opened) (nth 1 (caar opened))))
+ (caar opened))
(push (list op-ser (caar opened)) gnus-inserted-opened-servers))
(setq opened (cdr opened))))
(goto-char (point-min))
(save-excursion
(set-buffer gnus-server-buffer)
(let* ((buffer-read-only nil)
- (entry (assoc server gnus-server-alist)))
+ (entry (assoc server gnus-server-alist))
+ (oentry (assoc (gnus-server-to-method server)
+ gnus-opened-servers)))
(when entry
(gnus-dribble-enter
(concat "(gnus-server-set-info \"" server "\" '"
- (prin1-to-string (cdr entry)) ")"))
+ (prin1-to-string (cdr entry)) ")")))
+ (when (or entry oentry)
;; Buffer may be narrowed.
(save-restriction
(widen)
(when (gnus-server-goto-server server)
(gnus-delete-line))
- (gnus-server-insert-server-line (car entry) (cdr entry))
+ (if entry
+ (gnus-server-insert-server-line (car entry) (cdr entry))
+ (gnus-server-insert-server-line
+ (format "%s:%s" (caar oentry) (nth 1 (car oentry)))
+ (car oentry)))
(gnus-server-position-point))))))
(defun gnus-server-set-info (server info)
(killed (car gnus-server-killed-servers)))
(if (not server)
(setq gnus-server-alist (nconc gnus-server-alist (list killed)))
- (if (string= server (car (car gnus-server-alist)))
+ (if (string= server (caar gnus-server-alist))
(setq gnus-server-alist (cons killed gnus-server-alist))
(while (and (cdr alist)
- (not (string= server (car (car (cdr alist))))))
+ (not (string= server (caadr alist))))
(setq alist (cdr alist)))
(if alist
(setcdr alist (cons killed (cdr alist)))
"Return to the group buffer."
(interactive)
(kill-buffer (current-buffer))
- (switch-to-buffer gnus-group-buffer))
+ (switch-to-buffer gnus-group-buffer)
+ (run-hooks 'gnus-server-exit-hook))
(defun gnus-server-list-servers ()
"List all available servers."
(forward-line -1))
(gnus-server-position-point)))
+(defun gnus-server-set-status (method status)
+ "Make METHOD have STATUS."
+ (let ((entry (assoc method gnus-opened-servers)))
+ (if entry
+ (setcar (cdr entry) status)
+ (push (list method status) gnus-opened-servers))))
+
(defun gnus-opened-servers-remove (method)
"Remove METHOD from the list of opened servers."
(setq gnus-opened-servers (delq (assoc method gnus-opened-servers)
(interactive (list (gnus-server-server-name)))
(let ((method (gnus-server-to-method server)))
(or method (error "No such server: %s" server))
- (gnus-opened-servers-remove method)
+ (gnus-server-set-status method 'ok)
(prog1
(or (gnus-open-server method)
(progn (message "Couldn't open %s" server) nil))
(gnus-server-update-server server)
(gnus-server-position-point))))
+(defun gnus-server-open-all-servers ()
+ "Open all servers."
+ (interactive)
+ (let ((servers gnus-inserted-opened-servers))
+ (while servers
+ (gnus-server-open-server (car (pop servers))))))
+
(defun gnus-server-close-server (server)
"Close SERVER."
(interactive (list (gnus-server-server-name)))
(let ((method (gnus-server-to-method server)))
(or method (error "No such server: %s" server))
- (gnus-opened-servers-remove method)
+ (gnus-server-set-status method 'closed)
(prog1
(gnus-close-server method)
(gnus-server-update-server server)
(gnus-server-position-point))))
+(defun gnus-server-close-all-servers ()
+ "Close all servers."
+ (interactive)
+ (let ((servers gnus-inserted-opened-servers))
+ (while servers
+ (gnus-server-close-server (car (pop servers))))))
+
(defun gnus-server-deny-server (server)
"Make sure SERVER will never be attempted opened."
(interactive (list (gnus-server-server-name)))
(let ((method (gnus-server-to-method server)))
(or method (error "No such server: %s" server))
- (gnus-opened-servers-remove method)
- (setq gnus-opened-servers
- (cons (list method 'denied) gnus-opened-servers)))
+ (gnus-server-set-status method 'denied))
(gnus-server-update-server server)
- (gnus-server-position-point))
+ (gnus-server-position-point)
+ t)
(defun gnus-server-remove-denials ()
"Make all denied servers into closed servers."
(error "No server on current line"))
(unless (assoc server gnus-server-alist)
(error "This server can't be edited"))
- (let ((winconf (current-window-configuration))
- (info (cdr (assoc server gnus-server-alist))))
+ (let ((info (cdr (assoc server gnus-server-alist))))
(gnus-close-server info)
- (get-buffer-create gnus-server-edit-buffer)
- (gnus-configure-windows 'edit-server)
- (gnus-add-current-to-buffer-list)
- (emacs-lisp-mode)
- (make-local-variable 'gnus-prev-winconf)
- (setq gnus-prev-winconf winconf)
- (use-local-map (copy-keymap (current-local-map)))
- (let ((done-func '(lambda ()
- "Exit editing mode and update the information."
- (interactive)
- (gnus-server-edit-server-done 'group))))
- (setcar (cdr (nth 4 done-func)) server)
- (local-set-key "\C-c\C-c" done-func))
- (erase-buffer)
- (insert ";; Type `C-c C-c' after you have edited the server.\n\n")
- (insert (pp-to-string info))))
+ (gnus-edit-form
+ info "Editing the server."
+ `(lambda (form)
+ (gnus-server-set-info ,server form)
+ (gnus-server-list-servers)
+ (gnus-server-position-point)))))
-(defun gnus-server-edit-server-done (server)
- (interactive)
- (set-buffer (get-buffer-create gnus-server-edit-buffer))
- (goto-char (point-min))
- (let ((form (read (current-buffer)))
- (winconf gnus-prev-winconf))
- (gnus-server-set-info server form)
- (kill-buffer (current-buffer))
- (and winconf (set-window-configuration winconf))
- (set-buffer gnus-server-buffer)
- (gnus-server-update-server server)
- (gnus-server-list-servers)
- (gnus-server-position-point)))
+(defun gnus-server-scan-server (server)
+ "Request a scan from the current server."
+ (interactive (list (gnus-server-server-name)))
+ (gnus-message 3 "Scanning %s...done" server)
+ (gnus-request-scan nil (gnus-server-to-method server))
+ (gnus-message 3 "Scanning %s...done" server))
(defun gnus-server-read-server (server)
"Browse a server."
"Q" gnus-browse-exit
"\C-c\C-c" gnus-browse-exit
"?" gnus-browse-describe-briefly
+
"\C-c\C-i" gnus-info-find-node))
(defun gnus-browse-make-menu-bar ()
- (gnus-visual-turn-off-edit-menu 'browse)
- (or
- (boundp 'gnus-browse-menu)
- (progn
- (easy-menu-define
- gnus-browse-menu gnus-browse-mode-map ""
- '("Browse"
- ["Subscribe" gnus-browse-unsubscribe-current-group t]
- ["Read" gnus-browse-read-group t]
- ["Select" gnus-browse-read-group t]
- ["Next" gnus-browse-next-group t]
- ["Prev" gnus-browse-next-group t]
- ["Exit" gnus-browse-exit t]
- ))
- (run-hooks 'gnus-browse-menu-hook))))
+ (gnus-turn-off-edit-menu 'browse)
+ (unless (boundp 'gnus-browse-menu)
+ (easy-menu-define
+ gnus-browse-menu gnus-browse-mode-map ""
+ '("Browse"
+ ["Subscribe" gnus-browse-unsubscribe-current-group t]
+ ["Read" gnus-browse-read-group t]
+ ["Select" gnus-browse-read-group t]
+ ["Next" gnus-browse-next-group t]
+ ["Prev" gnus-browse-next-group t]
+ ["Exit" gnus-browse-exit t]
+ ))
+ (run-hooks 'gnus-browse-menu-hook)))
(defvar gnus-browse-current-method nil)
(defvar gnus-browse-return-buffer nil)
(setq mode-line-buffer-identification
(list
(format
- "Gnus: %%b {%s:%s}" (car method) (car (cdr method)))))
+ "Gnus: %%b {%s:%s}" (car method) (cadr method))))
(save-excursion
(set-buffer nntp-server-buffer)
(let ((cur (current-buffer)))
(switch-to-buffer (current-buffer))
(goto-char (point-min))
(gnus-group-position-point)
+ (gnus-message 5 "Connecting to %s...done" (nth 1 method))
t))))
(defun gnus-browse-mode ()
(use-local-map gnus-browse-mode-map)
(buffer-disable-undo (current-buffer))
(setq truncate-lines t)
+ (gnus-set-default-directory)
(setq buffer-read-only t)
(run-hooks 'gnus-browse-mode-hook))
"Enter the group at the current line."
(interactive)
(let ((group (gnus-browse-group-name)))
- (or (gnus-group-read-ephemeral-group
- group gnus-browse-current-method nil
- (cons (current-buffer) 'browse))
- (error "Couldn't enter %s" group))))
+ (unless (gnus-group-read-ephemeral-group
+ group gnus-browse-current-method nil
+ (cons (current-buffer) 'browse))
+ (error "Couldn't enter %s" group))))
(defun gnus-browse-select-group ()
"Select the current group."
;; If this group it killed, then we want to subscribe it.
(if (= (following-char) ?K) (setq sub t))
(setq group (gnus-browse-group-name))
+ ;; Make sure the group has been properly removed before we
+ ;; subscribe to it.
+ (gnus-kill-ephemeral-group group)
(delete-char 1)
(if sub
(progn
projects / gnus / blobdiff