acme-mouse.org

Acme-mouse library

Global variables

;; -*- lexical-binding: t -*-

(defvar acme-mouse-state 'none
  "The state of the chording state machine.")

(defvar acme-mouse-remapping nil
  "The remapping applied to the region face.")

(defvar acme-mouse-start-click nil
  "The start click of the transition from 'none state, set to
  nil on a transition back to 'none state.")

(defvar acme-mouse-saved-mark-point-active nil
  "The saved mark, point and mark-active variables, so that they
  can be restored when the user finishes dragging the eval/search
  selection. Set on a transition from a 'none state just like
  acme-mouse-start-click.")

Basic state-machine

These are the default bindings.

(setq acme-mouse-transition-table
      `((none (down left) left mouse-drag-region)
        (none (down middle) middle)
        (none (down right) right)

        (left (down middle) left-middle)
        (left (down right) left-right)

        (middle (down left) middle-left)

        ;; Mouse up
        (left (up left) none mouse-set-point)
        (middle (up middle) none mouse-yank-primary)
        (right (up right) none mouse-save-then-kill)

        (left-middle (up middle) left)
        (left-right (up right) left)

        (middle-left (up left) middle)

        ;; Mouse drag up
        (left (drag left) none mouse-set-region)
        (middle (drag middle) none)
        (right (drag right) none)

        (left-middle (drag middle) left)
        (left-right (drag right) left)

        (middle-left (drag left) middle)))

State-machine driver

If we only change the state, then we want to do that transparently, hence setting the last-command.

(defmacro acme-mouse-make-transition (&rest input)
  `(lambda (click)
     (interactive "e")
     (setq this-command last-command)   ; Transparent
     (when (eq acme-mouse-state 'none)
       (setq acme-mouse-start-click click)
       (acme-mouse-save-mark-point-active))
     (cond
      ,@(cl-reduce (lambda (acc transition)
                     (pcase transition
                       (`(,start ,(pred (equal input)) ,end . ,funs)
                        (cons
                         `((equal acme-mouse-state ',start)
                           (setq acme-mouse-state ',end)
                           ,@(apply 'append
                                    (cl-mapcar
                                     (lambda (f)
                                       (if (commandp f t)
                                           `((setq this-command ',f)
                                             (call-interactively ',f))
                                         `(,f)))
                                     funs)))
                         acc))
                       (_ acc)))
                   acme-mouse-transition-table
                   :initial-value nil)
      (t (setq acme-mouse-state 'none)))
     (when (eq acme-mouse-state 'none)
       (acme-mouse-face-unmap)
       (setq acme-mouse-start-click nil))))

(defun acme-mouse-save-mark-point-active ()
  (setq acme-mouse-saved-mark-point-active (list (mark) (point) mark-active)))

(defun acme-mouse-restore-mark-point-active ()
  (seq-let [mark point active] acme-mouse-saved-mark-point-active
    (when mark (set-mark mark))
    (when point (goto-char point))
    (setq mark-active active)))

Extending the state-machine

(defun acme-mouse-lookup (start transition end)
  (let (ret)
    (dolist (el acme-mouse-transition-table
                (list start transition end))
      (setq ret el))))

(defun acme-mouse-add (start transition end &rest actions)
  (let ((entry (acme-mouse-lookup start transition end)))
    (setcdr (cddr entry)
            (append (cdddr entry) actions))))

(defun acme-mouse-del (start transition end &rest actions)
  (let ((entry (acme-mouse-lookup start transition end)))
    (if actions
        ;; remove-actions
        (seq-map
         (lambda (action)
           (setcdr (cddr entry)
                   (seq-filter (lambda (action) (equal actions))
                               (cdddr entry))))
         actions)
      ;; remove-all
      (setcdr (cddr entry) nil))))

Selection faces

(defun acme-mouse-face-unmap ()
  (when acme-mouse-remapping
    (face-remap-remove-relative acme-mouse-remapping)
    (setq acme-mouse-remapping nil)))

(defun acme-mouse-face-remap (face)
  (acme-mouse-face-unmap)
  (setq acme-mouse-remapping (face-remap-add-relative 'region face)))

(defun acme-mouse-selection (click)
  (let* ((start (posn-point (event-start acme-mouse-start-click)))
         (end (posn-point (event-start click)))
         (clicks (event-click-count acme-mouse-start-click)))
    (mouse-start-end start end (1- clicks))))

(defface acme-mouse-face-eval
  '((((class color) (min-colors 8))
     :inverse-video t :foreground "dark red")
    (t :inverse-video t))
  "Face for selecting with the middle mouse button."
  :group 'acme-mouse
  :group 'faces)

(defface acme-mouse-face-search
  '((((class color) (min-colors 8))
     :inverse-video t :foreground "dark green")
    (t :inverse-video t))
  "Face for selecting with the right mouse button."
  :group 'acme-mouse
  :group 'faces)

Library

(defgroup acme-mouse nil
  "Acme mouse chording mode for Emacs"
  :group 'mouse)

(provide 'acme-mouse)