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