Add emms

Oops, should've been earlier /shurg

init.el

@@ -45,9 +45,7 @@
            ;; "C-x C-3" #'+split-window-right-then
            )
   ;; Font-lock keywords
-  (font-lock-add-keywords
-   nil
-   '(("\\<\\(TODO\\|XXX\\|FIXME\\|BUG\\):" 1 font-lock-warning-face t)))
+  (add-hook 'prog-mode-hook #'font-lock-todo-insinuate)
   ;; C-h deletes backward - see https://idiomdrottning.org/bad-emacs-defaults
   (global-set-key (kbd "C-h") 'delete-backward-char)
   (keyboard-translate ?\C-h ?\C-?)
@@ -64,7 +62,9 @@
   (:hook #'+init-add-setup-to-imenu))
 
 (setup (:require auth-source)
-  (:option auth-sources (list (private/ "authinfo"))))
+  (:option auth-sources (list (private/ "authinfo")))
+  (:with-mode authinfo-mode
+    (:local-set truncate-lines t)))
 
 (setup (:require auto-insert)
   (setf (alist-get '("lisp/.*\\.el\\'" . "+Emacs lisp")
@@ -400,6 +400,10 @@
     (:bind "c" #'+Info-copy-current-node-name
            "w" #'+Info-copy-current-node-name)))
 
+(setup ispell
+  (:also-load +ispell)
+  (put 'ispell-buffer-session-localwords 'safe-local-variable #'+ispell-safe-local-p))
+
 (setup kmacro
   (:also-load +kmacro)
   (with-eval-after-load '+kmacro
@@ -427,6 +431,11 @@
     (global-set-key (vector 'right-margin click) 'mwheel-scroll)
     (global-set-key (vector 'left-margin click) 'mwheel-scroll)))
 
+(setup net-utils
+  (:require +finger)                        ; fixes `finger' to use var below
+  (:option finger-X.500-host-regexps '(".") ; only send username
+           ))
+
 (setup org
   ;; Plain org with the `setup' form for sorting, but I install with straight.
   (:straight (org
@@ -571,6 +580,25 @@
   (+org-capture-templates-setf "l"
       `("Link" entry (file "links.org")
         "* %(+org-insert-link-dwim) %^g\n\n"))
+  (+org-capture-templates-setf "w" "Work")
+  (+org-capture-templates-setf "j"
+      '("Journal entry" plain
+        (file+olp+datetree "journal.org")
+        "**** %i%?\n"
+        :time-prompt n
+        :unnarrowed t))
+  ;; TODO: Prompt for identity file from ~/.ssh and try to guess the hostname
+  ;; from there.
+  (+org-capture-templates-setf "s"
+      `("SSH Config" plain (file "~/.ssh/config")
+        ,(concat "\n\nHost %^{Host: }"
+                 "\nHostname %\\1"
+                 "\nUser %^{User:|" (user-login-name) "}"
+                 "\nIdentityFile %?"
+                 "\nIdentitiesOnly yes"
+                 "\nPubkeyAuthentication yes"
+                 "\nPort %^{Port: |22}")
+        :unnarrowed t))
   (+org-capture-sort))
 
 (setup org-contacts
@@ -601,7 +629,7 @@
 
 (setup scratch
   (:require +scratch)
-  (:option initial-major-mode #'emacs-lisp-mode
+  (:option initial-major-mode #'lisp-interaction-mode
            initial-scratch-message
            ";; ABANDON ALL HOPE YE WHO ENTER HERE\n\n")
   (add-hook 'kill-buffer-query-functions #'+scratch-immortal))
@@ -640,35 +668,34 @@
   ;; TODO: +display-time-mode with MOAR customizations
   (:option display-time-default-load-average nil
            display-time-mail-file :disable)
-  (with-eval-after-load 'discord
-    (with-eval-after-load '+tab-bar
-      (:option display-time-string-forms
-               '((propertize (format-time-string "%H:%M %a %e" now)
-                             'face '+tab-bar-extra
-                             'help-echo (discord-date-string))
-                 load
-                 (if mail
-                     (concat " "
-                             (propertize
-                              display-time-mail-string
-                              'display `(when (and display-time-use-mail-icon
-                                                   (display-graphic-p))
-                                          ,@display-time-mail-icon
-                                          ,@(when (and
-                                                   display-time-mail-face
-                                                   (memq
-                                                    (plist-get
-                                                     (cdr display-time-mail-icon)
-                                                     :type)
-                                                    '(pbm xbm)))
-                                              (let ((bg (face-attribute
-                                                         display-time-mail-face
-                                                         :background)))
-                                                (when (stringp bg)
-                                                  (list :background bg)))))
-                              'face display-time-mail-face))
-                   "")
-                 " "))))
+  (:require discord +tab-bar)           ; Require instead of eval after load
+  (:option display-time-string-forms
+           '((propertize (format-time-string "%H:%M %a %e" now)
+                         'face '+tab-bar-extra
+                         'help-echo (discord-date-string))
+             load
+             (if mail
+                 (concat " "
+                         (propertize
+                          display-time-mail-string
+                          'display `(when (and display-time-use-mail-icon
+                                               (display-graphic-p))
+                                      ,@display-time-mail-icon
+                                      ,@(when (and
+                                               display-time-mail-face
+                                               (memq
+                                                (plist-get
+                                                 (cdr display-time-mail-icon)
+                                                 :type)
+                                                '(pbm xbm)))
+                                          (let ((bg (face-attribute
+                                                     display-time-mail-face
+                                                     :background)))
+                                            (when (stringp bg)
+                                              (list :background bg)))))
+                          'face display-time-mail-face))
+               "")
+             " "))
 
   (display-time-mode +1))
 
@@ -1030,6 +1057,7 @@ They are completed by \"M-x TAB\" only in Tramp debug buffers."
            "C-k" #'crux-kill-and-join-forward
            "C-c d" #'+crux-insert-date-or-time)
   (:+leader "s"  #'crux-visit-shell-buffer)
+  (crux-with-region-or-buffer indent-region)
 
   (el-patch-feature crux)
   (with-eval-after-load 'crux
@@ -1102,7 +1130,8 @@ See also `crux-reopen-as-root-mode'."
     (:hook #'reading-mode)
     (:option +elfeed--update-repeat (* 60 60) ; 1 hour
              +elfeed--update-first-time 60)
-    (+elfeed-update-async-mode +1)))
+    ;; (+elfeed-update-async-mode +1)
+    ))
 
 (setup (:straight elfeed-org)
   (:also-load +org-capture)
@@ -1133,6 +1162,13 @@ See also `crux-reopen-as-root-mode'."
   (:load-after consult embark)
   (add-hook 'embark-collect-mode-hook #'consult-preview-at-point-mode))
 
+(setup (:straight emms)
+  ;; TODO: Definitely need to do more customization here
+  (:option emms-source-file-default-directory "~/var/music/")
+  (require 'emms-setup)
+  (emms-all)
+  (emms-default-players))
+
 (setup (:straight epithet)
   (dolist (hook '(Info-selection-hook
                   eww-after-render-hook
@@ -1320,11 +1356,21 @@ See also `crux-reopen-as-root-mode'."
                                   "jabber-pkg.el")
                           :fork (:repo "https://tildegit.org/acdw/emacs-jabber"
                                        :host nil)))
+  (:also-load +jabber)
+  (:option jabber-account-list '(("acdw@hmm.st"))
+           jabber-groupchat-buffer-format "%n"
+           jabber-chat-buffer-format "%n"
+           jabber-muc-private-buffer-format "%n (%g)"
+           jabber-activity-show-p #'ignore)
   (dolist (mode '(jabber-chat-mode
                   jabber-browse-mode
                   jabber-roster-mode
                   jabber-console-mode))
-    (add-hook (intern (format "%s-hook" mode)) #'visual-fill-column-mode)))
+    (add-hook (intern (format "%s-hook" mode)) #'visual-fill-column-mode))
+  (add-hook 'jabber-activity-mode-hook 'tracking-mode)
+  (:+leader "C-j" jabber-global-keymap)
+  (advice-add 'jabber-activity-add :after #'+jabber-tracking-add)
+  (advice-add 'jabber-activity-add-muc :after #'+jabber-tracking-add-muc))
 
 (setup (:straight-when keychain-environment
          (executable-find "keychain"))

lisp/+finger.el

@@ -0,0 +1,46 @@
+;;; +finger.el --- Finger bugfix -*- lexical-binding: t; -*-
+
+;;; Commentary:
+
+;; `net-utils' defines `finger', which purportedly consults
+;; `finger-X.500-host-regexps' to determine what hosts to only send a username
+;; to.  I've found that that is not the case, and so I've patched it.  At some
+;; point I'll submit this to Emacs itself.
+
+;;; Code:
+
+(require 'net-utils)                    ; this requires everything else I'll need.
+(require 'seq)
+
+(defun finger (user host)
+  "Finger USER on HOST.
+This command uses `finger-X.500-host-regexps'
+and `network-connection-service-alist', which see."
+  ;; One of those great interactive statements that's actually
+  ;; longer than the function call! The idea is that if the user
+  ;; uses a string like "pbreton@cs.umb.edu", we won't ask for the
+  ;; host name. If we don't see an "@", we'll prompt for the host.
+  (interactive
+   (let* ((answer (read-from-minibuffer "Finger User: "
+                                        (net-utils-url-at-point)))
+          (index  (string-match (regexp-quote "@") answer)))
+     (if index
+         (list (substring answer 0 index)
+               (substring answer (1+ index)))
+       (list answer
+             (read-from-minibuffer "At Host: "
+                                   (net-utils-machine-at-point))))))
+  (let* ((user-and-host (concat user "@" host))
+         (process-name (concat "Finger [" user-and-host "]"))
+         (regexps finger-X.500-host-regexps)
+         ) ;; found
+    (when (seq-some (lambda (r) (string-match-p r host)) regexps)
+      (setq user-and-host user))
+    (run-network-program
+     process-name
+     host
+     (cdr (assoc 'finger network-connection-service-alist))
+     user-and-host)))
+
+(provide '+finger)
+;;; +finger.el ends here

lisp/+ispell.el

@@ -0,0 +1,82 @@
+;;; +ispell.el --- Customizations for `ispell' -*- lexical-binding: t; -*-
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'cl)
+
+;; Utility function TODO: move elsewhere
+(defun +ispell-append-removing-duplicates (&rest lists)
+  "Append LISTS, removing duplicates from the result.
+Any keyword arguments to `cl-remove-duplicates' should come
+before the LISTS."
+  (let (cl-remove-duplicates-args)
+    (while (keywordp (car lists))
+      (push (pop lists) cl-remove-duplicates-args)
+      (push (pop lists) cl-remove-duplicates-args))
+    (apply #'cl-remove-duplicates (apply #'append lists)
+           (nreverse cl-remove-duplicates-args))))
+
+;;; Ispell in .dir-locals
+
+;; Let Emacs know a list of strings is safe
+(defun +ispell-safe-local-p (list)
+  (and (listp list)
+       (seq-every-p #'stringp list)))
+
+;; Can I instruct ispell to insert LocalWords in a different file?
+;; https://emacs.stackexchange.com/q/31396/2264
+
+;; How can I move all my file-local LocalWords to .dir-locals.el?
+;; https://emacs.stackexchange.com/q/31419
+
+;; Adapted from ispell.el:ispell-buffer-local-words
+(defun +ispell-buffer-local-words-list ()
+  (let (words)
+    (or ispell-buffer-local-name
+        (setq ispell-buffer-local-name (buffer-name)))
+    (save-excursion
+      (goto-char (point-min))
+      (while (search-forward ispell-words-keyword nil t)
+        (let ((end (point-at-eol))
+              (ispell-casechars (ispell-get-casechars))
+              string)
+          (while (re-search-forward " *\\([^ ]+\\)" end t)
+            (setq string (match-string-no-properties 1))
+            (if (and (< 1 (length string))
+                     (equal 0 (string-match ispell-casechars string)))
+                (push string words))))))
+    words))
+
+(defun +ispell-move-buffer-words-to-dir-locals ()
+  (interactive)
+  (unless (buffer-file-name)
+    (user-error "Buffer not attached to file"))
+  (hack-dir-local-variables)
+  (let ((words (+ispell-buffer-local-words-list))
+        (dir-local-words (+ispell-append-removing-duplicates
+                          (alist-get 'ispell-buffer-session-localwords
+                                     dir-local-variables-alist)
+                          (alist-get 'ispell-buffer-session-localwords
+                                     file-local-variables-alist))))
+    (save-excursion
+      (add-dir-local-variable
+       major-mode
+       'ispell-buffer-session-localwords
+       (setq ispell-buffer-session-localwords
+             (+ispell-append-removing-duplicates
+              :test #'string=
+              dir-local-words ispell-buffer-session-localwords words)))
+      (when (y-or-n-p "Save .dir-locals.el?")
+        (save-buffer))
+      (bury-buffer))
+    (or ispell-buffer-local-name
+        (setq ispell-buffer-local-name (buffer-name)))
+    (save-excursion
+      (goto-char (point-min))
+      (while (search-forward ispell-words-keyword nil t)
+        (delete-region (point-at-bol) (1+ (point-at-eol)))))))
+
+(provide '+ispell)
+;;; +ispell.el ends here

lisp/+jabber.el

@@ -0,0 +1,29 @@
+;;; +jabber.el --- Customizations for jabber.el -*- lexical-binding: t; -*-
+
+;;; Commentary:
+
+;; Most changes I want to PR and contribute, but a few don't make sense to
+;; contribute upstream, at least not now.
+
+;;; Code:
+
+(require 'jabber)
+(require 'tracking)
+
+(defvar +jabber-tracking-show-p #'jabber-activity-show-p-default
+  "Function that checks if the given JID should be shown in the mode line.
+This does the same as `jabber-activity-show-p', but for the
+`tracking-mode' mode-line.")
+
+(defun +jabber-tracking-add (from buffer text proposed-alert)
+  "ADVICE to add jabber buffers to `tracking-buffers'."
+  (when (funcall +jabber-tracking-show-p from)
+    (tracking-add-buffer buffer 'jabber-activity-face)))
+
+(defun +jabber-tracking-add-muc (nick group buffer text proposed-alert)
+  "ADVICE to add jabber MUC buffers to `tracking-buffers'."
+  (when (funcall +jabber-tracking-show-p group)
+    (tracking-add-buffer buffer 'jabber-activity-face)))
+
+(provide '+jabber)
+;;; +jabber.el ends here

lisp/+modeline.el

@@ -57,16 +57,22 @@ This function makes a lambda, so you can throw it straight into
 
 ;;; Modeline segments
 
+(defun +modeline-sanitize-string (string)
+  "Sanitize a string for `format-mode-line'."
+  (when string
+    (string-replace "%" "%%" string)))
+
 (defun +modeline-buffer-name (&optional spacer)         ; gonsie
   "Display the buffer name."
-  (concat (or spacer +modeline-default-spacer)
-          (propertize
-           (truncate-string-to-width (buffer-name)
-                                     (min 24 (/ (window-width) 3))
-                                     nil ?\  t)
-           'help-echo (or (buffer-file-name)
-                          (buffer-name))
-           'mouse-face 'mode-line-highlight)))
+  (let ((bufname (string-replace "%" "" (buffer-name))))
+    (concat (or spacer +modeline-default-spacer)
+            (propertize
+             (truncate-string-to-width bufname
+                                       (min 24 (/ (window-width) 3))
+                                       nil ?\  t)
+             'help-echo (or (buffer-file-name)
+                            (buffer-name))
+             'mouse-face 'mode-line-highlight))))
 
 (defcustom +modeline-minions-icon "&"
   "The \"icon\" for `+modeline-minions' button."

lisp/acdw.el

@@ -222,5 +222,24 @@ UNIT can be one of :kb, :mb, :gb, :tb, :pb, :eb, :zb, :yb; :kib, :mib, :gib,
               (:zib (* 1024 1024 1024 1024 1024 1024 1024))
               (:yib (* 1024 1024 1024 1024 1024 1024 1024 1024)))))
 
+;;; Font lock TODO keywords
+
+(defcustom font-lock-todo-keywords '("TODO" "XXX" "FIXME" "BUG")
+  "Keywords to highlight with `font-lock-todo-face'.")
+
+(defface font-lock-todo-face '((t :inherit font-lock-warning-face))
+  "Face for TODO keywords.")
+
+(defun font-lock-todo-insinuate ()
+  (let ((keyword-regexp
+         (rx bow (group (eval (let ((lst '(or)))
+                                (dolist (kw font-lock-todo-keywords)
+                                  (push kw lst))
+                                (nreverse lst))))
+             ":")))
+    (font-lock-add-keywords
+     nil
+     `((,keyword-regexp 1 'font-lock-todo-face prepend)))))
+
 (provide 'acdw)
 ;;; acdw.el ends here