(defvar t-mouse-process nil
"Embeds the process which passes mouse events to Emacs.
It is used by the program t-mouse.")
(defvar t-mouse-filter-accumulator ""
"Accumulates input from the mouse reporting process.")
(defvar t-mouse-debug-buffer nil
"Events normally posted to command queue are printed here in debug mode.
See `t-mouse-start-debug'.")
(defvar t-mouse-current-xy '(0 . 0)
"Stores the last mouse position t-mouse has been told about.")
(defvar t-mouse-drag-start nil
"Whenever a drag starts in a special part of a window
\(not the text), the `translated' starting coordinates including the
window and part involved are saved here. This is necessary lest they
get re-translated when the button goes up, at which time window
configuration may have changed.")
(defvar t-mouse-prev-set-selection-function 'x-set-selection)
(defvar t-mouse-prev-get-selection-function 'x-get-selection)
(defvar t-mouse-swap-alt-keys nil
"When set, Emacs will handle mouse events with the right Alt
\(a.k.a. Alt-Ger) modifier, not with the regular left Alt modifier.
Useful for people who play strange games with their keyboard tables.")
(defvar t-mouse-fix-21 nil
"Enable brain-dead chords for 2 button mice.")
(defun t-mouse-tty ()
"Return number of virtual terminal Emacs is running on, as a string.
For example, \"2\" for /dev/tty2."
(with-temp-buffer
(call-process "ps" nil t nil "h" (format "%s" (emacs-pid)))
(goto-char (point-min))
(if (or
(re-search-forward " +tty\\(.?[0-9a-f]\\)" nil t)
(re-search-forward "p \\([0-9a-f]\\)" nil t)
(re-search-forward "v0\\([0-9a-f]\\)" nil t)
(re-search-forward "[0-9]+ +\\([0-9]+\\)" nil t)
(re-search-forward "[\\t ]*[0-9]+[\\t ]+\\([0-9]+\\)" nil t)
(re-search-forward " +vc/\\(.?[0-9a-f]\\)" nil t)
(re-search-forward " +pts/\\(.?[0-9a-f]\\)" nil t))
(buffer-substring (match-beginning 1) (match-end 1)))))
(defun t-mouse-powerset (l)
(if (null l) '(nil)
(let ((l1 (t-mouse-powerset (cdr l)))
(first (nth 0 l)))
(append
(mapcar (function (lambda (l) (cons first l))) l1) l1))))
(defun t-mouse-cartesian (l1 l2)
(if (null l1) l2
(append (mapcar (function (lambda (x) (append (nth 0 l1) x))) l2)
(t-mouse-cartesian (cdr l1) l2))))
(let* ((modifier-sets (t-mouse-powerset '(control meta shift)))
(typed-sets (t-mouse-cartesian '((down) (drag))
'((mouse-1) (mouse-2) (mouse-3))))
(multipled-sets (t-mouse-cartesian '((double) (triple)) typed-sets))
(all-sets (t-mouse-cartesian modifier-sets multipled-sets)))
(while all-sets
(let ((event-sym (event-convert-list (nth 0 all-sets))))
(if (not (get event-sym 'event-kind))
(put event-sym 'event-kind 'mouse-click)))
(setq all-sets (cdr all-sets))))
(defun t-mouse-make-event-element (x-dot-y-avec-time)
(let* ((x-dot-y (nth 0 x-dot-y-avec-time))
(time (nth 1 x-dot-y-avec-time))
(x (car x-dot-y))
(y (cdr x-dot-y))
(w (window-at x y))
(ltrb (window-edges w))
(left (nth 0 ltrb))
(top (nth 1 ltrb))
(event (if w
(posn-at-x-y (- x left) (- y top) w t)
(append (list nil 'menu-bar)
(nthcdr 2 (posn-at-x-y x y))))))
(setcar (nthcdr 3 event) time)
event))
(defun t-mouse-make-event ()
"Make a Lisp style event from the contents of mouse input accumulator.
Also trim the accumulator by all the data used to build the event."
(let (ob (ob-pos (condition-case nil
(progn
(if (string-match "STILL RUNNING_1\n"
t-mouse-filter-accumulator)
(setq t-mouse-filter-accumulator
(substring
t-mouse-filter-accumulator (match-end 0))))
(read-from-string t-mouse-filter-accumulator))
(error nil))))
(if (or (eq (car ob-pos) 'STILL) (eq (car ob-pos) '***) (not ob-pos))
nil
(setq ob (car ob-pos))
(if (string-match "mev:$" (prin1-to-string ob))
(error "Can't open mouse connection"))
(setq t-mouse-filter-accumulator
(substring t-mouse-filter-accumulator (cdr ob-pos)))
(let ((event-type (nth 0 ob))
(current-xy-avec-time (nth 1 ob))
(type-switch (length ob)))
(if t-mouse-fix-21
(let
((event-name-string (symbol-name event-type))
end-of-root-event-name
new-event-name-string)
(if (string-match "-\\(21\\|\\12\\)$" event-name-string)
(progn
(setq end-of-root-event-name (match-beginning 0))
(setq new-event-name-string
(concat (substring
event-name-string 0
end-of-root-event-name) "-3"))
(setq event-type
(intern new-event-name-string))))))
(setq t-mouse-current-xy (nth 0 current-xy-avec-time))
(cond
((= type-switch 4) (let ((count (nth 2 ob))
(start-element
(or t-mouse-drag-start
(t-mouse-make-event-element (nth 3 ob))))
(end-element
(t-mouse-make-event-element current-xy-avec-time)))
(setq t-mouse-drag-start nil)
(list event-type start-element end-element count)))
((= type-switch 3) (let ((count (nth 2 ob))
(element
(t-mouse-make-event-element current-xy-avec-time)))
(if (and (not t-mouse-drag-start)
(symbolp (nth 1 element)))
(setq t-mouse-drag-start (copy-sequence element))
(setq t-mouse-drag-start nil))
(list event-type element count)))
((= type-switch 2) (list (if (eq 'vertical-scroll-bar
(nth 1 t-mouse-drag-start)) 'scroll-bar-movement
'mouse-movement)
(t-mouse-make-event-element current-xy-avec-time))))))))
(defun t-mouse-process-filter (proc string)
(setq t-mouse-filter-accumulator
(concat t-mouse-filter-accumulator string))
(let ((event (t-mouse-make-event)))
(while event
(if (or track-mouse
(not (eq 'mouse-movement (event-basic-type event))))
(setq unread-command-events
(nconc unread-command-events (list event))))
(if t-mouse-debug-buffer
(print unread-command-events t-mouse-debug-buffer))
(setq event (t-mouse-make-event)))))
(defun t-mouse-mouse-position-function (pos)
"Return the t-mouse-position unless running with a window system.
The (secret) scrollbar interface is not implemented yet."
(setcdr pos t-mouse-current-xy)
pos)
(add-hook 'suspend-hook
(function (lambda ()
(and t-mouse-process
(process-send-string
t-mouse-process "push -enone -dall -Mnone\n")))))
(add-hook 'suspend-resume-hook
(function (lambda ()
(and t-mouse-process
(process-send-string t-mouse-process "pop\n")))))
(define-minor-mode t-mouse-mode
"Toggle t-mouse mode to use the mouse in Linux consoles.
With prefix arg, turn t-mouse mode on iff arg is positive.
This allows the use of the mouse when operating on a Linux console, in the
same way as you can use the mouse under X11.
It requires the `mev' program, part of the `gpm' utilities."
nil " Mouse" nil :global t
(if t-mouse-mode
(unless window-system
(progn
(setq mouse-position-function #'t-mouse-mouse-position-function)
(let ((tty (t-mouse-tty))
(process-connection-type t))
(if (not (stringp tty))
(error "Cannot find a virtual terminal"))
(setq t-mouse-process
(start-process "t-mouse" nil
"mev" "-i" "-E" "-C" tty
(if t-mouse-swap-alt-keys
"-M-leftAlt" "-M-rightAlt")
"-e-move"
"-dall" "-d-hard"
"-f")))
(setq t-mouse-filter-accumulator "")
(set-process-filter t-mouse-process 't-mouse-process-filter)
(set-process-query-on-exit-flag t-mouse-process nil)))
(setq mouse-position-function nil)
(delete-process t-mouse-process)
(setq t-mouse-process nil)))
(provide 't-mouse)