diff lisp/packages/time.el @ 42:8b8b7f3559a2 r19-15b104

Import from CVS: tag r19-15b104
author cvs
date Mon, 13 Aug 2007 08:54:51 +0200
parents 7e54bd776075
children 131b0175ea99
line wrap: on
line diff
--- a/lisp/packages/time.el	Mon Aug 13 08:54:26 2007 +0200
+++ b/lisp/packages/time.el	Mon Aug 13 08:54:51 2007 +0200
@@ -23,6 +23,10 @@
 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 ;; 02111-1307, USA.
 
+;;; Version: 1.6   (I choose the version number starting at 1.1
+;;;                to indicate that 1.0 was the old version
+;;;                before I hacked away on it -JTL)
+
 ;;; Synched up with: Not synched with FSF.
 
 ;;; Commentary:
@@ -50,13 +54,6 @@
 in the XEmacs mode line or echo area."
   :group 'applications)
 
-(defcustom display-time-compatible nil 
-  "*This variable may be set to t to get the old behaviour of display-time.
-This means no display of a spiffy mail icon or use of the
-display-time-form-list instead of the old display-time-string-form."
-  :group 'display-time
-  :type 'boolean)
-
 (defcustom display-time-mail-file nil
   "*File name of mail inbox file, for indicating existence of new mail.
 Non-nil and not a string means don't check for mail.  nil means use
@@ -98,11 +95,17 @@
    "Time when mail file's file system was recorded to be down.
 If that file system seems to be up, the value is nil.")
 
-(defcustom display-time-ignore-read-mail nil
+(defcustom display-time-ignore-read-mail t
   "*Non-nil means displays the mail icon on any non-empty mailbox."
   :group 'display-time
   :type 'boolean)
 
+(defcustom display-time-balloon-show-mail-from t
+  "*Non-nil means displays the `From' lines of your new mail in the help balloon.
+This feature needs `balloon-help' to be loaded."
+  :group 'display-time
+  :type 'boolean)
+
 ;;;###autoload
 (defun display-time ()
   "Display current time, load level, and mail flag in mode line of each buffer.
@@ -196,6 +199,11 @@
 		 (const transparent)
 		 (string :tag "Color")))
 
+(defvar display-time-balloon-date-string nil)
+
+(defvar display-time-spool-file-modification nil)
+
+(defvar display-time-mail-header nil)
 
 (defvar display-time-display-pad-old nil)
 
@@ -216,6 +224,15 @@
 	       (number :tag "Threshold 5")
 	       (number :tag "Threshold 6")))
 
+(defcustom display-time-compatible nil 
+  "*This variable may be set to t to get the old behaviour of display-time.
+It should be considered obsolete and only be used if you really want the
+old behaviour (eq. you made extensive customizations yourself).
+This means no display of a spiffy mail icon or use of the
+display-time-form-list instead of the old display-time-string-form."
+  :group 'display-time
+  :type 'boolean)
+
 (defun display-time-string-to-char-list (str)
   (mapcar (function identity) str))
 
@@ -365,11 +382,48 @@
 	elem tmp)
     (if (not (display-time-can-do-graphical-display textual)) time-string 
       (display-time-generate-time-glyphs)
+      (setq display-time-balloon-date-string
+	    (format "%s, %s %s %s %s" dayname day monthname year
+		    (if (not (equal load ""))
+			(concat "-- Average load: " load)
+		      "")))
       (while (setq elem (pop list))
-	(push (eval (intern-soft (concat "display-time-"
+	(setq elem (eval (intern-soft (concat "display-time-"
 					 (char-to-string elem)
-					 "-glyph"))) tmp))
-      (reverse tmp)))) 
+					 "-glyph"))))
+	(set-extent-property (car elem) 'balloon-help 'display-time-balloon)
+	(push elem tmp))
+      (reverse tmp))))
+
+(defun display-time-balloon (&rest ciao)
+  (let ((header display-time-balloon-date-string)
+	header-ext)
+    (setq header-ext
+	  (make-extent 0 (length display-time-balloon-date-string)
+		       header))
+    (set-extent-property header-ext 'face 'red)
+    (set-extent-property header-ext 'duplicable t)
+    (concat header
+	    (if display-time-balloon-show-mail-from
+		(display-time-scan-spool-file)))))
+
+
+(defun display-time-scan-spool-file ()
+  (let* ((mail-spool-file (or display-time-mail-file
+			     (getenv "MAIL")
+			     (concat rmail-spool-directory
+				     (user-login-name))))
+	 (mod (nth 5 (file-attributes mail-spool-file))))
+    (if (equal mod display-time-spool-file-modification)
+	display-time-mail-header
+      (setq tmp  (exec-to-string
+		 (concat "grep \"^From \" " mail-spool-file)))
+      (if (equal tmp "") ()
+	(setq tmp (concat "\n\nYou have mail:\n-------------\n" tmp))
+	(setq tmp (substring tmp 0 (1- (length tmp)))))
+      (setq display-time-spool-file-modification mod)
+      (setq display-time-mail-header tmp))))
+
 
 (defun display-time-convert-load (load-string &optional textual)
   (let ((load-number (string-to-number load-string))
@@ -381,16 +435,14 @@
 		    (cons 2.5 (cadr (cdddr display-time-load-list)))
 		    (cons 3.0 (caddr (cdddr display-time-load-list)))
 		    (cons 100000 100000)))
-	result elem)
+	elem load-elem)
     (if (not (display-time-can-do-graphical-display textual))
 	load-string
       (display-time-generate-load-glyphs)
       (while (>= load-number (cdr (setq elem (pop alist))))
-	(setq result (eval (intern-soft (concat
-					 "display-time-load-"
-					 (number-to-string (car elem))
-					 "-glyph")))))
-      result)))
+	(setq load-elem elem))
+      (eval (intern-soft (concat "display-time-load-"
+				 (number-to-string (car load-elem)) "-glyph"))))))
 
 (defun display-time-convert-am-pm (ampm-string &optional textual)
   (if (not (display-time-can-do-graphical-display textual))