emacs/lisp/dawn.el

75 lines
2.2 KiB
EmacsLisp

;;; dawn.el --- Do things at dawn (and dusk) -*- lexical-binding: t; -*-
;;; Commentary:
;; There is also circadian.el, but it doesn't quite work for me.
;; This code comes mostly from https://gnu.xyz/auto_theme.html, but also
;; somewhere else (which I've forgotten) and my own brain :)
;;; Code:
(require 'calendar)
(require 'cl-lib)
(require 'solar)
(defvar dawn--dawn-timer nil
"Timer for dawn-command.")
(defvar dawn--dusk-timer nil
"Timer for dusk-command.")
(defvar dawn--reset-timer nil
"Timer to reset dawn at midnight.")
(defun dawn-encode-time (f)
"Encode fractional time F."
(let ((hhmm (cl-floor f))
(date (cdddr (decode-time))))
(encode-time
(append (list 0
(round (* 60 (cadr hhmm)))
(car hhmm)
)
date))))
(defun dawn-midnight ()
"Return the time of the /next/ midnight."
(let ((date (cdddr (decode-time))))
(encode-time
(append (list 0 0 0 (1+ (car date))) (cdr date)))))
(defun dawn-sunrise ()
"Return the time of today's sunrise."
(dawn-encode-time (caar (solar-sunrise-sunset (calendar-current-date)))))
(defun dawn-sunset ()
"Return the time of today's sunset."
(dawn-encode-time (caadr (solar-sunrise-sunset (calendar-current-date)))))
(defun dawn-schedule (dawn-command dusk-command)
"Run DAWN-COMMAND at sunrise, and DUSK-COMMAND at dusk.
RESET is an argument for internal use."
(let ((dawn (dawn-sunrise))
(dusk (dawn-sunset)))
(cond
((time-less-p nil dawn)
;; If it isn't dawn yet, it's still dark. Run DUSK-COMMAND and schedule
;; DAWN-COMMAND and DUSK-COMMAND for later.
(funcall dusk-command)
(run-at-time dawn nil dawn-command)
(run-at-time dusk nil dusk-command))
((time-less-p nil dusk)
;; If it isn't dusk yet, it's still light. Run DAWN-COMMAND and schedule
;; DUSK-COMMAND.
(funcall dawn-command)
(run-at-time dusk nil dusk-command))
(t ;; Otherwise, it's past dusk, so run DUSK-COMMAND.
(funcall dusk-command)))
;; Schedule a reset at midnight, to re-calculate dawn/dusk times.
;(unless reset)
(run-at-time (dawn-midnight) nil
#'dawn-schedule dawn-command dusk-command)))
(provide 'dawn)
;;; dawn.el ends here