* nnheader.el (nnheader-find-file-noselect): Use

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

diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el
index c31a804..9371650 100644 (file)
--- a/lisp/gnus-util.el
+++ b/lisp/gnus-util.el
@@ -2,6 +2,7 @@
 ;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;;     Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
 ;; Keywords: mail, news, MIME
 
 ;; This file is part of GNU Emacs.
@@ -483,21 +484,40 @@ If N, return the Nth ancestor instead."
 (defun gnus-make-sort-function (funs)
   "Return a composite sort condition based on the functions in FUNC."
   (cond
-   ((not (listp funs)) funs)
+   ;; Just a simple function.
+   ((gnus-functionp funs) funs)
+   ;; No functions at all.
    ((null funs) funs)
-   ((cdr funs)
+   ;; A list of functions.
+   ((or (cdr funs)
+       (listp (car funs)))
     `(lambda (t1 t2)
        ,(gnus-make-sort-function-1 (reverse funs))))
+   ;; A list containing just one function.
    (t
     (car funs))))
 
 (defun gnus-make-sort-function-1 (funs)
   "Return a composite sort condition based on the functions in FUNC."
-  (if (cdr funs)
-      `(or (,(car funs) t1 t2)
-          (and (not (,(car funs) t2 t1))
-               ,(gnus-make-sort-function-1 (cdr funs))))
-    `(,(car funs) t1 t2)))
+  (let ((function (car funs))
+       (first 't1)
+       (last 't2))
+    (when (consp function)
+      (cond
+       ;; Reversed spec.
+       ((eq (car function) 'not)
+       (setq function (cadr function)
+             first 't2
+             last 't1))
+       ((gnus-functionp function)
+       )
+       (t
+       (error "Invalid sort spec: %s" function))))if
+    (if (cdr funs)
+       `(or (,function ,first ,last)
+            (and (not (,function ,last ,first))
+                 ,(gnus-make-sort-function-1 (cdr funs))))
+      `(,function ,first ,last))))
 
 (defun gnus-turn-off-edit-menu (type)
   "Turn off edit menu in `gnus-TYPE-mode-map'."
@@ -533,6 +553,21 @@ Bind `print-quoted' and `print-readably' to t while printing."
   ;; Write the buffer.
   (write-region (point-min) (point-max) file nil 'quietly))
 
+(defun gnus-write-buffer-as-binary (file)
+  "Write the current buffer's contents to FILE without code conversion."
+  ;; Make sure the directory exists.
+  (gnus-make-directory (file-name-directory file))
+  ;; Write the buffer.
+  (write-region-as-binary (point-min) (point-max) file nil 'quietly))
+
+(defun gnus-write-buffer-as-coding-system (file coding-system)
+  "Write the current buffer's contents to FILE with code conversion."
+  ;; Make sure the directory exists.
+  (gnus-make-directory (file-name-directory file))
+  ;; Write the buffer.
+  (write-region-as-coding-system
+   (point-min) (point-max) file coding-system nil 'quietly))
+
 (defun gnus-delete-file (file)
   "Delete FILE if it exists."
   (when (file-exists-p file)
@@ -652,7 +687,7 @@ with potentially long computations."
   (setq filename (expand-file-name filename))
   (setq rmail-default-rmail-file filename)
   (let ((artbuf (current-buffer))
-       (tmpbuf (gnus-get-buffer-create " *Gnus-output*")))
+       (tmpbuf (get-buffer-create " *Gnus-output*")))
     (save-excursion
       (or (get-file-buffer filename)
          (file-exists-p filename)
@@ -703,7 +738,7 @@ with potentially long computations."
   "Append the current article to a mail file named FILENAME."
   (setq filename (expand-file-name filename))
   (let ((artbuf (current-buffer))
-       (tmpbuf (gnus-get-buffer-create " *Gnus-output*")))
+       (tmpbuf (get-buffer-create " *Gnus-output*")))
     (save-excursion
       ;; Create the file, if it doesn't exist.
       (when (and (not (get-file-buffer filename))
@@ -714,9 +749,8 @@ with potentially long computations."
            (let ((file-buffer (create-file-buffer filename)))
              (save-excursion
                (set-buffer file-buffer)
-               (let ((require-final-newline nil)
-                     (coding-system-for-write 'binary))
-                 (gnus-write-buffer filename)))
+               (let ((require-final-newline nil))
+                 (gnus-write-buffer-as-binary filename)))
              (kill-buffer file-buffer))
          (error "Output file does not exist")))
       (set-buffer tmpbuf)
@@ -733,8 +767,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)
-           (let ((buffer-read-only nil)
-                 (coding-system-for-write 'binary))
+           (let ((buffer-read-only nil))
              (save-excursion
                (goto-char (point-max))
                (forward-char -2)
@@ -744,7 +777,8 @@ with potentially long computations."
                    (insert "\n"))
                  (insert "\n"))
                (goto-char (point-max))
-               (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))
@@ -903,11 +937,12 @@ ARG is passed to the first function."
       (setq alist (delq entry alist)))
     alist))
 
-(defmacro gnus-pull (key alist)
+(defmacro gnus-pull (key alist &optional assoc-p)
   "Modify ALIST to be without KEY."
   (unless (symbolp alist)
     (error "Not a symbol: %s" alist))
-  `(setq ,alist (delq (assq ,key ,alist) ,alist)))
+  (let ((fun (if assoc-p 'assoc 'assq)))
+    `(setq ,alist (delq (,fun ,key ,alist) ,alist))))
 
 (defun gnus-globalify-regexp (re)
   "Returns a regexp that matches a whole line, iff RE matches a part of it."
@@ -921,6 +956,11 @@ ARG is passed to the first function."
     (when win
       (set-window-start win (or point (point))))))
 
+(defun gnus-annotation-in-region-p (b e)
+  (if (= b e)
+      (eq (cadr (memq 'gnus-undeletable (text-properties-at b))) t) 
+    (text-property-any b e 'gnus-undeletable t)))
+
 (provide 'gnus-util)
 
 ;;; gnus-util.el ends here