(eval-when-compile
(require 'cl))
(require 'pp)
(require 'timer-funcs)
(eval-and-compile
(unless (fboundp 'defgroup)
(defmacro defgroup (&rest rest) nil)
(defmacro defcustom (symbol init docstring &rest rest)
`(defvar ,symbol ,init ,docstring))))
(eval-when (load eval)
(unless (fboundp 'values)
(defalias 'values 'list)))
(defconst uptimes-version
(let ((revision "$Revision: 2.2 $"))
(when (string-match ": \\([0-9.]+\\)" revision)
(match-string 1 revision)))
"uptimes version.")
(defgroup uptimes nil
"Track emacs session uptimes."
:group 'games
:prefix "uptimes-")
(defcustom uptimes-database "~/.emacs-uptimes"
"*Database of uptimes."
:type 'file
:group 'uptimes)
(defcustom uptimes-keep-count 10
"*Number of uptimes to keep."
:type 'integer
:group 'uptimes)
(defcustom uptimes-auto-save t
"*Should we auto-save our uptime data?"
:type '(choice (const :tag "Yes, auto-save uptime details" t)
(const :tag "No, don't auto-save details" nil))
:group 'uptimes)
(defcustom uptimes-auto-save-interval 300
"*How often, in seconds, should we auto-save the data?"
:type 'integer
:group 'uptimes)
(defun uptimes-float-time (&optional tm)
"Convert `current-time' to a float number of seconds."
(multiple-value-bind (s0 s1 s2) (or tm (current-time))
(+ (* (float (ash 1 16)) s0) (float s1) (* 0.0000001 s2))))
(defun uptimes-time-float (num)
"Convert the float number of seconds since epoch to the list of 3 integers."
(let* ((div (ash 1 16))
(1st (floor num div)))
(list 1st (floor (- num (* (float div) 1st)))
(round (* 10000000 (mod num 1))))))
(defvar uptimes-boottime (uptimes-float-time)
"The time that uptimes.el came into existance.")
(defvar uptimes-last-n nil
"Last `uptimes-keep-count' uptimes.")
(defvar uptimes-top-n nil
"Top `uptimes-keep-count' uptimes.")
(defvar uptimes-auto-save-timer nil
"Timer object for the auto-saver.
Note that the timer object isn't used in the uptime code but this variable
is provided so that you can kill/restart the timer in your own code.")
(defun* uptimes-key (&optional (boottime uptimes-boottime))
"Return an `assoc' key for the given BOOTTIME.
If not supplied BOOTTIME defaults to `uptimes-boottime'."
(format "%.7f" boottime))
(defun* uptimes-uptime (&optional (boottime uptimes-boottime)
(endtime (uptimes-float-time)))
"Return the uptime of BOOTTIME at ENDTIME."
(- endtime boottime))
(defun* uptimes-uptime-values (&optional (boottime uptimes-boottime)
(endtime (uptimes-float-time)))
"Get the different parts of an uptime.
BOOTTIME is an optional boot-time for an emacs process, if not supplied the
default is the boot-time of the current process. ENDTIME is the optional
time at which the emacs process closed down, if not supplied the default is
the current time.
The result is returned as the following `values':
(DAYS HOURS MINS SECS)"
(let* ((now (uptimes-uptime boottime endtime))
(days (floor (/ now 86400)))
(hours (progn (decf now (* days 86400)) (floor (/ now 3600))))
(mins (progn (decf now (* hours 3600)) (floor (/ now 60))))
(secs (progn (decf now (* mins 60)) (floor now))))
(values days hours mins secs)))
(defun* uptimes-uptime-string (&optional (boottime uptimes-boottime)
(endtime (uptimes-float-time)))
"Return `uptimes-uptime-values' as a human readable string."
(multiple-value-bind (days hours mins secs)
(uptimes-uptime-values boottime endtime)
(format "%d.%02d:%02d:%02d" days hours mins secs)))
(defun* uptimes-wordy-uptime (&optional (boottime uptimes-boottime)
(endtime (uptimes-float-time)))
"Return `uptimes-uptime-values' as a \"wordy\" string."
(multiple-value-bind (days hours mins secs)
(uptimes-uptime-values boottime endtime)
(flet ((mul (n word) (concat word (unless (= n 1) "s")))
(say (n word) (format "%d %s" n (mul n word))))
(concat (say days "day")
", "
(say hours "hour")
", "
(say mins "minute")
" and "
(say secs "second")))))
(defun uptimes-read-uptimes ()
"Read the uptimes database into `uptimes-last-n' and `uptimes-top-n'."
(when (file-exists-p uptimes-database)
(let ((inhibit-clash-detection t))
(with-temp-buffer
(insert-file-contents uptimes-database t)
(setq uptimes-last-n (read (current-buffer)))
(setq uptimes-top-n (read (current-buffer)))))))
(defun uptimes-update ()
"Update `uptimes-last-n' and `uptimes-top-n'."
(uptimes-read-uptimes)
(flet ((trunc (list &optional (where uptimes-keep-count))
(let ((trunc-point (nthcdr (1- where) list)))
(when (consp trunc-point)
(setf (cdr trunc-point) nil)))
list)
(update (list now sort-pred)
(let* ((key (uptimes-key))
(this (cdr (assoc key list))))
(unless this
(setq this (cons uptimes-boottime nil))
(push (cons key this) list))
(setf (cdr this) now)
(trunc (sort list sort-pred)))))
(let ((now (uptimes-float-time)))
(setq uptimes-last-n
(update uptimes-last-n now
(lambda (x y) (> (cddr x) (cddr y)))))
(setq uptimes-top-n
(update uptimes-top-n now
(lambda (x y)
(> (uptimes-uptime (cadr x) (cddr x))
(uptimes-uptime (cadr y) (cddr y)))))))))
(defun uptimes-save-uptimes ()
"Write the uptimes to `uptimes-database'."
(uptimes-update)
(with-temp-buffer
(let ((standard-output (current-buffer))
(inhibit-clash-detection t))
(pp uptimes-last-n)
(pp uptimes-top-n)
(write-region (point-min) (point-max) uptimes-database nil 0))))
(defun uptimes-print-uptimes (list)
"Print uptimes list LIST to `standard-output'."
(princ "Boot Endtime Uptime This emacs\n")
(princ "=================== =================== ============ ==========\n")
(flet ((format-time (time)
(format-time-string "%Y-%m-%d %T" (uptimes-time-float time))))
(loop for uptime in list
for bootsig = (car uptime)
for booted = (cadr uptime)
for snapshot = (cddr uptime)
do (princ (format "%19s %19s %12s %s\n"
(format-time booted)
(format-time snapshot)
(uptimes-uptime-string booted snapshot)
(if (string= bootsig (uptimes-key)) "<--" ""))))))
(defun uptimes ()
"Display the last and top `uptimes-keep-count' uptimes."
(interactive)
(uptimes-save-uptimes)
(with-output-to-temp-buffer "*uptimes*"
(princ (format "Last %d uptimes\n\n" uptimes-keep-count))
(uptimes-print-uptimes uptimes-last-n)
(princ (format "\nTop %d uptimes\n\n" uptimes-keep-count))
(uptimes-print-uptimes uptimes-top-n)))
(defun uptimes-this ()
"Display the uptime for the current emacs session."
(interactive)
(uptimes-save-uptimes)
(message "emacs has been up and running for %s" (uptimes-wordy-uptime)))
(eval-when (load eval)
(uptimes-save-uptimes)
(when uptimes-auto-save
(setq uptimes-auto-save-timer
(run-at-time nil uptimes-auto-save-interval #'uptimes-save-uptimes)))
(add-hook 'kill-emacs-hook #'uptimes-save-uptimes))
(provide 'uptimes)