--- ./time.el 2021-11-28 16:21:48.518437586 +0100 +++ /home/arthur/repos/time.el 2021-12-01 23:00:43.761860792 +0100 @@ -110,6 +110,10 @@ "List of functions to be called when the time is updated on the mode line." :type 'hook) +(defcustom display-time-update-hooks nil + "List of functions to be called when the time is updated." + :type 'hook) + (defvar display-time-server-down-time nil "Time when mail file's file system was recorded to be down. If that file system seems to be up, the value is nil.") @@ -171,17 +175,34 @@ :type '(choice (const :tag "Default" nil) string)) +(defvar display-time-now nil) +(defvar display-time-time nil) +(defvar display-time-load nil) +(defvar display-time-mail nil) +(defvar display-time-24-hours nil) +(defvar display-time-hour nil) +(defvar display-time-12-hours nil) +(defvar display-time-am-pm nil) +(defvar display-time-minutes nil) +(defvar display-time-seconds nil) +(defvar display-time-time-zone nil) +(defvar display-time-day nil) +(defvar display-time-year nil) +(defvar display-time-monthname nil) +(defvar display-time-month nil) +(defvar display-time-dayname nil) + (defcustom display-time-string-forms '((if (and (not display-time-format) display-time-day-and-date) - (format-time-string "%a %b %e " now) + (format-time-string "%a %b %e " display-time-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 + display-time-now) + 'help-echo (format-time-string "%a %b %e, %Y" display-time-now)) + display-time-load + (if display-time-mail ;; Build the string every time to act on customization. ;; :set-after doesn't help for `customize-option'. I think it ;; should. @@ -225,7 +246,8 @@ would give mode line times like `94/12/30 21:07:48 (UTC)'." :type '(repeat sexp)) - + +;;; Implementation (defun display-time-event-handler () (display-time-update) (let* ((current (current-time)) @@ -266,25 +288,6 @@ size nil))) -(with-no-warnings - ;; Warnings are suppressed to avoid "global/dynamic var `X' lacks a prefix". - (defvar now) - (defvar time) - (defvar load) - (defvar mail) - (defvar 24-hours) - (defvar hour) - (defvar 12-hours) - (defvar am-pm) - (defvar minutes) - (defvar seconds) - (defvar time-zone) - (defvar day) - (defvar year) - (defvar monthname) - (defvar month) - (defvar dayname)) - (defun display-time-update--load () (if (null display-time-load-average) "" @@ -339,40 +342,42 @@ end-time start-time)) (float-time end-time)))))))))) +(defun display-time-update--mode-line () + (run-hooks 'display-time-hook) + (force-mode-line-update 'all)) + (defun display-time-update () + "Run all registered hooks that wish to be updated on a clock beat." "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 (display-time-update--load)) - (mail (display-time-update--mail)) - (24-hours (substring time 11 13)) - (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)) - (seconds (substring time 17 19)) - (time-zone (car (cdr (current-time-zone now)))) - (day (substring time 8 10)) - (year (format-time-string "%Y" now)) - (monthname (substring time 4 7)) - (month - (cdr - (assoc - monthname - '(("Jan" . "1") ("Feb" . "2") ("Mar" . "3") ("Apr" . "4") - ("May" . "5") ("Jun" . "6") ("Jul" . "7") ("Aug" . "8") - ("Sep" . "9") ("Oct" . "10") ("Nov" . "11") ("Dec" . "12"))))) - (dayname (substring time 0 3))) - (setq display-time-string - (mapconcat 'eval display-time-string-forms "")) - ;; This is inside the let binding, but we are not going to document - ;; what variables are available. - (run-hooks 'display-time-hook)) - (force-mode-line-update 'all)) + (setq + display-time-now (current-time) + display-time-time (current-time-string display-time-now) + display-time-load (display-time-update--load) + display-time-mail (display-time-update--mail) + display-time-24-hours (substring display-time-time 11 13) + display-time-hour (string-to-number display-time-24-hours) + display-time-12-hours (int-to-string (1+ (% (+ display-time-hour 11) 12))) + display-time-am-pm (if (>= display-time-hour 12) "pm" "am") + display-time-minutes (substring display-time-time 14 16) + display-time-seconds (substring display-time-time 17 19) + display-time-time-zone (car (cdr (current-time-zone display-time-now))) + display-time-day (substring display-time-time 8 10) + display-time-year (format-time-string "%Y" display-time-now) + display-time-monthname (substring display-time-time 4 7) + display-time-month + (cdr + (assoc + display-time-monthname + '(("Jan" . "1") ("Feb" . "2") ("Mar" . "3") ("Apr" . "4") + ("May" . "5") ("Jun" . "6") ("Jul" . "7") ("Aug" . "8") + ("Sep" . "9") ("Oct" . "10") ("Nov" . "11") ("Dec" . "12")))) + display-time-dayname (substring display-time-time 0 3) + display-time-string (mapconcat 'eval display-time-string-forms "")) + (run-hooks 'display-time-update-hooks)) (defun display-time-file-nonempty-p (file) (let ((remote-file-name-inhibit-cache (- display-time-interval 5))) @@ -381,37 +386,53 @@ (file-attributes (file-chase-links file))))))) ;;;###autoload -(define-minor-mode display-time-mode - "Toggle display of time, load level, and mail flag in mode lines. +(define-minor-mode update-time-mode + "Internal mode used to setup timerand hooks for periodic clock updates. -When Display Time mode is enabled, it updates every minute (you -can control the number of seconds between updates by customizing -`display-time-interval'). If `display-time-day-and-date' is -non-nil, the current day and date are displayed as well. This -runs the normal hook `display-time-hook' after each update." +To customize update interval choose display-time variables as defined by +DISPLAY-TIME-UPDATE mode." :global t :group 'display-time (and display-time-timer (cancel-timer display-time-timer)) (setq display-time-timer nil) - (setq display-time-string "") - (or global-mode-string (setq global-mode-string '(""))) (setq display-time-load-average display-time-default-load-average) (if display-time-mode (progn - (or (memq 'display-time-string global-mode-string) - (setq global-mode-string - (append global-mode-string '(display-time-string)))) ;; Set up the time timer. (setq display-time-timer (run-at-time t display-time-interval - 'display-time-event-handler)) - ;; Make the time appear right away. - (display-time-update) - ;; When you get new mail, clear "Mail" from the mode line. - (add-hook 'rmail-after-get-new-mail-hook - 'display-time-event-handler)) - (remove-hook 'rmail-after-get-new-mail-hook - 'display-time-event-handler))) + 'display-time-event-handler))))) + +;;;###autoload +(define-minor-mode display-time-mode + "Toggle display of time, load level, and mail flag in mode lines. +When Display Time mode is enabled, it updates every minute (you +can control the number of seconds between updates by customizing +`display-time-interval'). If `display-time-day-and-date' is +non-nil, the current day and date are displayed as well. This +runs the normal hook `display-time-hook' after each update." + :global t :group 'display-time + (cond + (display-time-mode + (update-time-mode 1) + (or global-mode-string (setq global-mode-string '(""))) + (or (memq 'display-time-string global-mode-string) + (setq global-mode-string + (append global-mode-string '(display-time-string)))) + ;; When you get new mail, clear "Mail" from the mode line. + (add-hook 'rmail-after-get-new-mail-hook + 'display-time-event-handler) + (add-hook 'display-time-update-hooks + 'display-time-update--mode-line) + ;; Make the time appear right away. + (display-time-update--mode-line)) + (t + (setq global-mode-string + (remove 'display-time-string global-mode-string)) + (remove-hook 'rmail-after-get-new-mail-hook + 'display-time-event-handler) + (add-hook 'display-time-update-hooks + 'display-time-update--mode-line)))) ;;; Obsolete names