1 files changed, 112 insertions, 22 deletions

@@ -28,21 +28,21 @@
     (_ :other))
   "Which computer system is currently being used.")
 
-(defmacro acdw/system (&rest arg)
+(defmacro acdw/system (&rest args)
   "Convenience macro for interfacing with `acdw/system'.
 
-When called without arguments, it returns `acdw/system'.
-When called with one argument, it returns (eq acdw/system ARG).
-When called with multiple arguments, it returns `pcase' over each argument."
+When called without arguments, it returns `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."
   (cond
-   ((not arg) acdw/system)
-   ((not (cdr arg))
-    `(when (eq acdw/system ,(car arg))
-       ,(car arg)))
-   ((cdr arg)
+   ((null args) acdw/system)
+   ((atom (car args))
+    `(when (eq acdw/system ,(car args))
+       ,(car args)))
+   (t
     `(pcase acdw/system
-       ,@arg))
-   (t (error "Wrong argument type: %s" (type-of arg)))))
+       ,@args))))
 
 
 ;;; Utility functions
@@ -65,17 +65,17 @@ When called with multiple arguments, it returns `pcase' over each argument."
         file
       nil)))
 
-(defmacro hook-defun (name hooks &rest forms)
-  "Define a function NAME that executes FORMS, and add it to
-each hook in HOOKS."
-  (declare (indent 2))
-  (let ((func-name (intern (concat "hook-defun-" (symbol-name name))))
-        (hook-list (if (consp hooks) hooks (list hooks)))
-        (hook-defun-add-hook-list))
-    `(progn
-       (defun ,func-name () "Defined by `hook-defun'." ,@forms)
-       ,@(dolist (hook hook-list hook-defun-add-hook-list)
-           (push `(add-hook ',hook #',func-name) hook-defun-add-hook-list)))))
+;; (defmacro hook-defun (name hooks &rest forms)
+;;   "Define a function NAME that executes FORMS, and add it to
+;; each hook in HOOKS."
+;;   (declare (indent 2))
+;;   (let ((func-name (intern (concat "hook-defun-" (symbol-name name))))
+;;         (hook-list (if (consp hooks) hooks (list hooks)))
+;;         (hook-defun-add-hook-list))
+;;     `(progn
+;;        (defun ,func-name () "Defined by `hook-defun'." ,@forms)
+;;        ,@(dolist (hook hook-list hook-defun-add-hook-list)
+;;            (push `(add-hook ',hook #',func-name) hook-defun-add-hook-list)))))
 
 (defun kill-region-or-backward-word (arg)
   "Kill region if active, or backward word if not."
@@ -106,6 +106,96 @@ is unfocused."
      (message "%s... Done." ,message)))
 
 
+;;; Comment-or-uncomment-sexp
+;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html
+
+(defun uncomment-sexp (&optional n)
+  "Uncomment a sexp around point."
+  (interactive "P")
+  (let* ((initial-point (point-marker))
+         (inhibit-field-text-motion t)
+         (p)
+         (end (save-excursion
+                (when (elt (syntax-ppss) 4)
+                  (re-search-backward comment-start-skip
+                                      (line-beginning-position)
+                                      t))
+                (setq p (point-marker))
+                (comment-forward (point-max))
+                (point-marker)))
+         (beg (save-excursion
+                (forward-line 0)
+                (while (and (not (bobp))
+                            (= end (save-excursion
+                                     (comment-forward (point-max))
+                                     (point))))
+                  (forward-line -1))
+                (goto-char (line-end-position))
+                (re-search-backward comment-start-skip
+                                    (line-beginning-position)
+                                    t)
+                (ignore-errors
+                  (while (looking-at-p comment-start-skip)
+                    (forward-char -1)))
+                (point-marker))))
+    (unless (= beg end)
+      (uncomment-region beg end)
+      (goto-char p)
+      ;; Indentify the "top-level" sexp inside the comment.
+      (while (and (ignore-errors (backward-up-list) t)
+                  (>= (point) beg))
+        (skip-chars-backward (rx (syntax expression-prefix)))
+        (setq p (point-marker)))
+      ;; Re-comment everything before it. 
+      (ignore-errors
+        (comment-region beg p))
+      ;; And everything after it.
+      (goto-char p)
+      (forward-sexp (or n 1))
+      (skip-chars-forward "\r\n[:blank:]")
+      (if (< (point) end)
+          (ignore-errors
+            (comment-region (point) end))
+        ;; If this is a closing delimiter, pull it up.
+        (goto-char end)
+        (skip-chars-forward "\r\n[:blank:]")
+        (when (eq 5 (car (syntax-after (point))))
+          (delete-indentation))))
+    ;; Without a prefix, it's more useful to leave point where
+    ;; it was.
+    (unless n
+      (goto-char initial-point))))
+
+(defun comment-sexp--raw ()
+  "Comment the sexp at point or ahead of point."
+  (pcase (or (bounds-of-thing-at-point 'sexp)
+             (save-excursion
+               (skip-chars-forward "\r\n[:blank:]")
+               (bounds-of-thing-at-point 'sexp)))
+    (`(,l . ,r)
+     (goto-char r)
+     (skip-chars-forward "\r\n[:blank:]")
+     (save-excursion
+       (comment-region l r))
+     (skip-chars-forward "\r\n[:blank:]"))))
+
+(defun comment-or-uncomment-sexp (&optional n)
+  "Comment the sexp at point and move past it.
+If already inside (or before) a comment, uncomment instead.
+With a prefix argument N, (un)comment that many sexps."
+  (interactive "P")
+  (if (or (elt (syntax-ppss) 4)
+          (< (save-excursion
+               (skip-chars-forward "\r\n[:blank:]")
+               (point))
+             (save-excursion
+               (comment-forward 1)
+               (point))))
+      (uncomment-sexp n)
+    (dotimes (_ (or n 1))
+      (comment-sexp--raw))))
+
+
 ;;; Emacs configuration functions
 
 (defun emacs-git-pull-config (&optional remote branch)