diff options
68 files changed, 991 insertions, 529 deletions
diff --git a/archive/README.org b/archive/README.org new file mode 100644 index 00000000..bbc30a14 --- /dev/null +++ b/archive/README.org @@ -0,0 +1,64 @@ +#+TITLE: Archive — Retired Modules +#+AUTHOR: Craig Jennings + +* What this is + +The pasture upstate. Modules that were once part of the config but are no +longer loaded, kept here instead of deleted so they can be read, mined for +ideas, or brought back later. + +Nothing in this directory is on the Emacs =load-path=, and nothing in the +active config requires anything here. Retiring a file means moving it here and +removing whatever orphaned reference kept pointing at it. Restoring one means +moving it back to =modules/= or =custom/= and re-adding its =require= (or +=use-package=) in =init.el=. + +The directory is tracked in git, so every retired file stays retrievable from +history even after it moves again. + +* The rule this directory enforces + +Every =.el= file *outside* this directory should be of active use — required, +loaded, or otherwise reached by the running config. If a file is never touched, +loaded, or referenced, it belongs here. The candidate list is generated by a +reachability sweep from =init.el= (transitive =require= closure), then checked +by hand for the cases pure requires miss: =use-package= with =:load-path=, +autoloads, and vendored copies shadowed by a package-manager install. + +* Layout + +Retired files keep their origin directory so a restore is a straight move back: + +- =archive/modules/= — retired first-party modules +- =archive/custom/= — retired vendored third-party files +- =archive/tests/= — tests belonging to retired modules +- =archive/gptel/= — the gptel feature subtree, retired as a unit + +* Inventory + +** archive/modules/ + +- =show-kill-ring.el= — kill-ring viewer bound to M-S-k. Its =require= was + dropped in b785a19d and consult-yank-pop covers the same need. Retiring it + also removed the orphaned M-K -> M-S-k translation in =keyboard-compat.el=, + which had been leaving M-K a dead key. +- =duet-config.el= — no reference anywhere in the config. +- =mu4e-org-contacts-setup.el= — nothing requires it; its featurep gate would + be nil at init in any case. The live mu4e contacts wiring lives in + =mu4e-org-contacts-integration.el=. + +** archive/custom/ + +- =eplot.el= — vendored plotting package, unreferenced. +- =profile-dotemacs.el= — startup-profiling tool, unreferenced. +- =titlecase.el= + =titlecase-data.el= — the duckwork/titlecase.el package, + superseded by =custom-case.el='s own =cj/title-case-region=. +- =edit-indirect.el= — a vendored copy of the MELPA package that + =text-config.el= installs (its =use-package= carries no =:ensure nil=). With + this copy off the =load-path=, the MELPA copy loads, which is the intended + one. + +** archive/gptel/ + +The gptel AI-assistant feature, retired as a whole subtree (modules, tests, +tools, custom, and its spec docs) when the config moved off gptel. diff --git a/custom/edit-indirect.el b/archive/custom/edit-indirect.el index 307f9695..307f9695 100644 --- a/custom/edit-indirect.el +++ b/archive/custom/edit-indirect.el diff --git a/custom/eplot.el b/archive/custom/eplot.el index c00a3e31..c00a3e31 100644 --- a/custom/eplot.el +++ b/archive/custom/eplot.el diff --git a/custom/profile-dotemacs.el b/archive/custom/profile-dotemacs.el index 8baee47b..8baee47b 100644 --- a/custom/profile-dotemacs.el +++ b/archive/custom/profile-dotemacs.el diff --git a/custom/titlecase-data.el b/archive/custom/titlecase-data.el index 7415a210..7415a210 100644 --- a/custom/titlecase-data.el +++ b/archive/custom/titlecase-data.el diff --git a/custom/titlecase.el b/archive/custom/titlecase.el index 319befef..319befef 100644 --- a/custom/titlecase.el +++ b/archive/custom/titlecase.el diff --git a/modules/duet-config.el b/archive/modules/duet-config.el index 2dc7ad2e..2dc7ad2e 100644 --- a/modules/duet-config.el +++ b/archive/modules/duet-config.el diff --git a/modules/mu4e-org-contacts-setup.el b/archive/modules/mu4e-org-contacts-setup.el index bfb9b1f2..bfb9b1f2 100644 --- a/modules/mu4e-org-contacts-setup.el +++ b/archive/modules/mu4e-org-contacts-setup.el diff --git a/modules/show-kill-ring.el b/archive/modules/show-kill-ring.el index e65d48b5..e65d48b5 100644 --- a/modules/show-kill-ring.el +++ b/archive/modules/show-kill-ring.el diff --git a/tests/test-show-kill-ring--insert-item.el b/archive/tests/test-show-kill-ring--insert-item.el index a29ca75e..a29ca75e 100644 --- a/tests/test-show-kill-ring--insert-item.el +++ b/archive/tests/test-show-kill-ring--insert-item.el @@ -162,6 +162,7 @@ ;; their own commands via package.el; games-config only supplies malyon's config, ;; so load it when malyon loads rather than requiring it at startup. (with-eval-after-load 'malyon (require 'games-config)) +(require 'takuzu-config) ;; Takuzu (Binairo) puzzle on M-x takuzu; package in ~/code/takuzu ;; ------------------------------- Misc Modules -------------------------------- diff --git a/modules/calendar-sync-source.el b/modules/calendar-sync-source.el index 15c91c59..10dea66e 100644 --- a/modules/calendar-sync-source.el +++ b/modules/calendar-sync-source.el @@ -138,39 +138,25 @@ Checks `cj/debug-modules' for symbol `calendar-sync' or t (all)." ;;; .ics Fetch -(defun calendar-sync--fetch-ics (url callback) - "Fetch .ics file from URL asynchronously using curl. -Calls CALLBACK with the .ics content as string (normalized to Unix line endings) -or nil on error. CALLBACK signature: (lambda (content) ...). - -The fetch happens asynchronously and doesn't block Emacs. The callback is -invoked when the fetch completes, either successfully or with an error." - (condition-case err - (let ((buffer (generate-new-buffer " *calendar-sync-curl*"))) - (make-process - :name "calendar-sync-curl" - :buffer buffer - :command (list "curl" "-s" "-L" "--fail" - "--connect-timeout" "10" - "--max-time" (number-to-string calendar-sync-fetch-timeout) - url) - :sentinel - (lambda (process event) - (when (memq (process-status process) '(exit signal)) - (let ((buf (process-buffer process))) - (when (buffer-live-p buf) - (let ((content - (with-current-buffer buf - (if (and (eq (process-status process) 'exit) - (= (process-exit-status process) 0)) - (calendar-sync--normalize-line-endings (buffer-string)) - (calendar-sync--log-silently "calendar-sync: Fetch error: curl failed: %s" (string-trim event)) - nil)))) - (kill-buffer buf) - (funcall callback content)))))))) - (error - (calendar-sync--log-silently "calendar-sync: Fetch error: %s" (error-message-string err)) - (funcall callback nil)))) +(defun calendar-sync--fetch-sentinel-finish (success event temp-file buffer callback) + "Finish an async .ics fetch. +SUCCESS is non-nil when curl exited cleanly, EVENT the process event +string, TEMP-FILE the curl output path, BUFFER the process buffer, and +CALLBACK the continuation. On success CALLBACK receives TEMP-FILE (the +caller owns deleting it); on failure the error is logged, TEMP-FILE is +removed, and CALLBACK receives nil. Extracted from the sentinel so the +success, failure, and cleanup branches are unit-testable without a live +curl process." + (when (buffer-live-p buffer) + (unless success + (calendar-sync--log-silently "calendar-sync: Fetch error: curl failed: %s" + (string-trim event))) + (kill-buffer buffer)) + (if success + (funcall callback temp-file) + (when (file-exists-p temp-file) + (delete-file temp-file)) + (funcall callback nil))) (defun calendar-sync--fetch-ics-file (url callback) "Fetch .ics from URL to a temp file asynchronously. @@ -190,19 +176,10 @@ owns deleting the temp file after a successful callback." :sentinel (lambda (process event) (when (memq (process-status process) '(exit signal)) - (let ((buf (process-buffer process)) - (success (and (eq (process-status process) 'exit) - (= (process-exit-status process) 0)))) - (when (buffer-live-p buf) - (unless success - (calendar-sync--log-silently "calendar-sync: Fetch error: curl failed: %s" - (string-trim event))) - (kill-buffer buf)) - (if success - (funcall callback temp-file) - (when (file-exists-p temp-file) - (delete-file temp-file)) - (funcall callback nil))))))) + (calendar-sync--fetch-sentinel-finish + (and (eq (process-status process) 'exit) + (= (process-exit-status process) 0)) + event temp-file (process-buffer process) callback))))) (error (calendar-sync--log-silently "calendar-sync: Fetch error: %s" (error-message-string err)) (funcall callback nil)))) diff --git a/modules/custom-buffer-file.el b/modules/custom-buffer-file.el index 25555b53..0ca06cf9 100644 --- a/modules/custom-buffer-file.el +++ b/modules/custom-buffer-file.el @@ -51,8 +51,13 @@ (declare-function ps-print-buffer-with-faces "ps-print") (declare-function ps-print-region-with-faces "ps-print") -;; mm-decode for email viewing (mm-handle-type is a macro, needs early require) -(require 'mm-decode) +;; mm-handle-type is a macro used in `cj/--email-handle-is-type-p', so mm-decode +;; is only needed at compile time here; `cj/view-email-in-buffer' requires it at +;; runtime before any mm-* call, so the eager startup require is unnecessary. +(eval-when-compile (require 'mm-decode)) +(declare-function mm-dissect-buffer "mm-decode") +(declare-function mm-insert-part "mm-decode") +(declare-function mm-destroy-parts "mm-decode") (require 'external-open) ;; for cj/xdg-open, cj/open-this-file-with (require 'system-lib) ;; cj/confirm-strong (overwrite confirms), used below @@ -236,13 +241,16 @@ blast-radius operation on this map. The VC path is not double-prompted: (cj/--delete-buffer-and-file)))))) (defun cj/copy-link-to-buffer-file () - "Copy the full file:// path of the current buffer's source file to the kill ring." + "Copy the full file:// path of the current buffer's source file to the kill ring. +Signal a `user-error' when the buffer is not visiting a file, matching the +other copy commands in this module." (interactive) (let ((file-path (buffer-file-name))) - (when file-path - (setq file-path (concat "file://" file-path)) - (kill-new file-path) - (message "Copied file link to kill ring: %s" file-path)))) + (unless file-path + (user-error "Buffer is not visiting a file")) + (setq file-path (concat "file://" file-path)) + (kill-new file-path) + (message "Copied file link to kill ring: %s" file-path))) (defvar cj/buffer-source-functions '((eww-mode . (lambda () (eww-current-url))) @@ -941,19 +949,24 @@ Signals an error if: (let* ((handle (mm-dissect-buffer t)) (displayable-part (cj/--email-find-displayable-part handle)) (buffer-name (format "*Email: %s*" (file-name-nondirectory buffer-file-name)))) - (unless displayable-part - (user-error "No displayable content found in email")) - (with-current-buffer (get-buffer-create buffer-name) - (let ((inhibit-read-only t)) - (erase-buffer) - (mm-insert-part displayable-part) - (goto-char (point-min)) - (when (cj/--email-handle-is-type-p displayable-part "text/html") - (shr-render-region (point-min) (point-max))) - (goto-char (point-min)) - (special-mode))) - (mm-destroy-parts handle) - (switch-to-buffer buffer-name))) + ;; `mm-dissect-buffer' allocates handles that must be freed even when we + ;; bail out early (no displayable part), so destroy them from the cleanup + ;; form rather than after the body. + (unwind-protect + (progn + (unless displayable-part + (user-error "No displayable content found in email")) + (with-current-buffer (get-buffer-create buffer-name) + (let ((inhibit-read-only t)) + (erase-buffer) + (mm-insert-part displayable-part) + (goto-char (point-min)) + (when (cj/--email-handle-is-type-p displayable-part "text/html") + (shr-render-region (point-min) (point-max))) + (goto-char (point-min)) + (special-mode))) + (switch-to-buffer buffer-name)) + (mm-destroy-parts handle)))) ;; --------------------------- Buffer And File Keymap -------------------------- diff --git a/modules/custom-case.el b/modules/custom-case.el index 87622695..dde2d6c1 100644 --- a/modules/custom-case.el +++ b/modules/custom-case.el @@ -49,13 +49,14 @@ (downcase-region (car bounds) (cdr bounds)) (user-error "No symbol at point"))))) -(defun cj/--title-case-capitalize-word-p (word is-first prev-word-end word-skip chars-skip-reset) +(defun cj/--title-case-capitalize-word-p (word is-first is-last prev-word-end word-skip chars-skip-reset) "Return non-nil when WORD at point should be capitalized in title case. Point is at WORD's first character. WORD is capitalized when it is the first -word (IS-FIRST), is not a minor skip word (in WORD-SKIP), or immediately follows -a skip-reset character (one of CHARS-SKIP-RESET: : ! ?), reached by skipping -blanks back to PREV-WORD-END." +word (IS-FIRST) or the last word (IS-LAST), is not a minor skip word (in +WORD-SKIP), or immediately follows a skip-reset character (one of +CHARS-SKIP-RESET: : ! ? .), reached by skipping blanks back to PREV-WORD-END." (or is-first + is-last (not (member word word-skip)) (save-excursion (and (not (zerop (skip-chars-backward "[:blank:]" prev-word-end))) @@ -67,22 +68,30 @@ Title case is a capitalization convention where major words are capitalized, and most minor words are lowercase. Nouns, verbs (including linking verbs), adjectives, adverbs,pronouns, and all words of four letters or more are considered major words. Short (i.e., three letters or fewer) conjunctions, -short prepositions, and all articles are considered minor words." +short prepositions, and all articles are considered minor words. The first +and last words are always capitalized, and a word following a sentence-ending +period (or a colon, exclamation mark, or question mark) restarts +capitalization even when it is a minor word." (interactive) (let ((beg nil) (end nil) (prev-word-end nil) - ;; Allow capitals for skip characters after this, so: - ;; Warning: An Example - ;; Capitalizes the `An'. - (chars-skip-reset '(?: ?! ??)) + (last-word-start nil) + ;; Restart capitalization for a minor word after one of these, so + ;; "Warning: An Example" capitalizes the "An" and a sentence-ending + ;; period capitalizes the next word ("End. The Next"). + (chars-skip-reset '(?: ?! ?? ?.)) ;; Don't capitalize characters directly after these. e.g. - ;; "Foo-bar" or "Foo\bar" or "Foo's". + ;; "Foo-bar" or "Foo\bar" or "Foo's". A period is here too, so + ;; "3.14" and "foo.bar" are left alone; a period followed by a + ;; blank still restarts via `chars-skip-reset' above. (chars-separator '(?\\ ?- ?' ?.)) (word-chars "[:alnum:]") + ;; "is" and other linking verbs are major words, so they are not in + ;; this minor-word skip list. (word-skip (list "a" "an" "and" "as" "at" "but" "by" - "for" "if" "in" "is" "nor" "of" + "for" "if" "in" "nor" "of" "on" "or" "so" "the" "to" "yet")) (is-first t)) (cond @@ -92,6 +101,15 @@ short prepositions, and all articles are considered minor words." (t (setq beg (line-beginning-position)) (setq end (line-end-position)))) + ;; The last word is always capitalized in title case, so find its start + ;; once: from END, skip back over any trailing non-word chars, then over + ;; the word itself. + (setq last-word-start + (save-excursion + (goto-char end) + (skip-chars-backward (concat "^" word-chars) beg) + (skip-chars-backward word-chars beg) + (point))) (save-excursion ;; work on uppercased text (e.g., headlines) by downcasing first (downcase-region beg end) @@ -112,7 +130,8 @@ short prepositions, and all articles are considered minor words." (unless (string-equal c-orig c-up) (let ((word (buffer-substring-no-properties (point) word-end))) (when (cj/--title-case-capitalize-word-p - word is-first prev-word-end word-skip chars-skip-reset) + word is-first (= (point) last-word-start) + prev-word-end word-skip chars-skip-reset) (delete-region (point) (1+ (point))) (insert c-up)))))) (goto-char word-end) diff --git a/modules/custom-comments.el b/modules/custom-comments.el index a2604a55..73d29b0c 100644 --- a/modules/custom-comments.el +++ b/modules/custom-comments.el @@ -35,19 +35,19 @@ ;; ------------------------------ Comment Reformat ----------------------------- (defun cj/comment-reformat () - "Reformat commented text into a single paragraph." + "Reformat the commented text in the active region into a single paragraph. +Signal a `user-error' when no region is active." (interactive) - (if mark-active - (let ((beg (region-beginning)) - (end (copy-marker (region-end))) - (orig-fill-column fill-column)) - (uncomment-region beg end) - (setq fill-column (- fill-column 3)) - (cj/join-line-or-region) - (comment-region beg end) - (setq fill-column orig-fill-column ))) - ;; if no region - (message "No region was selected. Select the comment lines to reformat.")) + (unless (use-region-p) + (user-error "No region selected: select the comment lines to reformat")) + (let ((beg (region-beginning)) + (end (copy-marker (region-end))) + ;; Dynamically narrow the fill target for the join, then let it + ;; restore itself -- an error mid-join no longer strands fill-column. + (fill-column (- fill-column 3))) + (uncomment-region beg end) + (cj/join-line-or-region) + (comment-region beg end))) ;; ======================== Comment Generation Functions ======================= @@ -95,6 +95,14 @@ LENGTH is the total width of the line." text-length (if (> text-length 0) 2 0)) ; spaces around text 2)) + ;; The right side fills the exact remaining width so the line always + ;; reaches LENGTH. Keying this off text-length parity (as before) left + ;; even-length and empty text two columns short, misaligning stacked + ;; dividers of differing text lengths. + (right-space (- available-width + text-length + (if (> text-length 0) 2 0) + space-on-each-side)) (min-space 2)) ;; Validate we have enough space (when (< space-on-each-side min-space) @@ -108,10 +116,8 @@ LENGTH is the total width of the line." ;; Text with spaces (when (> text-length 0) (insert " " text " ")) - ;; Right decoration (handle odd-length text) - (dotimes (_ (if (= (% text-length 2) 0) - (- space-on-each-side 1) - space-on-each-side)) + ;; Right decoration -- fills the exact remaining width so the line reaches LENGTH. + (dotimes (_ right-space) (insert decoration-char)) ;; Comment end (when (not (string-empty-p cmt-end)) diff --git a/modules/custom-datetime.el b/modules/custom-datetime.el index 0528688c..52e8c2b3 100644 --- a/modules/custom-datetime.el +++ b/modules/custom-datetime.el @@ -51,7 +51,7 @@ See `format-time-string' for possible replacements.") ;; ------------------------------- Sortable Time ------------------------------- -(defvar sortable-time-format "%I:%M:%S %p %Z " +(defvar sortable-time-format "%H:%M:%S %Z " "Format string used by `cj/insert-sortable-time'. See `format-time-string' for possible replacements.") diff --git a/modules/custom-line-paragraph.el b/modules/custom-line-paragraph.el index d29d4125..5d96fe41 100644 --- a/modules/custom-line-paragraph.el +++ b/modules/custom-line-paragraph.el @@ -46,7 +46,10 @@ (when (> (line-number-at-pos) 1) (join-line)) (end-of-line) - (newline))) + ;; Only add a newline at end of buffer. Doing it unconditionally left a + ;; stray blank line when joining a line in the middle of the buffer. + (when (eobp) + (newline)))) (defun cj/join-paragraph () "Join all lines in the current paragraph using `cj/join-line-or-region'." @@ -67,18 +70,27 @@ produce malformed output silently." (> (length comment-start) 0)))) (user-error "Cannot comment in %s: no comment syntax defined" major-mode)) - (let* ((b (if (region-active-p) (region-beginning) (line-beginning-position))) - (e (if (region-active-p) (region-end) (line-end-position))) - (lines (split-string (buffer-substring-no-properties b e) "\n"))) + ;; Normalize the bounds to whole lines: extend to the start of the first + ;; line and the end of the last line the region touches. The old open-line + ;; loop mishandled a region ending mid-line or at beginning-of-line, either + ;; splitting a line or duplicating a stray empty line. + (let* ((rb (if (region-active-p) (region-beginning) (point))) + (re (if (region-active-p) (region-end) (point))) + (beg (save-excursion (goto-char rb) (line-beginning-position))) + (end (save-excursion + (goto-char re) + ;; A region ending exactly at beginning-of-line does not + ;; include that line, so step back to the previous line's end. + (when (and (> re rb) (bolp)) + (backward-char)) + (line-end-position))) + (text (buffer-substring-no-properties beg end))) (save-excursion - (goto-char e) - (dolist (line lines) - (open-line 1) - (forward-line 1) - (insert line) - ;; If the COMMENT prefix argument is non-nil, comment the inserted text - (when comment - (comment-region (line-beginning-position) (line-end-position))))))) + (goto-char end) + (insert "\n" text) + ;; Comment the freshly-inserted copy when the COMMENT prefix arg is set. + (when comment + (comment-region (1+ end) (point)))))) (defun cj/remove-duplicate-lines-region-or-buffer () "Remove duplicate lines in the region or buffer, keeping the first occurrence. @@ -175,9 +187,9 @@ If not on a delimiter, show a message. Respects the current syntax table." (cb (char-before)) ;; Check if on opening paren (open-p (and ca (eq (char-syntax ca) ?\())) - ;; Check if on or just after closing paren - (close-p (or (and ca (eq (char-syntax ca) ?\))) - (and cb (eq (char-syntax cb) ?\)))))) + ;; On a closing paren (point sits on it) vs just after one. + (on-close-p (and ca (eq (char-syntax ca) ?\)))) + (after-close-p (and cb (eq (char-syntax cb) ?\))))) (cond ;; Jump forward from opening (open-p @@ -185,12 +197,19 @@ If not on a delimiter, show a message. Respects the current syntax table." (forward-sexp) (scan-error (message "No matching delimiter: %s" (error-message-string err))))) - ;; Jump backward from closing - (close-p - (condition-case err - (backward-sexp) - (scan-error - (message "No matching delimiter: %s" (error-message-string err))))) + ;; Jump backward from closing to its matching opener. When point is ON + ;; the closer, step past it first so `backward-sexp' spans the whole + ;; expression to the opener rather than the last inner sexp. Restore + ;; point if the delimiter is unmatched. + ((or on-close-p after-close-p) + (let ((start (point))) + (condition-case err + (progn + (when on-close-p (forward-char)) + (backward-sexp)) + (scan-error + (goto-char start) + (message "No matching delimiter: %s" (error-message-string err)))))) ;; Not on delimiter (t (message "Point is not on a delimiter."))))) diff --git a/modules/custom-ordering.el b/modules/custom-ordering.el index 4dc5bff8..71477948 100644 --- a/modules/custom-ordering.el +++ b/modules/custom-ordering.el @@ -145,8 +145,15 @@ START and END identify the active region." START and END define the region to operate on. Returns the transformed string without modifying the buffer." (cj/--ordering-validate-region start end) - (let ((lines (split-string (buffer-substring start end) "\n"))) - (mapconcat #'identity (nreverse lines) "\n"))) + ;; Strip a trailing newline before splitting so it doesn't become a spurious + ;; empty line (which reversing would float to the top); reattach it after. + ;; Internal blank lines are preserved. + (let* ((raw (buffer-substring start end)) + (trailing-newline (string-suffix-p "\n" raw)) + (body (if trailing-newline (substring raw 0 -1) raw)) + (lines (split-string body "\n"))) + (concat (mapconcat #'identity (nreverse lines) "\n") + (if trailing-newline "\n" "")))) (defun cj/reverse-lines (start end) "Reverse the order of lines in region between START and END. @@ -164,20 +171,28 @@ 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." (cj/--ordering-validate-region start end) - (let* ((lines (split-string (buffer-substring start end) "\n")) + ;; Strip a trailing newline before splitting so it doesn't become a spurious + ;; extra numbered empty line; reattach it after. Internal blank lines are + ;; preserved and numbered. + (let* ((raw (buffer-substring start end)) + (trailing-newline (string-suffix-p "\n" raw)) + (body (if trailing-newline (substring raw 0 -1) raw)) + (lines (split-string body "\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"))) + (concat + (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") + (if trailing-newline "\n" "")))) (defun cj/number-lines (start end format-string zero-pad) "Number lines in region between START and END with custom format. diff --git a/modules/custom-text-enclose.el b/modules/custom-text-enclose.el index 4d72347d..12d2deaf 100644 --- a/modules/custom-text-enclose.el +++ b/modules/custom-text-enclose.el @@ -180,9 +180,14 @@ Returns the indented text without modifying the buffer." (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") +COUNT is the numeric prefix argument, defaulting to 4 with no prefix. +USE-TABS non-nil indents with tabs instead of spaces; interactively it +follows the buffer's `indent-tabs-mode', so the prefix argument is free to +mean the count. Call it from Lisp with an explicit USE-TABS to override." + (interactive (list (if current-prefix-arg + (prefix-numeric-value current-prefix-arg) + 4) + indent-tabs-mode)) (let* ((bounds (cj/--region-or-buffer-bounds)) (start-pos (car bounds)) (end-pos (cdr bounds)) @@ -224,9 +229,11 @@ Returns the dedented text without modifying the buffer." (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). +COUNT is the numeric prefix argument, defaulting to 4 with no prefix. Works on region if active, otherwise entire buffer." - (interactive "p") + (interactive (list (if current-prefix-arg + (prefix-numeric-value current-prefix-arg) + 4))) (let* ((bounds (cj/--region-or-buffer-bounds)) (start-pos (car bounds)) (end-pos (cdr bounds)) diff --git a/modules/flyspell-and-abbrev.el b/modules/flyspell-and-abbrev.el index b73bfdf3..ebe4898e 100644 --- a/modules/flyspell-and-abbrev.el +++ b/modules/flyspell-and-abbrev.el @@ -197,9 +197,10 @@ Without prefix argument, it's created in the global abbrev table. Press C-' repeatedly to step through misspellings one at a time." (interactive "P") (cj/--require-spell-checker) - ;; Run flyspell-buffer only if buffer hasn't been checked yet - (unless (bound-and-true-p flyspell-mode) - (flyspell-buffer)) + ;; Enable Flyspell for the buffer type so the mode sticks and the buffer is + ;; scanned once. A bare flyspell-buffer here never turned the mode on, so + ;; the guard never tripped and every C-' press re-scanned the whole buffer. + (cj/flyspell-on-for-buffer-type) (let ((misspelled-word (cj/flyspell-goto-previous-misspelling (point)))) (if (not misspelled-word) diff --git a/modules/font-config.el b/modules/font-config.el index 3aa3d80f..e5afb361 100644 --- a/modules/font-config.el +++ b/modules/font-config.el @@ -210,6 +210,15 @@ the fontset repeatedly is harmless, so it can be called from ;; ---------------------------------- Emojify ---------------------------------- ;; converts emoji identifiers into emojis; allows for easy emoji entry. +(defvar emojify-display-style) ;; emojify's, forward-declared for the helper + +(defun cj/set-emojify-display-style () + "Set `emojify-display-style' to `image' on a graphical frame, else `unicode'. +Image emoji only render on a GUI frame. In daemon mode no GUI frame exists when +emojify loads, so this runs per-frame from `server-after-make-frame-hook'; +otherwise the value would latch to `unicode' and GUI frames never get images." + (setq emojify-display-style (if (env-gui-p) 'image 'unicode))) + (use-package emojify :defer 1 :hook ((erc-mode . emojify-mode)) @@ -221,7 +230,11 @@ the fontset repeatedly is harmless, so it can be called from :config (setq emojify-show-help nil) (setq emojify-point-entered-behaviour 'uncover) - (setq emojify-display-style (if (env-gui-p) 'image 'unicode)) + ;; In daemon mode `env-gui-p' is nil at :config time (no GUI frame yet), so + ;; recompute the display style per-frame; otherwise set it now. + (if (daemonp) + (add-hook 'server-after-make-frame-hook #'cj/set-emojify-display-style) + (cj/set-emojify-display-style)) (setq emojify-emoji-styles '(ascii unicode github)) ;; Disable emojify in programming modes @@ -242,21 +255,24 @@ the fontset repeatedly is harmless, so it can be called from (let ((font-list (font-family-list))) (setq font-list (cl-remove-duplicates (cl-sort font-list 'string-lessp :key 'downcase))) (with-current-buffer "*Available Fonts*" - (erase-buffer) - (dolist (font-family font-list) - (insert (propertize (concat font-family) 'face '(font-lock-keyword-face (:weight bold)))) - (insert (concat "\n"(propertize "Regular: "))) - (insert (propertize (concat "The quick brown fox jumps over the lazy dog I 1 l ! : ; . , 0 O o [ { ( ) } ] ?") - 'face `((:family, font-family)))) - (insert (concat "\n" (propertize "Bold: "))) - (insert (propertize (concat "The quick brown fox jumps over the lazy dog I 1 l ! : ; . , 0 O o [ { ( ) } ] ?") - 'face `((:family, font-family :weight bold)))) - (insert (concat "\n" (propertize "Italic: "))) - (insert (propertize (concat "The quick brown fox jumps over the lazy dog I 1 l ! : ; . , 0 O o [ { ( ) } ] ?") - 'face `((:family, font-family :slant italic)))) - (insert (concat "\n\n")))) - (move-to-window-line 0) - (special-mode))) + ;; The buffer is left in `special-mode' (read-only) after the first call, + ;; so re-running must relax read-only to erase and rewrite it. + (let ((inhibit-read-only t)) + (erase-buffer) + (dolist (font-family font-list) + (insert (propertize (concat font-family) 'face '(font-lock-keyword-face (:weight bold)))) + (insert (concat "\n"(propertize "Regular: "))) + (insert (propertize (concat "The quick brown fox jumps over the lazy dog I 1 l ! : ; . , 0 O o [ { ( ) } ] ?") + 'face `((:family, font-family)))) + (insert (concat "\n" (propertize "Bold: "))) + (insert (propertize (concat "The quick brown fox jumps over the lazy dog I 1 l ! : ; . , 0 O o [ { ( ) } ] ?") + 'face `((:family, font-family :weight bold)))) + (insert (concat "\n" (propertize "Italic: "))) + (insert (propertize (concat "The quick brown fox jumps over the lazy dog I 1 l ! : ; . , 0 O o [ { ( ) } ] ?") + 'face `((:family, font-family :slant italic)))) + (insert (concat "\n\n")))) + (move-to-window-line 0) + (special-mode)))) (keymap-global-set "C-z F" #'cj/display-available-fonts) diff --git a/modules/keyboard-compat.el b/modules/keyboard-compat.el index b72362e7..73138ca5 100644 --- a/modules/keyboard-compat.el +++ b/modules/keyboard-compat.el @@ -98,8 +98,7 @@ Meta+Shift+letter triggers M-S-letter keybindings." (define-key key-translation-map (kbd "M-D") (kbd "M-S-d")) (define-key key-translation-map (kbd "M-I") (kbd "M-S-i")) (define-key key-translation-map (kbd "M-C") (kbd "M-S-c")) - (define-key key-translation-map (kbd "M-B") (kbd "M-S-b")) - (define-key key-translation-map (kbd "M-K") (kbd "M-S-k")))) + (define-key key-translation-map (kbd "M-B") (kbd "M-S-b")))) ;; In daemon mode, no frame exists at startup so env-gui-p returns nil. ;; Use server-after-make-frame-hook to set up translations when the first diff --git a/modules/keyboard-macros.el b/modules/keyboard-macros.el index 4e801096..bca36eed 100644 --- a/modules/keyboard-macros.el +++ b/modules/keyboard-macros.el @@ -43,7 +43,7 @@ ;;; Code: (require 'subr-x) ;; for string-trim -(eval-when-compile (require 'user-constants)) +(require 'user-constants) ;; for macros-file, read at runtime (defvar cj/macros-loaded nil "Whether saved keyboard macros have been loaded from file.") @@ -130,15 +130,7 @@ With prefix arg, open the macros file for editing after saving." (keymap-global-set "C-<f3>" #'cj/kbd-macro-start-or-end) (keymap-global-set "<f3>" #'call-last-kbd-macro) (keymap-global-set "M-<f3>" #'cj/save-maybe-edit-macro) - (keymap-global-set "s-<f3>" #'cj/open-macros-file) - (add-hook 'kill-emacs-hook #'cj/save-last-kbd-macro-on-exit)) - -;; Add hook to save any unnamed macros on exit if desired -(defun cj/save-last-kbd-macro-on-exit () - "Save the last keyboard macro before exiting Emacs if it's not saved." - (when last-kbd-macro - (when (y-or-n-p "Save last keyboard macro before exiting? ") - (call-interactively #'cj/save-maybe-edit-macro)))) + (keymap-global-set "s-<f3>" #'cj/open-macros-file)) ;; Auto-call setup after init (if after-init-time diff --git a/modules/local-repository.el b/modules/local-repository.el index e3c7a227..0f2c981c 100644 --- a/modules/local-repository.el +++ b/modules/local-repository.el @@ -6,72 +6,28 @@ ;; Layer: 4 (Optional). ;; Category: O/D/P. ;; Load shape: eager. -;; Eager reason: none; local package mirror commands can autoload. +;; Eager reason: none; the mirror-refresh command can autoload. ;; Top-level side effects: none. ;; Runtime requires: elpa-mirror when updating the mirror. ;; Direct test load: yes. ;; -;; Adds the checked-in local package archive to package-archives with high -;; priority, and provides a command to refresh that archive from installed -;; packages via elpa-mirror. +;; Provides a command to refresh the checked-in local package archive from the +;; installed packages via elpa-mirror. Adding that archive to package-archives +;; is owned by early-init.el (see `localrepo-location'); this module only +;; refreshes it. ;;; Code: (require 'elpa-mirror nil t) ;; optional; cj/update-localrepo-repository fails at call-time if absent (declare-function elpamr-create-mirror-for-installed "elpa-mirror") - -;; ------------------------------ Utility Function ----------------------------- - - -(defun localrepo--car-member (value list) - "Check if VALUE exists as the car of any cons cell in LIST." - (member value (mapcar #'car list))) - -;; ------------------------------- Customizations ------------------------------ - -(defgroup localrepo nil - "Local last-known-good package repository." - :group 'package) - -(defcustom localrepo-repository-id "localrepo" - "The name used to identify the local repository internally. - -Used for the package-archive and package-archive-priorities lists." - :type 'string - :group 'localrepo) - -(defcustom localrepo-repository-priority 100 - "The value for the local repository in the package-archive-priority list. - -A higher value means higher priority. If you want your local packages to be -preferred, this must be a higher number than any other repositories." - :type 'integer - :group 'localrepo) - -(defcustom localrepo-repository-location - (concat user-emacs-directory "/.localrepo") - "The location of the local repository. - -It's a good idea to keep this with the rest of your configuration files and -keep them in source control." - :type 'directory - :group 'localrepo) +(defvar localrepo-location) ;; defconst in early-init.el: the archive path (defun cj/update-localrepo-repository () - "Update the local repository with currently installed packages." + "Update the local repository with currently installed packages. +Targets `localrepo-location', the archive path early-init.el sets up." (interactive) - (elpamr-create-mirror-for-installed localrepo-repository-location t)) - -(defun localrepo-initialize () -"Add the repository to the package archives, then gives it a high priority." - (unless (localrepo--car-member localrepo-repository-id package-archives) - (add-to-list 'package-archives - (cons localrepo-repository-id localrepo-repository-location))) - - (unless (localrepo--car-member localrepo-repository-id package-archive-priorities) - (add-to-list 'package-archive-priorities - (cons localrepo-repository-id localrepo-repository-priority)))) + (elpamr-create-mirror-for-installed localrepo-location t)) (provide 'local-repository) ;;; local-repository.el ends here. diff --git a/modules/lorem-optimum.el b/modules/lorem-optimum.el index 8aa96345..14f1d666 100644 --- a/modules/lorem-optimum.el +++ b/modules/lorem-optimum.el @@ -219,8 +219,22 @@ Builds and caches the keys list lazily if not already cached." (message "Lorem-optimum learned from file: %s" file)) (defun cj/lipsum (n) - "Return N words of lorem ipsum." - (cj/markov-generate cj/lipsum-chain n '("Lorem" "ipsum"))) + "Return N words of lorem ipsum. +Interactively, prompt for N and echo the generated words. + +Signal a `user-error' when the Markov chain is empty (for example when the +training file `cj/lipsum-default-file' is missing). Without this, callers +such as `cj/lipsum-insert' would insert nil and raise a cryptic wrong-type +error far from the cause. Train the chain with `cj/lipsum-learn-file', +`cj/lipsum-learn-buffer', or `cj/lipsum-learn-region', or restore the file." + (interactive "nNumber of words: ") + (let ((text (cj/markov-generate cj/lipsum-chain n '("Lorem" "ipsum")))) + (unless (and (stringp text) (not (string-empty-p text))) + (user-error "Lorem-optimum chain is empty; train it with cj/lipsum-learn-file or restore %s" + cj/lipsum-default-file)) + (when (called-interactively-p 'any) + (message "%s" text)) + text)) (defun cj/lipsum-insert (n) "Insert N words of lorem ipsum at point." diff --git a/modules/org-agenda-config.el b/modules/org-agenda-config.el index 207c286e..d4407b28 100644 --- a/modules/org-agenda-config.el +++ b/modules/org-agenda-config.el @@ -50,10 +50,10 @@ :demand t :config (setq org-agenda-prefix-format '((agenda . " %i %-25:c%?-12t% s") - (timeline . " % s") (todo . " %i %-25:c") (tags . " %i %-12:c") (search . " %i %-12:c"))) + (setq org-agenda-timegrid-use-ampm t) ;; show the agenda time grid in 12-hour am/pm (setq org-agenda-dim-blocked-tasks 'invisible) (setq org-agenda-skip-scheduled-if-done nil) (setq org-agenda-remove-tags t) diff --git a/modules/org-babel-config.el b/modules/org-babel-config.el index 79661013..51919da1 100644 --- a/modules/org-babel-config.el +++ b/modules/org-babel-config.el @@ -173,8 +173,5 @@ session when working in trusted files, and back on when done." ;; requires ob-racket, not yet in repositories ;; (add-to-list 'org-structure-template-alist '("sicp" . "src racket :lang sicp")) -;; drop Org’s default footnote list at the end -(setq org-html-footnote-separator "") - (provide 'org-babel-config) ;;; org-babel-config.el ends here. diff --git a/modules/org-contacts-config.el b/modules/org-contacts-config.el index 944d75c1..39ff9910 100644 --- a/modules/org-contacts-config.el +++ b/modules/org-contacts-config.el @@ -170,29 +170,40 @@ Added: %U" (require 'system-lib) +(defun cj/--org-contacts-collect (buffer) + "Return an alist of (NAME POSITION INFO) for the contact headings in BUFFER. +NAME is the heading text, POSITION its buffer position, and INFO the +EMAIL or PHONE property value (or nil)." + (with-current-buffer buffer + (org-map-entries + (lambda () + (list (nth 4 (org-heading-components)) + (point) + (or (org-entry-get nil "EMAIL") + (org-entry-get nil "PHONE")))) + nil nil))) + (defun cj/org-contacts-find () - "Find and open a contact." + "Find a contact and jump to its heading. +Collect the contact headings before prompting, so cancelling the prompt +leaves point where it was, and jump to the selected heading's stored +position instead of a text search that could land inside another entry." (interactive) - (find-file contacts-file) - (goto-char (point-min)) - (let* ((alist (org-map-entries - (lambda () - (cons (nth 4 (org-heading-components)) - (or (org-entry-get nil "EMAIL") - (org-entry-get nil "PHONE")))) - nil (list contacts-file))) + (let* ((buf (find-file-noselect contacts-file)) + (alist (cj/--org-contacts-collect buf)) (contact (completing-read "Find contact: " (cj/completion-table-annotated 'contact (lambda (cand) - (let ((info (cdr (assoc cand alist)))) + (let ((info (nth 2 (assoc cand alist)))) (when (and info (> (length info) 0)) (concat " " (propertize info 'face 'completions-annotations))))) - alist)))) - (goto-char (point-min)) - (search-forward contact) + alist) + nil t))) + (switch-to-buffer buf) + (goto-char (nth 1 (assoc contact alist))) (org-fold-show-entry) (org-reveal))) diff --git a/modules/org-drill-config.el b/modules/org-drill-config.el index 29f6130a..f53f36b9 100644 --- a/modules/org-drill-config.el +++ b/modules/org-drill-config.el @@ -134,25 +134,42 @@ With a prefix arg OTHER-DIR, prompt for the directory instead of `drill-dir'." ;; --------------------------------- Org Drill --------------------------------- -(use-package org-drill - ;; :vc (:url "git@cjennings.net:org-drill.git" - ;; :branch "main" - ;; :rev :newest) - :load-path "~/code/org-drill" ;; local dev checkout — switch back to :vc above when done - :after (org org-capture) - :demand t - :commands (org-drill org-drill-resume) - :custom - (org-drill-leech-failure-threshold 50 "leech cards = 50 wrong answers") - (org-drill-leech-method 'warn "leech cards show warnings") - (org-drill-use-visible-cloze-face-p t "cloze text shows up in a different font") - (org-drill-hide-item-headings-p t "don't show heading text") - (org-drill-maximum-items-per-session 100 "drill sessions end after 100 cards") - (org-drill-maximum-duration 30 "each drill session can last up to 30 mins") - (org-drill-add-random-noise-to-intervals-p t "vary the days to repetition slightly") - (org-drill-text-size-during-session 24 "24-point font for comfortable reading") - (org-drill-use-variable-pitch t "variable-pitch font for readability") - (org-drill-hide-modeline-during-session t "hide the modeline for a cleaner display")) +(defconst cj/org-drill-dev-checkout (expand-file-name "org-drill" "~/code/") + "Local org-drill development checkout, preferred when it exists.") + +(defun cj/--org-drill-source-keywords (&optional checkout) + "Return the use-package source keywords for org-drill. +With CHECKOUT (default `cj/org-drill-dev-checkout') an existing directory, +load from it via :load-path. Otherwise install from upstream via :vc, so +drill still loads on a machine without the dev checkout (bare :load-path + +:demand t would fail to load there)." + (let ((dir (or checkout cj/org-drill-dev-checkout))) + (if (file-directory-p dir) + (list :load-path dir) + (list :vc '(:url "git@cjennings.net:org-drill.git" + :branch "main" + :rev :newest))))) + +;; `use-package' keywords must be literals at macro-expansion, so the +;; source keyword is spliced in through `eval' at load time (same idiom as +;; the computed flycheck checker path elsewhere in the config). +(eval + `(use-package org-drill + ,@(cj/--org-drill-source-keywords) + :after (org org-capture) + :demand t + :commands (org-drill org-drill-resume) + :custom + (org-drill-leech-failure-threshold 50 "leech cards = 50 wrong answers") + (org-drill-leech-method 'warn "leech cards show warnings") + (org-drill-use-visible-cloze-face-p t "cloze text shows up in a different font") + (org-drill-hide-item-headings-p t "don't show heading text") + (org-drill-maximum-items-per-session 100 "drill sessions end after 100 cards") + (org-drill-maximum-duration 30 "each drill session can last up to 30 mins") + (org-drill-add-random-noise-to-intervals-p t "vary the days to repetition slightly") + (org-drill-text-size-during-session 24 "24-point font for comfortable reading") + (org-drill-use-variable-pitch t "variable-pitch font for readability") + (org-drill-hide-modeline-during-session t "hide the modeline for a cleaner display"))) (provide 'org-drill-config) ;;; org-drill-config.el ends here. diff --git a/modules/org-export-config.el b/modules/org-export-config.el index 5a6f09fc..c3d3294c 100644 --- a/modules/org-export-config.el +++ b/modules/org-export-config.el @@ -20,7 +20,6 @@ ;; - HTML: Web publishing with HTML5 support ;; - Markdown: README files and web content ;; - ODT: Office documents for LibreOffice/MS Word -;; - Texinfo: GNU documentation and Info files ;; ;; Extended via Pandoc: ;; - Additional formats: DOCX, self-contained HTML5 @@ -28,7 +27,7 @@ ;; ;; Key features: ;; - UTF-8 encoding enforced across all backends -;; - Subtree export as default scope +;; - Buffer export as default scope ;; ;; Note: reveal.js presentations are handled by org-reveal-config.el (C-; p) ;; @@ -68,17 +67,8 @@ :config (setq org-html-postamble nil) (setq org-html-html5-fancy t) - (setq org-html-head-include-default-style nil)) - - -(use-package ox-texinfo - :ensure nil ; Built into Org - :defer t - :after ox - :config - (setq org-texinfo-coding-system 'utf-8) - (setq org-texinfo-default-class "info") - (add-to-list 'org-export-backends 'texinfo)) + (setq org-html-head-include-default-style nil) + (setq org-html-footnote-separator "")) ;; no separator between adjacent footnote refs (use-package ox-pandoc :defer t diff --git a/modules/org-reveal-config.el b/modules/org-reveal-config.el index be702bf7..f842680b 100644 --- a/modules/org-reveal-config.el +++ b/modules/org-reveal-config.el @@ -8,9 +8,10 @@ ;; Load shape: eager. ;; Eager reason: none; presentation export is a command-loaded deferral ;; candidate for Phase 4. -;; Top-level side effects: package configuration via use-package. -;; Runtime requires: none (configures packages via use-package). -;; Direct test load: yes. +;; Top-level side effects: registers a presentation prefix keymap under +;; cj/custom-keymap; package configuration via use-package. +;; Runtime requires: keybindings. +;; Direct test load: yes (requires keybindings explicitly). ;; ;; Integrates ox-reveal for creating reveal.js presentations from Org files. ;; @@ -28,6 +29,8 @@ ;;; Code: +(require 'keybindings) ;; cj/register-prefix-map, cj/custom-keymap + ;; Forward declarations for byte-compiler (ox-reveal loaded via use-package) (defvar org-reveal-root) (defvar org-reveal-single-file) @@ -238,17 +241,25 @@ reveal.js headers pre-filled." ;; -------------------------------- Keybindings -------------------------------- -(global-set-key (kbd "C-; p SPC") #'cj/reveal-present) -(global-set-key (kbd "C-; p e") #'cj/reveal-export) -(global-set-key (kbd "C-; p p") #'cj/reveal-preview-start) -(global-set-key (kbd "C-; p s") #'cj/reveal-preview-stop) -(global-set-key (kbd "C-; p h") #'cj/reveal-insert-header) -(global-set-key (kbd "C-; p H") #'cj/reveal-remove-headers) -(global-set-key (kbd "C-; p n") #'cj/reveal-new) +;; A registered prefix keymap, not raw `global-set-key' chains: binding +;; "C-; p ..." directly depends on keybindings.el having already made "C-;" +;; a live prefix (otherwise "non-prefix key" errors), while +;; `cj/register-prefix-map' binds into `cj/custom-keymap' with no load-order +;; dependency beyond requiring keybindings. +(defvar-keymap cj/reveal-map + :doc "Keymap for reveal.js presentation commands." + "SPC" #'cj/reveal-present + "e" #'cj/reveal-export + "p" #'cj/reveal-preview-start + "s" #'cj/reveal-preview-stop + "h" #'cj/reveal-insert-header + "H" #'cj/reveal-remove-headers + "n" #'cj/reveal-new) + +(cj/register-prefix-map "p" cj/reveal-map "presentations") (with-eval-after-load 'which-key (which-key-add-key-based-replacements - "C-; p" "presentations" "C-; p SPC" "present current buffer" "C-; p e" "export & open" "C-; p p" "start live preview" diff --git a/modules/org-roam-config.el b/modules/org-roam-config.el index eca867df..867f2d99 100644 --- a/modules/org-roam-config.el +++ b/modules/org-roam-config.el @@ -34,7 +34,6 @@ ;; External variables, declared special so byte-compilation doesn't treat them ;; as free references/assignments. Owned by org and org-roam-dailies. -(defvar org-agenda-timegrid-use-ampm) (defvar org-roam-dailies-map) (defvar org-last-state) @@ -77,30 +76,27 @@ FILETAGS and TITLE must sit on separate lines so Org parses the :unnarrowed t) ("v" "v2mom" plain - (file ,(concat user-emacs-directory "org-roam-templates/v2mom.org")) + (file ,(concat roam-dir "templates/v2mom.org")) :if-new (file+head "%<%Y%m%d%H%M%S>-${slug}.org" "") :unnarrowed t) ("r" "recipe" plain - (file ,(concat user-emacs-directory "org-roam-templates/recipe.org")) + (file ,(concat roam-dir "templates/recipe.org")) :if-new (file+head "recipes/%<%Y%m%d%H%M%S>-${slug}.org" "") :unnarrowed t) ("t" "topic" plain - (file ,(concat user-emacs-directory "org-roam-templates/topic.org")) + (file ,(concat roam-dir "templates/topic.org")) :if-new (file+head "%<%Y%m%d%H%M%S>-${slug}.org" "") :unnarrowed t))) :bind (("C-c n l" . org-roam-buffer-toggle) ("C-c n f" . org-roam-node-find) - ("C-c n p" . cj/org-roam-find-node-project) ("C-c n i" . org-roam-node-insert) - ("C-c n w" . cj/org-roam-find-node-webclip) :map org-mode-map ("C-M-i" . completion-at-point)) :config ;; org-log-done is set once in org-config.el (cj/org-todo-settings). - (setq org-agenda-timegrid-use-ampm t) ;; Don't build the org-refile targets cache here. org-refile-config.el ;; already schedules it on a 5s idle timer; doing it in org-roam's :config @@ -209,10 +205,17 @@ created in that subdirectory of `org-roam-directory'." (interactive) (cj/org-roam-find-node "Recipe" "r" (concat roam-dir "templates/recipe.org") "recipes/")) + +(defun cj/org-roam-find-node-project () + "List nodes of type \"Project\" in completing read for selection or creation." + (interactive) + (cj/org-roam-find-node "Project" "p" (concat roam-dir "templates/project.org"))) + ;; Bound after their defuns (not in the use-package :bind) so the byte-compiler ;; doesn't see both a :bind autoload and the real defun as two definitions. (keymap-global-set "C-c n r" #'cj/org-roam-find-node-recipe) (keymap-global-set "C-c n t" #'cj/org-roam-find-node-topic) +(keymap-global-set "C-c n p" #'cj/org-roam-find-node-project) ;; ---------------------- Org Capture After Finalize Hook ---------------------- @@ -394,36 +397,6 @@ cut stays undoable. A confirmation prompt guards large subtrees (see (org-roam-db-sync) (message "'%s' moved to a new org-roam node (%s)." title filename)))) -;; TASK: Need to decide keybindings before implementation and testing -;; (use-package consult-org-roam -;; :ensure t -;; :after org-roam -;; :init -;; (require 'consult-org-roam) -;; ;; Activate the minor mode -;; (consult-org-roam-mode 1) -;; :custom -;; ;; Use `ripgrep' for searching with `consult-org-roam-search' -;; (consult-org-roam-grep-func #'consult-ripgrep) -;; ;; Configure a custom narrow key for `consult-buffer' -;; (consult-org-roam-buffer-narrow-key ?r) -;; ;; Display org-roam buffers right after non-org-roam buffers -;; ;; in consult-buffer (and not down at the bottom) -;; (consult-org-roam-buffer-after-buffers t) -;; :config -;; ;; Eventually suppress previewing for certain functions -;; (consult-customize -;; consult-org-roam-forward-links -;; :preview-key "M-.") -;; :bind -;; ;; Define some convenient keybindings as an addition -;; ("C-c n e" . consult-org-roam-file-find) -;; ("C-c n b" . consult-org-roam-backlinks) -;; ("C-c n B" . consult-org-roam-backlinks-recursive) -;; ("C-c n l" . consult-org-roam-forward-links) -;; ("C-c n r" . consult-org-roam-search)) - - ;; which-key labels (with-eval-after-load 'which-key (which-key-add-key-based-replacements @@ -434,7 +407,6 @@ cut stays undoable. A confirmation prompt guards large subtrees (see "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")) diff --git a/modules/org-webclipper.el b/modules/org-webclipper.el index 40ceada7..217aecfa 100644 --- a/modules/org-webclipper.el +++ b/modules/org-webclipper.el @@ -186,22 +186,6 @@ Return the yanked content as a string so templates can insert it." ;; extract the webpage content from the kill ring (car kill-ring))) -;; ----------------------------- Webclipper Keymap ----------------------------- - -;; keymaps shouldn't be required for webclipper -;; Setup keymaps -;; -;; (defun cj/webclipper-setup-keymaps () -;; "Setup webclipper keymaps." -;; (define-prefix-command 'cj/webclipper-map nil -;; "Keymap for weblipper operations.") -;; (define-key cj/custom-keymap "c" 'cj/webclipper-map) -;; (define-key cj/webclipper-map "n" 'cj/move-org-branch-to-roam)) - -;; ;; Call keymap setup if cj/custom-keymap is already defined -;; (when (boundp 'cj/custom-keymap) -;; (cj/webclipper-setup-keymaps)) - ;; Register protocol handler early for external calls (with-eval-after-load 'org-protocol (unless (assoc "webclip" org-protocol-protocol-alist) @@ -211,9 +195,5 @@ Return the yanked content as a string so templates can insert it." :function cj/org-protocol-webclip :kill-client t)))) -;; (with-eval-after-load 'cj/custom-keymap -;; (require 'org-webclipper) -;; (cj/webclipper-setup-keymaps)) - (provide 'org-webclipper) ;;; org-webclipper.el ends here diff --git a/modules/selection-framework.el b/modules/selection-framework.el index 7f7f9a47..8e3ee252 100644 --- a/modules/selection-framework.el +++ b/modules/selection-framework.el @@ -41,7 +41,9 @@ (vertico-cycle t) ; Cycle through candidates (vertico-count 10) ; Number of candidates to display (vertico-resize nil) ; Don't resize the minibuffer - (vertico-sort-function #'vertico-sort-history-alpha) ; History first, then alphabetical + ;; Sorting is owned by `vertico-prescient-mode' (frecency). A + ;; `vertico-sort-function' set here is overridden inside every vertico + ;; session, so it is omitted rather than left as dead config. :bind (:map vertico-map ("C-j" . vertico-next) ("C-k" . vertico-previous) diff --git a/modules/takuzu-config.el b/modules/takuzu-config.el new file mode 100644 index 00000000..470aaec8 --- /dev/null +++ b/modules/takuzu-config.el @@ -0,0 +1,17 @@ +;;; takuzu-config.el --- Takuzu (Binairo) game configuration -*- lexical-binding: t -*- + +;;; Commentary: +;; Wire the standalone takuzu game package (developed at ~/code/takuzu). +;; Play with M-x takuzu. Switch to :vc once it is published on GitHub. + +;;; Code: + +(use-package takuzu + :load-path "~/code/takuzu" + :commands (takuzu) + :custom + (takuzu-default-size 6) + (takuzu-default-difficulty 'easy)) + +(provide 'takuzu-config) +;;; takuzu-config.el ends here diff --git a/modules/text-config.el b/modules/text-config.el index dd7bd3ca..a65002a8 100644 --- a/modules/text-config.el +++ b/modules/text-config.el @@ -69,7 +69,7 @@ ;; edit selection in new buffer, C-c to finish; replaces with modifications (use-package edit-indirect - :bind ("M-S-i" . edit-indirect-region)) ;; was M-I + :bind ("M-I" . edit-indirect-region)) ;; ------------------------------ Prettify Symbols ----------------------------- ;; replacing the word l-a-m-b-d-a with a symbol, just because @@ -118,8 +118,8 @@ everything else, such as `lambda', use the standard boundary check." ;; an easy way to enter diacritical marks (use-package accent - :commands accent-company - :bind ("C-`" . accent-company)) + :commands accent-menu + :bind ("C-`" . accent-menu)) (provide 'text-config) ;;; text-config.el ends here diff --git a/modules/ui-config.el b/modules/ui-config.el index fbc3d91c..9ac6faec 100644 --- a/modules/ui-config.el +++ b/modules/ui-config.el @@ -29,9 +29,6 @@ ;; (i.e., read-only, overwrite, normal) ;; – Option to customize cursor shape with 'cj/set-cursor-type' -;; • Icons -;; – Load and enable 'nerd-icons' for UI glyphs - ;; Customize the transparency and cursor color options at the top of this file. ;;; Code: @@ -116,11 +113,5 @@ When `cj/enable-transparency' is nil, reset alpha to fully opaque." ;; burst when entering read-only buffers like EPUBs or vterm). (blink-cursor-mode -1) -;; --------------------------------- Nerd Icons -------------------------------- -;; use icons from nerd fonts in the Emacs UI - -(use-package nerd-icons - :defer t) - (provide 'ui-config) ;;; ui-config.el ends here diff --git a/modules/ui-theme.el b/modules/ui-theme.el index 499e71a4..b3cdc634 100644 --- a/modules/ui-theme.el +++ b/modules/ui-theme.el @@ -88,8 +88,14 @@ If FILENAME isn't readable, return nil." (string-trim (buffer-string))))) (defun cj/theme-write-file-contents (content filename) - "Write CONTENT to FILENAME. -If FILENAME isn't writeable, return nil. If successful, return t." + "Write CONTENT to FILENAME, creating its parent directory if absent. +On a fresh machine the `persist/' directory doesn't exist yet, and +`file-writable-p' returns nil for a file inside a missing directory, so the +write would silently fail. If FILENAME still isn't writeable, return nil. +If successful, return t." + (let ((dir (file-name-directory filename))) + (when (and dir (not (file-directory-p dir))) + (ignore-errors (make-directory dir t)))) (when (file-writable-p filename) (condition-case err (progn diff --git a/modules/undead-buffers.el b/modules/undead-buffers.el index cbd2c0d7..21a04de9 100644 --- a/modules/undead-buffers.el +++ b/modules/undead-buffers.el @@ -65,7 +65,10 @@ regexp in `cj/undead-buffer-regexps'." cj/undead-buffer-regexps)))) (defun cj/kill-buffer-or-bury-alive (buffer) - "Kill BUFFER or bury it if it's in `cj/undead-buffer-list'." + "Kill BUFFER, or bury it when it is in `cj/undead-buffer-list'. +With a prefix argument (e.g. \\`C-u'), instead add BUFFER's name to +`cj/undead-buffer-list' and report it, so the buffer is buried rather than +killed on later kill attempts." (interactive "bBuffer to kill or bury: ") (with-current-buffer buffer (if current-prefix-arg @@ -97,12 +100,15 @@ Undead-buffers are buffers in `cj/undead-buffer-list'." ;; Keybinding moved to custom-buffer-file.el (C-; b k) (defun cj/kill-other-window () - "Delete the next window and kill or bury its buffer." + "Delete the next window and kill or bury its buffer. +Signal a `user-error' in a single-window frame, where there is no other +window and acting would kill the buffer being viewed." (interactive) + (when (one-window-p) + (user-error "No other window")) (other-window 1) (let ((buf (current-buffer))) - (unless (one-window-p) - (delete-window)) + (delete-window) (cj/kill-buffer-or-bury-alive buf))) (keymap-global-set "M-S-o" #'cj/kill-other-window) diff --git a/org-roam-templates/recipe.org b/org-roam-templates/recipe.org deleted file mode 100644 index ed395be1..00000000 --- a/org-roam-templates/recipe.org +++ /dev/null @@ -1,17 +0,0 @@ -#+TITLE: ${title} -#+CATEGORY: ${title} -#+FILETAGS: Recipe -#+STARTUP: showall - -${title} - -* Mise En Place - - -* Execution - - -* Notes - - -* Nutrition diff --git a/org-roam-templates/topic.org b/org-roam-templates/topic.org deleted file mode 100644 index 40a09f79..00000000 --- a/org-roam-templates/topic.org +++ /dev/null @@ -1,7 +0,0 @@ -#+TITLE: ${title} -#+CATEGORY: ${title} -#+FILETAGS: Topic - -* ${title} - - diff --git a/org-roam-templates/v2mom.org b/org-roam-templates/v2mom.org deleted file mode 100644 index 0316299d..00000000 --- a/org-roam-templates/v2mom.org +++ /dev/null @@ -1,40 +0,0 @@ -#+TITLE: ${title} -#+CATEGORY: ${title} -#+FILETAGS: V2MOM - -* Vision -_What do you want to achieve?_ - - -* Values -_What's important about it? What are the principles and beliefs that guide it?_ - -1. -2. -3. - -* Methods -_How will you get it done? What are the key initiatives and actions?_ - -1. -2. -3. -4. -5. - -* Obstacles -_What might prevent success? What challenges must be overcome?_ - -1. - - Mitigation: -2. - - Mitigation: -3. - - Mitigation: - -* Measures -_How will you know when you've succeeded? What are the key metrics?_ - -1. -2. -3. diff --git a/tests/test-calendar-sync-source-fetch-sentinel.el b/tests/test-calendar-sync-source-fetch-sentinel.el new file mode 100644 index 00000000..0b7ba1cf --- /dev/null +++ b/tests/test-calendar-sync-source-fetch-sentinel.el @@ -0,0 +1,72 @@ +;;; test-calendar-sync-source-fetch-sentinel.el --- Tests for the fetch sentinel -*- lexical-binding: t; -*- + +;;; Commentary: +;; calendar-sync--fetch-sentinel-finish is the extracted tail of the async +;; .ics fetch sentinel. The async-worker tests stub the whole fetch, so its +;; success, failure, and temp-file-cleanup branches were never exercised. +;; These tests drive the helper directly with fake success/failure inputs, +;; no live curl process. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'calendar-sync) + +(ert-deftest test-calendar-sync-fetch-sentinel-success-passes-temp-file () + "Normal: on success the callback gets the temp file and it is not deleted." + (let ((temp-file (make-temp-file "calendar-sync-sentinel-" nil ".ics")) + (buffer (generate-new-buffer " *cs-test*")) + (got 'unset)) + (unwind-protect + (progn + (calendar-sync--fetch-sentinel-finish + t "finished\n" temp-file buffer (lambda (r) (setq got r))) + (should (equal got temp-file)) + (should (file-exists-p temp-file)) + (should-not (buffer-live-p buffer))) + (when (file-exists-p temp-file) (delete-file temp-file)) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(ert-deftest test-calendar-sync-fetch-sentinel-failure-deletes-and-passes-nil () + "Error: on failure the temp file is deleted and the callback gets nil." + (let ((temp-file (make-temp-file "calendar-sync-sentinel-" nil ".ics")) + (buffer (generate-new-buffer " *cs-test*")) + (got 'unset) + (logged nil)) + (unwind-protect + (cl-letf (((symbol-function 'calendar-sync--log-silently) + (lambda (&rest _) (setq logged t)))) + (calendar-sync--fetch-sentinel-finish + nil "exited abnormally with code 22\n" temp-file buffer + (lambda (r) (setq got r))) + (should (null got)) + (should-not (file-exists-p temp-file)) + (should logged) + (should-not (buffer-live-p buffer))) + (when (file-exists-p temp-file) (delete-file temp-file)) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(ert-deftest test-calendar-sync-fetch-sentinel-failure-tolerates-missing-temp-file () + "Boundary: failure with the temp file already gone does not error." + (let ((temp-file (make-temp-file "calendar-sync-sentinel-" nil ".ics")) + (got 'unset)) + (delete-file temp-file) + (cl-letf (((symbol-function 'calendar-sync--log-silently) #'ignore)) + (calendar-sync--fetch-sentinel-finish + nil "failed\n" temp-file nil (lambda (r) (setq got r))) + (should (null got))))) + +(ert-deftest test-calendar-sync-fetch-sentinel-tolerates-dead-buffer () + "Boundary: a already-dead process buffer is not touched on success." + (let ((temp-file (make-temp-file "calendar-sync-sentinel-" nil ".ics")) + (got 'unset)) + (unwind-protect + (progn + (calendar-sync--fetch-sentinel-finish + t "finished\n" temp-file nil (lambda (r) (setq got r))) + (should (equal got temp-file))) + (when (file-exists-p temp-file) (delete-file temp-file))))) + +(provide 'test-calendar-sync-source-fetch-sentinel) +;;; test-calendar-sync-source-fetch-sentinel.el ends here diff --git a/tests/test-custom-buffer-file--view-email-in-buffer.el b/tests/test-custom-buffer-file--view-email-in-buffer.el index 99e0e44d..b0209b78 100644 --- a/tests/test-custom-buffer-file--view-email-in-buffer.el +++ b/tests/test-custom-buffer-file--view-email-in-buffer.el @@ -13,6 +13,7 @@ ;;; Code: (require 'ert) +(require 'cl-lib) (require 'testutil-general) (require 'custom-buffer-file) @@ -233,5 +234,24 @@ Note: shr may insert newlines between words for wrapping." (kill-buffer))) (test-email--teardown))) +(ert-deftest test-custom-buffer-file--view-email-no-displayable-destroys-handle () + "Error: the MIME handle is destroyed even when no displayable part is found. +The `user-error' fires before cleanup, so without `unwind-protect' the dissected +handle leaks." + (test-email--setup) + (unwind-protect + (let ((eml-file (test-email--create-eml-file test-email--image-only)) + (destroy-called nil)) + (with-current-buffer (find-file-noselect eml-file) + (let ((real (symbol-function 'mm-destroy-parts))) + (cl-letf (((symbol-function 'mm-destroy-parts) + (lambda (handle) + (setq destroy-called t) + (funcall real handle)))) + (should-error (cj/view-email-in-buffer) :type 'user-error))) + (should destroy-called) + (kill-buffer))) + (test-email--teardown))) + (provide 'test-custom-buffer-file--view-email-in-buffer) ;;; test-custom-buffer-file--view-email-in-buffer.el ends here diff --git a/tests/test-custom-buffer-file-copy-link-to-buffer-file.el b/tests/test-custom-buffer-file-copy-link-to-buffer-file.el index 262968d6..5ee57b3a 100644 --- a/tests/test-custom-buffer-file-copy-link-to-buffer-file.el +++ b/tests/test-custom-buffer-file-copy-link-to-buffer-file.el @@ -4,7 +4,8 @@ ;; Tests for the cj/copy-link-to-buffer-file function from custom-buffer-file.el ;; ;; This function copies the full file:// path of the current buffer's file to -;; the kill ring. For non-file buffers, it does nothing (no error). +;; the kill ring. For non-file buffers, it signals a user-error, matching its +;; sibling copy commands. ;;; Code: @@ -58,12 +59,12 @@ (test-copy-link-teardown))) (ert-deftest test-copy-link-non-file-buffer () - "Should do nothing for non-file buffer without error." + "Error: a non-file buffer signals `user-error' and leaves the kill ring alone." (test-copy-link-setup) (unwind-protect (with-temp-buffer (setq kill-ring nil) - (cj/copy-link-to-buffer-file) + (should-error (cj/copy-link-to-buffer-file) :type 'user-error) (should (null kill-ring))) (test-copy-link-teardown))) @@ -195,13 +196,13 @@ (test-copy-link-teardown))) (ert-deftest test-copy-link-scratch-buffer () - "Should do nothing for *scratch* buffer." + "Error: the *scratch* buffer (no file) signals `user-error'." (test-copy-link-setup) (unwind-protect (progn (setq kill-ring nil) (with-current-buffer "*scratch*" - (cj/copy-link-to-buffer-file) + (should-error (cj/copy-link-to-buffer-file) :type 'user-error) (should (null kill-ring)))) (test-copy-link-teardown))) diff --git a/tests/test-custom-case-title-case-region.el b/tests/test-custom-case-title-case-region.el index 383ae927..82b4966a 100644 --- a/tests/test-custom-case-title-case-region.el +++ b/tests/test-custom-case-title-case-region.el @@ -60,16 +60,17 @@ an active region, and return the result." "The Art of War"))) (ert-deftest test-custom-case-title-case-region-normal-all-minor-words () - "All minor words in the skip list should be lowercased in mid-sentence." + "All minor words in the skip list should be lowercased in mid-sentence. +\"is\" is a linking verb, so it is a major word and is capitalized." (should (equal (test-title-case--on-string "go a an and as at but by for if in is nor of on or so the to yet go") - "Go a an and as at but by for if in is nor of on or so the to yet Go"))) + "Go a an and as at but by for if in Is nor of on or so the to yet Go"))) (ert-deftest test-custom-case-title-case-region-normal-four-letter-words-capitalized () "Words of four or more letters should always be capitalized. -Note: 'is' is explicitly in the minor word list, so it stays lowercase." +\"is\" is a linking verb (a major word), so it is capitalized too." (should (equal (test-title-case--on-string "this is from that with over") - "This is From That With Over"))) + "This Is From That With Over"))) (ert-deftest test-custom-case-title-case-region-normal-allcaps-input () "All-caps input should be downcased first, then title-cased." @@ -94,7 +95,16 @@ Note: 'is' is explicitly in the minor word list, so it stays lowercase." (ert-deftest test-custom-case-title-case-region-normal-question-resets () "Word immediately after a question mark should be capitalized, even if minor." (should (equal (test-title-case--on-string "really? the answer is no") - "Really? The Answer is No"))) + "Really? The Answer Is No"))) + +(ert-deftest test-custom-case-title-case-region-normal-last-word-capitalized () + "The last word is always capitalized, even a minor one." + (should (equal (test-title-case--on-string "the art of") "The Art Of"))) + +(ert-deftest test-custom-case-title-case-region-normal-period-restarts () + "A word after a sentence-ending period should be capitalized." + (should (equal (test-title-case--on-string "one. the next sentence") + "One. The Next Sentence"))) (ert-deftest test-custom-case-title-case-region-normal-hyphenated-word () "Second part of a hyphenated word should NOT be capitalized." @@ -141,7 +151,7 @@ Note: 'is' is explicitly in the minor word list, so it stays lowercase." (ert-deftest test-custom-case-title-case-region-boundary-unicode-words () "Unicode characters should pass through without error." (should (equal (test-title-case--on-string "the café is nice") - "The Café is Nice"))) + "The Café Is Nice"))) (ert-deftest test-custom-case-title-case-region-boundary-numbers-in-text () "Numbers mixed with text should not break title casing." diff --git a/tests/test-custom-comments-comment-inline-border.el b/tests/test-custom-comments-comment-inline-border.el index 78e86035..305a2c7a 100644 --- a/tests/test-custom-comments-comment-inline-border.el +++ b/tests/test-custom-comments-comment-inline-border.el @@ -120,6 +120,16 @@ Returns the buffer string for assertions." (let ((result (test-inline-border-at-column 0 ";;" "" "=" "" 10))) (should (string-match-p ";" result)))) +(ert-deftest test-inline-border-elisp-fills-exact-width-all-parities () + "Boundary: even, odd, and empty text all fill LENGTH exactly. +Even-length and empty text used to come out two columns short because the +right decoration count keyed off text-length parity instead of the remaining +width, so stacked dividers of differing text lengths misaligned." + (dolist (text '("" "X" "EVEN" "ODD" "Header")) + (let* ((result (test-inline-border-at-column 0 ";;" "" "=" text 50)) + (line (string-trim-right result "\n"))) + (should (= 50 (length line)))))) + (ert-deftest test-inline-border-elisp-text-centering-even () "Should center text properly with even length." (let ((result (test-inline-border-at-column 0 ";;" "" "=" "EVEN" 70))) diff --git a/tests/test-custom-comments-comment-reformat.el b/tests/test-custom-comments-comment-reformat.el index 83248aee..91b7dfe3 100644 --- a/tests/test-custom-comments-comment-reformat.el +++ b/tests/test-custom-comments-comment-reformat.el @@ -146,19 +146,12 @@ Insert CONTENT-BEFORE, select all, run cj/comment-reformat, verify EXPECTED-AFTE (should (string-match-p ";; Start line 1.*Start line 2" (buffer-string))))) (ert-deftest test-comment-reformat-elisp-no-region-active () - "Should show message when no region selected." + "Should signal `user-error' when no region is selected." (with-temp-buffer (emacs-lisp-mode) (insert ";; Comment line") (deactivate-mark) - (let ((message-log-max nil) - (messages '())) - ;; Capture messages - (cl-letf (((symbol-function 'message) - (lambda (format-string &rest args) - (push (apply #'format format-string args) messages)))) - (cj/comment-reformat) - (should (string-match-p "No region was selected" (car messages))))))) + (should-error (cj/comment-reformat) :type 'user-error))) (ert-deftest test-comment-reformat-elisp-read-only-buffer () "Should signal error in read-only buffer." diff --git a/tests/test-custom-datetime-all-methods.el b/tests/test-custom-datetime-all-methods.el index 62b421bd..1f31c6c4 100644 --- a/tests/test-custom-datetime-all-methods.el +++ b/tests/test-custom-datetime-all-methods.el @@ -54,9 +54,10 @@ (should (string-match-p "14:30:45" result)))) (ert-deftest test-custom-datetime-all-methods-normal-sortable-time () - "cj/insert-sortable-time should insert time with AM/PM and timezone." + "cj/insert-sortable-time should insert 24-hour time so it sorts lexically." (let ((result (test-datetime--run #'cj/insert-sortable-time))) - (should (string-match-p "02:30:45 PM" result)))) + (should (string-match-p "14:30:45" result)) + (should-not (string-match-p "PM" result)))) (ert-deftest test-custom-datetime-all-methods-normal-readable-time () "cj/insert-readable-time should insert short time with AM/PM." diff --git a/tests/test-custom-line-paragraph-duplicate-line-or-region.el b/tests/test-custom-line-paragraph-duplicate-line-or-region.el index 84f5bc2d..9e501086 100644 --- a/tests/test-custom-line-paragraph-duplicate-line-or-region.el +++ b/tests/test-custom-line-paragraph-duplicate-line-or-region.el @@ -327,6 +327,40 @@ (should (> (length (buffer-string)) (length "line one\nline two\nline three")))) (test-duplicate-line-or-region-teardown))) +(ert-deftest test-duplicate-line-or-region-mid-line-bounds-duplicate-whole-lines () + "A region ending mid-line duplicates every whole line it touches, no splits. +The old open-line loop split the mid-line-ending line instead." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "aaa\nbbb\nccc") + (transient-mark-mode 1) + (goto-char (point-min)) + (forward-char 1) ; mid first line + (set-mark (point)) + (forward-line 1) + (forward-char 2) ; mid second line + (activate-mark) + (cj/duplicate-line-or-region) + (should (string= "aaa\nbbb\naaa\nbbb\nccc" (buffer-string)))) + (test-duplicate-line-or-region-teardown))) + +(ert-deftest test-duplicate-line-or-region-ends-at-bol-no-extra-empty-line () + "A region ending at beginning-of-line duplicates only the fully-included lines. +The old open-line loop duplicated a stray empty line here." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "aaa\nbbb\nccc") + (transient-mark-mode 1) + (goto-char (point-min)) + (set-mark (point)) + (forward-line 2) ; region "aaa\nbbb\n", ends at bol of ccc + (activate-mark) + (cj/duplicate-line-or-region) + (should (string= "aaa\nbbb\naaa\nbbb\nccc" (buffer-string)))) + (test-duplicate-line-or-region-teardown))) + (ert-deftest test-duplicate-line-or-region-trailing-whitespace () "Should preserve trailing whitespace." (test-duplicate-line-or-region-setup) diff --git a/tests/test-custom-line-paragraph-join-line-or-region.el b/tests/test-custom-line-paragraph-join-line-or-region.el index f8738910..5d421683 100644 --- a/tests/test-custom-line-paragraph-join-line-or-region.el +++ b/tests/test-custom-line-paragraph-join-line-or-region.el @@ -62,8 +62,8 @@ (should (string-match-p "line one line two" (buffer-string)))) (test-join-line-or-region-teardown))) -(ert-deftest test-join-line-or-region-no-region-adds-newline-after-join () - "Without region, should add newline after joining." +(ert-deftest test-join-line-or-region-no-region-adds-newline-at-end-of-buffer () + "Without region, joining the last line adds a trailing newline at end of buffer." (test-join-line-or-region-setup) (unwind-protect (with-temp-buffer @@ -73,6 +73,20 @@ (should (string-suffix-p "\n" (buffer-string)))) (test-join-line-or-region-teardown))) +(ert-deftest test-join-line-or-region-no-region-mid-buffer-no-blank-line () + "Without region, joining a non-last line must not insert a blank line. +The trailing newline belongs only at end of buffer; adding it unconditionally +left a stray blank line between the joined line and the rest of the buffer." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\nline two\nline three") + (goto-char (point-min)) + (forward-line 1) ; point on "line two", not the last line + (cj/join-line-or-region) + (should (string= "line one line two\nline three" (buffer-string)))) + (test-join-line-or-region-teardown))) + (ert-deftest test-join-line-or-region-with-region-joins-all-lines () "With region, should join all lines in region." (test-join-line-or-region-setup) diff --git a/tests/test-custom-line-paragraph-jump-to-matching-paren.el b/tests/test-custom-line-paragraph-jump-to-matching-paren.el index 31853da6..bd24faed 100644 --- a/tests/test-custom-line-paragraph-jump-to-matching-paren.el +++ b/tests/test-custom-line-paragraph-jump-to-matching-paren.el @@ -83,11 +83,11 @@ POINT-POSITION is 1-indexed (1 = first character)." ;;; Normal Cases - Backward Jump (Closing to Opening) (ert-deftest test-jump-paren-backward-simple () - "Should jump backward from closing paren to opening paren." + "Should jump from a closing paren to its matching opening paren." ;; Text: "(hello)" ;; Start at position 7 (on closing paren) - ;; Should end at position 2 (after opening paren) - (should (= 2 (test-jump-to-matching-paren "(hello)" 7)))) + ;; Should end at position 1 (the matching opening paren) + (should (= 1 (test-jump-to-matching-paren "(hello)" 7)))) (ert-deftest test-jump-paren-backward-nested () "Should jump backward over nested parens from after outer closing." @@ -97,11 +97,11 @@ POINT-POSITION is 1-indexed (1 = first character)." (should (= 1 (test-jump-to-matching-paren "(foo (bar))" 12)))) (ert-deftest test-jump-paren-backward-inner-nested () - "Should jump backward from inner closing paren." + "Should jump from an inner closing paren to its matching inner opener." ;; Text: "(foo (bar))" ;; Start at position 10 (on inner closing paren) - ;; Should end at position 7 (after inner opening paren) - (should (= 7 (test-jump-to-matching-paren "(foo (bar))" 10)))) + ;; Should end at position 6 (the matching inner opening paren) + (should (= 6 (test-jump-to-matching-paren "(foo (bar))" 10)))) (ert-deftest test-jump-bracket-backward () "Should jump backward from after closing bracket." @@ -145,11 +145,11 @@ POINT-POSITION is 1-indexed (1 = first character)." (should (= 1 (test-jump-to-matching-paren "(hello" 1)))) (ert-deftest test-jump-paren-unmatched-closing () - "Should move to beginning from unmatched closing paren." + "Should stay put on an unmatched closing paren (no matching opener)." ;; Text: "hello)" ;; Start at position 6 (on closing paren with no opening) - ;; backward-sexp with unmatched closing paren goes to beginning - (should (= 1 (test-jump-to-matching-paren "hello)" 6)))) + ;; There is no matching opener, so point is restored and stays at 6 + (should (= 6 (test-jump-to-matching-paren "hello)" 6)))) ;;; Boundary Cases - Empty Delimiters @@ -161,11 +161,11 @@ POINT-POSITION is 1-indexed (1 = first character)." (should (= 3 (test-jump-to-matching-paren "()" 1)))) (ert-deftest test-jump-paren-empty-backward () - "Should stay put when on closing paren of empty parens." + "Should jump from the closing paren of empty parens to its opener." ;; Text: "()" ;; Start at position 2 (on closing paren) - ;; backward-sexp from closing of empty parens gives an error, so stays at 2 - (should (= 2 (test-jump-to-matching-paren "()" 2)))) + ;; Should end at position 1 (the matching opening paren) + (should (= 1 (test-jump-to-matching-paren "()" 2)))) ;;; Boundary Cases - Multiple Delimiter Types diff --git a/tests/test-custom-ordering-number-lines.el b/tests/test-custom-ordering-number-lines.el index adda84f0..142e5561 100644 --- a/tests/test-custom-ordering-number-lines.el +++ b/tests/test-custom-ordering-number-lines.el @@ -122,9 +122,10 @@ Returns the transformed string." (should (string= result "1. ")))) (ert-deftest test-number-lines-empty-lines () - "Should number empty lines." + "Should number empty lines, treating the final newline as a terminator. +The old split counted the trailing newline as a spurious third line." (let ((result (test-number-lines "\n\n" "N. " nil))) - (should (string= result "1. \n2. \n3. ")))) + (should (string= result "1. \n2. \n")))) (ert-deftest test-number-lines-with-existing-numbers () "Should number lines that already have content." diff --git a/tests/test-custom-ordering-reverse-lines.el b/tests/test-custom-ordering-reverse-lines.el index 3c71362d..5b8c01ac 100644 --- a/tests/test-custom-ordering-reverse-lines.el +++ b/tests/test-custom-ordering-reverse-lines.el @@ -86,9 +86,11 @@ Returns the transformed string." (should (string= result "b\n\na")))) (ert-deftest test-reverse-lines-trailing-newline () - "Should handle trailing newline." + "Should reverse the lines and preserve the trailing newline. +The old split dropped the trailing newline into a leading empty line, +producing \"\\nline2\\nline1\"." (let ((result (test-reverse-lines "line1\nline2\n"))) - (should (string= result "\nline2\nline1")))) + (should (string= result "line2\nline1\n")))) (ert-deftest test-reverse-lines-only-newlines () "Should reverse lines that are only newlines." diff --git a/tests/test-custom-text-enclose-indent.el b/tests/test-custom-text-enclose-indent.el index e9042d35..f37d1800 100644 --- a/tests/test-custom-text-enclose-indent.el +++ b/tests/test-custom-text-enclose-indent.el @@ -43,6 +43,35 @@ Returns the transformed string." Returns the transformed string." (cj/--dedent-lines text count)) +;;; Interactive default resolution (the prefix-arg decoupling fix) + +(ert-deftest test-indent-lines-interactive-no-prefix-is-four-spaces () + "Interactive: no prefix indents by 4, spaces when `indent-tabs-mode' is nil. +The old \"p\\nP\" spec defaulted count to 1 and forced tabs on any prefix." + (with-temp-buffer + (setq-local indent-tabs-mode nil) + (insert "line") + (let ((current-prefix-arg nil)) + (call-interactively #'cj/indent-lines-in-region-or-buffer)) + (should (string= " line" (buffer-string))))) + +(ert-deftest test-indent-lines-interactive-follows-indent-tabs-mode () + "Interactive: tabs-vs-spaces follows `indent-tabs-mode', not the prefix arg." + (with-temp-buffer + (setq-local indent-tabs-mode t) + (insert "line") + (let ((current-prefix-arg nil)) + (call-interactively #'cj/indent-lines-in-region-or-buffer)) + (should (string= "\t\t\t\tline" (buffer-string))))) + +(ert-deftest test-dedent-lines-interactive-no-prefix-is-four () + "Interactive: no prefix removes up to 4 leading whitespace characters." + (with-temp-buffer + (insert " line") ; eight leading spaces + (let ((current-prefix-arg nil)) + (call-interactively #'cj/dedent-lines-in-region-or-buffer)) + (should (string= " line" (buffer-string))))) + ;;; Indent Tests - Normal Cases with Spaces (ert-deftest test-indent-single-line-4-spaces () diff --git a/tests/test-flyspell-and-abbrev.el b/tests/test-flyspell-and-abbrev.el index ef8cc637..3b494d5e 100644 --- a/tests/test-flyspell-and-abbrev.el +++ b/tests/test-flyspell-and-abbrev.el @@ -97,5 +97,27 @@ (cj/flyspell-on-for-buffer-type))) (should mode-called))) +;; --------------------------- cj/flyspell-then-abbrev ------------------------- + +(ert-deftest test-flyspell-then-abbrev-enables-mode-not-bare-rescan () + "Regression: cj/flyspell-then-abbrev routes the initial scan through +cj/flyspell-on-for-buffer-type, which enables flyspell-mode so it sticks. +The bare flyspell-buffer it replaced never turned the mode on, so the guard +never tripped and every C-' press re-scanned the whole buffer (O(buffer) per +keypress in large files)." + (let (on-called scan-called) + (cl-letf (((symbol-function 'cj/--require-spell-checker) #'ignore) + ((symbol-function 'cj/flyspell-on-for-buffer-type) + (lambda () (setq on-called t))) + ((symbol-function 'flyspell-buffer) + (lambda (&rest _) (setq scan-called t))) + ((symbol-function 'cj/flyspell-goto-previous-misspelling) + (lambda (&rest _) nil))) + (with-temp-buffer + (text-mode) + (cj/flyspell-then-abbrev nil))) + (should on-called) + (should-not scan-called))) + (provide 'test-flyspell-and-abbrev) ;;; test-flyspell-and-abbrev.el ends here diff --git a/tests/test-font-config.el b/tests/test-font-config.el index 393a7758..4df2b41a 100644 --- a/tests/test-font-config.el +++ b/tests/test-font-config.el @@ -93,5 +93,47 @@ ((symbol-function 'set-fontset-font) (lambda (&rest _) t))) (should (progn (cj/setup-emoji-fontset) t)))) +;;; cj/set-emojify-display-style + +(defvar emojify-display-style) + +(ert-deftest test-font-config-emojify-display-style-image-on-gui () + "Normal: on a GUI frame the emoji display style is `image'." + (skip-unless test-font-config--available) + (require 'font-config) + (let ((emojify-display-style nil)) + (cl-letf (((symbol-function 'env-gui-p) (lambda (&rest _) t))) + (cj/set-emojify-display-style) + (should (eq emojify-display-style 'image))))) + +(ert-deftest test-font-config-emojify-display-style-unicode-without-gui () + "Boundary: without a GUI the emoji display style is `unicode'." + (skip-unless test-font-config--available) + (require 'font-config) + (let ((emojify-display-style nil)) + (cl-letf (((symbol-function 'env-gui-p) (lambda (&rest _) nil))) + (cj/set-emojify-display-style) + (should (eq emojify-display-style 'unicode))))) + +;;; cj/display-available-fonts + +(ert-deftest test-font-config-display-available-fonts-second-call-no-error () + "Error: a second invocation does not signal on the read-only buffer." + (skip-unless test-font-config--available) + (require 'font-config) + (cl-letf (((symbol-function 'font-family-list) + (lambda (&rest _) '("Fixture Font A" "Fixture Font B")))) + (unwind-protect + (progn + (cj/display-available-fonts) + ;; The first call ends in `special-mode' (read-only); the second must + ;; not signal when it erases and rewrites the buffer. + (cj/display-available-fonts) + (with-current-buffer "*Available Fonts*" + (should (> (buffer-size) 0)) + (should buffer-read-only))) + (when (get-buffer "*Available Fonts*") + (kill-buffer "*Available Fonts*"))))) + (provide 'test-font-config) ;;; test-font-config.el ends here diff --git a/tests/test-keyboard-compat-setup.el b/tests/test-keyboard-compat-setup.el index a3e6f441..a23e24e1 100644 --- a/tests/test-keyboard-compat-setup.el +++ b/tests/test-keyboard-compat-setup.el @@ -79,18 +79,20 @@ without the arrow-key decodings. The GUI half already frame-scopes itself." ,@body))) (defconst test-kbc--meta-shift-letters - '(?o ?m ?y ?f ?w ?e ?l ?r ?v ?h ?t ?z ?u ?d ?i ?c ?b ?k) - "The 18 letters whose M-<UPPER> form is translated to M-S-<lower> in GUI mode.") + '(?o ?m ?y ?f ?w ?e ?l ?r ?v ?h ?t ?z ?u ?d ?i ?c ?b) + "The 17 letters whose M-<UPPER> form is translated to M-S-<lower> in GUI mode.") (ert-deftest test-keyboard-compat-gui-setup-translates-spot-checks () - "Normal: in GUI mode, M-O -> M-S-o and M-K -> M-S-k (sampled)." + "Normal: in GUI mode, M-O -> M-S-o and M-B -> M-S-b (sampled). +M-K is no longer translated: show-kill-ring, its only consumer, was retired." (test-kbc--gui t (cj/keyboard-compat-gui-setup) (should (equal (lookup-key key-translation-map (kbd "M-O")) (kbd "M-S-o"))) - (should (equal (lookup-key key-translation-map (kbd "M-K")) (kbd "M-S-k"))) - (should (equal (lookup-key key-translation-map (kbd "M-D")) (kbd "M-S-d"))))) + (should (equal (lookup-key key-translation-map (kbd "M-B")) (kbd "M-S-b"))) + (should (equal (lookup-key key-translation-map (kbd "M-D")) (kbd "M-S-d"))) + (should-not (lookup-key key-translation-map (kbd "M-K"))))) -(ert-deftest test-keyboard-compat-gui-setup-translates-all-eighteen () +(ert-deftest test-keyboard-compat-gui-setup-translates-all-seventeen () "Normal: every documented M-<UPPER> maps to its M-S-<lower> form." (test-kbc--gui t (cj/keyboard-compat-gui-setup) diff --git a/tests/test-local-repository--car-member.el b/tests/test-local-repository--car-member.el deleted file mode 100644 index 30ae58c6..00000000 --- a/tests/test-local-repository--car-member.el +++ /dev/null @@ -1,58 +0,0 @@ -;;; test-local-repository--car-member.el --- Tests for localrepo--car-member -*- lexical-binding: t -*- - -;;; Commentary: -;; Tests for `localrepo--car-member' in local-repository.el — the predicate -;; localrepo-initialize uses to check whether an archive id is already -;; registered in package-archives / package-archive-priorities. - -;;; Code: - -(require 'ert) -(require 'local-repository) - -;;; Normal Cases - -(ert-deftest test-local-repository-localrepo--car-member-found () - "Normal: VALUE present as a car returns the matching tail (non-nil)." - (should (equal (localrepo--car-member 'b '((a . 1) (b . 2) (c . 3))) - '(b c)))) - -(ert-deftest test-local-repository-localrepo--car-member-not-found () - "Normal: VALUE absent from every car returns nil." - (should-not (localrepo--car-member 'z '((a . 1) (b . 2))))) - -(ert-deftest test-local-repository-localrepo--car-member-string-car () - "Normal: car comparison uses `equal', so string keys match by value." - (should (localrepo--car-member "localrepo" - '(("gnu" . "url1") ("localrepo" . "url2"))))) - -;;; Boundary Cases - -(ert-deftest test-local-repository-localrepo--car-member-empty-list () - "Boundary: an empty list never matches." - (should-not (localrepo--car-member 'a nil))) - -(ert-deftest test-local-repository-localrepo--car-member-single-match () - "Boundary: a single-element list whose car matches returns non-nil." - (should (localrepo--car-member 'only '((only . 1))))) - -(ert-deftest test-local-repository-localrepo--car-member-single-no-match () - "Boundary: a single-element list whose car differs returns nil." - (should-not (localrepo--car-member 'x '((only . 1))))) - -(ert-deftest test-local-repository-localrepo--car-member-nil-value-with-nil-car () - "Boundary: a nil VALUE matches a cons whose car is nil." - (should (localrepo--car-member nil '((nil . 1) (a . 2))))) - -(ert-deftest test-local-repository-localrepo--car-member-nil-value-no-nil-car () - "Boundary: a nil VALUE with no nil car returns nil." - (should-not (localrepo--car-member nil '((a . 1) (b . 2))))) - -;;; Error Cases - -(ert-deftest test-local-repository-localrepo--car-member-non-cons-element () - "Error: a non-cons element makes `car' signal wrong-type-argument." - (should-error (localrepo--car-member 'x '(1 2)) :type 'wrong-type-argument)) - -(provide 'test-local-repository--car-member) -;;; test-local-repository--car-member.el ends here diff --git a/tests/test-local-repository.el b/tests/test-local-repository.el new file mode 100644 index 00000000..132f8dc4 --- /dev/null +++ b/tests/test-local-repository.el @@ -0,0 +1,32 @@ +;;; test-local-repository.el --- Tests for the local-repository update command -*- lexical-binding: t; -*- + +;;; Commentary: +;; `cj/update-localrepo-repository' refreshes the checked-in local package +;; archive at `localrepo-location' (owned by early-init.el) via elpa-mirror. +;; The elpa-mirror call is mocked at the boundary. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'local-repository) + +;; localrepo-location is a defconst in early-init.el, which `make test' never +;; loads. Declare it special here so the `let' below binds it dynamically and +;; the module reads that value. +(defvar localrepo-location nil) + +(ert-deftest test-local-repository-update-targets-early-init-location () + "Normal: the mirror update targets `localrepo-location', the single archive +path early-init.el owns, not a divergent module-local copy." + (let ((localrepo-location "/tmp/test-localrepo/") + (captured nil)) + (cl-letf (((symbol-function 'elpamr-create-mirror-for-installed) + (lambda (dir &rest _) (setq captured dir)))) + (cj/update-localrepo-repository) + (should (equal captured "/tmp/test-localrepo/"))))) + +(provide 'test-local-repository) +;;; test-local-repository.el ends here diff --git a/tests/test-lorem-optimum.el b/tests/test-lorem-optimum.el index f928c972..b7d97a8e 100644 --- a/tests/test-lorem-optimum.el +++ b/tests/test-lorem-optimum.el @@ -253,5 +253,26 @@ an empty string, not an error." (let ((cj/lipsum-chain (cj/markov-chain-create))) (should (equal "" (cj/lipsum-title))))) +;;; cj/lipsum entry point + +(ert-deftest test-lipsum-returns-string-with-populated-chain () + "Normal: cj/lipsum returns a non-empty string when the chain is trained." + (let ((cj/lipsum-chain + (test-learn "Lorem ipsum dolor sit amet consectetur adipiscing elit"))) + (let ((result (cj/lipsum 5))) + (should (stringp result)) + (should (> (length result) 0))))) + +(ert-deftest test-lipsum-empty-chain-signals-user-error () + "Error: cj/lipsum on an empty chain signals a user-error naming the fix, +rather than returning nil and letting cj/lipsum-insert do (insert nil), +which raises a cryptic wrong-type error far from the cause." + (let ((cj/lipsum-chain (cj/markov-chain-create))) + (should-error (cj/lipsum 5) :type 'user-error))) + +(ert-deftest test-lipsum-is-interactive-command () + "Normal: cj/lipsum is a command, as its Commentary (M-x cj/lipsum) advertises." + (should (commandp 'cj/lipsum))) + (provide 'test-lorem-optimum) ;;; test-lorem-optimum.el ends here diff --git a/tests/test-org-contacts-config-find.el b/tests/test-org-contacts-config-find.el new file mode 100644 index 00000000..60a5e713 --- /dev/null +++ b/tests/test-org-contacts-config-find.el @@ -0,0 +1,72 @@ +;;; test-org-contacts-config-find.el --- Tests for cj/org-contacts-find -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/org-contacts-find collects contact headings (name, position, and the +;; EMAIL/PHONE annotation) before prompting, then jumps to the selected +;; heading's stored position. These tests pin the collector helper and a +;; command-level smoke test: the jump must land on the heading, never on a +;; body line that merely mentions the name. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'org) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'org-contacts-config) + +;;; cj/--org-contacts-collect + +(ert-deftest test-org-contacts-collect-returns-name-position-info () + "Normal: collector returns heading name, heading position, and EMAIL/PHONE." + (with-temp-buffer + (org-mode) + (insert "* Alice\n:PROPERTIES:\n:EMAIL: alice@example.com\n:END:\n" + "some body text mentioning Bob\n" + "* Bob\n:PROPERTIES:\n:PHONE: 555-1234\n:END:\n") + (let* ((alist (cj/--org-contacts-collect (current-buffer))) + (alice (assoc "Alice" alist)) + (bob (assoc "Bob" alist))) + (should (equal (length alist) 2)) + (should (equal (nth 2 alice) "alice@example.com")) + (should (equal (nth 2 bob) "555-1234")) + ;; positions land on the headings, not the body line that mentions Bob + (should (save-excursion (goto-char (nth 1 alice)) (looking-at "\\* Alice"))) + (should (save-excursion (goto-char (nth 1 bob)) (looking-at "\\* Bob")))))) + +(ert-deftest test-org-contacts-collect-empty-buffer-returns-nil () + "Boundary: a buffer with no headings yields an empty alist." + (with-temp-buffer + (org-mode) + (should (null (cj/--org-contacts-collect (current-buffer)))))) + +(ert-deftest test-org-contacts-collect-heading-without-props-has-nil-info () + "Error: a heading with no EMAIL or PHONE yields nil info." + (with-temp-buffer + (org-mode) + (insert "* Carol\n") + (let ((alist (cj/--org-contacts-collect (current-buffer)))) + (should (equal (nth 2 (assoc "Carol" alist)) nil))))) + +;;; cj/org-contacts-find + +(ert-deftest test-org-contacts-find-jumps-to-heading-not-body () + "Normal: selecting a contact jumps to its heading, not a body mention." + (let ((contacts-file (make-temp-file "org-contacts-test-" nil ".org"))) + (unwind-protect + (progn + (with-temp-file contacts-file + (insert "* Alice\n:PROPERTIES:\n:EMAIL: alice@example.com\n:END:\n" + "note: call Bob about Alice\n" + "* Bob\n:PROPERTIES:\n:PHONE: 555-1234\n:END:\n")) + (cl-letf (((symbol-function 'completing-read) + (lambda (&rest _) "Bob")) + ((symbol-function 'org-fold-show-entry) #'ignore) + ((symbol-function 'org-reveal) #'ignore)) + (cj/org-contacts-find) + (should (looking-at "\\* Bob")))) + (delete-file contacts-file)))) + +(provide 'test-org-contacts-config-find) +;;; test-org-contacts-config-find.el ends here diff --git a/tests/test-org-drill-config-source.el b/tests/test-org-drill-config-source.el new file mode 100644 index 00000000..ccda99ef --- /dev/null +++ b/tests/test-org-drill-config-source.el @@ -0,0 +1,31 @@ +;;; test-org-drill-config-source.el --- Tests for org-drill source selection -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/--org-drill-source-keywords decides how use-package obtains org-drill: +;; a local dev checkout via :load-path when it exists, otherwise the upstream +;; repo via :vc. Without this, a machine lacking the checkout hits :demand t +;; against a nonexistent :load-path and drill fails to load entirely. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'org-drill-config) + +(ert-deftest test-org-drill-source-keywords-uses-load-path-when-checkout-exists () + "Normal: an existing checkout directory selects :load-path." + (let ((dir (make-temp-file "org-drill-checkout-" t))) + (unwind-protect + (should (equal (cj/--org-drill-source-keywords dir) + (list :load-path dir))) + (delete-directory dir t)))) + +(ert-deftest test-org-drill-source-keywords-falls-back-to-vc-when-absent () + "Error: a missing checkout falls back to a :vc install spec." + (let ((kws (cj/--org-drill-source-keywords "/nonexistent/org-drill-xyz"))) + (should (eq (car kws) :vc)) + (should (plist-get (nth 1 kws) :url)))) + +(provide 'test-org-drill-config-source) +;;; test-org-drill-config-source.el ends here diff --git a/tests/test-org-reveal-config-keymap.el b/tests/test-org-reveal-config-keymap.el new file mode 100644 index 00000000..17a21b19 --- /dev/null +++ b/tests/test-org-reveal-config-keymap.el @@ -0,0 +1,38 @@ +;;; test-org-reveal-config-keymap.el --- Tests for org-reveal-config prefix keymap -*- lexical-binding: t; -*- + +;;; Commentary: +;; The presentation commands are reached through `cj/reveal-map', a prefix +;; keymap registered under "C-; p" via `cj/register-prefix-map'. These +;; tests pin that structure so the module can't silently regress to raw +;; `global-set-key' calls (which carry a hidden load-order dependency on +;; keybindings.el establishing "C-;" as a prefix first). + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'keybindings) +(require 'org-reveal-config) + +(ert-deftest test-org-reveal-config-reveal-map-is-a-keymap () + "Normal: `cj/reveal-map' is a keymap." + (should (keymapp cj/reveal-map))) + +(ert-deftest test-org-reveal-config-reveal-map-bindings () + "Normal: each presentation command is reachable under `cj/reveal-map'." + (dolist (pair '(("SPC" . cj/reveal-present) + ("e" . cj/reveal-export) + ("p" . cj/reveal-preview-start) + ("s" . cj/reveal-preview-stop) + ("h" . cj/reveal-insert-header) + ("H" . cj/reveal-remove-headers) + ("n" . cj/reveal-new))) + (should (eq (keymap-lookup cj/reveal-map (car pair)) (cdr pair))))) + +(ert-deftest test-org-reveal-config-reveal-map-registered-under-p () + "Normal: `cj/reveal-map' is registered under \"p\" in `cj/custom-keymap'." + (should (eq (keymap-lookup cj/custom-keymap "p") cj/reveal-map))) + +(provide 'test-org-reveal-config-keymap) +;;; test-org-reveal-config-keymap.el ends here diff --git a/tests/test-org-roam-config-tag-and-find.el b/tests/test-org-roam-config-tag-and-find.el index f98d8af0..97a7a683 100644 --- a/tests/test-org-roam-config-tag-and-find.el +++ b/tests/test-org-roam-config-tag-and-find.el @@ -147,6 +147,17 @@ ;; The 4th arg is the subdir (should (equal (nth 3 args) "recipes/")))) +(ert-deftest test-org-roam-find-node-project-delegates-to-find-node () + "Normal: `find-node-project' uses Project tag, 'p' key, project.org template." + (let ((args nil)) + (cl-letf (((symbol-function 'cj/org-roam-find-node) + (lambda (&rest a) (setq args a)))) + (cj/org-roam-find-node-project)) + (should (equal (car args) "Project")) + (should (equal (cadr args) "p")) + ;; The 3rd arg is the template file, under the canonical roam-dir/templates/. + (should (string-suffix-p "templates/project.org" (nth 2 args))))) + ;;; cj/org-roam-node-insert-immediate (ert-deftest test-org-roam-node-insert-immediate-rebinds-templates-and-calls-insert () diff --git a/tests/test-text-config.el b/tests/test-text-config.el index 96935e1b..82dfe05e 100644 --- a/tests/test-text-config.el +++ b/tests/test-text-config.el @@ -37,5 +37,18 @@ standard boundary check." (should (eq (cj/prettify-compose-block-markers-p start end "lambda") (prettify-symbols-default-compose-p start end "lambda")))))) +(ert-deftest test-text-config-edit-indirect-bound-on-reachable-key () + "Error/regression: edit-indirect-region is bound on M-I -- the event +Meta+Shift+i actually produces -- not the unreachable M-S-i, which no +keypress generates so it silently fell through to M-i tab-to-tab-stop." + (should (eq (key-binding (kbd "M-I")) #'edit-indirect-region)) + (should-not (eq (key-binding (kbd "M-S-i")) #'edit-indirect-region))) + +(ert-deftest test-text-config-accent-uses-completion-agnostic-backend () + "Regression: C-` invokes accent-menu, which reads through the minibuffer +and so survives a Company->Corfu migration, rather than accent-company, +whose company backend would break silently once Company is gone." + (should (eq (key-binding (kbd "C-`")) #'accent-menu))) + (provide 'test-text-config) ;;; test-text-config.el ends here diff --git a/tests/test-ui-theme-persistence.el b/tests/test-ui-theme-persistence.el index 02bb105a..250b606b 100644 --- a/tests/test-ui-theme-persistence.el +++ b/tests/test-ui-theme-persistence.el @@ -32,6 +32,19 @@ "modus-vivendi"))) (delete-file file)))) +(ert-deftest test-ui-theme-write-file-contents-creates-missing-parent-dir () + "Boundary: writing into a not-yet-existing directory creates it first. +On a fresh machine `persist/' does not exist, and `file-writable-p' returns nil +for a file inside a missing directory, so the write must create the parent." + (let* ((sandbox (make-temp-file "ui-theme-sandbox-" t)) + (file (expand-file-name "persist/emacs-theme" sandbox))) + (unwind-protect + (progn + (should-not (file-directory-p (file-name-directory file))) + (should (cj/theme-write-file-contents "modus-vivendi" file)) + (should (equal (cj/theme-read-file-contents file) "modus-vivendi"))) + (delete-directory sandbox t)))) + (ert-deftest test-ui-theme-write-file-contents-uses-write-region () "Theme persistence should write directly instead of visiting the file." (let ((file (make-temp-file "ui-theme-write-region-")) diff --git a/tests/test-undead-buffers-kill-other-window.el b/tests/test-undead-buffers-kill-other-window.el index e9371a0f..000ada9b 100644 --- a/tests/test-undead-buffers-kill-other-window.el +++ b/tests/test-undead-buffers-kill-other-window.el @@ -66,8 +66,9 @@ ;;; Boundary Cases -(ert-deftest test-kill-other-window-single-window-should-only-kill-buffer () - "With single window, should only kill the current buffer." +(ert-deftest test-kill-other-window-single-window-signals-no-other-window () + "Error: with a single window, signal `user-error' and kill nothing. +There is no other window, so acting would kill the buffer being viewed." (test-kill-other-window-setup) (unwind-protect (let ((buf (generate-new-buffer "*test-single-other*"))) @@ -75,9 +76,9 @@ (progn (switch-to-buffer buf) (should (one-window-p)) - (cj/kill-other-window) + (should-error (cj/kill-other-window) :type 'user-error) (should (one-window-p)) - (should-not (buffer-live-p buf))) + (should (buffer-live-p buf))) (when (buffer-live-p buf) (kill-buffer buf)))) (test-kill-other-window-teardown))) |