changelog shortlog graph tags branches changeset files file revisions raw help

Mercurial > core / annotate emacs/util.el

changeset 34: 882a5c1e7b9f
parent: e3b0ec661dfa
child: 519ab3f9f548
author: ellis <ellis@rwest.io>
date: Sun, 05 Nov 2023 00:33:48 -0400
permissions: -rw-r--r--
description: emacs config

ellis.el example custom config file

removed vc utils (site-specific)

keys/defaults
21
3a0dac7e29ae Signed-off-by: ellis <ellis@rwest.io>
ellis <ellis@rwest.io>
parents:
diff changeset
1
 ;;; std/util.el --- standard utils  -*- lexical-binding: t -*-
3a0dac7e29ae Signed-off-by: ellis <ellis@rwest.io>
ellis <ellis@rwest.io>
parents:
diff changeset
2
 
3a0dac7e29ae Signed-off-by: ellis <ellis@rwest.io>
ellis <ellis@rwest.io>
parents:
diff changeset
3
 ;;; Code:
3a0dac7e29ae Signed-off-by: ellis <ellis@rwest.io>
ellis <ellis@rwest.io>
parents:
diff changeset
4
 (require 'cl-lib)
3a0dac7e29ae Signed-off-by: ellis <ellis@rwest.io>
ellis <ellis@rwest.io>
parents:
diff changeset
5
 
31
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
6
 ;;; Helpers
26
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
7
 (defun group (source n)
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
8
   "This is Paul Graham's group utility from 'On Lisp'.
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
9
 
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
10
 Group a list of arguments SOURCE by any provided grouping amount
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
11
 N.
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
12
 
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
13
 For example:
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
14
 (group '(foo 2 bar 4) 2) ;=> ((foo 2) (bar 4))
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
15
 (group '(a b c d e f) 3) ;=> ((a b c) (d e f))
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
16
 "
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
17
   (when (zerop n) (error "zero length"))
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
18
   (cl-labels ((rec (source acc)
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
19
                    (let ((rest (nthcdr n source)))
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
20
                      (if (consp rest)
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
21
                          (rec rest (cons
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
22
                                     (cl-subseq source 0 n)
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
23
                                     acc))
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
24
                        (nreverse
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
25
                         (cons source acc))))))
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
26
     (when source (rec source nil))))
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
27
 
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
28
 (defun flatten (x)
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
29
   "Paul Graham's flatten utility from 'On Lisp'.
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
30
 
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
31
 Given a tree X, return all the 'leaves' of the tree."
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
32
   (cl-labels ((rec (x acc)
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
33
                    (cond ((null x) acc)
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
34
                          ((atom x) (cons x acc))
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
35
                          (t (rec
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
36
                              (car x)
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
37
                              (rec (cdr x) acc))))))
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
38
     (rec x nil)))
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
39
 
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
40
 (defun mkstr (&rest args)
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
41
   "Paul Graham's mkstr utility from 'On Lisp'.
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
42
 
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
43
 Coerce ARGS into a single string and return it."
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
44
   (let* ((s ""))
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
45
     (dolist (a args)
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
46
       (cond
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
47
        ((null a) nil)
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
48
        ((sequencep a) (setq s (concat s a)))
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
49
        ((numberp a) (setq s(concat s (number-to-string a))))
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
50
        ((symbolp a) (setq s(concat s (symbol-name a))))))
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
51
     s))
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
52
 
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
53
 (defun symb (&rest args)
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
54
   "Paul Graham's symb utility from 'On Lisp'.
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
55
 
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
56
 Concat ARGS and return a newly interned symbol."
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
57
   (intern (apply #'mkstr args)))
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
58
 
33
e3b0ec661dfa added inbox.el, more emacs config
ellis <ellis@rwest.io>
parents: 31
diff changeset
59
 ;;; Config
21
3a0dac7e29ae Signed-off-by: ellis <ellis@rwest.io>
ellis <ellis@rwest.io>
parents:
diff changeset
60
 (defun add-to-load-path (&rest paths)
3a0dac7e29ae Signed-off-by: ellis <ellis@rwest.io>
ellis <ellis@rwest.io>
parents:
diff changeset
61
   "Add PATHS to `load-path'."
3a0dac7e29ae Signed-off-by: ellis <ellis@rwest.io>
ellis <ellis@rwest.io>
parents:
diff changeset
62
   (mapc (lambda (x)
3a0dac7e29ae Signed-off-by: ellis <ellis@rwest.io>
ellis <ellis@rwest.io>
parents:
diff changeset
63
           (cond
3a0dac7e29ae Signed-off-by: ellis <ellis@rwest.io>
ellis <ellis@rwest.io>
parents:
diff changeset
64
            ((listp x) (mapc #'add-to-load-path x))
3a0dac7e29ae Signed-off-by: ellis <ellis@rwest.io>
ellis <ellis@rwest.io>
parents:
diff changeset
65
            ('_ (cl-pushnew x load-path))))
3a0dac7e29ae Signed-off-by: ellis <ellis@rwest.io>
ellis <ellis@rwest.io>
parents:
diff changeset
66
         paths))
3a0dac7e29ae Signed-off-by: ellis <ellis@rwest.io>
ellis <ellis@rwest.io>
parents:
diff changeset
67
 
31
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
68
 (defmacro add-packages (&rest pkgs)
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
69
   "add list of packages PKGS to `package-selected-packages'"
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
70
   `(mapc (lambda (x) (add-to-list 'package-selected-packages x)) ',pkgs))
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
71
 
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
72
 ;;; OS
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
73
 (defmacro when-sys= (name body)
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
74
   "(when (string= (system-name) NAME) BODY)"
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
75
   `(when ,(string= (system-name) name) ,body))
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
76
 
21
3a0dac7e29ae Signed-off-by: ellis <ellis@rwest.io>
ellis <ellis@rwest.io>
parents:
diff changeset
77
 (defun join-paths (root &rest dirs)
3a0dac7e29ae Signed-off-by: ellis <ellis@rwest.io>
ellis <ellis@rwest.io>
parents:
diff changeset
78
   "helper function for joining strings to a path."
3a0dac7e29ae Signed-off-by: ellis <ellis@rwest.io>
ellis <ellis@rwest.io>
parents:
diff changeset
79
   (let ((result root))
3a0dac7e29ae Signed-off-by: ellis <ellis@rwest.io>
ellis <ellis@rwest.io>
parents:
diff changeset
80
     (cl-loop for dir in dirs do
3a0dac7e29ae Signed-off-by: ellis <ellis@rwest.io>
ellis <ellis@rwest.io>
parents:
diff changeset
81
              (setq result (concat (file-name-as-directory result) dir)))
3a0dac7e29ae Signed-off-by: ellis <ellis@rwest.io>
ellis <ellis@rwest.io>
parents:
diff changeset
82
     result))
3a0dac7e29ae Signed-off-by: ellis <ellis@rwest.io>
ellis <ellis@rwest.io>
parents:
diff changeset
83
 
31
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
84
 (defun wc (&optional start end)
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
85
   "Return a 3-element list with lines, words and characters in
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
86
 region or whole buffer."
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
87
   (interactive)
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
88
   (let ((n 0)
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
89
         (start (if mark-active (region-beginning) (point-min)))
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
90
         (end (if mark-active (region-end) (point-max))))
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
91
     (save-excursion
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
92
       (goto-char start)
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
93
       (while (< (point) end) (if (forward-word 1) (setq n (1+ n)))))
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
94
     (list (count-lines start end) n (- end start))))
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
95
 
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
96
 ;;; Regexps
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
97
 (defvar default-line-regexp-alist
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
98
   '((empty . "[\s\t]*$")
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
99
     (indent . "^[\s\t]+")
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
100
     (non-empty . "^.+$")
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
101
     (list . "^\\([\s\t#*+]+\\|[0-9]+[^\s]?[).]+\\)")
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
102
     (heading . "^[=-]+"))
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
103
   "Alist of regexp types used by `default-line-regexp-p'.")
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
104
 
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
105
 (defun default-line-regexp-p (type &optional n)
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
106
   "Test for TYPE on line.
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
107
 TYPE is the car of a cons cell in
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
108
 `default-line-regexp-alist'.  It matches a regular
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
109
 expression.
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
110
 With optional N, search in the Nth line from point."
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
111
   (save-excursion
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
112
     (goto-char (point-at-bol))
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
113
     (and (not (bobp))
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
114
          (or (beginning-of-line n) t)
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
115
          (save-match-data
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
116
            (looking-at
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
117
             (alist-get type default-line-regexp-alist))))))
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
118
 
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
119
 ;;; Time
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
120
 (defun format-iso-week-number (&optional date)
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
121
   "format DATE as ISO week number with week days starting on
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
122
     Monday. If DATE is nil use current date."
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
123
   (let* ((week (format-time-string "%W" date))
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
124
          (prefix (if (= (length week) 1)
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
125
                      "w0" "w")))
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
126
     (concat prefix week)))
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
127
 
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
128
 (defun last-day-of-year (&optional date)
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
129
   "Return the last day of the year as time."
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
130
   (encode-time 0 0 0 31 12 (nth 5 (decode-time
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
131
                                    (or date (current-time))))))
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
132
 
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
133
 (defun last-day-of-month (&optional date)
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
134
   "Return the last day of month as time."
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
135
   (let* ((now (decode-time (or date (current-time))))
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
136
          (month (nth 4 now))
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
137
          (year (nth 5 now))
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
138
          (last-day-of-month (calendar-last-day-of-month month year)))
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
139
     (encode-time 0 0 0 last-day-of-month month year)))
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
140
 
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
141
 (defun last-day-of-week (&optional date)
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
142
   "Return the last day of the week as time."
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
143
   (let* ((now (or date (current-time)))
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
144
          (datetime (decode-time now))
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
145
          (dow (nth 6 datetime)))
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
146
     (time-add now (days-to-time (- 7 dow)))))
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
147
 
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
148
 (defun first-day-of-week (&optional date)
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
149
   "Return the first day of the week as time."
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
150
   (let* ((now (or date (current-time)))
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
151
          (datetime (decode-time now))
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
152
          (dow (nth 6 datetime)))
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
153
     (time-subtract now (days-to-time dow))))
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
154
 
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
155
 ;;; Server
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
156
 ;;;###autoload
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
157
 (defun kill-emacs-restart (&optional arg)
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
158
   (interactive)
f28229bc9b58 emacs defaults
ellis <ellis@rwest.io>
parents: 28
diff changeset
159
   (kill-emacs arg t))
28
bc174808bc53 emacs and rust/lib/tenex
ellis <ellis@rwest.io>
parents: 27
diff changeset
160
 
34
882a5c1e7b9f emacs config
ellis <ellis@rwest.io>
parents: 33
diff changeset
161
 
26
51a8370766f7 emacs config
ellis <ellis@rwest.io>
parents: 21
diff changeset
162
 (provide 'util)
27
1142c97f92ab emacs config
ellis <ellis@rwest.io>
parents: 26
diff changeset
163
 ;; util.el ends here