projects
/
gnus
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Define `delete-dups' for XEmacs
[gnus]
/
lisp
/
gnus-srvr.el
diff --git
a/lisp/gnus-srvr.el
b/lisp/gnus-srvr.el
index
19fd5fe
..
319f7a8
100644
(file)
--- a/
lisp/gnus-srvr.el
+++ b/
lisp/gnus-srvr.el
@@
-1,7
+1,6
@@
;;; gnus-srvr.el --- virtual server support for Gnus
;;; gnus-srvr.el --- virtual server support for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2014 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@
-245,6
+244,7
@@
For more in-depth information on this mode, read the manual
The following commands are available:
\\{gnus-server-mode-map}"
The following commands are available:
\\{gnus-server-mode-map}"
+ ;; FIXME: Use define-derived-mode.
(interactive)
(when (gnus-visual-p 'server-menu 'menu)
(gnus-server-make-menu-bar))
(interactive)
(when (gnus-visual-p 'server-menu 'menu)
(gnus-server-make-menu-bar))
@@
-331,7
+331,7
@@
The following commands are available:
(dolist (open gnus-opened-servers)
(when (and (not (member (car open) done))
;; Just ignore ephemeral servers.
(dolist (open gnus-opened-servers)
(when (and (not (member (car open) done))
;; Just ignore ephemeral servers.
- (not (
member (car open) gnus-ephemeral-servers
)))
+ (not (
gnus-method-ephemeral-p (car open)
)))
(push (car open) done)
(gnus-server-insert-server-line
(setq op-ser (format "%s:%s" (caar open) (nth 1 (car open))))
(push (car open) done)
(gnus-server-insert-server-line
(setq op-ser (format "%s:%s" (caar open) (nth 1 (car open))))
@@
-363,7
+363,8
@@
The following commands are available:
(when entry
(gnus-dribble-enter
(concat "(gnus-server-set-info \"" server "\" '"
(when entry
(gnus-dribble-enter
(concat "(gnus-server-set-info \"" server "\" '"
- (gnus-prin1-to-string (cdr entry)) ")\n")))
+ (gnus-prin1-to-string (cdr entry)) ")\n")
+ (concat "^(gnus-server-set-info \"" (regexp-quote server) "\"")))
(when (or entry oentry)
;; Buffer may be narrowed.
(save-restriction
(when (or entry oentry)
;; Buffer may be narrowed.
(save-restriction
@@
-382,7
+383,8
@@
The following commands are available:
(when (and server info)
(gnus-dribble-enter
(concat "(gnus-server-set-info \"" server "\" '"
(when (and server info)
(gnus-dribble-enter
(concat "(gnus-server-set-info \"" server "\" '"
- (gnus-prin1-to-string info) ")"))
+ (gnus-prin1-to-string info) ")")
+ (concat "^(gnus-server-set-info \"" (regexp-quote server) "\""))
(let* ((server (nth 1 info))
(entry (assoc server gnus-server-alist))
(cached (assoc server gnus-server-method-cache)))
(let* ((server (nth 1 info))
(entry (assoc server gnus-server-alist))
(cached (assoc server gnus-server-method-cache)))
@@
-489,8
+491,7
@@
The following commands are available:
(error "No such server: %s" server))
(gnus-server-set-status method 'ok)
(prog1
(error "No such server: %s" server))
(gnus-server-set-status method 'ok)
(prog1
- (or (gnus-open-server method)
- (progn (message "Couldn't open %s" server) nil))
+ (gnus-open-server method)
(gnus-server-update-server server)
(gnus-server-position-point))))
(gnus-server-update-server server)
(gnus-server-position-point))))
@@
-552,7
+553,7
@@
The following commands are available:
(gnus-server-list-servers))
(defun gnus-server-copy-server (from to)
(gnus-server-list-servers))
(defun gnus-server-copy-server (from to)
- "Copy a server definiton to a new name."
+ "Copy a server definit
i
on to a new name."
(interactive
(list
(or (gnus-server-server-name)
(interactive
(list
(or (gnus-server-server-name)
@@
-713,6
+714,7
@@
claim them."
"q" gnus-browse-exit
"Q" gnus-browse-exit
"d" gnus-browse-describe-group
"q" gnus-browse-exit
"Q" gnus-browse-exit
"d" gnus-browse-describe-group
+ [delete] gnus-browse-delete-group
"\C-c\C-c" gnus-browse-exit
"?" gnus-browse-describe-briefly
"\C-c\C-c" gnus-browse-exit
"?" gnus-browse-describe-briefly
@@
-766,7
+768,8
@@
claim them."
(with-current-buffer nntp-server-buffer
(let ((cur (current-buffer)))
(goto-char (point-min))
(with-current-buffer nntp-server-buffer
(let ((cur (current-buffer)))
(goto-char (point-min))
- (unless (string= gnus-ignored-newsgroups "")
+ (unless (or (null gnus-ignored-newsgroups)
+ (string= gnus-ignored-newsgroups ""))
(delete-matching-lines gnus-ignored-newsgroups))
;; We treat NNTP as a special case to avoid problems with
;; garbage group names like `"foo' that appear in some badly
(delete-matching-lines gnus-ignored-newsgroups))
;; We treat NNTP as a special case to avoid problems with
;; garbage group names like `"foo' that appear in some badly
@@
-867,7
+870,7
@@
claim them."
(gnus-message 5 "Connecting to %s...done" (nth 1 method))
t))))
(gnus-message 5 "Connecting to %s...done" (nth 1 method))
t))))
-(def
un gnus-browse-mode ()
+(def
ine-derived-mode gnus-browse-mode fundamental-mode "Browse Server"
"Major mode for browsing a foreign server.
All normal editing commands are switched off.
"Major mode for browsing a foreign server.
All normal editing commands are switched off.
@@
-882,20
+885,14
@@
buffer.
2) `\\[gnus-browse-read-group]' to read a group ephemerally.
3) `\\[gnus-browse-exit]' to return to the group buffer."
2) `\\[gnus-browse-read-group]' to read a group ephemerally.
3) `\\[gnus-browse-exit]' to return to the group buffer."
- (interactive)
- (kill-all-local-variables)
(when (gnus-visual-p 'browse-menu 'menu)
(gnus-browse-make-menu-bar))
(gnus-simplify-mode-line)
(when (gnus-visual-p 'browse-menu 'menu)
(gnus-browse-make-menu-bar))
(gnus-simplify-mode-line)
- (setq major-mode 'gnus-browse-mode)
- (setq mode-name "Browse Server")
(setq mode-line-process nil)
(setq mode-line-process nil)
- (use-local-map gnus-browse-mode-map)
(buffer-disable-undo)
(setq truncate-lines t)
(gnus-set-default-directory)
(buffer-disable-undo)
(setq truncate-lines t)
(gnus-set-default-directory)
- (setq buffer-read-only t)
- (gnus-run-mode-hooks 'gnus-browse-mode-hook))
+ (setq buffer-read-only t))
(defun gnus-browse-read-group (&optional no-article number)
"Enter the group at the current line.
(defun gnus-browse-read-group (&optional no-article number)
"Enter the group at the current line.
@@
-963,6
+960,16
@@
how new groups will be entered into the group buffer."
(interactive (list (gnus-browse-group-name)))
(gnus-group-describe-group nil group))
(interactive (list (gnus-browse-group-name)))
(gnus-group-describe-group nil group))
+(defun gnus-browse-delete-group (group force)
+ "Delete the current group. Only meaningful with editable groups.
+If FORCE (the prefix) is non-nil, all the articles in the group will
+be deleted. This is \"deleted\" as in \"removed forever from the face
+of the Earth\". There is no undo. The user will be prompted before
+doing the deletion."
+ (interactive (list (gnus-browse-group-name)
+ current-prefix-arg))
+ (gnus-group-delete-group group force))
+
(defun gnus-browse-unsubscribe-group ()
"Toggle subscription of the current group in the browse buffer."
(let ((sub nil)
(defun gnus-browse-unsubscribe-group ()
"Toggle subscription of the current group in the browse buffer."
(let ((sub nil)
@@
-992,7
+999,8
@@
how new groups will be entered into the group buffer."
;; mechanism for new group subscription.
(gnus-call-subscribe-functions
gnus-browse-subscribe-newsgroup-method
;; mechanism for new group subscription.
(gnus-call-subscribe-functions
gnus-browse-subscribe-newsgroup-method
- group)))
+ group)
+ (gnus-request-update-group-status group 'subscribe)))
(delete-char 1)
(insert (let ((lvl (gnus-group-level group)))
(cond
(delete-char 1)
(insert (let ((lvl (gnus-group-level group)))
(cond
@@
-1009,7
+1017,7
@@
how new groups will be entered into the group buffer."
(defun gnus-browse-exit ()
"Quit browsing and return to the group buffer."
(interactive)
(defun gnus-browse-exit ()
"Quit browsing and return to the group buffer."
(interactive)
- (when (
eq major-mode
'gnus-browse-mode)
+ (when (
derived-mode-p
'gnus-browse-mode)
(gnus-kill-buffer (current-buffer)))
;; Insert the newly subscribed groups in the group buffer.
(with-current-buffer gnus-group-buffer
(gnus-kill-buffer (current-buffer)))
;; Insert the newly subscribed groups in the group buffer.
(with-current-buffer gnus-group-buffer