Mercurial > hg > xemacs-beta

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b104
author cvs
date Mon, 13 Aug 2007 08:54:51 +0200
parents 7e54bd776075
children 131b0175ea99
comparison
equal deleted inserted replaced
41:5d6df4963a99 42:8b8b7f3559a2
21 ;; You should have received a copy of the GNU General Public License 21 ;; 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 22 ;; along with XEmacs; see the file COPYING. If not, write to the Free
23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
24 ;; 02111-1307, USA. 24 ;; 02111-1307, USA.
25 25
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
26 ;;; Synched up with: Not synched with FSF. 30 ;;; Synched up with: Not synched with FSF.
27 31
28 ;;; Commentary: 32 ;;; Commentary:
29 33
30 ;; Facilities to display current time/date and a new-mail indicator 34 ;; Facilities to display current time/date and a new-mail indicator
47 51
48 (defgroup display-time nil 52 (defgroup display-time nil
49 "Facilities to display the current time/date/load and a new-mail indicator 53 "Facilities to display the current time/date/load and a new-mail indicator
50 in the XEmacs mode line or echo area." 54 in the XEmacs mode line or echo area."
51 :group 'applications) 55 :group 'applications)
52
53 (defcustom display-time-compatible nil
54 "*This variable may be set to t to get the old behaviour of display-time.
55 This means no display of a spiffy mail icon or use of the
56 display-time-form-list instead of the old display-time-string-form."
57 :group 'display-time
58 :type 'boolean)
59 56
60 (defcustom display-time-mail-file nil 57 (defcustom display-time-mail-file nil
61 "*File name of mail inbox file, for indicating existence of new mail. 58 "*File name of mail inbox file, for indicating existence of new mail.
62 Non-nil and not a string means don't check for mail. nil means use 59 Non-nil and not a string means don't check for mail. nil means use
63 default, which is system-dependent, and is the same as used by Rmail." 60 default, which is system-dependent, and is the same as used by Rmail."
96 93
97 (defvar display-time-server-down-time nil 94 (defvar display-time-server-down-time nil
98 "Time when mail file's file system was recorded to be down. 95 "Time when mail file's file system was recorded to be down.
99 If that file system seems to be up, the value is nil.") 96 If that file system seems to be up, the value is nil.")
100 97
101 (defcustom display-time-ignore-read-mail nil 98 (defcustom display-time-ignore-read-mail t
102 "*Non-nil means displays the mail icon on any non-empty mailbox." 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."
103 :group 'display-time 106 :group 'display-time
104 :type 'boolean) 107 :type 'boolean)
105 108
106 ;;;###autoload 109 ;;;###autoload
107 (defun display-time () 110 (defun display-time ()
194 :group 'display-time 197 :group 'display-time
195 :type '(choice :tag "Value" 198 :type '(choice :tag "Value"
196 (const transparent) 199 (const transparent)
197 (string :tag "Color"))) 200 (string :tag "Color")))
198 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)
199 207
200 (defvar display-time-display-pad-old nil) 208 (defvar display-time-display-pad-old nil)
201 209
202 (defvar display-time-display-time-fg-old nil) 210 (defvar display-time-display-time-fg-old nil)
203 211
213 (number :tag "Threshold 2") 221 (number :tag "Threshold 2")
214 (number :tag "Threshold 3") 222 (number :tag "Threshold 3")
215 (number :tag "Threshold 4") 223 (number :tag "Threshold 4")
216 (number :tag "Threshold 5") 224 (number :tag "Threshold 5")
217 (number :tag "Threshold 6"))) 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)
218 235
219 (defun display-time-string-to-char-list (str) 236 (defun display-time-string-to-char-list (str)
220 (mapcar (function identity) str)) 237 (mapcar (function identity) str))
221 238
222 (defun display-time-generate-load-glyphs (&optional force) 239 (defun display-time-generate-load-glyphs (&optional force)
363 (defun display-time-convert-num (time-string &optional textual) 380 (defun display-time-convert-num (time-string &optional textual)
364 (let ((list (display-time-string-to-char-list time-string)) 381 (let ((list (display-time-string-to-char-list time-string))
365 elem tmp) 382 elem tmp)
366 (if (not (display-time-can-do-graphical-display textual)) time-string 383 (if (not (display-time-can-do-graphical-display textual)) time-string
367 (display-time-generate-time-glyphs) 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 "")))
368 (while (setq elem (pop list)) 390 (while (setq elem (pop list))
369 (push (eval (intern-soft (concat "display-time-" 391 (setq elem (eval (intern-soft (concat "display-time-"
370 (char-to-string elem) 392 (char-to-string elem)
371 "-glyph"))) tmp)) 393 "-glyph"))))
372 (reverse tmp)))) 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
373 427
374 (defun display-time-convert-load (load-string &optional textual) 428 (defun display-time-convert-load (load-string &optional textual)
375 (let ((load-number (string-to-number load-string)) 429 (let ((load-number (string-to-number load-string))
376 (alist (list (cons 0.0 0.0) 430 (alist (list (cons 0.0 0.0)
377 (cons 0.5 (car display-time-load-list)) 431 (cons 0.5 (car display-time-load-list))
379 (cons 1.5 (caddr display-time-load-list)) 433 (cons 1.5 (caddr display-time-load-list))
380 (cons 2.0 (cadddr display-time-load-list)) 434 (cons 2.0 (cadddr display-time-load-list))
381 (cons 2.5 (cadr (cdddr display-time-load-list))) 435 (cons 2.5 (cadr (cdddr display-time-load-list)))
382 (cons 3.0 (caddr (cdddr display-time-load-list))) 436 (cons 3.0 (caddr (cdddr display-time-load-list)))
383 (cons 100000 100000))) 437 (cons 100000 100000)))
384 result elem) 438 elem load-elem)
385 (if (not (display-time-can-do-graphical-display textual)) 439 (if (not (display-time-can-do-graphical-display textual))
386 load-string 440 load-string
387 (display-time-generate-load-glyphs) 441 (display-time-generate-load-glyphs)
388 (while (>= load-number (cdr (setq elem (pop alist)))) 442 (while (>= load-number (cdr (setq elem (pop alist))))
389 (setq result (eval (intern-soft (concat 443 (setq load-elem elem))
390 "display-time-load-" 444 (eval (intern-soft (concat "display-time-load-"
391 (number-to-string (car elem)) 445 (number-to-string (car load-elem)) "-glyph"))))))
392 "-glyph")))))
393 result)))
394 446
395 (defun display-time-convert-am-pm (ampm-string &optional textual) 447 (defun display-time-convert-am-pm (ampm-string &optional textual)
396 (if (not (display-time-can-do-graphical-display textual)) 448 (if (not (display-time-can-do-graphical-display textual))
397 ampm-string 449 ampm-string
398 (cond ((equal ampm-string "am") display-time-am-glyph) 450 (cond ((equal ampm-string "am") display-time-am-glyph)