emacs-devel
[Top][All Lists]
Advanced

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

t-mouse.el


From: Nick Roberts
Subject: t-mouse.el
Date: Wed, 5 Jan 2005 10:20:26 +1300

Following an earlier thread, I have updated t-mouse.el so that it works better
with Emacs 21. In particular, the mode-line is position sensitive. This still
requires other programs from the GPM suite i.e gpm and mev. In the longer
run, it might be better to integrate mev into Emacs but for now I think this
is a worthwhile inclusion. It is no longer actively maintained on its mailing
list (address@hidden). I have contacted Alessandro Rubini <address@hidden>,
the original author, and he is agreeable to this. It has already been released
under GPL, but if papers are still required, perhaps someone else can do this.
GPM only works with Linux (the kernel) so its not completely general.

I have tried to make the mode-line is position sensitive in xt-mouse.el too
but this works by mapping key-sequences. Is it possible to take the
constructed mouse events and put them in the input stream as in t-mouse.el?

Ultimately I want key clicks like gdb-mouse-toggle-breakpoint in the margin to
work but I haven't got that far yet.

Nick

;;; 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
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; 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.

(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."
  (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)
         ;; for Mandrake 9.0 (Nick Roberts address@hidden)
         (re-search-forward " +vc/\\(.?[0-9a-f]\\)" nil t)
         ;; for an eterm in Emacs!
         (re-search-forward " +pts/\\(.?[0-9]\\)" 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))))


;;; This fun is partly Copyright (C) 1994 Per Abrahamsen <address@hidden>
;; This is basically a feeble attempt to mimic what the c function
;; buffer_posn_from_coords in dispnew.c does.  I wish that function
;; were exported to Lisp.

(defun t-mouse-lispy-buffer-posn-from-coords (w col line)
  "Return buffer position of character at COL and LINE within window W.
COL and LINE are glyph coordinates, relative to W topleft corner."
  (save-window-excursion
    (select-window w)
    (save-excursion
      (move-to-window-line line)
      (move-to-column (+ col (current-column)
                         (if (not (window-minibuffer-p w)) 0
                           (- (minibuffer-prompt-width)))
                         (max 0 (1- (window-hscroll)))))
      (point))))

;; compute one element of the form (WINDOW BUFFERPOS (COL . ROW) TIMESTAMP)

(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))
         (timestamp (nth 1 x-dot-y-avec-time))
         (w (window-at x y))
         (left-top-right-bottom (window-edges w))
         (left (nth 0 left-top-right-bottom))
         (top (nth 1 left-top-right-bottom))
         (right (nth 2 left-top-right-bottom))
         (bottom (nth 3 left-top-right-bottom))
         (coords-or-part (if w (coordinates-in-window-p x-dot-y w) nil)))
    (cond
     ((consp coords-or-part)
      (let ((wx (car coords-or-part)) (wy (cdr coords-or-part)))
        (if (< wx (- right left 1))
            (let ((pos (t-mouse-lispy-buffer-posn-from-coords
                        w (- wx left-margin-width)
                        (- wy (if (or header-line-format
                                      default-header-line-format) 1 0)))))
              (list w pos
                    (cons (- (car coords-or-part) left-margin-width)
                          (- (cdr coords-or-part) (if header-line-format 1 0)))
                    timestamp))
          (list w 'vertical-scroll-bar
                (cons (1+ wy) (- bottom top)) timestamp))))
     ((eq coords-or-part 'mode-line)
      (list w 'mode-line (cons (- x left) 0) timestamp 
            (cons (format-mode-line mode-line-format) (- x left))))
     ;; header-line for info, buffer-menu
     ((eq coords-or-part 'header-line)
      (list w 'header-line (cons (- x left) 0) timestamp
            (cons (format-mode-line header-line-format) (- x left))))
     ;; menu-bar a la xt-mouse.el
     ((eq coords-or-part nil)
      (list w 'menu-bar (cons (- x left) 0) timestamp))
     ((eq coords-or-part 'vertical-line)
      (list w 'vertical-line (cons 0 (- y top)) timestamp))
     ((eq coords-or-part 'left-margin)
     ;; FIXME: this click event is incomplete and needs
     ;; a new built-in function to access the missing components.
      (list w 'left-margin (cons x (- y top)) timestamp nil
            (t-mouse-lispy-buffer-posn-from-coords
             w (+ (- x left) left-margin-width) (- y top))
            (cons x (- y top)) nil '(0. 0) '(0 . 0))))))

;;; 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
                       (read-from-string t-mouse-filter-accumulator)
                     (error nil))))
    (if (not ob-pos) nil
      (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
            (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
         ;;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))
                (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.
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.
        (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)
         (process-kill-without-query t-mouse-process)))
; use line below for emacs 21.4 onwards
;        (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]