Mercurial > hg > xemacs-beta

comparison lisp/packages/time.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 8b8b7f3559a2
children cf808b4c4290
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;;; time.el --- display time and load in mode line of Emacs. 1 ;;; time.el --- display time and load in mode line of Emacs.
2 2
3 ;; Copyright (C) 1985, 86, 87, 93, 94, 1996 Free Software Foundation, Inc. 3 ;; Copyright (C) 1985, 86, 87, 93, 94, 1996 Free Software Foundation, Inc.
4 4
5 ;; Maintainer: FSF, XEmacs add-ons (C) by Jens T. Lautenbacher 5 ;; Maintainer: FSF
6 ;; mail <jens@lemming0.lem.uni-karlsruhe.de>
7 ;; for comments/fixes about the enhancements.
8 6
9 ;; This file is part of XEmacs. 7 ;; This file is part of XEmacs.
10 8
11 ;; XEmacs is free software; you can redistribute it and/or modify it 9 ;; XEmacs is free software; you can redistribute it and/or modify it
12 ;; under the terms of the GNU General Public License as published by 10 ;; under the terms of the GNU General Public License as published by
21 ;; You should have received a copy of the GNU General Public License 19 ;; You should have received a copy of the GNU General Public License
22 ;; along with XEmacs; see the file COPYING. If not, write to the Free 20 ;; along with XEmacs; see the file COPYING. If not, write to the Free
23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 21 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
24 ;; 02111-1307, USA. 22 ;; 02111-1307, USA.
25 23
26 ;;; Version: 1.6 (I choose the version number starting at 1.1
27 ;;; to indicate that 1.0 was the old version
28 ;;; before I hacked away on it -JTL)
29
30 ;;; Synched up with: Not synched with FSF. 24 ;;; Synched up with: Not synched with FSF.
31 25
32 ;;; Commentary: 26 ;;; Commentary:
33 27
34 ;; Facilities to display current time/date and a new-mail indicator 28 ;; Facilities to display current time/date and a new-mail indicator
36 30
37 ;; See also reportmail.el. 31 ;; See also reportmail.el.
38 ;; This uses the XEmacs timeout-event mechanism, via a version 32 ;; This uses the XEmacs timeout-event mechanism, via a version
39 ;; of Kyle Jones' itimer package. 33 ;; of Kyle Jones' itimer package.
40 34
41 ;;; JTL: This is in a wide part reworked for XEmacs so it won't use
42 ;;; the old mechanism for specifying what is to be displayed.
43 ;;; The starting variable to look at is `display-time-form-list'
44
45 ;;; Thanks to Mike Scheidler for the idea to make the time led's fore- and
46 ;;; background color customizable
47
48 ;;; Code: 35 ;;; Code:
49 36
50 (require 'itimer) 37 (require 'itimer)
51 38
52 (defgroup display-time nil 39 (defvar display-time-mail-file nil
53 "Facilities to display the current time/date/load and a new-mail indicator
54 in the XEmacs mode line or echo area."
55 :group 'applications)
56
57 (defcustom display-time-mail-file nil
58 "*File name of mail inbox file, for indicating existence of new mail. 40 "*File name of mail inbox file, for indicating existence of new mail.
59 Non-nil and not a string means don't check for mail. nil means use 41 Non-nil and not a string means don't check for mail. nil means use
60 default, which is system-dependent, and is the same as used by Rmail." 42 default, which is system-dependent, and is the same as used by Rmail.")
61 :group 'display-time)
62 43
63 ;;;###autoload 44 ;;;###autoload
64 (defcustom display-time-day-and-date nil 45 (defvar display-time-day-and-date nil "\
65 "*Non-nil means \\[display-time] should display day,date and time. 46 *Non-nil means \\[display-time] should display day and date as well as time.")
66 This affects the spec 'date in the variable display-time-form-list." 47
67 :group 'display-time 48 (defvar display-time-interval 60
68 :type 'boolean) 49 "*Seconds between updates of time in the mode line.")
69 50
70 (defcustom display-time-interval 20 51 (defvar display-time-24hr-format nil
71 "*Seconds between updates of time in the mode line."
72 :group 'display-time
73 :type 'integer)
74
75 (defcustom display-time-24hr-format nil
76 "*Non-nil indicates time should be displayed as hh:mm, 0 <= hh <= 23. 52 "*Non-nil indicates time should be displayed as hh:mm, 0 <= hh <= 23.
77 Nil means 1 <= hh <= 12, and an AM/PM suffix is used. 53 Nil means 1 <= hh <= 12, and an AM/PM suffix is used.")
78 This affects the spec 'time in the variable display-time-form-list." 54
79 :group 'display-time 55 (defvar display-time-echo-area nil
80 :type 'boolean) 56 "*If non-nil, display-time will use the echo area instead of the mode line.")
81
82 (defcustom display-time-echo-area nil
83 "*If non-nil, display-time will use the echo area instead of the mode line."
84 :group 'display-time
85 :type 'boolean)
86 57
87 (defvar display-time-string nil) 58 (defvar display-time-string nil)
88 59
89 (defcustom display-time-hook nil 60 (defvar display-time-hook nil
90 "*List of functions to be called when the time is updated on the mode line." 61 "*List of functions to be called when the time is updated on the mode line.")
91 :group 'display-time
92 :type 'hook)
93 62
94 (defvar display-time-server-down-time nil 63 (defvar display-time-server-down-time nil
95 "Time when mail file's file system was recorded to be down. 64 "Time when mail file's file system was recorded to be down.
96 If that file system seems to be up, the value is nil.") 65 If that file system seems to be up, the value is nil.")
97
98 (defcustom display-time-ignore-read-mail t
99 "*Non-nil means displays the mail icon on any non-empty mailbox."
100 :group 'display-time
101 :type 'boolean)
102
103 (defcustom display-time-balloon-show-mail-from t
104 "*Non-nil means displays the `From' lines of your new mail in the help balloon.
105 This feature needs `balloon-help' to be loaded."
106 :group 'display-time
107 :type 'boolean)
108 66
109 ;;;###autoload 67 ;;;###autoload
110 (defun display-time () 68 (defun display-time ()
111 "Display current time, load level, and mail flag in mode line of each buffer. 69 "Display current time, load level, and mail flag in mode line of each buffer.
112 Updates automatically every minute. 70 Updates automatically every minute.
117 echo area instead of in the mode-line." 75 echo area instead of in the mode-line."
118 (interactive) 76 (interactive)
119 ;; if the "display-time" itimer already exists, nuke it first. 77 ;; if the "display-time" itimer already exists, nuke it first.
120 (let ((old (get-itimer "display-time"))) 78 (let ((old (get-itimer "display-time")))
121 (if old (delete-itimer old))) 79 (if old (delete-itimer old)))
122
123 (if (memq 'display-time-string global-mode-string)
124 (setq global-mode-string
125 (remove 'display-time-string global-mode-string)))
126 ;; If we're not displaying the time in the echo area 80 ;; If we're not displaying the time in the echo area
127 ;; and the global mode string does not have a non-nil value 81 ;; and the global mode string does not have a non-nil value
128 ;; then initialize the global mode string's value. 82 ;; then initialize the global mode string's value.
129 (or display-time-echo-area 83 (or display-time-echo-area
130 global-mode-string 84 global-mode-string
131 (setq global-mode-string '(""))) 85 (setq global-mode-string '("")))
132 ;; If we're not displaying the time in the echo area 86 ;; If we're not displaying the time in the echo area
133 ;; then we add our variable to the list. This will make the time 87 ;; and our display variable is not part of the global-mode-string list
88 ;; the we add our variable to the list. This will make the time
134 ;; appear on the modeline. 89 ;; appear on the modeline.
135 (or display-time-echo-area 90 (or display-time-echo-area
91 (memq 'display-time-string global-mode-string)
136 (setq global-mode-string 92 (setq global-mode-string
137 (append global-mode-string '(display-time-string)))) 93 (append global-mode-string '(display-time-string))))
138 ;; Display the time initially... 94 ;; Display the time initially...
139 (display-time-function) 95 (display-time-function)
140 ;; ... and start an itimer to do it automatically thereafter. 96 ;; ... and start an itimer to do it automatically thereafter.
141 ;; 97 ;;
142 ;; If we wanted to be really clever about this, we could have the itimer 98 ;; If we wanted to be really clever about this, we could have the itimer
145 ;; wake up exactly at the minute boundary. But that's just a little 101 ;; wake up exactly at the minute boundary. But that's just a little
146 ;; more work than it's worth... 102 ;; more work than it's worth...
147 (start-itimer "display-time" 'display-time-function 103 (start-itimer "display-time" 'display-time-function
148 display-time-interval display-time-interval)) 104 display-time-interval display-time-interval))
149 105
150 (defun display-time-stop ()
151 (interactive)
152 (delete-itimer "display-time")
153 (setq display-time-string nil))
154
155 (defcustom display-time-show-icons-maybe t
156 "Use icons for time, load and mail status if possible
157 and not specified different explicitely"
158 :group 'display-time
159 :type 'boolean)
160
161 (defvar display-time-icons-dir (concat data-directory "time/"))
162
163 (defcustom display-time-mail-sign-string " Mail"
164 "The string used as mail indicator in the echo area
165 (and in the modeline if display-time-show-icons-maybe is nil)
166 if display-time-echo-area is t"
167 :group 'display-time
168 :type 'string)
169
170 (defcustom display-time-no-mail-sign-string ""
171 "The string used as no-mail indicator in the echo area
172 (and in the modeline if display-time-show-icons-maybe is nil)
173 if display-time-echo-area is t"
174 :group 'display-time
175 :type 'string)
176
177 (defcustom display-time-display-pad "grey35"
178 "How the load indicator's trapezoidal \"pad\" is to be displayed.
179 This can be 'transparent or a string describing the color it should have"
180 :group 'display-time
181 :type '(choice :tag "Value"
182 (const transparent)
183 (string :tag "Color")))
184
185 (defcustom display-time-display-time-foreground "firebrick"
186 "How the time LEDs foreground is to be displayed.
187 This can be 'modeline (foreground color of the Modeline)
188 or a string describing the color it should have"
189 :group 'display-time
190 :type '(choice :tag "Value"
191 (const modline)
192 (string :tag "Color")))
193
194 (defcustom display-time-display-time-background 'transparent
195 "How the time LEDs background is to be displayed.
196 This can be 'transparent or a string describing the color it should have"
197 :group 'display-time
198 :type '(choice :tag "Value"
199 (const transparent)
200 (string :tag "Color")))
201
202 (defvar display-time-balloon-date-string nil)
203
204 (defvar display-time-spool-file-modification nil)
205
206 (defvar display-time-mail-header nil)
207
208 (defvar display-time-display-pad-old nil)
209
210 (defvar display-time-display-time-fg-old nil)
211
212 (defvar display-time-display-time-bg-old nil)
213
214 (defcustom display-time-load-list
215 (list 0.2 0.5 0.8 1.1 1.8 2.6)
216 "*A list giving six thresholds for the load
217 which correspond to the six different icons to be displayed
218 as a load indicator"
219 :group 'display-time
220 :type '(list (number :tag "Threshold 1")
221 (number :tag "Threshold 2")
222 (number :tag "Threshold 3")
223 (number :tag "Threshold 4")
224 (number :tag "Threshold 5")
225 (number :tag "Threshold 6")))
226
227 (defcustom display-time-compatible nil
228 "*This variable may be set to t to get the old behaviour of display-time.
229 It should be considered obsolete and only be used if you really want the
230 old behaviour (eq. you made extensive customizations yourself).
231 This means no display of a spiffy mail icon or use of the
232 display-time-form-list instead of the old display-time-string-form."
233 :group 'display-time
234 :type 'boolean)
235
236 (defun display-time-string-to-char-list (str)
237 (mapcar (function identity) str))
238
239 (defun display-time-generate-load-glyphs (&optional force)
240 (let* ((pad-color (if (symbolp display-time-display-pad)
241 (list "pad-color" '(face-background 'modeline))
242 (list "pad-color" display-time-display-pad)))
243 (xpm-color-symbols (append (list pad-color) xpm-color-symbols)))
244 (if (and (featurep 'xpm)
245 (or force (not (equal display-time-display-pad
246 display-time-display-pad-old))))
247 (progn
248 (setq display-time-load-0.0-glyph
249 (cons (make-extent nil nil)
250 (make-glyph
251 (concat display-time-icons-dir "l-0.0.xpm"))))
252 (setq display-time-load-0.5-glyph
253 (cons (make-extent nil nil)
254 (make-glyph
255 (concat display-time-icons-dir "l-0.5.xpm"))))
256 (setq display-time-load-1.0-glyph
257 (cons (make-extent nil nil)
258 (make-glyph
259 (concat display-time-icons-dir "l-1.0.xpm"))))
260 (setq display-time-load-1.5-glyph
261 (cons (make-extent nil nil)
262 (make-glyph
263 (concat display-time-icons-dir "l-1.5.xpm"))))
264 (setq display-time-load-2.0-glyph
265 (cons (make-extent nil nil)
266 (make-glyph
267 (concat display-time-icons-dir "l-2.0.xpm"))))
268 (setq display-time-load-2.5-glyph
269 (cons (make-extent nil nil)
270 (make-glyph
271 (concat display-time-icons-dir "l-2.5.xpm"))))
272 (setq display-time-load-3.0-glyph
273 (cons (make-extent nil nil)
274 (make-glyph
275 (concat display-time-icons-dir "l-3.0.xpm"))))
276 (setq display-time-display-pad-old display-time-display-pad)
277 ))))
278
279
280 (defun display-time-generate-time-glyphs (&optional force)
281 (let* ((ledbg (if (symbolp display-time-display-time-background)
282 (list "ledbg" '(face-background 'modeline))
283 (list "ledbg" display-time-display-time-background)))
284 (ledfg (if (symbolp display-time-display-time-foreground)
285 (list "ledfg" '(face-foreground 'modeline))
286 (list "ledfg" display-time-display-time-foreground)))
287 (xpm-color-symbols (append (list ledbg)
288 (list ledfg) xpm-color-symbols)))
289 (if (and (featurep 'xpm)
290 (or force (not (equal display-time-display-time-background
291 display-time-display-time-bg-old))
292 (not (equal display-time-display-time-foreground
293 display-time-display-time-fg-old))))
294 (progn
295 (setq display-time-1-glyph
296 (cons (make-extent nil nil)
297 (make-glyph (concat display-time-icons-dir "1.xpm"))))
298 (setq display-time-2-glyph
299 (cons (make-extent nil nil)
300 (make-glyph (concat display-time-icons-dir "2.xpm"))))
301 (setq display-time-3-glyph
302 (cons (make-extent nil nil)
303 (make-glyph (concat display-time-icons-dir "3.xpm"))))
304 (setq display-time-4-glyph
305 (cons (make-extent nil nil)
306 (make-glyph (concat display-time-icons-dir "4.xpm"))))
307 (setq display-time-5-glyph
308 (cons (make-extent nil nil)
309 (make-glyph (concat display-time-icons-dir "5.xpm"))))
310 (setq display-time-6-glyph
311 (cons (make-extent nil nil)
312 (make-glyph (concat display-time-icons-dir "6.xpm"))))
313 (setq display-time-7-glyph
314 (cons (make-extent nil nil)
315 (make-glyph (concat display-time-icons-dir "7.xpm"))))
316 (setq display-time-8-glyph
317 (cons (make-extent nil nil)
318 (make-glyph (concat display-time-icons-dir "8.xpm"))))
319 (setq display-time-9-glyph
320 (cons (make-extent nil nil)
321 (make-glyph (concat display-time-icons-dir "9.xpm"))))
322 (setq display-time-0-glyph
323 (cons (make-extent nil nil)
324 (make-glyph (concat display-time-icons-dir "0.xpm"))))
325 (setq display-time-:-glyph
326 (cons (make-extent nil nil)
327 (make-glyph (concat display-time-icons-dir "dp.xpm"))))
328 (setq display-time-am-glyph
329 (cons (make-extent nil nil)
330 (make-glyph (concat display-time-icons-dir "am.xpm"))))
331 (setq display-time-pm-glyph
332 (cons (make-extent nil nil)
333 (make-glyph (concat display-time-icons-dir "pm.xpm"))))
334 (setq display-time-display-time-fg-old
335 display-time-display-time-foreground
336 display-time-display-time-bg-old
337 display-time-display-time-background)
338 ))))
339
340 (if (featurep 'xpm)
341 (progn
342 (defvar display-time-mail-sign
343 (cons (make-extent nil nil)
344 (make-glyph (concat display-time-icons-dir "letter.xpm"))))
345 (defvar display-time-no-mail-sign
346 (cons (make-extent nil nil)
347 (make-glyph (concat display-time-icons-dir "no-letter.xpm"))))
348 (defvar display-time-1-glyph nil)
349 (defvar display-time-2-glyph nil)
350 (defvar display-time-3-glyph nil)
351 (defvar display-time-4-glyph nil)
352 (defvar display-time-5-glyph nil)
353 (defvar display-time-6-glyph nil)
354 (defvar display-time-7-glyph nil)
355 (defvar display-time-8-glyph nil)
356 (defvar display-time-9-glyph nil)
357 (defvar display-time-0-glyph nil)
358 (defvar display-time-:-glyph nil)
359 (defvar display-time-am-glyph nil)
360 (defvar display-time-pm-glyph nil)
361 (defvar display-time-load-0.0-glyph nil)
362 (defvar display-time-load-0.5-glyph nil)
363 (defvar display-time-load-1.0-glyph nil)
364 (defvar display-time-load-1.5-glyph nil)
365 (defvar display-time-load-2.0-glyph nil)
366 (defvar display-time-load-2.5-glyph nil)
367 (defvar display-time-load-3.0-glyph nil)
368 (display-time-generate-time-glyphs 'force)
369 (display-time-generate-load-glyphs 'force)
370 ))
371
372 (defun display-time-can-do-graphical-display (&optional textual)
373 (and display-time-show-icons-maybe
374 (not textual)
375 (eq (console-type) 'x)
376 (featurep 'xpm)
377 (not display-time-echo-area)))
378
379
380 (defun display-time-convert-num (time-string &optional textual)
381 (let ((list (display-time-string-to-char-list time-string))
382 elem tmp)
383 (if (not (display-time-can-do-graphical-display textual)) time-string
384 (display-time-generate-time-glyphs)
385 (setq display-time-balloon-date-string
386 (format "%s, %s %s %s %s" dayname day monthname year
387 (if (not (equal load ""))
388 (concat "-- Average load: " load)
389 "")))
390 (while (setq elem (pop list))
391 (setq elem (eval (intern-soft (concat "display-time-"
392 (char-to-string elem)
393 "-glyph"))))
394 (set-extent-property (car elem) 'balloon-help 'display-time-balloon)
395 (push elem tmp))
396 (reverse tmp))))
397
398 (defun display-time-balloon (&rest ciao)
399 (let ((header display-time-balloon-date-string)
400 header-ext)
401 (setq header-ext
402 (make-extent 0 (length display-time-balloon-date-string)
403 header))
404 (set-extent-property header-ext 'face 'red)
405 (set-extent-property header-ext 'duplicable t)
406 (concat header
407 (if display-time-balloon-show-mail-from
408 (display-time-scan-spool-file)))))
409
410
411 (defun display-time-scan-spool-file ()
412 (let* ((mail-spool-file (or display-time-mail-file
413 (getenv "MAIL")
414 (concat rmail-spool-directory
415 (user-login-name))))
416 (mod (nth 5 (file-attributes mail-spool-file))))
417 (if (equal mod display-time-spool-file-modification)
418 display-time-mail-header
419 (setq tmp (exec-to-string
420 (concat "grep \"^From \" " mail-spool-file)))
421 (if (equal tmp "") ()
422 (setq tmp (concat "\n\nYou have mail:\n-------------\n" tmp))
423 (setq tmp (substring tmp 0 (1- (length tmp)))))
424 (setq display-time-spool-file-modification mod)
425 (setq display-time-mail-header tmp))))
426
427
428 (defun display-time-convert-load (load-string &optional textual)
429 (let ((load-number (string-to-number load-string))
430 (alist (list (cons 0.0 0.0)
431 (cons 0.5 (car display-time-load-list))
432 (cons 1.0 (cadr display-time-load-list))
433 (cons 1.5 (caddr display-time-load-list))
434 (cons 2.0 (cadddr display-time-load-list))
435 (cons 2.5 (cadr (cdddr display-time-load-list)))
436 (cons 3.0 (caddr (cdddr display-time-load-list)))
437 (cons 100000 100000)))
438 elem load-elem)
439 (if (not (display-time-can-do-graphical-display textual))
440 load-string
441 (display-time-generate-load-glyphs)
442 (while (>= load-number (cdr (setq elem (pop alist))))
443 (setq load-elem elem))
444 (eval (intern-soft (concat "display-time-load-"
445 (number-to-string (car load-elem)) "-glyph"))))))
446
447 (defun display-time-convert-am-pm (ampm-string &optional textual)
448 (if (not (display-time-can-do-graphical-display textual))
449 ampm-string
450 (cond ((equal ampm-string "am") display-time-am-glyph)
451 ((equal ampm-string "pm") display-time-pm-glyph))))
452
453
454 (defun display-time-mail-sign (&optional textual)
455 "*A function giving back the object indicating 'mail' which
456 is the value of display-time-mail-sign when running under X,
457 display-time-echo-area is nil and display-time-show-icons-maybe is t.
458 It is the value of display-time-mail-sign-string otherwise."
459 (if (not (display-time-can-do-graphical-display textual))
460 display-time-mail-sign-string
461 display-time-mail-sign))
462
463 (defun display-time-no-mail-sign (&optional textual)
464 "*A function giving back the object indicating 'no mail' which
465 is the value of display-time-no-mail-sign when running under X,
466 display-time-echo-area is nil and display-time-show-icons-maybe is t.
467 It is the value of display-time-no-mail-sign-string otherwise."
468 (if (not (display-time-can-do-graphical-display textual))
469 display-time-no-mail-sign-string
470 display-time-no-mail-sign))
471
472 (defcustom display-time-form-list
473 (list 'date 'time 'load 'mail)
474 "*This list describes the format of the strings/glyphs
475 which are to be displayed by display-time.
476 The old variable display-time-string-forms is only used if
477 display-time-compatible is non-nil. It is a list consisting of
478 strings or any of the following symbols:
479
480 There are three complex specs whose behaviour is changed via
481 the setting of various variables
482
483 date: This prints out the date in a manner compatible to
484 the default value of the obsolete variable
485 display-time-string-forms. It respects the variable
486 display-time-day-and-date. If this is t it will print
487 out the current date in the form DAYNAME MONTH DAY
488 otherwise it will print nothing.
489
490 time: This prints out the time in a manner compatible to
491 the default value of the obsolete variable
492 display-time-string-forms. It respects the variable
493 display-time-24hr-format. If this is t it will print
494 out the current hours in 24-hour format, if nil the
495 hours will be printed in 12-hour format and the
496 minutes will be followed by 'AM' or 'PM'.
497
498 time-text: The same as above, but will not use a glyph
499
500 The other specs are simpler, as their meaning is not changed via
501 variables.
502
503 24-hours: This prints the hours in 24-hours format
504
505 24-hours-text: The same as above, but will not use a glyph
506
507 12-hours: This prints the hours in 12-hours format
508
509 12-hours-text: The same as above, but will not use a glyph
510
511 am-pm: This prints am or pm.
512
513 Timezone: This prints out the local timezone
514
515 am-pm-text: The same as above, but will not use a glyph
516
517 minutes: This prints the minutes.
518
519 minutes-text: The same as above, but will not use a glyph
520
521 day: This prints out the current day as a number.
522
523 dayname: This prints out today's name.
524
525 month: This prints out the current month as a number
526
527 monthname: This prints out the current month's name
528
529 year: This prints out the current year.
530
531 load: This prints out the system's load.
532
533 load-text: The same as above, but will not use a glyph
534
535 mail: This displays a mail indicator. Under X this will
536 normally be a small icon which changes depending if
537 there is new mail or not.
538
539 mail-text: The same as above, but will not use a glyph"
540 :group 'display-time
541 :type '(repeat (choice :tag "Symbol/String"
542 (const :tag "Date" date)
543 (const :tag "Time" time)
544 (const :tag "Time (text)" time-text)
545 (const :tag "24 hour format" 24-hours)
546 (const :tag "24 hour format (text)" 24-hours-text)
547 (const :tag "12 hour format" 12-hours)
548 (const :tag "12 hour format (text)" 12-hours-text)
549 (const :tag "AM/PM indicator" am-pm)
550 (const :tag "AM/PM indicator (text)" am-pm-text)
551 (const :tag "Timezone" timezone)
552 (const :tag "Minutes" minutes)
553 (const :tag "Minutes (text)" minutes-text)
554 (const :tag "Day" day)
555 (const :tag "Dayname" dayname)
556 (const :tag "Month" month)
557 (const :tag "Monthname" monthname)
558 (const :tag "Year" year)
559 (const :tag "Load" load)
560 (const :tag "Load (text)" load-text)
561 (const :tag "Mail sign" mail)
562 (const :tag "Mail sign (text)" mail-text)
563 (string :tag "String"))))
564
565 (defun display-time-evaluate-list ()
566 "Evalute the variable display-time-form-list"
567 (let ((list display-time-form-list) elem tmp result)
568 (while (setq elem (pop list))
569 (cond ((stringp elem) (push elem tmp))
570 ((eq elem 'date)
571 (push (if display-time-day-and-date
572 (format "%s %s %s " dayname monthname day) "") tmp))
573 ((eq elem 'time)
574 (progn
575 (push (display-time-convert-num
576 (format "%s:%s"
577 (if display-time-24hr-format 24-hours 12-hours)
578 minutes)) tmp)
579 (if (not display-time-24hr-format)
580 (push (display-time-convert-am-pm am-pm) tmp))))
581 ((eq elem 'time-text)
582 (push (display-time-convert-num
583 (format "%s:%s"
584 (if display-time-24hr-format 24-hours 12-hours)
585 minutes) t) tmp)
586 (if (not display-time-24hr-format)
587 (push (display-time-convert-am-pm am-pm t) tmp)))
588 ((eq elem 'day) (push day tmp))
589 ((eq elem 'dayname) (push dayname tmp))
590 ((eq elem 'month) (push month tmp))
591 ((eq elem 'monthname) (push monthname tmp))
592 ((eq elem '24-hours)
593 (push (display-time-convert-num 24-hours) tmp))
594 ((eq elem 'year)
595 (push year tmp))
596 ((eq elem '24-hours-text)
597 (push (display-time-convert-num 24-hours t) tmp))
598 ((eq elem '12-hours)
599 (push (display-time-convert-num 12-hours) tmp))
600 ((eq elem '12-hours-text)
601 (push (display-time-convert-num 12-hours t) tmp))
602 ((eq elem 'minutes)
603 (push (display-time-convert-num minutes) tmp))
604 ((eq elem 'minutes-text)
605 (push (display-time-convert-num minutes t) tmp))
606 ((eq elem 'am-pm)
607 (push (display-time-convert-am-pm am-pm) tmp))
608 ((eq elem 'am-pm-text)
609 (push (display-time-convert-am-pm am-pm t) tmp))
610 ((eq elem 'timezone)
611 (push time-zone tmp))
612 ((eq elem 'load)
613 (push (display-time-convert-load load) tmp))
614 ((eq elem 'load-text)
615 (push (display-time-convert-load load t) tmp))
616 ((eq elem 'mail)
617 (push (if mail (display-time-mail-sign)
618 (display-time-no-mail-sign)) tmp))
619 ((eq elem 'mail-text)
620 (push (if mail (display-time-mail-sign t)
621 (display-time-no-mail-sign t)) tmp))
622 ))
623 ;; We know that we have a list containing only of strings if
624 ;; display-time-echo-area is t. So we construct this string from
625 ;; the list. Else we just reverse the list and give it as result.
626 (if (not display-time-echo-area) (setq result (reverse tmp))
627 (while (setq elem (pop tmp))
628 (setq result (concat elem result))))
629 result))
630
631
632 (defvar display-time-string-forms 106 (defvar display-time-string-forms
633 '((if display-time-day-and-date 107 '((if display-time-day-and-date
634 (format "%s %s %s " dayname monthname day) 108 (format "%s %s %s " dayname monthname day)
635 "") 109 "")
636 (format "%s:%s%s" 110 (format "%s:%s%s"
637 (if display-time-24hr-format 24-hours 12-hours) 111 (if display-time-24hr-format 24-hours 12-hours)
638 minutes 112 minutes
639 (if display-time-24hr-format "" am-pm)) 113 (if display-time-24hr-format "" am-pm))
640 load 114 load
641 (if mail " Mail" "")) 115 (if mail " Mail" ""))
642 "*THIS IS OBSOLETE! It will only be used if display-time-compatible is t. 116 "*A list of expressions governing display of the time in the mode line.
643 A list of expressions governing display of the time in the mode line.
644 This expression is a list of expressions that can involve the keywords 117 This expression is a list of expressions that can involve the keywords
645 `load', `day', `month', and `year', `12-hours', `24-hours', `minutes', 118 `load', `day', `month', and `year', `12-hours', `24-hours', `minutes',
646 `seconds', all numbers in string form, and `monthname', `dayname', `am-pm', 119 `seconds', all numbers in string form, and `monthname', `dayname', `am-pm',
647 and `time-zone' all alphabetic strings and `mail' a true/nil string value. 120 and `time-zone' all alphabetic strings, and `mail' a true/nil value.
648 121
649 For example, the form 122 For example, the form
650 123
651 '((substring year -2) \"/\" month \"/\" day 124 '((substring year -2) \"/\" month \"/\" day
652 \" \" 24-hours \":\" minutes \":\" seconds 125 \" \" 24-hours \":\" minutes \":\" seconds
653 (if time-zone \" (\") time-zone (if time-zone \")\")) 126 (if time-zone \" (\") time-zone (if time-zone \")\")
127 (if mail \" Mail\" \"\"))
654 128
655 would give mode line times like `94/12/30 21:07:48 (UTC)'.") 129 would give mode line times like `94/12/30 21:07:48 (UTC)'.")
656 130
657 (defun display-time-function () 131 (defun display-time-function ()
658 (let* ((now (current-time)) 132 (let* ((now (current-time))
699 '(("Jan" . "1") ("Feb" . "2") ("Mar" . "3") ("Apr" . "4") 173 '(("Jan" . "1") ("Feb" . "2") ("Mar" . "3") ("Apr" . "4")
700 ("May" . "5") ("Jun" . "6") ("Jul" . "7") ("Aug" . "8") 174 ("May" . "5") ("Jun" . "6") ("Jul" . "7") ("Aug" . "8")
701 ("Sep" . "9") ("Oct" . "10") ("Nov" . "11") ("Dec" . "12"))))) 175 ("Sep" . "9") ("Oct" . "10") ("Nov" . "11") ("Dec" . "12")))))
702 (dayname (substring time 0 3))) 176 (dayname (substring time 0 3)))
703 (setq display-time-string 177 (setq display-time-string
704 (if display-time-compatible 178 (mapconcat 'eval display-time-string-forms ""))
705 (mapconcat 'eval display-time-string-forms "")
706 (display-time-evaluate-list)))
707 ;; This is inside the let binding, but we are not going to document 179 ;; This is inside the let binding, but we are not going to document
708 ;; what variables are available. 180 ;; what variables are available.
709 (run-hooks 'display-time-hook)) 181 (run-hooks 'display-time-hook))
710 (if display-time-echo-area 182 (if display-time-echo-area
711 (or (> (minibuffer-depth) 0) 183 (or (> (minibuffer-depth) 0)
712 ;; don't stomp echo-area-buffer if reading from minibuffer now. 184 ;; don't stomp echo-area-buffer if reading from minibuffer now.
713 (save-excursion 185 (save-excursion
714 (save-window-excursion 186 (save-window-excursion
715 (select-window (minibuffer-window)) 187 (select-window (minibuffer-window))
716 (erase-buffer) 188 (erase-buffer)
717 (indent-to (- (frame-width) (length display-time-string) 1)) 189 (indent-to (- (screen-width) (length display-time-string) 1))
718 (insert display-time-string) 190 (insert display-time-string)
719 (message (buffer-string))))) 191 (message (buffer-string)))))
720 (force-mode-line-update) 192 (force-mode-line-update)
721 ;; Do redisplay right now, if no input pending. 193 ;; Do redisplay right now, if no input pending.
722 (sit-for 0))) 194 (sit-for 0)))
723 195
724 (defun display-time-file-nonempty-p (file) 196 (defun display-time-file-nonempty-p (file)
725 (let ((attributes (file-attributes (file-chase-links file)))) 197 (and (file-exists-p file)
726 (and attributes 198 (< 0 (nth 7 (file-attributes (file-chase-links file))))))
727 (< 0 (nth 7 attributes))
728 (or display-time-ignore-read-mail
729 (> (car (nth 5 attributes)) (car (nth 4 attributes)))
730 (and (= (car (nth 5 attributes)) (car (nth 4 attributes)))
731 (> (cadr (nth 5 attributes)) (cadr (nth 4 attributes))))))))
732 199
733 (provide 'time) 200 (provide 'time)
734 201
735 ;;; time.el ends here 202 ;;; time.el ends here