about summary refs log tree commit diff stats
path: root/lisp/acdw.el
blob: a4e12f1773f080b52799f4e9c9590a75baddd92a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
;;; acdw.el --- various meta-whatevers -*- lexical-binding: t -*-

;;; Commentary:

;; What's that saying about how the hardest things in computer science
;; are naming and off-by-one errors?  Well, the naming one I know very
;; well.  I've been trying to figure out a good way to prefix my
;; bespoke functions, other stuff I found online, and various emacs
;; lisp detritus for quite some time (I reckon at over a year, as of
;; 2021-11-02).  Finally, I found the answer in the writings of Daniel
;; Mendler: I'll prefix everything with a `+' !

;; To that end, pretty much everything in lisp/ will have a filename
;; like "+org.el", except of course this file, and maybe a few
;; /actually original/ libraries I haven't had the wherewithal to
;; package out properly yet.

;; Is it perfect?  No.  Is it fine?  Yes.  Here it is.

;;; Code:

;;; Define a directory and an expanding function

(defmacro +define-dir (name directory &optional docstring inhibit-mkdir)
  "Define a variable and function NAME expanding to DIRECTORY.
DOCSTRING is applied to the variable.  Ensure DIRECTORY exists in
the filesystem, unless INHIBIT-MKDIR is non-nil."
  (declare (indent 2))
  (unless inhibit-mkdir
    (make-directory (eval directory) :parents))
  `(progn
     (defvar ,name ,directory
       ,(concat docstring (when docstring "\n")
                "Defined by `/define-dir'."))
     (defun ,name (file &optional mkdir)
       ,(concat "Expand FILE relative to variable `" (symbol-name name) "'.\n"
                "If MKDIR is non-nil, the directory is created.\n"
                "Defined by `/define-dir'.")
       (let ((file-name (expand-file-name (convert-standard-filename file)
					  ,name)))
         (when mkdir
           (make-directory (file-name-directory file-name) :parents))
         file-name))))


(defun +suppress-messages (oldfn &rest args) ; from pkal
  "Advice wrapper for suppressing `message'.
OLDFN is the wrapped function, that is passed the arguments
ARGS."
  (let ((msg (current-message)))
    (prog1
        (let ((inhibit-message t))
          (apply oldfn args))
      (when msg
        (message "%s" msg)))))

(defun +sunrise-sunset (sunrise-command sunset-command)
  "Run SUNRISE-COMMAND at sunrise, and SUNSET-COMMAND at sunset."
  (let* ((times-regex (rx (* nonl)
                          (: (any ?s ?S) "unrise") " "
                          (group (repeat 1 2 digit) ":"
                                 (repeat 1 2 digit)
                                 (: (any ?a ?A ?p ?P) (any ?m ?M)))
                          (* nonl)
                          (: (any ?s ?S) "unset") " "
                          (group (repeat 1 2 digit) ":"
                                 (repeat 1 2 digit)
                                 (: (any ?a ?A ?p ?P) (any ?m ?M)))
                          (* nonl)))
         (ss (+suppress-messages #'sunrise-sunset))
         (_m (string-match times-regex ss))
         (sunrise-time (match-string 1 ss))
         (sunset-time (match-string 2 ss)))
    (run-at-time sunrise-time (* 60 60 24) sunrise-command)
    (run-at-time sunset-time (* 60 60 24) sunset-command)
    (run-at-time "12:00am" (* 60 60 24) sunset-command)))

(defun +ensure-after-init (function)
  "Ensure FUNCTION runs after init, or now if already initialized.
If Emacs is already started, run FUNCTION.  Otherwise, add it to
`after-init-hook'.  FUNCTION is called with no arguments."
  (if after-init-time
      (funcall function)
    (add-hook 'after-init-hook function)))

(defun +remember-prefix-arg (p-arg P-arg)
  "Display prefix ARG, in \"p\" and \"P\" `interactive' types.
I keep forgetting how they differ."
  (interactive "p\nP")
  (message "p: %S	P: %S" p-arg P-arg))

(provide 'acdw)
;;; acdw.el ends here