aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--modules/chrono-tools.el10
-rw-r--r--modules/help-config.el9
-rw-r--r--modules/hugo-config.el10
-rw-r--r--modules/music-config.el26
-rw-r--r--modules/org-agenda-config.el11
-rw-r--r--modules/org-drill-config.el11
-rw-r--r--modules/system-lib.el21
-rw-r--r--modules/test-runner.el17
-rw-r--r--modules/vc-config.el11
-rw-r--r--tests/test-system-lib--completion-file-annotator.el54
10 files changed, 158 insertions, 22 deletions
diff --git a/modules/chrono-tools.el b/modules/chrono-tools.el
index 744781268..57309178d 100644
--- a/modules/chrono-tools.el
+++ b/modules/chrono-tools.el
@@ -9,7 +9,7 @@
;; Eager reason: none; calendar/timer commands, a command-loaded deferral
;; candidate.
;; Top-level side effects: package configuration via use-package.
-;; Runtime requires: user-constants.
+;; Runtime requires: user-constants, system-lib.
;; Direct test load: yes.
;;
;; This module centralizes configuration for Emacs time-related tools:
@@ -21,6 +21,7 @@
;;; Code:
(require 'user-constants)
+(require 'system-lib) ;; provides cj/completion-table-annotated, cj/completion-file-annotator
;; Declared by the lazily-loaded `tmr' package; quiet the byte-compiler
;; without forcing the package to load.
@@ -107,7 +108,12 @@ Present all audio files in the sounds directory and set the chosen file as
(if current-file
(format " (current: %s)" current-file)
""))
- sound-files nil t nil nil current-file)))
+ (cj/completion-table-annotated
+ 'cj-sound-file
+ (cj/completion-file-annotator
+ (lambda (c) (expand-file-name c sounds-dir)))
+ sound-files)
+ nil t nil nil current-file)))
(if (or (null selected-file) (string-empty-p selected-file))
(message "No file selected")
(message "%s" (cj/tmr--apply-sound-file selected-file)))))))))
diff --git a/modules/help-config.el b/modules/help-config.el
index 4858abcf2..114b264ed 100644
--- a/modules/help-config.el
+++ b/modules/help-config.el
@@ -9,7 +9,7 @@
;; Eager reason: help/info/man configuration and its keybindings; eager only by
;; init order, a deferral candidate.
;; Top-level side effects: two global keys, package configuration via use-package.
-;; Runtime requires: none.
+;; Runtime requires: system-lib.
;; Direct test load: yes.
;;
;; This module enhances Emacs' built-in help system and documentation features.
@@ -25,6 +25,7 @@
;;; Code:
+(require 'system-lib) ;; completion table + file annotator
(setq help-window-select t) ;; Always select the help buffer in a separate window
@@ -90,7 +91,11 @@ Preserves any unsaved changes and checks if the file exists."
info-files))
(chosen-name (completing-read
"Select Info file: "
- (mapcar #'car files-alist)
+ (cj/completion-table-annotated
+ 'cj-info-file
+ (cj/completion-file-annotator
+ (lambda (c) (cdr (assoc c files-alist))))
+ (mapcar #'car files-alist))
nil t))
(chosen-file (cdr (assoc chosen-name files-alist))))
(when chosen-file
diff --git a/modules/hugo-config.el b/modules/hugo-config.el
index 7afa45a7b..b26398c69 100644
--- a/modules/hugo-config.el
+++ b/modules/hugo-config.el
@@ -9,7 +9,7 @@
;; Eager reason: none; blog publishing is a command-loaded deferral candidate
;; for Phase 4.
;; Top-level side effects: package configuration via use-package.
-;; Runtime requires: user-constants, host-environment.
+;; Runtime requires: user-constants, host-environment, system-lib.
;; Direct test load: yes.
;;
;; Integrates ox-hugo for publishing Org files to a Hugo website.
@@ -27,6 +27,7 @@
(require 'user-constants)
(require 'host-environment)
+(require 'system-lib) ;; completion table + file annotator
;; --------------------------------- Constants ---------------------------------
@@ -166,7 +167,12 @@ Switches #+hugo_draft between true and false."
(if (null drafts)
(message "No drafts found in %s" cj/hugo-content-org-dir)
(let ((choice (completing-read "Open draft: "
- (mapcar #'car drafts) nil t)))
+ (cj/completion-table-annotated
+ 'cj-hugo-draft
+ (cj/completion-file-annotator
+ (lambda (c) (cdr (assoc c drafts))))
+ (mapcar #'car drafts))
+ nil t)))
(find-file (cdr (assoc choice drafts)))))))
;; ---------------------------- Preview and Publish ----------------------------
diff --git a/modules/music-config.el b/modules/music-config.el
index c627d799a..d16e2bb2f 100644
--- a/modules/music-config.el
+++ b/modules/music-config.el
@@ -219,14 +219,24 @@ Directories are suffixed with /; files are plain. Hidden dirs/files skipped."
(sort acc #'string-lessp)))
(defun cj/music--completion-table (candidates)
- "Completion table for CANDIDATES preserving order and case-insensitive match."
- (lambda (string pred action)
- (if (eq action 'metadata)
- '(metadata
- (display-sort-function . identity)
- (cycle-sort-function . identity)
- (completion-ignore-case . t))
- (complete-with-action action candidates string pred))))
+ "Completion table for CANDIDATES preserving order and case-insensitive match.
+Tags the `cj-music-file' category and annotates each candidate (a path relative
+to `cj/music-root', with a trailing slash for directories) with its size and
+modification date so marginalia can show them."
+ (let ((annotate (cj/completion-file-annotator
+ (lambda (c)
+ (expand-file-name
+ (if (string-suffix-p "/" c) (substring c 0 -1) c)
+ cj/music-root)))))
+ (lambda (string pred action)
+ (if (eq action 'metadata)
+ `(metadata
+ (category . cj-music-file)
+ (annotation-function . ,annotate)
+ (display-sort-function . identity)
+ (cycle-sort-function . identity)
+ (completion-ignore-case . t))
+ (complete-with-action action candidates string pred)))))
(defun cj/music--ensure-playlist-buffer ()
"Ensure EMMS playlist buffer exists and is in playlist mode. Return buffer."
diff --git a/modules/org-agenda-config.el b/modules/org-agenda-config.el
index 51f269090..207c286e6 100644
--- a/modules/org-agenda-config.el
+++ b/modules/org-agenda-config.el
@@ -245,7 +245,16 @@ scoped to that project's todo.org plus calendars, schedule, and inbox."
(file-exists-p (expand-file-name "todo.org" dir))))
all-dirs))
(project-names (mapcar #'file-name-nondirectory project-dirs))
- (chosen (completing-read "Show agenda for project: " project-names nil t))
+ (chosen (completing-read
+ "Show agenda for project: "
+ (cj/completion-table-annotated
+ 'cj-agenda-project
+ (cj/completion-file-annotator
+ (lambda (c)
+ (expand-file-name "todo.org"
+ (expand-file-name c projects-dir))))
+ project-names)
+ nil t))
(todo-file (expand-file-name "todo.org"
(expand-file-name chosen projects-dir)))
(org-agenda-files (cons todo-file (cj/--org-agenda-base-files))))
diff --git a/modules/org-drill-config.el b/modules/org-drill-config.el
index 2c6e400e0..29f6130a2 100644
--- a/modules/org-drill-config.el
+++ b/modules/org-drill-config.el
@@ -8,7 +8,7 @@
;; Eager reason: none; optional flashcard workflow, a command-loaded deferral
;; candidate for Phase 4.
;; Top-level side effects: defines a drill keymap, registers it under cj/custom-keymap.
-;; Runtime requires: user-constants, keybindings.
+;; Runtime requires: user-constants, keybindings, system-lib.
;; Direct test load: yes (requires keybindings explicitly).
;;
;; Notes: Org-Drill
@@ -29,6 +29,7 @@
(require 'user-constants) ;; `drill-dir'
(require 'keybindings) ;; provides `cj/custom-keymap'
+(require 'system-lib) ;; completion table + file annotator
(declare-function org-drill "org-drill" (&optional scope drill-match resume-p))
(declare-function org-drill-resume "org-drill" ())
(declare-function org-capture "org-capture" (&optional goto keys))
@@ -57,7 +58,13 @@ drill commands and the drill capture templates share."
(defun cj/--drill-pick-file (dir)
"Prompt for one of the drill Org files in DIR; return its absolute path."
(expand-file-name
- (completing-read "Choose flashcard file: " (cj/--drill-files-or-error dir) nil t)
+ (completing-read "Choose flashcard file: "
+ (cj/completion-table-annotated
+ 'cj-drill-file
+ (cj/completion-file-annotator
+ (lambda (c) (expand-file-name c dir)))
+ (cj/--drill-files-or-error dir))
+ nil t)
dir))
(defun cj/--drill-pick-dir (other-dir)
diff --git a/modules/system-lib.el b/modules/system-lib.el
index 8b954c6a9..f1049c021 100644
--- a/modules/system-lib.el
+++ b/modules/system-lib.el
@@ -187,6 +187,27 @@ for: marginalia falls back to the table's own annotation function."
(annotation-function . ,annotate))
(complete-with-action action collection string predicate))))
+(defun cj/completion-file-annotator (candidate->path)
+ "Return an annotation function for completion candidates backed by files.
+CANDIDATE->PATH maps a candidate string to its absolute file path, or nil when
+the candidate has no backing file. The returned function, suitable as a
+completion table's annotation function (see `cj/completion-table-annotated'),
+yields a suffix with the file size and modification date for a regular file,
+the marker \"dir\" plus the date for a directory, or nil when the path is nil
+or the file is missing -- so marginalia then shows no suffix for that
+candidate."
+ (lambda (cand)
+ (let ((path (funcall candidate->path cand)))
+ (when (and path (file-exists-p path))
+ (let* ((attrs (file-attributes path))
+ (dirp (eq t (file-attribute-type attrs)))
+ (size (if dirp "dir"
+ (file-size-human-readable (file-attribute-size attrs))))
+ (date (format-time-string
+ "%Y-%m-%d"
+ (file-attribute-modification-time attrs))))
+ (format " %8s %s" size date))))))
+
(defun cj/format-region-with-program (program &rest args)
"Replace the current buffer with PROGRAM ARGS run over its contents, via argv.
Runs PROGRAM (with ARGS) on the whole buffer through `call-process-region'
diff --git a/modules/test-runner.el b/modules/test-runner.el
index 48a2b09fe..e05145e4e 100644
--- a/modules/test-runner.el
+++ b/modules/test-runner.el
@@ -8,7 +8,7 @@
;; Load shape: eager.
;; Eager reason: registers the C-; t test runner entry point and state.
;; Top-level side effects: defines and registers cj/test-map.
-;; Runtime requires: ert, cl-lib, keybindings.
+;; Runtime requires: ert, cl-lib, keybindings, system-lib.
;; Direct test load: yes.
;;
;; Project-aware ERT runner with two modes: all tests or a focused file set.
@@ -23,6 +23,7 @@
(require 'ert)
(require 'cl-lib)
(require 'keybindings) ;; provides cj/custom-keymap
+(require 'system-lib) ;; completion table + file annotator
;;; External Variables and Functions
@@ -209,7 +210,11 @@ Returns: \\='success if added successfully,
:test #'string=))
(selected (if unfocused-files
(completing-read "Add test file to focus: "
- unfocused-files
+ (cj/completion-table-annotated
+ 'cj-test-file
+ (cj/completion-file-annotator
+ (lambda (c) (expand-file-name c dir)))
+ unfocused-files)
nil t)
(user-error "All test files are already focused"))))
(pcase (cj/test--do-focus-add selected available-files focused-files)
@@ -278,7 +283,13 @@ Returns: \\='success if removed successfully,
(if (null focused-files)
(user-error "No focused files to remove")
(let ((selected (completing-read "Remove from focus: "
- focused-files
+ (cj/completion-table-annotated
+ 'cj-test-file
+ (cj/completion-file-annotator
+ (lambda (c)
+ (expand-file-name
+ c (cj/test--get-test-directory))))
+ focused-files)
nil t)))
(pcase (cj/test--do-focus-remove selected focused-files)
('success
diff --git a/modules/vc-config.el b/modules/vc-config.el
index fcca7e07b..60fcaeb89 100644
--- a/modules/vc-config.el
+++ b/modules/vc-config.el
@@ -8,7 +8,7 @@
;; Eager reason: the C-x g Magit entry point and the git keymap.
;; Top-level side effects: defines two keymaps, registers under cj/custom-keymap,
;; package configuration via use-package.
-;; Runtime requires: user-constants, keybindings.
+;; Runtime requires: user-constants, keybindings, system-lib.
;; Direct test load: yes (requires keybindings explicitly).
;;
;; C-x g is my general entry to Magit's version control via the status page.
@@ -26,6 +26,7 @@
(require 'user-constants) ;; provides code-dir
(require 'keybindings) ;; provides cj/custom-keymap
+(require 'system-lib) ;; completion table + file annotator
;; Forward declaration: cj/vc-map is defined later in this file (see
;; `defvar-keymap' below) but referenced earlier in a use-package :bind form.
@@ -199,7 +200,13 @@ repository's README if found, else `dired's the clone."
(read-directory-name "Clone to: " code-dir))
;; C-u: Choose from configured list
(current-prefix-arg
- (completing-read "Clone to: " cj/git-clone-dirs nil t))
+ (completing-read "Clone to: "
+ (cj/completion-table-annotated
+ 'cj-clone-dir
+ (cj/completion-file-annotator
+ (lambda (c) (expand-file-name c)))
+ cj/git-clone-dirs)
+ nil t))
;; No prefix: Use default (first in list)
(t (car cj/git-clone-dirs)))))
diff --git a/tests/test-system-lib--completion-file-annotator.el b/tests/test-system-lib--completion-file-annotator.el
new file mode 100644
index 000000000..9e1f4aa4a
--- /dev/null
+++ b/tests/test-system-lib--completion-file-annotator.el
@@ -0,0 +1,54 @@
+;;; test-system-lib--completion-file-annotator.el --- Tests for cj/completion-file-annotator -*- lexical-binding: t; -*-
+
+;;; Commentary:
+;; Unit tests for `cj/completion-file-annotator', the annotation-function
+;; factory used to annotate file-basename completion pickers with size and
+;; modification date.
+
+;;; Code:
+
+(require 'ert)
+(require 'system-lib)
+
+(ert-deftest test-system-lib-completion-file-annotator-normal-file-shows-size-and-date ()
+ "Normal: a regular file is annotated with a size and an ISO date."
+ (let ((file (make-temp-file "cfa-test-" nil ".txt" "hello world")))
+ (unwind-protect
+ (let* ((annotate (cj/completion-file-annotator
+ (lambda (_cand) file)))
+ (result (funcall annotate "anything")))
+ (should (stringp result))
+ ;; file-size-human-readable of 11 bytes is "11"
+ (should (string-match-p "11" result))
+ ;; ISO date for the file's mtime
+ (should (string-match-p
+ (format-time-string "%Y-%m-%d"
+ (file-attribute-modification-time
+ (file-attributes file)))
+ result)))
+ (delete-file file))))
+
+(ert-deftest test-system-lib-completion-file-annotator-boundary-directory-marked-dir ()
+ "Boundary: a directory candidate is annotated with the `dir' marker."
+ (let ((dir (make-temp-file "cfa-dir-" t)))
+ (unwind-protect
+ (let* ((annotate (cj/completion-file-annotator (lambda (_c) dir)))
+ (result (funcall annotate "d")))
+ (should (stringp result))
+ (should (string-match-p "dir" result)))
+ (delete-directory dir t))))
+
+(ert-deftest test-system-lib-completion-file-annotator-error-nil-path-returns-nil ()
+ "Error: a candidate whose path-resolver returns nil yields no annotation."
+ (let ((annotate (cj/completion-file-annotator (lambda (_c) nil))))
+ (should (null (funcall annotate "missing")))))
+
+(ert-deftest test-system-lib-completion-file-annotator-error-missing-file-returns-nil ()
+ "Error: a path that does not exist yields no annotation."
+ (let* ((path (expand-file-name "definitely-not-here-12345.txt"
+ temporary-file-directory))
+ (annotate (cj/completion-file-annotator (lambda (_c) path))))
+ (should (null (funcall annotate "gone")))))
+
+(provide 'test-system-lib--completion-file-annotator)
+;;; test-system-lib--completion-file-annotator.el ends here