Reduce to a minor-mode macro call.

1 files changed, 15 insertions, 261 deletions

diff --git a/lisp/t-mouse.el b/lisp/t-mouse.el
index ba774e68443..29b17f9b716 100644
--- a/lisp/t-mouse.el
+++ b/lisp/t-mouse.el
@@ -1,7 +1,7 @@
 ;;; t-mouse.el --- mouse support within the text terminal
 
-;; Authors: Alessandro Rubini and Ian T Zimmerman
-;; Maintainer: Nick Roberts <nickrob@gnu.org>
+;; Author: Nick Roberts <nickrob@gnu.org>
+;; Maintainer: FSF
 ;; Keywords: mouse gpm linux
 
 ;; Copyright (C) 1994, 1995, 1998, 2006, 2007 Free Software Foundation, Inc.
@@ -25,249 +25,20 @@
 
 ;;; Commentary:
 
-;; This package provides access to mouse event as reported by the
-;; gpm-Linux package.  It uses the program "mev" to get mouse events.
-;; It tries to reproduce the functionality offered by Emacs under X.
+;; This package provides access to mouse event as reported by the gpm-Linux
+;; package. It tries to reproduce the functionality offered by Emacs under X.
 ;; The "gpm" server runs under Linux, so this package is rather
 ;; Linux-dependent.
 
-;; Modified by Nick Roberts for Emacs 22.  In particular, the mode-line is
-;; now position sensitive.
-
-(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.")
+;; The file, t-mouse was originally written by Alessandro Rubini and Ian T
+;; Zimmerman and communicated with Emacs through the client program mev.  Now
+;; the interface with gpm is directly through a Unix socket, so this file is
+;; reduced to a minor mode macro call.
 
+;; 
 
 ;;; Code:
 
-;; get the number of the current virtual console
-
-(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
-         ;; Many versions of "ps", all different....
-         (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)))))
-
-
-;; due to a horrible kludge in Emacs' keymap handler
-;; (read_key_sequence) mouse clicks on funny parts of windows generate
-;; TWO events, the first being a dummy of the sort '(mode-line).
-;; That's why Per Abrahamsen's code in xt-mouse.el doesn't work for
-;; the modeline, for instance.
-
-;; now get this:  the Emacs C code that generates these fake events
-;; depends on certain things done by the very lowest level input
-;; handlers; namely the symbols for the events (for instance
-;; 'C-S-double-mouse-2) must have an 'event-kind property, set to
-;; 'mouse-click.  Since events from unread-command-events do not pass
-;; through the low level handlers, they don't get this property unless
-;; I set it myself.  I imagine this has caused innumerable attempts by
-;; hackers to do things similar to t-mouse to lose.
-
-;; The next page of code is devoted to fixing this ugly problem.
-
-;; WOW! a fully general powerset generator
-;; (C) Ian Zimmerman Mon Mar 23 12:00:16 PST 1998 :-)
-(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))))
-
-;; and a slightly less general cartesian product
-(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))
-
-;;; This fun is partly Copyright (C) 1994 Per Abrahamsen <abraham@iesd.auc.dk>
-(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
-                         ;; this test is just needed for Fedora Core 3
-                         (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))))
-    ;; this test is just needed for Fedora Core 3
-    (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)))
-
-      ;;now the real work
-
-      (let ((event-type (nth 0 ob))
-            (current-xy-avec-time (nth 1 ob))
-            (type-switch (length ob)))
-        (if t-mouse-fix-21
-            (let
-                ;;Acquire the event's symbol's name.
-                ((event-name-string (symbol-name event-type))
-                 end-of-root-event-name
-                 new-event-name-string)
-
-              (if (string-match "-\\(21\\|\\12\\)$" event-name-string)
-
-                  ;;Transform the name to what it should have been.
-                  (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"))
-
-                    ;;Change the event to the symbol that corresponds to the
-                    ;;name we made. The proper symbol already exists.
-                    (setq event-type
-                          (intern new-event-name-string))))))
-
-        ;;store current position for mouse-position
-
-        (setq t-mouse-current-xy (nth 0 current-xy-avec-time))
-
-        ;;events have many types but fortunately they differ in length
-
-        (cond
-         ((= type-switch 4)             ;must be drag
-          (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)             ;down or up
-          (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)))
-                ;; OUCH! GOTCHA! emacs uses setc[ad]r on these!
-                (setq t-mouse-drag-start (copy-sequence element))
-              (setq t-mouse-drag-start nil))
-            (list event-type element count)))
-         ((= type-switch 2)             ;movement
-          (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)
-
-;; It should be possible to just send SIGTSTP to the inferior with
-;; stop-process.  That doesn't work; mev receives the signal fine but
-;; is not really stopped: instead it returns from
-;; kill(getpid(), SIGTSTP) immediately.  I don't understand what's up
-;; itz Tue Mar 24 14:27:38 PST 1998.
-
-(add-hook 'suspend-hook
-          (function (lambda ()
-                      (and t-mouse-process
-                           ;(stop-process 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
-                           ;(continue-process t-mouse-process)
-                           (process-send-string t-mouse-process "pop\n")))))
-
 ;;;###autoload
 (define-minor-mode t-mouse-mode
   "Toggle t-mouse mode.
@@ -277,30 +48,13 @@ Turn it on to use Emacs mouse commands, and off to use t-mouse commands."
   nil " Mouse" nil :global t
   (unless window-system
     (if t-mouse-mode
-        ;; Turn it on.  Starts getting a stream of mouse events from an
-        ;; asynchronous process.  Only works if Emacs is running on a virtual
-        ;; terminal without a 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))
-    ;; Turn it off
-      (setq mouse-position-function nil)
-      (delete-process t-mouse-process)
-      (setq t-mouse-process nil))))
+          (unless (fboundp 'term-open-connection)
+            (error "Emacs must be built with Gpm to use this mode"))
+          (unless (term-open-connection)
+            (error "Can't open mouse connection")))
+      ;; Turn it off
+      (term-close-connection))))
 
 (provide 't-mouse)