summary refs log tree commit diff stats
path: root/lisp/acdw.el
blob: 603f46f9f0cf6f300efe7ce487585740f8b41096 (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
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
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
;;; 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 &optional _)
  "Quick way to `setq' a variable from a `defvar' form."
  (declare (doc-string 3))
  `(setq ,var ,value))

(defmacro +with-message (message &rest body)
  "Execute BODY, with MESSAGE.
If body executes without errors, MESSAGE...Done will be displayed."
  (declare (indent 1))
  (let ((msg (gensym)))
    `(let ((,msg ,message))
       (unwind-protect (progn (message "%s..." ,msg)
                              ,@body)
         (message "%s... Done." ,msg)))))

(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 (if (fboundp pred) (funcall pred buf) pred)
          (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 (and (not (looking-at "^$"))
                (< (point) (point-max)))
      (forward-line 1))
    (newline)
    (delete-blank-lines)
    (newline 2)
    (previous-line)))

(defun +split-window-then (&optional where arg)
  "Split the window into a new buffer.
With non-nil ARG (\\[universal-argument] interactively), don't
prompt for a buffer to switch to.  This function will split the
window using `split-window-sensibly', or open the new window in
the direction specified by WHERE.  WHERE is ignored when called
interactively; if you want specific splitting, use
`+split-window-right-then' or `+split-window-below-then'."
  (interactive "i\nP")
  ;; TODO: Canceling at the switching phase leaves the point in the other
  ;; window.  Ideally, the user would see this as one action, meaning a cancel
  ;; would return to the original window.
  (pcase where
    ;; These directions are 'backward' to the OG Emacs split-window commands,
    ;; because by default Emacs leaves the cursor in the original window.  Most
    ;; users probably expect a switch to the new window, at least I do.
    ((or 'right :right) (split-window-right) (other-window 1))
    ((or 'left :left) (split-window-right))
    ((or 'below :below) (split-window-below) (other-window 1))
    ((or 'above :above) (split-window-below))
    ((pred null)
     (or (split-window-sensibly)
         (if (< (window-height) (window-width))
             (split-window-below)
           (split-window-right)))
     (other-window 1))
    (_ (user-error "Unknown WHERE paramater: %s" where)))
  (unless arg
    (condition-case nil
        (call-interactively
         (pcase (read-char "(B)uffer or (F)ile?")
           (?b (if (fboundp #'consult-buffer)
                   #'consult-buffer
                 #'switch-to-buffer))
           (?f #'find-file)
           (_ #'ignore)))
      (quit (delete-window)))))

(defun +split-window-right-then (&optional arg)
  "Split window right, then prompt for a new buffer.
With optional ARG (\\[universal-argument]), just split."
  (interactive "P")
  (+split-window-then :right arg))

(defun +split-window-below-then (&optional arg)
  "Split window below, then prompt for a new buffer.
With optional ARG (\\[universal-argument]), just split."
  (interactive "P")
  (+split-window-then :below arg))

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