;;; gnus-srvr.el --- virtual server support for Gnus
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;; 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; backward-compatibility alias
(put 'gnus-server-offline-face 'face-alias 'gnus-server-offline)
-(defcustom gnus-server-agent-face 'gnus-server-agent
- "Face name to use on AGENTIZED servers."
- :version "22.1"
- :group 'gnus-server-visual
- :type 'face)
-
-(defcustom gnus-server-opened-face 'gnus-server-opened
- "Face name to use on OPENED servers."
- :version "22.1"
- :group 'gnus-server-visual
- :type 'face)
-
-(defcustom gnus-server-closed-face 'gnus-server-closed
- "Face name to use on CLOSED servers."
- :version "22.1"
- :group 'gnus-server-visual
- :type 'face)
-
-(defcustom gnus-server-denied-face 'gnus-server-denied
- "Face name to use on DENIED servers."
- :version "22.1"
- :group 'gnus-server-visual
- :type 'face)
-
-(defcustom gnus-server-offline-face 'gnus-server-offline
- "Face name to use on OFFLINE servers."
- :version "22.1"
- :group 'gnus-server-visual
- :type 'face)
-
(defvar gnus-server-font-lock-keywords
- (list
- '("(\\(agent\\))" 1 gnus-server-agent-face)
- '("(\\(opened\\))" 1 gnus-server-opened-face)
- '("(\\(closed\\))" 1 gnus-server-closed-face)
- '("(\\(offline\\))" 1 gnus-server-offline-face)
- '("(\\(denied\\))" 1 gnus-server-denied-face)))
+ '(("(\\(agent\\))" 1 'gnus-server-agent)
+ ("(\\(opened\\))" 1 'gnus-server-opened)
+ ("(\\(closed\\))" 1 'gnus-server-closed)
+ ("(\\(offline\\))" 1 'gnus-server-offline)
+ ("(\\(denied\\))" 1 'gnus-server-denied)))
(defun gnus-server-mode ()
"Major mode for listing and editing servers.
;; Insert the text.
(eval gnus-server-line-format-spec))
(list 'gnus-server (intern gnus-tmp-name)
- 'gnus-named-server (intern (gnus-method-to-server method))))))
+ 'gnus-named-server (intern (gnus-method-to-server method t))))))
(defun gnus-enter-server-buffer ()
"Set up the server buffer."
(gnus-server-setup-buffer)
(gnus-configure-windows 'server)
- (gnus-server-prepare))
+ ;; Usually `gnus-configure-windows' will finish with the
+ ;; `gnus-server-buffer' selected as the current buffer, but not always (I
+ ;; bumped into it when starting from a dedicated *Group* frame, and
+ ;; gnus-configure-windows opened *Server* into its own dedicated frame).
+ (with-current-buffer (get-buffer gnus-server-buffer)
+ (gnus-server-prepare)))
(defun gnus-server-setup-buffer ()
"Initialize the server buffer."
(unless (get-buffer gnus-server-buffer)
- (save-excursion
- (set-buffer (gnus-get-buffer-create gnus-server-buffer))
+ (with-current-buffer (gnus-get-buffer-create gnus-server-buffer)
(gnus-server-mode)
(when gnus-carpal
(gnus-carpal-setup-buffer 'server)))))
(defconst gnus-server-edit-buffer "*Gnus edit server*")
(defun gnus-server-update-server (server)
- (save-excursion
- (set-buffer gnus-server-buffer)
+ (with-current-buffer gnus-server-buffer
(let* ((buffer-read-only nil)
(entry (assoc server gnus-server-alist))
(oentry (assoc (gnus-server-to-method server)
"Close all servers."
(interactive)
(dolist (server gnus-inserted-opened-servers)
+ (gnus-server-close-server (car server)))
+ (dolist (server gnus-server-alist)
(gnus-server-close-server (car server))))
(defun gnus-server-deny-server (server)
(let ((buf (current-buffer)))
(prog1
(gnus-browse-foreign-server server buf)
- (save-excursion
- (set-buffer buf)
+ (with-current-buffer buf
(gnus-server-update-server (gnus-server-server-name))
(gnus-server-position-point)))))
(while (not (eobp))
(ignore-errors
(push (cons
- (buffer-substring
- (point)
- (progn
- (skip-chars-forward "^ \t")
- (point)))
+ (mm-string-as-unibyte
+ (buffer-substring
+ (point)
+ (progn
+ (skip-chars-forward "^ \t")
+ (point))))
(let ((last (read cur)))
(cons (read cur) last)))
groups))
(while (not (eobp))
(ignore-errors
(push (cons
- (if (eq (char-after) ?\")
- (read cur)
- (let ((p (point)) (name ""))
- (skip-chars-forward "^ \t\\\\")
- (setq name (buffer-substring p (point)))
- (while (eq (char-after) ?\\)
- (setq p (1+ (point)))
- (forward-char 2)
- (skip-chars-forward "^ \t\\\\")
- (setq name (concat name (buffer-substring
- p (point)))))
- name))
+ (mm-string-as-unibyte
+ (if (eq (char-after) ?\")
+ (read cur)
+ (let ((p (point)) (name ""))
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (buffer-substring p (point)))
+ (while (eq (char-after) ?\\)
+ (setq p (1+ (point)))
+ (forward-char 2)
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (concat name (buffer-substring
+ p (point)))))
+ name)))
(let ((last (read cur)))
(cons (read cur) last)))
groups))
(when (eq major-mode 'gnus-browse-mode)
(gnus-kill-buffer (current-buffer)))
;; Insert the newly subscribed groups in the group buffer.
- (save-excursion
- (set-buffer gnus-group-buffer)
+ (with-current-buffer gnus-group-buffer
(gnus-group-list-groups nil))
(if gnus-browse-return-buffer
(gnus-configure-windows 'server 'force)
(provide 'gnus-srvr)
-;;; arch-tag: c0117f64-27ca-475d-9406-8da6854c7a25
+;; arch-tag: c0117f64-27ca-475d-9406-8da6854c7a25
;;; gnus-srvr.el ends here
projects / gnus / blobdiff