Mercurial > hg > xemacs-beta

comparison lisp/packages/time.el @ 108:360340f9fd5f r20-1b6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b6
author cvs
date Mon, 13 Aug 2007 09:18:39 +0200
parents cf808b4c4290
children fe104dbd9147
comparison
equal deleted inserted replaced
107:523141596bda 108:360340f9fd5f
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 5 ;; Maintainer: FSF, XEmacs add-ons (C) by Jens T. Lautenbacher
6 ;; mail <jens@lemming0.lem.uni-karlsruhe.de>
7 ;; for comments/fixes about the enhancements.
6 8
7 ;; This file is part of XEmacs. 9 ;; This file is part of XEmacs.
8 10
9 ;; XEmacs is free software; you can redistribute it and/or modify it 11 ;; XEmacs is free software; you can redistribute it and/or modify it
10 ;; under the terms of the GNU General Public License as published by 12 ;; under the terms of the GNU General Public License as published by
30 32
31 ;; See also reportmail.el. 33 ;; See also reportmail.el.
32 ;; This uses the XEmacs timeout-event mechanism, via a version 34 ;; This uses the XEmacs timeout-event mechanism, via a version
33 ;; of Kyle Jones' itimer package. 35 ;; of Kyle Jones' itimer package.
34 36
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.
39 ;;; The starting variable to look at is `display-time-form-list'
40
35 ;;; Code: 41 ;;; Code:
36 42
37 (require 'itimer) 43 (require 'itimer)
44
45 (defvar display-time-compatible nil
46 "*This variable may be set to nil to get the old behaviour of display-time.
47 This means no display of a spiffy mail icon or use of the display-time-form-list
48 instead of the old display-time-string-form.")
38 49
39 (defvar display-time-mail-file nil 50 (defvar display-time-mail-file nil
40 "*File name of mail inbox file, for indicating existence of new mail. 51 "*File name of mail inbox file, for indicating existence of new mail.
41 Non-nil and not a string means don't check for mail. nil means use 52 Non-nil and not a string means don't check for mail. nil means use
42 default, which is system-dependent, and is the same as used by Rmail.") 53 default, which is system-dependent, and is the same as used by Rmail.")
43 54
44 ;;;###autoload 55 ;;;###autoload
45 (defvar display-time-day-and-date nil "\ 56 (defvar display-time-day-and-date nil "\
46 *Non-nil means \\[display-time] should display day and date as well as time.") 57 *Non-nil means \\[display-time] should display day and date as well as time.")
47 58
48 (defvar display-time-interval 60 59 (defvar display-time-interval 20
49 "*Seconds between updates of time in the mode line.") 60 "*Seconds between updates of time in the mode line.")
50 61
51 (defvar display-time-24hr-format nil 62 (defvar display-time-24hr-format nil
52 "*Non-nil indicates time should be displayed as hh:mm, 0 <= hh <= 23. 63 "*Non-nil indicates time should be displayed as hh:mm, 0 <= hh <= 23.
53 Nil means 1 <= hh <= 12, and an AM/PM suffix is used.") 64 Nil means 1 <= hh <= 12, and an AM/PM suffix is used.")
75 echo area instead of in the mode-line." 86 echo area instead of in the mode-line."
76 (interactive) 87 (interactive)
77 ;; if the "display-time" itimer already exists, nuke it first. 88 ;; if the "display-time" itimer already exists, nuke it first.
78 (let ((old (get-itimer "display-time"))) 89 (let ((old (get-itimer "display-time")))
79 (if old (delete-itimer old))) 90 (if old (delete-itimer old)))
91
92 (if (memq 'display-time-string global-mode-string)
93 (setq global-mode-string
94 (remove 'display-time-string global-mode-string)))
80 ;; If we're not displaying the time in the echo area 95 ;; If we're not displaying the time in the echo area
81 ;; and the global mode string does not have a non-nil value 96 ;; and the global mode string does not have a non-nil value
82 ;; then initialize the global mode string's value. 97 ;; then initialize the global mode string's value.
83 (or display-time-echo-area 98 (or display-time-echo-area
84 global-mode-string 99 global-mode-string
85 (setq global-mode-string '(""))) 100 (setq global-mode-string '("")))
86 ;; If we're not displaying the time in the echo area 101 ;; If we're not displaying the time in the echo area
87 ;; and our display variable is not part of the global-mode-string list 102 ;; then we add our variable to the list. This will make the time
88 ;; the we add our variable to the list. This will make the time
89 ;; appear on the modeline. 103 ;; appear on the modeline.
90 (or display-time-echo-area 104 (or display-time-echo-area
91 (memq 'display-time-string global-mode-string)
92 (setq global-mode-string 105 (setq global-mode-string
93 (append global-mode-string '(display-time-string)))) 106 (append global-mode-string '(display-time-string))))
94 ;; Display the time initially... 107 ;; Display the time initially...
95 (display-time-function) 108 (display-time-function)
96 ;; ... and start an itimer to do it automatically thereafter. 109 ;; ... and start an itimer to do it automatically thereafter.
97 ;; 110 ;;
98 ;; If we wanted to be really clever about this, we could have the itimer 111 ;; If we wanted to be really clever about this, we could have the itimer
101 ;; wake up exactly at the minute boundary. But that's just a little 114 ;; wake up exactly at the minute boundary. But that's just a little
102 ;; more work than it's worth... 115 ;; more work than it's worth...
103 (start-itimer "display-time" 'display-time-function 116 (start-itimer "display-time" 'display-time-function
104 display-time-interval display-time-interval)) 117 display-time-interval display-time-interval))
105 118
106 (defvar display-time-show-load t)
107
108 (defvar display-time-show-icons-maybe t 119 (defvar display-time-show-icons-maybe t
109 "Use icons to indicate the mail status if we're running under X and 120 "Use icons to indicate the mail status if possible")
110 XEmacs was compiled with xpm support") 121
111 122 (defvar display-time-icons-dir (concat data-directory "time/"))
112 (defun display-time-get-icons-dir () 123
113 (let ((path load-path) 124 (defvar display-time-mail-sign-string " Mail"
114 dir elem) 125 "The string used as mail indicator in the echo area
115 (while (setq elem (pop path)) 126 (and in the modeline if display-time-show-icons-maybe is nil)
116 (setq dir (concat (directory-file-name elem) "/../etc/time/")) 127 if display-time-echo-area is t")
117 (if (file-directory-p dir) (setq path nil) 128
118 nil)) 129 (defvar display-time-no-mail-sign-string ""
119 dir)) 130 "The string used as no-mail indicator in the echo area
120 131 (and in the modeline if display-time-show-icons-maybe is nil)
121 (defvar display-time-icons-dir (display-time-get-icons-dir)) 132 if display-time-echo-area is t")
122 133
123 (defvar display-time-mail-sign 134 (defvar display-time-mail-sign
124 (progn 135 (progn
125 (let* ((file (concat display-time-icons-dir "letter.xpm")) 136 (let* ((file (concat display-time-icons-dir "letter.xpm"))
126 (glyph (if (featurep 'xpm) (make-glyph file) nil)) 137 (glyph (if (featurep 'xpm) (make-glyph file)
127 (display-time-mail-ext (detach-extent (make-extent 1 1)))) 138 display-time-mail-sign-string))
128 (if (and (featurep 'x) glyph 139 (ext (make-extent nil nil)))
129 (file-exists-p file)) 140 (cons ext glyph)))
130 (cons display-time-mail-ext glyph) 141 "A variable holding a cons cell (ext . glyph)
131 " Mail"))) 142 which gives an indicator for new mail in the modeline")
132 "A variable holding a string or a cons cell (ext . glyph) which gives
133 an indicator for unread mail. The default displays a xpm-file (a yellow letter)
134 if (feturep 'xpm) and (featurep 'x) are both t, a string \" Mail\" otherwise")
135 143
136 (defvar display-time-no-mail-sign 144 (defvar display-time-no-mail-sign
137 (progn 145 (progn
138 (let* ((file (concat display-time-icons-dir "no-letter.xpm")) 146 (let* ((file (concat display-time-icons-dir "no-letter.xpm"))
139 (glyph (if (featurep 'xpm) (make-glyph file) nil)) 147 (glyph (if (featurep 'xpm) (make-glyph file)
140 (display-time-mail-ext (detach-extent (make-extent 1 1)))) 148 display-time-no-mail-sign-string))
141 (if (and (featurep 'x) glyph 149 (ext (make-extent nil nil)))
142 (file-exists-p file)) 150 (cons ext glyph)))
143 (cons display-time-mail-ext glyph) 151 "A variable holding a cons cell (ext . glyph) which gives
144 ""))) 152 an indicator for `no mail' in the modeline")
145 "A variable holding a string or a cons cell (ext . glyph) which gives 153
146 an indicator for `no mail'. The default displays a xpm-file 154 (defun display-time-string-to-char-list (str)
147 if (feturep 'xpm) and (featurep 'x) are both t, and nothing otherwise") 155 (mapcar (function identity) str))
148 156
149 157
158 (if (featurep 'xpm)
159 (progn
160 (setq display-time-1-glyph
161 (cons (make-extent nil nil)
162 (make-glyph (concat display-time-icons-dir "1.xpm"))))
163 (setq display-time-2-glyph
164 (cons (make-extent nil nil)
165 (make-glyph (concat display-time-icons-dir "2.xpm"))))
166 (setq display-time-3-glyph
167 (cons (make-extent nil nil)
168 (make-glyph (concat display-time-icons-dir "3.xpm"))))
169 (setq display-time-4-glyph
170 (cons (make-extent nil nil)
171 (make-glyph (concat display-time-icons-dir "4.xpm"))))
172 (setq display-time-5-glyph
173 (cons (make-extent nil nil)
174 (make-glyph (concat display-time-icons-dir "5.xpm"))))
175 (setq display-time-6-glyph
176 (cons (make-extent nil nil)
177 (make-glyph (concat display-time-icons-dir "6.xpm"))))
178 (setq display-time-7-glyph
179 (cons (make-extent nil nil)
180 (make-glyph (concat display-time-icons-dir "7.xpm"))))
181 (setq display-time-8-glyph
182 (cons (make-extent nil nil)
183 (make-glyph (concat display-time-icons-dir "8.xpm"))))
184 (setq display-time-9-glyph
185 (cons (make-extent nil nil)
186 (make-glyph (concat display-time-icons-dir "9.xpm"))))
187 (setq display-time-0-glyph
188 (cons (make-extent nil nil)
189 (make-glyph (concat display-time-icons-dir "0.xpm"))))
190 (setq display-time-:-glyph
191 (cons (make-extent nil nil)
192 (make-glyph (concat display-time-icons-dir "dp.xpm"))))
193 (setq display-time-load-0.0-glyph
194 (cons (make-extent nil nil)
195 (make-glyph (concat display-time-icons-dir "l-0.0.xpm"))))
196 (setq display-time-load-0.5-glyph
197 (cons (make-extent nil nil)
198 (make-glyph (concat display-time-icons-dir "l-0.5.xpm"))))
199 (setq display-time-load-1.0-glyph
200 (cons (make-extent nil nil)
201 (make-glyph (concat display-time-icons-dir "l-1.0.xpm"))))
202 (setq display-time-load-1.5-glyph
203 (cons (make-extent nil nil)
204 (make-glyph (concat display-time-icons-dir "l-1.5.xpm"))))
205 (setq display-time-load-2.0-glyph
206 (cons (make-extent nil nil)
207 (make-glyph (concat display-time-icons-dir "l-2.0.xpm"))))
208 (setq display-time-load-2.5-glyph
209 (cons (make-extent nil nil)
210 (make-glyph (concat display-time-icons-dir "l-2.5.xpm"))))
211 (setq display-time-load-3.0-glyph
212 (cons (make-extent nil nil)
213 (make-glyph (concat display-time-icons-dir "l-3.0.xpm"))))
214 (setq display-time-am-glyph
215 (cons (make-extent nil nil)
216 (make-glyph (concat display-time-icons-dir "am.xpm"))))
217 (setq display-time-pm-glyph
218 (cons (make-extent nil nil)
219 (make-glyph (concat display-time-icons-dir "pm.xpm"))))
220 ))
221
222
223 (defun display-time-convert-num-to-pics (string)
224 (let ((list (display-time-string-to-char-list string))
225 elem result tmp)
226 (if (not (and display-time-show-icons-maybe
227 (eq (console-type) 'x)
228 (not display-time-echo-area))) string
229 (while (setq elem (pop list))
230 (push (eval (intern-soft (concat "display-time-"
231 (char-to-string elem)
232 "-glyph"))) tmp))
233 (setq result (reverse tmp)))))
234
235 (defvar display-time-load-list
236 (list 0.2 0.5 0.8 1.1 1.8 2.6)
237 "*A list giving six thresholds for the load which correspond
238 to the six different icons to be displayed as a load indicator")
239
240 (defun display-time-convert-load-to-glyph (n)
241 (let ((load-number (string-to-number n))
242 (alist (list (cons 0.0 0.0)
243 (cons 0.5 (car display-time-load-list))
244 (cons 1.0 (cadr display-time-load-list))
245 (cons 1.5 (caddr display-time-load-list))
246 (cons 2.0 (cadddr display-time-load-list))
247 (cons 2.5 (cadr (cdddr display-time-load-list)))
248 (cons 3.0 (caddr (cdddr display-time-load-list)))
249 (cons 100000 100000)))
250 result elem)
251 (if (not (and display-time-show-icons-maybe
252 (eq (console-type) 'x)
253 (not display-time-echo-area))) n
254 (while (>= load-number (cdr (setq elem (pop alist))))
255 (setq result (eval (intern-soft (concat
256 "display-time-load-"
257 (number-to-string (car elem))
258 "-glyph")))))
259 result)))
260
261 (defun display-time-convert-am-pm (n)
262 (if (not (and display-time-show-icons-maybe
263 (eq (console-type) 'x)
264 (not display-time-echo-area))) n
265 (cond ((equal n "am") display-time-am-glyph)
266 ((equal n "pm") display-time-pm-glyph))))
267
268
269 (defun display-time-mail-sign ()
270 "*A function giving back the object indicating 'mail' which
271 is the value of display-time-mail-sign when running under X,
272 display-time-echo-area is nil and display-time-show-icons-maybe is t.
273 It is the value of display-time-mail-sign-string otherwise."
274 (if (or (not (eq (console-type) 'x))
275 display-time-echo-area
276 (not display-time-show-icons-maybe))
277 display-time-mail-sign-string
278 display-time-mail-sign))
279
280 (defun display-time-no-mail-sign ()
281 "*A function giving back the object indicating 'no mail' which
282 is the value of display-time-no-mail-sign when running under X,
283 display-time-echo-area is nil and display-time-show-icons-maybe is t.
284 It is the value of display-time-no-mail-sign-string otherwise."
285 (if (or (not (eq (console-type) 'x))
286 display-time-echo-area
287 (not display-time-show-icons-maybe))
288 display-time-no-mail-sign-string
289 display-time-no-mail-sign))
290
291 (defvar display-time-form-list
292 (list 'date-compatible 'time-compatible 'load 'mail)
293 "*This list describes the format of the strings/glyphs which are to be
294 displayed by display-time. The old variable display-time-string-forms is
295 only used if display-time-compatible is non-nil. It is a list consisting of
296 strings or any of the following symbols:
297
298 date-compatible: This prints out the date in a manner compatible to
299 the default value of the obsolete variable
300 display-time-string-forms. It respects the variable
301 display-time-day-and-date. If this is t it will print
302 out the current date in the form DAYNAME MONTH DAY
303 otherwise it will print nothing.
304
305 time-compatible: This prints out the time in a manner compatible to
306 the default value of the obsolete variable
307 display-time-string-forms. It respects the variable
308 display-time-24hr-format. If this is t it will print
309 out the current hours in 24-hour format, if nil the
310 hours will be printed in 12-hour format and the
311 minutes will be followed by 'AM' or 'PM'.
312
313 24-hours: This prints the hours in 24-hours format
314
315 12-hours: This prints the hours in 12-hours format
316
317 am-pm: This prints Am or Pm.
318
319 dp: This prints a \":\", maybe as an icon
320
321 minutes: This prints the minutes.
322
323 day: This prints out the current day as a number.
324
325 dayname: This prints out today's name.
326
327 month: This prints out the current month as a number
328
329 monthname: This prints out the current month's name
330
331 load: This prints out the system's load.
332
333 mail: This displays a mail indicator. Under X this will
334 normally be a small icon which changes depending if
335 there is new mail or not.")
336
337 (defun display-time-evaluate-list ()
338 "Evalute the variable display-time-form-list"
339 (let ((list display-time-form-list) elem tmp result)
340 (while (setq elem (pop list))
341 (cond ((stringp elem) (push elem tmp))
342 ((eq elem 'date-compatible)
343 (push (if display-time-day-and-date
344 (format "%s %s %s " dayname monthname day) "") tmp))
345 ((eq elem 'time-compatible)
346 (progn
347 (push (display-time-convert-num-to-pics
348 (format "%s:%s"
349 (if display-time-24hr-format 24-hours 12-hours)
350 minutes)) tmp)
351 (if (not display-time-24hr-format)
352 (push (display-time-convert-am-pm am-pm) tmp))))
353 ((eq elem 'day) (push day tmp))
354 ((eq elem 'dayname) (push dayname tmp))
355 ((eq elem 'month) (push month tmp))
356 ((eq elem 'monthname) (push monthname tmp))
357 ((eq elem '24-hours) (push (display-time-convert-num-to-pics 24-hours)
358 tmp))
359 ((eq elem '12-hours) (push (display-time-convert-num-to-pics 12-hours)
360 tmp))
361 ((eq elem 'minutes) (push (display-time-convert-num-to-pics minutes)
362 tmp))
363 ((eq elem 'am-pm) (push am-pm tmp))
364 ((eq elem 'dp) (push (display-time-convert-num-to-pics ":") tmp))
365 ((eq elem 'load)
366 (push (display-time-convert-load-to-glyph load) tmp))
367 ((eq elem 'mail) (push (if mail (display-time-mail-sign)
368 (display-time-no-mail-sign))
369 tmp))))
370 ;; We know that we have a list containing only of strings if
371 ;; display-time-echo-area is t. So we construct this string from
372 ;; the list. Else we just reverse the list and give it as result.
373 (if (not display-time-echo-area) (setq result (reverse tmp))
374 (while (setq elem (pop tmp))
375 (setq result (concat elem result))))
376 result))
377
378
150 (defvar display-time-string-forms 379 (defvar display-time-string-forms
151 '((if display-time-day-and-date 380 '((if display-time-day-and-date
152 (format "%s %s %s " dayname monthname day) 381 (format "%s %s %s " dayname monthname day)
153 "") 382 "")
154 (format "%s:%s%s" 383 (format "%s:%s%s"
155 (if display-time-24hr-format 24-hours 12-hours) 384 (if display-time-24hr-format 24-hours 12-hours)
156 minutes 385 minutes
157 (if display-time-24hr-format "" am-pm)) 386 (if display-time-24hr-format "" am-pm))
158 (if display-time-show-load load) 387 load
159 (if (and (not display-time-show-icons-maybe) mail) " Mail" "")) 388 (if mail " Mail" ""))
160 "*A list of expressions governing display of the time in the mode line. 389 "*THIS IS OBSOLETE! It will only be used if display-time-compatible is t.
390 A list of expressions governing display of the time in the mode line.
161 This expression is a list of expressions that can involve the keywords 391 This expression is a list of expressions that can involve the keywords
162 `load', `day', `month', and `year', `12-hours', `24-hours', `minutes', 392 `load', `day', `month', and `year', `12-hours', `24-hours', `minutes',
163 `seconds', all numbers in string form, and `monthname', `dayname', `am-pm', 393 `seconds', all numbers in string form, and `monthname', `dayname', `am-pm',
164 and `time-zone' all alphabetic strings and `mail' a true/nil string value. 394 and `time-zone' all alphabetic strings and `mail' a true/nil string value.
165 Beware: if display-time-show-icons-maybe is non-nil, the `mail' spec is also
166 evaluated after this form and depending on it's result display-time-mail-sign
167 or display-time-no-mail-sign is appended to the modeline string.
168 This was made so you can also use xpm-files as mail indicator.
169 395
170 For example, the form 396 For example, the form
171 397
172 '((substring year -2) \"/\" month \"/\" day 398 '((substring year -2) \"/\" month \"/\" day
173 \" \" 24-hours \":\" minutes \":\" seconds 399 \" \" 24-hours \":\" minutes \":\" seconds
220 '(("Jan" . "1") ("Feb" . "2") ("Mar" . "3") ("Apr" . "4") 446 '(("Jan" . "1") ("Feb" . "2") ("Mar" . "3") ("Apr" . "4")
221 ("May" . "5") ("Jun" . "6") ("Jul" . "7") ("Aug" . "8") 447 ("May" . "5") ("Jun" . "6") ("Jul" . "7") ("Aug" . "8")
222 ("Sep" . "9") ("Oct" . "10") ("Nov" . "11") ("Dec" . "12"))))) 448 ("Sep" . "9") ("Oct" . "10") ("Nov" . "11") ("Dec" . "12")))))
223 (dayname (substring time 0 3))) 449 (dayname (substring time 0 3)))
224 (setq display-time-string 450 (setq display-time-string
225 (mapconcat 'eval display-time-string-forms "")) 451 (if display-time-compatible
226 (if (and mail display-time-show-icons-maybe) 452 (mapconcat 'eval display-time-string-forms "")
227 (setq display-time-string 453 (display-time-evaluate-list)))
228 (list display-time-string display-time-mail-sign))
229 (if display-time-show-icons-maybe
230 (setq display-time-string
231 (list display-time-string display-time-no-mail-sign))))
232 ;; This is inside the let binding, but we are not going to document 454 ;; This is inside the let binding, but we are not going to document
233 ;; what variables are available. 455 ;; what variables are available.
234 (run-hooks 'display-time-hook)) 456 (run-hooks 'display-time-hook))
235 (if display-time-echo-area 457 (if display-time-echo-area
236 (or (> (minibuffer-depth) 0) 458 (or (> (minibuffer-depth) 0)