annotate lisp/xt-mouse.el @ 13282:69fe836d7f02

(get-method-definition, get-method-definition-1): Rename var md to get-method-definition-md and defvar it.
author Richard M. Stallman <rms@gnu.org>
date Tue, 24 Oct 1995 04:07:17 +0000
parents 01f90e21a1db
children 5de4c8a3f702
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
13163
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1 ;;; xt-mouse.el --- Support the mouse when emacs run in an xterm.
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2 ;; Copyright (C) 1994 Free Software Foundation
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
3
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
4 ;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
5 ;; Keywords: mouse, terminals
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
6
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
7 ;; This program is free software; you can redistribute it and/or modify
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
8 ;; it under the terms of the GNU General Public License as published by
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
9 ;; the Free Software Foundation; either version 2, or (at your option)
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
10 ;; any later version.
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
11 ;;
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
12 ;; This program is distributed in the hope that it will be useful,
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
15 ;; GNU General Public License for more details.
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
16 ;;
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
17 ;; You should have received a copy of the GNU General Public License
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
18 ;; along with this program; if not, write to the Free Software
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
19 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
20
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
21 ;;; Comments:
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
22
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
23 ;; Enable mouse support when running inside an xterm.
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
24
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
25 ;; This is actually useful when you are running X11 locally, but is
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
26 ;; working on remote machine over a modem line or through a gateway.
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
27
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
28 ;; It works by translating xterm escape codes into generic emacs mouse
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
29 ;; events so it should work with any package that uses the mouse.
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
30
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
31 ;;; Todo:
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
32
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
33 ;; Support multi-click -- somehow.
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
34
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
35 ;; Clicking on the mode-line does not work, although it should.
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
36
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
37 ;;; Code:
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
38
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
39 ;; Emacs only generates down events when needed.
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
40 ;; This is too hard to emulate, so we cheat instead.
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
41 (or (lookup-key global-map [ down-mouse-1 ])
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
42 (define-key global-map [ down-mouse-1 ] 'ignore))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
43 (or (lookup-key global-map [ down-mouse-2 ])
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
44 (define-key global-map [ down-mouse-2 ] 'ignore))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
45 (or (lookup-key global-map [ down-mouse-3 ])
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
46 (define-key global-map [ down-mouse-3 ] 'ignore))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
47
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
48 (define-key function-key-map "\e[M" 'xterm-mouse-translate)
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
49
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
50 (defun xterm-mouse-translate (event)
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
51 ;; Read a click and release event from XTerm.
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
52 (save-excursion
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
53 (save-window-excursion
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
54 (deactivate-mark)
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
55 (let* ((last)
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
56 (down (xterm-mouse-event)))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
57 (or (and (eq (read-char) ?\e)
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
58 (eq (read-char) ?\[)
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
59 (eq (read-char) ?M))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
60 (error "Unexpected escape sequence from XTerm"))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
61 (let ((click (xterm-mouse-event)))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
62 (setq unread-command-events
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
63 (append unread-command-events
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
64 (if (eq (nth 1 (nth 1 down)) (nth 1 (nth 1 click)))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
65 (list click)
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
66 (list
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
67 ;; Generate move event to cheat `mouse-drag-region'.
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
68 (list 'mouse-movement (nth 1 click))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
69 ;; Generate a drag event.
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
70 (list (intern (concat "drag-mouse-" (+ 1 last)))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
71 (nth 1 down) (nth 1 click)))))))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
72 (vector down)))))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
73
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
74 (defun xterm-mouse-event ()
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
75 ;; Convert XTerm mouse event to Emacs mouse event.
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
76 (let* ((type (- (read-char) ? ))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
77 (x (- (read-char) ? 1))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
78 (y (- (read-char) ? 1))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
79 (point (cons x y))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
80 (window (window-at x y))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
81 (where (coordinates-in-window-p point window))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
82 (pos (if (consp where)
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
83 (progn
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
84 (select-window window)
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
85 (goto-char (window-start window))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
86 (move-to-window-line (cdr where))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
87 (move-to-column (+ (car where) (current-column)
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
88 (max 0 (1- (window-hscroll)))))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
89 (point))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
90 where))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
91 (mouse (intern (if (eq type 3)
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
92 (concat "mouse-" (+ 1 last))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
93 (setq last type)
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
94 (concat "down-mouse-" (+ 1 type))))))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
95 (list mouse
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
96 (list window pos point
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
97 (/ (nth 2 (current-time)) 1000)))))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
98
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
99 ;; Indicator for the xterm-mouse mode.
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
100 (defvar xterm-mouse-mode nil)
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
101
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
102 (or (assq 'xterm-mouse-mode minor-mode-alist)
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
103 (setq minor-mode-alist
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
104 (cons '(xterm-mouse-mode (" Mouse")) minor-mode-alist)))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
105
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
106 ;;;###autoload
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
107 (defun xterm-mouse-mode (arg)
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
108 "Toggle XTerm mouse mode.
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
109 With prefix arg, turn XTerm mouse mode on iff arg is positive.
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
110
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
111 Turn it on to use emacs mouse commands, and off to use xterm mouse commands."
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
112 (interactive "P")
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
113 (if (or (and (null arg) xterm-mouse-mode)
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
114 (<= (prefix-numeric-value arg) 0))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
115 ;; Turn it off
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
116 (if xterm-mouse-mode
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
117 (progn
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
118 (turn-off-xterm-mouse-tracking)
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
119 (setq xterm-mouse-mode nil)
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
120 (set-buffer-modified-p (buffer-modified-p))))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
121 ;;Turn it on
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
122 (if xterm-mouse-mode
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
123 ()
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
124 (setq xterm-mouse-mode t)
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
125 (turn-on-xterm-mouse-tracking)
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
126 (set-buffer-modified-p (buffer-modified-p)))))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
127
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
128 (defun turn-on-xterm-mouse-tracking ()
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
129 ;; Enable emacs mouse tracking in xterm.
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
130 (if xterm-mouse-mode
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
131 (send-string-to-terminal "\e[?1000h")))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
132
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
133 (defun turn-off-xterm-mouse-tracking ()
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
134 ;; Disable disable emacs mouse tracking in xterm.
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
135 (if xterm-mouse-mode
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
136 (send-string-to-terminal "\e[?1000l")))
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
137
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
138 ;; Restore normal mouse behaviour outside Emacs.
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
139 (add-hook 'suspend-hook 'turn-off-xterm-mouse-tracking)
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
140 (add-hook 'suspend-resume-hook 'turn-on-xterm-mouse-tracking)
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
141 (add-hook 'kill-emacs-hook 'turn-off-xterm-mouse-tracking)
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
142
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
143 (provide 'xt-mouse)
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
144
01f90e21a1db Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
145 ;;; xt-mouse.el ends here