-;;; 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 -*-
-;; Copyright (C) 1985, 86, 87, 93, 94, 96, 2000, 2001, 2002
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1996, 2000, 2001, 2002,
+;; 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
;; Maintainer: FSF
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
:group 'display-time)
(defcustom display-time-default-load-average 0
- "*Which load-average value will be shown in the mode line.
+ "*Which load average value will be shown in the mode line.
Almost every system can provide values of load for past 1 minute, past 5 or
past 15 minutes. The default is to display 1 minute load average."
:type '(choice (const :tag "1 minute load" 0)
:group 'display-time)
(defvar display-time-load-average nil
- "Load average currently being shown in mode line")
+ "Load average currently being shown in mode line.")
(defcustom display-time-load-average-threshold 0.1
"*Load-average values below this value won't be shown in the mode line."
(interactive)
(display-time-mode 1))
-(defcustom display-time-mail-face 'mode-line
+;; This business used to be simpler when all mode lines had the same
+;; face and the image could just be pbm. Now we try to rely on an xpm
+;; image with a transparent background. Otherwise, set the background
+;; for pbm.
+
+(defcustom display-time-mail-face nil
"Face to use for `display-time-mail-string'.
-If `display-time-use-mail-icon' is non-nil, the image's background
-colour is the background of this face. Set this to a face other than
-`mode-line' to make the mail indicator stand out on a suitable
-display."
- :group 'faces
+If `display-time-use-mail-icon' is non-nil, the image's
+background color is the background of this face. Set this to
+make the mail indicator stand out on a color display."
+ :group 'mode-line-faces
:group 'display-time
- :type 'face)
+ :version "22.1"
+ :type '(choice (const :tag "None" nil) face))
(defvar display-time-mail-icon
(find-image '((:type xpm :file "letter.xpm" :ascent center)
- (:type xbm :file "letter.xbm" :ascent center)))
- "Image specification to offer as the mail indicator on a graphic
-display. See `display-time-use-mail-icon' and
-`display-time-mail-face'.")
+ (:type pbm :file "letter.pbm" :ascent center)))
+ "Image specification to offer as the mail indicator on a graphic display.
+See `display-time-use-mail-icon' and `display-time-mail-face'.")
+;; Fixme: Default to icon on graphical display?
(defcustom display-time-use-mail-icon nil
- "Non-nil means use an icon as the mail indicator on a graphic display.
-Otherwise use the string \"Mail\". The icon may consume less of the
-mode line. It is specified by `display-time-mail-icon'."
+ "Non-nil means use an icon as mail indicator on a graphic display.
+Otherwise use `display-time-mail-string'. The icon may consume less
+of the mode line. It is specified by `display-time-mail-icon'."
:group 'display-time
:type 'boolean)
+;; Fixme: maybe default to the character if we can display Unicode.
+(defcustom display-time-mail-string "Mail"
+ "String to use as the mail indicator in `display-time-string-forms'.
+This can use the Unicode letter character if you can display it."
+ :group 'display-time
+ :version "22.1"
+ :type '(choice (const "Mail")
+ ;; Use :tag here because the Lucid menu won't display
+ ;; multibyte text.
+ (const :tag "Unicode letter character" "✉")
+ string))
+
(defcustom display-time-format nil
- "*A string specifying the format for displaying the time in the mode line.
+ "*String specifying format for displaying the time in the mode line.
See the function `format-time-string' for an explanation of
how to write this string. If this is nil, the defaults
depend on `display-time-day-and-date' and `display-time-24hr-format'."
'((if (and (not display-time-format) display-time-day-and-date)
(format-time-string "%a %b %e " now)
"")
- (format-time-string (or display-time-format
- (if display-time-24hr-format "%H:%M" "%-I:%M%p"))
- now)
+ (propertize
+ (format-time-string (or display-time-format
+ (if display-time-24hr-format "%H:%M" "%-I:%M%p"))
+ now)
+ 'help-echo (format-time-string "%a %b %e, %Y" now))
load
(if mail
;; Build the string every time to act on customization.
- (concat " "
- (propertize
- "Mail"
- 'display `(when (and display-time-use-mail-icon
- (display-graphic-p))
- ,@display-time-mail-icon
- ,@(list :background (face-attribute
- display-time-mail-face
- :background)))
- 'face display-time-mail-face
- 'help-echo "You have new mail; mouse-2: Read mail"
- 'local-map (make-mode-line-mouse-map 'mouse-2
- read-mail-command)))
+ ;; :set-after doesn't help for `customize-option'. I think it
+ ;; should.
+ (concat
+ " "
+ (propertize
+ display-time-mail-string
+ 'display `(when (and display-time-use-mail-icon
+ (display-graphic-p))
+ ,@display-time-mail-icon
+ ,@(if (and display-time-mail-face
+ (memq (plist-get (cdr display-time-mail-icon)
+ :type)
+ '(pbm xbm)))
+ (let ((bg (face-attribute display-time-mail-face
+ :background)))
+ (if (stringp bg)
+ (list :background bg)))))
+ 'face display-time-mail-face
+ 'help-echo "You have new mail; mouse-2: Read mail"
+ 'mouse-face 'mode-line-highlight
+ 'local-map (make-mode-line-mouse-map 'mouse-2
+ read-mail-command)))
""))
- "*A list of expressions governing display of the time in the mode line.
+ "*List of expressions governing display of the time in the mode line.
For most purposes, you can control the time format using `display-time-format'
which is a more standard interface.
size
nil)))
-;; 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.
(defun display-time-update ()
+ "Update the display-time info for the mode line.
+However, 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."
(let* ((now (current-time))
(time (current-time-string now))
(load (if (null display-time-load-average)
""
;; The load average number is mysterious, so
;; provide some help.
- (let ((str (format " %03d" (nth display-time-load-average (load-average)))))
+ (let ((str (format " %03d"
+ (nth display-time-load-average
+ (load-average)))))
(propertize
(concat (substring str 0 -2) "." (substring str -2))
- 'local-map (make-mode-line-mouse-map 'mouse-2
- 'display-time-next-load-average)
- 'help-echo (concat "System load average for past "
- (if (= 0 display-time-load-average)
- "1 minute"
- (if (= 1 display-time-load-average)
- "5 minutes"
- "15 minutes")) "; mouse-2: next" ))))
+ 'local-map (make-mode-line-mouse-map
+ 'mouse-2 'display-time-next-load-average)
+ 'mouse-face 'mode-line-highlight
+ 'help-echo (concat
+ "System load average for past "
+ (if (= 0 display-time-load-average)
+ "1 minute"
+ (if (= 1 display-time-load-average)
+ "5 minutes"
+ "15 minutes"))
+ "; mouse-2: next"))))
(error ""))))
(mail-spool-file (or display-time-mail-file
(getenv "MAIL")
(> (- (nth 1 now) display-time-server-down-time)
1200)
(and (< (nth 1 now) display-time-server-down-time)
- (> (- (nth 1 now) display-time-server-down-time)
+ (> (- (nth 1 now)
+ display-time-server-down-time)
-64336)))
(let ((start-time (current-time)))
(prog1
(display-time-file-nonempty-p mail-spool-file)
- (if (> (- (nth 1 (current-time)) (nth 1 start-time))
+ (if (> (- (nth 1 (current-time))
+ (nth 1 start-time))
20)
;; Record that mail file is not accessible.
(setq display-time-server-down-time
;; Record that mail file is accessible.
(setq display-time-server-down-time nil)))))))
(24-hours (substring time 11 13))
- (hour (string-to-int 24-hours))
+ (hour (string-to-number 24-hours))
(12-hours (int-to-string (1+ (% (+ hour 11) 12))))
(am-pm (if (>= hour 12) "pm" "am"))
(minutes (substring time 14 16))
(provide 'time)
+;;; arch-tag: b9c1623f-b5cb-48e4-b650-482a4d23c5a6
;;; time.el ends here