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          (x (car x-dot-y))
 138          (y (cdr x-dot-y))
 139          (w (window-at x y))
 140          (ltrb (window-edges w))
 141          (left (nth 0 ltrb))
 142          (top (nth 1 ltrb)))
 143     (if w (posn-at-x-y (- x left) (- y top) w t)
 144       (append (list nil 'menu-bar) (nthcdr 2 (posn-at-x-y x y w t))))))
 145
 146 ;;; This fun is partly Copyright (C) 1994 Per Abrahamsen <abraham@iesd.auc.dk>
 147 (defun t-mouse-make-event ()
 148   "Make a Lisp style event from the contents of mouse input accumulator.
 149 Also trim the accumulator by all the data used to build the event."
 150   (let (ob (ob-pos (condition-case nil
 151                        (progn
 152                          ;; this test is just needed for Fedora Core 3
 153                          (if (string-match "STILL RUNNING_1\n"
 154                                            t-mouse-filter-accumulator)
 155                              (setq t-mouse-filter-accumulator
 156                                    (substring
 157                                     t-mouse-filter-accumulator (match-end 0))))
 158                          (read-from-string t-mouse-filter-accumulator))
 159                      (error nil))))
 160     ;; this test is just needed for Fedora Core 3
 161     (if (or (eq (car ob-pos) 'STILL) (eq (car ob-pos) '***) (not ob-pos))
 162         nil
 163       (setq ob (car ob-pos))
 164       (setq t-mouse-filter-accumulator
 165             (substring t-mouse-filter-accumulator (cdr ob-pos)))
 166
 167       ;;now the real work
 168
 169       (let ((event-type (nth 0 ob))
 170             (current-xy-avec-time (nth 1 ob))
 171             (type-switch (length ob)))
 172         (if t-mouse-fix-21
 173             (let
 174                 ;;Acquire the event's symbol's name.
 175                 ((event-name-string (symbol-name event-type))
 176                  end-of-root-event-name
 177                  new-event-name-string)
 178
 179               (if (string-match "-\\(21\\|\\12\\)$" event-name-string)
 180
 181                   ;;Transform the name to what it should have been.
 182                   (progn
 183                     (setq end-of-root-event-name (match-beginning 0))
 184                     (setq new-event-name-string
 185                           (concat (substring
 186                                    event-name-string 0
 187                                    end-of-root-event-name) "-3"))
 188
 189                     ;;Change the event to the symbol that corresponds to the
 190                     ;;name we made. The proper symbol already exists.
 191                     (setq event-type
 192                           (intern new-event-name-string))))))
 193
 194         ;;store current position for mouse-position
 195
 196         (setq t-mouse-current-xy (nth 0 current-xy-avec-time))
 197
 198         ;;events have many types but fortunately they differ in length
 199
 200         (cond
 201          ((= type-switch 4)             ;must be drag
 202           (let ((count (nth 2 ob))
 203                 (start-element
 204                  (or t-mouse-drag-start
 205                      (t-mouse-make-event-element (nth 3 ob))))
 206                 (end-element
 207                  (t-mouse-make-event-element current-xy-avec-time)))
 208             (setq t-mouse-drag-start nil)
 209             (list event-type start-element end-element count)))
 210          ((= type-switch 3)             ;down or up
 211           (let ((count (nth 2 ob))
 212                 (element
 213                  (t-mouse-make-event-element current-xy-avec-time)))
 214             (if (and (not t-mouse-drag-start)
 215                      (symbolp (nth 1 element)))
 216                 ;; OUCH! GOTCHA! emacs uses setc[ad]r on these!
 217                 (setq t-mouse-drag-start (copy-sequence element))
 218               (setq t-mouse-drag-start nil))
 219             (list event-type element count)))
 220          ((= type-switch 2)             ;movement
 221           (list (if (eq 'vertical-scroll-bar
 222                         (nth 1 t-mouse-drag-start)) 'scroll-bar-movement
 223                   'mouse-movement)
 224                 (t-mouse-make-event-element current-xy-avec-time))))))))
 225
 226 (defun t-mouse-process-filter (proc string)
 227   (setq t-mouse-filter-accumulator
 228         (concat t-mouse-filter-accumulator string))
 229   (let ((event (t-mouse-make-event)))
 230     (while event
 231       (if (or track-mouse
 232               (not (eq 'mouse-movement (event-basic-type event))))
 233           (setq unread-command-events
 234                 (nconc unread-command-events (list event))))
 235       (if t-mouse-debug-buffer
 236           (print unread-command-events t-mouse-debug-buffer))
 237       (setq event (t-mouse-make-event)))))
 238
 239 (defun t-mouse-mouse-position-function (pos)
 240   "Return the t-mouse-position unless running with a window system.
 241 The (secret) scrollbar interface is not implemented yet."
 242   (setcdr pos t-mouse-current-xy)
 243   pos)
 244
 245 ;; It should be possible to just send SIGTSTP to the inferior with
 246 ;; stop-process.  That doesn't work; mev receives the signal fine but
 247 ;; is not really stopped: instead it returns from
 248 ;; kill(getpid(), SIGTSTP) immediately.  I don't understand what's up
 249 ;; itz Tue Mar 24 14:27:38 PST 1998.
 250
 251 (add-hook 'suspend-hook
 252           (function (lambda ()
 253                       (and t-mouse-process
 254                            ;(stop-process t-mouse-process)
 255                            (process-send-string
 256                             t-mouse-process "push -enone -dall -Mnone\n")))))
 257
 258 (add-hook 'suspend-resume-hook
 259           (function (lambda ()
 260                       (and t-mouse-process
 261                            ;(continue-process t-mouse-process)
 262                            (process-send-string t-mouse-process "pop\n")))))
 263
 264 ;;;###autoload
 265 (define-minor-mode t-mouse-mode
 266   "Toggle t-mouse mode.
 267 With prefix arg, turn t-mouse mode on iff arg is positive.
 268
 269 Turn it on to use Emacs mouse commands, and off to use t-mouse commands."
 270   nil " Mouse" nil :global t
 271   (if t-mouse-mode
 272       ;; Turn it on
 273       (unless window-system
 274         ;; Starts getting a stream of mouse events from an asynchronous process.
 275         ;; Only works if Emacs is running on a virtual terminal without a window system.
 276         (progn
 277          (setq mouse-position-function #'t-mouse-mouse-position-function)
 278          (let ((tty (t-mouse-tty))
 279                (process-connection-type t))
 280            (if (not (stringp tty))
 281                (error "Cannot find a virtual terminal"))
 282            (setq t-mouse-process
 283                  (start-process "t-mouse" nil
 284                                 "mev" "-i" "-E" "-C" tty
 285                                 (if t-mouse-swap-alt-keys
 286                                     "-M-leftAlt" "-M-rightAlt")
 287                                 "-e-move"
 288                                 "-dall" "-d-hard"
 289                                 "-f")))
 290          (setq t-mouse-filter-accumulator "")
 291          (set-process-filter t-mouse-process 't-mouse-process-filter)
 292          (set-process-query-on-exit-flag t-mouse-process nil)))
 293     ;; Turn it off
 294     (setq mouse-position-function nil)
 295     (delete-process t-mouse-process)
 296     (setq t-mouse-process nil)))
 297
 298 (provide 't-mouse)
 299
 300 ;; arch-tag: a63163b3-bfbe-4eb2-ab4f-201cd164b05d
 301 ;;; t-mouse.el ends here