From 3b1f49e01f97f2543b531bb2a5ea6bbe09a1796b Mon Sep 17 00:00:00 2001 From: yamaoka Date: Wed, 17 May 2000 08:25:03 +0000 Subject: [PATCH] Sync. --- lisp/ChangeLog | 30 +++++++++++++ lisp/gnus-agent.el | 34 +++++++++------ lisp/gnus-group.el | 119 +++++++++++++++++++++++++++++++++++----------------- lisp/gnus-start.el | 2 +- lisp/gnus-topic.el | 38 +++++++++++------ lisp/gnus-util.el | 8 ++-- texi/ChangeLog | 4 ++ texi/gnus-ja.texi | 5 +++ texi/gnus.texi | 5 +++ 9 files changed, 179 insertions(+), 66 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 0e12a74..076d972 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,33 @@ +2000-05-17 02:25:11 Shenghuo ZHU + + * gnus-group.el (gnus-group-mark-line-p): New function. + (gnus-group-goto-group): New parameter. + (gnus-group-remove-mark): Use it. + * gnus-topic.el (gnus-topic-move-group): Ditto. + (gnus-topic-remove-group): Ditto. + +2000-05-17 00:49:09 Shenghuo ZHU + + * gnus-group.el (gnus-group-list-dormant): New function. + +2000-05-16 23:20:42 Shenghuo ZHU + + * gnus-agent.el (gnus-agent-synchronize): Use + nnheader-insert-file-contents. + (gnus-agent-save-active-1): Ditto. + (gnus-agent-write-active): Ditto. + (gnus-agent-expire): Ditto. + * gnus-cache.el (gnus-cache-read-active): Ditto. + * gnus-start.el (gnus-master-read-slave-newsrc): Ditto. + * gnus-sum.el (gnus-summary-import-article): Ditto. + + * gnus-agent.el (gnus-agent-write-servers): Bind coding-system. + (gnus-agent-save-group-info): Ditto. + (gnus-agent-save-alist): Ditto. + * gnus-util.el (gnus-make-directory): Ditto. + + * gnus-agent.el (gnus-agent-save-group-info): Disable multibyte. + 2000-05-16 21:13:24 Shenghuo ZHU * mml.el (mml-generate-mime-preprocess-function): New variable. diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index d9104f4..414b6b2 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -443,7 +443,7 @@ Currently sends flag setting requests, if any." (when (file-exists-p (gnus-agent-lib-file "flags")) (set-buffer (get-buffer-create " *Gnus Agent flag synchronize*")) (erase-buffer) - (insert-file-contents (gnus-agent-lib-file "flags")) + (nnheader-insert-file-contents (gnus-agent-lib-file "flags")) (if (null (gnus-check-server gnus-command-method)) (message "Couldn't open server %s" (nth 1 gnus-command-method)) (while (not (eobp)) @@ -493,8 +493,12 @@ Currently sends flag setting requests, if any." (defun gnus-agent-write-servers () "Write the alist of covered servers." (gnus-make-directory (nnheader-concat gnus-agent-directory "lib")) - (with-temp-file (nnheader-concat gnus-agent-directory "lib/servers") - (prin1 gnus-agent-covered-methods (current-buffer)))) + (let ((coding-system-for-write nnheader-file-coding-system) + (output-coding-system nnheader-file-coding-system) + (file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system)) + (with-temp-file (nnheader-concat gnus-agent-directory "lib/servers") + (prin1 gnus-agent-covered-methods (current-buffer))))) ;;; ;;; Summary commands @@ -633,6 +637,10 @@ the actual number of articles toggled is returned." (defun gnus-agent-save-group-info (method group active) (when (gnus-agent-method-p method) (let* ((gnus-command-method method) + (coding-system-for-write nnheader-file-coding-system) + (output-coding-system nnheader-file-coding-system) + (file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system) (file (gnus-agent-lib-file "active")) oactive) (gnus-make-directory (file-name-directory file)) @@ -974,15 +982,17 @@ the actual number of articles toggled is returned." (defun gnus-agent-save-alist (group &optional articles state dir) "Save the article-state alist for GROUP." - (with-temp-file (if dir - (concat dir ".agentview") - (gnus-agent-article-name ".agentview" group)) - (princ (setq gnus-agent-article-alist - (nconc gnus-agent-article-alist - (mapcar (lambda (article) (cons article state)) - articles))) - (current-buffer)) - (insert "\n"))) + (let ((file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system)) + (with-temp-file (if dir + (concat dir ".agentview") + (gnus-agent-article-name ".agentview" group)) + (princ (setq gnus-agent-article-alist + (nconc gnus-agent-article-alist + (mapcar (lambda (article) (cons article state)) + articles))) + (current-buffer)) + (insert "\n")))) (defun gnus-agent-article-name (article group) (concat (gnus-agent-directory) (gnus-agent-group-path group) "/" diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 9041f24..90bade9 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -631,7 +631,8 @@ For example: "m" gnus-group-list-matching "M" gnus-group-list-all-matching "l" gnus-group-list-level - "c" gnus-group-list-cached) + "c" gnus-group-list-cached + "?" gnus-group-list-dormant) (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map) "f" gnus-score-flush-cache) @@ -708,7 +709,8 @@ For example: ["List groups matching..." gnus-group-list-matching t] ["List all groups matching..." gnus-group-list-all-matching t] ["List active file" gnus-group-list-active t] - ["List groups with cached" gnus-group-list-cached t]) + ["List groups with cached" gnus-group-list-cached t] + ["List groups with dormant" gnus-group-list-dormant t]) ("Sort" ["Default sort" gnus-group-sort-groups t] ["Sort by method" gnus-group-sort-groups-by-method t] @@ -1427,6 +1429,12 @@ If FIRST-TOO, the current line is also eligible as a target." ;; Group marking. +(defun gnus-group-mark-line-p () + (save-excursion + (beginning-of-line) + (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2)) + (eq (char-after) gnus-process-mark))) + (defun gnus-group-mark-group (n &optional unmark no-advance) "Mark the current group." (interactive "p") @@ -1493,10 +1501,10 @@ If UNMARK, remove the mark instead." (gnus-group-set-mark group)))) (gnus-group-position-point)) -(defun gnus-group-remove-mark (group) +(defun gnus-group-remove-mark (group &optional test-marked) "Remove the process mark from GROUP and move point there. Return nil if the group isn't displayed." - (if (gnus-group-goto-group group) + (if (gnus-group-goto-group group nil test-marked) (save-excursion (gnus-group-mark-group 1 'unmark t) t) @@ -1575,7 +1583,7 @@ Take into consideration N (the prefix) and the list of marked groups." (eval `(defun gnus-group-iterate (arg ,function) "Iterate FUNCTION over all process/prefixed groups. -FUNCTION will be called with the group name as the paremeter +FUNCTION will be called with the group name as the parameter and with point over the group in question." (let ((,groups (gnus-group-process-prefix arg)) (,window (selected-window)) @@ -1766,41 +1774,56 @@ Return the name of the group if selection was successful." ;; Adjust cursor point. (gnus-group-position-point)) -(defun gnus-group-goto-group (group &optional far) +(defun gnus-group-goto-group (group &optional far test-marked) "Goto to newsgroup GROUP. -If FAR, it is likely that the group is not on the current line." +If FAR, it is likely that the group is not on the current line. +If TEST-MARKED, the line must be marked." (when group - (if far - (gnus-goto-char - (text-property-any - (point-min) (point-max) - 'gnus-group (gnus-intern-safe group gnus-active-hashtb))) - (beginning-of-line) - (cond - ;; It's quite likely that we are on the right line, so - ;; we check the current line first. - ((eq (get-text-property (point) 'gnus-group) - (gnus-intern-safe group gnus-active-hashtb)) - (point)) - ;; Previous and next line are also likely, so we check them as well. - ((save-excursion - (forward-line -1) - (eq (get-text-property (point) 'gnus-group) - (gnus-intern-safe group gnus-active-hashtb))) - (forward-line -1) - (point)) - ((save-excursion - (forward-line 1) - (eq (get-text-property (point) 'gnus-group) - (gnus-intern-safe group gnus-active-hashtb))) - (forward-line 1) - (point)) - (t - ;; Search through the entire buffer. - (gnus-goto-char - (text-property-any - (point-min) (point-max) - 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))))) + (beginning-of-line) + (cond + ;; It's quite likely that we are on the right line, so + ;; we check the current line first. + ((and (not far) + (eq (get-text-property (point) 'gnus-group) + (gnus-intern-safe group gnus-active-hashtb)) + (or (not test-marked) (gnus-group-mark-line-p))) + (point)) + ;; Previous and next line are also likely, so we check them as well. + ((and (not far) + (save-excursion + (forward-line -1) + (and (eq (get-text-property (point) 'gnus-group) + (gnus-intern-safe group gnus-active-hashtb)) + (or (not test-marked) (gnus-group-mark-line-p))))) + (forward-line -1) + (point)) + ((and (not far) + (save-excursion + (forward-line 1) + (and (eq (get-text-property (point) 'gnus-group) + (gnus-intern-safe group gnus-active-hashtb)) + (or (not test-marked) (gnus-group-mark-line-p))))) + (forward-line 1) + (point)) + (test-marked + (goto-char (point-min)) + (let (found) + (while (and (not found) + (gnus-goto-char + (text-property-any + (point) (point-max) + 'gnus-group + (gnus-intern-safe group gnus-active-hashtb)))) + (if (gnus-group-mark-line-p) + (setq found t) + (forward-line 1))) + found)) + (t + ;; Search through the entire buffer. + (gnus-goto-char + (text-property-any + (point-min) (point-max) + 'gnus-group (gnus-intern-safe group gnus-active-hashtb))))))) (defun gnus-group-next-group (n &optional silent) "Go to next N'th newsgroup. @@ -3735,6 +3758,26 @@ This command may read the active file." (goto-char (point-min)) (gnus-group-position-point)) +(defun gnus-group-list-dormant (level &optional lowest) + "List all groups with dormant articles. +If the prefix LEVEL is non-nil, it should be a number that says which +level to cut off listing groups. +If LOWEST, don't list groups with level lower than LOWEST. + +This command may read the active file." + (interactive "P") + (when level + (setq level (prefix-numeric-value level))) + (when (or (not level) (>= level gnus-level-zombie)) + (gnus-cache-open)) + (gnus-group-prepare-flat-predicate (or level gnus-level-subscribed) + #'(lambda (info) + (let ((marks (gnus-info-marks info))) + (assq 'dormant marks))) + lowest) + (goto-char (point-min)) + (gnus-group-position-point)) + (provide 'gnus-group) ;;; gnus-group.el ends here diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 3843e99..44ac21d 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -2667,7 +2667,7 @@ The backup file \".newsrc.eld_\" will be created before re-reading." (while slave-files (erase-buffer) (setq file (nth 1 (car slave-files))) - (insert-file-contents file) + (nnheader-insert-file-contents file) (when (condition-case () (progn (eval-buffer (current-buffer)) diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el index 528fb5a..852f2a7 100644 --- a/lisp/gnus-topic.el +++ b/lisp/gnus-topic.el @@ -1131,13 +1131,21 @@ When used interactively, PARENT will be the topic under point." (gnus-group-list-groups) (gnus-topic-goto-topic topic)) +;; FIXME: +;; 1. When the marked groups are overlapped with the process +;; region, the behavior of move or remove is not right. +;; 2. Can't process on several marked groups with a same name, +;; because gnus-group-marked only keeps one copy. + (defun gnus-topic-move-group (n topic &optional copyp) "Move the next N groups to TOPIC. If COPYP, copy the groups instead." (interactive (list current-prefix-arg (completing-read "Move to topic: " gnus-topic-alist nil t))) - (let ((groups (gnus-group-process-prefix n)) + (let ((use-marked (and (not n) (not (gnus-region-active-p)) + gnus-group-marked t)) + (groups (gnus-group-process-prefix n)) (topicl (assoc topic gnus-topic-alist)) (start-topic (gnus-group-topic-name)) (start-group (progn (forward-line 1) (gnus-group-group-name))) @@ -1146,7 +1154,7 @@ If COPYP, copy the groups instead." (gnus-topic-move start-topic topic) (mapcar (lambda (g) - (gnus-group-remove-mark g) + (gnus-group-remove-mark g use-marked) (when (and (setq entry (assoc (gnus-current-topic) gnus-topic-alist)) (not copyp)) @@ -1159,18 +1167,24 @@ If COPYP, copy the groups instead." (gnus-topic-goto-topic start-topic)) (gnus-group-list-groups)))) -(defun gnus-topic-remove-group (&optional arg) +(defun gnus-topic-remove-group (&optional n) "Remove the current group from the topic." (interactive "P") - (gnus-group-iterate arg - (lambda (group) - (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist)) - (buffer-read-only nil)) - (when (and topicl group) - (gnus-delete-line) - (gnus-delete-first group topicl)) - (gnus-topic-update-topic) - (gnus-group-position-point))))) + (let ((use-marked (and (not n) (not (gnus-region-active-p)) + gnus-group-marked t)) + (groups (gnus-group-process-prefix n))) + (mapcar + (lambda (group) + (gnus-group-remove-mark group use-marked) + (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist)) + (buffer-read-only nil)) + (when (and topicl group) + (gnus-delete-line) + (gnus-delete-first group topicl)) + (gnus-topic-update-topic))) + groups) + (gnus-topic-enter-dribble) + (gnus-group-position-point))) (defun gnus-topic-copy-group (n topic) "Copy the current group to a topic." diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 0a62b5f..7aa1c33 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -570,9 +570,11 @@ Bind `print-quoted' and `print-readably' to t while printing." (defun gnus-make-directory (directory) "Make DIRECTORY (and all its parents) if it doesn't exist." - (when (and directory - (not (file-exists-p directory))) - (make-directory directory t)) + (let ((file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system)) + (when (and directory + (not (file-exists-p directory))) + (make-directory directory t))) t) (defun gnus-write-buffer (file) diff --git a/texi/ChangeLog b/texi/ChangeLog index a0f2b6c..fcc5120 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,7 @@ +2000-05-17 00:50:29 Shenghuo ZHU + + * gnus.texi (Listing Groups): Addition. + 2000-05-16 21:46:40 Shenghuo ZHU * gnus.texi (Misc Group Stuff): Addition. diff --git a/texi/gnus-ja.texi b/texi/gnus-ja.texi index 8d2cff8..e647acd 100644 --- a/texi/gnus-ja.texi +++ b/texi/gnus-ja.texi @@ -2820,6 +2820,11 @@ kill $(B$5$l$?%0%k!<%W$rA4$FI=<($7$^$9(B (@code{gnus-group-list-killed})$(B!# $(B%-%c%C%7%e5-;v$r;}$D%0%k!<%W$rA4$FI=<($9$k(B (@code{gnus-group-list-cached})$(B!#(B +@item A ? +@kindex A ? (Group) +@findex gnus-group-list-dormant +$(BJ]N15-;v$r;}$D%0%k!<%W$rA4$FI=<($9$k(B (@code{gnus-group-list-dormant})$(B!#(B + @end table @vindex gnus-permanently-visible-groups diff --git a/texi/gnus.texi b/texi/gnus.texi index 5fce227..2514f9a 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -2778,6 +2778,11 @@ List all groups that have names or descriptions that match a regexp @findex gnus-group-list-cached List all groups with cached articles (@code{gnus-group-list-cached}). +@item A ? +@kindex A ? (Group) +@findex gnus-group-list-dormant +List all groups with dormant articles (@code{gnus-group-list-dormant}). + @end table @vindex gnus-permanently-visible-groups -- 1.7.10.4