summary refs log tree commit diff stats
diff options
context:
space:
mode:
-rw-r--r--early-init.el10
-rw-r--r--init.el58
-rw-r--r--lisp/acdw-compat.el8
-rw-r--r--lisp/acdw-org.el46
-rw-r--r--lisp/acdw.el13
-rw-r--r--lisp/titlecase.el157
6 files changed, 269 insertions, 23 deletions
diff --git a/early-init.el b/early-init.el index 29b4d38..e8d02ad 100644 --- a/early-init.el +++ b/early-init.el
@@ -82,9 +82,13 @@ say, `tool-bar-mode' once to toggle the tool bar back on."
82 (defun after-make-frame@setup (&rest args) 82 (defun after-make-frame@setup (&rest args)
83 (ignore args) 83 (ignore args)
84 (let ((monospace-faces 84 (let ((monospace-faces
85 '((:font "DejaVu Sans Mono" :height 100) 85 (acdw/system
86 (:font "Consolas" :height 100) 86 (:work '((:font "Consolas" :height 110)
87 (:font "monospace" :height 100)))) 87 (:font "DejaVu Sans Mono" :height 110)
88 (:font "monospace" :height 110)))
89 (_ '((:font "DejaVu Sans Mono" :height 100)
90 (:font "Consolas" :height 100)
91 (:font "monospace" :height 100))))))
88 (acdw/set-first-face-attribute 'default monospace-faces) 92 (acdw/set-first-face-attribute 'default monospace-faces)
89 (acdw/set-first-face-attribute 'fixed-pitch monospace-faces) 93 (acdw/set-first-face-attribute 'fixed-pitch monospace-faces)
90 (acdw/set-first-face-attribute 'variable-pitch 94 (acdw/set-first-face-attribute 'variable-pitch
diff --git a/init.el b/init.el index fbf5296..edbc99c 100644 --- a/init.el +++ b/init.el
@@ -979,11 +979,16 @@ like a dumbass."
979 (setq read-extended-command-predicate 979 (setq read-extended-command-predicate
980 #'command-completion-default-include-p)) 980 #'command-completion-default-include-p))
981 981
982 (defvar case-map (make-sparse-keymap)
983 "A keymap for setting case in various ways.")
984 (global-set-key (kbd "C-c c") case-map)
985
982 (:global "M-=" count-words 986 (:global "M-=" count-words
983 "C-w" kill-region-or-backward-word 987 "C-w" kill-region-or-backward-word
984 "C-c c" capitalize-dwim 988 "C-c c c" capitalize-dwim
985 "C-c u" upcase-dwim 989 "C-c c t" titlecase-dwim
986 "C-c l" downcase-dwim 990 "C-c c u" upcase-dwim
991 "C-c c l" downcase-dwim
987 "C-c d" acdw/insert-iso-date 992 "C-c d" acdw/insert-iso-date
988 "M-`" nil) 993 "M-`" nil)
989 994
@@ -1002,6 +1007,7 @@ like a dumbass."
1002 (defalias 'backward-word-with-case 'backward-word 1007 (defalias 'backward-word-with-case 'backward-word
1003 "Alias for `backward-word for use in `case-repeat-map'.") 1008 "Alias for `backward-word for use in `case-repeat-map'.")
1004 1009
1010 ;; XXX: this isn't repeating correctly ...
1005 (defvar case-repeat-map 1011 (defvar case-repeat-map
1006 (let ((map (make-sparse-keymap))) 1012 (let ((map (make-sparse-keymap)))
1007 (define-key map "c" #'capitalize-word) 1013 (define-key map "c" #'capitalize-word)
@@ -1048,7 +1054,9 @@ like a dumbass."
1048 (indent-region (point-min) (point-max)))))) 1054 (indent-region (point-min) (point-max))))))
1049 1055
1050(setup (:straight-if affe 1056(setup (:straight-if affe
1051 (executable-find "rg")) 1057 (and (or (executable-find "fd")
1058 (executable-find "find"))
1059 (executable-find "rg")))
1052 ;; Keys are bound in `acdw/sensible-grep' and `acdw/sensible-find' 1060 ;; Keys are bound in `acdw/sensible-grep' and `acdw/sensible-find'
1053 (defun affe-orderless-regexp-compiler (input _type) 1061 (defun affe-orderless-regexp-compiler (input _type)
1054 (setq input (orderless-pattern-compiler input)) 1062 (setq input (orderless-pattern-compiler input))
@@ -1058,7 +1066,11 @@ like a dumbass."
1058 1066
1059(setup (:straight async) 1067(setup (:straight async)
1060 (autoload 'dired-async-mode "dired-async.el" nil t) 1068 (autoload 'dired-async-mode "dired-async.el" nil t)
1061 (dired-async-mode +1)) 1069 (dired-async-mode +1)
1070 (add-hook 'dired-mode
1071 (defun dired@disable-dired-async-mode-line ()
1072 (autoload 'dired-async--modeline-mode "dired-async.el" nil t)
1073 (dired-async--modeline-mode -1))))
1062 1074
1063(setup (:straight alert) 1075(setup (:straight alert)
1064 (:option alert-default-style (acdw/system 1076 (:option alert-default-style (acdw/system
@@ -1083,9 +1095,24 @@ like a dumbass."
1083 1095
1084 (setq acdw-irc/post-my-nick "-> ") 1096 (setq acdw-irc/post-my-nick "-> ")
1085 1097
1086 (setq circe-default-part-message "See You, Space Cowpokes . . ." 1098 (setq circe-default-nick "acdw"
1099 circe-default-part-message "See You, Space Cowpokes . . ."
1087 circe-highlight-nick-type 'all 1100 circe-highlight-nick-type 'all
1088 ;; circe-network-options in private.el 1101 circe-network-options
1102 (("Libera Chat"
1103 :channels ("#emacs" "#systemcrafters" "##webpals")
1104 :sasl-username "acdw"
1105 :sasl-password ,(acdw/fetch-password :host "libera.chat"))
1106 ("Tilde Chat"
1107 :channels ("#meta" "#bread" "#dadjokes" "#team")
1108 :host "irc.tilde.chat" :port 6697 :use-tls t
1109 :sasl-username "acdw"
1110 :sasl-password ,(acdw/fetch-password :host "tilde.chat"))
1111 ("Casa"
1112 :channels ("#basement")
1113 :host "m455.casa" :port 6697 :use-tls t
1114 :sasl-username "acdw"
1115 :sasl-password ,(acdw/fetch-password :host "m455.casa")))
1089 circe-reduce-lurker-spam t 1116 circe-reduce-lurker-spam t
1090 circe-server-auto-join-default-type :after-auth) 1117 circe-server-auto-join-default-type :after-auth)
1091 1118
@@ -1336,6 +1363,23 @@ already been connected to."
1336 :repo "duckwork/electric-cursor")) 1363 :repo "duckwork/electric-cursor"))
1337 (electric-cursor-mode +1)) 1364 (electric-cursor-mode +1))
1338 1365
1366(setup (:straight elfeed
1367 elfeed-protocol)
1368 (:option elfeed-use-curl t
1369 elfeed-feeds `(("fever+https://acdw@mf.acdw.net"
1370 :api-url "https://mf.acdw.net/fever/"
1371 :password ,(acdw/fetch-password
1372 :host "mf.acdw.net"))))
1373
1374 (elfeed-protocol-enable)
1375
1376 (add-hook 'elfeed-show-mode-hook
1377 (defun elfeed-show@setup ()
1378 (olivetti-mode +1)))
1379
1380 ;; see https://irreal.org/blog/?p=8885
1381 )
1382
1339(setup (:straight (elpher :host nil 1383(setup (:straight (elpher :host nil
1340 :repo "git://thelambdalab.xyz/elpher.git")) 1384 :repo "git://thelambdalab.xyz/elpher.git"))
1341 (:option elpher-ipv4-always t 1385 (:option elpher-ipv4-always t
diff --git a/lisp/acdw-compat.el b/lisp/acdw-compat.el index 04e42ae..0a1a037 100644 --- a/lisp/acdw-compat.el +++ b/lisp/acdw-compat.el
@@ -22,7 +22,7 @@
22;;; Code: 22;;; Code:
23 23
24;; Convenience macro 24;; Convenience macro
25(defmacro safe-define (&rest defines) 25(defmacro safely (&rest defines)
26 "Wrap DEFINES in tests to make sure they're not already defined. 26 "Wrap DEFINES in tests to make sure they're not already defined.
27Is it necessary? Who knows!!" 27Is it necessary? Who knows!!"
28 (let (output) 28 (let (output)
@@ -53,7 +53,7 @@ Is it necessary? Who knows!!"
53 53
54;;; Functions for changing capitalization that Do What I Mean 54;;; Functions for changing capitalization that Do What I Mean
55;; Defined in EMACS/lisp/simple.el 55;; Defined in EMACS/lisp/simple.el
56(safe-define 56(safely
57 (defun upcase-dwim (arg) 57 (defun upcase-dwim (arg)
58 "Upcase words in the region, if active; if not, upcase word at point. 58 "Upcase words in the region, if active; if not, upcase word at point.
59If the region is active, this function calls `upcase-region'. 59If the region is active, this function calls `upcase-region'.
@@ -88,7 +88,7 @@ to capitalize ARG words."
88;;; Repeat.el 88;;; Repeat.el
89;; Defined in EMACS/lisp/repeat.el 89;; Defined in EMACS/lisp/repeat.el
90 90
91(safe-define 91(safely
92 (defcustom repeat-too-dangerous '(kill-this-buffer) 92 (defcustom repeat-too-dangerous '(kill-this-buffer)
93 "Commands too dangerous to repeat with \\[repeat]." 93 "Commands too dangerous to repeat with \\[repeat]."
94 :group 'convenience 94 :group 'convenience
@@ -538,7 +538,7 @@ Used in `repeat-mode'.")
538 538
539 539
540;;; goto-address-mode 540;;; goto-address-mode
541(safe-define 541(safely
542 (defvar global-address-mode nil) 542 (defvar global-address-mode nil)
543 543
544 (define-globalized-minor-mode global-goto-address-mode 544 (define-globalized-minor-mode global-goto-address-mode
diff --git a/lisp/acdw-org.el b/lisp/acdw-org.el index 50a0488..89269ab 100644 --- a/lisp/acdw-org.el +++ b/lisp/acdw-org.el
@@ -370,19 +370,49 @@ instead of the true count."
370;;; Next and previous heading, with widening 370;;; Next and previous heading, with widening
371(defun acdw/org-next-heading-widen (arg) 371(defun acdw/org-next-heading-widen (arg)
372 (interactive "p") 372 (interactive "p")
373 (let ((point-target (if (> arg 0) 373 (let ((current-point (point))
374 (point-max) 374 (point-target (if (> arg 0) (point-max) (point-min))))
375 (point-min)))) 375 (org-next-visible-heading arg)
376 (unless (or (org-next-visible-heading arg) ; XXX: this doesn't work!!! ARGH 376 (when (and (buffer-narrowed-p)
377 (/= (point) point-target)) 377 (= (point) point-target)
378 (when (buffer-narrowed-p) 378 (or (and (> arg 0))
379 (widen) 379 (and (< arg 0)
380 (org-next-visible-heading arg))))) 380 (= (point) current-point))))
381 (widen)
382 (org-next-visible-heading arg))))
381 383
382(defun acdw/org-previous-heading-widen (arg) 384(defun acdw/org-previous-heading-widen (arg)
383 (interactive "p") 385 (interactive "p")
384 (acdw/org-next-heading-widen (- arg))) 386 (acdw/org-next-heading-widen (- arg)))
385 387
386 388
389;;; Add headings for every day of the work month
390;; Gets rid of weekends.
391
392(defun acdw-org/work-month-headings (&optional month year)
393 (interactive (list
394 (read-number "Month: " (car (calendar-current-date)))
395 (read-number "Year: " (nth 2 (calendar-current-date)))))
396 (let ((offset 0)
397 (month (or month
398 (car (calendar-current-date))))
399 (year (or year
400 (car (last (calendar-current-date))))))
401 (dotimes (day (calendar-last-day-of-month month year))
402 (let* ((day (1+ day))
403 (day-of-week (calendar-day-of-week (list month day year))))
404 (unless (memq day-of-week '(0 6)) ; weekend
405 (end-of-line)
406 (org-insert-heading nil t t)
407 (insert (concat "[" (mapconcat (lambda (n)
408 (format "%02d" n))
409 (list year month day)
410 "-")
411 " "
412 (nth day-of-week '("Sun" "Mon" "Tue" "Wed" "Thu"
413 "Fri" "Sat"))
414 "]")))))))
415
416
387(provide 'acdw-org) 417(provide 'acdw-org)
388;; acdw-org.el ends here 418;; acdw-org.el ends here
diff --git a/lisp/acdw.el b/lisp/acdw.el index f23ca0e..796c2f1 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el
@@ -579,7 +579,18 @@ It's called 'require-private' for historical reasons."
579 (switch-to-buffer nil) 579 (switch-to-buffer nil)
580 (other-window (or arg 1)))) 580 (other-window (or arg 1))))
581 581
582 582
583;;; Auth-sources
584;; https://github.com/emacs-circe/circe/wiki/Configuration
585(defun acdw/fetch-password (&rest params)
586 (require 'auth-source)
587 (let ((match (car (apply #'auth-source-search params))))
588 (if match
589 (let ((secret (plist-get match :secret)))
590 (if (functionp secret)
591 (funcall secret)
592 secret))
593 (warn "Password not found for %S" params))))
583 594
584(provide 'acdw) 595(provide 'acdw)
585;;; acdw.el ends here 596;;; acdw.el ends here
diff --git a/lisp/titlecase.el b/lisp/titlecase.el new file mode 100644 index 0000000..64da5b4 --- /dev/null +++ b/lisp/titlecase.el
@@ -0,0 +1,157 @@
1;;; titlecase.el -*- lexical-binding: t; -*-
2
3;; https://hungyi.net/posts/programmers-way-to-title-case/
4
5(require 'cl-lib)
6(require 'subr-x)
7
8;;;###autoload
9(defun titlecase-string (str)
10 "Convert string STR to title case and return the resulting string."
11 (let* ((case-fold-search nil)
12 (str-length (length str))
13 ;; A list of markers that indicate start of a new phrase within the
14 ;; title, e.g. "The Lonely Reindeer: A Christmas Story"
15 ;; must be followed by one of word-boundary-chars
16 (new-phrase-chars '(?: ?. ?? ?\; ?\n ?\r))
17 ;; immediately triggers new phrase behavior without waiting for word
18 ;; boundary
19 (immediate-new-phrase-chars '(?\n ?\r))
20 ;; A list of characters that indicate "word boundaries"; used to split
21 ;; the title into processable segments
22 (word-boundary-chars (append '(? ?– ?— ?- ?‑ ?/)
23 immediate-new-phrase-chars))
24 ;; A list of small words that should not be capitalized (in the right
25 ;; conditions)
26 (small-words '("a" "an" "and" "as" "at" "but" "by" "en" "for" "if"
27 "in" "of" "on" "or" "the" "to" "v" "v." "vs" "vs."
28 "via"))
29 ;; Fix if str is ALL CAPS
30 (str (if (string-match-p "[a-z]" str) str (downcase str)))
31 ;; Reduce over a state machine to do title casing
32 (final-state
33 (cl-reduce
34 (lambda (state char)
35 (let* ((result (aref state 0))
36 (last-segment (aref state 1))
37 (first-word-p (aref state 2))
38 (was-in-path-p (aref state 3))
39 (last-char (car last-segment))
40 (in-path-p (or (and (eq char ?/)
41 (or (not last-segment)
42 (member last-char '(?. ?~))))
43 (and was-in-path-p
44 (not
45 (or (eq char ? )
46 (member
47 char
48 immediate-new-phrase-chars))))))
49 (end-p
50 ;; are we at the end of the input string?
51 (eq (+ (length result) (length last-segment) 1)
52 str-length))
53 (pop-p
54 ;; do we need to pop a segment onto the output result?
55 (or end-p (and (not in-path-p)
56 (member char word-boundary-chars))))
57 (segment
58 ;; add the current char to the current segment
59 (cons char last-segment))
60 (segment-string
61 ;; the readable version of the segment
62 (apply #'string (reverse segment)))
63 (small-word-p
64 ;; was the last segment a small word?
65 (member (downcase (substring segment-string 0 -1))
66 small-words))
67 (capitalize-p
68 ;; do we need to capitalized this segment or lowercase it?
69 (or end-p first-word-p (not small-word-p)))
70 (ignore-segment-p
71 ;; ignore explicitly capitalized segments
72 (or (string-match-p "[a-zA-Z].*[A-Z]" segment-string)
73 ;; ignore URLs
74 (string-match-p "^https?:" segment-string)
75 ;; ignore hostnames and namespaces.like.this
76 (string-match-p "\\w\\.\\w" segment-string)
77 ;; ignore windows filesystem paths
78 (string-match-p "^[A-Za-z]:\\\\" segment-string)
79 ;; ignore unix filesystem paths
80 was-in-path-p
81 ;; ignore email addresses and user handles with @ symbol
82 (member ?@ segment)))
83 (next-result
84 (if pop-p
85 (concat result
86 (if ignore-segment-p
87 ;; pop segment onto the result without
88 ;; processing
89 segment-string
90 ;; titlecase the segment before popping onto
91 ;; result
92 (titlecase--segment
93 segment-string capitalize-p)))
94 result))
95 (next-segment
96 (unless pop-p segment))
97 (will-be-first-word-p
98 (if pop-p
99 (or (not last-segment)
100 (member last-char new-phrase-chars)
101 (member char immediate-new-phrase-chars))
102 first-word-p)))
103 (vector
104 next-result next-segment will-be-first-word-p in-path-p)))
105 str
106 :initial-value
107 (vector nil ; result stack
108 nil ; current working segment
109 t ; is it the first word of a phrase?
110 nil)))) ; are we inside of a filesystem path?
111 (aref final-state 0)))
112
113(defun titlecase--segment (segment capitalize-p)
114 "Convert a title's inner SEGMENT to capitalized or lower case
115depending on CAPITALIZE-P, then return the result."
116 (let* ((case-fold-search nil)
117 (ignore-chars '(?' ?\" ?\( ?\[ ?‘ ?“ ?’ ?” ?_))
118 (final-state
119 (cl-reduce
120 (lambda (state char)
121 (let ((result (aref state 0))
122 (downcase-p (aref state 1)))
123 (cond
124 (downcase-p
125 ;; already upcased start of segment, so lowercase the rest
126 (vector (cons (downcase char) result) t))
127 ((member char ignore-chars)
128 ;; check if start char of segment needs to be ignored
129 (vector (cons char result) downcase-p))
130 (t
131 ;; haven't upcased yet, and we can, so do it
132 (vector (cons (upcase char) result) t)))))
133 segment
134 :initial-value (vector nil (not capitalize-p)))))
135 (thread-last (aref final-state 0)
136 (reverse)
137 (apply #'string))))
138
139;;;###autoload
140(defun titlecase-region (begin end)
141 "Convert text in region from BEGIN to END to title case."
142 (interactive "*r")
143 (let ((pt (point)))
144 (insert (titlecase-string (delete-and-extract-region begin end)))
145 (goto-char pt)))
146
147;;;###autoload
148(defun titlecase-dwim ()
149 "Convert the region or current line to title case.
150If Transient Mark Mode is on and there is an active region, convert
151the region to title case. Otherwise, work on the current line."
152 (interactive)
153 (if (and transient-mark-mode mark-active)
154 (titlecase-region (region-beginning) (region-end))
155 (titlecase-region (point-at-bol) (point-at-eol))))
156
157(provide 'titlecase)