2001-09-28 07:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>

[gnus] / lisp / gnus-util.el

diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el
index 174f2fb..c599ba8 100644 (file)
--- a/lisp/gnus-util.el
+++ b/lisp/gnus-util.el
@@ -53,20 +53,20 @@
 (defmacro gnus-eval-in-buffer-window (buffer &rest forms)
   "Pop to BUFFER, evaluate FORMS, and then return to the original window."
   (let ((tempvar (make-symbol "GnusStartBufferWindow"))
-        (w (make-symbol "w"))
-        (buf (make-symbol "buf")))
+       (w (make-symbol "w"))
+       (buf (make-symbol "buf")))
     `(let* ((,tempvar (selected-window))
-            (,buf ,buffer)
-            (,w (get-buffer-window ,buf 'visible)))
+           (,buf ,buffer)
+           (,w (get-buffer-window ,buf 'visible)))
        (unwind-protect
-           (progn
-             (if ,w
-                 (progn
-                   (select-window ,w)
-                   (set-buffer (window-buffer ,w)))
-               (pop-to-buffer ,buf))
-             ,@forms)
-         (select-window ,tempvar)))))
+          (progn
+            (if ,w
+                (progn
+                  (select-window ,w)
+                  (set-buffer (window-buffer ,w)))
+              (pop-to-buffer ,buf))
+            ,@forms)
+        (select-window ,tempvar)))))
 
 (put 'gnus-eval-in-buffer-window 'lisp-indent-function 1)
 (put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body))
@@ -182,7 +182,10 @@
 
 (defun gnus-goto-colon ()
   (beginning-of-line)
-  (search-forward ":" (gnus-point-at-eol) t))
+  (let ((eol (gnus-point-at-eol)))
+    (goto-char (or (text-property-any (point) eol 'gnus-position t)
+                  (search-forward ":" eol t)
+                  (point)))))
 
 (defun gnus-remove-text-with-property (prop)
   "Delete all text in the current buffer with text property PROP."
@@ -478,8 +481,9 @@ If N, return the Nth ancestor instead."
    ;; A list of functions.
    ((or (cdr funs)
        (listp (car funs)))
-    `(lambda (t1 t2)
-       ,(gnus-make-sort-function-1 (reverse funs))))
+    (gnus-byte-compile
+     `(lambda (t1 t2)
+       ,(gnus-make-sort-function-1 (reverse funs)))))
    ;; A list containing just one function.
    (t
     (car funs))))
@@ -686,7 +690,8 @@ with potentially long computations."
       ;; Decide whether to append to a file or to an Emacs buffer.
       (let ((outbuf (get-file-buffer filename)))
        (if (not outbuf)
-           (mm-append-to-file (point-min) (point-max) filename)
+           (let ((file-name-coding-system nnmail-pathname-coding-system))
+             (mm-append-to-file (point-min) (point-max) filename))
          ;; File has been visited, in buffer OUTBUF.
          (set-buffer outbuf)
          (let ((buffer-read-only nil)
@@ -700,10 +705,10 @@ with potentially long computations."
            (when msg
              (goto-char (point-min))
              (widen)
-             (search-backward "\n\^_")
-             (narrow-to-region (point) (point-max))
-             (rmail-count-new-messages t)
-             (when (rmail-summary-exists)
+             (search-backward "\n\^_")
+             (narrow-to-region (point) (point-max))
+             (rmail-count-new-messages t)
+             (when (rmail-summary-exists)
                (rmail-select-summary
                 (rmail-update-summary)))
              (rmail-count-new-messages t)
@@ -755,7 +760,8 @@ with potentially long computations."
                    (insert "\n"))
                  (insert "\n"))
                (goto-char (point-max))
-               (mm-append-to-file (point-min) (point-max) filename)))
+               (let ((file-name-coding-system nnmail-pathname-coding-system))
+                 (mm-append-to-file (point-min) (point-max) filename))))
          ;; File has been visited, in buffer OUTBUF.
          (set-buffer outbuf)
          (let ((buffer-read-only nil))
@@ -914,7 +920,7 @@ Entries without port tokens default to DEFAULTPORT."
 Return the modified alist."
     (let (entry)
       (while (setq entry (assq key alist))
-        (setq alist (delq entry alist)))
+       (setq alist (delq entry alist)))
       alist)))
 
 (defmacro gnus-pull (key alist &optional assoc-p)
@@ -1023,6 +1029,50 @@ Return the modified alist."
        (or (string-equal x y)
           (string-equal (downcase x) (downcase y)))))
 
+(defcustom gnus-use-byte-compile t
+  "If non-nil, byte-compile crucial run-time codes."
+  :type 'boolean
+  :version "21.1"
+  :group 'gnus-various)
+
+(defun gnus-byte-compile (form)
+  "Byte-compile FORM if `gnus-use-byte-compile' is non-nil."
+  (if gnus-use-byte-compile
+      (progn
+       (require 'bytecomp)
+       (defalias 'gnus-byte-compile 'byte-compile)
+       (byte-compile form))
+    form))
+
+(defun gnus-remassoc (key alist)
+  "Delete by side effect any elements of LIST whose car is `equal' to KEY.
+The modified LIST is returned.  If the first member
+of LIST has a car that is `equal' to KEY, there is no way to remove it
+by side effect; therefore, write `(setq foo (remassoc key foo))' to be
+sure of changing the value of `foo'."
+  (when alist
+    (if (equal key (caar alist))
+       (cdr alist)
+      (setcdr alist (gnus-remassoc key (cdr alist)))
+      alist)))
+
+(defun gnus-update-alist-soft (key value alist)
+  (if value
+      (cons (cons key value) (gnus-remassoc key alist))
+    (gnus-remassoc key alist)))
+
+(defun gnus-create-info-command (node)
+  "Create a command that will go to info NODE."
+  `(lambda ()
+     (interactive)
+     ,(concat "Enter the info system at node " node)
+     (Info-goto-node ,node)
+     (setq gnus-info-buffer (current-buffer))
+     (gnus-configure-windows 'info)))
+
+(defun gnus-not-ignore (&rest args)
+  t)
+
 (provide 'gnus-util)
 
 ;;; gnus-util.el ends here