lisp/t-mouse.el

   1 ;;; t-mouse.el --- mouse support within the text terminal
   2
   3 ;; Authors: Alessandro Rubini and Ian T Zimmerman
   4 ;; Maintainer: Nick Roberts <nickrob@gnu.org>
   5 ;; Keywords: mouse gpm linux
   6
   7 ;; Copyright (C) 1994, 1995, 1998, 2006, 2007 Free Software Foundation, Inc.
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; This package provides access to mouse event as reported by the
  29 ;; gpm-Linux package.  It uses the program "mev" to get mouse events.
  30 ;; It tries to reproduce the functionality offered by Emacs under X.
  31 ;; The "gpm" server runs under Linux, so this package is rather
  32 ;; Linux-dependent.
  33
  34 ;; Modified by Nick Roberts for Emacs 22.  In particular, the mode-line is
  35 ;; now position sensitive.
  36
  37 (defvar t-mouse-process nil
  38   "Embeds the process which passes mouse events to Emacs.
  39 It is used by the program t-mouse.")
  40
  41 (defvar t-mouse-filter-accumulator ""
  42   "Accumulates input from the mouse reporting process.")
  43
  44 (defvar t-mouse-debug-buffer nil
  45   "Events normally posted to command queue are printed here in debug mode.
  46 See `t-mouse-start-debug'.")
  47
  48 (defvar t-mouse-current-xy '(0 . 0)
  49   "Stores the last mouse position t-mouse has been told about.")
  50
  51 (defvar t-mouse-drag-start nil
  52   "Whenever a drag starts in a special part of a window
  53 \(not the text), the `translated' starting coordinates including the
  54 window and part involved are saved here.  This is necessary lest they
  55 get re-translated when the button goes up, at which time window
  56 configuration may have changed.")
  57
  58 (defvar t-mouse-prev-set-selection-function 'x-set-selection)
  59 (defvar t-mouse-prev-get-selection-function 'x-get-selection)
  60
  61 (defvar t-mouse-swap-alt-keys nil
  62   "When set, Emacs will handle mouse events with the right Alt
  63 \(a.k.a.  Alt-Ger) modifier, not with the regular left Alt modifier.
  64 Useful for people who play strange games with their keyboard tables.")
  65
  66 (defvar t-mouse-fix-21 nil
  67   "Enable brain-dead chords for 2 button mice.")
  68
  69 \f
  70 ;;; Code:
  71
  72 ;; get the number of the current virtual console
  73
  74 (defun t-mouse-tty ()
  75   "Return number of virtual terminal Emacs is running on, as a string.
  76 For example, \"2\" for /dev/tty2."
  77   (with-temp-buffer
  78     (call-process "ps" nil t nil "h" (format "%s" (emacs-pid)))
  79     (goto-char (point-min))
  80     (if (or
  81          ;; Many versions of "ps", all different....
  82          (re-search-forward " +tty\\(.?[0-9a-f]\\)" nil t)
  83          (re-search-forward "p \\([0-9a-f]\\)" nil t)
  84          (re-search-forward "v0\\([0-9a-f]\\)" nil t)
  85          (re-search-forward "[0-9]+ +\\([0-9]+\\)" nil t)
  86          (re-search-forward "[\\t ]*[0-9]+[\\t ]+\\([0-9]+\\)" nil t)
  87          (re-search-forward " +vc/\\(.?[0-9a-f]\\)" nil t)
  88          (re-search-forward " +pts/\\(.?[0-9a-f]\\)" nil t))
  89         (buffer-substring (match-beginning 1) (match-end 1)))))
  90
  91 \f
  92 ;; due to a horrible kludge in Emacs' keymap handler
  93 ;; (read_key_sequence) mouse clicks on funny parts of windows generate
  94 ;; TWO events, the first being a dummy of the sort '(mode-line).
  95 ;; That's why Per Abrahamsen's code in xt-mouse.el doesn't work for
  96 ;; the modeline, for instance.
  97
  98 ;; now get this:  the Emacs C code that generates these fake events
  99 ;; depends on certain things done by the very lowest level input
 100 ;; handlers; namely the symbols for the events (for instance
 101 ;; 'C-S-double-mouse-2) must have an 'event-kind property, set to
 102 ;; 'mouse-click.  Since events from unread-command-events do not pass
 103 ;; through the low level handlers, they don't get this property unless
 104 ;; I set it myself.  I imagine this has caused innumerable attempts by
 105 ;; hackers to do things similar to t-mouse to lose.
 106
 107 ;; The next page of code is devoted to fixing this ugly problem.
 108
 109 ;; WOW! a fully general powerset generator
 110 ;; (C) Ian Zimmerman Mon Mar 23 12:00:16 PST 1998 :-)
 111 (defun t-mouse-powerset (l)
 112   (if (null l) '(nil)
 113     (let ((l1 (t-mouse-powerset (cdr l)))
 114           (first (nth 0 l)))
 115       (append
 116        (mapcar (function (lambda (l) (cons first l))) l1) l1))))
 117
 118 ;; and a slightly less general cartesian product
 119 (defun t-mouse-cartesian (l1 l2)
 120   (if (null l1) l2
 121     (append (mapcar (function (lambda (x) (append (nth 0 l1) x))) l2)
 122             (t-mouse-cartesian (cdr l1) l2))))
 123
 124 (let* ((modifier-sets (t-mouse-powerset '(control meta shift)))
 125        (typed-sets (t-mouse-cartesian '((down) (drag))
 126                                       '((mouse-1) (mouse-2) (mouse-3))))
 127        (multipled-sets (t-mouse-cartesian '((double) (triple)) typed-sets))
 128        (all-sets (t-mouse-cartesian modifier-sets multipled-sets)))
 129   (while all-sets
 130     (let ((event-sym (event-convert-list (nth 0 all-sets))))
 131       (if (not (get event-sym 'event-kind))
 132           (put event-sym 'event-kind 'mouse-click)))
 133     (setq all-sets (cdr all-sets))))
 134
 135 (defun t-mouse-make-event-element (x-dot-y-avec-time)
 136   (let* ((x-dot-y (nth 0 x-dot-y-avec-time))
 137          (time (nth 1 x-dot-y-avec-time))
 138          (x (car x-dot-y))
 139          (y (cdr x-dot-y))
 140          (w (window-at x y))
 141          (ltrb (window-edges w))
 142          (left (nth 0 ltrb))
 143          (top (nth 1 ltrb))
 144          (event (if w
 145                     (posn-at-x-y (- x left) (- y top) w t)
 146                   (append (list nil 'menu-bar)
 147                           (nthcdr 2 (posn-at-x-y x y))))))
 148     (setcar (nthcdr 3 event) time)
 149     event))
 150
 151 ;;; This fun is partly Copyright (C) 1994 Per Abrahamsen <abraham@iesd.auc.dk>
 152 (defun t-mouse-make-event ()
 153   "Make a Lisp style event from the contents of mouse input accumulator.
 154 Also trim the accumulator by all the data used to build the event."
 155   (let (ob (ob-pos (condition-case nil
 156                        (progn
 157                          ;; this test is just needed for Fedora Core 3
 158                          (if (string-match "STILL RUNNING_1\n"
 159                                            t-mouse-filter-accumulator)
 160                              (setq t-mouse-filter-accumulator
 161                                    (substring
 162                                     t-mouse-filter-accumulator (match-end 0))))
 163                          (read-from-string t-mouse-filter-accumulator))
 164                      (error nil))))
 165     ;; this test is just needed for Fedora Core 3
 166     (if (or (eq (car ob-pos) 'STILL) (eq (car ob-pos) '***) (not ob-pos))
 167         nil
 168       (setq ob (car ob-pos))
 169       (setq t-mouse-filter-accumulator
 170             (substring t-mouse-filter-accumulator (cdr ob-pos)))
 171
 172       ;;now the real work
 173
 174       (let ((event-type (nth 0 ob))
 175             (current-xy-avec-time (nth 1 ob))
 176             (type-switch (length ob)))
 177         (if t-mouse-fix-21
 178             (let
 179                 ;;Acquire the event's symbol's name.
 180                 ((event-name-string (symbol-name event-type))
 181                  end-of-root-event-name
 182                  new-event-name-string)
 183
 184               (if (string-match "-\\(21\\|\\12\\)$" event-name-string)
 185
 186                   ;;Transform the name to what it should have been.
 187                   (progn
 188                     (setq end-of-root-event-name (match-beginning 0))
 189                     (setq new-event-name-string
 190                           (concat (substring
 191                                    event-name-string 0
 192                                    end-of-root-event-name) "-3"))
 193
 194                     ;;Change the event to the symbol that corresponds to the
 195                     ;;name we made. The proper symbol already exists.
 196                     (setq event-type
 197                           (intern new-event-name-string))))))
 198
 199         ;;store current position for mouse-position
 200
 201         (setq t-mouse-current-xy (nth 0 current-xy-avec-time))
 202
 203         ;;events have many types but fortunately they differ in length
 204
 205         (cond
 206          ((= type-switch 4)             ;must be drag
 207           (let ((count (nth 2 ob))
 208                 (start-element
 209                  (or t-mouse-drag-start
 210                      (t-mouse-make-event-element (nth 3 ob))))
 211                 (end-element
 212                  (t-mouse-make-event-element current-xy-avec-time)))
 213             (setq t-mouse-drag-start nil)
 214             (list event-type start-element end-element count)))
 215          ((= type-switch 3)             ;down or up
 216           (let ((count (nth 2 ob))
 217                 (element
 218                  (t-mouse-make-event-element current-xy-avec-time)))
 219             (if (and (not t-mouse-drag-start)
 220                      (symbolp (nth 1 element)))
 221                 ;; OUCH! GOTCHA! emacs uses setc[ad]r on these!
 222                 (setq t-mouse-drag-start (copy-sequence element))
 223               (setq t-mouse-drag-start nil))
 224             (list event-type element count)))
 225          ((= type-switch 2)             ;movement
 226           (list (if (eq 'vertical-scroll-bar
 227                         (nth 1 t-mouse-drag-start)) 'scroll-bar-movement
 228                   'mouse-movement)
 229                 (t-mouse-make-event-element current-xy-avec-time))))))))
 230
 231 (defun t-mouse-process-filter (proc string)
 232   (setq t-mouse-filter-accumulator
 233         (concat t-mouse-filter-accumulator string))
 234   (let ((event (t-mouse-make-event)))
 235     (while event
 236       (if (or track-mouse
 237               (not (eq 'mouse-movement (event-basic-type event))))
 238           (setq unread-command-events
 239                 (nconc unread-command-events (list event))))
 240       (if t-mouse-debug-buffer
 241           (print unread-command-events t-mouse-debug-buffer))
 242       (setq event (t-mouse-make-event)))))
 243
 244 (defun t-mouse-mouse-position-function (pos)
 245   "Return the t-mouse-position unless running with a window system.
 246 The (secret) scrollbar interface is not implemented yet."
 247   (setcdr pos t-mouse-current-xy)
 248   pos)
 249
 250 ;; It should be possible to just send SIGTSTP to the inferior with
 251 ;; stop-process.  That doesn't work; mev receives the signal fine but
 252 ;; is not really stopped: instead it returns from
 253 ;; kill(getpid(), SIGTSTP) immediately.  I don't understand what's up
 254 ;; itz Tue Mar 24 14:27:38 PST 1998.
 255
 256 (add-hook 'suspend-hook
 257           (function (lambda ()
 258                       (and t-mouse-process
 259                            ;(stop-process t-mouse-process)
 260                            (process-send-string
 261                             t-mouse-process "push -enone -dall -Mnone\n")))))
 262
 263 (add-hook 'suspend-resume-hook
 264           (function (lambda ()
 265                       (and t-mouse-process
 266                            ;(continue-process t-mouse-process)
 267                            (process-send-string t-mouse-process "pop\n")))))
 268
 269 ;;;###autoload
 270 (define-minor-mode t-mouse-mode
 271   "Toggle t-mouse mode.
 272 With prefix arg, turn t-mouse mode on iff arg is positive.
 273
 274 Turn it on to use Emacs mouse commands, and off to use t-mouse commands."
 275   nil " Mouse" nil :global t
 276   (if t-mouse-mode
 277       ;; Turn it on
 278       (unless window-system
 279         ;; Starts getting a stream of mouse events from an asynchronous process.
 280         ;; Only works if Emacs is running on a virtual terminal without a window system.
 281         (progn
 282          (setq mouse-position-function #'t-mouse-mouse-position-function)
 283          (let ((tty (t-mouse-tty))
 284                (process-connection-type t))
 285            (if (not (stringp tty))
 286                (error "Cannot find a virtual terminal"))
 287            (setq t-mouse-process
 288                  (start-process "t-mouse" nil
 289                                 "mev" "-i" "-E" "-C" tty
 290                                 (if t-mouse-swap-alt-keys
 291                                     "-M-leftAlt" "-M-rightAlt")
 292                                 "-e-move"
 293                                 "-dall" "-d-hard"
 294                                 "-f")))
 295          (setq t-mouse-filter-accumulator "")
 296          (set-process-filter t-mouse-process 't-mouse-process-filter)
 297          (set-process-query-on-exit-flag t-mouse-process nil)))
 298     ;; Turn it off
 299     (setq mouse-position-function nil)
 300     (delete-process t-mouse-process)
 301     (setq t-mouse-process nil)))
 302
 303 (provide 't-mouse)
 304
 305 ;; arch-tag: a63163b3-bfbe-4eb2-ab4f-201cd164b05d
 306 ;;; t-mouse.el ends here