diff options
| -rw-r--r-- | modules/mousetrap-mode.el | 225 | ||||
| -rw-r--r-- | tests/test-integration-mousetrap-mode-lighter-click.el | 174 | ||||
| -rw-r--r-- | tests/test-integration-mousetrap-mode-profiles.el | 374 | ||||
| -rw-r--r-- | tests/test-mousetrap-mode--build-keymap.el | 262 | ||||
| -rw-r--r-- | tests/test-mousetrap-mode--get-profile-for-mode.el | 98 | ||||
| -rw-r--r-- | tests/test-mousetrap-mode--lighter.el | 194 | ||||
| -rw-r--r-- | todo.org | 21 |
7 files changed, 1305 insertions, 43 deletions
diff --git a/modules/mousetrap-mode.el b/modules/mousetrap-mode.el index f31acbf8..e656e447 100644 --- a/modules/mousetrap-mode.el +++ b/modules/mousetrap-mode.el @@ -2,72 +2,211 @@ ;; ;;; Commentary: ;; Mouse Trap Mode is a minor mode for Emacs that disables most mouse and -;; trackpad events to prevent accidental text modifications. Hitting the trackpad and -;; finding my text is being inserted in an unintended place is quite annoying, -;; especially when you're overcaffeinated. +;; trackpad events to prevent accidental text modifications. Hitting the +;; trackpad and finding my text is being inserted in an unintended place is +;; quite annoying, especially when you're overcaffeinated. ;; -;; The mode unbinds almost every mouse event, including clicks, drags, and wheel -;; movements, with various modifiers like Control, Meta, and Shift. +;; The mode uses a profile-based architecture to selectively enable/disable +;; mouse events based on the current major mode. Profiles define which +;; event categories are allowed (scrolling, clicks, drags, etc.), and modes +;; are mapped to profiles. +;; +;; The keymap is built dynamically when the mode is toggled, so you can +;; change profiles or mode mappings and re-enable the mode without reloading +;; your Emacs configuration. ;; ;; Inspired by this blog post from Malabarba ;; https://endlessparentheses.com/disable-mouse-only-inside-emacs.html ;; ;;; Code: +(require 'cl-lib) + ;; ------------------------------ Mouse Trap Mode ------------------------------ -(defvar mouse-trap-enable-scrolling t - "When non-nil, allow mouse wheel scrolling in `mouse-trap-mode'. -When nil, disable mouse wheel scrolling along with clicks and drags.") - -(defvar mouse-trap-mode-map - (let* ((prefixes '("" "C-" "M-" "S-" "C-M-" "C-S-" "M-S-" "C-M-S-")) ; modifiers - (buttons (number-sequence 1 5)) ; mouse-1..5 - (types '("mouse" "down-mouse" "drag-mouse" - "double-mouse" "triple-mouse")) - (wheel '("wheel-up" "wheel-down" "wheel-left" "wheel-right")) - (map (make-sparse-keymap))) - ;; clicks, drags, double, triple - (dolist (type types) - (dolist (pref prefixes) - (dolist (n buttons) - (define-key map (kbd (format "<%s%s-%d>" pref type n)) #'ignore)))) - ;; wheel (only disable if mouse-trap-enable-scrolling is nil) - (unless mouse-trap-enable-scrolling - (dolist (evt wheel) - (dolist (pref prefixes) - (define-key map (kbd (format "<%s%s>" pref evt)) #'ignore)))) - map) - "Keymap for `mouse-trap-mode'. Unbinds almost every mouse event. - -Disabling mouse prevents accidental mouse moves modifying text. -Respects `mouse-trap-enable-scrolling' to optionally allow wheel scrolling.") +;;; Event Categories + +(defvar mouse-trap--event-categories + '((primary-click . ((types . ("mouse" "down-mouse")) + (buttons . (1)))) + (secondary-click . ((types . ("mouse" "down-mouse")) + (buttons . (2 3)))) + (drags . ((types . ("drag-mouse")) + (buttons . (1 2 3 4 5)))) + (multi-clicks . ((types . ("double-mouse" "triple-mouse")) + (buttons . (1 2 3 4 5)))) + (scroll . ((wheel . ("wheel-up" "wheel-down" "wheel-left" "wheel-right"))))) + "Event category definitions for mouse-trap-mode. + +Each category maps to a set of event types and buttons (or wheel events). +Categories can be combined in profiles to allow specific interaction patterns.") + +;;; Profiles + +(defvar mouse-trap-profiles + '((disabled . ()) + (scroll-only . (scroll)) + (primary-click . (primary-click)) + (scroll+primary . (scroll primary-click)) + (read-only . (scroll primary-click secondary-click)) + (interactive . (scroll primary-click secondary-click drags)) + (full . (scroll primary-click secondary-click drags multi-clicks))) + "Mouse interaction profiles for different use cases. + +Each profile specifies which event categories are allowed. +Available categories: primary-click, secondary-click, drags, multi-clicks, scroll. + +Profiles: + - disabled: Block all mouse events + - scroll-only: Only allow scrolling + - primary-click: Only allow left click + - scroll+primary: Allow scrolling and left click + - read-only: Scrolling and clicking for reading/browsing + - interactive: Add dragging for text selection + - full: Allow all mouse events") + +(defvar mouse-trap-mode-profiles + '((dashboard-mode . primary-click) + (pdf-view-mode . full) + (nov-mode . full)) + "Map major modes to mouse-trap profiles. + +Modes not listed here will use `mouse-trap-default-profile'. +When checking, the mode hierarchy is respected via `derived-mode-p'.") + +(defvar mouse-trap-default-profile 'disabled + "Default profile to use when current major mode is not in `mouse-trap-mode-profiles'.") + +;;; Keymap Builder + +(defun mouse-trap--get-profile-for-mode () + "Return the profile for the current major mode. + +Checks `mouse-trap-mode-profiles' for an exact match with `major-mode', +then checks parent modes via `derived-mode-p'. Falls back to +`mouse-trap-default-profile' if no match." + ;; First check for exact match with current major-mode + (or (alist-get major-mode mouse-trap-mode-profiles) + ;; Then check parent modes + (cl-loop for (mode . profile) in mouse-trap-mode-profiles + when (and (not (eq mode major-mode)) + (derived-mode-p mode)) + return profile) + ;; Finally use default + mouse-trap-default-profile)) + +(defun mouse-trap--build-keymap () + "Build a keymap based on current major mode's profile. + +Returns a keymap that binds mouse events to `ignore' for all events +NOT allowed by the current profile. This function is called each time +the mode is toggled, allowing dynamic behavior without reloading config." + (let* ((profile-name (mouse-trap--get-profile-for-mode)) + (allowed-categories (alist-get profile-name mouse-trap-profiles)) + (prefixes '("" "C-" "M-" "S-" "C-M-" "C-S-" "M-S-" "C-M-S-")) + (map (make-sparse-keymap))) + + ;; For each event category, disable it if not in allowed list + (dolist (category-entry mouse-trap--event-categories) + (let ((category (car category-entry)) + (spec (cdr category-entry))) + (unless (memq category allowed-categories) + ;; This category is NOT allowed - bind its events to ignore + (cond + ;; Scroll events (wheel) + ((alist-get 'wheel spec) + (dolist (evt (alist-get 'wheel spec)) + (dolist (pref prefixes) + (define-key map (kbd (format "<%s%s>" pref evt)) #'ignore)))) + + ;; Click/drag events (types + buttons) + ((and (alist-get 'types spec) (alist-get 'buttons spec)) + (dolist (type (alist-get 'types spec)) + (dolist (button (alist-get 'buttons spec)) + (dolist (pref prefixes) + (define-key map (kbd (format "<%s%s-%d>" pref type button)) #'ignore))))))))) + map)) + +;;; Minor Mode Definition + +(defvar-local mouse-trap-mode-map nil + "Keymap for `mouse-trap-mode'. Built dynamically per buffer.") + +(defvar mouse-trap--lighter-keymap + (let ((map (make-sparse-keymap))) + (define-key map [mode-line mouse-1] + (lambda (event) + (interactive "e") + (with-selected-window (posn-window (event-start event)) + (mouse-trap-mode (if mouse-trap-mode -1 1))))) + map) + "Keymap for the mouse-trap-mode lighter. +Allows clicking the lighter to toggle the mode.") + +(defun mouse-trap--lighter-string () + "Generate the mode-line lighter string for mouse-trap-mode. +Returns a propertized string that shows 🪤 when mode is on, 🐭 when off. +The string is clickable to toggle the mode." + (propertize (if mouse-trap-mode " 🪤" " 🐭") + 'mouse-face 'mode-line-highlight + 'help-echo "mouse-1: Toggle mousetrap mode" + 'local-map mouse-trap--lighter-keymap)) (define-minor-mode mouse-trap-mode - "Buffer-locally disable most mouse and trackpad events. + "Buffer-locally disable mouse and trackpad events based on major mode. -When active, <mouse-*>, <down-mouse-*>, <drag-mouse-*>, -<double-mouse-*>, and <triple-mouse-*> events are bound to `ignore', -with or without C-, M-, S- modifiers. +Mouse-trap-mode uses a profile-based system to selectively enable or +disable mouse events. Each major mode can be mapped to a profile, and +profiles define which event categories are allowed. -Wheel scrolling is enabled by default, but can be disabled by -setting `mouse-trap-enable-scrolling' to nil before loading this file." - :lighter " 🐭" - :keymap mouse-trap-mode-map - :group 'convenience) +Available event categories: + - primary-click: Left mouse button + - secondary-click: Middle and right mouse buttons + - drags: Drag selections + - multi-clicks: Double and triple clicks + - scroll: Mouse wheel / trackpad scrolling + +The keymap is built dynamically when the mode is toggled, so you can +change `mouse-trap-mode-profiles' or `mouse-trap-profiles' and re-enable +the mode without reloading your configuration. + +See `mouse-trap-profiles' for available profiles and +`mouse-trap-mode-profiles' for mode mappings." + :lighter nil ; We use mode-line-misc-info instead + :group 'convenience + ;; Build keymap dynamically when mode is activated + (if mouse-trap-mode + (progn + (setq mouse-trap-mode-map (mouse-trap--build-keymap)) + ;; Force the keymap to be recognized by the minor mode system + (setq minor-mode-map-alist + (cons (cons 'mouse-trap-mode mouse-trap-mode-map) + (assq-delete-all 'mouse-trap-mode minor-mode-map-alist))) + ;; Add dynamic lighter to mode-line-misc-info (always visible) + (unless (member '(:eval (mouse-trap--lighter-string)) mode-line-misc-info) + (push '(:eval (mouse-trap--lighter-string)) mode-line-misc-info))) + ;; When disabling, remove from minor-mode-map-alist + (setq minor-mode-map-alist + (assq-delete-all 'mouse-trap-mode minor-mode-map-alist)) + ;; Note: We keep the lighter in mode-line-misc-info so it shows 🐭 when disabled + )) (defvar mouse-trap-excluded-modes - '(nov-mode pdf-view-mode dashboard-mode image-mode eww-mode Info-mode dired-mode) - "Major modes where `mouse-trap-mode' should not be enabled.") + '(image-mode eww-mode Info-mode dired-mode) + "Major modes where `mouse-trap-mode' should not be auto-enabled. + +These modes are excluded from automatic activation via hooks, but you +can still manually enable mouse-trap-mode in these buffers if desired.") (defun mouse-trap-maybe-enable () "Enable `mouse-trap-mode' unless in an excluded mode." (unless (apply #'derived-mode-p mouse-trap-excluded-modes) (mouse-trap-mode 1))) -;; Enable in text and prog modes +;; Enable in text, prog, and special modes (add-hook 'text-mode-hook #'mouse-trap-maybe-enable) (add-hook 'prog-mode-hook #'mouse-trap-maybe-enable) +(add-hook 'special-mode-hook #'mouse-trap-maybe-enable) (keymap-global-set "C-c M" #'mouse-trap-mode) diff --git a/tests/test-integration-mousetrap-mode-lighter-click.el b/tests/test-integration-mousetrap-mode-lighter-click.el new file mode 100644 index 00000000..fcae89a6 --- /dev/null +++ b/tests/test-integration-mousetrap-mode-lighter-click.el @@ -0,0 +1,174 @@ +;;; test-integration-mousetrap-mode-lighter-click.el --- Integration tests for lighter clicking -*- lexical-binding: t; -*- + +;;; Commentary: +;; Integration tests for mousetrap-mode lighter click functionality. +;; Tests that clicking the lighter properly toggles the mode AND +;; rebuilds the keymap based on the current major mode profile. + +;;; Code: + +(require 'ert) +(require 'mousetrap-mode) + +;;; Integration Tests - Lighter Click Behavior + +(ert-deftest test-integration-lighter-click-enables-mode-in-dashboard () + "Test clicking lighter in dashboard-mode enables mode with correct profile. +Dashboard uses primary-click profile which blocks scrolling but allows mouse-1." + (with-temp-buffer + (let ((major-mode 'dashboard-mode) + (mouse-trap-mode nil)) + ;; Start with mode disabled + (should-not mouse-trap-mode) + + ;; Simulate clicking lighter to enable (calls mouse-trap-mode with 1) + (mouse-trap-mode 1) + + ;; Mode should be enabled + (should mouse-trap-mode) + + ;; Keymap should be built for dashboard (primary-click profile) + (should (keymapp mouse-trap-mode-map)) + + ;; Verify profile-specific behavior: mouse-1 allowed, scroll blocked + (should (eq (lookup-key mouse-trap-mode-map (kbd "<mouse-1>")) nil)) + (should (eq (lookup-key mouse-trap-mode-map (kbd "<wheel-up>")) 'ignore)) + + ;; Keymap should be in minor-mode-map-alist + (should (assq 'mouse-trap-mode minor-mode-map-alist))))) + +(ert-deftest test-integration-lighter-click-disables-mode () + "Test clicking lighter when mode is enabled disables it and removes keymap." + (with-temp-buffer + (emacs-lisp-mode) + (mouse-trap-mode 1) + (should mouse-trap-mode) + (should (assq 'mouse-trap-mode minor-mode-map-alist)) + + ;; Simulate clicking lighter to disable + (mouse-trap-mode -1) + + ;; Mode should be disabled + (should-not mouse-trap-mode) + + ;; Keymap should be removed from minor-mode-map-alist + (should-not (assq 'mouse-trap-mode minor-mode-map-alist)))) + +(ert-deftest test-integration-lighter-click-toggle-updates-keymap () + "Test toggling mode via lighter click rebuilds keymap for current mode. +This is the critical test - when you click to enable, it should rebuild +the keymap based on the CURRENT major mode's profile." + (with-temp-buffer + (let ((major-mode 'dashboard-mode)) + ;; Start disabled + (mouse-trap-mode -1) + (should-not mouse-trap-mode) + + ;; Enable via click (simulate) + (mouse-trap-mode 1) + (should mouse-trap-mode) + + ;; Should have dashboard profile (primary-click) + (let ((map1 mouse-trap-mode-map)) + (should (eq (lookup-key map1 (kbd "<mouse-1>")) nil)) ; allowed + (should (eq (lookup-key map1 (kbd "<wheel-up>")) 'ignore)) ; blocked + + ;; Disable + (mouse-trap-mode -1) + (should-not mouse-trap-mode) + + ;; Change to different mode + (setq major-mode 'pdf-view-mode) + + ;; Enable again + (mouse-trap-mode 1) + (should mouse-trap-mode) + + ;; Should now have pdf-view profile (full - all allowed) + (let ((map2 mouse-trap-mode-map)) + (should (eq (lookup-key map2 (kbd "<mouse-1>")) nil)) ; allowed + (should (eq (lookup-key map2 (kbd "<wheel-up>")) nil))) ; allowed now! + + ;; Verify maps are different + (should-not (equal map1 mouse-trap-mode-map)))))) + +(ert-deftest test-integration-lighter-click-respects-buffer-local-mode () + "Test lighter click affects only current buffer (buffer-local behavior)." + (let ((buf1 (generate-new-buffer "test1")) + (buf2 (generate-new-buffer "test2"))) + (unwind-protect + (progn + ;; Buffer 1: enable mode manually + (with-current-buffer buf1 + (setq major-mode 'text-mode) ; Use setq to avoid hooks + (mouse-trap-mode 1) + (should mouse-trap-mode)) + + ;; Buffer 2: mode should be independent (not auto-enabled) + (with-current-buffer buf2 + (setq major-mode 'text-mode) ; Use setq to avoid hooks + (should-not mouse-trap-mode) + + ;; Enable in buf2 + (mouse-trap-mode 1) + (should mouse-trap-mode)) + + ;; Verify buf1 still enabled + (with-current-buffer buf1 + (should mouse-trap-mode)) + + ;; Disable buf2 via click + (with-current-buffer buf2 + (mouse-trap-mode -1) + (should-not mouse-trap-mode)) + + ;; Verify buf1 unaffected + (with-current-buffer buf1 + (should mouse-trap-mode))) + + (kill-buffer buf1) + (kill-buffer buf2)))) + +(ert-deftest test-integration-lighter-click-with-excluded-mode () + "Test lighter click works even in excluded modes. +Auto-enable is blocked, but manual toggle should still work." + (with-temp-buffer + (dired-mode default-directory) + + ;; Auto-enable is blocked for dired + (mouse-trap-maybe-enable) + (should-not mouse-trap-mode) + + ;; But manual toggle should work + (mouse-trap-mode 1) + (should mouse-trap-mode) + (should (assq 'mouse-trap-mode minor-mode-map-alist)) + + ;; Toggle off + (mouse-trap-mode -1) + (should-not mouse-trap-mode) + (should-not (assq 'mouse-trap-mode minor-mode-map-alist)))) + +(ert-deftest test-integration-lighter-click-multiple-rapid-toggles () + "Test rapid clicking (multiple toggles) is stable and doesn't corrupt state." + (with-temp-buffer + (emacs-lisp-mode) + + ;; Rapid toggle 10 times + (dotimes (i 10) + (if (= (mod i 2) 0) + (mouse-trap-mode 1) + (mouse-trap-mode -1))) + + ;; Should end in disabled state (even number of toggles) + (should-not mouse-trap-mode) + (should-not (assq 'mouse-trap-mode minor-mode-map-alist)) + + ;; Enable one more time to end enabled + (mouse-trap-mode 1) + (should mouse-trap-mode) + (should (assq 'mouse-trap-mode minor-mode-map-alist)) + (should (keymapp mouse-trap-mode-map)))) + +(provide 'test-integration-mousetrap-mode-lighter-click) +;;; test-integration-mousetrap-mode-lighter-click.el ends here diff --git a/tests/test-integration-mousetrap-mode-profiles.el b/tests/test-integration-mousetrap-mode-profiles.el new file mode 100644 index 00000000..6abd3ad2 --- /dev/null +++ b/tests/test-integration-mousetrap-mode-profiles.el @@ -0,0 +1,374 @@ +;;; test-integration-mousetrap-mode-profiles.el --- Integration tests -*- lexical-binding: t; -*- + +;;; Commentary: +;; Integration tests for mousetrap-mode profile system. +;; Tests complete workflows including profile lookup, keymap building, +;; mode activation, inheritance, and dynamic reconfiguration. +;; +;; Components integrated: +;; - mouse-trap--get-profile-for-mode (profile lookup) +;; - mouse-trap--build-keymap (keymap generation) +;; - mouse-trap-mode (minor mode activation) +;; - derived-mode-p (Emacs mode inheritance) +;; - mouse-trap-maybe-enable (auto-activation logic) + +;;; Code: + +(require 'ert) +(require 'mousetrap-mode) + +;;; Integration Tests - Normal Workflows + +(ert-deftest test-integration-mousetrap-mode-profiles-org-mode-inherits-text-mode-disabled () + "Test org-mode inherits disabled profile from text-mode. + +Components integrated: +- mouse-trap--get-profile-for-mode (lookup with inheritance) +- derived-mode-p (mode hierarchy checking) +- org-mode (real major mode) + +Validates: +- Mode inheritance chain works correctly +- org-mode → text-mode → disabled profile" + (with-temp-buffer + (org-mode) + (let ((profile (mouse-trap--get-profile-for-mode))) + (should (eq 'disabled profile))))) + +(ert-deftest test-integration-mousetrap-mode-profiles-pdf-view-full-allows-all-events () + "Test pdf-view-mode gets full profile with all events allowed. + +Components integrated: +- mouse-trap--get-profile-for-mode (exact match lookup) +- mouse-trap--build-keymap (full profile keymap) + +Validates: +- Full profile configuration +- All event categories allowed (empty/minimal keymap)" + (let ((major-mode 'pdf-view-mode)) + (let ((profile (mouse-trap--get-profile-for-mode)) + (map (mouse-trap--build-keymap))) + (should (eq 'full profile)) + (should (keymapp map)) + ;; All events should be allowed (not bound) + (should (eq (lookup-key map (kbd "<mouse-1>")) nil)) + (should (eq (lookup-key map (kbd "<wheel-up>")) nil)) + (should (eq (lookup-key map (kbd "<drag-mouse-1>")) nil))))) + +(ert-deftest test-integration-mousetrap-mode-profiles-dashboard-primary-click-only () + "Test dashboard-mode gets primary-click profile. + +Components integrated: +- mouse-trap--get-profile-for-mode (lookup) +- mouse-trap--build-keymap (selective event binding) + +Validates: +- Primary-click profile allows mouse-1 +- Blocks mouse-2/3 and scroll events" + (let ((major-mode 'dashboard-mode)) + (let ((profile (mouse-trap--get-profile-for-mode)) + (map (mouse-trap--build-keymap))) + (should (eq 'primary-click profile)) + ;; mouse-1 allowed + (should (eq (lookup-key map (kbd "<mouse-1>")) nil)) + ;; mouse-2/3 blocked + (should (eq (lookup-key map (kbd "<mouse-2>")) 'ignore)) + ;; scroll blocked + (should (eq (lookup-key map (kbd "<wheel-up>")) 'ignore))))) + +(ert-deftest test-integration-mousetrap-mode-profiles-emacs-lisp-uses-default-disabled () + "Test unmapped mode uses default disabled profile. + +Components integrated: +- mouse-trap--get-profile-for-mode (fallback to default) +- mouse-trap--build-keymap (disabled keymap) + +Validates: +- Default profile fallback works +- All events blocked by default" + (with-temp-buffer + (emacs-lisp-mode) + (let ((profile (mouse-trap--get-profile-for-mode)) + (map (mouse-trap--build-keymap))) + (should (eq 'disabled profile)) + ;; All events blocked + (should (eq (lookup-key map (kbd "<wheel-up>")) 'ignore)) + (should (eq (lookup-key map (kbd "<mouse-1>")) 'ignore))))) + +(ert-deftest test-integration-mousetrap-mode-profiles-change-profile-no-reload () + "Test changing profiles and re-enabling mode without Emacs reload. + +Components integrated: +- mouse-trap--get-profile-for-mode (re-reads configuration) +- mouse-trap--build-keymap (rebuilds dynamically) +- mouse-trap-mode (mode toggle) + +Validates: +- KEY FEATURE: Dynamic reconfiguration +- Profile changes take effect without reload" + (let ((original-profiles mouse-trap-mode-profiles)) + (unwind-protect + (with-temp-buffer + (emacs-lisp-mode) + ;; Start with unmapped mode (gets default scroll-only) + (setq mouse-trap-mode-profiles nil) + (mouse-trap-mode 1) + (let ((map mouse-trap-mode-map)) + (should (eq (lookup-key map (kbd "<mouse-1>")) 'ignore))) + (mouse-trap-mode -1) + + ;; Change configuration + (setq mouse-trap-mode-profiles '((emacs-lisp-mode . full))) + + ;; Re-enable and verify new profile + (mouse-trap-mode 1) + (let ((map mouse-trap-mode-map)) + ;; Full profile - all events allowed + (should (eq (lookup-key map (kbd "<mouse-1>")) nil)) + (should (eq (lookup-key map (kbd "<wheel-up>")) nil)))) + ;; Restore original configuration + (setq mouse-trap-mode-profiles original-profiles)))) + +(ert-deftest test-integration-mousetrap-mode-profiles-switch-major-mode-updates-profile () + "Test switching major-mode and re-enabling updates profile. + +Components integrated: +- mouse-trap--get-profile-for-mode (mode-sensitive lookup) +- Major mode switching +- Mode re-activation + +Validates: +- Profile changes with major-mode +- Mode-sensitive behavior" + (with-temp-buffer + (text-mode) + (mouse-trap-mode 1) + (let ((map1 mouse-trap-mode-map)) + ;; text-mode = disabled (inherits from default), all blocked + (should (eq (lookup-key map1 (kbd "<wheel-up>")) 'ignore)) + (should (eq (lookup-key map1 (kbd "<mouse-1>")) 'ignore)) + (mouse-trap-mode -1)) + + ;; Switch to pdf-view-mode which has full profile + (setq major-mode 'pdf-view-mode) + (mouse-trap-mode 1) + (let ((map2 mouse-trap-mode-map)) + ;; pdf-view-mode = full, all events allowed + (should (eq (lookup-key map2 (kbd "<wheel-up>")) nil)) + (should (eq (lookup-key map2 (kbd "<mouse-1>")) nil))))) + +(ert-deftest test-integration-mousetrap-mode-profiles-auto-enable-respects-exclusions () + "Test auto-enable respects exclusion list. + +Components integrated: +- mouse-trap-maybe-enable (auto-activation logic) +- mouse-trap-excluded-modes (exclusion list) +- derived-mode-p (mode checking) + +Validates: +- Exclusion list prevents auto-activation +- dired-mode is excluded" + (with-temp-buffer + (dired-mode default-directory) + ;; Manually call maybe-enable + (mouse-trap-maybe-enable) + ;; Should NOT enable + (should-not mouse-trap-mode))) + +(ert-deftest test-integration-mousetrap-mode-profiles-manual-enable-in-excluded-mode () + "Test manual activation works in excluded modes. + +Components integrated: +- mouse-trap-mode (manual activation) +- Exclusion list (should not affect manual activation) + +Validates: +- Manual activation bypasses auto-enable exclusions +- Exclusions only affect hooks, not manual toggling" + (with-temp-buffer + (dired-mode default-directory) + ;; Manually enable + (mouse-trap-mode 1) + ;; Should be enabled despite being in exclusion list + (should mouse-trap-mode))) + +;;; Integration Tests - Boundary Cases + +(ert-deftest test-integration-mousetrap-mode-profiles-markdown-inherits-text-disabled () + "Test markdown-mode inherits disabled profile from text-mode. + +Components integrated: +- Mode inheritance (markdown-mode → text-mode) +- Profile lookup with inheritance + +Validates: +- Multi-level inheritance works +- Markdown gets disabled profile" + (with-temp-buffer + (when (fboundp 'markdown-mode) + (markdown-mode) + (let ((profile (mouse-trap--get-profile-for-mode))) + (should (eq 'disabled profile)))))) + +(ert-deftest test-integration-mousetrap-mode-profiles-help-mode-inherits-special-disabled () + "Test help-mode inherits disabled from special-mode. + +Components integrated: +- Mode inheritance (help-mode → special-mode) +- Profile lookup + +Validates: +- special-mode inheritance works +- Help buffers get disabled profile" + (with-temp-buffer + (help-mode) + (let ((profile (mouse-trap--get-profile-for-mode))) + (should (eq 'disabled profile))))) + +(ert-deftest test-integration-mousetrap-mode-profiles-toggle-multiple-times () + "Test toggling mode multiple times is stable. + +Components integrated: +- mouse-trap-mode (activation/deactivation) +- Keymap building (multiple times) + +Validates: +- Mode toggle robustness +- No errors on rapid toggling" + (with-temp-buffer + (emacs-lisp-mode) + ;; Toggle multiple times + (dotimes (_ 5) + (mouse-trap-mode 1) + (should mouse-trap-mode) + (mouse-trap-mode -1) + (should-not mouse-trap-mode)))) + +(ert-deftest test-integration-mousetrap-mode-profiles-multiple-buffers-independent () + "Test multiple buffers have independent profiles. + +Components integrated: +- Buffer-local mode behavior +- Profile lookup per buffer +- Multiple mode activation + +Validates: +- Buffer-local mode isolation +- Each buffer gets correct profile" + (let ((buf1 (generate-new-buffer "test1")) + (buf2 (generate-new-buffer "test2"))) + (unwind-protect + (progn + ;; Buffer 1: text-mode (disabled = default) + (with-current-buffer buf1 + (text-mode) + (mouse-trap-mode 1) + (should mouse-trap-mode) + (let ((map1 mouse-trap-mode-map)) + (should (eq (lookup-key map1 (kbd "<wheel-up>")) 'ignore)) + (should (eq (lookup-key map1 (kbd "<mouse-1>")) 'ignore)))) + + ;; Buffer 2: pdf-view-mode (full profile) + (with-current-buffer buf2 + (setq major-mode 'pdf-view-mode) + (mouse-trap-mode 1) + (should mouse-trap-mode) + (let ((map2 mouse-trap-mode-map)) + ;; All events allowed + (should (eq (lookup-key map2 (kbd "<wheel-up>")) nil)) + (should (eq (lookup-key map2 (kbd "<mouse-1>")) nil))))) + + ;; Cleanup + (kill-buffer buf1) + (kill-buffer buf2)))) + +;;; Integration Tests - Edge Cases + +(ert-deftest test-integration-mousetrap-mode-profiles-change-default-profile () + "Test changing default profile takes effect. + +Components integrated: +- mouse-trap-default-profile (configuration) +- Profile fallback logic +- Dynamic reconfiguration + +Validates: +- Default profile configuration works +- Changes take effect on re-enable" + (let ((original-default mouse-trap-default-profile) + (original-profiles mouse-trap-mode-profiles)) + (unwind-protect + (with-temp-buffer + ;; Unmapped mode uses default + (setq mouse-trap-mode-profiles nil) + (setq mouse-trap-default-profile 'disabled) + (emacs-lisp-mode) + (mouse-trap-mode 1) + (let ((map1 mouse-trap-mode-map)) + ;; Default = disabled, all blocked + (should (eq (lookup-key map1 (kbd "<wheel-up>")) 'ignore)) + (should (eq (lookup-key map1 (kbd "<mouse-1>")) 'ignore)) + (mouse-trap-mode -1)) + + ;; Change default + (setq mouse-trap-default-profile 'full) + (mouse-trap-mode 1) + (let ((map2 mouse-trap-mode-map)) + ;; Default = full, all allowed + (should (eq (lookup-key map2 (kbd "<wheel-up>")) nil)) + (should (eq (lookup-key map2 (kbd "<mouse-1>")) nil)))) + ;; Restore original configuration + (setq mouse-trap-default-profile original-default) + (setq mouse-trap-mode-profiles original-profiles)))) + +(ert-deftest test-integration-mousetrap-mode-profiles-add-new-profile-runtime () + "Test adding new profile at runtime. + +Components integrated: +- mouse-trap-profiles (extensibility) +- Profile lookup +- Runtime configuration + +Validates: +- Runtime extensibility +- New profiles work immediately" + (let ((original-profiles mouse-trap-profiles) + (original-mode-profiles mouse-trap-mode-profiles)) + (unwind-protect + (with-temp-buffer + (setq mouse-trap-profiles + (append mouse-trap-profiles + '((custom-profile . (primary-click scroll))))) + (setq mouse-trap-mode-profiles '((emacs-lisp-mode . custom-profile))) + (emacs-lisp-mode) + (mouse-trap-mode 1) + (let ((map mouse-trap-mode-map)) + ;; Custom profile: primary-click and scroll allowed + (should (eq (lookup-key map (kbd "<mouse-1>")) nil)) + (should (eq (lookup-key map (kbd "<wheel-up>")) nil)) + ;; Secondary click blocked + (should (eq (lookup-key map (kbd "<mouse-2>")) 'ignore)))) + ;; Restore original configuration + (setq mouse-trap-profiles original-profiles) + (setq mouse-trap-mode-profiles original-mode-profiles)))) + +(ert-deftest test-integration-mousetrap-mode-profiles-remove-mode-mapping-uses-default () + "Test removing mode mapping falls back to default. + +Components integrated: +- Profile lookup fallback +- Dynamic configuration + +Validates: +- Graceful handling of removed mappings +- Fallback to default profile" + (with-temp-buffer + (let ((mouse-trap-mode-profiles nil) ; Dashboard not mapped + (mouse-trap-default-profile 'scroll-only) + (major-mode 'dashboard-mode)) + (let ((profile (mouse-trap--get-profile-for-mode))) + ;; Should fall back to default + (should (eq 'scroll-only profile)))))) + +(provide 'test-integration-mousetrap-mode-profiles) +;;; test-integration-mousetrap-mode-profiles.el ends here 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 "<mouse-1>")) 'ignore)) + (should (eq (lookup-key map (kbd "<wheel-up>")) 'ignore)) + (should (eq (lookup-key map (kbd "<drag-mouse-1>")) 'ignore)) + (should (eq (lookup-key map (kbd "<double-mouse-1>")) '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 "<wheel-up>")) nil)) + (should (eq (lookup-key map (kbd "<wheel-down>")) nil)) + ;; Click events should be blocked + (should (eq (lookup-key map (kbd "<mouse-1>")) 'ignore)) + (should (eq (lookup-key map (kbd "<mouse-2>")) '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 "<mouse-1>")) nil)) + (should (eq (lookup-key map (kbd "<down-mouse-1>")) nil)) + ;; mouse-2/3 should be blocked + (should (eq (lookup-key map (kbd "<mouse-2>")) 'ignore)) + (should (eq (lookup-key map (kbd "<mouse-3>")) 'ignore)) + ;; Scroll should be blocked + (should (eq (lookup-key map (kbd "<wheel-up>")) '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 "<mouse-1>")) nil)) + (should (eq (lookup-key map (kbd "<wheel-up>")) nil)) + ;; Blocked events + (should (eq (lookup-key map (kbd "<mouse-2>")) 'ignore)) + (should (eq (lookup-key map (kbd "<drag-mouse-1>")) '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 "<mouse-1>")) nil)) + (should (eq (lookup-key map (kbd "<mouse-2>")) nil)) + (should (eq (lookup-key map (kbd "<wheel-up>")) nil)) + (should (eq (lookup-key map (kbd "<drag-mouse-1>")) nil)) + (should (eq (lookup-key map (kbd "<double-mouse-1>")) 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 "<wheel-up>")) nil)) + (should (eq (lookup-key map (kbd "<mouse-1>")) nil)) + (should (eq (lookup-key map (kbd "<mouse-2>")) nil)) + ;; Blocked: drags and multi-clicks + (should (eq (lookup-key map (kbd "<drag-mouse-1>")) 'ignore)) + (should (eq (lookup-key map (kbd "<double-mouse-1>")) '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 "<wheel-up>")) nil)) + (should (eq (lookup-key map (kbd "<mouse-1>")) nil)) + (should (eq (lookup-key map (kbd "<drag-mouse-1>")) nil)) + ;; Blocked: multi-clicks + (should (eq (lookup-key map (kbd "<double-mouse-1>")) 'ignore)) + (should (eq (lookup-key map (kbd "<triple-mouse-1>")) '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 "<mouse-1>")) nil)) + ;; Everything else blocked + (should (eq (lookup-key map (kbd "<mouse-2>")) 'ignore)) + (should (eq (lookup-key map (kbd "<wheel-up>")) 'ignore)) + (should (eq (lookup-key map (kbd "<drag-mouse-1>")) 'ignore)) + (should (eq (lookup-key map (kbd "<double-mouse-1>")) '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 "<mouse-1>")) 'ignore)) + (should (eq (lookup-key map (kbd "<C-mouse-1>")) 'ignore)) + (should (eq (lookup-key map (kbd "<M-mouse-1>")) 'ignore)) + (should (eq (lookup-key map (kbd "<S-mouse-1>")) 'ignore)) + (should (eq (lookup-key map (kbd "<C-M-mouse-1>")) 'ignore)) + (should (eq (lookup-key map (kbd "<C-S-mouse-1>")) 'ignore)) + (should (eq (lookup-key map (kbd "<M-S-mouse-1>")) 'ignore)) + (should (eq (lookup-key map (kbd "<C-M-S-mouse-1>")) '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 "<mouse-1>")) 'ignore)) + (should (eq (lookup-key map (kbd "<mouse-2>")) 'ignore)) + (should (eq (lookup-key map (kbd "<mouse-3>")) 'ignore)) + ;; Drag events include all buttons (1-5) + (should (eq (lookup-key map (kbd "<drag-mouse-1>")) 'ignore)) + (should (eq (lookup-key map (kbd "<drag-mouse-4>")) 'ignore)) + (should (eq (lookup-key map (kbd "<drag-mouse-5>")) '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 "<wheel-up>")) 'ignore)) + (should (eq (lookup-key map (kbd "<wheel-down>")) 'ignore)) + (should (eq (lookup-key map (kbd "<wheel-left>")) 'ignore)) + (should (eq (lookup-key map (kbd "<wheel-right>")) '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 "<mouse-1>")) '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 "<wheel-up>")) nil)) ; scroll allowed + (should (eq (lookup-key map (kbd "<mouse-1>")) nil)) ; primary-click allowed + ;; Other events should be blocked + (should (eq (lookup-key map (kbd "<mouse-2>")) '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 "<mouse-1>")) '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 "<mouse-1>")) 'ignore)) + (should-not (eq (lookup-key map (kbd "<mouse-1>")) 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 "<wheel-up>")) nil)) + (should (eq (lookup-key map (kbd "<wheel-down>")) 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 "<mouse-1>")) nil)) + ;; drag-mouse-1 blocked + (should (eq (lookup-key map (kbd "<drag-mouse-1>")) '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 "<mouse-1>")) nil)) + ;; double-mouse-1 blocked + (should (eq (lookup-key map (kbd "<double-mouse-1>")) 'ignore)) + (should (eq (lookup-key map (kbd "<triple-mouse-1>")) 'ignore))))) + +(provide 'test-mousetrap-mode--build-keymap) +;;; test-mousetrap-mode--build-keymap.el ends here diff --git a/tests/test-mousetrap-mode--get-profile-for-mode.el b/tests/test-mousetrap-mode--get-profile-for-mode.el new file mode 100644 index 00000000..bfeb0bcd --- /dev/null +++ b/tests/test-mousetrap-mode--get-profile-for-mode.el @@ -0,0 +1,98 @@ +;;; test-mousetrap-mode--get-profile-for-mode.el --- Tests for profile lookup -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for mouse-trap--get-profile-for-mode function. +;; Tests profile lookup logic including exact matches, inheritance, +;; and fallback to default profile. + +;;; Code: + +(require 'ert) +(require 'mousetrap-mode) + +;;; Normal Cases + +(ert-deftest test-mousetrap-mode--get-profile-for-mode-normal-exact-match-returns-profile () + "Test exact mode match returns mapped profile." + (let ((major-mode 'dashboard-mode)) + (should (eq 'primary-click (mouse-trap--get-profile-for-mode))))) + +(ert-deftest test-mousetrap-mode--get-profile-for-mode-normal-inherited-mode-returns-parent-profile () + "Test that org-mode inherits disabled profile from text-mode." + (with-temp-buffer + (org-mode) + (should (eq 'disabled (mouse-trap--get-profile-for-mode))))) + +(ert-deftest test-mousetrap-mode--get-profile-for-mode-normal-unmapped-mode-returns-default () + "Test unmapped mode returns default profile." + (with-temp-buffer + (emacs-lisp-mode) + (should (eq 'disabled (mouse-trap--get-profile-for-mode))))) + +(ert-deftest test-mousetrap-mode--get-profile-for-mode-normal-special-mode-derivative-returns-disabled () + "Test that help-mode inherits disabled from special-mode." + (with-temp-buffer + (help-mode) + (should (eq 'disabled (mouse-trap--get-profile-for-mode))))) + +(ert-deftest test-mousetrap-mode--get-profile-for-mode-normal-pdf-view-mode-returns-full () + "Test pdf-view-mode returns full profile." + (let ((major-mode 'pdf-view-mode)) + (should (eq 'full (mouse-trap--get-profile-for-mode))))) + +;;; Boundary Cases + +(ert-deftest test-mousetrap-mode--get-profile-for-mode-boundary-empty-mode-profiles-returns-default () + "Test empty mode profiles list returns default." + (let ((mouse-trap-mode-profiles nil)) + (with-temp-buffer + (emacs-lisp-mode) + (should (eq 'disabled (mouse-trap--get-profile-for-mode)))))) + +(ert-deftest test-mousetrap-mode--get-profile-for-mode-boundary-exact-match-priority-over-inheritance () + "Test exact mode match takes priority over inherited match." + (let ((major-mode 'text-mode)) + ;; text-mode is explicitly mapped to disabled + (should (eq 'disabled (mouse-trap--get-profile-for-mode))))) + +(ert-deftest test-mousetrap-mode--get-profile-for-mode-boundary-first-parent-match-wins () + "Test first matching parent profile wins with multiple inheritance. +When a mode could match multiple parent profiles, the first one +in mouse-trap-mode-profiles should win." + (let ((mouse-trap-mode-profiles + '((special-mode . disabled) + (text-mode . scroll-only))) + (major-mode 'derived-test-mode)) + ;; Simulate a mode that derives from special-mode + (put 'derived-test-mode 'derived-mode-parent 'special-mode) + (with-temp-buffer + (setq major-mode 'derived-test-mode) + (should (eq 'disabled (mouse-trap--get-profile-for-mode)))))) + +(ert-deftest test-mousetrap-mode--get-profile-for-mode-boundary-deeply-nested-inheritance () + "Test profile lookup works through deep inheritance chain." + ;; Create a deep inheritance chain: level3 -> level2 -> level1 -> text-mode + (let ((mouse-trap-mode-profiles + '((text-mode . disabled))) + (major-mode 'level3-mode)) + (put 'level1-mode 'derived-mode-parent 'text-mode) + (put 'level2-mode 'derived-mode-parent 'level1-mode) + (put 'level3-mode 'derived-mode-parent 'level2-mode) + (with-temp-buffer + (setq major-mode 'level3-mode) + (should (eq 'disabled (mouse-trap--get-profile-for-mode)))))) + +;;; Error Cases + +(ert-deftest test-mousetrap-mode--get-profile-for-mode-error-nil-major-mode-returns-default () + "Test nil major-mode returns default profile gracefully." + (let ((major-mode nil)) + (should (eq 'disabled (mouse-trap--get-profile-for-mode))))) + +(ert-deftest test-mousetrap-mode--get-profile-for-mode-error-invalid-symbol-returns-default () + "Test invalid major-mode symbol returns default profile." + (let ((major-mode 'not-a-real-mode-symbol)) + (should (eq 'disabled (mouse-trap--get-profile-for-mode))))) + +(provide 'test-mousetrap-mode--get-profile-for-mode) +;;; test-mousetrap-mode--get-profile-for-mode.el ends here diff --git a/tests/test-mousetrap-mode--lighter.el b/tests/test-mousetrap-mode--lighter.el new file mode 100644 index 00000000..982eed44 --- /dev/null +++ b/tests/test-mousetrap-mode--lighter.el @@ -0,0 +1,194 @@ +;;; test-mousetrap-mode--lighter.el --- Tests for lighter functionality -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for mouse-trap-mode lighter functionality. +;; Tests the dynamic lighter display and interactive clicking behavior. + +;;; Code: + +(require 'ert) +(require 'mousetrap-mode) + +;;; Normal Cases + +(ert-deftest test-mousetrap-mode--lighter-normal-shows-mousetrap-when-enabled () + "Test lighter shows 🪤 when mode is enabled." + (with-temp-buffer + (emacs-lisp-mode) + (mouse-trap-mode 1) + (let ((lighter (mouse-trap--lighter-string))) + (should (string-match-p "🪤" lighter))))) + +(ert-deftest test-mousetrap-mode--lighter-normal-shows-mouse-when-disabled () + "Test lighter shows 🐭 when mode is disabled." + (with-temp-buffer + (emacs-lisp-mode) + (mouse-trap-mode -1) + (let ((lighter (mouse-trap--lighter-string))) + (should (string-match-p "🐭" lighter))))) + +(ert-deftest test-mousetrap-mode--lighter-normal-has-help-echo () + "Test lighter has help-echo tooltip." + (with-temp-buffer + (emacs-lisp-mode) + (mouse-trap-mode 1) + (let ((lighter (mouse-trap--lighter-string))) + (should (get-text-property 0 'help-echo lighter)) + (should (string-match-p "Toggle" (get-text-property 0 'help-echo lighter)))))) + +(ert-deftest test-mousetrap-mode--lighter-normal-has-mouse-face () + "Test lighter has mouse-face for hover highlighting." + (with-temp-buffer + (emacs-lisp-mode) + (mouse-trap-mode 1) + (let ((lighter (mouse-trap--lighter-string))) + (should (eq (get-text-property 0 'mouse-face lighter) 'mode-line-highlight))))) + +(ert-deftest test-mousetrap-mode--lighter-normal-has-local-map () + "Test lighter has local-map for click handling." + (with-temp-buffer + (emacs-lisp-mode) + (mouse-trap-mode 1) + (let ((lighter (mouse-trap--lighter-string))) + (should (get-text-property 0 'local-map lighter)) + (should (keymapp (get-text-property 0 'local-map lighter)))))) + +(ert-deftest test-mousetrap-mode--lighter-normal-keymap-has-mouse-1-binding () + "Test lighter keymap has mouse-1 binding." + (should (keymapp mouse-trap--lighter-keymap)) + (let ((binding (lookup-key mouse-trap--lighter-keymap [mode-line mouse-1]))) + (should binding) + (should (functionp binding)))) + +(ert-deftest test-mousetrap-mode--lighter-normal-added-to-mode-line-misc-info () + "Test lighter is added to mode-line-misc-info when mode enabled." + (with-temp-buffer + (emacs-lisp-mode) + (let ((mode-line-misc-info nil)) ; Start fresh + (mouse-trap-mode 1) + (should (member '(:eval (mouse-trap--lighter-string)) mode-line-misc-info))))) + +(ert-deftest test-mousetrap-mode--lighter-normal-persists-when-mode-disabled () + "Test lighter stays in mode-line-misc-info when mode disabled. +This allows it to show the 🐭 indicator when mode is off." + (with-temp-buffer + (emacs-lisp-mode) + (let ((mode-line-misc-info nil)) ; Start fresh + (mouse-trap-mode 1) + (should (member '(:eval (mouse-trap--lighter-string)) mode-line-misc-info)) + (mouse-trap-mode -1) + ;; Lighter should still be present (to show 🐭) + (should (member '(:eval (mouse-trap--lighter-string)) mode-line-misc-info))))) + +;;; Boundary Cases + +(ert-deftest test-mousetrap-mode--lighter-boundary-toggle-changes-display () + "Test toggling mode changes lighter display between 🪤 and 🐭." + (with-temp-buffer + (emacs-lisp-mode) + (mouse-trap-mode 1) + (let ((lighter-on (mouse-trap--lighter-string))) + (should (string-match-p "🪤" lighter-on))) + (mouse-trap-mode -1) + (let ((lighter-off (mouse-trap--lighter-string))) + (should (string-match-p "🐭" lighter-off))) + (mouse-trap-mode 1) + (let ((lighter-on-again (mouse-trap--lighter-string))) + (should (string-match-p "🪤" lighter-on-again))))) + +(ert-deftest test-mousetrap-mode--lighter-boundary-multiple-enables-no-duplicates () + "Test enabling mode multiple times doesn't create duplicate lighters." + (with-temp-buffer + (emacs-lisp-mode) + (let ((mode-line-misc-info nil)) ; Start fresh + (mouse-trap-mode 1) + (mouse-trap-mode -1) + (mouse-trap-mode 1) + ;; Should only have one entry + (let ((count 0)) + (dolist (item mode-line-misc-info) + (when (equal item '(:eval (mouse-trap--lighter-string))) + (setq count (1+ count)))) + (should (= count 1)))))) + +(ert-deftest test-mousetrap-mode--lighter-boundary-different-buffers-independent () + "Test lighter state is independent in different buffers." + (let ((buf1 (generate-new-buffer "test1")) + (buf2 (generate-new-buffer "test2"))) + (unwind-protect + (progn + (with-current-buffer buf1 + (emacs-lisp-mode) + (mouse-trap-mode 1) + (should (string-match-p "🪤" (mouse-trap--lighter-string)))) + (with-current-buffer buf2 + (emacs-lisp-mode) + (mouse-trap-mode -1) + (should (string-match-p "🐭" (mouse-trap--lighter-string)))) + ;; Verify buf1 still shows 🪤 + (with-current-buffer buf1 + (should (string-match-p "🪤" (mouse-trap--lighter-string))))) + (kill-buffer buf1) + (kill-buffer buf2)))) + +;;; Edge Cases + +(ert-deftest test-mousetrap-mode--lighter-edge-always-evaluates-regardless-of-mode-state () + "Test that lighter entry always evaluates, even when mode is disabled. +This is critical - the entry structure is (:eval ...) not (mouse-trap-mode (:eval ...)) +so it displays regardless of the mode variable's value." + (with-temp-buffer + (emacs-lisp-mode) + (let ((mode-line-misc-info nil)) + ;; Enable mode - adds lighter + (mouse-trap-mode 1) + (let ((entry (car (member '(:eval (mouse-trap--lighter-string)) mode-line-misc-info)))) + (should entry) + ;; Entry should be (:eval ...) not (mouse-trap-mode (:eval ...)) + (should (eq (car entry) :eval)) + ;; Verify it's not conditional on mouse-trap-mode being the car + (should-not (eq (car entry) 'mouse-trap-mode))) + + ;; Disable mode - lighter stays and still evaluates + (mouse-trap-mode -1) + (let ((entry (car (member '(:eval (mouse-trap--lighter-string)) mode-line-misc-info)))) + (should entry) + (should (eq (car entry) :eval)))))) + +(ert-deftest test-mousetrap-mode--lighter-edge-string-always-has-space-prefix () + "Test lighter string always starts with space for proper modeline spacing." + (with-temp-buffer + (emacs-lisp-mode) + (mouse-trap-mode 1) + (let ((lighter-on (mouse-trap--lighter-string))) + (should (string-prefix-p " " lighter-on))) + (mouse-trap-mode -1) + (let ((lighter-off (mouse-trap--lighter-string))) + (should (string-prefix-p " " lighter-off))))) + +(ert-deftest test-mousetrap-mode--lighter-edge-properties-cover-entire-string () + "Test text properties are applied to entire lighter string." + (with-temp-buffer + (emacs-lisp-mode) + (mouse-trap-mode 1) + (let ((lighter (mouse-trap--lighter-string))) + ;; Check properties at each position + (dotimes (i (length lighter)) + (should (get-text-property i 'local-map lighter)) + (should (get-text-property i 'mouse-face lighter)) + (should (get-text-property i 'help-echo lighter)))))) + +(ert-deftest test-mousetrap-mode--lighter-edge-same-keymap-instance () + "Test all lighters use the same keymap instance for efficiency." + (with-temp-buffer + (emacs-lisp-mode) + (mouse-trap-mode 1) + (let ((lighter1 (mouse-trap--lighter-string)) + (lighter2 (mouse-trap--lighter-string))) + (should (eq (get-text-property 0 'local-map lighter1) + (get-text-property 0 'local-map lighter2))) + (should (eq (get-text-property 0 'local-map lighter1) + mouse-trap--lighter-keymap))))) + +(provide 'test-mousetrap-mode--lighter) +;;; test-mousetrap-mode--lighter.el ends here @@ -1378,3 +1378,24 @@ CLOSED: [2025-11-12 Wed 02:41] SCHEDULED: <2025-11-03 Sun> Review this inbox, cancel stale items, keep < 20 active. Track in calendar. * Emacs Config Inbox +** TODO [#C] Investigate dashboard-mode interaction with mousetrap-mode +Dashboard-mode with primary-click profile appears to block all clicks, not just secondary/scroll. +Expected: left-click works on dashboard items, scroll blocked +Actual: all clicks blocked when mousetrap enabled + +Possible causes: +- Dashboard widgets use own keymaps that conflict with mousetrap keymap +- Need to investigate dashboard-mode keymap priority +- May need special handling or different profile for dashboard + +Current workaround: mousetrap works correctly in all other modes (org, pdf, nov, elisp) + +Related files: +- modules/mousetrap-mode.el (profile: primary-click for dashboard) +- tests/test-integration-mousetrap-mode-lighter-click.el + +** TODO Emacs: Modeline not updating dirty documents color properly +** TODO [#A] Emacs Audio Recording Still Doesn't Get Audience! +On a recorded call today Thursday, November 13, 2025 at 03:09:20 PM CST, the audio wasn't recorded on one side of the phone. Just my side was recorded. + +The input device works fine. I suspect we aren't taking input from the output device or monitor. Perhaps we should grab from them all? |