about summary refs log tree commit diff stats
diff options
context:
space:
mode:
-rw-r--r--basics.el21
-rw-r--r--init.el74
-rw-r--r--lisp/acdw-mail.el12
-rw-r--r--lisp/acdw-org.el69
-rw-r--r--lisp/acdw.el129
5 files changed, 279 insertions, 26 deletions
diff --git a/basics.el b/basics.el index 1f64522..3b24a68 100644 --- a/basics.el +++ b/basics.el
@@ -290,6 +290,17 @@ N spaces."
290(global-set-key (kbd "C-/") #'undo-only) 290(global-set-key (kbd "C-/") #'undo-only)
291(global-set-key (kbd "C-?") #'undo-redo) 291(global-set-key (kbd "C-?") #'undo-redo)
292 292
293(global-set-key [f10] #'tmm-menubar)
294(advice-add 'tmm-add-prompt :after 'minibuffer-hide-completions)
295
296(when (fboundp '+lisp-comment-or-uncomment-sexp)
297 (define-key lisp-mode-map (kbd "C-M-;") #'+lisp-comment-or-uncomment-sexp)
298 (define-key emacs-lisp-mode-map (kbd "C-M-;")
299 #'+lisp-comment-or-uncomment-sexp)
300 (with-eval-after-load 'scheme
301 (define-key scheme-mode-map (kbd "C-M-;")
302 #'+lisp-comment-or-uncomment-sexp)))
303
293(define-key emacs-lisp-mode-map (kbd "C-c C-c") 304(define-key emacs-lisp-mode-map (kbd "C-c C-c")
294 #'eval-defun) 305 #'eval-defun)
295(define-key emacs-lisp-mode-map (kbd "C-c C-k") 306(define-key emacs-lisp-mode-map (kbd "C-c C-k")
@@ -415,14 +426,18 @@ See also `with-region-or-to-eol'."
415 :ensure t :demand t 426 :ensure t :demand t
416 :config 427 :config
417 (setq vertico-cycle t) 428 (setq vertico-cycle t)
429 (add-hook 'vertico-mode-hook
430 (defun vertico-mode@fix-completions ()
431 (setopt completion-in-region-function
432 (if vertico-mode
433 #'consult-completion-in-region
434 #'completion--in-region))))
418 (vertico-mode)) 435 (vertico-mode))
419 436
420(use-package vertico-directory 437(use-package vertico-directory
421 :after vertico 438 :after vertico
422 :bind (:map vertico-map 439 :bind (:map vertico-map
423 ("RET" . vertico-directory-enter) 440 ("C-DEL" . vertico-directory-delete-word))
424 ("DEL" . vertico-directory-delete-char)
425 ("M-DEL" . vertico-directory-delete-word))
426 :hook (rfn-shadow-update-overlay-hook . vertico-directory-tidy)) 441 :hook (rfn-shadow-update-overlay-hook . vertico-directory-tidy))
427 442
428(use-package vertico-mouse 443(use-package vertico-mouse
diff --git a/init.el b/init.el index da4b537..f4eac89 100644 --- a/init.el +++ b/init.el
@@ -10,12 +10,20 @@
10 10
11(use-package emacs ; Misc. config 11(use-package emacs ; Misc. config
12 :custom-face 12 :custom-face
13 (default ((t :family "Comic Code" 13 (fixed-pitch ((t :family ,(find-font "Comic Code"
14 "DejaVu Sans Mono")
15 :height 100)))
16 (variable-pitch ((t :family ,(find-font "Atkinson Hyperlegible"
17 "DejaVu Serif")
18 :height 1.4)))
19 (default ((t :family ,(find-font "Comic Code"
20 "DejaVu Sans Mono")
14 :height 100))) 21 :height 100)))
15 (variable-pitch ((t :family "Comic Code"))) 22 (font-lock-comment-face ((t :slant italic)))
16 :config 23 :config
17 (setopt tab-bar-show 1 24 (setopt tab-bar-show 1
18 recenter-positions '(top middle bottom))) 25 recenter-positions '(top middle bottom))
26 (keymap-global-unset "C-\\"))
19 27
20(use-package faces 28(use-package faces
21 :defer 2 ; This is sort of expensive 29 :defer 2 ; This is sort of expensive
@@ -272,7 +280,9 @@ With prefix ARG, toggle the value of
272 (visual-fill-column-mode) 280 (visual-fill-column-mode)
273 (electric-pair-local-mode -1) 281 (electric-pair-local-mode -1)
274 (auto-fill-mode -1) 282 (auto-fill-mode -1)
275 (setq-local wrap-prefix (make-string (+ 3 jabber-prefix-width) #x20))) 283 (setq-local wrap-prefix (make-string (+ 3 jabber-prefix-width) #x20)
284 visual-fill-column-extra-text-width `(,(+ 3 jabber-prefix-width)
285 . 1)))
276 :custom-face 286 :custom-face
277 (jabber-activity-face ((t :inherit jabber-chat-prompt-foreign 287 (jabber-activity-face ((t :inherit jabber-chat-prompt-foreign
278 :foreground unspecified 288 :foreground unspecified
@@ -294,12 +304,13 @@ With prefix ARG, toggle the value of
294 :config 304 :config
295 (setopt jabber-account-list '(("acdw@hmm.st")) 305 (setopt jabber-account-list '(("acdw@hmm.st"))
296 jabber-auto-reconnect t 306 jabber-auto-reconnect t
297 jabber-last-read-marker (make-string 40 ?-) 307 jabber-last-read-marker (make-string (- fill-column 8) ?—)
298 jabber-muc-decorate-presence-patterns 308 jabber-muc-decorate-presence-patterns
299 '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$") 309 '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$" . nil)
310 ("Mode #.*" . jabber-muc-presence-dim)
300 ("." . jabber-muc-presence-dim)) 311 ("." . jabber-muc-presence-dim))
301 jabber-activity-make-strings #'jabber-activity-make-strings-shorten 312 jabber-activity-make-strings #'jabber-activity-make-strings-shorten
302 jabber-last-read-marker (make-string (- fill-column 8) ?-) 313 jabber-last-read-marker (make-string fill-column ?-)
303 jabber-rare-time-format " - - - - - - %H:%M %F" 314 jabber-rare-time-format " - - - - - - %H:%M %F"
304 ;; buffer name formats 315 ;; buffer name formats
305 jabber-chat-buffer-format "%n <xmpp>" 316 jabber-chat-buffer-format "%n <xmpp>"
@@ -341,6 +352,11 @@ With prefix ARG, toggle the value of
341 352
342;;; External packages 353;;; External packages
343 354
355(use-package form-feed
356 :ensure t
357 :hook (emacs-lisp-mode-hook
358 jabber-chat-mode-hook))
359
344(use-package minions 360(use-package minions
345 :ensure t 361 :ensure t
346 :config (minions-mode)) 362 :config (minions-mode))
@@ -349,7 +365,7 @@ With prefix ARG, toggle the value of
349 :ensure t 365 :ensure t
350 :init 366 :init
351 (setopt visual-fill-column-center-text t 367 (setopt visual-fill-column-center-text t
352 visual-fill-column-extra-text-width '(1 . 1)) 368 visual-fill-column-extra-text-width '(3 . 3))
353 :config 369 :config
354 (add-hook 'visual-fill-column-mode-hook #'visual-line-mode) 370 (add-hook 'visual-fill-column-mode-hook #'visual-line-mode)
355 (add-hook 'eww-mode-hook #'visual-fill-column-mode) 371 (add-hook 'eww-mode-hook #'visual-fill-column-mode)
@@ -620,7 +636,7 @@ With prefix ARG, toggle the value of
620 (push (cons (format "%s - %s" name tags) url) chans))))))))) 636 (push (cons (format "%s - %s" name tags) url) chans)))))))))
621 637
622(use-package wiki-abbrev 638(use-package wiki-abbrev
623 :defer 5 ; Allow for network to come up 639 :after org ; Don't need abbrevs til I load org.
624 :load-path "~/src/emacs/wiki-abbrev.el/" 640 :load-path "~/src/emacs/wiki-abbrev.el/"
625 :config 641 :config
626 (setopt wiki-abbrev-file (etc/ "wiki-abbrevs")) 642 (setopt wiki-abbrev-file (etc/ "wiki-abbrevs"))
@@ -651,8 +667,8 @@ With PREFIX, prompt to change the current dictionary."
651 :ensure t 667 :ensure t
652 :after dired 668 :after dired
653 :bind (:map dired-mode-map 669 :bind (:map dired-mode-map
654 (("TAB" . dired-subtree-cycle) 670 (("TAB" . dired-subtree-cycle)
655 ("i" . dired-subtree-toggle)))) 671 ("i" . dired-subtree-toggle))))
656 672
657(use-package dired-hide-dotfiles 673(use-package dired-hide-dotfiles
658 ;; I could maybe use a more general package for this ... see 674 ;; I could maybe use a more general package for this ... see
@@ -661,11 +677,45 @@ With PREFIX, prompt to change the current dictionary."
661 :bind (:map dired-mode-map 677 :bind (:map dired-mode-map
662 ("." . dired-hide-dotfiles-mode))) 678 ("." . dired-hide-dotfiles-mode)))
663 679
680(use-package embrace
681 :ensure t
682 :preface
683 (defmacro org-insert-or-embrace (char)
684 "Define a function to insert CHAR, or `embrace' the region with it."
685 (let* ((fn-name (intern (format "org-insert-or-embrace-%s" char)))
686 (char (cond ((characterp char) char)
687 ((stringp char) (string-to-char char))
688 (t (user-error "Bad format for char: %S" char)))))
689 `(defun ,fn-name (n)
690 ,(format "Insert N %ss, or surround the region with them."
691 (char-to-string char))
692 (interactive "p")
693 (if (region-active-p)
694 (dotimes (_ n)
695 (embrace--add-internal (region-beginning) (region-end) ,char)
696 (forward-char 1))
697 (self-insert-command n ,char)))))
698 (with-eval-after-load 'org
699 (require 'embrace)
700 (keymap-set org-mode-map "*" (org-insert-or-embrace "*"))
701 (keymap-set org-mode-map "/" (org-insert-or-embrace "/"))
702 (keymap-set org-mode-map "_" (org-insert-or-embrace "_"))
703 (keymap-set org-mode-map "=" (org-insert-or-embrace "="))
704 (keymap-set org-mode-map "~" (org-insert-or-embrace "~"))
705 (keymap-set org-mode-map "+" (org-insert-or-embrace "+")))
706 :bind (("C-\"" . embrace-commander))
707 :hook ((org-mode-hook . embrace-org-mode-hook)
708 (ruby-mode-hook . embrace-ruby-mode-hook)
709 (emacs-lisp-mode-hook . embrace-emacs-lisp-mode-hook)
710 (latex-mode-hook . embrace-LaTeX-mode-hook)))
711
664 712
665;;; Applications 713;;; Applications
666 714
667(use-package acdw-mail 715(use-package acdw-mail
668 :load-path "lisp/") 716 :load-path "lisp/"
717 :demand t
718 :bind (("C-c n" . +notmuch-goto)))
669 719
670(use-package acdw-org 720(use-package acdw-org
671 :load-path "lisp/") 721 :load-path "lisp/")
diff --git a/lisp/acdw-mail.el b/lisp/acdw-mail.el index d0ee28e..9545808 100644 --- a/lisp/acdw-mail.el +++ b/lisp/acdw-mail.el
@@ -3,6 +3,7 @@
3;;; Code: 3;;; Code:
4 4
5(require 'cl-lib) 5(require 'cl-lib)
6(require 'message)
6 7
7;;; Variables 8;;; Variables
8 9
@@ -56,6 +57,7 @@ Useful in `message-send-hook'."
56 "Concatenate `notmuch' QUERIES with AND." 57 "Concatenate `notmuch' QUERIES with AND."
57 (mapconcat #'identity queries " AND ")) 58 (mapconcat #'identity queries " AND "))
58 59
60;;;###autoload
59(defun +notmuch-goto (&optional prefix) 61(defun +notmuch-goto (&optional prefix)
60 "Perform a saved `notmuch' search. 62 "Perform a saved `notmuch' search.
61Without a PREFIX argument, perform the first search in 63Without a PREFIX argument, perform the first search in
@@ -91,7 +93,7 @@ reversing the tag changes."
91 (when (eq start end) 93 (when (eq start end)
92 (notmuch-search-next-thread))) 94 (notmuch-search-next-thread)))
93 95
94(defun +notmuch-tree-mark-spam (&optional ham) 96(defun +notmuch-tree-mark-spam (&optional ham _ _)
95 "Mark the current message as spam. 97 "Mark the current message as spam.
96That is, add the tags in `+notmuch-spam-tags' to the message. 98That is, add the tags in `+notmuch-spam-tags' to the message.
97With an optional HAM argument (interactively, 99With an optional HAM argument (interactively,
@@ -152,6 +154,7 @@ the saved search as well."
152 :preface (defdir notmuch/ (sync/ "emacs/notmuch/") 154 :preface (defdir notmuch/ (sync/ "emacs/notmuch/")
153 "Notmuch configuration directory." 155 "Notmuch configuration directory."
154 :makedir) 156 :makedir)
157 :bind (("C-c m" . notmuch-mua-new-mail))
155 :config 158 :config
156 ;; Options 159 ;; Options
157 (setopt notmuch-init-file (notmuch/ "notmuch-init.el" t) 160 (setopt notmuch-init-file (notmuch/ "notmuch-init.el" t)
@@ -172,8 +175,6 @@ the saved search as well."
172 message-envelope-from 'header 175 message-envelope-from 'header
173 notmuch-saved-searches nil) 176 notmuch-saved-searches nil)
174 ;; Key bindings 177 ;; Key bindings
175 (keymap-global-set "C-c m" #'nomtuch-mua-new-mail)
176 (keymap-global-set "C-c n" #'+notmuch-goto)
177 (keymap-set notmuch-search-mode-map "!" #'+notmuch-search-mark-spam) 178 (keymap-set notmuch-search-mode-map "!" #'+notmuch-search-mark-spam)
178 (keymap-set notmuch-search-mode-map "RET" #'notmuch-search-show-thread) 179 (keymap-set notmuch-search-mode-map "RET" #'notmuch-search-show-thread)
179 (keymap-set notmuch-search-mode-map "M-RET" #'notmuch-tree-from-search-thread) 180 (keymap-set notmuch-search-mode-map "M-RET" #'notmuch-tree-from-search-thread)
@@ -197,7 +198,7 @@ the saved search as well."
197 "tag:draft") 198 "tag:draft")
198 (+notmuch-define-saved-search "all mail" "a" 'tree "*") 199 (+notmuch-define-saved-search "all mail" "a" 'tree "*")
199 ;; Hooks and advice 200 ;; Hooks and advice
200 (add-hook 'message-send-hook #'+message-send-dispatch-rules) 201 (add-hook 'message-send-hook #'+message-send-set-variables)
201 (add-hook 'message-setup-hook #'+message-signature-setup) 202 (add-hook 'message-setup-hook #'+message-signature-setup)
202 (autoload 'visual-fill-column-mode "visual-fill-column" nil t) 203 (autoload 'visual-fill-column-mode "visual-fill-column" nil t)
203 (add-hook 'notmuch-message-mode-hook #'visual-fill-column-mode) 204 (add-hook 'notmuch-message-mode-hook #'visual-fill-column-mode)
@@ -214,13 +215,14 @@ This version doesn't add any initial-input."
214 "Make `notmuch-mua-new-reply' list-aware." 215 "Make `notmuch-mua-new-reply' list-aware."
215 (let ((ml (notmuch-show-get-header :List-Post))) 216 (let ((ml (notmuch-show-get-header :List-Post)))
216 (apply orig r) 217 (apply orig r)
218 (require 'message)
217 (when ml 219 (when ml
218 (with-buffer-modified-unmodified 220 (with-buffer-modified-unmodified
219 (message-remove-header "To") 221 (message-remove-header "To")
220 (message-add-header 222 (message-add-header
221 (format "To: %s" (replace-regexp-in-string "<mailto:\\(.*\\)>" "\\1" 223 (format "To: %s" (replace-regexp-in-string "<mailto:\\(.*\\)>" "\\1"
222 ml))) 224 ml)))
223 (messgage-goto-body))))) 225 (message-goto-body)))))
224 226
225 (define-advice notmuch-tag (:filter-args (args) trim) 227 (define-advice notmuch-tag (:filter-args (args) trim)
226 "Trim whitespace from ends of tags." 228 "Trim whitespace from ends of tags."
diff --git a/lisp/acdw-org.el b/lisp/acdw-org.el index 8a63d04..5255a50 100644 --- a/lisp/acdw-org.el +++ b/lisp/acdw-org.el
@@ -222,6 +222,25 @@ If LIST is non-nil, return the result as a list instead of a string."
222 222
223(use-package org 223(use-package org
224 :defer t 224 :defer t
225 :custom-face
226 (org-level-1 ((t :inherit fixed-pitch
227 :weight bold
228 :height 1.2)))
229 (org-level-2 ((t :inherit fixed-pitch
230 :weight bold
231 :height 1.1)))
232 (org-level-3 ((t :inherit fixed-pitch
233 :weight bold
234 :height 1.0)))
235 (org-level-4 ((t :inherit org-level-3)))
236 (org-level-5 ((t :inherit org-level-4)))
237 (org-level-6 ((t :inherit org-level-5)))
238 (org-level-7 ((t :inherit org-level-6)))
239 (org-level-8 ((t :inherit org-level-7)))
240 (org-drawer ((t :inherit fixed-pitch)))
241 (org-property-value ((t :inherit fixed-pitch)))
242 (org-special-keyword ((t :inherit fixed-pitch)))
243 (org-indent ((t :inherit fixed-pitch)))
225 :config 244 :config
226 ;; Options 245 ;; Options
227 (setopt org-adapt-indentation nil 246 (setopt org-adapt-indentation nil
@@ -273,7 +292,7 @@ If LIST is non-nil, return the result as a list instead of a string."
273 org-src-window-setup 'current-window 292 org-src-window-setup 'current-window
274 org-startup-truncated nil 293 org-startup-truncated nil
275 org-startup-with-inline-images t 294 org-startup-with-inline-images t
276 org-tags-column 0 295 org-tags-column 0 ;(- 0 fill-column -3)
277 org-todo-keywords '((sequence "TODO(t)" "WAIT(w@/!)" "ONGOING(o@)" 296 org-todo-keywords '((sequence "TODO(t)" "WAIT(w@/!)" "ONGOING(o@)"
278 "|" "DONE(d!)" "ASSIGNED(a@/!)") 297 "|" "DONE(d!)" "ASSIGNED(a@/!)")
279 (sequence "|" "CANCELED(k@)") 298 (sequence "|" "CANCELED(k@)")
@@ -292,9 +311,25 @@ If LIST is non-nil, return the result as a list instead of a string."
292 (add-hook 'org-mode-hook #'turn-off-auto-fill) 311 (add-hook 'org-mode-hook #'turn-off-auto-fill)
293 (add-hook 'org-mode-hook #'org-indent-mode) 312 (add-hook 'org-mode-hook #'org-indent-mode)
294 (add-hook 'org-mode-hook #'abbrev-mode) 313 (add-hook 'org-mode-hook #'abbrev-mode)
295 (add-hook 'org-mode-hook (defun before-save@org-mode () 314 (add-hook 'org-mode-hook
296 (org-align-tags 'all) 315 (defun before-save@org-mode ()
297 (+org-hide-drawers-except-point)))) 316 (add-hook 'before-save-hook
317 (defun before-save@org-mode@before-save ()
318 (org-align-tags 'all)
319 (+org-hide-drawers-except-point))
320 nil :local)))
321 ;; Extra font-lock keywords
322 (font-lock-add-keywords
323 'org-mode
324 `(;; List markers => org-indent
325 (,(concat
326 "^[ ]*\\(\\(?:[-+]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)"
327 "\\(?:[ ]+\\|$\\)\\)"
328 "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\]"
329 "[ ]*\\)?"
330 "\\(?:\\(\\[[ X-]\\]\\)"
331 "\\(?:[ ]+\\|$\\)\\)?")
332 0 'org-indent))))
298 333
299(use-package org-agenda 334(use-package org-agenda
300 :bind (("C-c a" . org-agenda)) 335 :bind (("C-c a" . org-agenda))
@@ -316,7 +351,10 @@ If LIST is non-nil, return the result as a list instead of a string."
316 org-deadline-warning-days 0 351 org-deadline-warning-days 0
317 org-agenda-show-future-repeats 'next 352 org-agenda-show-future-repeats 'next
318 org-agenda-window-setup 'current-window 353 org-agenda-window-setup 'current-window
319 org-agenda-skip-file-regexp "sync-conflict") 354 org-agenda-skip-file-regexp "sync-conflict"
355 org-agenda-inhibit-startup t
356 org-agenda-sticky t
357 org-agenda-follow-indirect t)
320 ;; Hooks and advice 358 ;; Hooks and advice
321 (add-hook 'org-agenda-mode-hook #'truncate-lines-local-mode) 359 (add-hook 'org-agenda-mode-hook #'truncate-lines-local-mode)
322 (add-hook 'org-agenda-mode-hook #'hl-line-mode) 360 (add-hook 'org-agenda-mode-hook #'hl-line-mode)
@@ -329,7 +367,13 @@ If LIST is non-nil, return the result as a list instead of a string."
329 (string-match-p org-agenda-skip-file-regexp 367 (string-match-p org-agenda-skip-file-regexp
330 file)) 368 file))
331 files))) 369 files)))
332 files)) 370 files)
371 (define-advice org-agenda (:around (orig &rest r) inhibit-hooks)
372 (let ((org-mode-hook nil))
373 (apply orig r)))
374 (define-advice org-agenda-switch-to (:after (&rest _) do-hooks)
375 (run-hooks 'org-mode-hook))
376 (progress@around org-agenda-list "Building agenda"))
333 377
334(use-package org-capture 378(use-package org-capture
335 :bind (("C-c c" . org-capture))) 379 :bind (("C-c c" . org-capture)))
@@ -373,5 +417,18 @@ effect for exporting link types)."
373 :load-path "~/src/emacs/org-word-count/" 417 :load-path "~/src/emacs/org-word-count/"
374 :hook org-mode-hook) 418 :hook org-mode-hook)
375 419
420(use-package org-modern
421 :ensure t
422 :custom-face
423 (org-modern-label ((t :inherit fixed-pitch
424 :height 1.0)))
425 :config
426 (setopt org-modern-star nil
427 org-hide-leading-stars nil
428 org-modern-hide-stars nil
429 org-tags-column 0
430 org-modern-keyword nil)
431 (global-org-modern-mode))
432
376(provide 'acdw-org) 433(provide 'acdw-org)
377;;; acdw-org.el ends here 434;;; acdw-org.el ends here
diff --git a/lisp/acdw.el b/lisp/acdw.el index 6729759..a05295c 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el
@@ -85,5 +85,134 @@ If `:separator' is the first of STRINGS, the next string will be
85used as a separator." 85used as a separator."
86 (++concat #'format strings)) 86 (++concat #'format strings))
87 87
88(defun mapc-buffers (func &optional predicate)
89 "Map FUNC over buffers matching PREDICATE.
90Both FUNC and PREDICATE will be executed with no arguments and in
91the context of each buffer.
92
93If PREDICATE is nil or not given, map FUNC over all buffers."
94 (cl-loop for buf being the buffers
95 do (with-current-buffer buf
96 (when (and predicate
97 (funcall predicate))
98 (funcall func)))))
99
100(defun mapc-buffers-modes (func &rest modes)
101 "Map FUNC over buffers derived from MODES.
102FUNC will be executed with no arguments and in the context of
103each buffer."
104 (mapc-buffers func
105 (lambda ()
106 (apply #'derived-mode-p modes))))
107
108(defun find-font (&rest fonts)
109 "Return the first font of FONTS that is installed."
110 (cl-loop with ffl = (font-family-list)
111 for font in fonts
112 if (member font ffl)
113 return font))
114
115(defmacro progress@around (fn message &optional name)
116 "Define :around advice for functions adding a simple progress reporter."
117 (let ((orig (gensym))
118 (args (gensym))
119 (prog (gensym)))
120 `(define-advice ,fn (:around (,orig &rest ,args) ,(or name 'progress))
121 ,(format "Add a simple progress reporter to %s." fn)
122 (let ((,prog (make-progress-reporter
123 ,(format "%s..." (string-remove-suffix "..." message)))))
124 (apply ,orig ,args)
125 (progress-reporter-done ,prog)))))
126
127
128;;; Comment-or-uncomment-sexp
129;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html
130
131(defun +lisp-uncomment-sexp (&optional n)
132 "Uncomment N sexps around point."
133 (interactive "P")
134 (let* ((initial-point (point-marker))
135 (inhibit-field-text-motion t)
136 (p)
137 (end (save-excursion
138 (when (elt (syntax-ppss) 4)
139 (re-search-backward comment-start-skip
140 (line-beginning-position)
141 t))
142 (setq p (point-marker))
143 (comment-forward (point-max))
144 (point-marker)))
145 (beg (save-excursion
146 (forward-line 0)
147 (while (and (not (bobp))
148 (= end (save-excursion
149 (comment-forward (point-max))
150 (point))))
151 (forward-line -1))
152 (goto-char (line-end-position))
153 (re-search-backward comment-start-skip
154 (line-beginning-position)
155 t)
156 (ignore-errors
157 (while (looking-at-p comment-start-skip)
158 (forward-char -1)))
159 (point-marker))))
160 (unless (= beg end)
161 (uncomment-region beg end)
162 (goto-char p)
163 ;; Indentify the "top-level" sexp inside the comment.
164 (while (and (ignore-errors (backward-up-list) t)
165 (>= (point) beg))
166 (skip-chars-backward (rx (syntax expression-prefix)))
167 (setq p (point-marker)))
168 ;; Re-comment everything before it.
169 (ignore-errors
170 (comment-region beg p))
171 ;; And everything after it.
172 (goto-char p)
173 (forward-sexp (or n 1))
174 (skip-chars-forward "\r\n[:blank:]")
175 (if (< (point) end)
176 (ignore-errors
177 (comment-region (point) end))
178 ;; If this is a closing delimiter, pull it up.
179 (goto-char end)
180 (skip-chars-forward "\r\n[:blank:]")
181 (when (eq 5 (car (syntax-after (point))))
182 (delete-indentation))))
183 ;; Without a prefix, it's more useful to leave point where
184 ;; it was.
185 (unless n
186 (goto-char initial-point))))
187
188(defun +lisp-comment-sexp--raw ()
189 "Comment the sexp at point or ahead of point."
190 (pcase (or (bounds-of-thing-at-point 'sexp)
191 (save-excursion
192 (skip-chars-forward "\r\n[:blank:]")
193 (bounds-of-thing-at-point 'sexp)))
194 (`(,l . ,r)
195 (goto-char r)
196 (skip-chars-forward "\r\n[:blank:]")
197 (save-excursion
198 (comment-region l r))
199 (skip-chars-forward "\r\n[:blank:]"))))
200
201(defun +lisp-comment-or-uncomment-sexp (&optional n)
202 "Comment the sexp at point and move past it.
203If already inside (or before) a comment, uncomment instead.
204With a prefix argument N, (un)comment that many sexps."
205 (interactive "P")
206 (if (or (elt (syntax-ppss) 4)
207 (< (save-excursion
208 (skip-chars-forward "\r\n[:blank:]")
209 (point))
210 (save-excursion
211 (comment-forward 1)
212 (point))))
213 (+lisp-uncomment-sexp n)
214 (dotimes (_ (or n 1))
215 (+lisp-comment-sexp--raw))))
216
88(provide 'acdw) 217(provide 'acdw)
89;;; acdw.el ends here 218;;; acdw.el ends here