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