X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;ds=inline;f=lisp%2Fgnus-util.el;h=c599ba8636a4b46e16c8261b0e12406b227dbd0b;hb=aef74cc46d606bb69682a499643bc158186eef00;hp=0c633708f4d0ea56f774c4f870a74fb144718a8a;hpb=0af3d93431c5e085cd31b85b650ee532668814f4;p=gnus

diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el
index 0c633708f..c599ba863 100644
--- a/lisp/gnus-util.el
+++ b/lisp/gnus-util.el
@@ -1,5 +1,6 @@
 ;;; gnus-util.el --- utility functions for Gnus
-;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
+;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -31,12 +32,15 @@
 ;;; Code:
 
 (require 'custom)
-(eval-when-compile (require 'cl))
+(eval-when-compile
+  (require 'cl)
+  ;; Fixme: this should be a gnus variable, not nnmail-.
+  (defvar nnmail-pathname-coding-system))
 (require 'nnheader)
-(require 'message)
 (require 'time-date)
 
 (eval-and-compile
+  (autoload 'message-fetch-field "message")
   (autoload 'rmail-insert-rmail-file-header "rmail")
   (autoload 'rmail-count-new-messages "rmail")
   (autoload 'rmail-show-message "rmail"))
@@ -49,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))
@@ -102,15 +106,15 @@
      (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))
+(defalias '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))
+(defalias 'gnus-point-at-eol
+  (if (fboundp 'point-at-eol)
+      'point-at-eol
+    'line-end-position))
 
 (defun gnus-delete-first (elt list)
   "Delete by side effect the first occurrence of ELT as a member of LIST."
@@ -164,8 +168,8 @@
 	(and (string-match "(.*" from)
 	     (setq name (substring from (1+ (match-beginning 0))
 				   (match-end 0)))))
-    ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
-    (list (or name from) (or address from))))
+    (list (if (string= name "") nil name) (or address from))))
+
 
 (defun gnus-fetch-field (field)
   "Return the value of the header FIELD of current article."
@@ -178,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."
@@ -189,22 +196,17 @@
 	(delete-char 1))
       (goto-char (next-single-property-change (point) prop nil (point-max))))))
 
+(require 'nnheader)
 (defun gnus-newsgroup-directory-form (newsgroup)
   "Make hierarchical directory name from NEWSGROUP name."
-  (let ((newsgroup (gnus-newsgroup-savable-name newsgroup))
-	(len (length newsgroup))
-	idx)
-    ;; If this is a foreign group, we don't want to translate the
-    ;; entire name.
-    (if (setq idx (string-match ":" newsgroup))
-	(aset newsgroup idx ?/)
-      (setq idx 0))
-    ;; Replace all occurrences of `.' with `/'.
-    (while (< idx len)
-      (when (= (aref newsgroup idx) ?.)
-	(aset newsgroup idx ?/))
-      (setq idx (1+ idx)))
-    newsgroup))
+  (let* ((newsgroup (gnus-newsgroup-savable-name newsgroup))
+	 (idx (string-match ":" newsgroup)))
+    (concat
+     (if idx (substring newsgroup 0 idx))
+     (if idx "/")
+     (nnheader-replace-chars-in-string
+      (if idx (substring newsgroup (1+ idx)) newsgroup)
+      ?. ?/))))
 
 (defun gnus-newsgroup-savable-name (group)
   ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group)
@@ -291,7 +293,9 @@
 
 (defun gnus-dd-mmm (messy-date)
   "Return a string like DD-MMM from a big messy string."
-  (format-time-string "%2d-%b" (safe-date-to-time messy-date)))
+  (condition-case ()
+      (format-time-string "%d-%b" (safe-date-to-time messy-date))
+    (error "  -   ")))
 
 (defmacro gnus-date-get-time (date)
   "Convert DATE string to Emacs time.
@@ -308,11 +312,11 @@ Cache the result as a text property stored in DATE."
 	     time)))))
 
 (defsubst gnus-time-iso8601 (time)
-  "Return a string of TIME in YYMMDDTHHMMSS format."
+  "Return a string of TIME in YYYYMMDDTHHMMSS format."
   (format-time-string "%Y%m%dT%H%M%S" time))
 
 (defun gnus-date-iso8601 (date)
-  "Convert the DATE to YYMMDDTHHMMSS."
+  "Convert the DATE to YYYYMMDDTHHMMSS."
   (condition-case ()
       (gnus-time-iso8601 (gnus-date-get-time date))
     (error "")))
@@ -381,7 +385,7 @@ jabbering all the time."
   "Return a list of Message-IDs in REFERENCES."
   (let ((beg 0)
 	ids)
-    (while (string-match "<[^>]+>" references beg)
+    (while (string-match "<[^> \t]+>" references beg)
       (push (substring references (match-beginning 0) (setq beg (match-end 0)))
 	    ids))
     (nreverse ids)))
@@ -448,14 +452,6 @@ If N, return the Nth ancestor instead."
 		     (file-name-nondirectory file))))
   (copy-file file to))
 
