[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]


From: Nick Roberts
Subject: t-mouse.el
Date: Mon, 26 Dec 2005 11:25:42 +1300

t-mouse.el is a file written by Alessandro Rubini and Ian T Zimmermann to
provide mouse support for Emacs on a Linux Console.  I've updated it for Emacs
22 (soon to be released!).  It would be great to include this file in the
release.  Alessandro Rubini has signed (or at least agreed to sign papers) but
I have not managed to contact Ian Zimmermann.  If anyone on this mailing list
knows him or his whereabouts, could you please ask him to contact me about
this matter.  Even if he is unwilling to sign papers, it would be helpful for
me to know.  It would be a shame though, because this is great code.



;;; t-mouse.el --- mouse support within the text terminal

;;; Copyright (C) 1994,1995 Alessandro Rubini <address@hidden>
;;;               parts are by Ian T Zimmermann <address@hidden>, 1995,1998

;; Maintainer: gpm mailing list: address@hidden
;; Keywords: mouse gpm linux

;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; GNU General Public License for more details.

;;; You should have received a copy of the GNU General Public License
;;; along with GNU Emacs; see the file COPYING.  If not, write to
;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;;; 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.
;; The "gpm" server runs under Linux, so this package is rather
;; Linux-dependent.

;; Modified by Nick Roberts <address@hidden> for Emacs 22.  In
;; particular, the mode-line is 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.")

;;; Code:

;; get the number of the current virtual console

(defun t-mouse-tty ()
  "Returns number of virtual terminal Emacs is running on, as a string.
For example, \"2\" for /dev/tty2."
    (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))
        (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)))
       (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))
         (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)))
    (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 w t))))))

;;; This fun is partly Copyright (C) 1994 Per Abrahamsen <address@hidden>
(defun t-mouse-make-event ()
  "Makes a Lisp style event from the contents of mouse input accumulator.
Also trims the accumulator by all the data used to build the event."
  (let (ob (ob-pos (condition-case nil
                         ;; this test is just needed for Fedora Core 3
                         (if (string-match "STILL RUNNING_1\n"
                             (setq t-mouse-filter-accumulator
                                    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))
      (setq ob (car ob-pos))
      (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
                ;;Acquire the event's symbol's name.
                ((event-name-string (symbol-name event-type))
              (if (string-match "-\\(21\\|\\12\\)$" event-name-string)
                  ;;Transform the name to what it should have been.
                    (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

         ;;sink all events on the stupid text mode menubar.
;         ((and menu-bar-mode (eq 0 (cdr t-mouse-current-xy))) nil)
         ((= type-switch 4)             ;must be drag
          (let ((count (nth 2 ob))
                 (or t-mouse-drag-start
                     (t-mouse-make-event-element (nth 3 ob))))
                 (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))
                 (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
                (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)

;; 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)
                            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")))))

(define-minor-mode t-mouse-mode
  "Toggle t-mouse mode.
With prefix arg, turn t-mouse mode on iff arg is positive.

Turn it on to use emacs mouse commands, and off to use t-mouse commands."
  nil " Mouse" nil :global t
  (if t-mouse-mode
      ;; Turn it on
      (unless window-system
        ;; 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.
         (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")
                                "-dall" "-d-hard"
         (setq t-mouse-filter-accumulator "")
         (set-process-filter t-mouse-process 't-mouse-process-filter)
; use commented line instead for emacs 21.4 onwards
         (process-kill-without-query t-mouse-process)))
;        (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)))

(provide 't-mouse)

;;; t-mouse.el ends here

reply via email to

[Prev in Thread] Current Thread [Next in Thread]