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