-;;; t-mouse.el --- mouse support within the text terminal
-
-;;; Copyright (C) 1994,1995 Alessandro Rubini <rubini@linux.it>
-;;; parts are by Ian T Zimmermann <itz@rahul.net>, 1995,1998
-
-;; Maintainer: gpm mailing list: gpm@prosa.it
-;; 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.
-
-\f
-(require 'advice)
-
-(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.")
-
-\f
-;;; 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."
- (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))))
-
-\f
-;; 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))))
-
-\f
-;;; This fun is partly Copyright (C) 1994 Per Abrahamsen <abraham@iesd.auc.dk>
-;; 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 <abraham@iesd.auc.dk>
-
-(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)))))
-
-
-;; 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
-;; 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")))))
-
-\f
-;;; 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
+;;; t-mouse.el --- mouse support within the text terminal
+
+;; Author: Nick Roberts <nickrob@gnu.org>
+;; Maintainer: FSF
+;; Keywords: mouse gpm linux
+
+;; Copyright (C) 1994, 1995, 1998, 2006, 2007, 2008
+;; 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 3 of the License, 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. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; 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.
+
+;; The file, t-mouse.el was originally written by Alessandro Rubini and Ian T
+;; Zimmerman, and Emacs communicated with gpm through a client program called
+;; mev. Now the interface with gpm is directly through a Unix socket, so this
+;; file is reduced to a single minor mode macro call.
+
+;;
+\f
+;;; Code:
+
+;; Prevent warning when compiling in an Emacs without gpm support.
+(declare-function gpm-mouse-start "term.c" ())
+
+(defun gpm-mouse-enable ()
+ "Try to enable gpm mouse support on the current terminal."
+ (let ((activated nil))
+ (unwind-protect
+ (progn
+ (unless (fboundp 'gpm-mouse-start)
+ (error "Emacs must be built with Gpm to use this mode"))
+ (when gpm-mouse-mode
+ (gpm-mouse-start)
+ (set-terminal-parameter nil 'gpm-mouse-active t)
+ (setq activated t)))
+ ;; If something failed to turn it on, try to turn it off as well,
+ ;; just in case.
+ (unless activated (gpm-mouse-disable)))))
+
+(defun gpm-mouse-disable ()
+ "Try to disable gpm mouse support on the current terminal."
+ (when (fboundp 'gpm-mouse-stop)
+ (gpm-mouse-stop))
+ (set-terminal-parameter nil 'gpm-mouse-active nil))
+
+;;;###autoload
+(define-obsolete-function-alias 't-mouse-mode 'gpm-mouse-mode "23.1")
+;;;###autoload
+(define-minor-mode gpm-mouse-mode
+ "Toggle gpm-mouse mode to use the mouse in GNU/Linux consoles.
+With prefix arg, turn gpm-mouse mode on if arg is positive,
+otherwise turn it off.
+
+This allows the use of the mouse when operating on a GNU/Linux console,
+in the same way as you can use the mouse under X11.
+It relies on the `gpm' daemon being activated."
+ :global t :group 'mouse :init-value t
+ (dolist (terminal (terminal-list))
+ (when (and (eq t (terminal-live-p terminal))
+ (not (eq gpm-mouse-mode
+ (terminal-parameter terminal 'gpm-mouse-active))))
+ ;; Simulate selecting a terminal by selecting one of its frames ;-(
+ (with-selected-frame (car (frames-on-display-list terminal))
+ (if gpm-mouse-mode (gpm-mouse-enable) (gpm-mouse-disable))))))
+
+(provide 't-mouse)
+
+;; arch-tag: a63163b3-bfbe-4eb2-ab4f-201cd164b05d
+;;; t-mouse.el ends here
HCoop / bpt / emacs.git / blobdiff