+2000-10-30 01:52:40 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-util.el (gnus-union): Renamed from gnus-agent-union, and
+ moved here.
+ * gnus-agent.el (gnus-agent-fetch-headers): Use it.
+ * gnus-group.el (gnus-group-prepare-flat): Use it.
+ * gnus-topic.el (gnus-group-prepare-topics): Use it.
+
+2000-10-30 01:23:49 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml.el (mml-mode): Show menu in XEmacs.
+
+2000-10-30 00:49:33 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-srvr.el (gnus-server-browse-in-group-buffer): New variable.
+ (gnus-server-read-server-in-server-buffer): New function.
+ (gnus-browse-foreign-server): Browse in group buffer.
+ * gnus-group.el (gnus-group-prepare-flat): List group not in list.
+ (gnus-group-prepare-flat-list-dead): Use gnus-group-insert-group-line.
+ * gnus-topic.el (gnus-group-prepare-topics): Ditto.
+ * gnus.el (gnus-server-browse-hashtb): New variable.
+
2000-10-29 22:31:40 ShengHuo ZHU <zsh@cs.rochester.edu>
* nnfolder.el (nnfolder-open-nov): Use group.
(insert "\n"))
(pop gnus-agent-group-alist))))
-(defun gnus-agent-union (l1 l2)
- "Set union of lists L1 and L2."
- (cond ((null l1) l2)
- ((null l2) l1)
- ((equal l1 l2) l1)
- (t
- (or (>= (length l1) (length l2))
- (setq l1 (prog1 l2 (setq l2 l1))))
- (while l2
- (or (memq (car l2) l1)
- (push (car l2) l1))
- (pop l2))
- l1)))
-
(defun gnus-agent-fetch-headers (group &optional force)
(let* ((articles (gnus-list-of-unread-articles group))
(len (length articles))
(setq articles (nthcdr i articles))))
;; add article with marks to list of article headers we want to fetch.
(dolist (arts (gnus-info-marks (gnus-get-info group)))
- (setq articles (gnus-agent-union (gnus-uncompress-sequence (cdr arts))
- articles)))
+ (setq articles (gnus-union (gnus-uncompress-sequence (cdr arts))
+ articles)))
(setq articles (sort articles '<))
;; Remove known articles.
(when (gnus-agent-load-alist group)
(let ((buffer-read-only nil)
(newsrc (cdr gnus-newsrc-alist))
(lowest (or lowest 1))
+ (not-in-list (and gnus-group-listed-groups
+ (copy-sequence gnus-group-listed-groups)))
info clevel unread group params)
(erase-buffer)
(when (or (< lowest gnus-level-zombie)
params (gnus-info-params info)
newsrc (cdr newsrc)
unread (car (gnus-gethash group gnus-newsrc-hashtb)))
+ (if not-in-list
+ (setq not-in-list (delete group not-in-list)))
(and
(gnus-group-prepare-logic
group
(setq gnus-zombie-list (sort gnus-zombie-list 'string<))
gnus-level-zombie ?Z
regexp))
+ (if not-in-list
+ (dolist (group gnus-zombie-list)
+ (setq not-in-list (delete group not-in-list))))
(if (or gnus-group-listed-groups
(and (>= level gnus-level-killed) (<= lowest gnus-level-killed)))
(gnus-group-prepare-flat-list-dead
- (setq gnus-killed-list (sort gnus-killed-list 'string<))
+ (gnus-union
+ not-in-list
+ (setq gnus-killed-list (sort gnus-killed-list 'string<)))
gnus-level-killed ?K regexp))
(gnus-group-set-mode-line)
(or (not regexp)
(and (stringp regexp) (string-match regexp group))
(and (functionp regexp) (funcall regexp group))))
- (gnus-add-text-properties
- (point) (prog1 (1+ (point))
- (insert " " mark " *: "
- (gnus-group-name-decode group
- (gnus-group-name-charset
- nil group))
- "\n"))
- (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
- 'gnus-unread t
- 'gnus-level level))))))
+;;; (gnus-add-text-properties
+;;; (point) (prog1 (1+ (point))
+;;; (insert " " mark " *: "
+;;; (gnus-group-name-decode group
+;;; (gnus-group-name-charset
+;;; nil group))
+;;; "\n"))
+;;; (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
+;;; 'gnus-unread t
+;;; 'gnus-level level))
+ (gnus-group-insert-group-line
+ group level nil
+ (if gnus-server-browse-hashtb
+ (gnus-gethash group gnus-server-browse-hashtb) t)
+ (gnus-method-simplify (gnus-find-method-for-group group)))))))
(defun gnus-group-update-group-line ()
"Update the current line in the group buffer."
(defvar gnus-server-exit-hook nil
"*Hook run when exiting the server buffer.")
+(defvar gnus-server-browse-in-group-buffer t
+ "Whether browse server in group buffer.")
+
;;; Internal variables.
(defvar gnus-inserted-opened-servers nil)
(suppress-keymap gnus-server-mode-map)
(gnus-define-keys gnus-server-mode-map
- " " gnus-server-read-server
+ " " gnus-server-read-server-in-server-buffer
"\r" gnus-server-read-server
gnus-mouse-2 gnus-server-pick-server
"q" gnus-server-exit
(gnus-request-scan nil method)
(gnus-message 3 "Scanning %s...done" server))))
+(defun gnus-server-read-server-in-server-buffer (server)
+ "Browse a server in server buffer."
+ (interactive (list (gnus-server-server-name)))
+ (let (gnus-server-browse-in-group-buffer)
+ (gnus-server-read-server server)))
+
(defun gnus-server-read-server (server)
"Browse a server."
(interactive (list (gnus-server-server-name)))
(setq gnus-browse-current-method (gnus-server-to-method server))
(setq gnus-browse-return-buffer return-buffer)
(let* ((method gnus-browse-current-method)
+ (orig-select-method gnus-select-method)
(gnus-select-method method)
groups group)
(gnus-message 5 "Connecting to %s..." (nth 1 method))
1 "Couldn't request list: %s" (gnus-status-message method))
nil)
(t
- (gnus-get-buffer-create gnus-browse-buffer)
- (when gnus-carpal
- (gnus-carpal-setup-buffer 'browse))
- (gnus-configure-windows 'browse)
- (buffer-disable-undo)
- (let ((buffer-read-only nil))
- (erase-buffer))
- (gnus-browse-mode)
- (setq mode-line-buffer-identification
- (list
- (format
- "Gnus: %%b {%s:%s}" (car method) (cadr method))))
(save-excursion
(set-buffer nntp-server-buffer)
(let ((cur (current-buffer)))
(setq groups (sort groups
(lambda (l1 l2)
(string< (car l1) (car l2)))))
- (let ((buffer-read-only nil) charset)
- (while groups
- (setq group (car groups))
- (setq charset (gnus-group-name-charset method group))
- (gnus-add-text-properties
- (point)
- (prog1 (1+ (point))
- (insert
- (format "%c%7d: %s\n"
- (let ((level
- (gnus-group-level
- (gnus-group-prefixed-name (car group) method))))
+ (if gnus-server-browse-in-group-buffer
+ (let* ((gnus-select-method orig-select-method)
+ (gnus-server-browse-hashtb
+ (gnus-make-hashtable (length groups)))
+ (gnus-group-listed-groups
+ (mapcar (lambda (group)
+ (let ((name
+ (gnus-group-prefixed-name
+ (car group) method)))
+ (gnus-sethash name (cdr group)
+ gnus-server-browse-hashtb)
+ name))
+ groups)))
+ (gnus-configure-windows 'group)
+ (funcall gnus-group-prepare-function
+ gnus-level-killed 'ignore 1 'ingore))
+ (gnus-get-buffer-create gnus-browse-buffer)
+ (when gnus-carpal
+ (gnus-carpal-setup-buffer 'browse))
+ (gnus-configure-windows 'browse)
+ (buffer-disable-undo)
+ (let ((buffer-read-only nil))
+ (erase-buffer))
+ (gnus-browse-mode)
+ (setq mode-line-buffer-identification
+ (list
+ (format
+ "Gnus: %%b {%s:%s}" (car method) (cadr method))))
+ (let ((buffer-read-only nil) charset)
+ (while groups
+ (setq group (car groups))
+ (setq charset (gnus-group-name-charset method group))
+ (gnus-add-text-properties
+ (point)
+ (prog1 (1+ (point))
+ (insert
+ (format "%c%7d: %s\n"
+ (let ((level
+ (gnus-group-level
+ (gnus-group-prefixed-name (car group) method))))
(cond
((<= level gnus-level-subscribed) ? )
((<= level gnus-level-unsubscribed) ?U)
((= level gnus-level-zombie) ?Z)
(t ?K)))
- (cdr group)
- (gnus-group-name-decode (car group) charset))))
- (list 'gnus-group (car group)))
- (setq groups (cdr groups))))
- (switch-to-buffer (current-buffer))
+ (cdr group)
+ (gnus-group-name-decode (car group) charset))))
+ (list 'gnus-group (car group)))
+ (setq groups (cdr groups))))
+ (switch-to-buffer (current-buffer)))
(goto-char (point-min))
(gnus-group-position-point)
(gnus-message 5 "Connecting to %s...done" (nth 1 method))
If LOWEST is non-nil, list all newsgroups of level LOWEST or higher."
(set-buffer gnus-group-buffer)
(let ((buffer-read-only nil)
- (lowest (or lowest 1)))
+ (lowest (or lowest 1))
+ (not-in-list
+ (and gnus-group-listed-groups
+ (copy-sequence gnus-group-listed-groups))))
(when (or (not gnus-topic-alist)
(not gnus-topology-checked-p))
(and (>= level gnus-level-killed)
(<= lowest gnus-level-killed)))
(gnus-group-prepare-flat-list-dead
- (setq gnus-killed-list (sort gnus-killed-list 'string<))
+ (gnus-union
+ (and not-in-list
+ (gnus-delete-if (lambda (group)
+ (< (gnus-group-level group) gnus-level-killed))
+ not-in-list))
+ (setq gnus-killed-list (sort gnus-killed-list 'string<)))
gnus-level-killed ?K
regexp))
(while (search-backward "\\." nil t)
(delete-char 1)))))
+(if (fboundp 'union)
+ (defalias 'gnus-union 'union)
+ (defun gnus-union (l1 l2)
+ "Set union of lists L1 and L2."
+ (cond ((null l1) l2)
+ ((null l2) l1)
+ ((equal l1 l2) l1)
+ (t
+ (or (>= (length l1) (length l2))
+ (setq l1 (prog1 l2 (setq l2 l1))))
+ (while l2
+ (or (member (car l2) l1)
+ (push (car l2) l1))
+ (pop l2))
+ l1))))
+
(provide 'gnus-util)
;;; gnus-util.el ends here
(defvar gnus-moderated-hashtb nil
"Hashtable of moderated newsgroups.")
+(defvar gnus-server-browse-hashtb nil
+ "Hashtable of existing articles.")
+
;; Save window configuration.
(defvar gnus-prev-winconf nil)
\\{mml-mode-map}"
(interactive "P")
- (if (not (set (make-local-variable 'mml-mode)
- (if (null arg) (not mml-mode)
- (> (prefix-numeric-value arg) 0))))
- nil
- (set (make-local-variable 'mml-mode) t)
- (unless (assq 'mml-mode minor-mode-alist)
- (push `(mml-mode " MML") minor-mode-alist))
- (unless (assq 'mml-mode minor-mode-map-alist)
- (push (cons 'mml-mode mml-mode-map)
- minor-mode-map-alist)))
- (run-hooks 'mml-mode-hook))
+ (when (set (make-local-variable 'mml-mode)
+ (if (null arg) (not mml-mode)
+ (> (prefix-numeric-value arg) 0)))
+ (gnus-add-minor-mode 'mml-mode " MML" mml-mode-map)
+ (easy-menu-add mml-menu mml-mode-map)
+ (run-hooks 'mml-mode-hook)))
;;;
;;; Helper functions for reading MIME stuff from the minibuffer and
which should correspond to `B nntp RET sunsite.auc.dk' in *Group*.
+ [done]
+
* Take a look at w3-menu.el in the Emacs-W3 distribution - this
works out really well. Each menu is 'named' by a symbol that
would be on a gnus-*-menus (where * would be whatever, but at