From 1534be5b365431c885c4c5c09c7f157d94a9f942 Mon Sep 17 00:00:00 2001 From: Craig Jennings Date: Fri, 14 Nov 2025 01:22:36 -0600 Subject: feat(mousetrap): Add profile-based architecture and clickable lighter MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Implement comprehensive profile-based system for selective mouse event control with dynamic lighter and interactive toggling. Features: - Profile-based architecture (7 profiles: disabled, scroll-only, primary-click, scroll+primary, read-only, interactive, full) - Mode-specific configuration (dashboard, pdf-view, nov) - Dynamic keymap building based on current major mode - Clickable modeline lighter (🐭 when off, 🪤 when on) - Dynamic reconfiguration without Emacs reload - Mode inheritance support via derived-mode-p Profiles define which event categories are allowed: - primary-click: Left mouse button only - secondary-click: Middle and right buttons - drags: Drag selections - multi-clicks: Double and triple clicks - scroll: Mouse wheel/trackpad scrolling Default configuration: - dashboard-mode: primary-click (left-click only) - pdf-view-mode: full (all events) - nov-mode: full (all events) - Other modes: disabled (all events blocked) Tests: - 66 comprehensive tests across 5 test files - Unit tests for profile lookup and keymap building - Integration tests for mode switching and dynamic config - Lighter functionality and click interaction tests - All tests passing Known issue: - Dashboard-mode clicks blocked despite primary-click profile - Documented in todo.org for investigation 🤖 Generated with [Claude Code](https://claude.com/claude-code) Co-Authored-By: Claude --- tests/test-mousetrap-mode--build-keymap.el | 262 +++++++++++++++++++++++++++++ 1 file changed, 262 insertions(+) create mode 100644 tests/test-mousetrap-mode--build-keymap.el (limited to 'tests/test-mousetrap-mode--build-keymap.el') diff --git a/tests/test-mousetrap-mode--build-keymap.el b/tests/test-mousetrap-mode--build-keymap.el new file mode 100644 index 00000000..d632cc9a --- /dev/null +++ b/tests/test-mousetrap-mode--build-keymap.el @@ -0,0 +1,262 @@ +;;; test-mousetrap-mode--build-keymap.el --- Tests for keymap building -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for mouse-trap--build-keymap function. +;; Tests keymap generation for different profiles, event categories, +;; modifiers, and edge cases. + +;;; Code: + +(require 'ert) +(require 'mousetrap-mode) + +;;; Normal Cases + +(ert-deftest test-mousetrap-mode--build-keymap-normal-disabled-profile-blocks-all-events () + "Test disabled profile blocks all mouse events." + (let ((major-mode 'test-mode) + (mouse-trap-mode-profiles '((test-mode . disabled)))) + (let ((map (mouse-trap--build-keymap))) + (should (keymapp map)) + ;; Check various events are blocked + (should (eq (lookup-key map (kbd "")) 'ignore)) + (should (eq (lookup-key map (kbd "")) 'ignore)) + (should (eq (lookup-key map (kbd "")) 'ignore)) + (should (eq (lookup-key map (kbd "")) 'ignore))))) + +(ert-deftest test-mousetrap-mode--build-keymap-normal-scroll-only-allows-scroll () + "Test scroll-only profile allows scroll, blocks clicks." + (let ((major-mode 'test-mode) + (mouse-trap-mode-profiles '((test-mode . scroll-only)))) + (let ((map (mouse-trap--build-keymap))) + (should (keymapp map)) + ;; Wheel events should NOT be in map (allowed) + (should (eq (lookup-key map (kbd "")) nil)) + (should (eq (lookup-key map (kbd "")) nil)) + ;; Click events should be blocked + (should (eq (lookup-key map (kbd "")) 'ignore)) + (should (eq (lookup-key map (kbd "")) 'ignore))))) + +(ert-deftest test-mousetrap-mode--build-keymap-normal-primary-click-allows-left-click () + "Test primary-click profile allows mouse-1, blocks others." + (let ((major-mode 'test-mode) + (mouse-trap-mode-profiles '((test-mode . primary-click)))) + (let ((map (mouse-trap--build-keymap))) + (should (keymapp map)) + ;; mouse-1 should NOT be in map (allowed) + (should (eq (lookup-key map (kbd "")) nil)) + (should (eq (lookup-key map (kbd "")) nil)) + ;; mouse-2/3 should be blocked + (should (eq (lookup-key map (kbd "")) 'ignore)) + (should (eq (lookup-key map (kbd "")) 'ignore)) + ;; Scroll should be blocked + (should (eq (lookup-key map (kbd "")) 'ignore))))) + +(ert-deftest test-mousetrap-mode--build-keymap-normal-scroll-plus-primary-allows-both () + "Test scroll+primary profile allows scrolling and left click." + (let ((major-mode 'test-mode) + (mouse-trap-mode-profiles '((test-mode . scroll+primary)))) + (let ((map (mouse-trap--build-keymap))) + (should (keymapp map)) + ;; Allowed events + (should (eq (lookup-key map (kbd "")) nil)) + (should (eq (lookup-key map (kbd "")) nil)) + ;; Blocked events + (should (eq (lookup-key map (kbd "")) 'ignore)) + (should (eq (lookup-key map (kbd "")) 'ignore))))) + +(ert-deftest test-mousetrap-mode--build-keymap-normal-full-profile-allows-all () + "Test full profile allows all events." + (let ((major-mode 'test-mode) + (mouse-trap-mode-profiles '((test-mode . full)))) + (let ((map (mouse-trap--build-keymap))) + (should (keymapp map)) + ;; All events should be allowed (not in map) + (should (eq (lookup-key map (kbd "")) nil)) + (should (eq (lookup-key map (kbd "")) nil)) + (should (eq (lookup-key map (kbd "")) nil)) + (should (eq (lookup-key map (kbd "")) nil)) + (should (eq (lookup-key map (kbd "")) nil))))) + +(ert-deftest test-mousetrap-mode--build-keymap-normal-read-only-profile () + "Test read-only profile allows scrolling and all clicks, blocks drags/multi-clicks." + (let ((major-mode 'test-mode) + (mouse-trap-mode-profiles '((test-mode . read-only)))) + (let ((map (mouse-trap--build-keymap))) + (should (keymapp map)) + ;; Allowed: scroll and all clicks + (should (eq (lookup-key map (kbd "")) nil)) + (should (eq (lookup-key map (kbd "")) nil)) + (should (eq (lookup-key map (kbd "")) nil)) + ;; Blocked: drags and multi-clicks + (should (eq (lookup-key map (kbd "")) 'ignore)) + (should (eq (lookup-key map (kbd "")) 'ignore))))) + +(ert-deftest test-mousetrap-mode--build-keymap-normal-interactive-profile () + "Test interactive profile allows scrolling, clicks, drags; blocks multi-clicks." + (let ((major-mode 'test-mode) + (mouse-trap-mode-profiles '((test-mode . interactive)))) + (let ((map (mouse-trap--build-keymap))) + (should (keymapp map)) + ;; Allowed: scroll, clicks, drags + (should (eq (lookup-key map (kbd "")) nil)) + (should (eq (lookup-key map (kbd "")) nil)) + (should (eq (lookup-key map (kbd "")) nil)) + ;; Blocked: multi-clicks + (should (eq (lookup-key map (kbd "")) 'ignore)) + (should (eq (lookup-key map (kbd "")) 'ignore))))) + +;;; Boundary Cases + +(ert-deftest test-mousetrap-mode--build-keymap-boundary-single-category-profile () + "Test profile with single category works correctly." + (let ((major-mode 'test-mode) + (mouse-trap-mode-profiles '((test-mode . primary-click)))) + (let ((map (mouse-trap--build-keymap))) + (should (keymapp map)) + ;; Only primary-click should be allowed + (should (eq (lookup-key map (kbd "")) nil)) + ;; Everything else blocked + (should (eq (lookup-key map (kbd "")) 'ignore)) + (should (eq (lookup-key map (kbd "")) 'ignore)) + (should (eq (lookup-key map (kbd "")) 'ignore)) + (should (eq (lookup-key map (kbd "")) 'ignore))))) + +(ert-deftest test-mousetrap-mode--build-keymap-boundary-all-modifiers-included () + "Test all modifier combinations are handled." + (let ((major-mode 'test-mode) + (mouse-trap-mode-profiles '((test-mode . scroll-only)))) + (let ((map (mouse-trap--build-keymap))) + (should (keymapp map)) + ;; Check various modifier combinations are blocked for clicks + (should (eq (lookup-key map (kbd "")) 'ignore)) + (should (eq (lookup-key map (kbd "")) 'ignore)) + (should (eq (lookup-key map (kbd "")) 'ignore)) + (should (eq (lookup-key map (kbd "")) 'ignore)) + (should (eq (lookup-key map (kbd "")) 'ignore)) + (should (eq (lookup-key map (kbd "")) 'ignore)) + (should (eq (lookup-key map (kbd "")) 'ignore)) + (should (eq (lookup-key map (kbd "")) 'ignore))))) + +(ert-deftest test-mousetrap-mode--build-keymap-boundary-all-button-numbers () + "Test button numbers handled according to category definitions. +Buttons 1-3 are in click categories, buttons 1-5 are in drag/multi-click." + (let ((major-mode 'test-mode) + (mouse-trap-mode-profiles '((test-mode . scroll-only)))) + (let ((map (mouse-trap--build-keymap))) + (should (keymapp map)) + ;; Primary and secondary click buttons (1-3) should be blocked + (should (eq (lookup-key map (kbd "")) 'ignore)) + (should (eq (lookup-key map (kbd "")) 'ignore)) + (should (eq (lookup-key map (kbd "")) 'ignore)) + ;; Drag events include all buttons (1-5) + (should (eq (lookup-key map (kbd "")) 'ignore)) + (should (eq (lookup-key map (kbd "")) 'ignore)) + (should (eq (lookup-key map (kbd "")) 'ignore))))) + +(ert-deftest test-mousetrap-mode--build-keymap-boundary-all-wheel-directions () + "Test all wheel directions are handled." + (let ((major-mode 'test-mode) + (mouse-trap-mode-profiles '((test-mode . primary-click)))) + (let ((map (mouse-trap--build-keymap))) + (should (keymapp map)) + ;; All wheel directions should be blocked (not in primary-click) + (should (eq (lookup-key map (kbd "")) 'ignore)) + (should (eq (lookup-key map (kbd "")) 'ignore)) + (should (eq (lookup-key map (kbd "")) 'ignore)) + (should (eq (lookup-key map (kbd "")) 'ignore))))) + +(ert-deftest test-mousetrap-mode--build-keymap-boundary-returns-valid-keymap () + "Test function always returns a valid keymap." + (let ((major-mode 'test-mode) + (mouse-trap-mode-profiles '((test-mode . disabled)))) + (let ((map (mouse-trap--build-keymap))) + (should (keymapp map))))) + +;;; Error Cases + +(ert-deftest test-mousetrap-mode--build-keymap-error-nil-profile-blocks-all () + "Test nil profile (unmapped) blocks all events." + (let ((major-mode 'unmapped-mode) + (mouse-trap-mode-profiles '((test-mode . disabled))) + (mouse-trap-profiles '((disabled . ())))) + ;; This mode will get nil from alist-get, treated as empty list + (let ((map (mouse-trap--build-keymap))) + (should (keymapp map)) + ;; With default scroll-only, clicks should be blocked + (should (eq (lookup-key map (kbd "")) 'ignore))))) + +(ert-deftest test-mousetrap-mode--build-keymap-error-invalid-category-ignored () + "Test invalid category in profile is gracefully ignored." + (let ((major-mode 'test-mode) + (mouse-trap-profiles '((test-profile . (scroll invalid-category primary-click)))) + (mouse-trap-mode-profiles '((test-mode . test-profile)))) + (let ((map (mouse-trap--build-keymap))) + (should (keymapp map)) + ;; Valid categories should work + (should (eq (lookup-key map (kbd "")) nil)) ; scroll allowed + (should (eq (lookup-key map (kbd "")) nil)) ; primary-click allowed + ;; Other events should be blocked + (should (eq (lookup-key map (kbd "")) 'ignore))))) + +(ert-deftest test-mousetrap-mode--build-keymap-error-empty-category-spec-ignored () + "Test empty category spec is handled gracefully." + (let ((major-mode 'test-mode) + (mouse-trap-mode-profiles '((test-mode . disabled))) + (mouse-trap--event-categories + '((primary-click . ((types . ("mouse" "down-mouse")) + (buttons . (1)))) + (empty-category . ()) ; Empty spec + (scroll . ((wheel . ("wheel-up" "wheel-down"))))))) + (let ((map (mouse-trap--build-keymap))) + (should (keymapp map)) + ;; Should still work despite empty category + (should (eq (lookup-key map (kbd "")) 'ignore))))) + +;;; Edge Cases + +(ert-deftest test-mousetrap-mode--build-keymap-edge-event-bound-to-ignore-function () + "Test blocked events are bound to ignore function, not nil." + (let ((major-mode 'test-mode) + (mouse-trap-mode-profiles '((test-mode . disabled)))) + (let ((map (mouse-trap--build-keymap))) + (should (keymapp map)) + ;; Check binding is exactly 'ignore + (should (eq (lookup-key map (kbd "")) 'ignore)) + (should-not (eq (lookup-key map (kbd "")) nil))))) + +(ert-deftest test-mousetrap-mode--build-keymap-edge-allowed-events-not-in-keymap () + "Test allowed events are not present in keymap (nil lookup)." + (let ((major-mode 'test-mode) + (mouse-trap-mode-profiles '((test-mode . scroll-only)))) + (let ((map (mouse-trap--build-keymap))) + (should (keymapp map)) + ;; Allowed events should return nil from lookup + (should (eq (lookup-key map (kbd "")) nil)) + (should (eq (lookup-key map (kbd "")) nil))))) + +(ert-deftest test-mousetrap-mode--build-keymap-edge-drag-vs-click-separation () + "Test drag events are independent from click events." + (let ((major-mode 'test-mode) + (mouse-trap-mode-profiles '((test-mode . primary-click)))) + (let ((map (mouse-trap--build-keymap))) + (should (keymapp map)) + ;; mouse-1 allowed + (should (eq (lookup-key map (kbd "")) nil)) + ;; drag-mouse-1 blocked + (should (eq (lookup-key map (kbd "")) 'ignore))))) + +(ert-deftest test-mousetrap-mode--build-keymap-edge-double-vs-single-click-separation () + "Test multi-clicks are independent from single clicks." + (let ((major-mode 'test-mode) + (mouse-trap-mode-profiles '((test-mode . primary-click)))) + (let ((map (mouse-trap--build-keymap))) + (should (keymapp map)) + ;; mouse-1 allowed + (should (eq (lookup-key map (kbd "")) nil)) + ;; double-mouse-1 blocked + (should (eq (lookup-key map (kbd "")) 'ignore)) + (should (eq (lookup-key map (kbd "")) 'ignore))))) + +(provide 'test-mousetrap-mode--build-keymap) +;;; test-mousetrap-mode--build-keymap.el ends here -- cgit v1.2.3