1;;; sup-mouse.el --- supdup mouse support for lisp machines
2
3;; Copyright (C) 1985, 1986, 2001, 2002, 2003, 2004,
4;;   2005, 2006, 2007 Free Software Foundation, Inc.
5
6;; Author: Wolfgang Rupprecht
7;; Maintainer: FSF
8;; Created: 21 Nov 1986
9;; Keywords: hardware
10
11;;     (from code originally written by John Robinson@bbn for the bitgraph)
12
13;; This file is part of GNU Emacs.
14
15;; GNU Emacs is free software; you can redistribute it and/or modify
16;; it under the terms of the GNU General Public License as published by
17;; the Free Software Foundation; either version 2, or (at your option)
18;; any later version.
19
20;; GNU Emacs is distributed in the hope that it will be useful,
21;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
23;; GNU General Public License for more details.
24
25;; You should have received a copy of the GNU General Public License
26;; along with GNU Emacs; see the file COPYING.  If not, write to the
27;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
28;; Boston, MA 02110-1301, USA.
29
30;;; Commentary:
31
32;;; Code:
33
34;;;  User customization option:
35
36(defvar sup-mouse-fast-select-window nil
37  "*Non-nil for mouse hits to select new window, then execute; else just select.")
38
39(defconst mouse-left 0)
40(defconst mouse-center 1)
41(defconst mouse-right 2)
42
43(defconst mouse-2left 4)
44(defconst mouse-2center 5)
45(defconst mouse-2right 6)
46
47(defconst mouse-3left 8)
48(defconst mouse-3center 9)
49(defconst mouse-3right 10)
50
51;;;  Defuns:
52
53(defun sup-mouse-report ()
54  "This function is called directly by the mouse, it parses and
55executes the mouse commands.
56
57 L move point          *  |---- These apply for mouse click in a window.
582L delete word            |
593L copy word		  | If sup-mouse-fast-select-window is nil,
60 C move point and yank *  | just selects that window.
612C yank pop		  |
62 R set mark            *  |
632R delete region	  |
643R copy region		  |
65
66on modeline		    on \"scroll bar\"	in minibuffer
67 L scroll-up		    line to top		execute-extended-command
68 C proportional goto-char   line to middle	mouse-help
69 R scroll-down		    line to bottom	eval-expression"
70
71  (interactive)
72  (let*
73;; expect a string of <esc>:<buttons>;<x-pos>;<y-pos>c
74      ((buttons (sup-get-tty-num ?\;))
75       (x (sup-get-tty-num ?\;))
76       (y (sup-get-tty-num ?c))
77       (window (sup-pos-to-window x y))
78       (edges (window-edges window))
79       (old-window (selected-window))
80       (in-minibuf-p (eq y (1- (frame-height))))
81       (same-window-p (and (not in-minibuf-p) (eq window old-window)))
82       (in-modeline-p (eq y (1- (nth 3 edges))))
83       (in-scrollbar-p (>= x (1- (nth 2 edges)))))
84    (setq x (- x (nth 0 edges)))
85    (setq y (- y (nth 1 edges)))
86
87;    (error "mouse-hit %d %d %d" buttons x y) ;;;; debug
88
89    (cond (in-modeline-p
90	   (select-window window)
91	   (cond ((= buttons mouse-left)
92		  (scroll-up))
93		 ((= buttons mouse-right)
94		  (scroll-down))
95		 ((= buttons mouse-center)
96		  (goto-char (/ (* x
97				   (- (point-max) (point-min)))
98				(1- (window-width))))
99		  (beginning-of-line)
100		  (what-cursor-position)))
101	   (select-window old-window))
102	  (in-scrollbar-p
103	   (select-window window)
104	   (scroll-up
105	    (cond ((= buttons mouse-left)
106		   y)
107		  ((= buttons mouse-right)
108		   (+ y (- 2 (window-height))))
109		  ((= buttons mouse-center)
110		   (/ (+ 2 y y (- (window-height))) 2))
111		  (t
112		   0)))
113	   (select-window old-window))
114	  (same-window-p
115	   (cond ((= buttons mouse-left)
116		  (sup-move-point-to-x-y x y))
117		 ((= buttons mouse-2left)
118		  (sup-move-point-to-x-y x y)
119		  (kill-word 1))
120		 ((= buttons mouse-3left)
121		  (sup-move-point-to-x-y x y)
122		  (save-excursion
123		    (copy-region-as-kill
124		     (point) (progn (forward-word 1) (point))))
125		  (setq this-command 'yank)
126		  )
127		 ((= buttons mouse-right)
128		  (push-mark)
129		  (sup-move-point-to-x-y x y)
130		  (exchange-point-and-mark))
131		 ((= buttons mouse-2right)
132		  (push-mark)
133		  (sup-move-point-to-x-y x y)
134		  (kill-region (mark) (point)))
135		 ((= buttons mouse-3right)
136		  (push-mark)
137		  (sup-move-point-to-x-y x y)
138		  (copy-region-as-kill (mark) (point))
139		  (setq this-command 'yank))
140		 ((= buttons mouse-center)
141		  (sup-move-point-to-x-y x y)
142		  (setq this-command 'yank)
143		  (yank))
144		 ((= buttons mouse-2center)
145		  (yank-pop 1))
146		 )
147	   )
148	  (in-minibuf-p
149	   (cond ((= buttons mouse-right)
150		  (call-interactively 'eval-expression))
151		 ((= buttons mouse-left)
152		  (call-interactively 'execute-extended-command))
153		 ((= buttons mouse-center)
154		  (describe-function 'sup-mouse-report)); silly self help
155		 ))
156	  (t				;in another window
157	   (select-window window)
158	   (cond ((not sup-mouse-fast-select-window))
159		 ((= buttons mouse-left)
160		  (sup-move-point-to-x-y x y))
161		 ((= buttons mouse-right)
162		  (push-mark)
163		  (sup-move-point-to-x-y x y)
164		  (exchange-point-and-mark))
165		 ((= buttons mouse-center)
166		  (sup-move-point-to-x-y x y)
167		  (setq this-command 'yank)
168		  (yank))
169		 ))
170	  )))
171
172
173(defun sup-get-tty-num (term-char)
174  "Read from terminal until TERM-CHAR is read, and return intervening number.
175Upon non-numeric not matching TERM-CHAR signal an error."
176  (let
177      ((num 0)
178       (char (read-char)))
179    (while (and (>= char ?0)
180		(<= char ?9))
181      (setq num (+ (* num 10) (- char ?0)))
182      (setq char (read-char)))
183    (or (eq term-char char)
184	(error "Invalid data format in mouse command"))
185    num))
186
187(defun sup-move-point-to-x-y (x y)
188  "Position cursor in window coordinates.
189X and Y are 0-based character positions in the window."
190  (move-to-window-line y)
191  (move-to-column x)
192  )
193
194(defun sup-pos-to-window (x y)
195  "Find window corresponding to frame coordinates.
196X and Y are 0-based character positions on the frame."
197  (get-window-with-predicate (lambda (w)
198			       (coordinates-in-window-p (cons x y) w))))
199
200;;; arch-tag: ec644ed4-cac4-43b8-b3db-cfe83e9098d7
201;;; sup-mouse.el ends here
202