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." (defun after-make-frame@setup (&rest args) (ignore args) (let ((monospace-faces - '((:font "DejaVu Sans Mono" :height 100) - (:font "Consolas" :height 100) - (:font "monospace" :height 100)))) + (acdw/system + (:work '((:font "Consolas" :height 110) + (:font "DejaVu Sans Mono" :height 110) + (:font "monospace" :height 110))) + (_ '((:font "DejaVu Sans Mono" :height 100) + (:font "Consolas" :height 100) + (:font "monospace" :height 100)))))) (acdw/set-first-face-attribute 'default monospace-faces) (acdw/set-first-face-attribute 'fixed-pitch monospace-faces) (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." (setq read-extended-command-predicate #'command-completion-default-include-p)) + (defvar case-map (make-sparse-keymap) + "A keymap for setting case in various ways.") + (global-set-key (kbd "C-c c") case-map) + (:global "M-=" count-words "C-w" kill-region-or-backward-word - "C-c c" capitalize-dwim - "C-c u" upcase-dwim - "C-c l" downcase-dwim + "C-c c c" capitalize-dwim + "C-c c t" titlecase-dwim + "C-c c u" upcase-dwim + "C-c c l" downcase-dwim "C-c d" acdw/insert-iso-date "M-`" nil) @@ -1002,6 +1007,7 @@ like a dumbass." (defalias 'backward-word-with-case 'backward-word "Alias for `backward-word for use in `case-repeat-map'.") + ;; XXX: this isn't repeating correctly ... (defvar case-repeat-map (let ((map (make-sparse-keymap))) (define-key map "c" #'capitalize-word) @@ -1048,7 +1054,9 @@ like a dumbass." (indent-region (point-min) (point-max)))))) (setup (:straight-if affe - (executable-find "rg")) + (and (or (executable-find "fd") + (executable-find "find")) + (executable-find "rg"))) ;; Keys are bound in `acdw/sensible-grep' and `acdw/sensible-find' (defun affe-orderless-regexp-compiler (input _type) (setq input (orderless-pattern-compiler input)) @@ -1058,7 +1066,11 @@ like a dumbass." (setup (:straight async) (autoload 'dired-async-mode "dired-async.el" nil t) - (dired-async-mode +1)) + (dired-async-mode +1) + (add-hook 'dired-mode + (defun dired@disable-dired-async-mode-line () + (autoload 'dired-async--modeline-mode "dired-async.el" nil t) + (dired-async--modeline-mode -1)))) (setup (:straight alert) (:option alert-default-style (acdw/system @@ -1083,9 +1095,24 @@ like a dumbass." (setq acdw-irc/post-my-nick "-> ") - (setq circe-default-part-message "See You, Space Cowpokes . . ." + (setq circe-default-nick "acdw" + circe-default-part-message "See You, Space Cowpokes . . ." circe-highlight-nick-type 'all - ;; circe-network-options in private.el + circe-network-options + (("Libera Chat" + :channels ("#emacs" "#systemcrafters" "##webpals") + :sasl-username "acdw" + :sasl-password ,(acdw/fetch-password :host "libera.chat")) + ("Tilde Chat" + :channels ("#meta" "#bread" "#dadjokes" "#team") + :host "irc.tilde.chat" :port 6697 :use-tls t + :sasl-username "acdw" + :sasl-password ,(acdw/fetch-password :host "tilde.chat")) + ("Casa" + :channels ("#basement") + :host "m455.casa" :port 6697 :use-tls t + :sasl-username "acdw" + :sasl-password ,(acdw/fetch-password :host "m455.casa"))) circe-reduce-lurker-spam t circe-server-auto-join-default-type :after-auth) @@ -1336,6 +1363,23 @@ already been connected to." :repo "duckwork/electric-cursor")) (electric-cursor-mode +1)) +(setup (:straight elfeed + elfeed-protocol) + (:option elfeed-use-curl t + elfeed-feeds `(("fever+https://acdw@mf.acdw.net" + :api-url "https://mf.acdw.net/fever/" + :password ,(acdw/fetch-password + :host "mf.acdw.net")))) + + (elfeed-protocol-enable) + + (add-hook 'elfeed-show-mode-hook + (defun elfeed-show@setup () + (olivetti-mode +1))) + + ;; see https://irreal.org/blog/?p=8885 + ) + (setup (:straight (elpher :host nil :repo "git://thelambdalab.xyz/elpher.git")) (: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 @@ ;;; Code: ;; Convenience macro -(defmacro safe-define (&rest defines) +(defmacro safely (&rest defines) "Wrap DEFINES in tests to make sure they're not already defined. Is it necessary? Who knows!!" (let (output) @@ -53,7 +53,7 @@ Is it necessary? Who knows!!" ;;; Functions for changing capitalization that Do What I Mean ;; Defined in EMACS/lisp/simple.el -(safe-define +(safely (defun upcase-dwim (arg) "Upcase words in the region, if active; if not, upcase word at point. If the region is active, this function calls `upcase-region'. @@ -88,7 +88,7 @@ to capitalize ARG words." ;;; Repeat.el ;; Defined in EMACS/lisp/repeat.el -(safe-define +(safely (defcustom repeat-too-dangerous '(kill-this-buffer) "Commands too dangerous to repeat with \\[repeat]." :group 'convenience @@ -538,7 +538,7 @@ Used in `repeat-mode'.") ;;; goto-address-mode -(safe-define +(safely (defvar global-address-mode nil) (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." ;;; Next and previous heading, with widening (defun acdw/org-next-heading-widen (arg) (interactive "p") - (let ((point-target (if (> arg 0) - (point-max) - (point-min)))) - (unless (or (org-next-visible-heading arg) ; XXX: this doesn't work!!! ARGH - (/= (point) point-target)) - (when (buffer-narrowed-p) - (widen) - (org-next-visible-heading arg))))) + (let ((current-point (point)) + (point-target (if (> arg 0) (point-max) (point-min)))) + (org-next-visible-heading arg) + (when (and (buffer-narrowed-p) + (= (point) point-target) + (or (and (> arg 0)) + (and (< arg 0) + (= (point) current-point)))) + (widen) + (org-next-visible-heading arg)))) (defun acdw/org-previous-heading-widen (arg) (interactive "p") (acdw/org-next-heading-widen (- arg))) + +;;; Add headings for every day of the work month +;; Gets rid of weekends. + +(defun acdw-org/work-month-headings (&optional month year) + (interactive (list + (read-number "Month: " (car (calendar-current-date))) + (read-number "Year: " (nth 2 (calendar-current-date))))) + (let ((offset 0) + (month (or month + (car (calendar-current-date)))) + (year (or year + (car (last (calendar-current-date)))))) + (dotimes (day (calendar-last-day-of-month month year)) + (let* ((day (1+ day)) + (day-of-week (calendar-day-of-week (list month day year)))) + (unless (memq day-of-week '(0 6)) ; weekend + (end-of-line) + (org-insert-heading nil t t) + (insert (concat "[" (mapconcat (lambda (n) + (format "%02d" n)) + (list year month day) + "-") + " " + (nth day-of-week '("Sun" "Mon" "Tue" "Wed" "Thu" + "Fri" "Sat")) + "]"))))))) + (provide 'acdw-org) ;; 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." (switch-to-buffer nil) (other-window (or arg 1)))) - + +;;; Auth-sources +;; https://github.com/emacs-circe/circe/wiki/Configuration +(defun acdw/fetch-password (&rest params) + (require 'auth-source) + (let ((match (car (apply #'auth-source-search params)))) + (if match + (let ((secret (plist-get match :secret))) + (if (functionp secret) + (funcall secret) + secret)) + (warn "Password not found for %S" params)))) (provide 'acdw) ;;; 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 @@ +;;; titlecase.el -*- lexical-binding: t; -*- + +;; https://hungyi.net/posts/programmers-way-to-title-case/ + +(require 'cl-lib) +(require 'subr-x) + +;;;###autoload +(defun titlecase-string (str) + "Convert string STR to title case and return the resulting string." + (let* ((case-fold-search nil) + (str-length (length str)) + ;; A list of markers that indicate start of a new phrase within the + ;; title, e.g. "The Lonely Reindeer: A Christmas Story" + ;; must be followed by one of word-boundary-chars + (new-phrase-chars '(?: ?. ?? ?\; ?\n ?\r)) + ;; immediately triggers new phrase behavior without waiting for word + ;; boundary + (immediate-new-phrase-chars '(?\n ?\r)) + ;; A list of characters that indicate "word boundaries"; used to split + ;; the title into processable segments + (word-boundary-chars (append '(? ?– ?— ?- ?‑ ?/) + immediate-new-phrase-chars)) + ;; A list of small words that should not be capitalized (in the right + ;; conditions) + (small-words '("a" "an" "and" "as" "at" "but" "by" "en" "for" "if" + "in" "of" "on" "or" "the" "to" "v" "v." "vs" "vs." + "via")) + ;; Fix if str is ALL CAPS + (str (if (string-match-p "[a-z]" str) str (downcase str))) + ;; Reduce over a state machine to do title casing + (final-state + (cl-reduce + (lambda (state char) + (let* ((result (aref state 0)) + (last-segment (aref state 1)) + (first-word-p (aref state 2)) + (was-in-path-p (aref state 3)) + (last-char (car last-segment)) + (in-path-p (or (and (eq char ?/) + (or (not last-segment) + (member last-char '(?. ?~)))) + (and was-in-path-p + (not + (or (eq char ? ) + (member + char + immediate-new-phrase-chars)))))) + (end-p + ;; are we at the end of the input string? + (eq (+ (length result) (length last-segment) 1) + str-length)) + (pop-p + ;; do we need to pop a segment onto the output result? + (or end-p (and (not in-path-p) + (member char word-boundary-chars)))) + (segment + ;; add the current char to the current segment + (cons char last-segment)) + (segment-string + ;; the readable version of the segment + (apply #'string (reverse segment))) + (small-word-p + ;; was the last segment a small word? + (member (downcase (substring segment-string 0 -1)) + small-words)) + (capitalize-p + ;; do we need to capitalized this segment or lowercase it? + (or end-p first-word-p (not small-word-p))) + (ignore-segment-p + ;; ignore explicitly capitalized segments + (or (string-match-p "[a-zA-Z].*[A-Z]" segment-string) + ;; ignore URLs + (string-match-p "^https?:" segment-string) + ;; ignore hostnames and namespaces.like.this + (string-match-p "\\w\\.\\w" segment-string) + ;; ignore windows filesystem paths + (string-match-p "^[A-Za-z]:\\\\" segment-string) + ;; ignore unix filesystem paths + was-in-path-p + ;; ignore email addresses and user handles with @ symbol + (member ?@ segment))) + (next-result + (if pop-p + (concat result + (if ignore-segment-p + ;; pop segment onto the result without + ;; processing + segment-string + ;; titlecase the segment before popping onto + ;; result + (titlecase--segment + segment-string capitalize-p))) + result)) + (next-segment + (unless pop-p segment)) + (will-be-first-word-p + (if pop-p + (or (not last-segment) + (member last-char new-phrase-chars) + (member char immediate-new-phrase-chars)) + first-word-p))) + (vector + next-result next-segment will-be-first-word-p in-path-p))) + str + :initial-value + (vector nil ; result stack + nil ; current working segment + t ; is it the first word of a phrase? + nil)))) ; are we inside of a filesystem path? + (aref final-state 0))) + +(defun titlecase--segment (segment capitalize-p) + "Convert a title's inner SEGMENT to capitalized or lower case +depending on CAPITALIZE-P, then return the result." + (let* ((case-fold-search nil) + (ignore-chars '(?' ?\" ?\( ?\[ ?‘ ?“ ?’ ?” ?_)) + (final-state + (cl-reduce + (lambda (state char) + (let ((result (aref state 0)) + (downcase-p (aref state 1))) + (cond + (downcase-p + ;; already upcased start of segment, so lowercase the rest + (vector (cons (downcase char) result) t)) + ((member char ignore-chars) + ;; check if start char of segment needs to be ignored + (vector (cons char result) downcase-p)) + (t + ;; haven't upcased yet, and we can, so do it + (vector (cons (upcase char) result) t))))) + segment + :initial-value (vector nil (not capitalize-p))))) + (thread-last (aref final-state 0) + (reverse) + (apply #'string)))) + +;;;###autoload +(defun titlecase-region (begin end) + "Convert text in region from BEGIN to END to title case." + (interactive "*r") + (let ((pt (point))) + (insert (titlecase-string (delete-and-extract-region begin end))) + (goto-char pt))) + +;;;###autoload +(defun titlecase-dwim () + "Convert the region or current line to title case. +If Transient Mark Mode is on and there is an active region, convert +the region to title case. Otherwise, work on the current line." + (interactive) + (if (and transient-mark-mode mark-active) + (titlecase-region (region-beginning) (region-end)) + (titlecase-region (point-at-bol) (point-at-eol)))) + +(provide 'titlecase)