Merge branch 'main' of https://tildegit.org/acdw/emacs

6 files changed, 269 insertions, 23 deletions

@@ -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
@@ -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
@@ -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)