Mercurial > hg > xemacs-beta

comparison lisp/term/sun-mouse.el @ 165:5a88923fcbfe r20-3b9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b9
author cvs
date Mon, 13 Aug 2007 09:44:42 +0200
parents ac2d302a0011
children a4f53d9b3154
comparison
equal deleted inserted replaced
164:4e0740e5aab2 165:5a88923fcbfe
1 ;;; sun-mouse.el --- mouse handling for Sun windows 1 ;;; sun-mouse.el --- mouse handling for Sun windows
2 2
3 ;; Copyright (C) 1987 Free Software Foundation, Inc. 3 ;; Copyright (C) 1987, 1997 Free Software Foundation, Inc.
4 4
5 ;; Author: Jeff Peck 5 ;; Author: Jeff Peck
6 ;; Maintainer: FSF 6 ;; Maintainer: FSF
7 ;; Keywords: hardware 7 ;; Keywords: hardware
8 8
9 ;; This file is part of GNU Emacs. 9 ;; This file is part of XEmacs.
10 10
11 ;; GNU Emacs is free software; you can redistribute it and/or modify 11 ;; XEmacs is free software; you can redistribute it and/or modify it
12 ;; it under the terms of the GNU General Public License as published by 12 ;; under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option) 13 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; any later version. 14 ;; any later version.
15 15
16 ;; GNU Emacs is distributed in the hope that it will be useful, 16 ;; XEmacs is distributed in the hope that it will be useful, but
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; GNU General Public License for more details. 19 ;; General Public License for more details.
20 20
21 ;; You should have received a copy of the GNU General Public License 21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to 22 ;; along with XEmacs; see the file COPYING. If not, write to the Free
23 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
24 ;; 02111-1307, USA.
25
26 ;;; Synched up with: Unknown
24 27
25 ;;; Commentary: 28 ;;; Commentary:
26 29
27 ;;; Jeff Peck, Sun Microsystems, Jan 1987. 30 ;; Jeff Peck, Sun Microsystems, Jan 1987.
28 ;;; Original idea by Stan Jefferson 31 ;; Original idea by Stan Jefferson
29 32
30 ;;; 33 ;;
31 ;;; Modelled after the GNUEMACS keymap interface. 34 ;; Modelled after the GNUEMACS keymap interface.
32 ;;; 35 ;;
33 ;;; User Functions: 36 ;; User Functions:
34 ;;; make-mousemap, copy-mousemap, 37 ;; make-mousemap, copy-mousemap,
35 ;;; define-mouse, global-set-mouse, local-set-mouse, 38 ;; define-mouse, global-set-mouse, local-set-mouse,
36 ;;; use-global-mousemap, use-local-mousemap, 39 ;; use-global-mousemap, use-local-mousemap,
37 ;;; mouse-lookup, describe-mouse-bindings 40 ;; mouse-lookup, describe-mouse-bindings
38 ;;; 41 ;;
39 ;;; Options: 42 ;; Options:
40 ;;; extra-click-wait, scrollbar-width 43 ;; extra-click-wait, scrollbar-width
41 ;;; 44 ;;
42 45
43 ;;; Code: 46 ;;; Code:
44 47
45 (defvar extra-click-wait 150 48 (defvar extra-click-wait 150
46 "*Number of milliseconds to wait for an extra click. 49 "*Number of milliseconds to wait for an extra click.
162 ;;; 165 ;;;
163 (defmacro sm::loc-w (loc) (list 'nth 0 loc)) 166 (defmacro sm::loc-w (loc) (list 'nth 0 loc))
164 (defmacro sm::loc-x (loc) (list 'nth 1 loc)) 167 (defmacro sm::loc-x (loc) (list 'nth 1 loc))
165 (defmacro sm::loc-y (loc) (list 'nth 2 loc)) 168 (defmacro sm::loc-y (loc) (list 'nth 2 loc))
166 169
167 (defmacro eval-in-buffer (buffer &rest forms)
168 "Macro to switches to BUFFER, evaluates FORMS, returns to original buffer."
169 ;; When you don't need the complete window context of eval-in-window
170 (` (let ((StartBuffer (current-buffer)))
171 (unwind-protect
172 (progn
173 (set-buffer (, buffer))
174 (,@ forms))
175 (set-buffer StartBuffer)))))
176
177 (put 'eval-in-buffer 'lisp-indent-function 1)
178
179 ;;; this is used extensively by sun-fns.el 170 ;;; this is used extensively by sun-fns.el
180 ;;; 171 ;;;
181 (defmacro eval-in-window (window &rest forms) 172 (defmacro eval-in-window (window &rest forms)
182 "Switch to WINDOW, evaluate FORMS, return to original window." 173 "Switch to WINDOW, evaluate FORMS, return to original window."
183 (` (let ((OriginallySelectedWindow (selected-window))) 174 (` (let ((OriginallySelectedWindow (selected-window)))
245 (let ((loc (sm::window-xy (sm::hit-x hit) (sm::hit-y hit)))) 236 (let ((loc (sm::window-xy (sm::hit-x hit) (sm::hit-y hit))))
246 (let ((*mouse-window* (sm::loc-w loc)) 237 (let ((*mouse-window* (sm::loc-w loc))
247 (*mouse-x* (sm::loc-x loc)) 238 (*mouse-x* (sm::loc-x loc))
248 (*mouse-y* (sm::loc-y loc)) 239 (*mouse-y* (sm::loc-y loc))
249 (mouse-code (mouse-event-code hit loc))) 240 (mouse-code (mouse-event-code hit loc)))
250 (let ((form (eval-in-buffer (window-buffer *mouse-window*) 241 (let ((form (with-current-buffer (window-buffer *mouse-window*)
251 (mouse-lookup mouse-code)))) 242 (mouse-lookup mouse-code))))
252 (cond ((null form) 243 (cond ((null form)
253 (if (not (sm::hit-up-p hit)) ; undefined up hits are ok. 244 (if (not (sm::hit-up-p hit)) ; undefined up hits are ok.
254 (error "Undefined mouse event: %s" 245 (error "Undefined mouse event: %s"
255 (prin1-to-string 246 (prin1-to-string