/[emacs]/emacs/lisp/time.el
ViewVC logotype

Diff of /emacs/lisp/time.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.75 by rms, Tue Apr 30 17:56:19 2002 UTC revision 1.75.2.1 by miles, Fri Apr 4 06:20:11 2003 UTC
# Line 1  Line 1 
1  ;;; time.el --- display time, load and mail indicator in mode line of Emacs  ;;; time.el --- display time, load and mail indicator in mode line of Emacs -*-coding: utf-8 -*-
2    
3  ;; Copyright (C) 1985, 86, 87, 93, 94, 96, 2000, 2001, 2002  ;; Copyright (C) 1985, 86, 87, 93, 94, 96, 2000, 2001, 2002, 2003
4  ;;   Free Software Foundation, Inc.  ;;   Free Software Foundation, Inc.
5    
6  ;; Maintainer: FSF  ;; Maintainer: FSF
# Line 39  Line 39 
39    "*File name of mail inbox file, for indicating existence of new mail.    "*File name of mail inbox file, for indicating existence of new mail.
40  Non-nil and not a string means don't check for mail.  nil means use  Non-nil and not a string means don't check for mail.  nil means use
41  default, which is system-dependent, and is the same as used by Rmail."  default, which is system-dependent, and is the same as used by Rmail."
42    :type '(choice (const :tag "(None)" none)    :type '(choice (const :tag "None" none)
43                   (const :tag "Default" nil)                   (const :tag "Default" nil)
44                   (file :format "%v"))                   (file :format "%v"))
45    :group 'display-time)    :group 'display-time)
# Line 62  directory `display-time-mail-directory' Line 62  directory `display-time-mail-directory'
62    :group 'display-time)    :group 'display-time)
63    
64  (defcustom display-time-default-load-average 0  (defcustom display-time-default-load-average 0
65    "*Which load-average value will be shown in the mode line.    "*Which load average value will be shown in the mode line.
66  Almost every system can provide values of load for past 1 minute, past 5 or  Almost every system can provide values of load for past 1 minute, past 5 or
67  past 15 minutes.  The default is to display 1 minute load average."  past 15 minutes.  The default is to display 1 minute load average."
68    :type '(choice (const :tag "1 minute load" 0)    :type '(choice (const :tag "1 minute load" 0)
69                   (const :tag "5 minutes load" 1)                   (const :tag "5 minutes load" 1)
70                   (const :tag "15 minutes load" 2))                   (const :tag "15 minutes load" 2)
71                     (const :tag "None" nil))
72    :group 'display-time)    :group 'display-time)
73    
74  (defvar display-time-load-average display-time-default-load-average)  (defvar display-time-load-average nil
75      "Load average currently being shown in mode line.")
76    
77  (defcustom display-time-load-average-threshold 0.1  (defcustom display-time-load-average-threshold 0.1
78    "*Load-average values below this value won't be shown in the mode line."    "*Load-average values below this value won't be shown in the mode line."
# Line 117  This runs the normal hook `display-time- Line 119  This runs the normal hook `display-time-
119    (interactive)    (interactive)
120    (display-time-mode 1))    (display-time-mode 1))
121    
122  (defcustom display-time-mail-face 'mode-line  ;; This business used to be simpler when all mode lines had the same
123    ;; face and the image could just be pbm.  Now we try to rely on an xpm
124    ;; image with a transparent background.  Otherwise, set the background
125    ;; for pbm.
126    
127    (defcustom display-time-mail-face nil
128    "Face to use for `display-time-mail-string'.    "Face to use for `display-time-mail-string'.
129  If `display-time-use-mail-icon' is non-nil, the image's background  If `display-time-use-mail-icon' is non-nil, the image's
130  colour is the background of this face.  Set this to a face other than  background colour is the background of this face.  Set this to
131  `mode-line' to make the mail indicator stand out on a suitable  make the mail indicator stand out on a colour display."
 display."  
132    :group 'faces    :group 'faces
133    :group 'display-time    :group 'display-time
134    :type 'face)    :version "21.4"
135      :type '(choice (const :tag "None" nil) face))
136    
137  (defvar display-time-mail-icon  (defvar display-time-mail-icon
138    (find-image '((:type xpm :file "letter.xpm" :ascent center)    (find-image '((:type xpm :file "letter.xpm" :ascent center)
139                  (:type xbm :file "letter.xbm" :ascent center)))                  (:type pbm :file "letter.pbm" :ascent center)))
140    "Image specification to offer as the mail indicator on a graphic    "Image specification to offer as the mail indicator on a graphic display.
141  display.  See `display-time-use-mail-icon' and  See `display-time-use-mail-icon' and `display-time-mail-face'.")
 `display-time-mail-face'.")  
142    
143    ;; Fixme: Default to icon on graphical display?
144  (defcustom display-time-use-mail-icon nil  (defcustom display-time-use-mail-icon nil
145    "Non-nil means use an icon as the mail indicator on a graphic display.    "Non-nil means use an icon as the mail indicator on a graphic display.
146  Otherwise use the string \"Mail\".  The icon may consume less of the  Otherwise use `display-time-mail-string'.  The icon may consume less
147  mode line.  It is specified by `display-time-mail-icon'."  of the mode line.  It is specified by `display-time-mail-icon'."
148    :group 'display-time    :group 'display-time
149    :type 'boolean)    :type 'boolean)
150    
151    ;; Fixme: maybe default to the character if we can display Unicode.
152    (defcustom display-time-mail-string "Mail"
153      "String to use as the mail indicator in `display-time-string-forms'.
154    This can use the Unicode letter character if you can display it."
155      :group 'display-time
156      :version "21.4"
157      :type '(choice (const "Mail")
158                     ;; Use :tag here because the Lucid menu won't display
159                     ;; multibyte text.
160                     (const :tag "Unicode letter character" "✉")
161                     string))
162    
163  (defcustom display-time-format nil  (defcustom display-time-format nil
164    "*A string specifying the format for displaying the time in the mode line.    "*A string specifying the format for displaying the time in the mode line.
165  See the function `format-time-string' for an explanation of  See the function `format-time-string' for an explanation of
# Line 160  depend on `display-time-day-and-date' an Line 179  depend on `display-time-day-and-date' an
179      load      load
180      (if mail      (if mail
181          ;; Build the string every time to act on customization.          ;; Build the string every time to act on customization.
182          (concat " "          ;; :set-after doesn't help for `customize-option'.  I think it
183                  (propertize          ;; should.
184                   "Mail"          (concat
185                   'display `(when (and display-time-use-mail-icon           " "
186                                        (display-graphic-p))           (propertize
187                               ,@display-time-mail-icon            display-time-mail-string
188                               ,@(list :background (face-attribute            'display `(when (and display-time-use-mail-icon
189                                                    display-time-mail-face                                 (display-graphic-p))
190                                                    :background)))                        ,@display-time-mail-icon
191                   'help-echo "You have new mail; mouse-2: Read mail"                        ,@(if (and display-time-mail-face
192                   'local-map (make-mode-line-mouse-map 'mouse-2                                   (memq (plist-get (cdr display-time-mail-icon)
193                                                        read-mail-command)))                                                    :type)
194                                           '(pbm xbm)))
195                                (let ((bg (face-attribute display-time-mail-face
196                                                          :background)))
197                                  (if (stringp bg)
198                                      (list :background bg)))))
199              'face display-time-mail-face
200              'help-echo "You have new mail; mouse-2: Read mail"
201              'local-map (make-mode-line-mouse-map 'mouse-2
202                                                   read-mail-command)))
203        ""))        ""))
204    "*A list of expressions governing display of the time in the mode line.    "*A list of expressions governing display of the time in the mode line.
205  For most purposes, you can control the time format using `display-time-format'  For most purposes, you can control the time format using `display-time-format'
# Line 238  would give mode line times like `94/12/3 Line 266  would give mode line times like `94/12/3
266          size          size
267        nil)))        nil)))
268    
 ;; Update the display-time info for the mode line  
 ;; but don't redisplay right now.  This is used for  
 ;; things like Rmail `g' that want to force an update  
 ;; which can wait for the next redisplay.  
269  (defun display-time-update ()  (defun display-time-update ()
270      "Update the display-time info for the mode line.
271    However, don't redisplay right now.
272    
273    This is used for things like Rmail `g' that want to force an
274    update which can wait for the next redisplay."
275    (let* ((now (current-time))    (let* ((now (current-time))
276           (time (current-time-string now))           (time (current-time-string now))
277           (load (condition-case ()           (load (if (null display-time-load-average)
278                     ;; Do not show values less than                     ""
279                     ;; `display-time-load-average-threshold'.                   (condition-case ()
280                     (if (> (* display-time-load-average-threshold 100)                       ;; Do not show values less than
281                             (nth display-time-load-average (load-average)))                       ;; `display-time-load-average-threshold'.
282                         ""                       (if (> (* display-time-load-average-threshold 100)
283                       ;; The load average number is mysterious, so                              (nth display-time-load-average (load-average)))
284                       ;; provide some help.                           ""
285                       (let ((str (format " %03d" (nth display-time-load-average (load-average)))))                         ;; The load average number is mysterious, so
286                         (propertize                         ;; provide some help.
287                          (concat (substring str 0 -2) "." (substring str -2))                         (let ((str (format " %03d"
288                          'local-map (make-mode-line-mouse-map 'mouse-2                                            (nth display-time-load-average
289                                                               'display-time-next-load-average)                                                 (load-average)))))
290                          'help-echo (concat "System load average for past "                           (propertize
291                                             (if (= 0 display-time-load-average)                            (concat (substring str 0 -2) "." (substring str -2))
292                                                 "1 minute"                            'local-map (make-mode-line-mouse-map
293                                               (if (= 1 display-time-load-average)                                        'mouse-2 'display-time-next-load-average)
294                                                   "5 minutes"                            'help-echo (concat
295                                                 "15 minutes")) "; mouse-2: next" ))))                                        "System load average for past "
296                   (error "")))                                        (if (= 0 display-time-load-average)
297                                              "1 minute"
298                                            (if (= 1 display-time-load-average)
299                                                "5 minutes"
300                                              "15 minutes"))
301                                          "; mouse-2: next"))))
302                       (error ""))))
303           (mail-spool-file (or display-time-mail-file           (mail-spool-file (or display-time-mail-file
304                                (getenv "MAIL")                                (getenv "MAIL")
305                                (concat rmail-spool-directory                                (concat rmail-spool-directory
# Line 279  would give mode line times like `94/12/3 Line 314  would give mode line times like `94/12/3
314                              (> (- (nth 1 now) display-time-server-down-time)                              (> (- (nth 1 now) display-time-server-down-time)
315                                 1200)                                 1200)
316                              (and (< (nth 1 now) display-time-server-down-time)                              (and (< (nth 1 now) display-time-server-down-time)
317                                   (> (- (nth 1 now) display-time-server-down-time)                                   (> (- (nth 1 now)
318                                           display-time-server-down-time)
319                                      -64336)))                                      -64336)))
320                          (let ((start-time (current-time)))                          (let ((start-time (current-time)))
321                            (prog1                            (prog1
322                                (display-time-file-nonempty-p mail-spool-file)                                (display-time-file-nonempty-p mail-spool-file)
323                              (if (> (- (nth 1 (current-time)) (nth 1 start-time))                              (if (> (- (nth 1 (current-time))
324                                          (nth 1 start-time))
325                                     20)                                     20)
326                                  ;; Record that mail file is not accessible.                                  ;; Record that mail file is not accessible.
327                                  (setq display-time-server-down-time                                  (setq display-time-server-down-time
# Line 330  If `display-time-day-and-date' is non-ni Line 367  If `display-time-day-and-date' is non-ni
367  are displayed as well.  are displayed as well.
368  This runs the normal hook `display-time-hook' after each update."  This runs the normal hook `display-time-hook' after each update."
369    :global t :group 'display-time    :global t :group 'display-time
370      (and display-time-timer (cancel-timer display-time-timer))    (and display-time-timer (cancel-timer display-time-timer))
371      (setq display-time-timer nil)    (setq display-time-timer nil)
372      (setq display-time-string "")    (setq display-time-string "")
373      (or global-mode-string (setq global-mode-string '("")))    (or global-mode-string (setq global-mode-string '("")))
374      (if display-time-mode    (setq display-time-load-average display-time-default-load-average)
375          (progn    (if display-time-mode
376            (or (memq 'display-time-string global-mode-string)        (progn
377                (setq global-mode-string          (or (memq 'display-time-string global-mode-string)
378                      (append global-mode-string '(display-time-string))))              (setq global-mode-string
379            ;; Set up the time timer.                    (append global-mode-string '(display-time-string))))
380            (setq display-time-timer          ;; Set up the time timer.
381                  (run-at-time t display-time-interval          (setq display-time-timer
382                               'display-time-event-handler))                (run-at-time t display-time-interval
383            ;; Make the time appear right away.                             'display-time-event-handler))
384            (display-time-update)          ;; Make the time appear right away.
385            ;; When you get new mail, clear "Mail" from the mode line.          (display-time-update)
386            (add-hook 'rmail-after-get-new-mail-hook          ;; When you get new mail, clear "Mail" from the mode line.
387                      'display-time-event-handler))          (add-hook 'rmail-after-get-new-mail-hook
388        (remove-hook 'rmail-after-get-new-mail-hook                    'display-time-event-handler))
389                     'display-time-event-handler)))      (remove-hook 'rmail-after-get-new-mail-hook
390                     'display-time-event-handler)))
391    
392  (provide 'time)  (provide 'time)
393    

Legend:
Removed from v.1.75  
changed lines
  Added in v.1.75.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26