Merge branch 'main' of https://tildegit.org/acdw/emacs
This commit is contained in:
commit
963d94a0ec
|
@ -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
|
||||
|
|
58
init.el
58
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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
13
lisp/acdw.el
13
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
|
||||
|
|
|
@ -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)
|
Loading…
Reference in New Issue