diff options
Diffstat (limited to 'modules')
45 files changed, 1680 insertions, 716 deletions
diff --git a/modules/ai-config.el b/modules/ai-config.el index 004750b6..3b89faca 100644 --- a/modules/ai-config.el +++ b/modules/ai-config.el @@ -415,5 +415,22 @@ Works for any buffer, whether it's visiting a file or not." "x" #'cj/gptel-clear-buffer) ;; clears the assistant buffer (keymap-set cj/custom-keymap "a" cj/ai-keymap) +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-; a" "AI assistant menu" + "C-; a B" "switch backend" + "C-; a M" "gptel menu" + "C-; a d" "delete conversation" + "C-; a ." "add buffer" + "C-; a f" "add file" + "C-; a l" "load conversation" + "C-; a m" "change model" + "C-; a p" "change prompt" + "C-; a &" "rewrite region" + "C-; a r" "clear context" + "C-; a s" "save conversation" + "C-; a t" "toggle window" + "C-; a x" "clear buffer")) + (provide 'ai-config) ;;; ai-config.el ends here. diff --git a/modules/ai-conversations.el b/modules/ai-conversations.el index 92549176..4f97d761 100644 --- a/modules/ai-conversations.el +++ b/modules/ai-conversations.el @@ -159,7 +159,6 @@ Expect FILENAME to match _YYYYMMDD-HHMMSS.gptel." (or (get-buffer buf-name) (user-error "Could not create or find *AI-Assistant* buffer")))) -;;;###autoload (defun cj/gptel-save-conversation () "Save the current AI-Assistant buffer to a .gptel file. @@ -188,7 +187,6 @@ Enable autosave for subsequent AI responses to the same file." (setq-local cj/gptel-autosave-enabled t)) (message "Conversation saved to: %s" filepath)))) -;;;###autoload (defun cj/gptel-delete-conversation () "Delete a saved GPTel conversation file (chronologically sorted candidates)." (interactive) @@ -218,7 +216,6 @@ Enable autosave for subsequent AI responses to the same file." (when (looking-at "^\n+") (delete-region (point) (match-end 0))))) -;;;###autoload (defun cj/gptel-load-conversation () "Load a saved GPTel conversation into the AI-Assistant buffer. diff --git a/modules/browser-config.el b/modules/browser-config.el index fddc02e6..52c3b8a6 100644 --- a/modules/browser-config.el +++ b/modules/browser-config.el @@ -80,19 +80,44 @@ Returns the browser plist if found, nil otherwise." cj/saved-browser-choice)) (error nil)))) -(defun cj/apply-browser-choice (browser-plist) - "Apply the browser settings from BROWSER-PLIST." - (when browser-plist +(defun cj/--do-apply-browser-choice (browser-plist) + "Apply the browser settings from BROWSER-PLIST. +Returns: \\='success if applied successfully, + \\='invalid-plist if browser-plist is nil or missing required keys." + (if (null browser-plist) + 'invalid-plist (let ((browse-fn (plist-get browser-plist :function)) (executable (plist-get browser-plist :executable)) (path (plist-get browser-plist :path)) (program-var (plist-get browser-plist :program-var))) - ;; Set the main browse-url function - (setq browse-url-browser-function browse-fn) - ;; Set the specific browser program variable if it exists - (when program-var - (set program-var (or path executable))) - (message "Default browser set to: %s" (plist-get browser-plist :name))))) + (if (null browse-fn) + 'invalid-plist + ;; Set the main browse-url function + (setq browse-url-browser-function browse-fn) + ;; Set the specific browser program variable if it exists + (when program-var + (set program-var (or path executable))) + 'success)))) + +(defun cj/apply-browser-choice (browser-plist) + "Apply the browser settings from BROWSER-PLIST." + (pcase (cj/--do-apply-browser-choice browser-plist) + ('success (message "Default browser set to: %s" (plist-get browser-plist :name))) + ('invalid-plist (message "Invalid browser configuration")))) + +(defun cj/--do-choose-browser (browser-plist) + "Save and apply BROWSER-PLIST as the default browser. +Returns: \\='success if browser was saved and applied, + \\='save-failed if save operation failed, + \\='invalid-plist if browser-plist is invalid." + (condition-case _err + (progn + (cj/save-browser-choice browser-plist) + (let ((result (cj/--do-apply-browser-choice browser-plist))) + (if (eq result 'success) + 'success + 'invalid-plist))) + (error 'save-failed))) (defun cj/choose-browser () "Interactively choose a browser from available options. @@ -107,21 +132,39 @@ Persists the choice for future sessions." (string= (plist-get b :name) choice)) browsers))) (when selected - (cj/save-browser-choice selected) - (cj/apply-browser-choice selected)))))) + (pcase (cj/--do-choose-browser selected) + ('success (message "Default browser set to: %s" (plist-get selected :name))) + ('save-failed (message "Failed to save browser choice")) + ('invalid-plist (message "Invalid browser configuration")))))))) ;; Initialize: Load saved choice or use first available browser -(defun cj/initialize-browser () - "Initialize browser configuration on startup." +(defun cj/--do-initialize-browser () + "Initialize browser configuration. +Returns: (cons \\='loaded browser-plist) if saved choice was loaded, + (cons \\='first-available browser-plist) if using first discovered browser, + (cons \\='no-browsers nil) if no browsers found." (let ((saved-choice (cj/load-browser-choice))) (if saved-choice - (cj/apply-browser-choice saved-choice) - ;; No saved choice - try to set first available browser silently + (cons 'loaded saved-choice) + ;; No saved choice - try to set first available browser (let ((browsers (cj/discover-browsers))) - (when browsers - (cj/apply-browser-choice (car browsers)) - (message "No browser configured. Using %s. Run M-x cj/choose-browser to change." - (plist-get (car browsers) :name))))))) + (if browsers + (cons 'first-available (car browsers)) + (cons 'no-browsers nil)))))) + +(defun cj/initialize-browser () + "Initialize browser configuration on startup." + (let ((result (cj/--do-initialize-browser))) + (pcase (car result) + ('loaded + (cj/--do-apply-browser-choice (cdr result))) + ('first-available + (let ((browser (cdr result))) + (cj/--do-apply-browser-choice browser) + (message "No browser configured. Using %s. Run M-x cj/choose-browser to change." + (plist-get browser :name)))) + ('no-browsers + (message "No supported browsers found"))))) ;; Run initialization (cj/initialize-browser) diff --git a/modules/config-utilities.el b/modules/config-utilities.el index ea92f19a..32018371 100644 --- a/modules/config-utilities.el +++ b/modules/config-utilities.el @@ -17,12 +17,27 @@ (keymap-global-set "C-c d" cj/debug-config-keymap) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-c d" "config debugging utils")) + (which-key-add-key-based-replacements + "C-c d" "config debugging utils" + "C-c d p" "profiler menu" + "C-c d p s" "start profiler" + "C-c d p h" "stop profiler" + "C-c d p r" "profiler report" + "C-c d t" "toggle debug-on-error" + "C-c d b" "benchmark method" + "C-c d c" "compilation menu" + "C-c d c h" "compile home" + "C-c d c d" "delete compiled" + "C-c d c ." "compile buffer" + "C-c d i" "info menu" + "C-c d i b" "info build" + "C-c d i p" "info packages" + "C-c d i f" "info features" + "C-c d r" "reload init" + "C-c d a" "reset auth cache")) ;;; --------------------------------- Profiling --------------------------------- -(with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-c d p" "profiler menu.")) (keymap-set cj/debug-config-keymap "p s" #'profiler-start) (keymap-set cj/debug-config-keymap "p h" #'profiler-stop) (keymap-set cj/debug-config-keymap "p r" #'profiler-report) @@ -92,8 +107,6 @@ Recompile natively when supported, otherwise fall back to byte compilation." (message "Cancelled recompilation of %s" user-emacs-directory)))) (keymap-set cj/debug-config-keymap "c h" 'cj/recompile-emacs-home) -(with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-c d c" "config compilation options.")) (defun cj/delete-emacs-home-compiled-files () "Delete all compiled files recursively in \='user-emacs-directory\='." @@ -214,8 +227,6 @@ Recompile natively when supported, otherwise fall back to byte compilation." (pop-to-buffer buf))) (keymap-set cj/debug-config-keymap "i b" 'cj/info-emacs-build) -(with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-c d i" "info on build/features/packages.")) (defvar cj--loaded-file-paths nil "All file paths that are loaded.") diff --git a/modules/custom-file-buffer.el b/modules/custom-buffer-file.el index e0224a32..9438e8ed 100644 --- a/modules/custom-file-buffer.el +++ b/modules/custom-buffer-file.el @@ -1,4 +1,4 @@ -;;; custom-file-buffer.el --- Custom Buffer and File Operations -*- coding: utf-8; lexical-binding: t; -*- +;;; custom-buffer-file.el --- Custom Buffer and File Operations -*- coding: utf-8; lexical-binding: t; -*- ;; ;;; Commentary: ;; This module provides custom buffer and file operations including PostScript @@ -240,8 +240,21 @@ Do not save the deleted text in the kill ring." (keymap-set cj/custom-keymap "b" cj/buffer-and-file-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; b" "buffer and file menu")) + (which-key-add-key-based-replacements + "C-; b" "buffer and file menu" + "C-; b m" "move file" + "C-; b r" "rename file" + "C-; b p" "print to PS" + "C-; b d" "delete file" + "C-; b c" "copy buffer" + "C-; b n" "copy buffer name" + "C-; b t" "clear to top" + "C-; b b" "clear to bottom" + "C-; b x" "erase buffer" + "C-; b s" "save as" + "C-; b l" "copy file link" + "C-; b P" "copy file path")) -(provide 'custom-file-buffer) -;;; custom-file-buffer.el ends here. +(provide 'custom-buffer-file) +;;; custom-buffer-file.el ends here. diff --git a/modules/custom-case.el b/modules/custom-case.el index 4fd9ac05..59250ddb 100644 --- a/modules/custom-case.el +++ b/modules/custom-case.el @@ -118,7 +118,11 @@ short prepositions, and all articles are considered minor words." (keymap-set cj/custom-keymap "c" cj/case-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; c" "case change menu")) + (which-key-add-key-based-replacements + "C-; c" "case change menu" + "C-; c t" "title case" + "C-; c u" "upcase" + "C-; c l" "downcase")) (provide 'custom-case) ;;; custom-case.el ends here. diff --git a/modules/custom-comments.el b/modules/custom-comments.el index b4e51b2c..0d83d31b 100644 --- a/modules/custom-comments.el +++ b/modules/custom-comments.el @@ -619,7 +619,18 @@ Leverages cj/comment-inline-border." (keymap-set cj/custom-keymap "C" cj/comment-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; C" "code comment menu")) + (which-key-add-key-based-replacements + "C-; C" "code comment menu" + "C-; C r" "reformat comment" + "C-; C d" "delete comments" + "C-; C c" "inline border" + "C-; C -" "hyphen divider" + "C-; C s" "simple divider" + "C-; C p" "padded divider" + "C-; C b" "box" + "C-; C h" "heavy box" + "C-; C u" "unicode box" + "C-; C n" "block banner")) (provide 'custom-comments) ;;; custom-comments.el ends here. diff --git a/modules/custom-datetime.el b/modules/custom-datetime.el index c195ebc2..5b06d81a 100644 --- a/modules/custom-datetime.el +++ b/modules/custom-datetime.el @@ -117,7 +117,14 @@ Use `readable-date-format' for formatting." (keymap-set cj/custom-keymap "d" cj/datetime-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; d" "date/time insertion menu")) + (which-key-add-key-based-replacements + "C-; d" "date/time insertion menu" + "C-; d r" "readable date-time" + "C-; d s" "sortable date-time" + "C-; d t" "sortable time" + "C-; d T" "readable time" + "C-; d d" "sortable date" + "C-; d D" "readable date")) (provide 'custom-datetime) ;;; custom-datetime.el ends here. diff --git a/modules/custom-line-paragraph.el b/modules/custom-line-paragraph.el index 7f0baef9..32f9aaa1 100644 --- a/modules/custom-line-paragraph.el +++ b/modules/custom-line-paragraph.el @@ -139,8 +139,15 @@ If the line is empty or contains only whitespace, abort with a message." (keymap-set cj/custom-keymap "l" cj/line-and-paragraph-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; l" "line and paragraph menu") - (which-key-add-key-based-replacements "C-; l c" "duplicate and comment")) + (which-key-add-key-based-replacements + "C-; l" "line and paragraph menu" + "C-; l j" "join lines" + "C-; l J" "join paragraph" + "C-; l d" "duplicate" + "C-; l c" "duplicate and comment" + "C-; l R" "remove duplicates" + "C-; l r" "remove matching" + "C-; l u" "underscore line")) (provide 'custom-line-paragraph) ;;; custom-line-paragraph.el ends here. diff --git a/modules/custom-misc.el b/modules/custom-misc.el index 0c6d7ac8..be1f26bb 100644 --- a/modules/custom-misc.el +++ b/modules/custom-misc.el @@ -46,19 +46,27 @@ If not on a delimiter, show a message. Respects the current syntax table." (message "Point is not on a delimiter."))))) +(defun cj/--format-region (start end) + "Internal implementation: Reformat text between START and END. +START and END define the region to operate on. +Replaces tabs with spaces, reindents, and deletes trailing whitespace." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (save-excursion + (save-restriction + (narrow-to-region start end) + (untabify (point-min) (point-max)) + (indent-region (point-min) (point-max)) + (delete-trailing-whitespace (point-min) (point-max))))) + (defun cj/format-region-or-buffer () "Reformat the region or the entire buffer. Replaces tabs with spaces, deletes trailing whitespace, and reindents." (interactive) (let ((start-pos (if (use-region-p) (region-beginning) (point-min))) - (end-pos (if (use-region-p) (region-end) (point-max)))) - (save-excursion - (save-restriction - (narrow-to-region start-pos end-pos) - (untabify (point-min) (point-max)) - (indent-region (point-min) (point-max)) - (delete-trailing-whitespace (point-min) (point-max)))) - (message "Formatted %s" (if (use-region-p) "region" "buffer")))) + (end-pos (if (use-region-p) (region-end) (point-max)))) + (cj/--format-region start-pos end-pos) + (message "Formatted %s" (if (use-region-p) "region" "buffer")))) (defun cj/switch-to-previous-buffer () "Switch to previously open buffer. @@ -66,6 +74,14 @@ Repeated invocations toggle between the two most recently open buffers." (interactive) (switch-to-buffer (other-buffer (current-buffer) 1))) +(defun cj/--count-words (start end) + "Internal implementation: Count words between START and END. +START and END define the region to count. +Returns the word count as an integer." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (count-words start end)) + (defun cj/count-words-buffer-or-region () "Count the number of words in the buffer or region. Display the result in the minibuffer." @@ -73,37 +89,49 @@ Display the result in the minibuffer." (let* ((use-region (use-region-p)) (begin (if use-region (region-beginning) (point-min))) (end (if use-region (region-end) (point-max))) - (area-type (if use-region "the region" "the buffer"))) - (message "There are %d words in %s." (count-words begin end) area-type))) + (area-type (if use-region "the region" "the buffer")) + (word-count (cj/--count-words begin end))) + (message "There are %d words in %s." word-count area-type))) +(defun cj/--replace-fraction-glyphs (start end to-glyphs) + "Internal implementation: Replace fraction glyphs or text between START and END. +START and END define the region to operate on. +TO-GLYPHS when non-nil converts text (1/4) to glyphs (¼), +otherwise converts glyphs to text." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (let ((replacements (if to-glyphs + '(("1/4" . "¼") + ("1/2" . "½") + ("3/4" . "¾") + ("1/3" . "⅓") + ("2/3" . "⅔")) + '(("¼" . "1/4") + ("½" . "1/2") + ("¾" . "3/4") + ("⅓" . "1/3") + ("⅔" . "2/3")))) + (count 0) + (end-marker (copy-marker end))) + (save-excursion + (dolist (r replacements) + (goto-char start) + (while (search-forward (car r) end-marker t) + (replace-match (cdr r)) + (setq count (1+ count))))) + count)) + (defun cj/replace-fraction-glyphs (start end) "Replace common fraction glyphs between START and END. Operate on the buffer or region designated by START and END. Replace the text representations with glyphs when called with a \\[universal-argument] prefix." (interactive (if (use-region-p) - (list (region-beginning) (region-end)) - (list (point-min) (point-max)))) - (let ((replacements (if current-prefix-arg - '(("1/4" . "¼") - ("1/2" . "½") - ("3/4" . "¾") - ("1/3" . "⅓") - ("2/3" . "⅔")) - '(("¼" . "1/4") - ("½" . "1/2") - ("¾" . "3/4") - ("⅓" . "1/3") - ("⅔" . "2/3")))) - (count 0)) - (save-excursion - (dolist (r replacements) - (goto-char start) - (while (search-forward (car r) end t) - (replace-match (cdr r)) - (setq count (1+ count))))) - (message "Replaced %d fraction%s" count (if (= count 1) "" "s")))) + (list (region-beginning) (region-end)) + (list (point-min) (point-max)))) + (let ((count (cj/--replace-fraction-glyphs start end current-prefix-arg))) + (message "Replaced %d fraction%s" count (if (= count 1) "" "s")))) (defun cj/align-regexp-with-spaces (orig-fun &rest args) "Call ORIG-FUN with ARGS while temporarily disabling tabs for alignment. @@ -124,5 +152,15 @@ to nil." (keymap-set cj/custom-keymap "SPC" #'cj/switch-to-previous-buffer) (keymap-set cj/custom-keymap "|" #'display-fill-column-indicator-mode) +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-; )" "jump to paren" + "C-; f" "format buffer" + "C-; W" "count words" + "C-; /" "fraction glyphs" + "C-; A" "align regexp" + "C-; SPC" "prev buffer" + "C-; |" "fill column")) + (provide 'custom-misc) ;;; custom-misc.el ends here diff --git a/modules/custom-ordering.el b/modules/custom-ordering.el index 5d308604..7d906e75 100644 --- a/modules/custom-ordering.el +++ b/modules/custom-ordering.el @@ -2,47 +2,197 @@ ;;; Commentary: -;; This module provides functions for converting text between different formats and sorting operations. -;; These utilities are useful for reformatting data structures and organizing text. - -;; Functions include: - -;; - converting lines to quoted comma-separated arrays (arrayify) -;; - converting arrays back to separate lines (unarrayify) -;; - alphabetically sorting words in a region -;; - splitting comma-separated text into individual lines - +;; Text transformation and sorting utilities for reformatting data structures. +;; +;; Array/list formatting: +;; - arrayify/listify - convert lines to comma-separated format (with/without quotes, brackets) +;; - unarrayify - convert arrays back to separate lines +;; +;; Line manipulation: +;; - toggle-quotes - swap double ↔ single quotes +;; - reverse-lines - reverse line order +;; - number-lines - add line numbers with custom format (supports zero-padding) +;; - alphabetize-region - sort words alphabetically +;; - comma-separated-text-to-lines - split CSV text into lines +;; +;; Convenience functions: listify, arrayify-json, arrayify-python ;; Bound to keymap prefix C-; o ;;; Code: +(require 'cl-lib) + ;; cj/custom-keymap defined in keybindings.el (eval-when-compile (defvar cj/custom-keymap)) (defvar cj/ordering-map) +(defun cj/--arrayify (start end quote &optional prefix suffix) + "Internal implementation: Convert lines to quoted, comma-separated format. +START and END define the region to operate on. +QUOTE specifies the quotation characters to surround each element. + Use \"\" for no quotes, \"\\\"\" for double quotes, \"'\" for single quotes. +PREFIX is an optional string to prepend to the result (e.g., \"[\" or \"(\"). +SUFFIX is an optional string to append to the result (e.g., \"]\" or \")\"). +Returns the transformed string without modifying the buffer." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (let ((result (mapconcat + (lambda (x) (format "%s%s%s" quote x quote)) + (split-string (buffer-substring start end)) ", "))) + (concat (or prefix "") result (or suffix "")))) + (defun cj/arrayify (start end quote) "Convert lines between START and END into quoted, comma-separated strings. START and END identify the active region. QUOTE specifies the quotation characters to surround each element." (interactive "r\nMQuotation character to use for array element: ") - (let ((insertion - (mapconcat - (lambda (x) (format "%s%s%s" quote x quote)) - (split-string (buffer-substring start end)) ", "))) + (let ((insertion (cj/--arrayify start end quote))) (delete-region start end) (insert insertion))) +(defun cj/listify (start end) + "Convert lines between START and END into an unquoted, comma-separated list. +START and END identify the active region. +Example: `apple banana cherry' becomes `apple, banana, cherry'." + (interactive "r") + (let ((insertion (cj/--arrayify start end ""))) + (delete-region start end) + (insert insertion))) + +(defun cj/arrayify-json (start end) + "Convert lines between START and END into a JSON-style array. +START and END identify the active region. +Example: `apple banana cherry' becomes `[\"apple\", \"banana\", \"cherry\"]'." + (interactive "r") + (let ((insertion (cj/--arrayify start end "\"" "[" "]"))) + (delete-region start end) + (insert insertion))) + +(defun cj/arrayify-python (start end) + "Convert lines between START and END into a Python-style list. +START and END identify the active region. +Example: `apple banana cherry' becomes `[\"apple\", \"banana\", \"cherry\"]'." + (interactive "r") + (let ((insertion (cj/--arrayify start end "\"" "[" "]"))) + (delete-region start end) + (insert insertion))) + +(defun cj/--unarrayify (start end) + "Internal implementation: Convert comma-separated array to lines. +START and END define the region to operate on. +Removes quotes (both single and double) and splits by ', '. +Returns the transformed string without modifying the buffer." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (mapconcat + (lambda (x) (replace-regexp-in-string "[\"']" "" x)) + (split-string (buffer-substring start end) ", ") "\n")) + (defun cj/unarrayify (start end) "Convert quoted comma-separated strings between START and END to separate lines. START and END identify the active region." (interactive "r") - (let ((insertion - (mapconcat - (lambda (x) (replace-regexp-in-string "[\"']" "" x)) - (split-string (buffer-substring start end) ", ") "\n"))) + (let ((insertion (cj/--unarrayify start end))) (delete-region start end) (insert insertion))) +(defun cj/--toggle-quotes (start end) + "Internal implementation: Toggle between double and single quotes. +START and END define the region to operate on. +Swaps all double quotes with single quotes and vice versa. +Returns the transformed string without modifying the buffer." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (let ((text (buffer-substring start end))) + (with-temp-buffer + (insert text) + (goto-char (point-min)) + ;; Use a placeholder to avoid double-swapping + (while (search-forward "\"" nil t) + (replace-match "\001" nil t)) + (goto-char (point-min)) + (while (search-forward "'" nil t) + (replace-match "\"" nil t)) + (goto-char (point-min)) + (while (search-forward "\001" nil t) + (replace-match "'" nil t)) + (buffer-string)))) + +(defun cj/toggle-quotes (start end) + "Toggle between double and single quotes in region between START and END. +START and END identify the active region." + (interactive "r") + (let ((insertion (cj/--toggle-quotes start end))) + (delete-region start end) + (insert insertion))) + +(defun cj/--reverse-lines (start end) + "Internal implementation: Reverse the order of lines in region. +START and END define the region to operate on. +Returns the transformed string without modifying the buffer." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (let ((lines (split-string (buffer-substring start end) "\n"))) + (mapconcat #'identity (nreverse lines) "\n"))) + +(defun cj/reverse-lines (start end) + "Reverse the order of lines in region between START and END. +START and END identify the active region." + (interactive "r") + (let ((insertion (cj/--reverse-lines start end))) + (delete-region start end) + (insert insertion))) + +(defun cj/--number-lines (start end format-string zero-pad) + "Internal implementation: Number lines in region with custom format. +START and END define the region to operate on. +FORMAT-STRING is the format for each line, with N as placeholder for number. + Example: \"N. \" produces \"1. \", \"2. \", etc. + Example: \"[N] \" produces \"[1] \", \"[2] \", etc. +ZERO-PAD when non-nil pads numbers with zeros for alignment. + Example with 100 lines: \"001\", \"002\", ..., \"100\". +Returns the transformed string without modifying the buffer." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (let* ((lines (split-string (buffer-substring start end) "\n")) + (line-count (length lines)) + (width (if zero-pad (length (number-to-string line-count)) 1)) + (format-spec (if zero-pad (format "%%0%dd" width) "%d"))) + (mapconcat + (lambda (pair) + (let* ((num (car pair)) + (line (cdr pair)) + (num-str (format format-spec num))) + (concat (replace-regexp-in-string "N" num-str format-string) line))) + (cl-loop for line in lines + for i from 1 + collect (cons i line)) + "\n"))) + +(defun cj/number-lines (start end format-string zero-pad) + "Number lines in region between START and END with custom format. +START and END identify the active region. +FORMAT-STRING is the format for each line, with N as placeholder for number. + Example: \"N. \" produces \"1. \", \"2. \", etc. +ZERO-PAD when non-nil (prefix argument) pads numbers with zeros." + (interactive "r\nMFormat string (use N for number): \nP") + (let ((insertion (cj/--number-lines start end format-string zero-pad))) + (delete-region start end) + (insert insertion))) + +(defun cj/--alphabetize-region (start end) + "Internal implementation: Alphabetize words in region. +START and END define the region to operate on. +Splits by whitespace and commas, sorts alphabetically, joins with ', '. +Returns the transformed string without modifying the buffer." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (let ((string (buffer-substring-no-properties start end))) + (mapconcat #'identity + (sort (split-string string "[[:space:],]+" t) + #'string-lessp) + ", "))) + (defun cj/alphabetize-region () "Alphabetize words in the active region and replace the original text. Produce a comma-separated list as the result." @@ -51,14 +201,26 @@ Produce a comma-separated list as the result." (user-error "No region selected")) (let ((start (region-beginning)) (end (region-end)) - (string (buffer-substring-no-properties (region-beginning) (region-end)))) + (insertion (cj/--alphabetize-region (region-beginning) (region-end)))) (delete-region start end) (goto-char start) - (insert - (mapconcat #'identity - (sort (split-string string "[[:space:],]+" t) - #'string-lessp) - ", ")))) + (insert insertion))) + +(defun cj/--comma-separated-text-to-lines (start end) + "Internal implementation: Convert comma-separated text to lines. +START and END define the region to operate on. +Replaces commas with newlines and removes trailing whitespace from each line. +Returns the transformed string without modifying the buffer." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (let ((text (buffer-substring-no-properties start end))) + (with-temp-buffer + (insert text) + (goto-char (point-min)) + (while (search-forward "," nil t) + (replace-match "\n" nil t)) + (delete-trailing-whitespace) + (buffer-string)))) (defun cj/comma-separated-text-to-lines () "Break up comma-separated text in active region so each item is on own line." @@ -68,15 +230,7 @@ Produce a comma-separated list as the result." (let ((beg (region-beginning)) (end (region-end)) - (text (buffer-substring-no-properties (region-beginning) (region-end)))) - (with-temp-buffer - (insert text) - (goto-char (point-min)) - (while (search-forward "," nil t) - (replace-match "\n" nil t)) - (delete-trailing-whitespace) - (setq text (buffer-string))) - + (text (cj/--comma-separated-text-to-lines (region-beginning) (region-end)))) (delete-region beg end) (goto-char beg) (insert text))) @@ -88,12 +242,27 @@ Produce a comma-separated list as the result." :doc "Keymap for text ordering and sorting operations" "a" #'cj/arrayify "u" #'cj/unarrayify + "l" #'cj/listify + "j" #'cj/arrayify-json + "p" #'cj/arrayify-python + "q" #'cj/toggle-quotes + "r" #'cj/reverse-lines + "n" #'cj/number-lines "A" #'cj/alphabetize-region - "l" #'cj/comma-separated-text-to-lines) + "L" #'cj/comma-separated-text-to-lines) (keymap-set cj/custom-keymap "o" cj/ordering-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; o" "ordering/sorting menu")) + (which-key-add-key-based-replacements + "C-; o" "ordering/sorting menu" + "C-; o l" "listify" + "C-; o j" "JSON array" + "C-; o p" "Python list" + "C-; o q" "toggle quotes" + "C-; o r" "reverse lines" + "C-; o n" "number lines" + "C-; o A" "alphabetize" + "C-; o L" "comma to lines")) (provide 'custom-ordering) ;;; custom-ordering.el ends here. diff --git a/modules/custom-text-enclose.el b/modules/custom-text-enclose.el index 514419cd..e93e6dea 100644 --- a/modules/custom-text-enclose.el +++ b/modules/custom-text-enclose.el @@ -2,82 +2,285 @@ ;;; Commentary: -;; This module provides functions to surround words or regions with custom strings, and to append or prepend text to lines. +;; Text enclosure utilities for wrapping and line manipulation. +;; +;; Wrapping functions: +;; - surround-word-or-region - wrap text with same delimiter on both sides +;; - wrap-word-or-region - wrap with different opening/closing delimiters +;; - unwrap-word-or-region - remove surrounding delimiters +;; +;; Line manipulation: +;; - append-to-lines - add suffix to each line +;; - prepend-to-lines - add prefix to each line +;; - indent-lines - add leading whitespace (spaces or tabs) +;; - dedent-lines - remove leading whitespace +;; +;; Most functions work on region or entire buffer when no region is active. +;; +;; Bound to keymap prefix C-; s -;; It includes three main functions: -;; - surround word or region with a user-specified string -;; - append text to the end of lines -;; - prepend text to the beginning of lines +;;; Code: -;; All functions work on both the active region and the entire buffer when no region is selected. +;; cj/custom-keymap defined in keybindings.el +(eval-when-compile (defvar cj/custom-keymap)) -;; Bound to keymap prefix C-; s +(defun cj/--surround (text surround-string) + "Internal implementation: Surround TEXT with SURROUND-STRING. +TEXT is the string to be surrounded. +SURROUND-STRING is prepended and appended to TEXT. +Returns the surrounded text without modifying the buffer." + (concat surround-string text surround-string)) -;;; Code: +(defun cj/--wrap (text opening closing) + "Internal implementation: Wrap TEXT with OPENING and CLOSING strings. +TEXT is the string to be wrapped. +OPENING is prepended to TEXT. +CLOSING is appended to TEXT. +Returns the wrapped text without modifying the buffer." + (concat opening text closing)) (defun cj/surround-word-or-region () - "Surround the word at point or active region with a string read from the minibuffer." + "Surround the word at point or active region with a string. +The surround string is read from the minibuffer." (interactive) (let ((str (read-string "Surround with: ")) (regionp (use-region-p))) - (save-excursion - (if regionp - (let ((beg (region-beginning)) - (end (region-end))) - (goto-char end) - (insert str) - (goto-char beg) - (insert str)) - (if (thing-at-point 'word) - (let ((bounds (bounds-of-thing-at-point 'word))) - (goto-char (cdr bounds)) - (insert str) - (goto-char (car bounds)) - (insert str)) - (message "Can't insert around. No word at point and no region selected.")))))) + (if regionp + (let ((beg (region-beginning)) + (end (region-end)) + (text (buffer-substring (region-beginning) (region-end)))) + (delete-region beg end) + (goto-char beg) + (insert (cj/--surround text str))) + (if (thing-at-point 'word) + (let* ((bounds (bounds-of-thing-at-point 'word)) + (text (buffer-substring (car bounds) (cdr bounds)))) + (delete-region (car bounds) (cdr bounds)) + (goto-char (car bounds)) + (insert (cj/--surround text str))) + (message "Can't insert around. No word at point and no region selected."))))) + +(defun cj/wrap-word-or-region () + "Wrap the word at point or active region with different opening/closing strings. +The opening and closing strings are read from the minibuffer." + (interactive) + (let ((opening (read-string "Opening: ")) + (closing (read-string "Closing: ")) + (regionp (use-region-p))) + (if regionp + (let ((beg (region-beginning)) + (end (region-end)) + (text (buffer-substring (region-beginning) (region-end)))) + (delete-region beg end) + (goto-char beg) + (insert (cj/--wrap text opening closing))) + (if (thing-at-point 'word) + (let* ((bounds (bounds-of-thing-at-point 'word)) + (text (buffer-substring (car bounds) (cdr bounds)))) + (delete-region (car bounds) (cdr bounds)) + (goto-char (car bounds)) + (insert (cj/--wrap text opening closing))) + (message "Can't wrap. No word at point and no region selected."))))) + +(defun cj/--unwrap (text opening closing) + "Internal implementation: Remove OPENING and CLOSING from TEXT if present. +TEXT is the string to unwrap. +OPENING is checked at the start of TEXT. +CLOSING is checked at the end of TEXT. +Returns the unwrapped text if both delimiters present, otherwise unchanged." + (if (and (string-prefix-p opening text) + (string-suffix-p closing text) + (>= (length text) (+ (length opening) (length closing)))) + (substring text (length opening) (- (length text) (length closing))) + text)) + +(defun cj/unwrap-word-or-region () + "Remove surrounding delimiters from word at point or active region. +The opening and closing strings are read from the minibuffer." + (interactive) + (let ((opening (read-string "Opening to remove: ")) + (closing (read-string "Closing to remove: ")) + (regionp (use-region-p))) + (if regionp + (let ((beg (region-beginning)) + (end (region-end)) + (text (buffer-substring (region-beginning) (region-end)))) + (delete-region beg end) + (goto-char beg) + (insert (cj/--unwrap text opening closing))) + (if (thing-at-point 'word) + (let* ((bounds (bounds-of-thing-at-point 'word)) + (text (buffer-substring (car bounds) (cdr bounds)))) + (delete-region (car bounds) (cdr bounds)) + (goto-char (car bounds)) + (insert (cj/--unwrap text opening closing))) + (message "Can't unwrap. No word at point and no region selected."))))) + +(defun cj/--append-to-lines (text suffix) + "Internal implementation: Append SUFFIX to each line in TEXT. +TEXT is the string containing one or more lines. +SUFFIX is appended to the end of each line. +Returns the transformed string without modifying the buffer." + (let* ((lines (split-string text "\n")) + (has-trailing-newline (string-suffix-p "\n" text)) + ;; If has trailing newline, last element will be empty string - exclude it + (lines-to-process (if (and has-trailing-newline + (not (null lines)) + (string-empty-p (car (last lines)))) + (butlast lines) + lines))) + (concat + (mapconcat (lambda (line) (concat line suffix)) lines-to-process "\n") + (if has-trailing-newline "\n" "")))) (defun cj/append-to-lines-in-region-or-buffer (str) "Append STR to the end of each line in the region or entire buffer." (interactive "sEnter string to append: ") - (let ((start-pos (if (use-region-p) - (region-beginning) - (point-min))) - (end-pos (if (use-region-p) - (region-end) - (point-max)))) - (save-excursion - (goto-char start-pos) - (while (< (point) end-pos) - (move-end-of-line 1) - (insert str) - (forward-line 1))))) + (let* ((start-pos (if (use-region-p) + (region-beginning) + (point-min))) + (end-pos (if (use-region-p) + (region-end) + (point-max))) + (text (buffer-substring start-pos end-pos)) + (insertion (cj/--append-to-lines text str))) + (delete-region start-pos end-pos) + (goto-char start-pos) + (insert insertion))) + +(defun cj/--prepend-to-lines (text prefix) + "Internal implementation: Prepend PREFIX to each line in TEXT. +TEXT is the string containing one or more lines. +PREFIX is prepended to the beginning of each line. +Returns the transformed string without modifying the buffer." + (let* ((lines (split-string text "\n")) + (has-trailing-newline (string-suffix-p "\n" text)) + ;; If has trailing newline, last element will be empty string - exclude it + (lines-to-process (if (and has-trailing-newline + (not (null lines)) + (string-empty-p (car (last lines)))) + (butlast lines) + lines))) + (concat + (mapconcat (lambda (line) (concat prefix line)) lines-to-process "\n") + (if has-trailing-newline "\n" "")))) (defun cj/prepend-to-lines-in-region-or-buffer (str) "Prepend STR to the beginning of each line in the region or entire buffer." (interactive "sEnter string to prepend: ") - (let ((start-pos (if (use-region-p) - (region-beginning) - (point-min))) - (end-pos (if (use-region-p) - (region-end) - (point-max)))) - (save-excursion - (goto-char start-pos) - (while (< (point) end-pos) - (beginning-of-line 1) - (insert str) - (forward-line 1))))) - -;; Surround, append, prepend prefix keymap + (let* ((start-pos (if (use-region-p) + (region-beginning) + (point-min))) + (end-pos (if (use-region-p) + (region-end) + (point-max))) + (text (buffer-substring start-pos end-pos)) + (insertion (cj/--prepend-to-lines text str))) + (delete-region start-pos end-pos) + (goto-char start-pos) + (insert insertion))) + +(defun cj/--indent-lines (text count use-tabs) + "Internal implementation: Indent each line in TEXT by COUNT characters. +TEXT is the string containing one or more lines. +COUNT is the number of indentation characters to add. +USE-TABS when non-nil uses tabs instead of spaces for indentation. +Returns the indented text without modifying the buffer." + (let ((indent-string (if use-tabs + (make-string count ?\t) + (make-string count ?\s)))) + (cj/--prepend-to-lines text indent-string))) + +(defun cj/indent-lines-in-region-or-buffer (count use-tabs) + "Indent each line in region or buffer by COUNT characters. +COUNT is the number of characters to indent (default 4). +USE-TABS when non-nil (prefix argument) uses tabs instead of spaces." + (interactive "p\nP") + (let* ((start-pos (if (use-region-p) + (region-beginning) + (point-min))) + (end-pos (if (use-region-p) + (region-end) + (point-max))) + (text (buffer-substring start-pos end-pos)) + (insertion (cj/--indent-lines text count use-tabs))) + (delete-region start-pos end-pos) + (goto-char start-pos) + (insert insertion))) + +(defun cj/--dedent-lines (text count) + "Internal implementation: Remove up to COUNT leading characters from each line. +TEXT is the string containing one or more lines. +COUNT is the maximum number of leading whitespace characters to remove. +Removes spaces and tabs, but only up to COUNT characters per line. +Returns the dedented text without modifying the buffer." + (let* ((lines (split-string text "\n")) + (has-trailing-newline (string-suffix-p "\n" text)) + (lines-to-process (if (and has-trailing-newline + (not (null lines)) + (string-empty-p (car (last lines)))) + (butlast lines) + lines)) + (dedented-lines + (mapcar + (lambda (line) + (let ((removed 0) + (pos 0) + (len (length line))) + (while (and (< removed count) + (< pos len) + (memq (aref line pos) '(?\s ?\t))) + (setq removed (1+ removed)) + (setq pos (1+ pos))) + (substring line pos))) + lines-to-process))) + (concat + (mapconcat #'identity dedented-lines "\n") + (if has-trailing-newline "\n" "")))) + +(defun cj/dedent-lines-in-region-or-buffer (count) + "Remove up to COUNT leading whitespace characters from each line. +COUNT is the number of characters to remove (default 4). +Works on region if active, otherwise entire buffer." + (interactive "p") + (let* ((start-pos (if (use-region-p) + (region-beginning) + (point-min))) + (end-pos (if (use-region-p) + (region-end) + (point-max))) + (text (buffer-substring start-pos end-pos)) + (insertion (cj/--dedent-lines text count))) + (delete-region start-pos end-pos) + (goto-char start-pos) + (insert insertion))) + +;; Text enclosure keymap (defvar-keymap cj/enclose-map - :doc "Keymap for enclosing text: surrounding, appending, and prepending" + :doc "Keymap for text enclosure: wrapping, line manipulation, and indentation" "s" #'cj/surround-word-or-region + "w" #'cj/wrap-word-or-region + "u" #'cj/unwrap-word-or-region "a" #'cj/append-to-lines-in-region-or-buffer - "p" #'cj/prepend-to-lines-in-region-or-buffer) + "p" #'cj/prepend-to-lines-in-region-or-buffer + "i" #'cj/indent-lines-in-region-or-buffer + "d" #'cj/dedent-lines-in-region-or-buffer + "I" #'change-inner + "O" #'change-outer) (keymap-set cj/custom-keymap "s" cj/enclose-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; s" "text enclose menu")) + (which-key-add-key-based-replacements + "C-; s" "text enclose menu" + "C-; s s" "surround text" + "C-; s w" "wrap text" + "C-; s u" "unwrap text" + "C-; s a" "append to lines" + "C-; s p" "prepend to lines" + "C-; s i" "indent lines" + "C-; s d" "dedent lines" + "C-; s I" "change inner" + "C-; s O" "change outer")) (provide 'custom-text-enclose) ;;; custom-text-enclose.el ends here. diff --git a/modules/custom-whitespace.el b/modules/custom-whitespace.el index df93459a..d5f8d80c 100644 --- a/modules/custom-whitespace.el +++ b/modules/custom-whitespace.el @@ -217,7 +217,15 @@ Operate on the active region designated by START and END." (keymap-set cj/custom-keymap "w" cj/whitespace-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; w" "whitespace menu")) + (which-key-add-key-based-replacements + "C-; w" "whitespace menu" + "C-; w c" "collapse whitespace" + "C-; w l" "delete blank lines" + "C-; w 1" "single blank line" + "C-; w d" "delete all whitespace" + "C-; w -" "hyphenate whitespace" + "C-; w t" "untabify" + "C-; w T" "tabify")) (provide 'custom-whitespace) ;;; custom-whitespace.el ends here. diff --git a/modules/diff-config.el b/modules/diff-config.el index 382b2250..45c2a778 100644 --- a/modules/diff-config.el +++ b/modules/diff-config.el @@ -48,6 +48,14 @@ (add-hook 'ediff-mode-hook #'cj/ediff-hook) (add-hook 'ediff-after-quit-hook-internal #'winner-undo)) +;; which-key labels +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-c D" "ediff menu" + "C-c D f" "ediff files" + "C-c D b" "ediff buffers" + "C-c D r" "ediff revision" + "C-c D D" "ediff directories")) (provide 'diff-config) ;;; diff-config.el ends here diff --git a/modules/erc-config.el b/modules/erc-config.el index 1c189fa3..e7efb33f 100644 --- a/modules/erc-config.el +++ b/modules/erc-config.el @@ -183,7 +183,14 @@ Auto-adds # prefix if missing. Offers completion from configured channels." (keymap-set cj/custom-keymap "E" cj/erc-keymap) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; E" "ERC chat menu")) + (which-key-add-key-based-replacements + "C-; E" "ERC chat menu" + "C-; E C" "connect server" + "C-; E c" "join channel" + "C-; E b" "switch buffer" + "C-; E l" "list servers" + "C-; E q" "quit channel" + "C-; E Q" "quit server")) ;; Main ERC configuration (use-package erc diff --git a/modules/external-open.el b/modules/external-open.el index 41d842fb..8c4db810 100644 --- a/modules/external-open.el +++ b/modules/external-open.el @@ -111,6 +111,11 @@ (keymap-global-set "C-c x o" #'cj/open-this-file-with) +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-c x" "external open menu" + "C-c x o" "open file with")) + ;; -------------------- Open Files With Default File Handler ------------------- (defun cj/find-file-auto (orig-fun &rest args) diff --git a/modules/flycheck-config.el b/modules/flycheck-config.el index d7f1ad39..ea19f08f 100644 --- a/modules/flycheck-config.el +++ b/modules/flycheck-config.el @@ -94,5 +94,8 @@ Runs flycheck-prose-on-demand if in an org-buffer." ;; trigger immediate check (flycheck-buffer))) +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements "C-; ?" "list errors")) + (provide 'flycheck-config) ;;; flycheck-config.el ends here diff --git a/modules/flyspell-and-abbrev.el b/modules/flyspell-and-abbrev.el index 12e0d348..d12a1794 100644 --- a/modules/flyspell-and-abbrev.el +++ b/modules/flyspell-and-abbrev.el @@ -111,7 +111,6 @@ ;; ------------------------------ Flyspell Toggle ------------------------------ ;; easy toggling flyspell and also leverage the 'for-buffer-type' functionality. -;;;###autoload (defun cj/flyspell-toggle () "Turn Flyspell on if it is off, or off if it is on. @@ -198,7 +197,6 @@ buffer." (downcase misspelled-word) nil))) -;;;###autoload (defun cj/flyspell-then-abbrev (p) "Find and correct the previous misspelled word, creating an abbrev. @@ -241,5 +239,11 @@ Press C-' repeatedly to step through misspellings one at a time." ;;;###autoload (keymap-set global-map "C-c f" #'cj/flyspell-toggle) ;;;###autoload (keymap-set global-map "C-'" #'cj/flyspell-then-abbrev) +;; which-key labels +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-c f" "flyspell toggle" + "C-'" "flyspell then abbrev")) + (provide 'flyspell-and-abbrev) ;;; flyspell-and-abbrev.el ends here. diff --git a/modules/font-config.el b/modules/font-config.el index 1541f55f..ddd4497f 100644 --- a/modules/font-config.el +++ b/modules/font-config.el @@ -142,7 +142,6 @@ If FRAME is nil, uses the selected frame." ;; ----------------------------- Font Install Check ---------------------------- ;; convenience function to indicate whether a font is available by name. -;;;###autoload (defun cj/font-installed-p (font-name) "Check if font with FONT-NAME is available." (if (find-font (font-spec :name font-name)) @@ -224,7 +223,6 @@ If FRAME is nil, uses the selected frame." ;; -------------------------- Display Available Fonts -------------------------- ;; display all available fonts on the system in a side panel -;;;###autoload (defun cj/display-available-fonts () "Display a list of all font faces with sample text in another read-only buffer." (interactive) @@ -286,5 +284,12 @@ If FRAME is nil, uses the selected frame." "<~" "<~~" "</" "</>" "~@" "~-" "~>" "~~" "~~>" "%%")) (global-ligature-mode t)) +;; which-key labels +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-c E" "emojify menu" + "C-c E i" "insert emoji" + "C-c E l" "list emojis")) + (provide 'font-config) ;;; font-config.el ends here diff --git a/modules/jumper.el b/modules/jumper.el index e1025472..67d930aa 100644 --- a/modules/jumper.el +++ b/modules/jumper.el @@ -10,24 +10,76 @@ ;; Jumper provides a simple way to store and jump between locations ;; in your codebase without needing to remember register assignments. +;; +;; PURPOSE: +;; +;; When working on large codebases, you often need to jump between +;; multiple related locations: a function definition, its tests, its +;; callers, configuration files, etc. Emacs registers are perfect for +;; this, but require you to remember which register you assigned to +;; which location. Jumper automates register management, letting you +;; focus on your work instead of bookkeeping. +;; +;; WORKFLOW: +;; +;; 1. Navigate to an important location in your code +;; 2. Press M-SPC SPC to store it (automatically assigned to register 0) +;; 3. Continue working, storing more locations as needed (registers 1-9) +;; 4. Press M-SPC j to jump back to any stored location +;; 5. Select from the list using completion (shows file, line, context) +;; 6. Press M-SPC d to remove locations you no longer need +;; +;; RECOMMENDED USAGE: +;; +;; Store locations temporarily while working on a feature: +;; - Store the main function you're implementing +;; - Store the test file where you're writing tests +;; - Store the caller that needs updating +;; - Store the documentation that needs changes +;; - Jump between them freely as you work +;; - Clear them when done with the feature +;; +;; SPECIAL BEHAVIORS: +;; +;; - Duplicate prevention: Storing the same location twice shows a message +;; instead of wasting a register slot. +;; +;; - Single location toggle: When only one location is stored, M-SPC j +;; toggles between that location and your current position. Perfect for +;; rapid back-and-forth between two related files. +;; +;; - Last location tracking: The last position before each jump is saved +;; in register 'z', allowing quick "undo" of navigation. +;; +;; - Smart selection: With multiple locations, completing-read shows +;; helpful context: "[0] filename.el:42 - function definition..." +;; +;; KEYBINDINGS: +;; +;; M-SPC SPC Store current location in next available register +;; M-SPC j Jump to a stored location (with completion) +;; M-SPC d Delete a stored location from the list +;; +;; CONFIGURATION: +;; +;; You can customize the prefix key and maximum locations: +;; +;; (setq jumper-prefix-key "C-c j") ; Change prefix key +;; (setq jumper-max-locations 20) ; Store up to 20 locations +;; +;; Note: Changing jumper-max-locations requires restarting Emacs or +;; manually reinitializing jumper--registers. ;;; Code: -(defgroup jumper nil - "Quick navigation between stored locations." - :group 'convenience) +(require 'cl-lib) -(defcustom jumper-prefix-key "M-SPC" +(defvar jumper-prefix-key "M-SPC" "Prefix key for jumper commands. +Note that using M-SPC will override the default binding to just-one-space.") -Note that using M-SPC will override the default binding to just-one-space." - :type 'string - :group 'jumper) - -(defcustom jumper-max-locations 10 - "Maximum number of locations to store." - :type 'integer - :group 'jumper) +(defvar jumper-max-locations 10 + "Maximum number of locations to store.") ;; Internal variables (defvar jumper--registers (make-vector jumper-max-locations nil) @@ -50,12 +102,10 @@ Note that using M-SPC will override the default binding to just-one-space." "Check if current location is already stored." (let ((key (jumper--location-key)) (found nil)) - (dotimes (i - jumper--next-index found) + (dotimes (i jumper--next-index found) (let* ((reg (aref jumper--registers i)) - (pos (get-register reg)) - (marker (and pos (registerv-data pos)))) - (when marker + (marker (get-register reg))) + (when (and marker (markerp marker)) (save-current-buffer (set-buffer (marker-buffer marker)) (save-excursion @@ -70,9 +120,8 @@ Note that using M-SPC will override the default binding to just-one-space." (defun jumper--format-location (index) "Format location at INDEX for display." (let* ((reg (aref jumper--registers index)) - (pos (get-register reg)) - (marker (and pos (registerv-data pos)))) - (when marker + (marker (get-register reg))) + (when (and marker (markerp marker)) (save-current-buffer (set-buffer (marker-buffer marker)) (save-excursion @@ -86,49 +135,83 @@ Note that using M-SPC will override the default binding to just-one-space." (min (+ (line-beginning-position) 40) (line-end-position))))))))) +(defun jumper--do-store-location () + "Store current location in the next free register. +Returns: \\='already-exists if location is already stored, + \\='no-space if all registers are full, + register character if successfully stored." + (cond + ((jumper--location-exists-p) 'already-exists) + ((not (jumper--register-available-p)) 'no-space) + (t + (let ((reg (+ ?0 jumper--next-index))) + (point-to-register reg) + (aset jumper--registers jumper--next-index reg) + (setq jumper--next-index (1+ jumper--next-index)) + reg)))) + (defun jumper-store-location () "Store current location in the next free register." (interactive) - (if (jumper--location-exists-p) - (message "Location already stored") - (if (jumper--register-available-p) - (let ((reg (+ ?0 jumper--next-index))) - (point-to-register reg) - (aset jumper--registers jumper--next-index reg) - (setq jumper--next-index (1+ jumper--next-index)) - (message "Location stored in register %c" reg)) - (message "Sorry - all jump locations are filled!")))) + (pcase (jumper--do-store-location) + ('already-exists (message "Location already stored")) + ('no-space (message "Sorry - all jump locations are filled!")) + (reg (message "Location stored in register %c" reg)))) + +(defun jumper--do-jump-to-location (target-idx) + "Jump to location at TARGET-IDX. +TARGET-IDX: -1 for last location, 0-9 for stored locations, nil for toggle. +Returns: \\='no-locations if no locations stored, + \\='already-there if at the only location (toggle case), + \\='jumped if successfully jumped." + (cond + ((= jumper--next-index 0) 'no-locations) + ;; Toggle behavior when target-idx is nil and only 1 location + ((and (null target-idx) (= jumper--next-index 1)) + (if (jumper--location-exists-p) + 'already-there + (let ((reg (aref jumper--registers 0))) + (point-to-register jumper--last-location-register) + (jump-to-register reg) + 'jumped))) + ;; Jump to specific target + (t + (if (= target-idx -1) + ;; Jumping to last location - don't overwrite it + (jump-to-register jumper--last-location-register) + ;; Jumping to stored location - save current for "last" + (progn + (point-to-register jumper--last-location-register) + (jump-to-register (aref jumper--registers target-idx)))) + 'jumped))) (defun jumper-jump-to-location () "Jump to a stored location." (interactive) - (if (= jumper--next-index 0) - (message "No locations stored") - (if (= jumper--next-index 1) - ;; Special case for one location - toggle behavior - (let ((reg (aref jumper--registers 0))) - (if (jumper--location-exists-p) - (message "You're already at the stored location") - (point-to-register jumper--last-location-register) - (jump-to-register reg) - (message "Jumped to location"))) - ;; Multiple locations - use completing-read - (let* ((locations - (cl-loop for i from 0 below jumper--next-index - for fmt = (jumper--format-location i) - when fmt collect (cons fmt i))) - ;; Add last location if available - (last-pos (get-register jumper--last-location-register)) - (locations (if last-pos - (cons (cons "[z] Last location" -1) locations) - locations)) - (choice (completing-read "Jump to: " locations nil t)) - (idx (cdr (assoc choice locations)))) - (point-to-register jumper--last-location-register) - (if (= idx -1) - (jump-to-register jumper--last-location-register) - (jump-to-register (aref jumper--registers idx))) - (message "Jumped to location"))))) + (cond + ;; No locations + ((= jumper--next-index 0) + (message "No locations stored")) + ;; Single location - toggle + ((= jumper--next-index 1) + (pcase (jumper--do-jump-to-location nil) + ('already-there (message "You're already at the stored location")) + ('jumped (message "Jumped to location")))) + ;; Multiple locations - prompt user + (t + (let* ((locations + (cl-loop for i from 0 below jumper--next-index + for fmt = (jumper--format-location i) + when fmt collect (cons fmt i))) + ;; Add last location if available + (last-pos (get-register jumper--last-location-register)) + (locations (if last-pos + (cons (cons "[z] Last location" -1) locations) + locations)) + (choice (completing-read "Jump to: " locations nil t)) + (idx (cdr (assoc choice locations)))) + (jumper--do-jump-to-location idx) + (message "Jumped to location"))))) (defun jumper--reorder-registers (removed-idx) "Reorder registers after removing the one at REMOVED-IDX." @@ -139,32 +222,40 @@ Note that using M-SPC will override the default binding to just-one-space." (aset jumper--registers i next-reg)))) (setq jumper--next-index (1- jumper--next-index))) +(defun jumper--do-remove-location (index) + "Remove location at INDEX. +Returns: \\='no-locations if no locations stored, + \\='cancelled if index is -1, + t if successfully removed." + (cond + ((= jumper--next-index 0) 'no-locations) + ((= index -1) 'cancelled) + (t + (jumper--reorder-registers index) + t))) + (defun jumper-remove-location () "Remove a stored location." (interactive) (if (= jumper--next-index 0) - (message "No locations stored") - (let* ((locations - (cl-loop for i from 0 below jumper--next-index - for fmt = (jumper--format-location i) - when fmt collect (cons fmt i))) - (locations (cons (cons "Cancel" -1) locations)) - (choice (completing-read "Remove location: " locations nil t)) - (idx (cdr (assoc choice locations)))) - (if (= idx -1) - (message "Operation cancelled") - (jumper--reorder-registers idx) - (message "Location removed"))))) - -(defvar jumper-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "SPC") #'jumper-store-location) - (define-key map (kbd "j") #'jumper-jump-to-location) - (define-key map (kbd "d") #'jumper-remove-location) - map) - "Keymap for jumper commands.") - -;;;###autoload + (message "No locations stored") + (let* ((locations + (cl-loop for i from 0 below jumper--next-index + for fmt = (jumper--format-location i) + when fmt collect (cons fmt i))) + (locations (cons (cons "Cancel" -1) locations)) + (choice (completing-read "Remove location: " locations nil t)) + (idx (cdr (assoc choice locations)))) + (pcase (jumper--do-remove-location idx) + ('cancelled (message "Operation cancelled")) + ('t (message "Location removed")))))) + +(defvar-keymap jumper-map + :doc "Keymap for jumper commands" + "SPC" #'jumper-store-location + "j" #'jumper-jump-to-location + "d" #'jumper-remove-location) + (defun jumper-setup-keys () "Setup default keybindings for jumper." (interactive) @@ -173,5 +264,13 @@ Note that using M-SPC will override the default binding to just-one-space." ;; Call jumper-setup-keys when the package is loaded (jumper-setup-keys) +;; which-key integration +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "M-SPC" "jumper menu" + "M-SPC SPC" "store location" + "M-SPC j" "jump to location" + "M-SPC d" "remove location")) + (provide 'jumper) ;;; jumper.el ends here. diff --git a/modules/keybindings.el b/modules/keybindings.el index 1f8867ef..1eff621c 100644 --- a/modules/keybindings.el +++ b/modules/keybindings.el @@ -68,12 +68,22 @@ Errors if VAR is unbound, not a non-empty string, or the file does not exist." ;; Bind it under the prefix map. (keymap-set cj/jump-map key fn)))) -;; Bind the prefix globally (user-reserved prefix). -(keymap-global-set "C-c j" cj/jump-map) +;; Bind the prefix to custom keymap +(keymap-set cj/custom-keymap "j" cj/jump-map) -;; nicer prefix label in which-key +;; which-key labels (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-c j" "Jump to common files.")) + (which-key-add-key-based-replacements + "C-; j" "jump to files menu" + "C-; j r" "jump to reference" + "C-; j s" "jump to schedule" + "C-; j i" "jump to inbox" + "C-; j c" "jump to contacts" + "C-; j m" "jump to macros" + "C-; j n" "jump to reading notes" + "C-; j w" "jump to webclipped" + "C-; j g" "jump to gcal" + "C-; j I" "jump to emacs init")) ;; ---------------------------- Keybinding Discovery --------------------------- diff --git a/modules/lipsum-generator.el b/modules/lipsum-generator.el index b328b989..11ed8caa 100644 --- a/modules/lipsum-generator.el +++ b/modules/lipsum-generator.el @@ -129,25 +129,21 @@ Defaults to 'liber-primus.txt' in the modules directory." (when candidates (nth (random (length candidates)) candidates)))) -;;;###autoload (defvar cj/lipsum-chain (cj/markov-chain-create) "Global Markov chain for lipsum generation.") -;;;###autoload (defun cj/lipsum-reset () "Reset the global lipsum Markov chain." (interactive) (setq cj/lipsum-chain (cj/markov-chain-create)) (message "cj/lipsum-chain reset.")) -;;;###autoload (defun cj/lipsum-learn-region (beg end) "Learn text from region." (interactive "r") (cj/markov-learn cj/lipsum-chain (buffer-substring-no-properties beg end)) (message "Learned from region.")) -;;;###autoload (defun cj/lipsum-learn-buffer () "Learn from entire buffer." (interactive) @@ -155,7 +151,6 @@ Defaults to 'liber-primus.txt' in the modules directory." (buffer-substring-no-properties (point-min) (point-max))) (message "Learned from buffer.")) -;;;###autoload (defun cj/lipsum-learn-file (file) "Learn from FILE containing plain text." (interactive "fTrain from file: ") @@ -164,12 +159,10 @@ Defaults to 'liber-primus.txt' in the modules directory." (cj/markov-learn cj/lipsum-chain (buffer-string))) (message "Learned from file: %s" file)) -;;;###autoload (defun cj/lipsum (n) "Return N words of lorem ipsum." (cj/markov-generate cj/lipsum-chain n '("Lorem" "ipsum"))) -;;;###autoload (defun cj/lipsum-insert (n) "Insert N words of lorem ipsum at point." (interactive "nNumber of words: ") @@ -181,7 +174,6 @@ Defaults to 'liber-primus.txt' in the modules directory." (defconst cj/lipsum-title-max 8) (defconst cj/lipsum-title-small 3) -;;;###autoload (defun cj/lipsum-title () "Generate a pseudo-Latin title." (interactive) @@ -205,7 +197,6 @@ Defaults to 'liber-primus.txt' in the modules directory." ;;; Paragraphs -;;;###autoload (defun cj/lipsum-paragraphs (count &optional min max) "Insert COUNT paragraphs of lipsum. Each paragraph has a random length between MIN and MAX words. diff --git a/modules/lorem-generator.el b/modules/lorem-optimum.el index 6148dfdc..6ccca55f 100644 --- a/modules/lorem-generator.el +++ b/modules/lorem-optimum.el @@ -1,4 +1,4 @@ -;;; lorem-generator.el --- Fake Latin Text Generator -*- coding: utf-8; lexical-binding: t; -*- +;;; lorem-optimum.el --- Fake Latin Text Generator -*- coding: utf-8; lexical-binding: t; -*- ;; ;; Author: Craig Jennings ;; Version: 0.5 @@ -24,6 +24,19 @@ (require 'cl-lib) +;;; Configuration + +(defvar cj/lipsum-training-file "assets/liber-primus.txt" + "Default training file name (relative to `user-emacs-directory`).") + +(defvar cj/lipsum-default-file + (expand-file-name cj/lipsum-training-file user-emacs-directory) + "Default training file for cj-lipsum. + +This should be a plain UTF-8 text file with hundreds of Latin words +or sentences. By default it points to the file specified in +`cj/lipsum-training-file` relative to `user-emacs-directory`.") + (cl-defstruct (cj/markov-chain (:constructor cj/markov-chain-create)) "An order-two Markov chain." @@ -31,25 +44,45 @@ (keys nil)) (defun cj/markov-tokenize (text) - "Split TEXT into tokens: words and punctuation separately." - (let ((case-fold-search nil)) - (split-string text "\\b" t "[[:space:]\n]+"))) - + "Split TEXT into tokens: words and punctuation separately. +Returns a list of words and punctuation marks as separate tokens." + (let ((tokens '()) + (pos 0) + (len (length text))) + (while (< pos len) + (cond + ;; Skip whitespace + ((string-match-p "[[:space:]]" (substring text pos (1+ pos))) + (setq pos (1+ pos))) + ;; Match word (sequence of alphanumeric characters) + ((string-match "\\`\\([[:alnum:]]+\\)" (substring text pos)) + (let ((word (match-string 1 (substring text pos)))) + (push word tokens) + (setq pos (+ pos (length word))))) + ;; Match punctuation (single character) + ((string-match "\\`\\([[:punct:]]\\)" (substring text pos)) + (let ((punct (match-string 1 (substring text pos)))) + (push punct tokens) + (setq pos (+ pos (length punct))))) + ;; Skip any other character + (t (setq pos (1+ pos))))) + (nreverse tokens))) (defun cj/markov-learn (chain text) "Add TEXT into the Markov CHAIN with tokenized input." - (let* ((words (cj/markov-tokenize text)) + (let* ((word-list (cj/markov-tokenize text)) + ;; Convert to vector for O(1) access instead of O(n) with nth + (words (vconcat word-list)) (len (length words))) (cl-loop for i from 0 to (- len 3) - for a = (nth i words) - for b = (nth (1+ i) words) - for c = (nth (+ i 2) words) + for a = (aref words i) + for b = (aref words (1+ i)) + for c = (aref words (+ i 2)) do (let* ((bigram (list a b)) (nexts (gethash bigram (cj/markov-chain-map chain)))) (puthash bigram (cons c nexts) (cj/markov-chain-map chain))))) - (setf (cj/markov-chain-keys chain) - (cl-loop for k being the hash-keys of (cj/markov-chain-map chain) - collect k))) + ;; Invalidate cached keys after learning new data + (setf (cj/markov-chain-keys chain) nil)) (defun cj/markov-fix-capitalization (sentence) "Capitalize the first word and the first word after .!? in SENTENCE." @@ -94,7 +127,7 @@ (defun cj/markov-generate (chain n &optional start) "Generate a sentence of N tokens from CHAIN." - (when (cj/markov-chain-keys chain) + (when (> (hash-table-count (cj/markov-chain-map chain)) 0) (let* ((state (or (and start (gethash start (cj/markov-chain-map chain)) start) @@ -116,33 +149,37 @@ (cj/markov-join-tokens tokens)))) (defun cj/markov-random-key (chain) - (nth (random (length (cj/markov-chain-keys chain))) - (cj/markov-chain-keys chain))) + "Return a random bigram key from CHAIN. +Builds and caches the keys list lazily if not already cached." + (unless (cj/markov-chain-keys chain) + ;; Lazily build keys list only when needed + (setf (cj/markov-chain-keys chain) + (cl-loop for k being the hash-keys of (cj/markov-chain-map chain) + collect k))) + (let ((keys (cj/markov-chain-keys chain))) + (when keys + (nth (random (length keys)) keys)))) (defun cj/markov-next-word (chain bigram) (let ((candidates (gethash bigram (cj/markov-chain-map chain)))) (when candidates (nth (random (length candidates)) candidates)))) -;;;###autoload (defvar cj/lipsum-chain (cj/markov-chain-create) "Global Markov chain for lipsum generation.") -;;;###autoload (defun cj/lipsum-reset () "Reset the global lipsum Markov chain." (interactive) (setq cj/lipsum-chain (cj/markov-chain-create)) (message "cj/lipsum-chain reset.")) -;;;###autoload (defun cj/lipsum-learn-region (beg end) "Learn text from region." (interactive "r") (cj/markov-learn cj/lipsum-chain (buffer-substring-no-properties beg end)) (message "Learned from region.")) -;;;###autoload (defun cj/lipsum-learn-buffer () "Learn from entire buffer." (interactive) @@ -150,7 +187,6 @@ (buffer-substring-no-properties (point-min) (point-max))) (message "Learned from buffer.")) -;;;###autoload (defun cj/lipsum-learn-file (file) "Learn from FILE containing plain text." (interactive "fTrain from file: ") @@ -159,12 +195,10 @@ (cj/markov-learn cj/lipsum-chain (buffer-string))) (message "Learned from file: %s" file)) -;;;###autoload (defun cj/lipsum (n) "Return N words of lorem ipsum." (cj/markov-generate cj/lipsum-chain n '("Lorem" "ipsum"))) -;;;###autoload (defun cj/lipsum-insert (n) "Insert N words of lorem ipsum at point." (interactive "nNumber of words: ") @@ -176,7 +210,6 @@ (defconst cj/lipsum-title-max 8) (defconst cj/lipsum-title-small 3) -;;;###autoload (defun cj/lipsum-title () "Generate a pseudo-Latin title." (interactive) @@ -190,6 +223,7 @@ (or (cj/markov-next-word cj/lipsum-chain state) (cadr (cj/markov-random-key cj/lipsum-chain)))))) collect (replace-regexp-in-string "^[[:punct:]]+\\|[[:punct:]]+$" "" w)))) + ;; Filter empty strings from generated words (setq words (cl-remove-if #'string-empty-p words)) (mapconcat (lambda (word idx) @@ -200,7 +234,6 @@ ;;; Paragraphs -;;;###autoload (defun cj/lipsum-paragraphs (count &optional min max) "Insert COUNT paragraphs of lipsum. @@ -213,23 +246,6 @@ Defaults: MIN=30, MAX=80." (let ((len (+ min (random (1+ (- max min)))))) (insert (cj/lipsum len) "\n\n"))))) -;;; Customization - -(defgroup cj-lipsum nil - "Pseudo-Latin lorem ipsum text generator." - :prefix "cj/lipsum-" - :group 'text) - -(defcustom cj/lipsum-default-file - (expand-file-name "latin.txt" - (file-name-directory (or load-file-name buffer-file-name))) - "Default training file for cj-lipsum. - -This should be a plain UTF-8 text file with hundreds of Latin words -or sentences. By default it points to the bundled `latin.txt`." - :type 'file - :group 'cj-lipsum) - ;;; Initialization: train on default file (defun cj/lipsum--init () "Initialize cj-lipsum by learning from `cj/lipsum-default-file`." @@ -240,5 +256,5 @@ or sentences. By default it points to the bundled `latin.txt`." (cj/lipsum--init) -(provide 'lorem-generator) -;;; lorem-generator.el ends here. +(provide 'lorem-optimum) +;;; lorem-optimum.el ends here. diff --git a/modules/mail-config.el b/modules/mail-config.el index c65e5342..1d5a14ea 100644 --- a/modules/mail-config.el +++ b/modules/mail-config.el @@ -283,9 +283,9 @@ Prompts user for the action when executing." ;; user composes org mode; recipient receives html (use-package org-msg - :ensure nil ;; loading locally for fixes + ;; :vc (:url "https://github.com/cjennings/org-msg" :rev :newest) + :load-path "/home/cjennings/code/org-msg" :defer 1 - :load-path "~/code/org-msg/" :after (org mu4e) :preface (defvar-keymap cj/email-map @@ -294,7 +294,10 @@ Prompts user for the action when executing." "d" #'org-msg-attach-delete) (keymap-set cj/custom-keymap "e" cj/email-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; e" "email menu")) + (which-key-add-key-based-replacements + "C-; e" "email menu" + "C-; e a" "attach file" + "C-; e d" "delete attachment")) :bind ;; more intuitive keybinding for attachments (:map org-msg-edit-mode-map @@ -342,5 +345,9 @@ Prompts user for the action when executing." (advice-add #'mu4e-compose-wide-reply :after (lambda (&rest _) (org-msg-edit-mode))) +;; which-key labels +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements "C-c m" "mu4e email")) + (provide 'mail-config) ;;; mail-config.el ends here diff --git a/modules/mousetrap-mode.el b/modules/mousetrap-mode.el index fa9ee6dd..76c08c79 100644 --- a/modules/mousetrap-mode.el +++ b/modules/mousetrap-mode.el @@ -62,5 +62,8 @@ with or without C-, M-, S- modifiers." (keymap-global-set "C-c M" #'mouse-trap-mode) +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements "C-c M" "mouse trap mode")) + (provide 'mousetrap-mode) ;;; mousetrap-mode.el ends here. diff --git a/modules/music-config.el b/modules/music-config.el index 90feb7eb..902fbd9c 100644 --- a/modules/music-config.el +++ b/modules/music-config.el @@ -366,7 +366,16 @@ Dirs added recursively." (keymap-set cj/custom-keymap "m" cj/music-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; m" "music menu")) + (which-key-add-key-based-replacements + "C-; m" "music menu" + "C-; m m" "toggle playlist" + "C-; m M" "show playlist" + "C-; m a" "add music" + "C-; m r" "create radio" + "C-; m SPC" "pause" + "C-; m s" "stop" + "C-; m p" "playlist mode" + "C-; m x" "shuffle")) (use-package emms :defer t diff --git a/modules/org-agenda-config.el b/modules/org-agenda-config.el index c7aac99b..30f4606c 100644 --- a/modules/org-agenda-config.el +++ b/modules/org-agenda-config.el @@ -244,7 +244,6 @@ The agenda is rebuilt from all sources before display, including: (defun cj/add-timestamp-to-org-entry (s) "Add an event with time S to appear underneath the line-at-point. - This allows a line to show in an agenda without being scheduled or a deadline." (interactive "sTime: ") (defvar cj/timeformat "%Y-%m-%d %a") @@ -253,7 +252,6 @@ This allows a line to show in an agenda without being scheduled or a deadline." (open-line 1) (forward-line 1) (insert (concat "<" (format-time-string cj/timeformat (current-time)) " " s ">" )))) -;;(global-set-key (kbd "M-t") #'cj/add-timestamp-to-org-entry) ;; --------------------------- Notifications / Alerts -------------------------- ;; send libnotify notifications for agenda items @@ -275,13 +273,25 @@ This allows a line to show in an agenda without being scheduled or a deadline." ;; This gives two notifications per event without any after-event notifications (setq chime-alert-time '(5 0)) - ;; Modeline display: show upcoming events within 60 minutes + ;; Modeline display: show upcoming events within 2 hours + (setq chime-enable-modeline t) (setq chime-modeline-lookahead 120) (setq chime-modeline-format " ⏰ %s") - ;; Chime sound: plays when notifications appear - (setq chime-play-sound t) - ;; Uses bundled chime.wav by default + ;; Modeline content: show title and countdown only (omit event time) + (setq chime-notification-text-format "%t (%u)") + + ;; Time-until format: compact style like " in 10m" or " in 1h 37m" + (setq chime-time-left-format-short " in %mm") ; Under 1 hour: " in 10m" + (setq chime-time-left-format-long " in %hh %mm") ; 1 hour+: " in 1h 37m" + (setq chime-time-left-format-at-event "right now") + + ;; Title truncation: limit long event titles to 15 characters + ;; This affects only the title, not the icon or countdown + (setq chime-max-title-length 25) ; "Very Long Me... ( in 10m)" + + ;; Chime sound: disabled + (setq chime-play-sound nil) ;; Notification settings (setq chime-notification-title "Reminder") @@ -298,6 +308,9 @@ This allows a line to show in an agenda without being scheduled or a deadline." ;; Enable chime-mode automatically (chime-mode 1)) +;; which-key labels +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements "C-c A" "chime check")) (provide 'org-agenda-config) ;;; org-agenda-config.el ends here diff --git a/modules/org-config.el b/modules/org-config.el index 0249973f..753b1092 100644 --- a/modules/org-config.el +++ b/modules/org-config.el @@ -16,7 +16,7 @@ :init (defvar-keymap cj/org-table-map :doc "org table operations.") - (keymap-global-set "C-c t" cj/org-table-map) + (keymap-set cj/custom-keymap "T" cj/org-table-map) :bind ("C-c c" . org-capture) ("C-c a" . org-agenda) @@ -266,5 +266,20 @@ the current buffer's cache. Useful when encountering parsing errors like (message "Cleared org-element cache for current buffer")) (user-error "Current buffer is not in org-mode")))) +;; which-key labels for org-table-map +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-; T" "org table menu" + "C-; T r" "table row" + "C-; T r i" "insert row" + "C-; T r d" "delete row" + "C-; T c" "table column" + "C-; T c i" "insert column" + "C-; T c d" "delete column" + ;; org global bindings + "C-c a" "org agenda" + "C-c c" "org capture" + "C-c l" "org store link")) + (provide 'org-config) ;;; org-config.el ends here diff --git a/modules/org-contacts-config.el b/modules/org-contacts-config.el index 706412a2..adb99db4 100644 --- a/modules/org-contacts-config.el +++ b/modules/org-contacts-config.el @@ -20,17 +20,17 @@ ;; Add a wrapper function that ensures proper context (defun cj/org-contacts-anniversaries-safe () - "Safely call org-contacts-anniversaries with required bindings." - (require 'diary-lib) - ;; These need to be dynamically bound for diary functions - (defvar date) - (defvar entry) - (defvar original-date) - (let ((date (calendar-current-date)) - (entry "") - (original-date (calendar-current-date))) - (ignore-errors - (org-contacts-anniversaries)))) + "Safely call org-contacts-anniversaries with required bindings." + (require 'diary-lib) + ;; These need to be dynamically bound for diary functions + (defvar date) + (defvar entry) + (defvar original-date) + (let ((date (calendar-current-date)) + (entry "") + (original-date (calendar-current-date))) + (ignore-errors + (org-contacts-anniversaries)))) ;; Use the safe wrapper instead (add-hook 'org-agenda-finalize-hook 'cj/org-contacts-anniversaries-safe)) @@ -39,8 +39,8 @@ (with-eval-after-load 'org-capture (add-to-list 'org-capture-templates - '("C" "Contact" entry (file+headline contacts-file "Contacts") - "* %(cj/org-contacts-template-name) + '("C" "Contact" entry (file+headline contacts-file "Contacts") + "* %(cj/org-contacts-template-name) :PROPERTIES: :EMAIL: %(cj/org-contacts-template-email) :PHONE: %^{Phone(s) - separate multiple with commas} @@ -57,31 +57,31 @@ Added: %U"))) ;; duplicate?!? ;; (with-eval-after-load 'org-capture ;; (add-to-list 'org-capture-templates -;; '("C" "Contact" entry (file+headline contacts-file "Contacts") -;; "* %(cj/org-contacts-template-name) +;; '("C" "Contact" entry (file+headline contacts-file "Contacts") +;; "* %(cj/org-contacts-template-name) ;; Added: %U"))) (defun cj/org-contacts-template-name () "Get name for contact template from context." (let ((name (when (boundp 'cj/contact-name) cj/contact-name))) - (or name - (when (eq major-mode 'mu4e-headers-mode) - (mu4e-message-field (mu4e-message-at-point) :from-or-to)) - (when (eq major-mode 'mu4e-view-mode) - (mu4e-message-field mu4e~view-message :from-or-to)) - (read-string "Name: ")))) + (or name + (when (eq major-mode 'mu4e-headers-mode) + (mu4e-message-field (mu4e-message-at-point) :from-or-to)) + (when (eq major-mode 'mu4e-view-mode) + (mu4e-message-field mu4e~view-message :from-or-to)) + (read-string "Name: ")))) (defun cj/org-contacts-template-email () "Get email for contact template from context." (let ((email (when (boundp 'cj/contact-email) cj/contact-email))) - (or email - (when (eq major-mode 'mu4e-headers-mode) - (let ((from (mu4e-message-field (mu4e-message-at-point) :from))) - (when from (cdr (car from))))) - (when (eq major-mode 'mu4e-view-mode) - (let ((from (mu4e-message-field mu4e~view-message :from))) - (when from (cdr (car from))))) - (read-string "Email: ")))) + (or email + (when (eq major-mode 'mu4e-headers-mode) + (let ((from (mu4e-message-field (mu4e-message-at-point) :from))) + (when from (cdr (car from))))) + (when (eq major-mode 'mu4e-view-mode) + (let ((from (mu4e-message-field mu4e~view-message :from))) + (when from (cdr (car from))))) + (read-string "Email: ")))) ;;; ------------------------- Quick Contact Functions --------------------------- @@ -91,13 +91,13 @@ Added: %U"))) (find-file contacts-file) (goto-char (point-min)) (let ((contact (completing-read "Contact: " - (org-map-entries - (lambda () (nth 4 (org-heading-components))) - nil (list contacts-file))))) - (goto-char (point-min)) - (search-forward contact) - (org-fold-show-entry) - (org-reveal))) + (org-map-entries + (lambda () (nth 4 (org-heading-components))) + nil (list contacts-file))))) + (goto-char (point-min)) + (search-forward contact) + (org-fold-show-entry) + (org-reveal))) (defun cj/org-contacts-new () "Create a new contact." @@ -110,19 +110,6 @@ Added: %U"))) (find-file contacts-file) (org-columns)) -;;; -------------------------- Org-Roam Integration ----------------------------- - -;; (with-eval-after-load 'org-roam -;; (defun cj/org-contacts-link-to-roam () -;; "Link current contact to an org-roam node." -;; (interactive) -;; (when (eq major-mode 'org-mode) -;; (let ((contact-name (org-entry-get (point) "ITEM"))) -;; (org-set-property "ROAM_REFS" -;; (org-roam-node-id -;; (org-roam-node-read nil nil nil nil -;; :initial-input contact-name))))))) - ;;; ----------------------------- Birthday Agenda -------------------------------- (with-eval-after-load 'org-agenda @@ -131,40 +118,48 @@ Added: %U"))) ;; Custom agenda command for upcoming birthdays (add-to-list 'org-agenda-custom-commands - '("b" "Birthdays and Anniversaries" - ((tags-todo "BIRTHDAY|ANNIVERSARY" - ((org-agenda-overriding-header "Upcoming Birthdays and Anniversaries") - (org-agenda-sorting-strategy '(time-up)))))))) + '("b" "Birthdays and Anniversaries" + ((tags-todo "BIRTHDAY|ANNIVERSARY" + ((org-agenda-overriding-header "Upcoming Birthdays and Anniversaries") + (org-agenda-sorting-strategy '(time-up)))))))) ;;; ---------------------------- Core Contact Data Functions --------------------------- (defun cj/org-contacts--props-matching (entry pattern) "Return all property values from ENTRY whose keys match PATTERN (a regexp)." (let ((props (nth 2 entry))) - (delq nil - (mapcar (lambda (prop) - (when (string-match-p pattern (car prop)) - (cdr prop))) - props)))) + (delq nil + (mapcar (lambda (prop) + (when (string-match-p pattern (car prop)) + (cdr prop))) + props)))) + +(defun cj/--parse-email-string (name email-string) + "Parse EMAIL-STRING and return formatted entries for NAME. +EMAIL-STRING may contain multiple emails separated by commas, semicolons, or spaces. +Returns a list of strings formatted as 'Name <email>'. +Returns nil if EMAIL-STRING is nil or contains only whitespace." + (when (and email-string (string-match-p "[^[:space:]]" email-string)) + (let ((emails (split-string email-string "[,;[:space:]]+" t))) + (mapcar (lambda (email) + (format "%s <%s>" name (string-trim email))) + emails)))) (defun cj/get-all-contact-emails () "Retrieve all contact emails from org-contacts database. Returns a list of formatted strings like \"Name <email@example.com>\". This is the core function used by the mu4e integration module." (let ((contacts (org-contacts-db))) - (delq nil - (mapcan (lambda (e) - (let* ((name (car e)) - ;; This returns a LIST of email strings - (email-strings (cj/org-contacts--props-matching e "EMAIL"))) - ;; Need mapcan here to handle the list - (mapcan (lambda (email-str) - (when (and email-str (string-match-p "[^[:space:]]" email-str)) - (mapcar (lambda (email) - (format "%s <%s>" name (string-trim email))) - (split-string email-str "[,;[:space:]]+" t)))) - email-strings))) - contacts)))) + (delq nil + (mapcan (lambda (e) + (let* ((name (car e)) + ;; This returns a LIST of email strings + (email-strings (cj/org-contacts--props-matching e "EMAIL"))) + ;; Process each email string using the extracted parser + (mapcan (lambda (email-str) + (cj/--parse-email-string name email-str)) + email-strings))) + contacts)))) ;; Simple insertion function for use outside of mu4e (defun cj/insert-contact-email () @@ -173,8 +168,8 @@ For use outside of mu4e compose buffers. In mu4e, the integration module provides more sophisticated completion." (interactive) (let* ((items (cj/get-all-contact-emails)) - (selected (completing-read "Contact: " items nil t))) - (insert selected))) + (selected (completing-read "Contact: " items nil t))) + (insert selected))) ;;; -------------------------------- Org Contacts -------------------------------- @@ -195,9 +190,9 @@ module provides more sophisticated completion." (setq mu4e-org-contacts-file contacts-file) (add-to-list 'mu4e-headers-actions - '("org-contact-add" . mu4e-action-add-org-contact) t) + '("org-contact-add" . mu4e-action-add-org-contact) t) (add-to-list 'mu4e-view-actions - '("org-contact-add" . mu4e-action-add-org-contact) t) + '("org-contact-add" . mu4e-action-add-org-contact) t) ;; Disable mu4e's built-in completion in favor of our custom solution (setq mu4e-compose-complete-addresses nil)) @@ -207,15 +202,24 @@ module provides more sophisticated completion." ;; Keymap for `org-contacts' commands (defvar cj/org-contacts-map (let ((map (make-sparse-keymap))) - (keymap-set map "f" #'cj/org-contacts-find) ;; find contact - (keymap-set map "n" #'cj/org-contacts-new) ;; new contact - (keymap-set map "e" #'cj/insert-contact-email) ;; inserts email from org-contact - (keymap-set map "v" #'cj/org-contacts-view-all) ;; view all contacts - map) + (keymap-set map "f" #'cj/org-contacts-find) ;; find contact + (keymap-set map "n" #'cj/org-contacts-new) ;; new contact + (keymap-set map "e" #'cj/insert-contact-email) ;; inserts email from org-contact + (keymap-set map "v" #'cj/org-contacts-view-all) ;; view all contacts + map) "Keymap for `org-contacts' commands.") ;; Bind the org-contacts map to the C-c C prefix (keymap-global-set "C-c C" cj/org-contacts-map) +;; which-key labels +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-c C" "contacts menu" + "C-c C f" "find contact" + "C-c C n" "new contact" + "C-c C e" "insert email" + "C-c C v" "view all contacts")) + (provide 'org-contacts-config) ;;; org-contacts-config.el ends here diff --git a/modules/org-drill-config.el b/modules/org-drill-config.el index f18760c7..08047e3a 100644 --- a/modules/org-drill-config.el +++ b/modules/org-drill-config.el @@ -70,7 +70,13 @@ (keymap-set cj/custom-keymap "D" cj/drill-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; D" "org-drill menu"))) + (which-key-add-key-based-replacements + "C-; D" "org-drill menu" + "C-; D s" "start drill" + "C-; D e" "edit drill file" + "C-; D c" "capture question" + "C-; D r" "refile to drill" + "C-; D R" "resume drill"))) (provide 'org-drill-config) ;;; org-drill-config.el ends here. diff --git a/modules/org-gcal-config.el b/modules/org-gcal-config.el index ed0831b8..b3c63663 100644 --- a/modules/org-gcal-config.el +++ b/modules/org-gcal-config.el @@ -10,6 +10,9 @@ ;; - Automatic removal of cancelled events, but with TODOs added for visibility ;; - System timezone configuration via functions in host-environment ;; - No notifications on syncing +;; - Events are managed by Org (changes in org file push back to Google Calendar) +;; This is controlled by org-gcal-managed-newly-fetched-mode and +;; org-gcal-managed-update-existing-mode set to "org" ;; - Initial automatic sync post Emacs startup. No auto resync'ing. ;; (my calendar doesn't change hourly and I want fewer distractions and slowdowns). ;; if you need it: https://github.com/kidd/org-gcal.el?tab=readme-ov-file#sync-automatically-at-regular-times @@ -35,6 +38,11 @@ (require 'host-environment) (require 'user-constants) +;; Forward declare org-gcal internal variables and functions +(eval-when-compile + (defvar org-gcal--sync-lock)) +(declare-function org-gcal-reload-client-id-secret "org-gcal") + (defun cj/org-gcal-clear-sync-lock () "Clear the org-gcal sync lock. Useful when a sync fails and leaves the lock in place, preventing future syncs." @@ -42,7 +50,24 @@ Useful when a sync fails and leaves the lock in place, preventing future syncs." (setq org-gcal--sync-lock nil) (message "org-gcal sync lock cleared")) +(defun cj/org-gcal-convert-all-to-org-managed () + "Convert all org-gcal events in current buffer to Org-managed. + +Changes all events with org-gcal-managed property from `gcal' to `org', +enabling bidirectional sync so changes push back to Google Calendar." + (interactive) + (let ((count 0)) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^:org-gcal-managed: gcal$" nil t) + (replace-match ":org-gcal-managed: org") + (setq count (1+ count)))) + (when (> count 0) + (save-buffer)) + (message "Converted %d event(s) to Org-managed" count))) + (use-package org-gcal + :vc (:url "https://github.com/cjennings/org-gcal" :rev :newest) :defer t ;; unless idle timer is set below :bind (("C-; g" . org-gcal-sync) ("C-; G" . cj/org-gcal-clear-sync-lock)) @@ -71,6 +96,10 @@ Useful when a sync fails and leaves the lock in place, preventing future syncs." (setq org-gcal-remove-api-cancelled-events t) ;; auto-remove cancelled events (setq org-gcal-update-cancelled-events-with-todo t) ;; todo cancelled events for visibility + ;; Enable bidirectional sync - treat events as Org-managed so changes push back + (setq org-gcal-managed-newly-fetched-mode "org") ;; New events from GCal are Org-managed + (setq org-gcal-managed-update-existing-mode "org") ;; Existing events become Org-managed + :config ;; Enable plstore passphrase caching after org-gcal loads (require 'plstore) @@ -90,5 +119,11 @@ Useful when a sync fails and leaves the lock in place, preventing future syncs." ;; (org-gcal-sync) ;; (error (message "org-gcal: Initial sync failed: %s" err))))) +;; which-key labels +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-; g" "gcal sync" + "C-; G" "clear sync lock")) + (provide 'org-gcal-config) ;;; org-gcal-config.el ends here diff --git a/modules/org-roam-config.el b/modules/org-roam-config.el index 18552b1d..a6b42ce7 100644 --- a/modules/org-roam-config.el +++ b/modules/org-roam-config.el @@ -1,7 +1,15 @@ ;;; org-roam-config.el --- Org-Roam Config -*- lexical-binding: t; coding: utf-8; -*- ;; author: Craig Jennings <c@cjennings.net> ;;; Commentary: -;; Currently a work in progress. The initial version of this was taken from David Wilson: +;; Configuration and utilities for org-roam knowledge management. +;; +;; Key features: +;; - Custom capture templates for different node types (v2mom, recipe, topic) +;; - Automatic moving of completed tasks to daily journal +;; - Tag-based node filtering and finding +;; - Branch extraction to new roam nodes (cj/move-org-branch-to-roam) +;; +;; The initial version was adapted from David Wilson: ;; https://systemcrafters.net/build-a-second-brain-in-emacs/5-org-roam-hacks/ ;;; Code: @@ -11,6 +19,7 @@ ;; ---------------------------------- Org Roam --------------------------------- (use-package org-roam + :defer 1 :commands (org-roam-node-find org-roam-node-insert org-roam-db-autosync-mode) :config ;; Enable autosync mode after org-roam loads @@ -77,7 +86,9 @@ (add-to-list 'org-after-todo-state-change-hook (lambda () (when (and (member org-state org-done-keywords) - (not (member org-last-state org-done-keywords))) + (not (member org-last-state org-done-keywords)) + ;; Don't run for gcal.org - it's managed by org-gcal + (not (string= (buffer-file-name) (expand-file-name gcal-file)))) (cj/org-roam-copy-todo-to-today))))) ;; ------------------------- Org Roam Insert Immediate ------------------------- @@ -190,6 +201,51 @@ Otherwise return TEXT unchanged." (or description url)) text)) +(defun cj/--generate-roam-slug (title) + "Convert TITLE to a filename-safe slug. +Converts to lowercase, replaces non-alphanumeric characters with hyphens, +and removes leading/trailing hyphens. +Returns the slugified string." + (let ((slug (replace-regexp-in-string + "[^a-zA-Z0-9]+" "-" + (downcase title)))) + (replace-regexp-in-string "^-\\|-$" "" slug))) + +(defun cj/--demote-org-subtree (content from-level to-level) + "Demote org subtree CONTENT from FROM-LEVEL to TO-LEVEL. +CONTENT is the org-mode text with headings. +FROM-LEVEL is the current level of the top heading (integer). +TO-LEVEL is the desired level for the top heading (integer). +Returns the demoted content as a string. +All headings in the tree are adjusted proportionally." + (if (<= from-level to-level) + ;; No demotion needed + content + (let ((demote-count (- from-level to-level))) + (with-temp-buffer + (insert content) + (goto-char (point-min)) + (while (re-search-forward "^\\(\\*+\\) " nil t) + (let* ((stars (match-string 1)) + (level (length stars)) + (new-level (max 1 (- level demote-count))) + (new-stars (make-string new-level ?*))) + (replace-match (concat new-stars " ")))) + (buffer-string))))) + +(defun cj/--format-roam-node (title node-id content) + "Format org-roam node file CONTENT with TITLE and NODE-ID. +TITLE is the node title string. +NODE-ID is the unique identifier for the node. +CONTENT is the main body content (already demoted if needed). +Returns the complete file content as a string." + (concat ":PROPERTIES:\n" + ":ID: " node-id "\n" + ":END:\n" + "#+TITLE: " title "\n" + "#+CATEGORY: " title "\n" + "#+FILETAGS: Topic\n\n" + content)) (defun cj/move-org-branch-to-roam () "Move the org subtree at point to a new org-roam node. @@ -213,12 +269,7 @@ title." (title (cj/org-link-get-description raw-title)) (timestamp (format-time-string "%Y%m%d%H%M%S")) ;; Convert title to filename-safe format - (title-slug (replace-regexp-in-string - "[^a-zA-Z0-9]+" "-" - (downcase title))) - ;; Remove leading/trailing hyphens - (title-slug (replace-regexp-in-string - "^-\\|-$" "" title-slug)) + (title-slug (cj/--generate-roam-slug title)) (filename (format "%s-%s.org" timestamp title-slug)) (filepath (expand-file-name filename org-roam-directory)) ;; Generate a unique ID for the node @@ -234,33 +285,11 @@ title." (org-cut-subtree) ;; Process the subtree to demote it to level 1 - (with-temp-buffer - (org-mode) - (insert subtree-content) - ;; Demote the entire tree so the top level becomes level 1 - (goto-char (point-min)) - (when (> current-level 1) - (let ((demote-count (- current-level 1))) - (while (re-search-forward "^\\*+ " nil t) - (beginning-of-line) - (dotimes (_ demote-count) - (when (looking-at "^\\*\\*") - (delete-char 1))) - (forward-line)))) - (setq subtree-content (buffer-string))) + (setq subtree-content (cj/--demote-org-subtree subtree-content current-level 1)) ;; Create the new org-roam file (with-temp-file filepath - ;; Insert the org-roam template with ID at file level - (insert ":PROPERTIES:\n") - (insert ":ID: " node-id "\n") - (insert ":END:\n") - (insert "#+TITLE: " title "\n") - (insert "#+CATEGORY: " title "\n") - (insert "#+FILETAGS: Topic\n\n") - - ;; Insert the demoted subtree content - (insert subtree-content)) + (insert (cj/--format-roam-node title node-id subtree-content))) ;; Sync the org-roam database (org-roam-db-sync) @@ -268,5 +297,19 @@ title." ;; Message to user (message "'%s' added as an org-roam node." title))) +;; which-key labels +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-c n" "org-roam menu" + "C-c n l" "roam buffer toggle" + "C-c n f" "roam find node" + "C-c n p" "roam find project" + "C-c n r" "roam find recipe" + "C-c n t" "roam find topic" + "C-c n i" "roam insert node" + "C-c n w" "roam find webclip" + "C-c n I" "roam insert immediate" + "C-c n d" "roam dailies menu")) + (provide 'org-roam-config) ;;; org-roam-config.el ends here. diff --git a/modules/org-webclipper.el b/modules/org-webclipper.el index 67bfa6dd..7b024e43 100644 --- a/modules/org-webclipper.el +++ b/modules/org-webclipper.el @@ -11,6 +11,7 @@ ;; - Automatic conversion to Org format using eww-readable and Pandoc ;; - One-click capture from any web page ;; - Preserves page structure and formatting +;; - Smart heading adjustment (removes page title, demotes remaining headings) ;; ;; Setup: ;; 1. Ensure this file is loaded in your Emacs configuration @@ -30,6 +31,11 @@ ;; The clipped content will be added to the file specified by `webclipped-file` ;; under the "Webclipped Inbox" heading with proper formatting and metadata. ;; +;; Architecture: +;; - cj/--process-webclip-content: Pure function for content processing +;; - cj/org-protocol-webclip-handler: Handles URL fetching and capture +;; - cj/org-webclipper-EWW: Direct capture from EWW/W3M buffers +;; ;; Requirements: ;; - org-web-tools package ;; - Pandoc installed on your system @@ -89,6 +95,28 @@ (setq cj/webclipper-initialized t))) +(defun cj/--process-webclip-content (org-content) + "Process webclip ORG-CONTENT by removing first heading and demoting others. +ORG-CONTENT is the raw org-mode text from the web page conversion. +Returns the processed content as a string with: +- First top-level heading removed +- Initial blank lines removed +- All remaining headings demoted by one level" + (with-temp-buffer + (insert org-content) + (goto-char (point-min)) + ;; Skip the first heading line (we'll use our template's heading) + (when (looking-at "^\\* .*\n") + (delete-region (match-beginning 0) (match-end 0))) + ;; Remove any initial blank lines + (while (looking-at "^[ \t]*\n") + (delete-char 1)) + ;; Demote all remaining headings by one level + ;; since our template already provides the top-level heading + (while (re-search-forward "^\\(\\*+\\) " nil t) + (replace-match (concat (match-string 1) "* ") t t)) + (buffer-string))) + (defun cj/org-protocol-webclip (info) "Process org-protocol webclip requests. INFO is a plist containing :url and :title from the org-protocol call." @@ -121,22 +149,7 @@ It fetches the page content and converts it to Org format." (error "No URL provided for clipping") (condition-case err (let* ((org-content (org-web-tools--url-as-readable-org url)) - ;; Process the content to adjust heading levels - (processed-content - (with-temp-buffer - (insert org-content) - (goto-char (point-min)) - ;; Skip the first heading line (we'll use our template's heading) - (when (looking-at "^\\* .*\n") - (delete-region (match-beginning 0) (match-end 0))) - ;; Remove any initial blank lines - (while (looking-at "^[ \t]*\n") - (delete-char 1)) - ;; Demote all remaining headings by one level - ;; since our template already provides the top-level heading - (while (re-search-forward "^\\(\\*+\\) " nil t) - (replace-match (concat (match-string 1) "* ") t t)) - (buffer-string)))) + (processed-content (cj/--process-webclip-content org-content))) ;; Show success message with the title (require 'user-constants) ;; Ensure webclipped-file is available (message "'%s' added to %s" title webclipped-file) @@ -171,7 +184,6 @@ Return the yanked content as a string so templates can insert it." ;; ----------------------------- Webclipper Keymap ----------------------------- ;; keymaps shouldn't be required for webclipper -;; TASK Move org-branch to roam functionality under org-roam ;; Setup keymaps ;; ;; (defun cj/webclipper-setup-keymaps () diff --git a/modules/popper-config.el b/modules/popper-config.el index b0f503e8..d9a9d9b0 100644 --- a/modules/popper-config.el +++ b/modules/popper-config.el @@ -26,6 +26,7 @@ '("\\*Messages\\*" "Output\\*$" "\\*Async Shell Command\\*" + "\\*Async-native-compile-log\\*" help-mode compilation-mode)) (add-to-list 'display-buffer-alist diff --git a/modules/prog-general.el b/modules/prog-general.el index f6ebfe09..d8d9627d 100644 --- a/modules/prog-general.el +++ b/modules/prog-general.el @@ -264,12 +264,8 @@ If no such file exists there, display a message." ("C-c s n" . yas-new-snippet) ("C-c s e" . yas-visit-snippet-file) :config - (setq yas-snippet-dirs '(snippets-dir))) - -(use-package ivy-yasnippet - :after yasnippet - :bind - ("C-c s i" . ivy-yasnippet)) + (setq yas-snippet-dirs (list snippets-dir)) + (yas-reload-all)) ;; --------------------- Display Color On Color Declaration -------------------- ;; display the actual color as highlight to color hex code @@ -400,6 +396,15 @@ If no such file exists there, display a message." "1.5 sec" nil 'delete-windows-on (get-buffer-create "*compilation*")))))) +;; which-key labels +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-c s" "snippets menu" + "C-c s n" "new snippet" + "C-c s e" "edit snippet" + "C-c s i" "insert snippet" + "C-c p" "projectile menu" + "C-c C-s" "symbol overlay")) (provide 'prog-general) ;;; prog-general.el ends here diff --git a/modules/reconcile-open-repos.el b/modules/reconcile-open-repos.el index 648de222..2e48e45d 100644 --- a/modules/reconcile-open-repos.el +++ b/modules/reconcile-open-repos.el @@ -73,7 +73,6 @@ Magit for review." ;; ---------------------------- Check For Open Work ---------------------------- -;;;###autoload (defun cj/check-for-open-work () "Check all project directories for open work." (interactive) diff --git a/modules/selection-framework.el b/modules/selection-framework.el index 66ca1cbd..a89afc02 100644 --- a/modules/selection-framework.el +++ b/modules/selection-framework.el @@ -27,7 +27,6 @@ (vertico-resize nil) ; Don't resize the minibuffer (vertico-sort-function #'vertico-sort-history-alpha) ; History first, then alphabetical :bind (:map vertico-map - ;; Match ivy's C-j C-k behavior ("C-j" . vertico-next) ("C-k" . vertico-previous) ("C-l" . vertico-insert) ; Insert current candidate @@ -128,7 +127,7 @@ ;; Use Consult for completion-at-point (setq completion-in-region-function #'consult-completion-in-region)) -(global-unset-key (kbd "C-s")) +;; Override default search with consult-line (keymap-global-set "C-s" #'consult-line) ;; Consult integration with Embark @@ -152,10 +151,10 @@ (use-package orderless :demand t :custom - (completion-styles '(orderless)) + (completion-styles '(orderless basic)) (completion-category-defaults nil) - (completion-category-overrides '((file (styles partial-completion)) - (multi-category (styles orderless)))) + (completion-category-overrides '((file (styles partial-completion orderless basic)) + (multi-category (styles orderless basic)))) (orderless-matching-styles '(orderless-literal orderless-regexp orderless-initialism @@ -183,16 +182,10 @@ nil (window-parameters (mode-line-format . none))))) -;; this typo causes crashes -;; (add-to-list 'display-buffer-alist -;; '("\\=\\*Embark Collect \\(Live\\|Completions\\)\\*" -;; nil -;; (window-parameters (mode-line-format . none))))) - ;; --------------------------- Consult Integration ---------------------------- ;; Additional integrations for specific features -;; Yasnippet integration - replaces ivy-yasnippet +;; Yasnippet integration (use-package consult-yasnippet :after yasnippet :bind ("C-c s i" . consult-yasnippet)) @@ -204,7 +197,7 @@ ("C-c ! c" . consult-flycheck))) ;; ---------------------------------- Company ---------------------------------- -;; In-buffer completion (retained from original configuration) +;; In-buffer completion for text and code (use-package company :demand t @@ -259,5 +252,13 @@ :config (company-prescient-mode)) +;; which-key labels +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-c h" "consult history" + "C-c s i" "insert snippet" + "M-g" "goto menu" + "M-s" "search menu")) + (provide 'selection-framework) ;;; selection-framework.el ends here diff --git a/modules/system-commands.el b/modules/system-commands.el new file mode 100644 index 00000000..fb8c0611 --- /dev/null +++ b/modules/system-commands.el @@ -0,0 +1,138 @@ +;;; system-commands.el --- System power and session management -*- lexical-binding: t; coding: utf-8; -*- +;; author: Craig Jennings <c@cjennings.net> +;; +;;; Commentary: +;; +;; System commands for logout, lock, suspend, shutdown, reboot, and Emacs +;; exit/restart. Provides both a keymap (C-; !) and a completing-read menu. +;; +;; Commands include: +;; - Logout (terminate user session) +;; - Lock screen (slock) +;; - Suspend (systemctl suspend) +;; - Shutdown (systemctl poweroff) +;; - Reboot (systemctl reboot) +;; - Exit Emacs (kill-emacs) +;; - Restart Emacs (via systemctl --user restart emacs.service) +;; +;; Dangerous commands (logout, suspend, shutdown, reboot) require confirmation. +;; +;;; Code: + +(eval-when-compile (require 'keybindings)) +(eval-when-compile (require 'subr-x)) +(require 'rx) + +;; ------------------------------ System Commands ------------------------------ + +(defun cj/system-cmd--resolve (cmd) + "Return (values symbol-or-nil command-string label) for CMD." + (cond + ((symbolp cmd) + (let ((val (and (boundp cmd) (symbol-value cmd)))) + (unless (and (stringp val) (not (string-empty-p val))) + (user-error "Variable %s is not a non-empty string" cmd)) + (list cmd val (symbol-name cmd)))) + ((stringp cmd) + (let ((s (string-trim cmd))) + (when (string-empty-p s) (user-error "Command string is empty")) + (list nil s "command"))) + (t (user-error "Error: cj/system-cmd expects a string or a symbol")))) + +(defun cj/system-cmd (cmd) + "Run CMD (string or symbol naming a string) detached via the shell. +Shell expansions like $(...) are supported. Output is silenced. +If CMD is deemed dangerous, ask for confirmation." + (interactive (list (read-shell-command "System command: "))) + (pcase-let ((`(,sym ,cmdstr ,label) (cj/system-cmd--resolve cmd))) + (when (and sym (get sym 'cj/system-confirm) + (memq (read-char-choice + (format "Run %s now (%s)? (Y/n) " label cmdstr) + '(?y ?Y ?n ?N ?\r ?\n ?\s)) + '(?n ?N))) + (user-error "Aborted")) + (let ((proc (start-process-shell-command "cj/system-cmd" nil + (format "nohup %s >/dev/null 2>&1 &" cmdstr)))) + (set-process-query-on-exit-flag proc nil) + (set-process-sentinel proc #'ignore) + (message "Running %s..." label)))) + +(defmacro cj/defsystem-command (name var cmdstr &optional confirm) + "Define VAR with CMDSTR and interactive command NAME to run it. +If CONFIRM is non-nil, mark VAR to always require confirmation." + (declare (indent defun)) + `(progn + (defvar ,var ,cmdstr) + ,(when confirm `(put ',var 'cj/system-confirm t)) + (defun ,name () + ,(format "Run %s via `cj/system-cmd'." var) + (interactive) + (cj/system-cmd ',var)))) + +;; Define system commands +(cj/defsystem-command cj/system-cmd-logout logout-cmd "loginctl terminate-user $(whoami)" t) +(cj/defsystem-command cj/system-cmd-lock lockscreen-cmd "slock") +(cj/defsystem-command cj/system-cmd-suspend suspend-cmd "systemctl suspend" t) +(cj/defsystem-command cj/system-cmd-shutdown shutdown-cmd "systemctl poweroff" t) +(cj/defsystem-command cj/system-cmd-reboot reboot-cmd "systemctl reboot" t) + +(defun cj/system-cmd-exit-emacs () + "Exit Emacs server and all clients." + (interactive) + (when (memq (read-char-choice + "Exit Emacs? (Y/n) " + '(?y ?Y ?n ?N ?\r ?\n ?\s)) + '(?n ?N)) + (user-error "Aborted")) + (kill-emacs)) + +(defun cj/system-cmd-restart-emacs () + "Restart Emacs server after saving buffers." + (interactive) + (when (memq (read-char-choice + "Restart Emacs? (Y/n) " + '(?y ?Y ?n ?N ?\r ?\n ?\s)) + '(?n ?N)) + (user-error "Aborted")) + (save-some-buffers) + ;; Start the restart process before killing Emacs + (run-at-time 0.5 nil + (lambda () + (call-process-shell-command + "systemctl --user restart emacs.service && emacsclient -c" + nil 0))) + (run-at-time 1 nil #'kill-emacs) + (message "Restarting Emacs...")) + +(defvar-keymap cj/system-command-map + :doc "Keymap for system commands." + "L" #'cj/system-cmd-logout + "r" #'cj/system-cmd-reboot + "s" #'cj/system-cmd-shutdown + "S" #'cj/system-cmd-suspend + "l" #'cj/system-cmd-lock + "E" #'cj/system-cmd-exit-emacs + "e" #'cj/system-cmd-restart-emacs) +(keymap-set cj/custom-keymap "!" cj/system-command-map) + +(defun cj/system-command-menu () + "Present system commands via \='completing-read\='." + (interactive) + (let* ((commands '(("Logout System" . cj/system-cmd-logout) + ("Lock Screen" . cj/system-cmd-lock) + ("Suspend System" . cj/system-cmd-suspend) + ("Shutdown System" . cj/system-cmd-shutdown) + ("Reboot System" . cj/system-cmd-reboot) + ("Exit Emacs" . cj/system-cmd-exit-emacs) + ("Restart Emacs" . cj/system-cmd-restart-emacs))) + (choice (completing-read "System command: " commands nil t))) + (when-let ((cmd (alist-get choice commands nil nil #'equal))) + (call-interactively cmd)))) + +(keymap-set cj/custom-keymap "!" #'cj/system-command-menu) + +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements "C-; !" "system commands")) + +(provide 'system-commands) +;;; system-commands.el ends here diff --git a/modules/system-utils.el b/modules/system-utils.el index 6e51c32c..eef20718 100644 --- a/modules/system-utils.el +++ b/modules/system-utils.el @@ -43,6 +43,9 @@ (message "Error occurred during evaluation: %s" (error-message-string err))))) (keymap-global-set "C-c b" #'cj/eval-buffer-with-confirmation-or-error-message) +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements "C-c b" "eval buffer")) + ;;; ---------------------------- Edit A File With Sudo ---------------------------- (use-package sudo-edit diff --git a/modules/test-runner.el b/modules/test-runner.el index b4c40820..125a8d20 100644 --- a/modules/test-runner.el +++ b/modules/test-runner.el @@ -2,26 +2,75 @@ ;; author: Craig Jennings <c@cjennings.net> ;; ;;; Commentary: -;; Provides utilities for running ERT tests with focus/unfocus workflow + +;; This module provides a powerful ERT test runner with focus/unfocus workflow +;; for efficient test-driven development in Emacs Lisp projects. +;; +;; PURPOSE: +;; +;; When working on large Emacs Lisp projects with many test files, you often +;; want to focus on running just the tests relevant to your current work without +;; waiting for the entire suite to run. This module provides a smart test runner +;; that supports both running all tests and focusing on specific test files. +;; +;; WORKFLOW: +;; +;; 1. Run all tests initially to establish baseline (C-; t R) +;; 2. Add test files to focus while working on a feature (C-; t a) +;; 3. Run focused tests repeatedly as you develop (C-; t r) +;; 4. Add more test files as needed (C-; t b from within test buffer) +;; 5. View your focused test list at any time (C-; t v) +;; 6. Clear focus and run all tests before finishing (C-; t c, then C-; t R) +;; +;; PROJECT INTEGRATION: ;; -;; Tests should be located in the Projectile project test directories, -;; typically "test" or "tests" under the project root. -;; Falls back to =~/.emacs.d/tests= if not in a Projectile project. +;; - Automatically discovers test directories in Projectile projects +;; (looks for "test" or "tests" under project root) +;; - Falls back to ~/.emacs.d/tests if not in a Projectile project +;; - Test files must match pattern: test-*.el ;; -;; The default mode is to load and run all tests. +;; SPECIAL BEHAVIORS: ;; -;; To focus on running a specific set of test files: -;; - Toggle the mode to "focus" mode -;; - Add specific test files to the list of tests in "focus" -;; - Running tests (smartly) will now just run those tests +;; - Smart test running: Automatically runs all or focused tests based on mode +;; - Test extraction: Discovers test names via regex to run specific tests +;; - At-point execution: Run individual test at cursor position (C-; t .) +;; - Error handling: Continues loading tests even if individual files fail ;; -;; Don't forget to run all tests again in default mode at least once before finishing. +;; KEYBINDINGS: +;; +;; C-; t L Load all test files +;; C-; t R Run all tests (full suite) +;; C-; t r Run tests smartly (all or focused based on mode) +;; C-; t . Run test at point +;; C-; t a Add test file to focus (with completion) +;; C-; t b Add current buffer's test file to focus +;; C-; t c Clear all focused test files +;; C-; t v View list of focused test files +;; C-; t t Toggle mode between 'all and 'focused +;; +;; RECOMMENDED USAGE: +;; +;; While implementing a feature: +;; - Add the main test file for the feature you're working on +;; - Add any related test files that might be affected +;; - Use C-; t r to repeatedly run just those focused tests +;; - This provides fast feedback during development +;; +;; Before committing: +;; - Clear the focus with C-; t c +;; - Run the full suite with C-; t R to ensure nothing broke +;; - Verify all tests pass before pushing changes ;; ;;; Code: (require 'ert) (require 'cl-lib) +;;; External Variables and Functions + +(defvar cj/custom-keymap) ; Defined in init.el +(declare-function projectile-project-root "projectile" ()) + ;;; Variables (defvar cj/test-global-directory nil @@ -35,19 +84,19 @@ Each element is a filename (without path) to run.") (defvar cj/test-mode 'all "Current test execution mode. -Either 'all (run all tests) or 'focused (run only focused tests).") +Either \\='all (run all tests) or \\='focused (run only focused tests).") (defvar cj/test-last-results nil "Results from the last test run.") ;;; Core Functions -;;;###autoload (defun cj/test--get-test-directory () "Return the test directory path for the current project. -If in a Projectile project, prefers a 'test' or 'tests' directory inside the project root. -Falls back to =cj/test-global-directory= if not found or not in a project." +If in a Projectile project, prefers \\='test or \\='tests directory +inside the project root. Falls back to `cj/test-global-directory' +if not found or not in a project." (require 'projectile) (let ((project-root (ignore-errors (projectile-project-root)))) (if (not (and project-root (file-directory-p project-root))) @@ -60,15 +109,32 @@ Falls back to =cj/test-global-directory= if not found or not in a project." ((file-directory-p tests-dir) tests-dir) (t cj/test-global-directory)))))) -;;;###autoload (defun cj/test--get-test-files () - "Return a list of test file names (without path) in the appropriate test directory." + "Return list of test file names (without path) in test directory." (let ((dir (cj/test--get-test-directory))) (when (file-directory-p dir) (mapcar #'file-name-nondirectory (directory-files dir t "^test-.*\\.el$"))))) -;;;###autoload +(defun cj/test--do-load-files (_dir files) + "Load test FILES from DIR. +Returns: (cons \\='success loaded-count) on success, + (cons \\='error (list failed-files errors)) on errors." + (let ((loaded-count 0) + (errors '())) + (dolist (file files) + (condition-case err + (progn + (load-file file) + (setq loaded-count (1+ loaded-count))) + (error + (push (cons (file-name-nondirectory file) + (error-message-string err)) + errors)))) + (if (null errors) + (cons 'success loaded-count) + (cons 'error (list loaded-count (nreverse errors)))))) + (defun cj/test-load-all () "Load all test files from the appropriate test directory." (interactive) @@ -76,21 +142,27 @@ Falls back to =cj/test-global-directory= if not found or not in a project." (let ((dir (cj/test--get-test-directory))) (unless (file-directory-p dir) (user-error "Test directory %s does not exist" dir)) - (let ((test-files (directory-files dir t "^test-.*\\.el$")) - (loaded-count 0)) - (dolist (file test-files) - (condition-case err - (progn - (load-file file) - (setq loaded-count (1+ loaded-count)) - (message "Loaded test file: %s" (file-name-nondirectory file))) - (error - (message "Error loading %s: %s" - (file-name-nondirectory file) - (error-message-string err))))) - (message "Loaded %d test file(s)" loaded-count)))) - -;;;###autoload + (let ((test-files (directory-files dir t "^test-.*\\.el$"))) + (pcase (cj/test--do-load-files dir test-files) + (`(success . ,count) + (message "Loaded %d test file(s)" count)) + (`(error ,count ,errors) + (dolist (err errors) + (message "Error loading %s: %s" (car err) (cdr err))) + (message "Loaded %d test file(s) with %d error(s)" count (length errors))))))) + +(defun cj/test--do-focus-add (filename available-files focused-files) + "Add FILENAME to focused test files. +AVAILABLE-FILES is the list of all available test files. +FOCUSED-FILES is the current list of focused files. +Returns: \\='success if added successfully, + \\='already-focused if file is already focused, + \\='not-available if file is not in available-files." + (cond + ((not (member filename available-files)) 'not-available) + ((member filename focused-files) 'already-focused) + (t 'success))) + (defun cj/test-focus-add () "Select test file(s) to add to the focused list." (interactive) @@ -109,30 +181,64 @@ Falls back to =cj/test-global-directory= if not found or not in a project." unfocused-files nil t) (user-error "All test files are already focused")))) - (push selected cj/test-focused-files) - (message "Added to focus: %s" selected) - (when (called-interactively-p 'interactive) - (cj/test-view-focused)))))) + (pcase (cj/test--do-focus-add selected available-files cj/test-focused-files) + ('success + (push selected cj/test-focused-files) + (message "Added to focus: %s" selected) + (when (called-interactively-p 'interactive) + (cj/test-view-focused))) + ('already-focused + (message "Already focused: %s" selected)) + ('not-available + (user-error "File not available: %s" selected))))))) + +(defun cj/test--do-focus-add-file (filepath testdir focused-files) + "Validate and add FILEPATH to focused list. +TESTDIR is the test directory path. +FOCUSED-FILES is the current list of focused files. +Returns: \\='success if added successfully, + \\='no-file if filepath is nil, + \\='not-in-testdir if file is not inside test directory, + \\='already-focused if file is already focused. +Second value is the relative filename if successful." + (cond + ((null filepath) (cons 'no-file nil)) + ((not (string-prefix-p (file-truename testdir) (file-truename filepath))) + (cons 'not-in-testdir nil)) + (t + (let ((relative (file-relative-name filepath testdir))) + (if (member relative focused-files) + (cons 'already-focused relative) + (cons 'success relative)))))) -;;;###autoload (defun cj/test-focus-add-this-buffer-file () "Add the current buffer's file to the focused test list." (interactive) (let ((file (buffer-file-name)) (dir (cj/test--get-test-directory))) - (unless file - (user-error "Current buffer is not visiting a file")) - (unless (string-prefix-p (file-truename dir) (file-truename file)) - (user-error "File is not inside the test directory: %s" dir)) - (let ((relative (file-relative-name file dir))) - (if (member relative cj/test-focused-files) - (message "Already focused: %s" relative) - (push relative cj/test-focused-files) - (message "Added to focus: %s" relative) - (when (called-interactively-p 'interactive) - (cj/test-view-focused)))))) - -;;;###autoload + (pcase (cj/test--do-focus-add-file file dir cj/test-focused-files) + (`(no-file . ,_) + (user-error "Current buffer is not visiting a file")) + (`(not-in-testdir . ,_) + (user-error "File is not inside the test directory: %s" dir)) + (`(already-focused . ,relative) + (message "Already focused: %s" relative)) + (`(success . ,relative) + (push relative cj/test-focused-files) + (message "Added to focus: %s" relative) + (when (called-interactively-p 'interactive) + (cj/test-view-focused)))))) + +(defun cj/test--do-focus-remove (filename focused-files) + "Remove FILENAME from FOCUSED-FILES. +Returns: \\='success if removed successfully, + \\='empty-list if focused-files is empty, + \\='not-found if filename is not in focused-files." + (cond + ((null focused-files) 'empty-list) + ((not (member filename focused-files)) 'not-found) + (t 'success))) + (defun cj/test-focus-remove () "Remove a test file from the focused list." (interactive) @@ -141,13 +247,18 @@ Falls back to =cj/test-global-directory= if not found or not in a project." (let ((selected (completing-read "Remove from focus: " cj/test-focused-files nil t))) - (setq cj/test-focused-files - (delete selected cj/test-focused-files)) - (message "Removed from focus: %s" selected) - (when (called-interactively-p 'interactive) - (cj/test-view-focused))))) + (pcase (cj/test--do-focus-remove selected cj/test-focused-files) + ('success + (setq cj/test-focused-files + (delete selected cj/test-focused-files)) + (message "Removed from focus: %s" selected) + (when (called-interactively-p 'interactive) + (cj/test-view-focused))) + ('not-found + (message "File not in focused list: %s" selected)) + ('empty-list + (user-error "No focused files to remove")))))) -;;;###autoload (defun cj/test-focus-clear () "Clear all focused test files." (interactive) @@ -168,73 +279,82 @@ Returns a list of test name symbols defined in the file." (push (match-string 1) test-names))) test-names)) -;;;###autoload +(defun cj/test--do-get-focused-tests (focused-files test-dir) + "Get test names from FOCUSED-FILES in TEST-DIR. +Returns: (cons \\='success (list test-names loaded-count)) if successful, + (cons \\='no-tests nil) if no tests found, + (cons \\='empty-list nil) if focused-files is empty." + (if (null focused-files) + (cons 'empty-list nil) + (let ((all-test-names '()) + (loaded-count 0)) + (dolist (file focused-files) + (let ((full-path (expand-file-name file test-dir))) + (when (file-exists-p full-path) + (load-file full-path) + (setq loaded-count (1+ loaded-count)) + (let ((test-names (cj/test--extract-test-names full-path))) + (setq all-test-names (append all-test-names test-names)))))) + (if (null all-test-names) + (cons 'no-tests nil) + (cons 'success (list all-test-names loaded-count)))))) + (defun cj/test-run-focused () "Run only the focused test files." (interactive) - (if (null cj/test-focused-files) - (user-error "No focused files set. Use =cj/test-focus-add' first") - (let ((all-test-names '()) - (loaded-count 0) - (dir (cj/test--get-test-directory))) - ;; Load the focused files and collect their test names - (dolist (file cj/test-focused-files) - (let ((full-path (expand-file-name file dir))) - (when (file-exists-p full-path) - (load-file full-path) - (setq loaded-count (1+ loaded-count)) - ;; Extract test names from this file - (let ((test-names (cj/test--extract-test-names full-path))) - (setq all-test-names (append all-test-names test-names)))))) - (if (null all-test-names) - (message "No tests found in focused files") - ;; Build a regexp that matches any of our test names - (let ((pattern (regexp-opt all-test-names))) - (message "Running %d test(s) from %d focused file(s)" - (length all-test-names) loaded-count) - ;; Run only the tests we found - (ert (concat "^" pattern "$"))))))) + (let ((dir (cj/test--get-test-directory))) + (pcase (cj/test--do-get-focused-tests cj/test-focused-files dir) + (`(empty-list . ,_) + (user-error "No focused files set. Use =cj/test-focus-add' first")) + (`(no-tests . ,_) + (message "No tests found in focused files")) + (`(success ,test-names ,loaded-count) + (let ((pattern (regexp-opt test-names))) + (message "Running %d test(s) from %d focused file(s)" + (length test-names) loaded-count) + (ert (concat "^" pattern "$"))))))) (defun cj/test--ensure-test-dir-in-load-path () - "Ensure the directory returned by cj/test--get-test-directory is in `load-path`." + "Ensure test directory is in `load-path'." (let ((dir (cj/test--get-test-directory))) (when (and dir (file-directory-p dir)) (add-to-list 'load-path dir)))) -;;;###autoload +(defun cj/test--extract-test-at-pos () + "Extract test name at current position. +Returns: test name symbol if found, nil otherwise." + (save-excursion + (beginning-of-defun) + (condition-case nil + (let ((form (read (current-buffer)))) + (when (and (listp form) + (eq (car form) 'ert-deftest) + (symbolp (cadr form))) + (cadr form))) + (error nil)))) + (defun cj/run-test-at-point () "Run the ERT test at point. If point is inside an `ert-deftest` definition, run that test only. Otherwise, message that no test is found." (interactive) - (let ((original-point (point))) - (save-excursion - (beginning-of-defun) - (condition-case nil - (let ((form (read (current-buffer)))) - (if (and (listp form) - (eq (car form) 'ert-deftest) - (symbolp (cadr form))) - (ert (cadr form)) - (message "Not in an ERT test method."))) - (error (message "No ERT test methods found at point.")))) - (goto-char original-point))) - -;;;###autoload + (let ((test-name (cj/test--extract-test-at-pos))) + (if test-name + (ert test-name) + (message "Not in an ERT test method.")))) + (defun cj/test-run-all () "Load and run all tests." (interactive) (cj/test-load-all) (ert t)) -;;;###autoload (defun cj/test-toggle-mode () - "Toggle between 'all and 'focused test execution modes." + "Toggle between \\='all and \\='focused test execution modes." (interactive) (setq cj/test-mode (if (eq cj/test-mode 'all) 'focused 'all)) (message "Test mode: %s" cj/test-mode)) -;;;###autoload (defun cj/test-view-focused () "Display test files in focus." (interactive) @@ -243,7 +363,6 @@ Otherwise, message that no test is found." (message "Focused files: %s" (mapconcat 'identity cj/test-focused-files ", ")))) -;;;###autoload (defun cj/test-run-smart () "Run tests based on current mode (all or focused)." (interactive) @@ -265,8 +384,20 @@ Otherwise, message that no test is found." "t" #'cj/test-toggle-mode) (keymap-set cj/custom-keymap "t" cj/testrunner-map) + +;; which-key integration (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; t" "test runner menu")) + (which-key-add-key-based-replacements + "C-; t" "test runner menu" + "C-; t L" "load all tests" + "C-; t R" "run all tests" + "C-; t r" "run smart" + "C-; t ." "run test at point" + "C-; t a" "add to focus" + "C-; t b" "add buffer to focus" + "C-; t c" "clear focus" + "C-; t v" "view focused" + "C-; t t" "toggle mode")) (provide 'test-runner) ;;; test-runner.el ends here diff --git a/modules/text-config.el b/modules/text-config.el index 730e36a3..29db9e0b 100644 --- a/modules/text-config.el +++ b/modules/text-config.el @@ -46,8 +46,7 @@ ;; change inner and outer, just like in vim. (use-package change-inner - :bind (("C-c i" . change-inner) - ("C-c o" . change-outer))) + :commands (change-inner change-outer)) ;; ------------------------------ Delete Selection ----------------------------- ;; delete the region on character insertion diff --git a/modules/vc-config.el b/modules/vc-config.el index 3b116cc1..a936e890 100644 --- a/modules/vc-config.el +++ b/modules/vc-config.el @@ -131,7 +131,16 @@ (keymap-set cj/custom-keymap "v" cj/vc-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; v" "version control menu")) + (which-key-add-key-based-replacements + "C-; v" "version control menu" + "C-; v d" "goto diff hunks" + "C-; v c" "create issue" + "C-; v f" "forge pull" + "C-; v i" "list issues" + "C-; v n" "next hunk" + "C-; v p" "previous hunk" + "C-; v r" "list pull requests" + "C-; v t" "git timemachine")) (provide 'vc-config) ;;; vc-config.el ends here. diff --git a/modules/video-audio-recording.el b/modules/video-audio-recording.el index fa4c2926..73f782f6 100644 --- a/modules/video-audio-recording.el +++ b/modules/video-audio-recording.el @@ -227,5 +227,14 @@ Otherwise use the default location in `audio-recordings-dir'." (keymap-set cj/custom-keymap "r" cj/record-map) +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-; r" "recording menu" + "C-; r v" "start video" + "C-; r V" "stop video" + "C-; r a" "start audio" + "C-; r A" "stop audio" + "C-; r l" "adjust levels")) + (provide 'video-audio-recording) ;;; video-audio-recording.el ends here. diff --git a/modules/weather-config.el b/modules/weather-config.el index 526a0b41..31fb1b70 100644 --- a/modules/weather-config.el +++ b/modules/weather-config.el @@ -11,9 +11,8 @@ ;; ----------------------------------- Wttrin ---------------------------------- (use-package wttrin + :vc (:url "https://github.com/cjennings/emacs-wttrin" :rev :newest) :defer t - :load-path ("~/code/wttrin") - :ensure nil ;; local package :preface ;; dependency for wttrin (use-package xterm-color diff --git a/modules/wip.el b/modules/wip.el index 314881d2..93c799fb 100644 --- a/modules/wip.el +++ b/modules/wip.el @@ -14,134 +14,6 @@ ;; ;;; Code: -(eval-when-compile (require 'user-constants)) -(eval-when-compile (require 'keybindings)) -(eval-when-compile (require 'subr-x)) ;; for system commands -(require 'rx) ;; for system commands - -;; ------------------------------ System Commands ------------------------------ - -(defun cj/system-cmd--resolve (cmd) - "Return (values symbol-or-nil command-string label) for CMD." - (cond - ((symbolp cmd) - (let ((val (and (boundp cmd) (symbol-value cmd)))) - (unless (and (stringp val) (not (string-empty-p val))) - (user-error "Variable %s is not a non-empty string" cmd)) - (list cmd val (symbol-name cmd)))) - ((stringp cmd) - (let ((s (string-trim cmd))) - (when (string-empty-p s) (user-error "Command string is empty")) - (list nil s "command"))) - (t (user-error "Error: cj/system-cmd expects a string or a symbol")))) - -;;;###autoload -(defun cj/system-cmd (cmd) - "Run CMD (string or symbol naming a string) detached via the shell. -Shell expansions like $(...) are supported. Output is silenced. -If CMD is deemed dangerous, ask for confirmation." - (interactive (list (read-shell-command "System command: "))) - (pcase-let ((`(,sym ,cmdstr ,label) (cj/system-cmd--resolve cmd))) - (when (and sym (get sym 'cj/system-confirm) - (memq (read-char-choice - (format "Run %s now (%s)? (Y/n) " label camdstr) - '(?y ?Y ?n ?N ?\r ?\n ?\s)) - '(?n ?N))) - (user-error "Aborted")) - (let ((proc (start-process-shell-command "cj/system-cmd" nil - (format "nohup %s >/dev/null 2>&1 &" cmdstr)))) - (set-process-query-on-exit-flag proc nil) - (set-process-sentinel proc #'ignore) - (message "Running %s..." label)))) - -(defmacro cj/defsystem-command (name var cmdstr &optional confirm) - "Define VAR with CMDSTR and interactive command NAME to run it. -If CONFIRM is non-nil, mark VAR to always require confirmation." - (declare (indent defun)) - `(progn - (defvar ,var ,cmdstr) - ,(when confirm `(put ',var 'cj/system-confirm t)) - (defun ,name () - ,(format "Run %s via `cj/system-cmd'." var) - (interactive) - (cj/system-cmd ',var)))) - -;; Define system commands -(cj/defsystem-command cj/system-cmd-logout logout-cmd "loginctl terminate-user $(whoami)" t) -(cj/defsystem-command cj/system-cmd-lock lockscreen-cmd "slock") -(cj/defsystem-command cj/system-cmd-suspend suspend-cmd "systemctl suspend" t) -(cj/defsystem-command cj/system-cmd-shutdown shutdown-cmd "systemctl poweroff" t) -(cj/defsystem-command cj/system-cmd-reboot reboot-cmd "systemctl reboot" t) - -(defun cj/system-cmd-exit-emacs () - "Exit Emacs server and all clients." - (interactive) - (when (memq (read-char-choice - "Exit Emacs? (Y/n) " - '(?y ?Y ?n ?N ?\r ?\n ?\s)) - '(?n ?N)) - (user-error "Aborted")) - (kill-emacs)) - -(defun cj/system-cmd-restart-emacs () - "Restart Emacs server after saving buffers." - (interactive) - (when (memq (read-char-choice - "Restart Emacs? (Y/n) " - '(?y ?Y ?n ?N ?\r ?\n ?\s)) - '(?n ?N)) - (user-error "Aborted")) - (save-some-buffers) - ;; Start the restart process before killing Emacs - (run-at-time 0.5 nil - (lambda () - (call-process-shell-command - "systemctl --user restart emacs.service && emacsclient -c" - nil 0))) - (run-at-time 1 nil #'kill-emacs) - (message "Restarting Emacs...")) - -;; (defvar-keymap cj/system-command-map -;; :doc "Keymap for system commands." -;; "L" #'cj/system-cmd-logout -;; "r" #'cj/system-cmd-reboot -;; "s" #'cj/system-cmd-shutdown -;; "S" #'cj/system-cmd-suspend -;; "l" #'cj/system-cmd-lock -;; "E" #'cj/system-cmd-exit-emacs -;; "e" #'cj/system-cmd-restart-emacs) -;; (keymap-set cj/custom-keymap "!" cj/system-command-map) - -(defun cj/system-command-menu () - "Present system commands via \='completing-read\='." - (interactive) - (let* ((commands '(("Logout System" . cj/system-cmd-logout) - ("Lock Screen" . cj/system-cmd-lock) - ("Suspend System" . cj/system-cmd-suspend) - ("Shutdown System" . cj/system-cmd-shutdown) - ("Reboot System" . cj/system-cmd-reboot) - ("Exit Emacs" . cj/system-cmd-exit-emacs) - ("Restart Emacs" . cj/system-cmd-restart-emacs))) - (choice (completing-read "System command: " commands nil t))) - (when-let ((cmd (alist-get choice commands nil nil #'equal))) - (call-interactively cmd)))) - -(keymap-set cj/custom-keymap "!" #'cj/system-command-menu) - - -;; --------------------------- Org Upcoming Modeline --------------------------- - -;; (use-package org-upcoming-modeline -;; :after org -;; :load-path "~/code/org-upcoming-modeline/org-upcoming-modeline.el" -;; :config -;; (setq org-upcoming-modeline-keep-late 300) -;; (setq org-upcoming-modeline-ignored-keywords '("DONE" "CANCELLED" "FAILED")) -;; (setq org-upcoming-modeline-trim 30) -;; (setq org-upcoming-modeline-days-ahead 5) -;; (setq org-upcoming-modeline-format (lambda (ms mh) (format "📅 %s %s" ms mh))) -;; (org-upcoming-modeline-mode)) - ;; ----------------------------------- Efrit ----------------------------------- ;; not working as of Wednesday, September 03, 2025 at 12:44:09 AM CDT @@ -184,30 +56,5 @@ If CONFIRM is non-nil, mark VAR to always require confirmation." :bind ("M-p" . pomm) :commands (pomm pomm-third-time)) -;; ----------------------------------- Popper ---------------------------------- - -;; (use-package popper -;; :bind (("C-`" . popper-toggle) -;; ("M-`" . popper-cycle) -;; ("C-M-`" . popper-toggle-type)) -;; :custom -;; (popper-display-control-nil) -;; :init -;; (setq popper-reference-buffers -;; '("\\*Messages\\*" -;; "Output\\*$" -;; "\\*Async Shell Command\\*" -;; ;; "\\*scratch\\*" -;; help-mode -;; compilation-mode)) -;; (add-to-list 'display-buffer-alist -;; '(popper-display-control-p ; Predicate to match popper buffers -;; (display-buffer-in-side-window) -;; (side . bottom) -;; (slot . 0) -;; (window-height . 0.5))) ; Half the frame height -;; (popper-mode +1) -;; (popper-echo-mode +1)) - (provide 'wip) ;;; wip.el ends here. |