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