X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-util.el;h=6c329c037f9b1fc9ab636a8900b13aa274df84db;hb=8cfa576451fc393ec8ad0de58a89a0afd4343fbf;hp=80496f8689fdbe322865f7a619b9987ac830cb0c;hpb=93fd3c5fd9f215515162b7016beb25d30d10104b;p=elisp%2Fgnus.git-

diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el
index 80496f8..6c329c0 100644
--- a/lisp/gnus-util.el
+++ b/lisp/gnus-util.el
@@ -1,5 +1,5 @@
 ;;; gnus-util.el --- utility functions for Gnus
-;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -478,21 +478,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'."
@@ -561,7 +580,7 @@ Bind `print-quoted' and `print-readably' to t while printing."
 	(gnus-put-text-property
 	 b (setq b (next-single-property-change b 'gnus-face nil end))
 	 prop val)))))
-  
+
 ;;; Protected and atomic operations.  dmoore@ucsd.edu 21.11.1996
 ;;; The primary idea here is to try to protect internal datastructures
 ;;; from becoming corrupted when the user hits C-g, or if a hook or
@@ -647,7 +666,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)
@@ -698,7 +717,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))
@@ -773,7 +792,7 @@ ARG is passed to the first function."
     (unwind-protect
 	(apply 'run-hooks funcs)
       (set-buffer buf))))
-  
+
 ;;;
 ;;; .netrc and .authinforc parsing
 ;;;
@@ -863,7 +882,7 @@ ARG is passed to the first function."
 
 ;;; Various
 
-(defvar gnus-group-buffer) ; Compiler directive
+(defvar gnus-group-buffer)		; Compiler directive
 (defun gnus-alive-p ()
   "Say whether Gnus is running or not."
   (and (boundp 'gnus-group-buffer)
@@ -896,11 +915,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."
@@ -908,6 +928,17 @@ ARG is passed to the first function."
 	  re
 	  (unless (string-match "\\$$" re) ".*$")))
 
+(defun gnus-set-window-start (&optional point)
+  "Set the window start to POINT, or (point) if nil."
+  (let ((win (get-buffer-window (current-buffer) t)))
+    (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