comparison lisp/t-mouse.el @ 69189:ec62f416bd30

(t-mouse-tty): Use with-temp-buffer. Add more terminal types. (t-mouse-lispy-buffer-posn-from-coords): Remove. Use C primitive... (t-mouse-make-event-element): ...posn-at-x-y instead. (t-mouse-make-event): Deal with Fedora Core 3. (t-mouse-make-event): Don't sink the `stupid text mode menubar'. (t-mouse-mouse-position-function): New function. Use it instead of advising mouse-position. (t-mouse-mode): New minor mode. (t-mouse-stop, t-mouse-run): Remove. Use t-mouse-mode instead.

69188:bbe4019f0045

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

;;; Copyright (C) 1994,1995 Alessandro Rubini <[e-mail]>
;;;               parts are by Ian T Zimmermann <[e-mail]>, 1995,1998

;; Maintainer: gpm mailing list: [e-mail]
;; 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.

;; Developed for GNU Emacs 19.34, likely won't work with many others
;; too much internals dependent cruft here.


(require 'advice)

(defvar t-mouse-process nil 
  "Embeds the process which passes mouse events to emacs.
It is used by the program t-mouse.")

;; 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."
  (let ((buffer (generate-new-buffer "*t-mouse*")))
    (call-process "ps" nil buffer nil "h" (format "%s" (emacs-pid)))
    (prog1 (save-excursion
             (set-buffer buffer)
             (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))
                 (buffer-substring (match-beginning 1) (match-end 1))))
      (kill-buffer buffer))))

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

    (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 <[e-mail]>
;; 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 (coordinates-in-window-p x-dot-y w)))
    (cond
     ((consp coords-or-part)
      (let ((wx (car coords-or-part)) (wy (cdr coords-or-part)))
        (if (< wx (- right left 1))
            (list w 
                  (t-mouse-lispy-buffer-posn-from-coords w wx wy)
                  coords-or-part 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))
     ((eq coords-or-part 'vertical-line)
      (list w 'vertical-line (cons 0 (- y top)) timestamp)))))     

;;; This fun is partly Copyright (C) 1994 Per Abrahamsen <[e-mail]>

(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

        (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))))

          (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

                (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)))))


;; this overrides a C function which stupidly assumes (no X => no mouse)
(defadvice mouse-position (around t-mouse-mouse-position activate)
  "Return the t-mouse-position unless running with a window system.
The (secret) scrollbar interface is not implemented yet."
  (if (not window-system)
      (setq ad-return-value
            (cons (selected-frame) t-mouse-current-xy))
    ad-do-it))

(setq mouse-sel-set-selection-function
      (function (lambda (type value)
                  (if (not window-system)
                      (if (eq 'PRIMARY type) (kill-new value))
                    (funcall t-mouse-prev-set-selection-function
                             type value)))))

(setq mouse-sel-get-selection-function
      (function (lambda (type)
                  (if (not window-system)
                      (if (eq 'PRIMARY type)
                          (current-kill 0) "")
                    (funcall t-mouse-prev-get-selection-function type)))))

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

          (function (lambda ()
                      (and t-mouse-process
                           ;(continue-process t-mouse-process)
                           (process-send-string t-mouse-process "pop\n")))))


;;; User commands

(defun t-mouse-stop ()
  "Stop getting mouse events from an asynchronous process."
  (interactive)
  (delete-process t-mouse-process)
  (setq t-mouse-process nil))

(defun t-mouse-run ()
  "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.
Returns the newly created asynchronous process."
  (interactive)
  (let ((tty (t-mouse-tty))
        (process-connection-type t))
    (if (or window-system (not (stringp tty)))
        (error "Run t-mouse on a virtual terminal without a window system"))
    (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)
  t-mouse-process)

(provide 't-mouse)

;;; t-mouse.el ends here

69189:ec62f416bd30

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

;; Authors: Alessandro Rubini and Ian T Zimmerman
;; Maintainer: Nick Roberts <[e-mail]>
;; Keywords: mouse gpm linux

;; Copyright (C) 1994,1995 Alessandro Rubini <[e-mail]>
;;               parts are by Ian T Zimmermann <[e-mail]>, 1995,1998
;; Copyright (C) 2006 
;; Free Software Foundation, Inc.

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs 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, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, 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 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.")

;; 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)
	 (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).

    (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 <[e-mail]>
(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
		       (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))
      (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

        (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))))

          (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

                (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

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