From af4a5319cbc657a992111b7cddbc8b23194691ee Mon Sep 17 00:00:00 2001 From: yamaoka Date: Mon, 30 Oct 2000 08:40:32 +0000 Subject: [PATCH] Synch with Gnus. --- lisp/ChangeLog | 22 ++++++++++++++ lisp/gnus-agent.el | 18 ++--------- lisp/gnus-group.el | 36 +++++++++++++++------- lisp/gnus-srvr.el | 86 ++++++++++++++++++++++++++++++++++------------------ lisp/gnus-topic.el | 12 ++++++-- lisp/gnus-util.el | 16 ++++++++++ lisp/gnus.el | 3 ++ lisp/mml.el | 17 ++++------- todo | 2 ++ 9 files changed, 142 insertions(+), 70 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index f91b63d..2f82b68 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,25 @@ +2000-10-30 01:52:40 ShengHuo ZHU + + * 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 + + * mml.el (mml-mode): Show menu in XEmacs. + +2000-10-30 00:49:33 ShengHuo ZHU + + * 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 * nnfolder.el (nnfolder-open-nov): Use group. diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index d48410f..2fefb48 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -946,20 +946,6 @@ the actual number of articles toggled is returned." (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)) @@ -973,8 +959,8 @@ the actual number of articles toggled is returned." (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) diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index dcf1b61..df4f371 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -1060,6 +1060,8 @@ if it is a string, only list groups matching REGEXP." (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) @@ -1071,6 +1073,8 @@ if it is a string, only list groups matching REGEXP." 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 @@ -1110,10 +1114,15 @@ if it is a string, only list groups matching REGEXP." (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) @@ -1133,16 +1142,21 @@ if it is a string, only list groups matching REGEXP." (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." diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el index 87155e7..b217086 100644 --- a/lisp/gnus-srvr.el +++ b/lisp/gnus-srvr.el @@ -55,6 +55,9 @@ The following specs are understood: (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) @@ -117,7 +120,7 @@ The following specs are understood: (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 @@ -489,6 +492,12 @@ The following commands are available: (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))) @@ -569,6 +578,7 @@ The following commands are available: (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)) @@ -587,18 +597,6 @@ The following commands are available: 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))) @@ -626,28 +624,56 @@ The following commands are available: (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)) diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el index b0c5d6c..8435bb1 100644 --- a/lisp/gnus-topic.el +++ b/lisp/gnus-topic.el @@ -394,7 +394,10 @@ if it is t, list groups that have no unread articles. 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)) @@ -416,7 +419,12 @@ If LOWEST is non-nil, list all newsgroups of level LOWEST or higher." (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)) diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 44529b2..e566243 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -1024,6 +1024,22 @@ Entries without port tokens default to DEFAULTPORT." (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 diff --git a/lisp/gnus.el b/lisp/gnus.el index a768887..5b7730a 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -1693,6 +1693,9 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") (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) diff --git a/lisp/mml.el b/lisp/mml.el index 6757290..ed8753d 100644 --- a/lisp/mml.el +++ b/lisp/mml.el @@ -699,17 +699,12 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." \\{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 diff --git a/todo b/todo index 9657c7e..bc35043 100644 --- a/todo +++ b/todo @@ -1016,6 +1016,8 @@ exceeding lisp nesting on huge groups. 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 -- 1.7.10.4