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