Importing gnus-5.6.22

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

diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el
index e48b14f..a0afd30 100644 (file)
--- a/lisp/gnus-util.el
+++ b/lisp/gnus-util.el
@@ -1,7 +1,7 @@
 ;;; gnus-util.el --- utility functions for Gnus
 ;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
 
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
@@ -340,12 +340,11 @@
       (yes-or-no-p prompt)
     (message "")))
 
-;; I suspect there's a better way, but I haven't taken the time to do
-;; it yet.  -erik selberg@cs.washington.edu
 (defun gnus-dd-mmm (messy-date)
-  "Return a string like DD-MMM from a big messy string"
+  "Return a string like DD-MMM from a big messy string."
   (let ((datevec (ignore-errors (timezone-parse-date messy-date))))
-    (if (not datevec)
+    (if (or (not datevec)
+           (string-equal "0" (aref datevec 1)))
        "??-???"
       (format "%2s-%s"
              (condition-case ()
@@ -377,7 +376,7 @@ Cache the result as a text property stored in DATE."
   (format-time-string "%Y%m%dT%H%M%S" time))
 
 (defun gnus-date-iso8601 (date)
-  "Convert the DATE to YYMMDDTHHMMSS"
+  "Convert the DATE to YYMMDDTHHMMSS."
   (condition-case ()
       (gnus-time-iso8601 (gnus-date-get-time date))
     (error "")))
@@ -604,14 +603,6 @@ Bind `print-quoted' and `print-readably' to t while printing."
   ;; Write the buffer.
   (write-region (point-min) (point-max) file nil 'quietly))
 
-(defmacro gnus-delete-assq (key list)
-  `(let ((listval (eval ,list)))
-     (setq ,list (delq (assq ,key listval) listval))))
-
-(defmacro gnus-delete-assoc (key list)
-  `(let ((listval ,list))
-     (setq ,list (delq (assoc ,key listval) listval))))
-
 (defun gnus-delete-file (file)
   "Delete FILE if it exists."
   (when (file-exists-p file)
@@ -630,10 +621,22 @@ Bind `print-quoted' and `print-readably' to t while printing."
       (save-restriction
        (goto-char beg)
        (while (re-search-forward "[ \t]*\n" end 'move)
-         (put-text-property beg (match-beginning 0) prop val)
+         (gnus-put-text-property beg (match-beginning 0) prop val)
          (setq beg (point)))
-       (put-text-property beg (point) prop val)))))
-
+       (gnus-put-text-property beg (point) prop val)))))
+
+(defun gnus-put-text-property-excluding-characters-with-faces (beg end
+                                                                  prop val)
+  "The same as `put-text-property', but don't put props on characters with the `gnus-face' property."
+  (let ((b beg))
+    (while (/= b end)
+      (when (get-text-property b 'gnus-face)
+       (setq b (next-single-property-change b 'gnus-face nil end)))
+      (when (/= b end)
+       (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
@@ -931,6 +934,35 @@ ARG is passed to the first function."
         (set-buffer gnus-group-buffer)
         (eq major-mode 'gnus-group-mode))))
 
+(defun gnus-remove-duplicates (list)
+  (let (new (tail list))
+    (while tail
+      (or (member (car tail) new)
+         (setq new (cons (car tail) new)))
+      (setq tail (cdr tail)))
+    (nreverse new)))
+
+(defun gnus-delete-if (predicate list)
+  "Delete elements from LIST that satisfy PREDICATE."
+  (let (out)
+    (while list
+      (when (funcall predicate (car list))
+       (push (car list) out))
+      (pop list))
+    (nreverse out)))
+
+(defun gnus-delete-alist (key alist)
+  "Delete all entries in ALIST that have a key eq to KEY."
+  (let (entry)
+    (while (setq entry (assq key alist))
+      (setq alist (delq entry alist)))
+    alist))
+
+(defmacro gnus-pull (key alist)
+  "Modify ALIST to be without KEY."
+  (unless (symbolp alist)
+    (error "Not a symbol: %s" alist))
+  `(setq ,alist (delq (assq ,key ,alist) ,alist)))
 
 (provide 'gnus-util)