-(defun gnus-kill-all-overlays ()
-  "Delete all overlays in the current buffer."
-  (let* ((overlayss (overlay-lists))
-	 (buffer-read-only nil)
-	 (overlays (delq nil (nconc (car overlayss) (cdr overlayss)))))
-    (while overlays
-      (delete-overlay (pop overlays)))))
-
 (defvar gnus-work-buffer " *gnus work*")
 
 (defun gnus-set-work-buffer ()
@@ -478,21 +474,42 @@ 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)
-    `(lambda (t1 t2)
-       ,(gnus-make-sort-function-1 (reverse funs))))
+   ;; A list of functions.
+   ((or (cdr funs)
+	(listp (car funs)))
+    (gnus-byte-compile
+     `(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)
+	;; Do nothing.
+	)
+       (t
+	(error "Invalid sort spec: %s" function))))
+    (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'."
@@ -516,17 +533,20 @@ Bind `print-quoted' and `print-readably' to t while printing."
 
 (defun gnus-make-directory (directory)
   "Make DIRECTORY (and all its parents) if it doesn't exist."
-  (when (and directory
-	     (not (file-exists-p directory)))
-    (make-directory directory t))
+  (require 'nnmail)
+  (let ((file-name-coding-system nnmail-pathname-coding-system))
+    (when (and directory
+	       (not (file-exists-p directory)))
+      (make-directory directory t)))
   t)
 
 (defun gnus-write-buffer (file)
   "Write the current buffer's contents to FILE."
   ;; Make sure the directory exists.
   (gnus-make-directory (file-name-directory file))
-  ;; Write the buffer.
-  (write-region (point-min) (point-max) file nil 'quietly))
+  (let ((file-name-coding-system nnmail-pathname-coding-system))
+    ;; Write the buffer.
+    (write-region (point-min) (point-max) file nil 'quietly)))
 
 (defun gnus-delete-file (file)
   "Delete FILE if it exists."
@@ -545,7 +565,7 @@ Bind `print-quoted' and `print-readably' to t while printing."
     (save-excursion
       (save-restriction
 	(goto-char beg)
-	(while (re-search-forward "[ \t]*\n" end 'move)
+	(while (re-search-forward gnus-emphasize-whitespace-regexp end 'move)
 	  (gnus-put-text-property beg (match-beginning 0) prop val)
 	  (setq beg (point)))
 	(gnus-put-text-property beg (point) prop val)))))
@@ -561,7 +581,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
@@ -639,11 +659,68 @@ with potentially long computations."
 
 ;;; Functions for saving to babyl/mail files.
 
+(defvar rmail-default-rmail-file)
+(defun gnus-output-to-rmail (filename &optional ask)
+  "Append the current article to an Rmail file named FILENAME."
+  (require 'rmail)
+  ;; Most of these codes are borrowed from rmailout.el.
+  (setq filename (expand-file-name filename))
+  (setq rmail-default-rmail-file filename)
+  (let ((artbuf (current-buffer))
+	(tmpbuf (get-buffer-create " *Gnus-output*")))
+    (save-excursion
+      (or (get-file-buffer filename)
+	  (file-exists-p filename)
+	  (if (or (not ask)
+		  (gnus-yes-or-no-p
+		   (concat "\"" filename "\" does not exist, create it? ")))
+	      (let ((file-buffer (create-file-buffer filename)))
+		(save-excursion
+		  (set-buffer file-buffer)
+		  (rmail-insert-rmail-file-header)
+		  (let ((require-final-newline nil)
+			(coding-system-for-write mm-text-coding-system))
+		    (gnus-write-buffer filename)))
+		(kill-buffer file-buffer))
+	    (error "Output file does not exist")))
+      (set-buffer tmpbuf)
+      (erase-buffer)
+      (insert-buffer-substring artbuf)
+      (gnus-convert-article-to-rmail)
+      ;; Decide whether to append to a file or to an Emacs buffer.
+      (let ((outbuf (get-file-buffer filename)))
+	(if (not outbuf)
+	    (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)
+		(msg (and (boundp 'rmail-current-message)
+			  (symbol-value 'rmail-current-message))))
+	    ;; If MSG is non-nil, buffer is in RMAIL mode.
+	    (when msg
+	      (widen)
+	      (narrow-to-region (point-max) (point-max)))
+	    (insert-buffer-substring tmpbuf)
+	    (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)
+		(rmail-select-summary
+		 (rmail-update-summary)))
+	      (rmail-count-new-messages t)
+	      (rmail-show-message msg))
+	    (save-buffer)))))
+    (kill-buffer tmpbuf)))
+
 (defun gnus-output-to-mail (filename &optional ask)
   "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))
@@ -654,7 +731,8 @@ with potentially long computations."
 	    (let ((file-buffer (create-file-buffer filename)))
 	      (save-excursion
 		(set-buffer file-buffer)
-		(let ((require-final-newline nil))
+		(let ((require-final-newline nil)
+		      (coding-system-for-write mm-text-coding-system))
 		  (gnus-write-buffer filename)))
 	      (kill-buffer file-buffer))
 	  (error "Output file does not exist")))
@@ -682,7 +760,8 @@ with potentially long computations."
 		    (insert "\n"))
 		  (insert "\n"))
 		(goto-char (point-max))
-		(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))
@@ -718,89 +797,89 @@ ARG is passed to the first function."
     (unwind-protect
 	(apply 'run-hooks funcs)
       (set-buffer buf))))
-  
+
 ;;;
 ;;; .netrc and .authinforc parsing
 ;;;
 
-(defvar gnus-netrc-syntax-table
-  (let ((table (copy-syntax-table text-mode-syntax-table)))
-    (modify-syntax-entry ?@ "w" table)
-    (modify-syntax-entry ?- "w" table)
-    (modify-syntax-entry ?_ "w" table)
-    (modify-syntax-entry ?! "w" table)
-    (modify-syntax-entry ?. "w" table)
-    (modify-syntax-entry ?, "w" table)
-    (modify-syntax-entry ?: "w" table)
-    (modify-syntax-entry ?\; "w" table)
-    (modify-syntax-entry ?% "w" table)
-    (modify-syntax-entry ?) "w" table)
-    (modify-syntax-entry ?( "w" table)
-    table)
-  "Syntax table when parsing .netrc files.")
-
 (defun gnus-parse-netrc (file)
   "Parse FILE and return an list of all entries in the file."
-  (if (not (file-exists-p file))
-      ()
-    (save-excursion
+  (when (file-exists-p file)
+    (with-temp-buffer
       (let ((tokens '("machine" "default" "login"
-		      "password" "account" "macdef" "force"))
+		      "password" "account" "macdef" "force"
+		      "port"))
 	    alist elem result pair)
-	(nnheader-set-temp-buffer " *netrc*")
-	(unwind-protect
-	    (progn
-	      (set-syntax-table gnus-netrc-syntax-table)
-	      (insert-file-contents file)
-	      (goto-char (point-min))
-	      ;; Go through the file, line by line.
-	      (while (not (eobp))
-		(narrow-to-region (point) (gnus-point-at-eol))
-		;; For each line, get the tokens and values.
-		(while (not (eobp))
-		  (skip-chars-forward "\t ")
-		  (unless (eobp)
-		    (setq elem (buffer-substring
-				(point) (progn (forward-sexp 1) (point))))
-		    (cond
-		     ((equal elem "macdef")
-		      ;; We skip past the macro definition.
-		      (widen)
-		      (while (and (zerop (forward-line 1))
-				  (looking-at "$")))
-		      (narrow-to-region (point) (point)))
-		     ((member elem tokens)
-		      ;; Tokens that don't have a following value are ignored,
-		      ;; except "default".
-		      (when (and pair (or (cdr pair)
-					  (equal (car pair) "default")))
-			(push pair alist))
-		      (setq pair (list elem)))
-		     (t
-		      ;; Values that haven't got a preceding token are ignored.
-		      (when pair
-			(setcdr pair elem)
-			(push pair alist)
-			(setq pair nil))))))
-		(if alist
-		    (push (nreverse alist) result))
-		(setq alist nil
-		      pair nil)
-		(widen)
-		(forward-line 1))
-	      (nreverse result))
-	  (kill-buffer " *netrc*"))))))
-
-(defun gnus-netrc-machine (list machine)
-  "Return the netrc values from LIST for MACHINE or for the default entry."
-  (let ((rest list))
-    (while (and list
-		(not (equal (cdr (assoc "machine" (car list))) machine)))
+	(insert-file-contents file)
+	(goto-char (point-min))
+	;; Go through the file, line by line.
+	(while (not (eobp))
+	  (narrow-to-region (point) (gnus-point-at-eol))
+	  ;; For each line, get the tokens and values.
+	  (while (not (eobp))
+	    (skip-chars-forward "\t ")
+	    ;; Skip lines that begin with a "#".
+	    (if (eq (char-after) ?#)
+		(goto-char (point-max))
+	      (unless (eobp)
+		(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.
+		  (widen)
+		  (while (and (zerop (forward-line 1))
+			      (looking-at "$")))
+		  (narrow-to-region (point) (point)))
+		 ((member elem tokens)
+		  ;; Tokens that don't have a following value are ignored,
+		  ;; except "default".
+		  (when (and pair (or (cdr pair)
+				      (equal (car pair) "default")))
+		    (push pair alist))
+		  (setq pair (list elem)))
+		 (t
+		  ;; Values that haven't got a preceding token are ignored.
+		  (when pair
+		    (setcdr pair elem)
+		    (push pair alist)
+		    (setq pair nil)))))))
+	  (when alist
+	    (push (nreverse alist) result))
+	  (setq alist nil
+		pair nil)
+	  (widen)
+	  (forward-line 1))
+	(nreverse result)))))
+
+(defun gnus-netrc-machine (list machine &optional port defaultport)
+  "Return the netrc values from LIST for MACHINE or for the default entry.
+If PORT specified, only return entries with matching port tokens.
+Entries without port tokens default to DEFAULTPORT."
+  (let ((rest list)
+	result)
+    (while list
+      (when (equal (cdr (assoc "machine" (car list))) machine)
+	(push (car list) result))
       (pop list))
-    (car (or list
-	     (progn (while (and rest (not (assoc "default" (car rest))))
-		      (pop rest))
-		    rest)))))
+    (unless result
+      ;; No machine name matches, so we look for default entries.
+      (while rest
+	(when (assoc "default" (car rest))
+	  (push (car rest) result))
+	(pop rest)))
+    (when result
+      (setq result (nreverse result))
+      (while (and result
+		  (not (equal (or port defaultport "nntp")
+			      (or (gnus-netrc-get (car result) "port")
+				  defaultport "nntp"))))
+	(pop result))
+      (car result))))
 
 (defun gnus-netrc-get (alist type)
   "Return the value of token TYPE from ALIST."
@@ -808,7 +887,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)
@@ -834,18 +913,22 @@ ARG is passed to the first function."
       (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)
+(if (fboundp 'assq-delete-all)
+    (defalias 'gnus-delete-alist 'assq-delete-all)
+  (defun gnus-delete-alist (key alist)
+    "Delete from ALIST all elements whose car is KEY.
+Return the modified alist."
+    (let (entry)
+      (while (setq entry (assq key alist))
+	(setq alist (delq entry alist)))
+      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."
@@ -853,6 +936,143 @@ 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)))
+
+(defun gnus-or (&rest elems)
+  "Return non-nil if any of the elements are non-nil."
+  (catch 'found
+    (while elems
+      (when (pop elems)
+	(throw 'found t)))))
+
+(defun gnus-and (&rest elems)
+  "Return non-nil if all of the elements are non-nil."
+  (catch 'found
+    (while elems
+      (unless (pop elems)
+	(throw 'found nil)))
+    t))
+
+(defun gnus-write-active-file (file hashtb &optional full-names)
+  (let ((coding-system-for-write nnmail-active-file-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
+			       sym
+			     (intern (gnus-group-real-name (symbol-name sym))))
+			   (or (cdr (symbol-value sym))
+			       (car (symbol-value sym)))
+			   (car (symbol-value sym))))))
+       hashtb)
+      (goto-char (point-max))
+      (while (search-backward "\\." nil t)
+	(delete-char 1)))))
+
+(if (fboundp 'union)
+    (defalias 'gnus-union 'union)
+  (defun gnus-union (l1 l2)
+    "Set union of lists L1 and L2."
+    (cond ((null l1) l2)
+	  ((null l2) l1)
+	  ((equal l1 l2) l1)
+	  (t
+	   (or (>= (length l1) (length l2))
+	       (setq l1 (prog1 l2 (setq l2 l1))))
+	   (while l2
+	     (or (member (car l2) l1)
+		 (push (car l2) l1))
+	     (pop l2))
+	   l1))))
+
+(defun gnus-add-text-properties-when
+  (property value start end properties &optional object)
+  "Like `gnus-add-text-properties', only applied on where PROPERTY is VALUE."
+  (let (point)
+    (while (and start
+		(< start end) ;; XEmacs will loop for every when start=end.
+		(setq point (text-property-not-all start end property value)))
+      (gnus-add-text-properties start point properties object)
+      (setq start (text-property-any point end property value)))
+    (if start
+	(gnus-add-text-properties start end properties object))))
+
+(defun gnus-remove-text-properties-when
+  (property value start end properties &optional object)
+  "Like `remove-text-properties', only applied on where PROPERTY is VALUE."
+  (let (point)
+    (while (and start
+		(< start end)
+		(setq point (text-property-not-all start end property value)))
+      (remove-text-properties start point properties object)
+      (setq start (text-property-any point end property value)))
+    (if start
+	(remove-text-properties start end properties object))
+    t))
+
+(defun gnus-string-equal (x y)
+  "Like `string-equal', except it compares case-insensitively."
+  (and (= (length x) (length y))
+       (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