Mercurial > hg > xemacs-beta

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b9
author cvs
date Mon, 13 Aug 2007 09:21:54 +0200
parents fe104dbd9147
children 9f59509498e1
comparison
equal deleted inserted replaced
113:2ec2fe4a4c89 114:8619ce7e4c50
35 ;; of Kyle Jones' itimer package. 35 ;; of Kyle Jones' itimer package.
36 36
37 ;;; JTL: This is in a wide part reworked for XEmacs so it won't use 37 ;;; JTL: This is in a wide part reworked for XEmacs so it won't use
38 ;;; the old mechanism for specifying what is to be displayed. 38 ;;; the old mechanism for specifying what is to be displayed.
39 ;;; The starting variable to look at is `display-time-form-list' 39 ;;; The starting variable to look at is `display-time-form-list'
40
41 ;;; Thanks to Mike Scheidler for the idea to make the time led's fore- and
42 ;;; background color customizable
40 43
41 ;;; Code: 44 ;;; Code:
42 45
43 (require 'itimer) 46 (require 'itimer)
44 47
139 ;; wake up exactly at the minute boundary. But that's just a little 142 ;; wake up exactly at the minute boundary. But that's just a little
140 ;; more work than it's worth... 143 ;; more work than it's worth...
141 (start-itimer "display-time" 'display-time-function 144 (start-itimer "display-time" 'display-time-function
142 display-time-interval display-time-interval)) 145 display-time-interval display-time-interval))
143 146
147 (defun display-time-stop ()
148 (interactive)
149 (delete-itimer "display-time")
150 (setq display-time-string nil))
151
144 (defcustom display-time-show-icons-maybe t 152 (defcustom display-time-show-icons-maybe t
145 "Use icons for time, load and mail status if possible 153 "Use icons for time, load and mail status if possible
146 and not specified different explicitely" 154 and not specified different explicitely"
147 :group 'display-time 155 :group 'display-time
148 :type 'boolean) 156 :type 'boolean)
161 (and in the modeline if display-time-show-icons-maybe is nil) 169 (and in the modeline if display-time-show-icons-maybe is nil)
162 if display-time-echo-area is t" 170 if display-time-echo-area is t"
163 :group 'display-time 171 :group 'display-time
164 :type 'string) 172 :type 'string)
165 173
166 (defcustom display-time-display-pad t 174 (defcustom display-time-display-pad "grey35"
167 "Wether the load indicator is displayed with a trapezoidal \"pad\" 175 "How the load indicator's trapezoidal \"pad\" is to be displayed.
168 in the background" 176 This can be 'transparent or a string describing the color it should have"
169 :group 'display-time 177 :group 'display-time
170 :type 'boolean) 178 :type '(choice :tag "Value"
179 (const transparent)
180 (string :tag "Color")))
181
182 (defcustom display-time-display-time-foreground "firebrick"
183 "How the time LEDs foreground is to be displayed.
184 This can be 'modeline (foreground color of the Modeline)
185 or a string describing the color it should have"
186 :group 'display-time
187 :type '(choice :tag "Value"
188 (const modline)
189 (string :tag "Color")))
190
191 (defcustom display-time-display-time-background 'transparent
192 "How the time LEDs background is to be displayed.
193 This can be 'transparent or a string describing the color it should have"
194 :group 'display-time
195 :type '(choice :tag "Value"
196 (const transparent)
197 (string :tag "Color")))
198
199
200 (defvar display-time-display-pad-old nil)
201
202 (defvar display-time-display-time-fg-old nil)
203
204 (defvar display-time-display-time-bg-old nil)
171 205
172 (defcustom display-time-load-list 206 (defcustom display-time-load-list
173 (list 0.2 0.5 0.8 1.1 1.8 2.6) 207 (list 0.2 0.5 0.8 1.1 1.8 2.6)
174 "*A list giving six thresholds for the load 208 "*A list giving six thresholds for the load
175 which correspond to the six different icons to be displayed 209 which correspond to the six different icons to be displayed
176 as a load indicator" 210 as a load indicator"
177 :group 'display-time 211 :group 'display-time
178 :type '(list (number :tag "Threshold 1 load") 212 :type '(list (number :tag "Threshold 1")
179 (number :tag "Threshold 2 load") 213 (number :tag "Threshold 2")
180 (number :tag "Threshold 3 load") 214 (number :tag "Threshold 3")
181 (number :tag "Threshold 4 load") 215 (number :tag "Threshold 4")
182 (number :tag "Threshold 5 load") 216 (number :tag "Threshold 5")
183 (number :tag "Threshold 6 load"))) 217 (number :tag "Threshold 6")))
184 218
185 (defun display-time-string-to-char-list (str) 219 (defun display-time-string-to-char-list (str)
186 (mapcar (function identity) str)) 220 (mapcar (function identity) str))
187 221
188 (if (featurep 'xpm) 222 (defun display-time-generate-load-glyphs (&optional force)
223 (let* ((pad-color (if (symbolp display-time-display-pad)
224 (list "pad-color" '(face-background 'modeline))
225 (list "pad-color" display-time-display-pad)))
226 (xpm-color-symbols (append (list pad-color) xpm-color-symbols)))
227 (if (and (featurep 'xpm)
228 (or force (not (equal display-time-display-pad
229 display-time-display-pad-old))))
230 (progn
231 (setq display-time-load-0.0-glyph
232 (cons (make-extent nil nil)
233 (make-glyph
234 (concat display-time-icons-dir "l-0.0.xpm"))))
235 (setq display-time-load-0.5-glyph
236 (cons (make-extent nil nil)
237 (make-glyph
238 (concat display-time-icons-dir "l-0.5.xpm"))))
239 (setq display-time-load-1.0-glyph
240 (cons (make-extent nil nil)
241 (make-glyph
242 (concat display-time-icons-dir "l-1.0.xpm"))))
243 (setq display-time-load-1.5-glyph
244 (cons (make-extent nil nil)
245 (make-glyph
246 (concat display-time-icons-dir "l-1.5.xpm"))))
247 (setq display-time-load-2.0-glyph
248 (cons (make-extent nil nil)
249 (make-glyph
250 (concat display-time-icons-dir "l-2.0.xpm"))))
251 (setq display-time-load-2.5-glyph
252 (cons (make-extent nil nil)
253 (make-glyph
254 (concat display-time-icons-dir "l-2.5.xpm"))))
255 (setq display-time-load-3.0-glyph
256 (cons (make-extent nil nil)
257 (make-glyph
258 (concat display-time-icons-dir "l-3.0.xpm"))))
259 (setq display-time-display-pad-old display-time-display-pad)
260 ))))
261
262
263 (defun display-time-generate-time-glyphs (&optional force)
264 (let* ((ledbg (if (symbolp display-time-display-time-background)
265 (list "ledbg" '(face-background 'modeline))
266 (list "ledbg" display-time-display-time-background)))
267 (ledfg (if (symbolp display-time-display-time-foreground)
268 (list "ledfg" '(face-foreground 'modeline))
269 (list "ledfg" display-time-display-time-foreground)))
270 (xpm-color-symbols (append (list ledbg)
271 (list ledfg) xpm-color-symbols)))
272 (if (and (featurep 'xpm)
273 (or force (not (equal display-time-display-time-background
274 display-time-display-time-bg-old))
275 (not (equal display-time-display-time-foreground
276 display-time-display-time-fg-old))))
277 (progn
278 (setq display-time-1-glyph
279 (cons (make-extent nil nil)
280 (make-glyph (concat display-time-icons-dir "1.xpm"))))
281 (setq display-time-2-glyph
282 (cons (make-extent nil nil)
283 (make-glyph (concat display-time-icons-dir "2.xpm"))))
284 (setq display-time-3-glyph
285 (cons (make-extent nil nil)
286 (make-glyph (concat display-time-icons-dir "3.xpm"))))
287 (setq display-time-4-glyph
288 (cons (make-extent nil nil)
289 (make-glyph (concat display-time-icons-dir "4.xpm"))))
290 (setq display-time-5-glyph
291 (cons (make-extent nil nil)
292 (make-glyph (concat display-time-icons-dir "5.xpm"))))
293 (setq display-time-6-glyph
294 (cons (make-extent nil nil)
295 (make-glyph (concat display-time-icons-dir "6.xpm"))))
296 (setq display-time-7-glyph
297 (cons (make-extent nil nil)
298 (make-glyph (concat display-time-icons-dir "7.xpm"))))
299 (setq display-time-8-glyph
300 (cons (make-extent nil nil)
301 (make-glyph (concat display-time-icons-dir "8.xpm"))))
302 (setq display-time-9-glyph
303 (cons (make-extent nil nil)
304 (make-glyph (concat display-time-icons-dir "9.xpm"))))
305 (setq display-time-0-glyph
306 (cons (make-extent nil nil)
307 (make-glyph (concat display-time-icons-dir "0.xpm"))))
308 (setq display-time-:-glyph
309 (cons (make-extent nil nil)
310 (make-glyph (concat display-time-icons-dir "dp.xpm"))))
311 (setq display-time-am-glyph
312 (cons (make-extent nil nil)
313 (make-glyph (concat display-time-icons-dir "am.xpm"))))
314 (setq display-time-pm-glyph
315 (cons (make-extent nil nil)
316 (make-glyph (concat display-time-icons-dir "pm.xpm"))))
317 (setq display-time-display-time-fg-old
318 display-time-display-time-foreground
319 display-time-display-time-bg-old
320 display-time-display-time-background)
321 ))))
322
323 (if (featurep 'xpm)
189 (progn 324 (progn
190 (defvar display-time-mail-sign 325 (defvar display-time-mail-sign
191 (cons (make-extent nil nil) 326 (cons (make-extent nil nil)
192 (make-glyph (concat display-time-icons-dir "letter.xpm")))) 327 (make-glyph (concat display-time-icons-dir "letter.xpm"))))
193 (defvar display-time-no-mail-sign 328 (defvar display-time-no-mail-sign
194 (cons (make-extent nil nil) 329 (cons (make-extent nil nil)
195 (make-glyph (concat display-time-icons-dir "no-letter.xpm")))) 330 (make-glyph (concat display-time-icons-dir "no-letter.xpm"))))
196 (defvar display-time-1-glyph 331 (defvar display-time-1-glyph nil)
197 (cons (make-extent nil nil) 332 (defvar display-time-2-glyph nil)
198 (make-glyph (concat display-time-icons-dir "1.xpm")))) 333 (defvar display-time-3-glyph nil)
199 (defvar display-time-2-glyph 334 (defvar display-time-4-glyph nil)
200 (cons (make-extent nil nil) 335 (defvar display-time-5-glyph nil)
201 (make-glyph (concat display-time-icons-dir "2.xpm")))) 336 (defvar display-time-6-glyph nil)
202 (defvar display-time-3-glyph 337 (defvar display-time-7-glyph nil)
203 (cons (make-extent nil nil) 338 (defvar display-time-8-glyph nil)
204 (make-glyph (concat display-time-icons-dir "3.xpm")))) 339 (defvar display-time-9-glyph nil)
205 (defvar display-time-4-glyph 340 (defvar display-time-0-glyph nil)
206 (cons (make-extent nil nil) 341 (defvar display-time-:-glyph nil)
207 (make-glyph (concat display-time-icons-dir "4.xpm")))) 342 (defvar display-time-am-glyph nil)
208 (defvar display-time-5-glyph 343 (defvar display-time-pm-glyph nil)
209 (cons (make-extent nil nil) 344 (defvar display-time-load-0.0-glyph nil)
210 (make-glyph (concat display-time-icons-dir "5.xpm")))) 345 (defvar display-time-load-0.5-glyph nil)
211 (defvar display-time-6-glyph 346 (defvar display-time-load-1.0-glyph nil)
212 (cons (make-extent nil nil) 347 (defvar display-time-load-1.5-glyph nil)
213 (make-glyph (concat display-time-icons-dir "6.xpm")))) 348 (defvar display-time-load-2.0-glyph nil)
214 (defvar display-time-7-glyph 349 (defvar display-time-load-2.5-glyph nil)
215 (cons (make-extent nil nil) 350 (defvar display-time-load-3.0-glyph nil)
216 (make-glyph (concat display-time-icons-dir "7.xpm")))) 351 (display-time-generate-time-glyphs 'force)
217 (defvar display-time-8-glyph 352 (display-time-generate-load-glyphs 'force)
218 (cons (make-extent nil nil)
219 (make-glyph (concat display-time-icons-dir "8.xpm"))))
220 (defvar display-time-9-glyph
221 (cons (make-extent nil nil)
222 (make-glyph (concat display-time-icons-dir "9.xpm"))))
223 (defvar display-time-0-glyph
224 (cons (make-extent nil nil)
225 (make-glyph (concat display-time-icons-dir "0.xpm"))))
226 (defvar display-time-:-glyph
227 (cons (make-extent nil nil)
228 (make-glyph (concat display-time-icons-dir "dp.xpm"))))
229 (defvar display-time-load-0.0-glyph
230 (cons (make-extent nil nil)
231 (make-glyph (concat display-time-icons-dir "l-0.0.xpm"))))
232 (defvar display-time-load-0.5-glyph
233 (cons (make-extent nil nil)
234 (make-glyph (concat display-time-icons-dir "l-0.5.xpm"))))
235 (defvar display-time-load-1.0-glyph
236 (cons (make-extent nil nil)
237 (make-glyph (concat display-time-icons-dir "l-1.0.xpm"))))
238 (defvar display-time-load-1.5-glyph
239 (cons (make-extent nil nil)
240 (make-glyph (concat display-time-icons-dir "l-1.5.xpm"))))
241 (defvar display-time-load-2.0-glyph
242 (cons (make-extent nil nil)
243 (make-glyph (concat display-time-icons-dir "l-2.0.xpm"))))
244 (defvar display-time-load-2.5-glyph
245 (cons (make-extent nil nil)
246 (make-glyph (concat display-time-icons-dir "l-2.5.xpm"))))
247 (defvar display-time-load-3.0-glyph
248 (cons (make-extent nil nil)
249 (make-glyph (concat display-time-icons-dir "l-3.0.xpm"))))
250 (defvar display-time-load-0.0-jtl-glyph
251 (cons (make-extent nil nil)
252 (make-glyph (concat display-time-icons-dir "l-jtl-0.0.xpm"))))
253 (defvar display-time-load-0.5-jtl-glyph
254 (cons (make-extent nil nil)
255 (make-glyph (concat display-time-icons-dir "l-jtl-0.5.xpm"))))
256 (defvar display-time-load-1.0-jtl-glyph
257 (cons (make-extent nil nil)
258 (make-glyph (concat display-time-icons-dir "l-jtl-1.0.xpm"))))
259 (defvar display-time-load-1.5-jtl-glyph
260 (cons (make-extent nil nil)
261 (make-glyph (concat display-time-icons-dir "l-jtl-1.5.xpm"))))
262 (defvar display-time-load-2.0-jtl-glyph
263 (cons (make-extent nil nil)
264 (make-glyph (concat display-time-icons-dir "l-jtl-2.0.xpm"))))
265 (defvar display-time-load-2.5-jtl-glyph
266 (cons (make-extent nil nil)
267 (make-glyph (concat display-time-icons-dir "l-jtl-2.5.xpm"))))
268 (defvar display-time-load-3.0-jtl-glyph
269 (cons (make-extent nil nil)
270 (make-glyph (concat display-time-icons-dir "l-jtl-3.0.xpm"))))
271 (defvar display-time-am-glyph
272 (cons (make-extent nil nil)
273 (make-glyph (concat display-time-icons-dir "am.xpm"))))
274 (defvar display-time-pm-glyph
275 (cons (make-extent nil nil)
276 (make-glyph (concat display-time-icons-dir "pm.xpm"))))
277 )) 353 ))
278
279 354
280 (defun display-time-can-do-graphical-display (&optional textual) 355 (defun display-time-can-do-graphical-display (&optional textual)
281 (and display-time-show-icons-maybe 356 (and display-time-show-icons-maybe
282 (not textual) 357 (not textual)
283 (eq (console-type) 'x) 358 (eq (console-type) 'x)
287 362
288 (defun display-time-convert-num (time-string &optional textual) 363 (defun display-time-convert-num (time-string &optional textual)
289 (let ((list (display-time-string-to-char-list time-string)) 364 (let ((list (display-time-string-to-char-list time-string))
290 elem tmp) 365 elem tmp)
291 (if (not (display-time-can-do-graphical-display textual)) time-string 366 (if (not (display-time-can-do-graphical-display textual)) time-string
367 (display-time-generate-time-glyphs)
292 (while (setq elem (pop list)) 368 (while (setq elem (pop list))
293 (push (eval (intern-soft (concat "display-time-" 369 (push (eval (intern-soft (concat "display-time-"
294 (char-to-string elem) 370 (char-to-string elem)
295 "-glyph"))) tmp)) 371 "-glyph"))) tmp))
296 (reverse tmp)))) 372 (reverse tmp))))
306 (cons 3.0 (caddr (cdddr display-time-load-list))) 382 (cons 3.0 (caddr (cdddr display-time-load-list)))
307 (cons 100000 100000))) 383 (cons 100000 100000)))
308 result elem) 384 result elem)
309 (if (not (display-time-can-do-graphical-display textual)) 385 (if (not (display-time-can-do-graphical-display textual))
310 load-string 386 load-string
387 (display-time-generate-load-glyphs)
311 (while (>= load-number (cdr (setq elem (pop alist)))) 388 (while (>= load-number (cdr (setq elem (pop alist))))
312 (setq result (eval (intern-soft (concat 389 (setq result (eval (intern-soft (concat
313 "display-time-load-" 390 "display-time-load-"
314 (number-to-string (car elem)) 391 (number-to-string (car elem))
315 (if display-time-display-pad "-jtl")
316 "-glyph"))))) 392 "-glyph")))))
317 result))) 393 result)))
318 394
319 (defun display-time-convert-am-pm (ampm-string &optional textual) 395 (defun display-time-convert-am-pm (ampm-string &optional textual)
320 (if (not (display-time-can-do-graphical-display textual)) 396 (if (not (display-time-can-do-graphical-display textual))
408 normally be a small icon which changes depending if 484 normally be a small icon which changes depending if
409 there is new mail or not. 485 there is new mail or not.
410 486
411 mail-text: The same as above, but will not use a glyph" 487 mail-text: The same as above, but will not use a glyph"
412 :group 'display-time 488 :group 'display-time
413 :type '(repeat (choice :tag "Toggle Symbol/String" 489 :type '(repeat (choice :tag "Symbol/String"
414 (const :tag "Date" date) 490 (const :tag "Date" date)
415 (const :tag "Time" time) 491 (const :tag "Time" time)
416 (const :tag "Time (text)" time-text) 492 (const :tag "Time (text)" time-text)
417 (const :tag "24 hour format" 24-hours) 493 (const :tag "24 hour format" 24-hours)
418 (const :tag "24 hour format (text)" 24-hours-text) 494 (const :tag "24 hour format (text)" 24-hours-text)