* gnus-util.el (gnus-string<): New function.
[gnus] / lisp / gnus-util.el
index 631e4be..80c36e2 100644 (file)
@@ -10,7 +10,7 @@
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -109,15 +109,6 @@ This is a compatibility function for different Emacsen."
         (set symbol nil))
      symbol))
 
-;; Added by Geoffrey T. Dairiki <dairiki@u.washington.edu>.  A safe way
-;; to limit the length of a string.  This function is necessary since
-;; `(substr "abc" 0 30)' pukes with "Args out of range".
-;; Fixme: Why not `truncate-string-to-width'?
-(defsubst gnus-limit-string (str width)
-  (if (> (length str) width)
-      (substring str 0 width)
-    str))
-
 (defsubst gnus-goto-char (point)
   (and point (goto-char point)))
 
@@ -263,6 +254,16 @@ is slower."
   (not (or (string< s1 s2)
           (string= s1 s2))))
 
+(defun gnus-string< (s1 s2)
+  "Return t if first arg string is less than second in lexicographic order.
+Case is significant if and only if `case-fold-search' is nil.
+Symbols are also allowed; their print names are used instead."
+  (if (symbolp s1) (setq s1 (symbol-name s1)))
+  (if (symbolp s2) (setq s2 (symbol-name s2)))
+  (if case-fold-search
+      (string-lessp (downcase s1) (downcase s2))
+    (string-lessp s1 s2)))
+
 ;;; Time functions.
 
 (defun gnus-file-newer-than (file date)
@@ -465,6 +466,79 @@ jabbering all the time."
   :group 'gnus-start
   :type 'integer)
 
+(defcustom gnus-add-timestamp-to-message nil
+  "Non-nil means add timestamps to messages that Gnus issues.
+If it is `log', add timestamps to only the messages that go into the
+\"*Messages*\" buffer (in XEmacs, it is the \" *Message-Log*\" buffer).
+If it is neither nil nor `log', add timestamps not only to log messages
+but also to the ones displayed in the echo area."
+  :version "23.0" ;; No Gnus
+  :group  'gnus-various
+  :type '(choice :format "%{%t%}:\n %[Value Menu%] %v"
+                (const :tag "Logged messages only" log)
+                (sexp :tag "All messages"
+                      :match (lambda (widget value) value)
+                      :value t)
+                (const :tag "No timestamp" nil)))
+
+(eval-when-compile
+  (defmacro gnus-message-with-timestamp-1 (format-string args)
+    (let ((timestamp '((format-time-string "%Y%m%dT%H%M%S" time)
+                      "." (format "%03d" (/ (nth 2 time) 1000)) "> ")))
+      (if (featurep 'xemacs)
+         `(let (str time)
+            (if (or (and (null ,format-string) (null ,args))
+                    (progn
+                      (setq str (apply 'format ,format-string ,args))
+                      (zerop (length str))))
+                (prog1
+                    (and ,format-string str)
+                  (clear-message nil))
+              (cond ((eq gnus-add-timestamp-to-message 'log)
+                     (setq time (current-time))
+                     (display-message 'no-log str)
+                     (log-message 'message (concat ,@timestamp str)))
+                    (gnus-add-timestamp-to-message
+                     (setq time (current-time))
+                     (display-message 'message (concat ,@timestamp str)))
+                    (t
+                     (display-message 'message str))))
+            str)
+       `(let (str time)
+          (cond ((eq gnus-add-timestamp-to-message 'log)
+                 (setq str (let (message-log-max)
+                             (apply 'message ,format-string ,args)))
+                 (when (and message-log-max
+                            (> message-log-max 0)
+                            (/= (length str) 0))
+                   (setq time (current-time))
+                   (with-current-buffer (get-buffer-create "*Messages*")
+                     (goto-char (point-max))
+                     (insert ,@timestamp str "\n")
+                     (forward-line (- message-log-max))
+                     (delete-region (point-min) (point))
+                     (goto-char (point-max))))
+                 str)
+                (gnus-add-timestamp-to-message
+                 (if (or (and (null ,format-string) (null ,args))
+                         (progn
+                           (setq str (apply 'format ,format-string ,args))
+                           (zerop (length str))))
+                     (prog1
+                         (and ,format-string str)
+                       (message nil))
+                   (setq time (current-time))
+                   (message "%s" (concat ,@timestamp str))
+                   str))
+                (t
+                 (apply 'message ,format-string ,args))))))))
+
+(defun gnus-message-with-timestamp (format-string &rest args)
+  "Display message with timestamp.  Arguments are the same as `message'.
+The `gnus-add-timestamp-to-message' variable controls how to add
+timestamp to message."
+  (gnus-message-with-timestamp-1 format-string args))
+
 (defun gnus-message (level &rest args)
   "If LEVEL is lower than `gnus-verbose' print ARGS using `message'.
 
@@ -473,7 +547,9 @@ Guideline for numbers:
 that take a long time, 7 - not very important messages on stuff, 9 - messages
 inside loops."
   (if (<= level gnus-verbose)
-      (apply 'message args)
+      (if gnus-add-timestamp-to-message
+         (apply 'gnus-message-with-timestamp args)
+       (apply 'message args))
     ;; We have to do this format thingy here even if the result isn't
     ;; shown - the return value has to be the same as the return value
     ;; from `message'.
@@ -707,9 +783,9 @@ Bind `print-quoted' and `print-readably' to t, and `print-length' and
 
 (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))
   (let ((file-name-coding-system nnmail-pathname-coding-system))
+    ;; Make sure the directory exists.
+    (gnus-make-directory (file-name-directory file))
     ;; Write the buffer.
     (write-region (point-min) (point-max) file nil 'quietly)))
 
@@ -1092,7 +1168,7 @@ Return the modified alist."
     `(setq ,alist (delq (,fun ,key ,alist) ,alist))))
 
 (defun gnus-globalify-regexp (re)
-  "Return a regexp that matches a whole line, iff RE matches a part of it."
+  "Return a regexp that matches a whole line, if RE matches a part of it."
   (concat (unless (string-match "^\\^" re) "^.*")
          re
          (unless (string-match "\\$$" re) ".*$")))
@@ -1124,8 +1200,12 @@ Return the modified alist."
     t))
 
 (defun gnus-write-active-file (file hashtb &optional full-names)
+  ;; `coding-system-for-write' should be `raw-text' or equivalent.
   (let ((coding-system-for-write nnmail-active-file-coding-system))
     (with-temp-file file
+      ;; The buffer should be in the unibyte mode because group names
+      ;; are ASCII text or encoded non-ASCII text (i.e., unibyte).
+      (mm-disable-multibyte)
       (mapatoms
        (lambda (sym)
         (when (and sym