From 466ba73f13e65a1644d900456b4ff42aca27fa36 Mon Sep 17 00:00:00 2001 From: Charlie Holland Date: Mon, 25 May 2026 08:06:25 -0400 Subject: [PATCH 1/2] refactor: expand docstrings, simplify internals, drop ht and dash Rewrite the package with publication-quality docstrings and remove external dependencies in favour of Emacs built-ins. - Replace `ht` and `dash` with built-in hash tables, `seq`, and `cl-lib`. The package now requires only Emacs 28.1+. - Expand every public docstring with usage details, side effects, and examples; clarify the internal ones. - Simplify several internals: rewrite `--select-non-side-window` with `cl-find-if-not`; rename `--list-starts-with` to `--prefix-p` and reimplement with `seq-take`; drop the redundant "space-tree" sentinel key from the tree's root; inline `--get-parent-ht-at`; factor `go-right`/`go-left` through a shared `--go-by` helper; factor digit-address parsing into `--parse-digit-address`; simplify `switch-space-by-name`'s alist juggling. - Fix `paste-workspace`'s `(interactive)` so the prefix arg actually reaches `inplace`; drop the broken `(interactive)` from `switch-or-create`; require a match in `switch-space-by-name` so it can't pass nil downstream. - Replace the 19 hand-written lambdas in the README example with the existing `space-tree-to-*`/`-sub-*`/`-sub-sub-*` convenience commands; add a short section documenting that family. Co-Authored-By: Claude Opus 4.7 (1M context) --- Eask | 2 - README.md | 77 +++-- space-tree.el | 750 ++++++++++++++++++++++++---------------- test/space-tree-test.el | 122 ++++--- 4 files changed, 562 insertions(+), 389 deletions(-) diff --git a/Eask b/Eask index 3011f62..27cdcec 100644 --- a/Eask +++ b/Eask @@ -18,8 +18,6 @@ (source "melpa") (depends-on "emacs" "28.1") -(depends-on "ht" "2.3") -(depends-on "dash" "2.19") (development (depends-on "package-lint") diff --git a/README.md b/README.md index 1b45d49..c45ac21 100644 --- a/README.md +++ b/README.md @@ -78,6 +78,21 @@ Add `space-tree-modeline-lighter` to your modeline to see the current space: ...)) ``` +### Level-switch convenience commands + +For binding directly to keys, the package defines a family of commands +that switch to a fixed space at each of the first three levels: + +| Command family | What it switches to | +|-----------------------------------------|----------------------------------------| +| `space-tree-to-1` … `space-tree-to-9` | Top-level space N | +| `space-tree-sub-1` … `space-tree-sub-5` | Sub-space N of the current top-level | +| `space-tree-sub-sub-1` … `-sub-sub-5` | Sub-sub-space N of the current sub | + +These exist so you can bind keys without writing a lambda per binding. +For deeper levels or non-contiguous targets, write a small wrapper +around `space-tree-switch-or-create` that passes an explicit address. + ## Example Configuration Here's an example configuration using `general.el` for keybindings: @@ -90,47 +105,47 @@ Here's an example configuration using `general.el` for keybindings: ;; Top-level spaces with Super key + number (general-define-key - "s-1" (lambda () (interactive) (space-tree-switch-or-create '(1))) - "s-2" (lambda () (interactive) (space-tree-switch-or-create '(2))) - "s-3" (lambda () (interactive) (space-tree-switch-or-create '(3))) - "s-4" (lambda () (interactive) (space-tree-switch-or-create '(4))) - "s-5" (lambda () (interactive) (space-tree-switch-or-create '(5))) - "s-6" (lambda () (interactive) (space-tree-switch-or-create '(6))) - "s-7" (lambda () (interactive) (space-tree-switch-or-create '(7))) - "s-8" (lambda () (interactive) (space-tree-switch-or-create '(8))) - "s-9" (lambda () (interactive) (space-tree-switch-or-create '(9))) + "s-1" #'space-tree-to-1 + "s-2" #'space-tree-to-2 + "s-3" #'space-tree-to-3 + "s-4" #'space-tree-to-4 + "s-5" #'space-tree-to-5 + "s-6" #'space-tree-to-6 + "s-7" #'space-tree-to-7 + "s-8" #'space-tree-to-8 + "s-9" #'space-tree-to-9 ;; Second level (within current top-level space) - "s-a" (lambda () (interactive) (space-tree-switch-or-create `(,(nth 0 space-tree-current-address) 1))) - "s-s" (lambda () (interactive) (space-tree-switch-or-create `(,(nth 0 space-tree-current-address) 2))) - "s-d" (lambda () (interactive) (space-tree-switch-or-create `(,(nth 0 space-tree-current-address) 3))) - "s-f" (lambda () (interactive) (space-tree-switch-or-create `(,(nth 0 space-tree-current-address) 4))) - "s-g" (lambda () (interactive) (space-tree-switch-or-create `(,(nth 0 space-tree-current-address) 5))) + "s-a" #'space-tree-sub-1 + "s-s" #'space-tree-sub-2 + "s-d" #'space-tree-sub-3 + "s-f" #'space-tree-sub-4 + "s-g" #'space-tree-sub-5 ;; Third level (within current second-level space) - "s-A" (lambda () (interactive) (space-tree-switch-or-create `(,(nth 0 space-tree-current-address) ,(nth 1 space-tree-current-address) 1))) - "s-S" (lambda () (interactive) (space-tree-switch-or-create `(,(nth 0 space-tree-current-address) ,(nth 1 space-tree-current-address) 2))) - "s-D" (lambda () (interactive) (space-tree-switch-or-create `(,(nth 0 space-tree-current-address) ,(nth 1 space-tree-current-address) 3))) - "s-F" (lambda () (interactive) (space-tree-switch-or-create `(,(nth 0 space-tree-current-address) ,(nth 1 space-tree-current-address) 4))) - "s-G" (lambda () (interactive) (space-tree-switch-or-create `(,(nth 0 space-tree-current-address) ,(nth 1 space-tree-current-address) 5))) + "s-A" #'space-tree-sub-sub-1 + "s-S" #'space-tree-sub-sub-2 + "s-D" #'space-tree-sub-sub-3 + "s-F" #'space-tree-sub-sub-4 + "s-G" #'space-tree-sub-sub-5 ;; Navigation - "M-S-" 'space-tree-switch-space-by-name - "M-" 'space-tree-go-to-last-space - "C-M-" 'space-tree-go-right - "C-M-S-" 'space-tree-go-left + "M-S-" #'space-tree-switch-space-by-name + "M-" #'space-tree-go-to-last-space + "C-M-" #'space-tree-go-right + "C-M-S-" #'space-tree-go-left - ;; Delete current space - "s-_" (lambda () (interactive) (space-tree-delete-space space-tree-current-address))) + ;; Delete current space (the command defaults to the current address) + "s-_" #'space-tree-delete-space) ;; Evil/vim-style bindings (general-define-key :states '(normal visual) :keymaps 'override - "gt" 'space-tree-switch-current-level - "gT" 'space-tree-switch-space-by-digit-arg - "g+" 'space-tree-create-space-top-level - "gn" 'space-tree-create-space-current-level)) + "gt" #'space-tree-switch-current-level + "gT" #'space-tree-switch-space-by-digit-arg + "g+" #'space-tree-create-space-top-level + "gn" #'space-tree-create-space-current-level)) ``` ## Customization @@ -164,9 +179,7 @@ Each space stores its own window configuration, which is restored when you switc ## Dependencies -- Emacs 28.1+ -- [ht](https://github.com/Wilfred/ht.el) (2.3+) -- [dash](https://github.com/magnars/dash.el) (2.19+) +- Emacs 28.1+ (no external packages) ## License diff --git a/space-tree.el b/space-tree.el index 5cac9a2..7bc3ffb 100644 --- a/space-tree.el +++ b/space-tree.el @@ -8,7 +8,7 @@ ;; x-release-please-start-version ;; Version: 0.1.8 ;; x-release-please-end -;; Package-Requires: ((emacs "28.1") (ht "2.3") (dash "2.19")) +;; Package-Requires: ((emacs "28.1")) ;; Keywords: convenience, frames ;; ;; This file is not part of GNU Emacs. @@ -33,25 +33,42 @@ ;;; Commentary: -;; space-tree is a library for managing spaces in Emacs. It is inspired -;; by the concept of "workspaces" supported in the most major -;; operating systems' window managers, and is intended to be a -;; lightweight, but flexible alternative to packages tab-bar-mode and -;; eyebrowse. +;; space-tree organizes Emacs window configurations into a tree of +;; named "spaces" - similar to the workspaces offered by tiling window +;; managers, but with arbitrary nesting. It is intended as a +;; lightweight, flexible alternative to packages like `tab-bar-mode' +;; and `eyebrowse'. -;; The main features of space-tree are: +;; A *space* is a saved window configuration that can be switched to +;; by address. Spaces are nodes in a tree, addressed by lists of +;; integers (e.g. `(2 1 3)' means "third grandchild of the first child +;; of the second top-level space"). Each space stores its own window +;; layout, which is restored on switch. -;; - A tree-based structure (AKA the space-tree) for organizing -;; spaces, with branches of mixed and arbitrary depth -;; - A modeline indicator(s) for the current space and context in the -;; space-tree -;; - Commands for creating and managing spaces +;; The main features are: + +;; - A tree-based structure for spaces, with branches of mixed and +;; arbitrary depth. +;; - A modeline lighter (see `space-tree-modeline-lighter') that +;; shows the current space and surrounding context. +;; - Commands for creating, deleting, copying, renaming, and +;; navigating spaces. + +;; Typical setup: +;; +;; (require 'space-tree) +;; (space-tree-init) +;; (setq-default mode-line-format +;; (append mode-line-format +;; '((:eval (space-tree-modeline-lighter))))) +;; +;; See the README for example keybindings. ;;; Code: -;; Dependencies -(require 'ht) -(require 'dash) +(require 'cl-lib) +(require 'seq) +(require 'subr-x) ;;; Customization @@ -62,435 +79,572 @@ :prefix "space-tree-") (defcustom space-tree-start-at-0 nil - "If non-nil, the first space will be numbered 0. -Otherwise, the first space will be numbered 1." + "If non-nil, the first space created by `space-tree-init' is numbered 0. +Otherwise it is numbered 1. Numbering only affects how spaces are +labelled in the modeline and addressed by digit-encoded commands; it +does not affect the underlying tree structure." :type 'boolean :group 'space-tree) ;;; State +;; +;; These variables are public only so that user code may inspect them +;; (for keybindings, custom modeline elements, etc.). Do not mutate +;; them directly; use the commands and helpers in this file. + +(defvar space-tree-tree (make-hash-table :test 'equal) + "Root hash table holding the structural layout of all spaces. -(defvar space-tree-tree (ht-create) - "Nested hashtable representing the structural layout of spaces.") +Each node is a hash table whose keys are integer space numbers and +whose values are the child node hash tables. The variable itself is +the root. Reset by `space-tree-init'.") -(defvar space-tree-current-address '() - "Address of the current space as a list of numbers.") +(defvar space-tree-current-address nil + "Address of the currently selected space, as a list of integers. -(defvar space-tree-address-wconf-tbl (ht-create) - "A hashtable that stores window configurations for each space. -The keys are the addresses of the spaces and the values are the -window configurations.") +For example, (2 1 3) refers to the third space at depth 3, nested +under space 1 at depth 2, which is nested under top-level space 2. +The empty list indicates no space is selected (initial state before +`space-tree-init' is called).") -(defvar space-tree-recent-space-list '() - "A list of the addresses of the most recently visited spaces. -The most recently visited existing-space is at the head of the list.") +(defvar space-tree-address-wconf-tbl (make-hash-table :test 'equal) + "Hash table mapping each space's address to its saved window state. -(defvar space-tree-space-name-tbl (ht-create) - "A hashtable that stores names for each space. -The keys are the addresses of the spaces and the values are the names.") +Keys are address lists (see `space-tree-current-address') and values +are objects produced by `window-state-get'. When you switch to a +space, the corresponding window state is restored via +`window-state-put'.") + +(defvar space-tree-recent-space-list nil + "List of recently visited space addresses, most recent first. + +Used by `space-tree-switch-or-create' to resolve a partial address +to its most recently visited descendant - e.g. asking for (2) when +\(2 1) was last visited resolves to (2 1). Adjacent duplicates and +pure prefixes of later entries are compacted by +`space-tree--process-history'.") + +(defvar space-tree-space-name-tbl (make-hash-table :test 'equal) + "Hash table mapping space addresses to user-supplied display names. + +Set by `space-tree-name-current-space' and +`space-tree-name-space-by-digit-arg'. Named spaces appear in the +modeline by name instead of number and can be reached directly with +`space-tree-switch-space-by-name'.") (defvar space-tree-copied-space nil - "Copied window configuration for pasting into another space.") + "Window state captured by `space-tree-copy-workspace', or nil. + +Pasted into a space by `space-tree-paste-workspace'. This is an +internal clipboard, independent of the OS clipboard and the Emacs +kill ring. Preserved across calls to `space-tree-init'.") + + +;;; Hash-table helper +;; +;; Built-in `make-hash-table' is verbose to call repeatedly; this +;; helper standardises on `equal' comparison since most space-tree +;; tables use list keys. + +(defun space-tree--ht () + "Return a fresh empty hash table that compares keys with `equal'." + (make-hash-table :test 'equal)) ;;; Internal Utilities -(defun space-tree--window-state-put-safely (space) - "Switch to workspace SPACE, ignoring `Selecting deleted buffer' error." - (condition-case err - (window-state-put space) - (error - (if (string= "Selecting deleted buffer" (cadr err)) - (message "Space contains deleted buffers") - (signal (car err) (cdr err)))))) +(defun space-tree--prefix-p (prefix lst) + "Return non-nil if PREFIX is a prefix of LST. +Both arguments are lists; comparison is by `equal'." + (equal prefix (seq-take lst (length prefix)))) + +(defun space-tree--remove-adjacent-duplicates (lst) + "Return a copy of LST with runs of `equal' elements collapsed to one. +Non-adjacent duplicates are preserved." + (let (result) + (dolist (x lst (nreverse result)) + (unless (equal x (car result)) + (push x result))))) (defun space-tree--side-window-p () - "Return t if the current window is a side window, nil otherwise." + "Return non-nil if the selected window is a side window. + +Side windows are those created by `display-buffer-in-side-window' +and carry a `window-slot' parameter. space-tree avoids capturing +window state from them since they hold transient buffers like +compilation output, help, etc." (window-parameter (selected-window) 'window-slot)) (defun space-tree--select-non-side-window () - "Select a non-side window. -If there are no non-side windows, an error is thrown." + "Select the first non-side window in the current frame. + +If the selected window is a side window, switch focus to a normal +working window so that subsequent `window-state-get' / +`window-state-put' operations apply to the main layout. Signals an +error if every window in the frame is a side window." (when (space-tree--side-window-p) - (let ((num-windows (length (window-list))) - (found nil)) - (dotimes (_i num-windows) - (unless found - (other-window 1) - (unless (space-tree--side-window-p) - (setq found t)))) - (when (space-tree--side-window-p) (error "No non-side windows found"))))) + (if-let* ((win (cl-find-if-not + (lambda (w) (window-parameter w 'window-slot)) + (window-list)))) + (select-window win) + (error "No non-side windows found")))) (defun space-tree--delete-other-windows-and-switch-to-scratch () - "Delete all windows except the current one and switch to *scratch* buffer. -This is a means of creating a clean slate, typically for a new space." + "Clear the frame: delete all other windows and switch to `*scratch*'. + +Called when a newly created space should start with a clean slate +rather than inheriting the previous space's layout." (delete-other-windows) (switch-to-buffer (get-buffer-create "*scratch*"))) -(defun space-tree--list-starts-with (lista listb) - "Return t if LISTA start with LISTB, nil otherwise. -For example, (space-tree--list-starts-with \\='(1 2 3) \\='(1 2)) -returns t." - (equal (butlast lista (- (length lista) (length listb))) listb)) +(defun space-tree--window-state-put-safely (state) + "Restore window STATE, tolerating buffers that have been killed. + +If `window-state-put' fails with a \"Selecting deleted buffer\" +error (because a buffer captured in the state no longer exists), +inform the user with a message instead of raising. Any other error +is re-signalled." + (condition-case err + (window-state-put state) + (error + (if (string= "Selecting deleted buffer" (cadr err)) + (message "Space contains deleted buffers") + (signal (car err) (cdr err)))))) + +(defun space-tree--parse-digit-address (s) + "Parse digit string S into an address list of integers. + +If S contains the digit \"0\", it is treated as a level separator, +allowing multi-level addresses to be expressed as a single integer +prefix argument. See `space-tree-switch-space-by-digit-arg' for the +full encoding and worked examples." + (mapcar #'string-to-number + (if (string-match-p "0" s) + (split-string s "0" t) + (split-string s "" t)))) -(defun space-tree--remove-adjacent-duplicates (lst) - "Remove adjacent duplicates from the list LST." - (let ((result '())) - (dolist (x lst) - (if (not (equal x (car result))) - (setq result (cons x result)))) - (nreverse result))) ;;; Analyzing State -(defun space-tree--recent-space-on-path (sublist) - "Return first element of `space-tree-recent-space-list' matching SUBLIST. -If no element begins with SUBLIST, return nil." - (let ((n (length sublist))) - (car (-filter - (lambda (x) (equal (butlast x (- (length x) n)) sublist)) - space-tree-recent-space-list)))) +(defun space-tree--get (address) + "Return the tree node at ADDRESS in `space-tree-tree', or nil if absent. + +ADDRESS is a list of integer space numbers. An empty list returns +the root. The returned value is the child-hash-table at that node." + (let ((node space-tree-tree)) + (dolist (k address node) + (setq node (and node (gethash k node)))))) + +(defun space-tree--space-exists-p (address) + "Return non-nil if a space exists at ADDRESS." + (and (gethash address space-tree-address-wconf-tbl) t)) (defun space-tree--current-depth () - "Return the depth of the current space in the space-tree." + "Return the depth (number of levels) of the current space." (length space-tree-current-address)) -(defun space-tree--number-of-spaces-current-level () - "Return the number of spaces at the current level of the space-tree." - (length (ht-keys (space-tree--get-parent-ht-at space-tree-current-address)))) - (defun space-tree--current-parent () - "Return the address of the parent of the current space." + "Return the address of the parent of the current space. +Returns the empty list when the current space is at the top level." (butlast space-tree-current-address)) -(defun space-tree--space-exists-p (address) - "Return t if the space at the given ADDRESS exists, nil otherwise." - (member address (ht-keys space-tree-address-wconf-tbl))) +(defun space-tree--siblings-of (address) + "Return the sorted list of space numbers at the level of ADDRESS. +That is, the keys of ADDRESS's parent node, in ascending order." + (sort (hash-table-keys (space-tree--get (butlast address))) #'<)) +(defun space-tree--number-of-spaces-current-level () + "Return the count of spaces at the current address's level." + (length (space-tree--siblings-of space-tree-current-address))) -;;; State Mutation +(defun space-tree--recent-space-on-path (sublist) + "Return the most recently visited address that starts with SUBLIST. -(defun space-tree--get (address) - "Return the existing-space at the ADDRESS in the space-tree. -Return nil if the existing-space doesn't exist." - (apply #'ht-get* space-tree-tree "space-tree" address)) +Returns nil if no recent space has SUBLIST as a prefix. Used to +resolve a partial navigation like \"go to space 1\" into the most +recently visited descendant of that parent." + (cl-find-if (lambda (x) (space-tree--prefix-p sublist x)) + space-tree-recent-space-list)) -(defun space-tree--get-parent-ht-at (address) - "Return the parent of the existing-space at the ADDRESS." - (let ((parent-path (butlast address))) - (if parent-path - (apply #'ht-get* space-tree-tree "space-tree" parent-path) - (ht-get* space-tree-tree "space-tree")))) + +;;; State Mutation (defun space-tree--set (address) - "Set the ADDRESS in the space-tree to a new hashtable." - (ht-set (space-tree--get-parent-ht-at address) - (car (last address)) - (ht-create))) + "Create an empty child node at ADDRESS. -(defun space-tree--remove (address) - "Remove the space at ADDRESS from the space-tree." - (ht-remove (space-tree--get-parent-ht-at address) - (car (last address))) - (ht-remove space-tree-space-name-tbl address) - (ht-remove space-tree-address-wconf-tbl address) - (setq - space-tree-recent-space-list - (-remove - (lambda (x) (equal x address)) - space-tree-recent-space-list)) - (space-tree--process-history) - (force-mode-line-update)) +ADDRESS must be non-empty and its parent must already exist. +Overwrites any existing node at that address." + (puthash (car (last address)) + (space-tree--ht) + (space-tree--get (butlast address)))) (defun space-tree--process-history () - "Remove prefix sublists from `space-tree-recent-space-list'." + "Compact `space-tree-recent-space-list'. + +Removes addresses that are pure prefixes of a deeper address already +in the list (since the deeper address already captures the parent +context) and collapses adjacent duplicates." + (setq space-tree-recent-space-list + (space-tree--remove-adjacent-duplicates + (seq-remove + (lambda (a) + (cl-some (lambda (b) + (and (> (length b) (length a)) + (space-tree--prefix-p a b))) + space-tree-recent-space-list)) + space-tree-recent-space-list)))) + +(defun space-tree--remove (address) + "Delete the space at ADDRESS from all state. + +Removes the tree node, the saved window state, the user-defined +name (if any), and all references in the recent-space history. +Refreshes the modeline." + (remhash (car (last address)) (space-tree--get (butlast address))) + (remhash address space-tree-space-name-tbl) + (remhash address space-tree-address-wconf-tbl) (setq space-tree-recent-space-list - (space-tree--remove-adjacent-duplicates - (-remove - (lambda (sublista) - (-filter - (lambda (sublistb) - (and - (> (length sublistb) (length sublista)) - (space-tree--list-starts-with sublistb sublista))) - space-tree-recent-space-list)) - space-tree-recent-space-list)))) + (seq-remove (lambda (x) (equal x address)) + space-tree-recent-space-list)) + (space-tree--process-history) + (force-mode-line-update)) (defun space-tree--create-space-at (address) - "Add an existing space to the space-tree at ADDRESS." + "Create a new space at ADDRESS and switch to it. + +Establishes the tree node, captures the current window state as the +new space's starting layout, and clears the frame to a single +`*scratch*' window unless this is the first space at its level (in +which case the user's existing frame layout is preserved, e.g. for +the very first space created by `space-tree-init')." (space-tree--select-non-side-window) (space-tree--set address) (setq space-tree-current-address address) - (ht-set space-tree-address-wconf-tbl address (window-state-get)) - (setq space-tree-recent-space-list (cons space-tree-current-address space-tree-recent-space-list)) - ;; process list -- remove duplicates and branch nodes + (puthash address (window-state-get) space-tree-address-wconf-tbl) + (push space-tree-current-address space-tree-recent-space-list) (space-tree--process-history) (when (> (space-tree--number-of-spaces-current-level) 1) (space-tree--delete-other-windows-and-switch-to-scratch))) +(defun space-tree--save-wconf () + "Snapshot the current window state into the current space." + (puthash space-tree-current-address + (window-state-get) + space-tree-address-wconf-tbl)) + +(defun space-tree--switch (address &optional no-update-wconf) + "Switch to the existing space at ADDRESS. + +If NO-UPDATE-WCONF is non-nil, do not restore the saved window +state - used when the caller will redraw the frame separately, for +example when deleting the current space and switching to its parent +in one operation." + (space-tree--select-non-side-window) + (let ((wconf (gethash address space-tree-address-wconf-tbl))) + (unless no-update-wconf + (space-tree--window-state-put-safely wconf)) + (setq space-tree-current-address address) + (push space-tree-current-address space-tree-recent-space-list))) + ;;; Modeline -(defun space-tree--modeline-string-for-level (parent-address level spaces-this-level-ht) - "Return a string for the modeline for the given level of space-tree. -PARENT-ADDRESS is the address of the parent. -LEVEL is the current level number. -SPACES-THIS-LEVEL-HT is the hashtable of spaces at this level." +(defun space-tree--modeline-string-for-level + (parent-address selected-space-number spaces-at-this-level) + "Render one level of the modeline lighter as a string. + +PARENT-ADDRESS is the address of the parent node, used to look up +named spaces. SELECTED-SPACE-NUMBER is the number, at this level, +that lies on the current address; it is rendered in bold with a +trailing apostrophe. SPACES-AT-THIS-LEVEL is the hash table of +sibling nodes at this level." (mapconcat - (lambda (space-number) - (let ((space-name-or-number (or (ht-get - space-tree-space-name-tbl - (append parent-address `(,space-number))) - (number-to-string space-number)))) - (concat "" - (if (equal space-number level) - ;; need to change text to update modeline - (propertize (concat space-name-or-number "' ") 'face 'bold) - (concat space-name-or-number " "))))) - (sort (ht-keys spaces-this-level-ht) (lambda (a b) (< a b))) + (lambda (n) + (let ((label (or (gethash (append parent-address (list n)) + space-tree-space-name-tbl) + (number-to-string n)))) + (if (equal n selected-space-number) + (propertize (concat label "' ") 'face 'bold) + (concat label " ")))) + (sort (hash-table-keys spaces-at-this-level) #'<) "")) ;;;###autoload (defun space-tree-modeline-lighter () - "Return a string to be used as the modeline lighter for space-tree. -This is a critical UI element for space-tree, as it provides a visual -indication of the current space in space-tree, which can grow to be quite -large." - (let ((modeline-string "")) + "Return a string showing the current location within the space-tree. + +Intended for use inside `mode-line-format', typically wrapped in a +`(:eval ...)' form. The selected space at each level is bold and +marked with a trailing apostrophe; levels are separated by `|'. +Named spaces appear by name instead of number." + (let (parts) (dotimes (i (space-tree--current-depth)) - (let* ((parent-address (butlast space-tree-current-address (- (space-tree--current-depth) i))) - (selected-space-this-level (nth i space-tree-current-address)) - (spaces-this-level-ht (space-tree--get parent-address)) - (modeline-string-this-node (space-tree--modeline-string-for-level - parent-address - selected-space-this-level - spaces-this-level-ht)) - (modeline-string-to-this-level (concat - modeline-string - modeline-string-this-node - "| "))) - (setq modeline-string modeline-string-to-this-level))) - (concat "{ " (substring modeline-string 0 -2) "}"))) - - -;;; Public API + (let* ((parent (seq-take space-tree-current-address i)) + (selected (nth i space-tree-current-address)) + (level-ht (space-tree--get parent))) + (push (space-tree--modeline-string-for-level parent selected level-ht) + parts))) + (concat "{ " (mapconcat #'identity (nreverse parts) "| ") "}"))) + + +;;; Public API - Lifecycle ;;;###autoload (defun space-tree-init () - "Initialize space-tree. Can also be used to reset space-tree." + "Initialise space-tree, replacing any existing state. + +Resets the entire tree and creates a single top-level space. The +first space is numbered 1 by default, or 0 if `space-tree-start-at-0' +is non-nil. + +WARNING: any previously created spaces and their saved window states +are discarded. The internal copy/paste clipboard +\(`space-tree-copied-space') is preserved." (interactive) - (let ((first-space-number (if space-tree-start-at-0 0 1))) - (setq space-tree-tree (ht-create) - space-tree-address-wconf-tbl (ht-create) - space-tree-space-name-tbl (ht-create) - space-tree-recent-space-list '()) - (ht-set space-tree-tree "space-tree" (ht-create)) - (space-tree--create-space-at `(,first-space-number))) + (setq space-tree-tree (space-tree--ht) + space-tree-current-address nil + space-tree-address-wconf-tbl (space-tree--ht) + space-tree-space-name-tbl (space-tree--ht) + space-tree-recent-space-list nil) + (space-tree--create-space-at (list (if space-tree-start-at-0 0 1))) (force-mode-line-update)) -(defun space-tree--save-current-space () - "Save the current window configuration in `space-tree-address-wconf-tbl'." - (ht-set space-tree-address-wconf-tbl space-tree-current-address (window-state-get))) -(defun space-tree--switch (address &optional no-update-wconf) - "Switch to the existing-space at the ADDRESS. -If NO-UPDATE-WCONF is non-nil, don't update the window configuration." - (space-tree--select-non-side-window) - (let ((recent-space (ht-get space-tree-address-wconf-tbl address))) - (unless no-update-wconf - (space-tree--window-state-put-safely recent-space)) - (setq space-tree-current-address address - space-tree-recent-space-list (cons space-tree-current-address space-tree-recent-space-list)))) +;;; Public API - Navigation ;;;###autoload (defun space-tree-switch-or-create (new-address) - "Switch to the existing space indicated by NEW-ADDRESS, or create it. -This is the workhorse for navigating the space-tree." - (interactive) - (let* ((existing-space (ht-get space-tree-address-wconf-tbl new-address)) - (space-tree-recent-space-address (space-tree--recent-space-on-path new-address))) - ;; save the current window configuration, the one being switched from - (space-tree--save-current-space) - ;; switch to the new existing-space + "Switch to NEW-ADDRESS, creating the space there if it does not exist. + +NEW-ADDRESS is a list of integers giving the path through the tree +to the target space. If NEW-ADDRESS names a parent rather than a +leaf, the call resolves to the most recently visited descendant of +that parent (see `space-tree-recent-space-list'). Before switching, +the current space's window state is saved so it can be restored on +return. + +This is the workhorse used by all higher-level navigation commands +including the convenience wrappers `space-tree-to-1' .. `-to-9' and +`space-tree-sub-1' .. `-sub-5'. It is not directly interactive; +bind a wrapper lambda or use a digit-encoded command instead." + (let* ((existing (gethash new-address space-tree-address-wconf-tbl)) + (recent (space-tree--recent-space-on-path new-address))) + (space-tree--save-wconf) (cond - ;; IF new-address hasn't been visited yet, THEN create it - ((not existing-space) (space-tree--create-space-at new-address)) - ;; IF new-address points to a recent space or parent, THEN switch to it - (space-tree-recent-space-address (space-tree--switch space-tree-recent-space-address)))) - ;; update the modeline + ((not existing) (space-tree--create-space-at new-address)) + (recent (space-tree--switch recent)))) (force-mode-line-update)) ;;;###autoload (defun space-tree-create-space-current-level () - "Add a new space at the current level of the space-tree." + "Create a new sibling of the current space and switch to it. + +The new space is numbered one higher than the current largest +sibling at this level. Its window layout starts as a single +`*scratch*' buffer." (interactive) (let* ((parent (space-tree--current-parent)) - (tbl (space-tree--get parent)) - (next-level-number (+ 1 (apply #'max (ht-keys tbl))))) - (space-tree--create-space-at (append parent `(,next-level-number))))) + (siblings (hash-table-keys (space-tree--get parent))) + (next (1+ (apply #'max siblings)))) + (space-tree--create-space-at (append parent (list next))))) ;;;###autoload (defun space-tree-create-space-top-level () - "Add a new space at the top level of the space-tree." + "Create a new top-level space and switch to it. + +The new space is numbered one higher than the current largest +top-level space. Its window layout starts as a single `*scratch*' +buffer." (interactive) - (space-tree--create-space-at - `(,(+ 1 (apply #'max (ht-keys (ht-get space-tree-tree "space-tree"))))))) + (let ((next (1+ (apply #'max (hash-table-keys space-tree-tree))))) + (space-tree--create-space-at (list next)))) ;;;###autoload (defun space-tree-delete-space (address) - "Delete the space at the given ADDRESS. -If the space is the only space at its level, it is deleted and the parent -space is selected. Otherwise, the space is deleted and the next space at -the same level is selected." + "Delete the space at ADDRESS and all references to it. + +When called interactively, deletes the current space. Behaviour +depends on how many siblings the space has at its level: if it has +siblings, switch to the previous one (wrapping around) and delete; +if it is the only space at its level and not at the top, switch to +the parent and delete; if it is the only top-level space, signal +an error. + +Deletion also removes the saved window state, the user-defined name +\(if any), and all history references." (interactive (list space-tree-current-address)) - (let ((n-spaces (space-tree--number-of-spaces-current-level))) - (cond ((> n-spaces 1) (space-tree-go-left) (space-tree--remove address)) - ((and (= 1 n-spaces) (= (space-tree--current-depth) 1)) - (error "Cannot delete the only space")) - ((= 1 n-spaces) - (space-tree--switch (butlast address) t) - (space-tree--remove address))))) + (let ((n (space-tree--number-of-spaces-current-level))) + (cond ((> n 1) (space-tree-go-left) (space-tree--remove address)) + ((and (= n 1) (= (space-tree--current-depth) 1)) + (error "Cannot delete the only space")) + ((= n 1) + (space-tree--switch (butlast address) t) + (space-tree--remove address))))) ;;;###autoload (defun space-tree-copy-workspace () - "Copy the current workspace to the clipboard." + "Save the current window layout to space-tree's internal clipboard. + +This is independent of the OS clipboard and the Emacs kill ring. +The saved layout can later be inserted into another space with +`space-tree-paste-workspace'." (interactive) (setq space-tree-copied-space (window-state-get))) ;;;###autoload (defun space-tree-paste-workspace (&optional inplace) - "Paste the copied workspace to the current space. -If INPLACE is non-nil, the current space is overwritten with the copied space. -If INPLACE is nil, a new space is created and the copied space is pasted there. -If no space has been copied, an error is raised." - (interactive) - (when (not space-tree-copied-space) (error "No copied space")) + "Paste the copied window layout into a space. + +By default, create a new sibling space at the current level and +paste the layout there. With a prefix argument (INPLACE non-nil), +replace the current space's layout in place. + +Signals an error if `space-tree-copy-workspace' has not yet been +called in this session." + (interactive "P") + (unless space-tree-copied-space (error "No copied space")) (unless inplace (space-tree-create-space-current-level)) (space-tree--window-state-put-safely space-tree-copied-space)) ;;;###autoload (defun space-tree-switch-current-level (arg) - "Switch to the ith space at the current level of the space-tree. -ARG specifies which space to switch to. When called without a -prefix argument, prompts the user." + "Switch to space number ARG at the current depth. + +When called interactively with a prefix argument, ARG is taken from +it; otherwise the user is prompted. If no space numbered ARG exists +at this level, it is created (delegates to +`space-tree-switch-or-create')." (interactive "P") (let ((n (if arg - (prefix-numeric-value arg) - (string-to-number - (read-from-minibuffer "Switch to space: "))))) - (space-tree-switch-or-create (append (space-tree--current-parent) `(,n))))) + (prefix-numeric-value arg) + (string-to-number + (read-from-minibuffer "Switch to space: "))))) + (space-tree-switch-or-create + (append (space-tree--current-parent) (list n))))) ;;;###autoload (defun space-tree-switch-space-by-digit-arg (arg) - "Switch to a space using a multi-digit address ARG. -Digits are separated by 0 for multi-level addresses." + "Switch to the space whose multi-level address is encoded in ARG. + +ARG is a prefix argument that encodes a path through the tree as a +single integer. If ARG contains no 0, each digit names one level +\(so ARG=23 selects (2 3)). If ARG contains a 0, the digit 0 acts +as a level separator and the chunks between zeros become the levels +\(so ARG=203 also selects (2 3); ARG=12013 selects (12 13)). +Single-digit levels containing 0 are not addressable this way. + +When called interactively without a prefix argument, prompts for a +digit string. Creates the target space if it does not yet exist. + +Note that the zero-as-separator convention conflicts with +`space-tree-start-at-0' - a space numbered 0 cannot be reached this +way; use `space-tree-switch-or-create' with an explicit list address +in that case." (interactive "P") - (let* ((arg-string (if (not arg) - (read-from-minibuffer "Switch to space: ") - (number-to-string arg))) - (address (if (string-match-p "0" arg-string) - (split-string arg-string "0") - (-filter - (lambda (x) (> (length x) 0)) - (split-string arg-string "")))) - (address (-map (lambda (x) (string-to-number x)) address))) + (let* ((s (if arg + (number-to-string (prefix-numeric-value arg)) + (read-from-minibuffer "Switch to space: "))) + (address (space-tree--parse-digit-address s))) (space-tree-switch-or-create address))) ;;;###autoload (defun space-tree-switch-space-by-name () - "Switch to a named space. -Prompt the user to select from a list of named spaces." + "Prompt for a named space and switch to it. + +Only spaces that have been named via `space-tree-name-current-space' +or `space-tree-name-space-by-digit-arg' are offered. The prompt +requires a match - arbitrary input is rejected." (interactive) - (let* ((space-tree-named-spaces-reversed - (-map - (lambda (x) `(,(cdr x) . (,(car x)))) - (ht-to-alist space-tree-space-name-tbl))) - (name (completing-read - "Select a named space: " - space-tree-named-spaces-reversed)) - (address (car - (ht-get - (ht-from-alist space-tree-named-spaces-reversed) - name)))) - (space-tree-switch-or-create address))) + (let* ((entries (let (acc) + (maphash (lambda (addr name) + (push (cons name addr) acc)) + space-tree-space-name-tbl) + acc)) + (name (completing-read "Named space: " entries nil t))) + (space-tree-switch-or-create (cdr (assoc name entries))))) ;;;###autoload (defun space-tree-go-to-last-space () - "Switch to the most recently visited space." + "Switch back to the most recently visited space. +Signals a `user-error' if there is no prior space in the history." (interactive) - (if-let ((prev (nth 1 space-tree-recent-space-list))) + (if-let* ((prev (nth 1 space-tree-recent-space-list))) (space-tree-switch-or-create prev) (user-error "No previous space"))) +(defun space-tree--go-by (delta) + "Move DELTA positions among the current level's sorted siblings. +Wraps around at both ends, so going right from the rightmost lands +on the leftmost and vice versa." + (let* ((siblings (space-tree--siblings-of space-tree-current-address)) + (i (seq-position siblings (car (last space-tree-current-address)))) + (j (mod (+ i delta) (length siblings)))) + (space-tree-switch-current-level (nth j siblings)))) + ;;;###autoload (defun space-tree-go-right () - "Switch to the next space to the right at the current level." + "Switch to the next space rightward at the current depth. +Wraps around to the leftmost sibling when called from the rightmost." (interactive) - (let* ((spaces-current-level (sort - (ht-keys (space-tree--get (butlast space-tree-current-address))) - (lambda (a b) (< a b)))) - (current-position (-elem-index - (car (last space-tree-current-address)) - spaces-current-level)) - (target-position (+ 1 current-position))) - (if (>= target-position (space-tree--number-of-spaces-current-level)) - (space-tree-switch-current-level (car spaces-current-level)) - (space-tree-switch-current-level (nth target-position spaces-current-level))))) + (space-tree--go-by 1)) ;;;###autoload (defun space-tree-go-left () - "Switch to the next space to the left at the current level." + "Switch to the previous space leftward at the current depth. +Wraps around to the rightmost sibling when called from the leftmost." (interactive) - (let* ((spaces-current-level (sort - (ht-keys (space-tree--get (butlast space-tree-current-address))) - (lambda (a b) (< a b)))) - (current-position (-elem-index - (car (last space-tree-current-address)) - spaces-current-level)) - (target-position (- current-position 1))) - (if (< target-position 0) - (space-tree-switch-current-level (car (last spaces-current-level))) - (space-tree-switch-current-level (nth target-position spaces-current-level))))) + (space-tree--go-by -1)) + + +;;; Public API - Naming ;;;###autoload (defun space-tree-name-current-space (name) - "Name the current space, prompting the user for NAME." + "Assign NAME to the current space. + +The name replaces the numeric label in the modeline lighter and can +be used as a target for `space-tree-switch-space-by-name'. Names +are not required to be unique." (interactive "sName: ") - (ht-set space-tree-space-name-tbl space-tree-current-address name) + (puthash space-tree-current-address name space-tree-space-name-tbl) (force-mode-line-update)) ;;;###autoload (defun space-tree-name-space-by-digit-arg (arg) - "Name a space specified by digit ARG, prompting the user for a name." + "Name the space whose digit-encoded address is ARG. + +ARG is the interactive prefix argument; its encoding follows the +same rules as `space-tree-switch-space-by-digit-arg'. The user is +prompted in the minibuffer for the name." (interactive "p") - (let* ((arg-string (number-to-string arg)) - (address (if (string-match-p "0" arg-string) - (split-string arg-string "0") - (-filter - (lambda (x) (> (length x) 0)) - (split-string arg-string "")))) - (address (-map (lambda (x) (string-to-number x)) address))) - (ht-set space-tree-space-name-tbl address (completing-read "Name: " nil))) + (let* ((address (space-tree--parse-digit-address (number-to-string arg))) + (name (read-from-minibuffer "Name: "))) + (puthash address name space-tree-space-name-tbl)) (force-mode-line-update)) -;;; Convenience Commands +;;; Convenience: bind-friendly switch commands (defmacro space-tree--def-level-commands (prefix doc-template count &rest address-body) - "Define COUNT interactive switch commands named PREFIX-1 through PREFIX-COUNT. -DOC-TEMPLATE is a format string taking one integer arg for the docstring. -ADDRESS-BODY are forms that compute the address list; the variable `n' -is bound to the space number." + "Define COUNT interactive switch commands sharing a common PREFIX. + +For each integer i in 1..COUNT, define a function named `PREFIX-i' +that calls `space-tree-switch-or-create' with the address produced +by ADDRESS-BODY, with the variable `n' bound to i. + +DOC-TEMPLATE is a `format' template taking one integer argument; it +is used as the docstring of each generated command." (declare (indent 3)) `(progn ,@(mapcar - (lambda (i) - `(defun ,(intern (format "%s-%d" prefix i)) () - ,(format doc-template i) - (interactive) - (let ((n ,i)) - (space-tree-switch-or-create ,@address-body)))) - (number-sequence 1 count)))) + (lambda (i) + `(defun ,(intern (format "%s-%d" prefix i)) () + ,(format doc-template i) + (interactive) + (let ((n ,i)) + (space-tree-switch-or-create ,@address-body)))) + (number-sequence 1 count)))) (space-tree--def-level-commands "space-tree-to" "Switch to top-level space %d." 9 diff --git a/test/space-tree-test.el b/test/space-tree-test.el index 8555d54..c3a9c5b 100644 --- a/test/space-tree-test.el +++ b/test/space-tree-test.el @@ -10,8 +10,7 @@ (require 'cl-lib) (require 'ert) -(require 'ht) -(require 'dash) +(require 'subr-x) (require 'space-tree) @@ -20,11 +19,11 @@ (defmacro space-tree-test-with-clean-state (&rest body) "Execute BODY with all space-tree global state saved and restored." (declare (indent 0) (debug t)) - `(let ((space-tree-tree (ht-create)) + `(let ((space-tree-tree (make-hash-table :test 'equal)) (space-tree-current-address '()) - (space-tree-address-wconf-tbl (ht-create)) + (space-tree-address-wconf-tbl (make-hash-table :test 'equal)) (space-tree-recent-space-list '()) - (space-tree-space-name-tbl (ht-create)) + (space-tree-space-name-tbl (make-hash-table :test 'equal)) (space-tree-copied-space nil)) ,@body)) @@ -43,7 +42,6 @@ "Populate space-tree state from a list of ADDRESSES. Each address is a list of integers. Sets up tree structure, wconf table entries, current-address (last in list), and recent-space-list." - (ht-set space-tree-tree "space-tree" (ht-create)) (dolist (addr addresses) ;; Ensure all intermediate nodes exist (let ((path '())) @@ -52,7 +50,7 @@ table entries, current-address (last in list), and recent-space-list." (unless (space-tree--get path) (space-tree--set path)))) ;; Store a placeholder wconf - (ht-set space-tree-address-wconf-tbl addr `(mock-wconf ,addr))) + (puthash addr (list 'mock-wconf addr) space-tree-address-wconf-tbl)) ;; Current address is the last one given (setq space-tree-current-address (car (last addresses))) ;; Recent list is addresses in reverse order @@ -61,25 +59,25 @@ table entries, current-address (last in list), and recent-space-list." ;;; A. Pure Functions -;; space-tree--list-starts-with +;; space-tree--prefix-p -(ert-deftest space-tree-test-list-starts-with/match () - (should (space-tree--list-starts-with '(1 2 3) '(1 2)))) +(ert-deftest space-tree-test-prefix-p/match () + (should (space-tree--prefix-p '(1 2) '(1 2 3)))) -(ert-deftest space-tree-test-list-starts-with/exact () - (should (space-tree--list-starts-with '(1 2) '(1 2)))) +(ert-deftest space-tree-test-prefix-p/exact () + (should (space-tree--prefix-p '(1 2) '(1 2)))) -(ert-deftest space-tree-test-list-starts-with/no-match () - (should-not (space-tree--list-starts-with '(1 2 3) '(1 3)))) +(ert-deftest space-tree-test-prefix-p/no-match () + (should-not (space-tree--prefix-p '(1 3) '(1 2 3)))) -(ert-deftest space-tree-test-list-starts-with/empty-sub () - (should (space-tree--list-starts-with '(1 2 3) '()))) +(ert-deftest space-tree-test-prefix-p/empty-prefix () + (should (space-tree--prefix-p '() '(1 2 3)))) -(ert-deftest space-tree-test-list-starts-with/sub-longer () - (should-not (space-tree--list-starts-with '(1) '(1 2)))) +(ert-deftest space-tree-test-prefix-p/longer-prefix () + (should-not (space-tree--prefix-p '(1 2) '(1)))) -(ert-deftest space-tree-test-list-starts-with/both-empty () - (should (space-tree--list-starts-with '() '()))) +(ert-deftest space-tree-test-prefix-p/both-empty () + (should (space-tree--prefix-p '() '()))) ;; space-tree--remove-adjacent-duplicates @@ -110,6 +108,21 @@ table entries, current-address (last in list), and recent-space-list." '((1 2) (1 2) (3 4))) '((1 2) (3 4))))) +;; space-tree--parse-digit-address + +(ert-deftest space-tree-test-parse-digit-address/single-digit () + (should (equal (space-tree--parse-digit-address "3") '(3)))) + +(ert-deftest space-tree-test-parse-digit-address/multiple-digits () + (should (equal (space-tree--parse-digit-address "23") '(2 3)))) + +(ert-deftest space-tree-test-parse-digit-address/zero-separator () + (should (equal (space-tree--parse-digit-address "203") '(2 3)))) + +(ert-deftest space-tree-test-parse-digit-address/multi-digit-levels () + "When zero is the separator, each inter-zero chunk is one level." + (should (equal (space-tree--parse-digit-address "12013") '(12 13)))) + ;;; B. State-Reading Functions @@ -206,13 +219,13 @@ table entries, current-address (last in list), and recent-space-list." (space-tree-test-with-clean-state (space-tree-test-with-mock-windows (space-tree-test-build-tree '((1))) - (should (ht-p (space-tree--get '(1))))))) + (should (hash-table-p (space-tree--get '(1))))))) (ert-deftest space-tree-test-get/nested () (space-tree-test-with-clean-state (space-tree-test-with-mock-windows (space-tree-test-build-tree '((1 2))) - (should (ht-p (space-tree--get '(1 2))))))) + (should (hash-table-p (space-tree--get '(1 2))))))) (ert-deftest space-tree-test-get/nonexistent () (space-tree-test-with-clean-state @@ -220,24 +233,14 @@ table entries, current-address (last in list), and recent-space-list." (space-tree-test-build-tree '((1))) (should-not (space-tree--get '(9)))))) -;; space-tree--get-parent-ht-at - -(ert-deftest space-tree-test-get-parent-ht-at/nested () - (space-tree-test-with-clean-state - (space-tree-test-with-mock-windows - (space-tree-test-build-tree '((1) (1 2))) - (let ((parent (space-tree--get-parent-ht-at '(1 2)))) - (should (ht-p parent)) - (should (ht-contains-p parent 2)))))) - -(ert-deftest space-tree-test-get-parent-ht-at/top-level () +(ert-deftest space-tree-test-get/empty-address-is-root () (space-tree-test-with-clean-state (space-tree-test-with-mock-windows (space-tree-test-build-tree '((1) (2))) - (let ((parent (space-tree--get-parent-ht-at '(1)))) - (should (ht-p parent)) - (should (ht-contains-p parent 1)) - (should (ht-contains-p parent 2)))))) + (let ((root (space-tree--get '()))) + (should (hash-table-p root)) + (should (gethash 1 root)) + (should (gethash 2 root)))))) ;;; C. State-Mutation Functions @@ -247,26 +250,23 @@ table entries, current-address (last in list), and recent-space-list." (ert-deftest space-tree-test-set/new-top-level () (space-tree-test-with-clean-state (space-tree-test-with-mock-windows - (ht-set space-tree-tree "space-tree" (ht-create)) (space-tree--set '(1)) - (should (ht-p (space-tree--get '(1))))))) + (should (hash-table-p (space-tree--get '(1))))))) (ert-deftest space-tree-test-set/nested () (space-tree-test-with-clean-state (space-tree-test-with-mock-windows - (ht-set space-tree-tree "space-tree" (ht-create)) (space-tree--set '(1)) (space-tree--set '(1 2)) - (should (ht-p (space-tree--get '(1 2))))))) + (should (hash-table-p (space-tree--get '(1 2))))))) (ert-deftest space-tree-test-set/deep () (space-tree-test-with-clean-state (space-tree-test-with-mock-windows - (ht-set space-tree-tree "space-tree" (ht-create)) (space-tree--set '(1)) (space-tree--set '(1 2)) (space-tree--set '(1 2 3)) - (should (ht-p (space-tree--get '(1 2 3))))))) + (should (hash-table-p (space-tree--get '(1 2 3))))))) ;; space-tree--remove @@ -276,7 +276,7 @@ table entries, current-address (last in list), and recent-space-list." (space-tree-test-build-tree '((1) (2))) (space-tree--remove '(2)) (should-not (space-tree--get '(2))) - (should-not (ht-get space-tree-address-wconf-tbl '(2)))))) + (should-not (gethash '(2) space-tree-address-wconf-tbl))))) (ert-deftest space-tree-test-remove/nested () (space-tree-test-with-clean-state @@ -286,15 +286,15 @@ table entries, current-address (last in list), and recent-space-list." (space-tree--remove '(1 1)) (should-not (space-tree--get '(1 1))) ;; Parent still has remaining child - (should (ht-p (space-tree--get '(1 2))))))) + (should (hash-table-p (space-tree--get '(1 2))))))) (ert-deftest space-tree-test-remove/cleans-name () (space-tree-test-with-clean-state (space-tree-test-with-mock-windows (space-tree-test-build-tree '((1) (2))) - (ht-set space-tree-space-name-tbl '(2) "work") + (puthash '(2) "work" space-tree-space-name-tbl) (space-tree--remove '(2)) - (should-not (ht-get space-tree-space-name-tbl '(2)))))) + (should-not (gethash '(2) space-tree-space-name-tbl))))) (ert-deftest space-tree-test-remove/cleans-history () (space-tree-test-with-clean-state @@ -334,8 +334,8 @@ table entries, current-address (last in list), and recent-space-list." (let ((space-tree-start-at-0 nil)) (space-tree-init) (should (equal space-tree-current-address '(1))) - (should (ht-get space-tree-address-wconf-tbl '(1))) - (should (ht-p (space-tree--get '(1)))))))) + (should (gethash '(1) space-tree-address-wconf-tbl)) + (should (hash-table-p (space-tree--get '(1)))))))) (ert-deftest space-tree-test-init/start-at-0 () (space-tree-test-with-clean-state @@ -343,21 +343,21 @@ table entries, current-address (last in list), and recent-space-list." (let ((space-tree-start-at-0 t)) (space-tree-init) (should (equal space-tree-current-address '(0))) - (should (ht-get space-tree-address-wconf-tbl '(0))))))) + (should (gethash '(0) space-tree-address-wconf-tbl)))))) (ert-deftest space-tree-test-init/resets-state () "Init clears any pre-existing state." (space-tree-test-with-clean-state (space-tree-test-with-mock-windows (space-tree-test-build-tree '((1) (2) (3))) - (ht-set space-tree-space-name-tbl '(1) "old") + (puthash '(1) "old" space-tree-space-name-tbl) (let ((space-tree-start-at-0 nil)) (space-tree-init) ;; Old spaces gone - (should-not (ht-get space-tree-address-wconf-tbl '(2))) - (should-not (ht-get space-tree-address-wconf-tbl '(3))) + (should-not (gethash '(2) space-tree-address-wconf-tbl)) + (should-not (gethash '(3) space-tree-address-wconf-tbl)) ;; Name table cleared - (should (= (ht-size space-tree-space-name-tbl) 0)))))) + (should (= (hash-table-count space-tree-space-name-tbl) 0)))))) ;; space-tree--switch @@ -398,7 +398,7 @@ table entries, current-address (last in list), and recent-space-list." (setq space-tree-current-address '(1)) (space-tree-switch-or-create '(2)) (should (equal space-tree-current-address '(2))) - (should (ht-get space-tree-address-wconf-tbl '(2)))))) + (should (gethash '(2) space-tree-address-wconf-tbl))))) (ert-deftest space-tree-test-switch-or-create/via-recent () "Navigating to a parent address resolves via recent list." @@ -408,7 +408,7 @@ table entries, current-address (last in list), and recent-space-list." (setq space-tree-current-address '(1)) (setq space-tree-recent-space-list '((1 2) (1 1) (1))) (space-tree-switch-or-create '(1)) - ;; Should resolve to (1 2) — first recent space on path (1) + ;; Should resolve to (1 2) - first recent space on path (1) (should (equal space-tree-current-address '(1 2)))))) @@ -450,10 +450,18 @@ table entries, current-address (last in list), and recent-space-list." (space-tree-test-with-clean-state (space-tree-test-with-mock-windows (space-tree-test-build-tree '((1) (2))) - (ht-set space-tree-space-name-tbl '(2) "work") + (puthash '(2) "work" space-tree-space-name-tbl) (let ((result (space-tree-modeline-lighter))) (should (string-match-p "work" result)))))) +(ert-deftest space-tree-test-modeline/empty-depth () + "Modeline with no current address renders an empty wrapper." + (space-tree-test-with-clean-state + (let ((result (space-tree-modeline-lighter))) + (should (stringp result)) + (should (string-match-p "^{" result)) + (should (string-match-p "}$" result))))) + (provide 'space-tree-test) ;;; space-tree-test.el ends here From f9af37323b98209f9aed3514d431b11f0bd48d1f Mon Sep 17 00:00:00 2001 From: Charlie Holland Date: Mon, 25 May 2026 08:14:29 -0400 Subject: [PATCH 2/2] fix: replace cryptic errors with user-error when state is invalid Address Copilot review feedback on PR #18. - Add `space-tree--validate-address' which signals a clear user-error when an address is nil (space-tree not initialised) or contains a nil component (level-based convenience command invoked from too shallow a depth). - Call the validator at entry to `space-tree-switch-or-create' (which every navigation command funnels through) and in `space-tree--go-by'. - Make `space-tree--save-wconf' a no-op when no current space is selected, instead of writing a nil-keyed entry. - Spell out the full `space-tree-sub-sub-5' name in the README convenience-command table for consistency. Co-Authored-By: Claude Opus 4.7 (1M context) --- README.md | 10 +++++----- space-tree.el | 28 ++++++++++++++++++++++++---- test/space-tree-test.el | 14 ++++++++++++++ 3 files changed, 43 insertions(+), 9 deletions(-) diff --git a/README.md b/README.md index c45ac21..ba31d74 100644 --- a/README.md +++ b/README.md @@ -83,11 +83,11 @@ Add `space-tree-modeline-lighter` to your modeline to see the current space: For binding directly to keys, the package defines a family of commands that switch to a fixed space at each of the first three levels: -| Command family | What it switches to | -|-----------------------------------------|----------------------------------------| -| `space-tree-to-1` … `space-tree-to-9` | Top-level space N | -| `space-tree-sub-1` … `space-tree-sub-5` | Sub-space N of the current top-level | -| `space-tree-sub-sub-1` … `-sub-sub-5` | Sub-sub-space N of the current sub | +| Command family | What it switches to | +|-------------------------------------------------|--------------------------------------| +| `space-tree-to-1` … `space-tree-to-9` | Top-level space N | +| `space-tree-sub-1` … `space-tree-sub-5` | Sub-space N of the current top-level | +| `space-tree-sub-sub-1` … `space-tree-sub-sub-5` | Sub-sub-space N of the current sub | These exist so you can bind keys without writing a lambda per binding. For deeper levels or non-contiguous targets, write a small wrapper diff --git a/space-tree.el b/space-tree.el index 7bc3ffb..ae8444e 100644 --- a/space-tree.el +++ b/space-tree.el @@ -224,6 +224,21 @@ full encoding and worked examples." (split-string s "0" t) (split-string s "" t)))) +(defun space-tree--validate-address (address) + "Signal a `user-error' if ADDRESS is unusable. + +An address is unusable when it is nil (no space is selected yet - +space-tree has not been initialised) or when any of its components +are nil (typically because a level-based convenience command was +invoked from a shallower depth than it expects)." + (cond + ((null address) + (user-error + "No space selected; call `space-tree-init' first")) + ((cl-some #'null address) + (user-error + "Cannot navigate to %S; current depth is too shallow" address)))) + ;;; Analyzing State @@ -328,10 +343,13 @@ the very first space created by `space-tree-init')." (space-tree--delete-other-windows-and-switch-to-scratch))) (defun space-tree--save-wconf () - "Snapshot the current window state into the current space." - (puthash space-tree-current-address - (window-state-get) - space-tree-address-wconf-tbl)) + "Snapshot the current window state into the current space. +No-op when no space is currently selected, so callers can invoke +this unconditionally without first checking initialisation state." + (when space-tree-current-address + (puthash space-tree-current-address + (window-state-get) + space-tree-address-wconf-tbl))) (defun space-tree--switch (address &optional no-update-wconf) "Switch to the existing space at ADDRESS. @@ -428,6 +446,7 @@ This is the workhorse used by all higher-level navigation commands including the convenience wrappers `space-tree-to-1' .. `-to-9' and `space-tree-sub-1' .. `-sub-5'. It is not directly interactive; bind a wrapper lambda or use a digit-encoded command instead." + (space-tree--validate-address new-address) (let* ((existing (gethash new-address space-tree-address-wconf-tbl)) (recent (space-tree--recent-space-on-path new-address))) (space-tree--save-wconf) @@ -577,6 +596,7 @@ Signals a `user-error' if there is no prior space in the history." "Move DELTA positions among the current level's sorted siblings. Wraps around at both ends, so going right from the rightmost lands on the leftmost and vice versa." + (space-tree--validate-address space-tree-current-address) (let* ((siblings (space-tree--siblings-of space-tree-current-address)) (i (seq-position siblings (car (last space-tree-current-address)))) (j (mod (+ i delta) (length siblings)))) diff --git a/test/space-tree-test.el b/test/space-tree-test.el index c3a9c5b..c2eceda 100644 --- a/test/space-tree-test.el +++ b/test/space-tree-test.el @@ -123,6 +123,20 @@ table entries, current-address (last in list), and recent-space-list." "When zero is the separator, each inter-zero chunk is one level." (should (equal (space-tree--parse-digit-address "12013") '(12 13)))) +;; space-tree--validate-address + +(ert-deftest space-tree-test-validate-address/nil-errors () + "A nil address is rejected with a user-error." + (should-error (space-tree--validate-address nil) :type 'user-error)) + +(ert-deftest space-tree-test-validate-address/nil-component-errors () + "An address containing a nil component is rejected with a user-error." + (should-error (space-tree--validate-address '(1 nil 2)) :type 'user-error)) + +(ert-deftest space-tree-test-validate-address/valid-passes () + "A well-formed address does not signal." + (should-not (space-tree--validate-address '(1 2 3)))) + ;;; B. State-Reading Functions