From 25ae8d0af030d77d5fead1083abf8b20259b55c4 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Mon, 21 Aug 2000 23:16:39 +0000 Subject: [PATCH] Synch with Gnus. --- lisp/ChangeLog | 37 ++++++++++++++++++++++++ lisp/gnus-clfns.el | 20 ++++++------- lisp/gnus-ems.el | 4 +-- lisp/gnus-salt.el | 12 ++++---- lisp/gnus-topic.el | 23 +++++++++++---- lisp/gnus.el | 23 ++++++++++++++- lisp/mm-util.el | 79 ++++++++++++++++++++++++++++------------------------ lisp/mml.el | 6 ---- lisp/nnimap.el | 10 ++++--- 9 files changed, 145 insertions(+), 69 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ac7455d..18d8587 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,40 @@ +2000-08-21 Dave Love + + * nnimap.el (nnimap-request-newgroups): Eschew member-if. + +2000-08-21 10:09:47 ShengHuo ZHU + + * gnus-topic.el (gnus-topic-hide-topic): Use find-topology if + permanent is used. + (gnus-topic-show-topic): Read topic when to show permanent hidden + topic. + (gnus-topic-remove-topic): Revert to the old behavior, not using + hide. + +2000-08-21 Dave Love + + * gnus-ems.el (gnus-add-minor-mode): Add &rest arg. + (gnus-xemacs): Use featurep. + + * mm-util.el (mm-read-charset): Maybe use builtin. + (mm-replace-chars-in-string): Maybe use subst-char-in-string. + (mm-multibyte-p, mm-with-unibyte-current-buffer) + (mm-with-unibyte): Use featurep, not string-match. + (mm-with-unibyte-buffer): Simplify. + (mm-quote-arg): Maybe use shell-quote-argument. + + * mml.el (mml-make-string): Deleted (unused). + + * gnus.el (gnus-mode-line-buffer-identification): Supply + definition for Emacs 21. + + * gnus-salt.el: Small doc fixes. + (gnus-pick-mode, gnus-binary-mode): Supply a toggle-func arg to + gnus-add-minor-mode. + + * gnus-topic.el (gnus-topic-mode): Supply a toggle-func arg to + gnus-add-minor-mode. + 2000-08-20 Simon Josefsson * nnimap.el (nnimap-before-find-minmax-bugworkaround): New diff --git a/lisp/gnus-clfns.el b/lisp/gnus-clfns.el index 2a9753e..d46f8f9 100644 --- a/lisp/gnus-clfns.el +++ b/lisp/gnus-clfns.el @@ -95,16 +95,16 @@ (setq arg (cdr arg))) (apply (function nconc) (nreverse res)))))) - (define-compiler-macro member-if (&whole form pred list) - (if (and (fboundp 'member-if) - (subrp (symbol-function 'member-if))) - form - `(let ((fn ,pred) - (seq ,list)) - (while (and seq - (not (funcall fn (car seq)))) - (pop seq)) - seq))) +;; (define-compiler-macro member-if (&whole form pred list) +;; (if (and (fboundp 'member-if) +;; (subrp (symbol-function 'member-if))) +;; form +;; `(let ((fn ,pred) +;; (seq ,list)) +;; (while (and seq +;; (not (funcall fn (car seq)))) +;; (pop seq)) +;; seq))) (define-compiler-macro union (&whole form list1 list2) (if (and (fboundp 'union) diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index 0b655de..4b750dc 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -32,7 +32,7 @@ ;;; Function aliases later to be redefined for XEmacs usage. (eval-and-compile - (defvar gnus-xemacs (string-match "XEmacs" emacs-version) + (defvar gnus-xemacs (featurep 'xemacs) "Non-nil if running under XEmacs.")) (defvar gnus-mouse-2 [mouse-2]) @@ -168,7 +168,7 @@ (if (fboundp 'add-minor-mode) (defalias 'gnus-add-minor-mode 'add-minor-mode) - (defun gnus-add-minor-mode (mode name map) + (defun gnus-add-minor-mode (mode name map &rest rest) (set (make-local-variable mode) t) (unless (assq mode minor-mode-alist) (push `(,mode ,name) minor-mode-alist)) diff --git a/lisp/gnus-salt.el b/lisp/gnus-salt.el index 181f9cf..017294e 100644 --- a/lisp/gnus-salt.el +++ b/lisp/gnus-salt.el @@ -53,7 +53,7 @@ :group 'gnus-summary-pick) (defcustom gnus-pick-elegant-flow t - "If non-nil, gnus-pick-start-reading will run gnus-summary-next-group when no articles have been picked." + "If non-nil, `gnus-pick-start-reading' runs `gnus-summary-next-group' when no articles have been picked." :type 'boolean :group 'gnus-summary-pick) @@ -120,7 +120,8 @@ It accepts the same format specs that `gnus-summary-line-format' does." ;; Set up the menu. (when (gnus-visual-p 'pick-menu 'menu) (gnus-pick-make-menu-bar)) - (gnus-add-minor-mode 'gnus-pick-mode " Pick" gnus-pick-mode-map) + (gnus-add-minor-mode 'gnus-pick-mode " Pick" gnus-pick-mode-map + nil 'gnus-pick-mode) (gnus-run-hooks 'gnus-pick-mode-hook)))) (defun gnus-pick-setup-message () @@ -182,7 +183,7 @@ If ARG, pick the article on that line instead." (gnus-summary-mark-as-processable 1)) (defun gnus-pick-article-or-thread (&optional arg) - "If gnus-thread-hide-subtree is t, then pick the thread on the current line. + "If `gnus-thread-hide-subtree' is t, then pick the thread on the current line. Otherwise pick the article on the current line. If ARG, pick the article/thread on that line instead." (interactive "P") @@ -196,7 +197,7 @@ If ARG, pick the article/thread on that line instead." (gnus-summary-mark-as-processable 1))) (defun gnus-pick-unmark-article-or-thread (&optional arg) - "If gnus-thread-hide-subtree is t, then unmark the thread on current line. + "If `gnus-thread-hide-subtree' is t, then unmark the thread on current line. Otherwise unmark the article on current line. If ARG, unmark thread/article on that line instead." (interactive "P") @@ -352,7 +353,8 @@ This must be bound to a button-down mouse event." ;; Set up the menu. (when (gnus-visual-p 'binary-menu 'menu) (gnus-binary-make-menu-bar)) - (gnus-add-minor-mode 'gnus-binary-mode " Binary" gnus-binary-mode-map) + (gnus-add-minor-mode 'gnus-binary-mode " Binary" + gnus-binary-mode-map nil 'gnus-binary-mode-map) (gnus-run-hooks 'gnus-binary-mode-hook)))) (defun gnus-binary-display-article (article &optional all-header) diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el index 2a4b20a..498b9f8 100644 --- a/lisp/gnus-topic.el +++ b/lisp/gnus-topic.el @@ -506,7 +506,7 @@ articles in the topic and its subtopics." (let ((data (cadr (gnus-topic-find-topology topic)))) (setcdr data (list (if insert 'visible 'invisible) - hide + (caddr data) (cadddr data)))) (if total-remove (setq gnus-topic-alist @@ -1020,7 +1020,10 @@ articles in the topic and its subtopics." (when (gnus-visual-p 'topic-menu 'menu) (gnus-topic-make-menu-bar)) (gnus-set-format 'topic t) - (gnus-add-minor-mode 'gnus-topic-mode " Topic" gnus-topic-mode-map) + (gnus-add-minor-mode 'gnus-topic-mode " Topic" + gnus-topic-mode-map nil (lambda (&rest junk) + (interactive) + (gnus-topic-mode nil t))) (add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic) (set (make-local-variable 'gnus-group-prepare-function) 'gnus-group-prepare-topics) @@ -1269,7 +1272,11 @@ If PERMANENT, make it stay hidden in subsequent sessions as well." (interactive "P") (when (gnus-current-topic) (gnus-topic-goto-topic (gnus-current-topic)) - (setcar (cddr (assoc (gnus-current-topic) gnus-topic-topology)) 'hidden) + (if permanent + (setcar (cddr + (cadr + (gnus-topic-find-topology (gnus-current-topic)))) + 'hidden)) (gnus-topic-remove-topic nil nil))) (defun gnus-topic-show-topic (&optional permanent) @@ -1277,8 +1284,14 @@ If PERMANENT, make it stay hidden in subsequent sessions as well." If PERMANENT, make it stay shown in subsequent sessions as well." (interactive "P") (when (gnus-group-topic-p) - (setcar (cddr (assoc (gnus-current-topic) gnus-topic-topology)) nil) - (gnus-topic-remove-topic t nil))) + (if (not permanent) + (gnus-topic-remove-topic t nil) + (let ((topic + (gnus-topic-find-topology + (completing-read "Show topic: " gnus-topic-alist nil t)))) + (setcar (cddr (cadr topic)) nil) + (setcar (cdr (cadr topic)) 'visible) + (gnus-group-list-groups))))) (defun gnus-topic-mark-topic (topic &optional unmark) "Mark all groups in the topic with the process mark." diff --git a/lisp/gnus.el b/lisp/gnus.el index 78adf57..3b42a3c 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -287,7 +287,28 @@ be set in `.emacs' instead." (defalias 'gnus-character-to-event 'identity) (defalias 'gnus-add-text-properties 'add-text-properties) (defalias 'gnus-put-text-property 'put-text-property) - (defalias 'gnus-mode-line-buffer-identification 'identity) + (defvar gnus-mode-line-image-cache t) + (if (fboundp 'find-image) + (defun gnus-mode-line-buffer-identification (line) + (let ((str (car-safe line))) + (if (and (stringp str) + (string-match "^Gnus:" str)) + (progn (add-text-properties + 0 5 + (list 'display + (if (eq t gnus-mode-line-image-cache) + (setq gnus-mode-line-image-cache + (find-image + '((:type xpm :file "gnus-pointer.xpm" + :ascent 100) + (:type xbm :file "gnus-pointer.xbm" + :ascent 100)))) + gnus-mode-line-image-cache) + 'help-echo "This is Gnus") + str) + (list str)) + line))) + (defalias 'gnus-mode-line-buffer-identification 'identity)) (defalias 'gnus-characterp 'numberp) (defalias 'gnus-deactivate-mark 'deactivate-mark) (defalias 'gnus-window-edges 'window-edges) diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 74cd23f..3091e20 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -24,6 +24,8 @@ ;;; Code: +(eval-when-compile (require 'static)) + (require 'mail-prsvr) (defvar mm-mime-mule-charset-alist @@ -96,7 +98,16 @@ "Prompt the user for a coding system." (completing-read prompt (mapcar (lambda (s) (list (symbol-name (car s)))) - mm-mime-mule-charset-alist))))))) + mm-mime-mule-charset-alist)))) + (read-charset + . (lambda (prompt) + "Return a charset." + (intern + (completing-read + prompt + (mapcar (lambda (e) (list (symbol-name (car e)))) + mm-mime-mule-charset-alist) + nil t))))))) (eval-and-compile (defalias 'mm-char-or-char-int-p @@ -191,17 +202,20 @@ used as the line break code type of the coding system." (t nil))) -(defun mm-replace-chars-in-string (string from to) - "Replace characters in STRING from FROM to TO." - (let ((string (substring string 0)) ;Copy string. - (len (length string)) - (idx 0)) - ;; Replace all occurrences of FROM with TO. - (while (< idx len) - (when (= (aref string idx) from) - (aset string idx to)) - (setq idx (1+ idx))) - string)) +(static-if (fboundp 'subst-char-in-string) + (defsubst mm-replace-chars-in-string (string from to) + (subst-char-in-string from to string)) + (defun mm-replace-chars-in-string (string from to) + "Replace characters in STRING from FROM to TO." + (let ((string (substring string 0)) ;Copy string. + (len (length string)) + (idx 0)) + ;; Replace all occurrences of FROM with TO. + (while (< idx len) + (when (= (aref string idx) from) + (aset string idx to)) + (setq idx (1+ idx))) + string))) (defsubst mm-enable-multibyte () "Enable multibyte in the current buffer." @@ -290,7 +304,7 @@ If the charset is `composition', return the actual one." (defsubst mm-multibyte-p () "Say whether multibyte is enabled." - (or (string-match "XEmacs\\|Lucid" emacs-version) + (or (featurep 'xemacs) (and (boundp 'enable-multibyte-characters) enable-multibyte-characters))) @@ -324,7 +338,7 @@ See also `with-temp-file' and `with-output-to-string'." (defmacro mm-with-unibyte-current-buffer (&rest forms) "Evaluate FORMS there like `progn' in current buffer." (let ((multibyte (make-symbol "multibyte"))) - `(if (or (string-match "XEmacs\\|Lucid" emacs-version) + `(if (or (featurep 'xemacs) (not (fboundp 'set-buffer-multibyte))) (progn ,@forms) @@ -344,7 +358,7 @@ See also `with-temp-file' and `with-output-to-string'." (defmacro mm-with-unibyte (&rest forms) "Set default `enable-multibyte-characters' to `nil', eval the FORMS." (let ((multibyte (make-symbol "multibyte"))) - `(if (or (string-match "XEmacs\\|Lucid" emacs-version) + `(if (or (featurep 'xemacs) (not (boundp 'enable-multibyte-characters))) (progn ,@forms) (let ((,multibyte (default-value 'enable-multibyte-characters))) @@ -390,27 +404,20 @@ See also `with-temp-file' and `with-output-to-string'." (or (car (last (assq 'charset entry))) 'latin-iso8859-1)))))))))) -(defun mm-read-charset (prompt) - "Return a charset." - (intern - (completing-read - prompt - (mapcar (lambda (e) (list (symbol-name (car e)))) - mm-mime-mule-charset-alist) - nil t))) - -(defun mm-quote-arg (arg) - "Return a version of ARG that is safe to evaluate in a shell." - (let ((pos 0) new-pos accum) - ;; *** bug: we don't handle newline characters properly - (while (setq new-pos (string-match "[]*[;!'`\"$\\& \t{} |()<>]" arg pos)) - (push (substring arg pos new-pos) accum) - (push "\\" accum) - (push (list (aref arg new-pos)) accum) - (setq pos (1+ new-pos))) - (if (= pos 0) - arg - (apply 'concat (nconc (nreverse accum) (list (substring arg pos))))))) +(static-if (fboundp 'shell-quote-argument) + (defalias 'mm-quote-arg 'shell-quote-argument) + (defun mm-quote-arg (arg) + "Return a version of ARG that is safe to evaluate in a shell." + (let ((pos 0) new-pos accum) + ;; *** bug: we don't handle newline characters properly + (while (setq new-pos (string-match "[]*[;!'`\"$\\& \t{} |()<>]" arg pos)) + (push (substring arg pos new-pos) accum) + (push "\\" accum) + (push (list (aref arg new-pos)) accum) + (setq pos (1+ new-pos))) + (if (= pos 0) + arg + (apply 'concat (nconc (nreverse accum) (list (substring arg pos)))))))) (defun mm-auto-mode-alist () "Return an `auto-mode-alist' with only the .gz (etc) thingies." diff --git a/lisp/mml.el b/lisp/mml.el index 4770d12..86faed8 100644 --- a/lisp/mml.el +++ b/lisp/mml.el @@ -450,12 +450,6 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." "") mml-base-boundary)) -(defun mml-make-string (num string) - (let ((out "")) - (while (not (zerop (decf num))) - (setq out (concat out string))) - out)) - (defun mml-insert-mime-headers (cont type charset encoding) (let (parameters disposition description) (setq parameters diff --git a/lisp/nnimap.el b/lisp/nnimap.el index 477e9af..5e9b62e 100644 --- a/lisp/nnimap.el +++ b/lisp/nnimap.el @@ -998,10 +998,12 @@ function is generally only called when Gnus is shutting down." nnimap-list-pattern)) (dolist (mbx (imap-mailbox-lsub "*" (car pattern) nil nnimap-server-buffer)) - (or (member-if (lambda (mailbox) - (string= (downcase mailbox) "\\noselect")) - (imap-mailbox-get 'list-flags mbx - nnimap-server-buffer)) + (or (catch 'found + (dolist (mailbox (imap-mailbox-get 'list-flags mbx + nnimap-server-buffer)) + (if (string= (downcase mailbox) "\\noselect") + (throw 'found t))) + nil) (let ((info (nnimap-find-minmax-uid mbx 'examine))) (when info (insert (format "\"%s\" %d %d y\n" -- 1.7.10.4