+2000-08-21 Dave Love <fx@gnu.org>
+
+ * nnimap.el (nnimap-request-newgroups): Eschew member-if.
+
+2000-08-21 10:09:47 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * 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 <fx@gnu.org>
+
+ * 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 <simon@josefsson.org>
* nnimap.el (nnimap-before-find-minmax-bugworkaround): New
(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)
;;; 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])
(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))
: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)
;; 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 ()
(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")
(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")
;; 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)
(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
(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)
(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)
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."
(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)
;;; Code:
+(eval-when-compile (require 'static))
+
(require 'mail-prsvr)
(defvar mm-mime-mule-charset-alist
"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
(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."
(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)))
(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)
(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)))
(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."
"")
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
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"
projects / elisp / gnus.git- / commitdiff