diff lisp/packages/time.el @ 114:8619ce7e4c50 r20-1b9

Import from CVS: tag r20-1b9
author cvs
date Mon, 13 Aug 2007 09:21:54 +0200
parents fe104dbd9147
children 9f59509498e1
line wrap: on
line diff
--- a/lisp/packages/time.el	Mon Aug 13 09:20:50 2007 +0200
+++ b/lisp/packages/time.el	Mon Aug 13 09:21:54 2007 +0200
@@ -38,6 +38,9 @@
 ;;;      the old mechanism for specifying what is to be displayed.
 ;;;      The starting variable to look at is `display-time-form-list'
 
+;;; Thanks to Mike Scheidler for the idea to make the time led's fore- and
+;;; background color customizable
+
 ;;; Code:
 
 (require 'itimer)
@@ -141,6 +144,11 @@
   (start-itimer "display-time" 'display-time-function
 		display-time-interval display-time-interval))
 
+(defun display-time-stop ()
+  (interactive)
+  (delete-itimer "display-time")
+  (setq display-time-string nil))
+
 (defcustom display-time-show-icons-maybe t
   "Use icons for time, load and mail status if possible
 and not specified different explicitely"
@@ -163,11 +171,37 @@
 :group 'display-time
 :type 'string)
 
-(defcustom display-time-display-pad t
-  "Wether the load indicator is displayed with a trapezoidal \"pad\"
-in the background"
+(defcustom display-time-display-pad  "grey35"
+  "How the load indicator's trapezoidal \"pad\" is to be displayed.
+This can be 'transparent or a string describing the color it should have"
+  :group 'display-time
+  :type '(choice :tag "Value"
+		 (const transparent)
+		 (string :tag "Color")))
+
+(defcustom display-time-display-time-foreground  "firebrick"
+  "How the time LEDs foreground is to be displayed.
+This can be 'modeline (foreground color of the Modeline)
+or a string describing the color it should have"
   :group 'display-time
-  :type 'boolean)
+  :type '(choice :tag "Value"
+		 (const modline)
+		 (string :tag "Color")))
+
+(defcustom display-time-display-time-background  'transparent
+  "How the time LEDs background is to be displayed.
+This can be 'transparent or a string describing the color it should have"
+  :group 'display-time
+  :type '(choice :tag "Value"
+		 (const transparent)
+		 (string :tag "Color")))
+
+
+(defvar display-time-display-pad-old nil)
+
+(defvar display-time-display-time-fg-old nil)
+
+(defvar display-time-display-time-bg-old nil)
 
 (defcustom display-time-load-list
   (list 0.2 0.5 0.8 1.1 1.8 2.6)
@@ -175,108 +209,149 @@
 which correspond to the six different icons to be displayed
 as a load indicator"
   :group 'display-time
-  :type '(list (number :tag "Threshold 1 load")
-	       (number :tag "Threshold 2 load")
-	       (number :tag "Threshold 3 load")
-	       (number :tag "Threshold 4 load")
-	       (number :tag "Threshold 5 load")
-	       (number :tag "Threshold 6 load")))
+  :type '(list (number :tag "Threshold 1")
+	       (number :tag "Threshold 2")
+	       (number :tag "Threshold 3")
+	       (number :tag "Threshold 4")
+	       (number :tag "Threshold 5")
+	       (number :tag "Threshold 6")))
 
 (defun display-time-string-to-char-list (str)
   (mapcar (function identity) str))
 
-(if (featurep 'xpm)
+(defun display-time-generate-load-glyphs (&optional force)
+  (let* ((pad-color (if (symbolp display-time-display-pad)
+			(list "pad-color" '(face-background 'modeline))
+		      (list "pad-color" display-time-display-pad)))
+	 (xpm-color-symbols (append (list pad-color) xpm-color-symbols)))
+    (if (and (featurep 'xpm)
+	     (or force (not (equal display-time-display-pad
+				   display-time-display-pad-old))))
+	(progn
+	  (setq display-time-load-0.0-glyph
+		(cons (make-extent nil nil)
+		      (make-glyph
+		       (concat display-time-icons-dir "l-0.0.xpm"))))
+	  (setq display-time-load-0.5-glyph
+		(cons (make-extent nil nil)
+		      (make-glyph
+		       (concat display-time-icons-dir "l-0.5.xpm"))))
+	  (setq display-time-load-1.0-glyph
+		(cons (make-extent nil nil)
+		      (make-glyph
+		       (concat display-time-icons-dir "l-1.0.xpm"))))
+	  (setq display-time-load-1.5-glyph
+		(cons (make-extent nil nil)
+		      (make-glyph
+		       (concat display-time-icons-dir "l-1.5.xpm"))))
+	  (setq display-time-load-2.0-glyph
+		(cons (make-extent nil nil)
+		      (make-glyph
+		       (concat display-time-icons-dir "l-2.0.xpm"))))
+	  (setq display-time-load-2.5-glyph
+		(cons (make-extent nil nil)
+		      (make-glyph
+		       (concat display-time-icons-dir "l-2.5.xpm"))))
+	  (setq display-time-load-3.0-glyph
+	  (cons (make-extent nil nil)
+		(make-glyph
+		 (concat display-time-icons-dir "l-3.0.xpm"))))
+	  (setq display-time-display-pad-old display-time-display-pad)
+	  ))))
+
+
+(defun display-time-generate-time-glyphs (&optional force)
+  (let* ((ledbg (if (symbolp display-time-display-time-background)
+		    (list "ledbg" '(face-background 'modeline))
+		  (list "ledbg" display-time-display-time-background)))
+	 (ledfg (if (symbolp display-time-display-time-foreground)
+		    (list "ledfg" '(face-foreground 'modeline))
+		  (list "ledfg" display-time-display-time-foreground)))
+	 (xpm-color-symbols (append (list ledbg)
+				    (list ledfg) xpm-color-symbols)))
+    (if (and (featurep 'xpm)
+	     (or force (not (equal display-time-display-time-background
+				   display-time-display-time-bg-old))
+		 (not (equal display-time-display-time-foreground
+			     display-time-display-time-fg-old))))
+	(progn
+	  (setq display-time-1-glyph
+		(cons (make-extent nil nil)
+		      (make-glyph (concat display-time-icons-dir "1.xpm"))))
+	  (setq display-time-2-glyph
+		(cons (make-extent nil nil)
+		      (make-glyph (concat display-time-icons-dir "2.xpm"))))
+	  (setq display-time-3-glyph
+		(cons (make-extent nil nil)
+		      (make-glyph (concat display-time-icons-dir "3.xpm"))))
+	  (setq display-time-4-glyph
+		(cons (make-extent nil nil)
+		      (make-glyph (concat display-time-icons-dir "4.xpm"))))
+	  (setq display-time-5-glyph
+		(cons (make-extent nil nil)
+		      (make-glyph (concat display-time-icons-dir "5.xpm"))))
+	  (setq display-time-6-glyph
+		(cons (make-extent nil nil)
+		      (make-glyph (concat display-time-icons-dir "6.xpm"))))
+	  (setq display-time-7-glyph
+		(cons (make-extent nil nil)
+		      (make-glyph (concat display-time-icons-dir "7.xpm"))))
+	  (setq display-time-8-glyph
+		(cons (make-extent nil nil)
+		      (make-glyph (concat display-time-icons-dir "8.xpm"))))
+	  (setq display-time-9-glyph
+		(cons (make-extent nil nil)
+		      (make-glyph (concat display-time-icons-dir "9.xpm"))))
+	  (setq display-time-0-glyph
+		(cons (make-extent nil nil)
+		      (make-glyph (concat display-time-icons-dir "0.xpm"))))
+	  (setq display-time-:-glyph
+		(cons (make-extent nil nil)
+		      (make-glyph (concat display-time-icons-dir "dp.xpm"))))
+	  (setq display-time-am-glyph
+		(cons (make-extent nil nil)
+		      (make-glyph (concat display-time-icons-dir "am.xpm"))))
+	  (setq display-time-pm-glyph
+		(cons (make-extent nil nil)
+		      (make-glyph (concat display-time-icons-dir "pm.xpm"))))
+	  (setq display-time-display-time-fg-old
+		display-time-display-time-foreground
+		display-time-display-time-bg-old
+		display-time-display-time-background)
+	  ))))
+
+  (if (featurep 'xpm)
     (progn
       (defvar display-time-mail-sign
 	(cons (make-extent nil nil)
-	      (make-glyph	(concat display-time-icons-dir "letter.xpm"))))
+	      (make-glyph  (concat display-time-icons-dir "letter.xpm"))))
       (defvar display-time-no-mail-sign
 	(cons (make-extent nil nil)
-	      (make-glyph	(concat display-time-icons-dir "no-letter.xpm"))))
-      (defvar  display-time-1-glyph
-	(cons (make-extent nil nil)
-	      (make-glyph	(concat display-time-icons-dir "1.xpm"))))
-      (defvar display-time-2-glyph
-	(cons (make-extent nil nil)
-	      (make-glyph	(concat display-time-icons-dir "2.xpm"))))
-      (defvar display-time-3-glyph
-	(cons (make-extent nil nil)
-	      (make-glyph	(concat display-time-icons-dir "3.xpm"))))
-      (defvar display-time-4-glyph
-	(cons (make-extent nil nil)
-	      (make-glyph	(concat display-time-icons-dir "4.xpm"))))
-      (defvar display-time-5-glyph
-	(cons (make-extent nil nil)
-	      (make-glyph	(concat display-time-icons-dir "5.xpm"))))
-      (defvar display-time-6-glyph
-	(cons (make-extent nil nil)
-	      (make-glyph	(concat display-time-icons-dir "6.xpm"))))
-      (defvar display-time-7-glyph
-	(cons (make-extent nil nil)
-	      (make-glyph	(concat display-time-icons-dir "7.xpm"))))
-      (defvar display-time-8-glyph
-	(cons (make-extent nil nil)
-	      (make-glyph	(concat display-time-icons-dir "8.xpm"))))
-      (defvar display-time-9-glyph
-	(cons (make-extent nil nil)
-	      (make-glyph	(concat display-time-icons-dir "9.xpm"))))
-      (defvar display-time-0-glyph
-	(cons (make-extent nil nil)
-	      (make-glyph	(concat display-time-icons-dir "0.xpm"))))
-      (defvar display-time-:-glyph
-	(cons (make-extent nil nil)
-	      (make-glyph	(concat display-time-icons-dir "dp.xpm"))))
-      (defvar display-time-load-0.0-glyph
-	(cons (make-extent nil nil)
-	      (make-glyph	(concat display-time-icons-dir "l-0.0.xpm"))))
-      (defvar display-time-load-0.5-glyph
-	(cons (make-extent nil nil)
-	      (make-glyph	(concat display-time-icons-dir "l-0.5.xpm"))))
-      (defvar display-time-load-1.0-glyph
-	(cons (make-extent nil nil)
-	      (make-glyph	(concat display-time-icons-dir "l-1.0.xpm"))))
-      (defvar display-time-load-1.5-glyph
-	(cons (make-extent nil nil)
-	      (make-glyph	(concat display-time-icons-dir "l-1.5.xpm"))))
-      (defvar display-time-load-2.0-glyph
-	(cons (make-extent nil nil)
-	      (make-glyph	(concat display-time-icons-dir "l-2.0.xpm"))))
-      (defvar display-time-load-2.5-glyph
-	(cons (make-extent nil nil)
-	      (make-glyph	(concat display-time-icons-dir "l-2.5.xpm"))))
-      (defvar display-time-load-3.0-glyph
-	(cons (make-extent nil nil)
-	      (make-glyph	(concat display-time-icons-dir "l-3.0.xpm"))))
-      (defvar display-time-load-0.0-jtl-glyph
-	(cons (make-extent nil nil)
-	      (make-glyph	(concat display-time-icons-dir "l-jtl-0.0.xpm"))))
-      (defvar display-time-load-0.5-jtl-glyph
-	(cons (make-extent nil nil)
-	      (make-glyph	(concat display-time-icons-dir "l-jtl-0.5.xpm"))))
-      (defvar display-time-load-1.0-jtl-glyph
-	(cons (make-extent nil nil)
-	      (make-glyph	(concat display-time-icons-dir "l-jtl-1.0.xpm"))))
-      (defvar display-time-load-1.5-jtl-glyph
-	(cons (make-extent nil nil)
-	      (make-glyph	(concat display-time-icons-dir "l-jtl-1.5.xpm"))))
-      (defvar display-time-load-2.0-jtl-glyph
-	(cons (make-extent nil nil)
-	      (make-glyph	(concat display-time-icons-dir "l-jtl-2.0.xpm"))))
-      (defvar display-time-load-2.5-jtl-glyph
-	(cons (make-extent nil nil)
-	      (make-glyph	(concat display-time-icons-dir "l-jtl-2.5.xpm"))))
-      (defvar display-time-load-3.0-jtl-glyph
-	(cons (make-extent nil nil)
-	      (make-glyph	(concat display-time-icons-dir "l-jtl-3.0.xpm"))))
-      (defvar display-time-am-glyph
-	(cons (make-extent nil nil)
-	      (make-glyph	(concat display-time-icons-dir "am.xpm"))))
-      (defvar display-time-pm-glyph
-	(cons (make-extent nil nil)
-	      (make-glyph	(concat display-time-icons-dir "pm.xpm"))))
+	      (make-glyph  (concat display-time-icons-dir "no-letter.xpm"))))
+      (defvar display-time-1-glyph  nil)
+      (defvar display-time-2-glyph  nil)
+      (defvar display-time-3-glyph  nil)
+      (defvar display-time-4-glyph  nil)
+      (defvar display-time-5-glyph  nil)
+      (defvar display-time-6-glyph  nil)
+      (defvar display-time-7-glyph  nil)
+      (defvar display-time-8-glyph  nil)
+      (defvar display-time-9-glyph  nil)
+      (defvar display-time-0-glyph  nil)
+      (defvar display-time-:-glyph  nil)
+      (defvar display-time-am-glyph nil)
+      (defvar display-time-pm-glyph nil)
+      (defvar display-time-load-0.0-glyph nil)
+      (defvar display-time-load-0.5-glyph nil)
+      (defvar display-time-load-1.0-glyph nil)
+      (defvar display-time-load-1.5-glyph nil)
+      (defvar display-time-load-2.0-glyph nil)
+      (defvar display-time-load-2.5-glyph nil)
+      (defvar display-time-load-3.0-glyph nil)
+      (display-time-generate-time-glyphs 'force)
+      (display-time-generate-load-glyphs 'force)  
       ))
 
-
 (defun display-time-can-do-graphical-display (&optional textual)
   (and display-time-show-icons-maybe
        (not textual)
@@ -289,6 +364,7 @@
   (let ((list (display-time-string-to-char-list time-string))
 	elem tmp)
     (if (not (display-time-can-do-graphical-display textual)) time-string 
+      (display-time-generate-time-glyphs)
       (while (setq elem (pop list))
 	(push (eval (intern-soft (concat "display-time-"
 					 (char-to-string elem)
@@ -308,11 +384,11 @@
 	result 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))
-					 (if display-time-display-pad "-jtl")
 					 "-glyph")))))
       result)))
 
@@ -410,7 +486,7 @@
 	      
 mail-text:     The same as above, but will not use a glyph"
   :group 'display-time
-  :type '(repeat (choice :tag "Toggle Symbol/String"
+  :type '(repeat (choice :tag "Symbol/String"
 			 (const :tag "Date" date)
 			 (const :tag "Time" time)
 			 (const :tag "Time (text)" time-text)