(copy-list): New function defined by `defun-maybe'.

[elisp/gnus.git-] / lisp / gnus-util.el

diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el
index 67f87fc..50e70d0 100644 (file)
--- a/lisp/gnus-util.el
+++ b/lisp/gnus-util.el
@@ -36,6 +36,7 @@
 (require 'nnheader)
 (require 'message)
 (require 'time-date)
+(eval-when-compile (require 'static))
 
 (eval-and-compile
   (autoload 'rmail-insert-rmail-file-header "rmail")
@@ -51,10 +52,12 @@
   "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")))
+        (buf (make-symbol "buf"))
+       (frame (make-symbol "frame")))
     `(let* ((,tempvar (selected-window))
             (,buf ,buffer)
-            (,w (get-buffer-window ,buf 'visible)))
+            (,w (get-buffer-window ,buf 'visible))
+           ,frame)
        (unwind-protect
            (progn
              (if ,w
@@ -63,7 +66,9 @@
                    (set-buffer (window-buffer ,w)))
                (pop-to-buffer ,buf))
              ,@forms)
-         (select-window ,tempvar)))))
+        (setq ,frame (selected-frame))
+         (select-window ,tempvar)
+        (select-frame ,frame)))))
 
 (put 'gnus-eval-in-buffer-window 'lisp-indent-function 1)
 (put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body))
@@ -109,15 +114,34 @@
      (when (gnus-buffer-exists-p buf)
        (kill-buffer buf))))
 
-(fset 'gnus-point-at-bol
-      (if (fboundp 'point-at-bol)
-         'point-at-bol
-       'line-beginning-position))
-
-(fset 'gnus-point-at-eol
-      (if (fboundp 'point-at-eol)
-         'point-at-eol
-       'line-end-position))
+(static-cond
+ ((fboundp 'point-at-bol)
+  (fset 'gnus-point-at-bol 'point-at-bol))
+ ((fboundp 'line-beginning-position)
+  (fset 'gnus-point-at-bol 'line-beginning-position))
+ (t
+  (defun gnus-point-at-bol ()
+    "Return point at the beginning of the line."
+    (let ((p (point)))
+      (beginning-of-line)
+      (prog1
+         (point)
+       (goto-char p))))
+  ))
+(static-cond
+ ((fboundp 'point-at-eol)
+  (fset 'gnus-point-at-eol 'point-at-eol))
+ ((fboundp 'line-end-position)
+  (fset 'gnus-point-at-eol 'line-end-position))
+ (t
+  (defun gnus-point-at-eol ()
+    "Return point at the end of the line."
+    (let ((p (point)))
+      (end-of-line)
+      (prog1
+         (point)
+       (goto-char p))))
+  ))
 
 (defun gnus-delete-first (elt list)
   "Delete by side effect the first occurrence of ELT as a member of LIST."
@@ -709,7 +733,7 @@ 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)
-           (append-to-file (point-min) (point-max) filename)
+           (write-region-as-binary (point-min) (point-max) filename 'append)
          ;; File has been visited, in buffer OUTBUF.
          (set-buffer outbuf)
          (let ((buffer-read-only nil)
@@ -838,9 +862,12 @@ ARG is passed to the first function."
            (if (eq (char-after) ?#)
                (goto-char (point-max))
              (unless (eobp)
-               (setq elem (buffer-substring
-                           (point) (progn (skip-chars-forward "^\t ")
-                                          (point))))
+               (setq elem
+                     (if (= (following-char) ?\")
+                         (read (current-buffer))
+                       (buffer-substring
+                        (point) (progn (skip-chars-forward "^\t ")
+                                       (point)))))
                (cond
                 ((equal elem "macdef")
                  ;; We skip past the macro definition.
@@ -958,19 +985,51 @@ ARG is passed to the first function."
        (throw 'found nil)))
     t))
 
-(defun gnus-write-active-file-as-coding-system (coding-system file hashtb)
-  (let ((coding-system-for-write coding-system))
-    (with-temp-file file
-      (mapatoms
-       (lambda (sym)
-        (when (and sym
-                   (boundp sym)
-                   (symbol-value sym))
-          (insert (format "%s %d %d y\n"
-                          (gnus-group-real-name (symbol-name sym))
-                          (cdr (symbol-value sym))
-                          (car (symbol-value sym))))))
-       hashtb))))
+(static-if (boundp 'MULE)
+    (defun gnus-write-active-file-as-coding-system
+      (coding-system file hashtb &optional full-names)
+      (let ((output-coding-system coding-system))
+       (with-temp-file file
+         (mapatoms
+          (lambda (sym)
+            (when (and sym
+                       (boundp sym)
+                       (symbol-value sym))
+              (insert (format "%s %d %d y\n"
+                              (if full-names
+                                  (symbol-name sym)
+                                (gnus-group-real-name (symbol-name sym)))
+                              (or (cdr (symbol-value sym))
+                                  (car (symbol-value sym)))
+                              (car (symbol-value sym))))))
+          hashtb))))
+  (defun gnus-write-active-file-as-coding-system
+    (coding-system file hashtb &optional full-names)
+    (let ((coding-system-for-write coding-system))
+      (with-temp-file file
+       (mapatoms
+        (lambda (sym)
+          (when (and sym
+                     (boundp sym)
+                     (symbol-value sym))
+            (insert (format "%s %d %d y\n"
+                            (if full-names
+                                (symbol-name sym)
+                              (gnus-group-real-name (symbol-name sym)))
+                            (or (cdr (symbol-value sym))
+                                (car (symbol-value sym)))
+                            (car (symbol-value sym))))))
+        hashtb))))
+  )
+
+(defun-maybe copy-list (list)
+  "Return a copy of a list, which may be a dotted list.
+The elements of the list are not copied, just the list structure itself."
+  (if (consp list)
+      (let ((res nil))
+       (while (consp list) (push (pop list) res))
+       (prog1 (nreverse res) (setcdr res list)))
+    (car list)))
 
 (provide 'gnus-util)