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

1 files changed, 65 insertions, 57 deletions

@@ -1,4 +1,4 @@
-;;; acdw.el -*- lexical-binding: t; coding: utf-8-unix -*-
+;;; acdw.el --- miscellaneous    -*- lexical-binding: t; coding: utf-8-unix -*-
 
 ;; Author: Case Duckworth <acdw@acdw.net>
 ;; Created: Sometime during Covid-19, 2020
@@ -21,6 +21,8 @@
 ;;; Code:
 
 (require 'cl-lib)
+(require 'auth-source)
+(require 'recentf)
 
 ;;; Variables
 
@@ -32,9 +34,9 @@
   "Which computer system is currently being used.")
 
 (defmacro acdw/system (&rest args)
-  "Convenience macro for interfacing with `acdw/system'.
+  "Macro for interfacing, depending on ARGS, with symbol `acdw/system'.
 
-When called without arguments, it returns `acdw/system'.  When
+When called without arguments, it returns symbol `acdw/system'.  When
 called with one (symbol) argument, it returns (eq acdw/system
 ARG).  When called with multiple arguments or a list, it returns
 `pcase' over each argument."
@@ -58,8 +60,7 @@ ARG).  When called with multiple arguments or a list, it returns
   `(and (fboundp ,func) ,func))
 
 (defmacro when-unfocused (name &rest forms)
-  "Define a function NAME, executing FORMS, that fires when Emacs
-is unfocused."
+  "Define a function NAME, executing FORMS, for when Emacs is unfocused."
   (declare (indent 1))
   (let ((func-name (intern (concat "when-unfocused-" (symbol-name name)))))
     `(progn
@@ -103,24 +104,39 @@ FILENAME and CONFIRM are passed directly to `write-file'."
       (write-file filename confirm))
     (switch-to-buffer buf)))
 
+;; https://old.reddit.com/r/emacs/comments/pjwkts
+(defun acdw/goto-last-row ()
+  "Move point to last row of buffer, but save the column."
+  (interactive)
+  (let ((col (current-column)))
+    (goto-char (point-max))
+    (move-to-column col t)))
+
+(defun acdw/goto-first-row ()
+  "Move point to first row of buffer, but save the column."
+  (interactive)
+  (let ((col (current-column)))
+    (goto-char (point-min))
+    (move-to-column col t)))
+
 (defun dos2unix (buffer)
   "Replace \r\n with \n in BUFFER."
   (interactive "*b")
   (save-excursion
-    (goto-char (point-min))
-    (while (search-forward (string ?\C-m ?\C-j) nil t)
-      (replace-match (string ?\C-j) nil t))))
-
-(defun expand-file-name-exists-p (&rest expand-file-name-args)
-  "Call `expand-file-name' on EXPAND-FILE-NAME-ARGS, returning
-  its name if it exists, or NIL otherwise."
-  (let ((file (apply #'expand-file-name expand-file-name-args)))
+    (with-current-buffer buffer
+      (goto-char (point-min))
+      (while (search-forward (string ?\C-m ?\C-j) nil t)
+        (replace-match (string ?\C-j) nil t)))))
+
+(defun expand-file-name-exists-p (&rest args)
+  "Return `expand-file-name' ARGS if it exists, or nil."
+  (let ((file (apply #'expand-file-name args)))
     (if (file-exists-p file)
         file
       nil)))
 
 (defun kill-region-or-backward-word (arg)
-  "Kill region if active, or backward word if not."
+  "If region is active, kill; otherwise kill word backward with ARG."
   (interactive "p")
   (if (region-active-p)
       (kill-region (region-beginning) (region-end))
@@ -129,19 +145,12 @@ FILENAME and CONFIRM are passed directly to `write-file'."
       (backward-kill-word arg))))
 
 (defun unfill-buffer (&optional buffer-or-name)
+  "Unfill entire contents of BUFFER-OR-NAME."
   (with-current-buffer (or buffer-or-name (current-buffer))
     (save-excursion
       (save-restriction
         (unfill-region (point-min) (point-max))))))
 
-;; https://www.emacswiki.org/emacs/UnfillRegion
-(defun unfill-region (start end)
-  "Unfill a region defined by START and END positions."
-  (interactive "*r")
-  (let ((fill-column (point-max))
-        (emacs-lisp-docstring-fill-column t))
-    (fill-region start end)))
-
 (defun waterfall-list (car list rest)
   "Cons CAR with each element in LIST in a waterfall fashion, end with REST.
 For use with the `with-eval-after-loads' function."
@@ -156,7 +165,7 @@ For use with the `with-eval-after-loads' function."
 ;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html
 
 (defun uncomment-sexp (&optional n)
-  "Uncomment a sexp around point."
+  "Uncomment N sexps around point."
   (interactive "P")
   (let* ((initial-point (point-marker))
          (inhibit-field-text-motion t)
@@ -192,7 +201,7 @@ For use with the `with-eval-after-loads' function."
                   (>= (point) beg))
         (skip-chars-backward (rx (syntax expression-prefix)))
         (setq p (point-marker)))
-      ;; Re-comment everything before it. 
+      ;; Re-comment everything before it.
       (ignore-errors
         (comment-region beg p))
       ;; And everything after it.
@@ -247,7 +256,7 @@ With a prefix argument N, (un)comment that many sexps."
 ;; and https://github.com/alphapapa/unpackaged.el/issues/20
 
 (defun sort-sexps (beg end &optional key)
-  "Sort sexps in region.
+  "Sort sexps between BEG and END.
 Comments stay with the code below.  KEY is a function to sort by,
 e.g. (lambda (sexp) (symbol-name (car sexp)))"
   (interactive "r")
@@ -301,8 +310,7 @@ e.g. (lambda (sexp) (symbol-name (car sexp)))"
 ;;; Emacs configuration functions
 
 (defun emacs-git-pull-config (&optional remote branch)
-  "`git-pull' emacs configuration from REMOTE and BRANCH.
-
+  "`git-pull' Emacs' configuration from REMOTE and BRANCH.
 REMOTE defaults to 'origin', BRANCH to 'main'."
   (let ((remote (or remote "origin"))
         (branch (or branch "main")))
@@ -315,8 +323,8 @@ REMOTE defaults to 'origin', BRANCH to 'main'."
 
 (defun emacs-reload (&optional git-pull-first)
   "Reload Emacs's configuration files.
-
-With a prefix argument, run git pull on the repo first."
+With a prefix argument GIT-PULL-FIRST, run git pull on the repo
+first."
   (interactive "P")
   (when git-pull-first
     (emacs-git-pull-config))
@@ -344,10 +352,10 @@ With a prefix argument, run git pull on the repo first."
 
 ;;; Specialized functions
 
-(defun acdw/copy-region-plain (start end)
-  "Copy a region to clipboard, removing all Org formatting."
+(defun acdw/copy-region-plain (beg end)
+  "Copy a region from BEG to END to clipboard, removing all Org formatting."
   (interactive "r")
-  (let ((s (buffer-substring-no-properties start end))
+  (let ((s (buffer-substring-no-properties beg end))
         (extracted-heading (when (derived-mode-p 'org-mode)
                              (acdw/org-extract-heading-text))))
     (with-temp-buffer
@@ -373,6 +381,7 @@ With a prefix argument, run git pull on the repo first."
   nil)
 
 (defun acdw/org-extract-heading-text ()
+  "Extract the heading text from an `org-mode' heading."
   (let ((heading (org-no-properties (org-get-heading t t t t))))
     (message
      (replace-regexp-in-string org-link-bracket-re
@@ -397,16 +406,8 @@ if MAKE-DIRECTORY is non-nil."
           file-name)
       dir)))
 
-(defun acdw/find-emacs-dotfiles ()
-  "Finds lisp files in `user-emacs-directory' and passes them to
-  `completing-read'."
-  (interactive)
-  (find-file (completing-read ".emacs: "
-                              (directory-files-recursively
-                               user-emacs-directory "\.el$"))))
-
-(defun acdw/find-emacs-source ()
-  "Find where Emacs keeps its source tree."
+(defun acdw/find-emacs-source () ;; doesn't work right now
+  "Find where Emacs' source tree is."
   (acdw/system
    (:work (expand-file-name
            (concat "~/src/emacs-" emacs-version "/src")))
@@ -423,18 +424,18 @@ if MAKE-DIRECTORY is non-nil."
   (setq gc-cons-threshold (* 800 1024 1024)
         gc-cons-percentage 0.1))
 
-(defun acdw/insert-iso-date (with-time)
-  "Insert the ISO-8601-formatted date, with optional time."
+(defun acdw/insert-iso-date (arg)
+  "Insert the ISO-8601-formatted date, optionally including time (pass ARG)."
   (interactive "P")
-  (let ((format (if with-time "%FT%T%z" "%F")))
+  (let ((format (if arg "%FT%T%z" "%F")))
     (insert (format-time-string format (current-time)))))
 
 (defun acdw/kill-a-buffer (&optional prefix)
-  "Kill a buffer based on the following rules:
+  "Kill this buffer, or other buffers, depending on PREFIX.
 
-C-x k         => Kill CURRENT buffer and window
-C-u C-x k     => Kill OTHER buffer and window
-C-u C-u C-x k => Kill ALL OTHER buffers and windows
+\\[acdw/kill-a-buffer] : Kill CURRENT buffer and window
+\\[universal-argument] \\[acdw/kill-a-buffer] : Kill OTHER buffer and window
+\\[universal-argument] \\[universal-argument] \\[acdw/kill-a-buffer] : Kill ALL OTHER buffers and windows
 
 Prompt only if there are unsaved changes."
   (interactive "P")
@@ -448,7 +449,7 @@ Prompt only if there are unsaved changes."
         (delete-other-windows))))
 
 (defun acdw/sunrise-sunset (sunrise-command sunset-command)
-  "Run commands at sunrise and sunset."
+  "Run SUNRISE-COMMAND at sunrise, and SUNSET-COMMAND at sunset."
   (let* ((times-regex (rx (* nonl)
                           (: (any ?s ?S) "unrise") " "
                           (group (repeat 1 2 digit) ":"
@@ -510,12 +511,14 @@ It's called 'require-private' for historical reasons."
 
 ;; Magic advice to rename entries in recentf when moving files in
 ;; dired.
-(defun rjs/recentf-rename-notify (oldname newname &rest args)
+(defun rjs/recentf-rename-notify (oldname newname &rest _args)
+  "Magically rename files from OLDNAME to NEWNAME when moved in `dired'."
   (if (file-directory-p newname)
       (rjs/recentf-rename-directory oldname newname)
     (rjs/recentf-rename-file oldname newname)))
 
 (defun rjs/recentf-rename-file (oldname newname)
+  "Rename a file from OLDNAME to NEWNAME in `recentf-list'."
   (setq recentf-list
         (mapcar (lambda (name)
                   (if (string-equal name oldname)
@@ -524,6 +527,7 @@ It's called 'require-private' for historical reasons."
                 recentf-list)))
 
 (defun rjs/recentf-rename-directory (oldname newname)
+  "Rename directory from OLDNAME to NEWNAME in `recentf-list'."
   ;; oldname, newname and all entries of recentf-list should already
   ;; be absolute and normalised so I think this can just test whether
   ;; oldname is a prefix of the element.
@@ -539,6 +543,7 @@ It's called 'require-private' for historical reasons."
 ;; https://emacs.stackexchange.com/questions/33039/
 
 (defun sort-setq ()
+  "Sort a setq.  Must be a defun."
   (interactive)
   (save-excursion
     (save-restriction
@@ -554,29 +559,32 @@ It's called 'require-private' for historical reasons."
         (sort-subr nil #'sort-setq-next-record #'sort-setq-end-record)))))
 
 (defun sort-setq-next-record ()
+  "Sort the next record of a `setq' form."
   (condition-case nil
       (progn
         (forward-sexp 1)
         (backward-sexp))
-    ('scan-error (end-of-buffer))))
+    ('scan-error (goto-char (point-max)))))
 
 (defun sort-setq-end-record ()
+  "Sort the end of a `setq' record."
   (condition-case nil
       (forward-sexp 2)
-    ('scan-error (end-of-buffer))))
+    ('scan-error (goto-char (point-max)))))
 
 
 ;;; Crux tweaks
 
 ;; `crux-other-window-or-switch-buffer' doesn't take an argument.
 (defun acdw/other-window-or-switch-buffer (&optional arg)
-  "Call `other-window' or switch buffers, depending on window count."
+  "Call `other-window' with ARG or switch buffers, depending on window count."
   (interactive "P")
   (if (one-window-p)
       (switch-to-buffer nil)
     (other-window (or arg 1))))
 
 (defun acdw/other-window-or-switch-buffer-backward ()
+  "Do `acdw/other-window-or-switch-buffer', but backward."
   (interactive)
   (acdw/other-window-or-switch-buffer -1))
 
@@ -584,8 +592,8 @@ It's called 'require-private' for historical reasons."
 ;;; Auth-sources
 ;; https://github.com/emacs-circe/circe/wiki/Configuration
 (defun acdw/fetch-password (&rest params)
-  "Fetch a password from `auth-source'."
-  (require 'auth-source)
+  "Fetch a password from `auth-source' using PARAMS.
+This function is internal.  Use `acdw/make-password-fetcher' instead."
   (let ((match (car (apply #'auth-source-search params))))
     (if match
         (let ((secret (plist-get match :secret)))
@@ -595,7 +603,7 @@ It's called 'require-private' for historical reasons."
       (message "Password not found for %S" params))))
 
 (defun acdw/make-password-fetcher (&rest params)
-  "Make a function that will fetch a password using `acdw/fetch-password'."
+  "Make a function that will call `acdw/fetch-password' with PARAMS."
   (lambda (&rest _)
     (apply #'acdw/fetch-password params)))