Compare commits
5 Commits
dev
...
alert-macr
Author | SHA1 | Date |
---|---|---|
contrapunctus | 71f5328d41 | |
contrapunctus | a1ec07c52e | |
contrapunctus | aee7453ff8 | |
contrapunctus | 21c442069e | |
contrapunctus | d69944b81c |
|
@ -1105,6 +1105,7 @@ hash table values must be in chronological order.")
|
||||||
|
|
||||||
;; [[file:chronometrist.org::*on-file-path-change][on-file-path-change:1]]
|
;; [[file:chronometrist.org::*on-file-path-change][on-file-path-change:1]]
|
||||||
(cl-defmethod chronometrist-on-file-path-change ((backend chronometrist-file-backend-mixin) _old-path new-path)
|
(cl-defmethod chronometrist-on-file-path-change ((backend chronometrist-file-backend-mixin) _old-path new-path)
|
||||||
|
"Update path and file slots of BACKEND to use NEW-PATH when `chronometrist-file' is changed."
|
||||||
(with-slots (path extension file) backend
|
(with-slots (path extension file) backend
|
||||||
(setf path new-path
|
(setf path new-path
|
||||||
file (concat path "." extension))))
|
file (concat path "." extension))))
|
||||||
|
@ -3518,6 +3519,39 @@ Return value is a list as specified by `tabulated-list-entries'."
|
||||||
do (cl-incf index)))
|
do (cl-incf index)))
|
||||||
;; rows:1 ends here
|
;; rows:1 ends here
|
||||||
|
|
||||||
|
;; [[file:chronometrist.org::*define-alert-system][define-alert-system:1]]
|
||||||
|
(defmacro chronometrist-define-alert-system (extension initvalue &rest custom-args)
|
||||||
|
"Define an alerts system for EXTENSION.
|
||||||
|
Defines a custom variable `chronometrist-EXTENSION-alerts-alist'
|
||||||
|
with INITVALUE and CUSTOM-ARGS, a variable
|
||||||
|
`chronometrist-EXTENSION--timer-list', and a procedure
|
||||||
|
`chronometrist-EXTENSION-run-at-time'."
|
||||||
|
(let* ((prefix (format "chronometrist-%s" extension))
|
||||||
|
(custom-var (intern (format "%s-alerts-alist" prefix)))
|
||||||
|
(list-var (intern (format "%s--timer-alist" prefix)))
|
||||||
|
(function (intern (format "%s-run-at-time" prefix))))
|
||||||
|
`(progn
|
||||||
|
(defcustom ,custom-var ,initvalue
|
||||||
|
,(let ((docstring (format "Alist of alerts run by `%s'.
|
||||||
|
|
||||||
|
Each element must be in the form (SYMBOL FUNCTION ALERT-FN &rest ALERT-ARGS),
|
||||||
|
where SYMBOL uniquely identifies the alert,
|
||||||
|
FUNCTION is a function calling `%s' and ALERT-FN,
|
||||||
|
and ALERT-ARGS are passed to ALERT-FN."
|
||||||
|
prefix function)))
|
||||||
|
(with-temp-buffer
|
||||||
|
(insert docstring)
|
||||||
|
(fill-region (point-min) (point-max))
|
||||||
|
(buffer-substring-no-properties (point-min) (point-max))))
|
||||||
|
,@custom-args)
|
||||||
|
(defvar ,list-var nil ,(format "Alist of timers created for `%s'." prefix))
|
||||||
|
(defun ,function (time repeat function &rest args)
|
||||||
|
,(format "Like `run-at-time', but store timer objects in `%s'." ,list-var)
|
||||||
|
(cl-pushnew (apply #'run-at-time time repeat function args) ,list-var)))))
|
||||||
|
|
||||||
|
;; (chronometrist-define-alert-system foo nil)
|
||||||
|
;; define-alert-system:1 ends here
|
||||||
|
|
||||||
(provide 'chronometrist)
|
(provide 'chronometrist)
|
||||||
|
|
||||||
;;; chronometrist.el ends here
|
;;; chronometrist.el ends here
|
||||||
|
|
|
@ -1810,9 +1810,10 @@ These can be implemented in terms of the minimal protocol above.
|
||||||
(find-file-noselect file)))))
|
(find-file-noselect file)))))
|
||||||
#+END_SRC
|
#+END_SRC
|
||||||
|
|
||||||
**** on-file-path-change :generic:function:
|
**** on-file-path-change :writer:method:
|
||||||
#+BEGIN_SRC emacs-lisp
|
#+BEGIN_SRC emacs-lisp
|
||||||
(cl-defmethod chronometrist-on-file-path-change ((backend chronometrist-file-backend-mixin) _old-path new-path)
|
(cl-defmethod chronometrist-on-file-path-change ((backend chronometrist-file-backend-mixin) _old-path new-path)
|
||||||
|
"Update path and file slots of BACKEND to use NEW-PATH when `chronometrist-file' is changed."
|
||||||
(with-slots (path extension file) backend
|
(with-slots (path extension file) backend
|
||||||
(setf path new-path
|
(setf path new-path
|
||||||
file (concat path "." extension))))
|
file (concat path "." extension))))
|
||||||
|
@ -4756,6 +4757,41 @@ Return value is a list as specified by `tabulated-list-entries'."
|
||||||
do (cl-incf index)))
|
do (cl-incf index)))
|
||||||
#+END_SRC
|
#+END_SRC
|
||||||
|
|
||||||
|
** Extension utilities
|
||||||
|
*** define-alert-system
|
||||||
|
#+BEGIN_SRC emacs-lisp
|
||||||
|
(defmacro chronometrist-define-alert-system (extension initvalue &rest custom-args)
|
||||||
|
"Define an alerts system for EXTENSION.
|
||||||
|
Defines a custom variable `chronometrist-EXTENSION-alerts-alist'
|
||||||
|
with INITVALUE and CUSTOM-ARGS, a variable
|
||||||
|
`chronometrist-EXTENSION--timer-list', and a procedure
|
||||||
|
`chronometrist-EXTENSION-run-at-time'."
|
||||||
|
(let* ((prefix (format "chronometrist-%s" extension))
|
||||||
|
(custom-var (intern (format "%s-alerts-alist" prefix)))
|
||||||
|
(list-var (intern (format "%s--timer-alist" prefix)))
|
||||||
|
(function (intern (format "%s-run-at-time" prefix))))
|
||||||
|
`(progn
|
||||||
|
(defcustom ,custom-var ,initvalue
|
||||||
|
,(let ((docstring (format "Alist of alerts run by `%s'.
|
||||||
|
|
||||||
|
Each element must be in the form (SYMBOL FUNCTION ALERT-FN &rest ALERT-ARGS),
|
||||||
|
where SYMBOL uniquely identifies the alert,
|
||||||
|
FUNCTION is a function calling `%s' and ALERT-FN,
|
||||||
|
and ALERT-ARGS are passed to ALERT-FN."
|
||||||
|
prefix function)))
|
||||||
|
(with-temp-buffer
|
||||||
|
(insert docstring)
|
||||||
|
(fill-region (point-min) (point-max))
|
||||||
|
(buffer-substring-no-properties (point-min) (point-max))))
|
||||||
|
,@custom-args)
|
||||||
|
(defvar ,list-var nil ,(format "Alist of timers created for `%s'." prefix))
|
||||||
|
(defun ,function (time repeat function &rest args)
|
||||||
|
,(format "Like `run-at-time', but store timer objects in `%s'." ,list-var)
|
||||||
|
(cl-pushnew (apply #'run-at-time time repeat function args) ,list-var)))))
|
||||||
|
|
||||||
|
;; (chronometrist-define-alert-system foo nil)
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
** Provide
|
** Provide
|
||||||
#+BEGIN_SRC emacs-lisp :comments no
|
#+BEGIN_SRC emacs-lisp :comments no
|
||||||
(provide 'chronometrist)
|
(provide 'chronometrist)
|
||||||
|
|
Reference in New Issue