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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
|
;;; 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:
(require 'diary-lib)
;;; 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--encode (time)
"Encode diary-style time string into a time.
This is stolen from `run-at-time'."
(let ((hhmm (diary-entry-time time))
(now (decode-time)))
(encode-time (list 0 (% hhmm 100) (/ hhmm 100)
(decoded-time-day now)
(decoded-time-month now)
(decoded-time-year now)
nil -1
(decoded-time-zone now)))))
(defun +sunrise-sunset (sunrise-command sunset-command &optional reset)
"Run SUNRISE-COMMAND at sunrise, and SUNSET-COMMAND at sunset.
With RESET, this function will call itself with its own
arguments. That's really only useful within this function
itself."
(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 (match-string 1 ss))
(sunset (match-string 2 ss))
(sunrise-time (+sunrise-sunset--encode sunrise))
(sunset-time (+sunrise-sunset--encode sunset)))
(cond
((time-less-p nil sunrise-time)
;; If it isn't sunrise yet, it's still dark---and so we need to run the
;; sunset-command.
(funcall sunset-command)
(run-at-time sunrise nil sunrise-command))
((time-less-p nil sunset-time)
;; If it isn't sunset yet, it's still light---so we need to run the
;; sunrise-command.
(funcall sunrise-command)
(run-at-time sunset nil sunset-command))
(t (run-at-time "12:00am" nil sunset-command)))
;; Reset everything at midnight
(unless reset
(run-at-time "12:00am" (* 60 60 24)
#'+sunrise-sunset sunrise-command sunset-command t))))
(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))
(defmacro +defvar (var value _)
"Quick way to `setq' a variable from a `defvar' form."
`(setq ,var ,value))
(defmacro +with-message (message &rest body)
"Execute BODY, with MESSAGE.
If body executes without errors, MESSAGE...Done will be displayed."
;; ^ TODO
`(prog1 (progn (message ,(concat message "..."))
,@body)
(message ,(concat message "...Done."))))
(defun +mapc-some-buffers (func &optional predicate)
"Perform FUNC on all buffers satisfied by PREDICATE.
By default, act on all buffers.
PREDICATE is a function called with one argument, the current
buffer. FUNC is called with no arguments. Both are called
within a `with-current-buffer' form."
(let ((pred (or predicate t)))
(dolist (buf (buffer-list))
(with-current-buffer buf
(when (funcall pred buf)
(funcall func))))))
;; https://github.com/cstby/emacs.d/blob/main/init.el#L67
(defun +clean-empty-lines (&optional begin end)
"Remove duplicate empty lines from BEGIN to END.
Called interactively, this function acts on the region, if
active, or else the entire buffer."
(interactive "*r")
(unless (region-active-p)
(setq begin (point-min)
end (save-excursion
(goto-char (point-max))
(skip-chars-backward "\n[:space:]")
(point))))
(save-excursion
(save-restriction
(narrow-to-region begin end)
(goto-char (point-min))
(while (re-search-forward "\n\n\n+" nil :move)
(replace-match "\n\n"))
;; Insert a newline at the end.
(goto-char (point-max))
(unless (= (line-beginning-position) (line-end-position))
(insert "\n")))))
(defun +open-paragraph ()
"Open a paragraph after paragraph at point.
A paragraph is defined as continguous non-empty lines of text
surrounded by empty lines, so opening a paragraph means to make
three blank lines, then place the point on the second one."
(interactive "*")
(unless (derived-mode-p 'special-mode 'lui-mode 'comint-mode)
;; Go to next blank line. This /isn't/ `end-of-paragraph-text' because
;; that's weird with org, and I'm guessing other modes too.
(while (not (looking-at "^$"))
(forward-line 1))
(newline)
(delete-blank-lines)
(newline 2)
(previous-line)))
(provide 'acdw)
;;; acdw.el ends here
|
