annotate lisp/term/sup-mouse.el @ 5327:d1b17a33450b

Move the heavy lifting from cl-seq.el to C. src/ChangeLog addition: 2010-12-30 Aidan Kehoe <kehoea@parhasard.net> Move the heavy lifting from cl-seq.el to C, finally making those functions first-class XEmacs citizens, with circularity checking, built-in support for tests other than #'eql, and as much compatibility with current Common Lisp as Paul Dietz' tests require. * fns.c (check_eq_nokey, check_eq_key, check_eql_nokey) (check_eql_key, check_equal_nokey, check_equal_key) (check_equalp_nokey, check_equalp_key, check_string_match_nokey) (check_string_match_key, check_other_nokey, check_other_key) (check_if_nokey, check_if_key, check_match_eq_key) (check_match_eql_key, check_match_equal_key) (check_match_equalp_key, check_match_other_key): New. These are basically to provide function pointers to be used by Lisp functions that take TEST, TEST-NOT and KEY arguments. (get_check_match_function_1, get_check_test_function) (get_check_match_function): These functions work out which of the previous list of functions to use, given the keywords supplied by the user. (count_with_tail): New. This is the bones of #'count. (list_count_from_end, string_count_from_end): Utility functions for #'count. (Fcount): New, moved from cl-seq.el. (list_position_cons_before): New. The implementation of #'member*, and important in implementing various other functions. (FmemberX, Fadjoin, FassocX, FrassocX, Fposition, Ffind) (FdeleteX, FremoveX, Fdelete_duplicates, Fremove_duplicates) (Fnsubstitute, Fsubstitute, Fsublis, Fnsublis, Fsubst, Fnsubst) (Ftree_equal, Fmismatch, Fsearch, Fintersection, Fnintersection) (Fsubsetp, Fset_difference, Fnset_difference, Fnunion, Funion) (Fset_exclusive_or, Fnset_exclusive_or): New, moved here from cl-seq.el. (position): New. The implementation of #'find and #'position. (list_delete_duplicates_from_end, subst, sublis, nsublis) (tree_equal, mismatch_from_end, mismatch_list_list) (mismatch_list_string, mismatch_list_array) (mismatch_string_array, mismatch_string_string) (mismatch_array_array, get_mismatch_func): Helper C functions for the Lisp-visible functions. (venn, nvenn): New. The implementation of the main Lisp functions that treat lists as sets. lisp/ChangeLog addition: 2010-12-30 Aidan Kehoe <kehoea@parhasard.net> * cl-seq.el: Move the heavy lifting from this file to C. Dump the cl-parsing-keywords macro, but don't use defun* for the functions we define that do take keywords, dynamic scope lossage makes that not practical. * subr.el (sort, fillarray): Move these aliases here. (map-plist): #'nsublis is now built-in, but at this point #'eql isn't necessarily available as a test; use #'eq. * obsolete.el (cl-delete-duplicates): Make this available for old compiler macros and old code. (memql): Document that this is equivalent to #'member*, and worse. * cl.el (adjoin, subst): Removed. These are in C.
author Aidan Kehoe <kehoea@parhasard.net>
date Thu, 30 Dec 2010 01:59:52 +0000
parents 85bd42a1e544
children b9167d522a9a
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1 ;;; sup-mouse.el --- supdup mouse support for lisp machines
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2
5291
85bd42a1e544 More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 772
diff changeset
3 ;; Copyright (C) 1985, 1986 Free Software Foundation
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5 ;; Author: Wolfgang Rupprecht
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6 ;; Maintainer: FSF
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
7 ;; Created: 21 Nov 1986
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
8 ;; Keywords: hardware
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
9
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
10 ;; (from code originally written by John Robinson@bbn for the bitgraph)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
11
5291
85bd42a1e544 More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 772
diff changeset
12 ;; This file is part of XEmacs.
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
13
5291
85bd42a1e544 More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 772
diff changeset
14 ;; XEmacs is free software; you can redistribute it and/or modify
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
15 ;; it under the terms of the GNU General Public License as published by
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
16 ;; the Free Software Foundation; either version 2, or (at your option)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
17 ;; any later version.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
18
5291
85bd42a1e544 More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 772
diff changeset
19 ;; XEmacs is distributed in the hope that it will be useful,
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
22 ;; GNU General Public License for more details.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
23
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
24 ;; You should have received a copy of the GNU General Public License
5291
85bd42a1e544 More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 772
diff changeset
25 ;; along with XEmacs; see the file COPYING. If not, write to
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
26 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
27
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
28 ;;; Code:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
29
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
30 ;;; User customization option:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
31
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
32 (defvar sup-mouse-fast-select-window nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
33 "*Non-nil for mouse hits to select new window, then execute; else just select.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
34
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
35 (defconst mouse-left 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
36 (defconst mouse-center 1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
37 (defconst mouse-right 2)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
38
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
39 (defconst mouse-2left 4)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
40 (defconst mouse-2center 5)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
41 (defconst mouse-2right 6)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
42
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
43 (defconst mouse-3left 8)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
44 (defconst mouse-3center 9)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
45 (defconst mouse-3right 10)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
46
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
47 ;;; Defuns:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
48
772
d682c0f82a71 [xemacs-hg @ 2002-03-13 10:00:06 by ben]
ben
parents: 0
diff changeset
49 (defun sup-window-edges (&optional win)
d682c0f82a71 [xemacs-hg @ 2002-03-13 10:00:06 by ben]
ben
parents: 0
diff changeset
50 (error "not implemented")
d682c0f82a71 [xemacs-hg @ 2002-03-13 10:00:06 by ben]
ben
parents: 0
diff changeset
51 (window-pixel-edges win))
d682c0f82a71 [xemacs-hg @ 2002-03-13 10:00:06 by ben]
ben
parents: 0
diff changeset
52
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
53 (defun sup-mouse-report ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
54 "This function is called directly by the mouse, it parses and
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
55 executes the mouse commands.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
56
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
57 L move point * |---- These apply for mouse click in a window.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
58 2L delete word |
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
59 3L copy word | If sup-mouse-fast-select-window is nil,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
60 C move point and yank * | just selects that window.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
61 2C yank pop |
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
62 R set mark * |
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
63 2R delete region |
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
64 3R copy region |
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
65
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
66 on modeline on \"scroll bar\" in minibuffer
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
67 L scroll-up line to top execute-extended-command
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
68 C proportional goto-char line to middle mouse-help
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
69 R scroll-down line to bottom eval-expression"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
70
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
71 (interactive)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
72 (let*
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
73 ;; expect a string of <esc>:<buttons>;<x-pos>;<y-pos>c
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
74 ((buttons (sup-get-tty-num ?\;))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
75 (x (sup-get-tty-num ?\;))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
76 (y (sup-get-tty-num ?c))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
77 (window (sup-pos-to-window x y))
772
d682c0f82a71 [xemacs-hg @ 2002-03-13 10:00:06 by ben]
ben
parents: 0
diff changeset
78 (edges (sup-window-edges window))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
79 (old-window (selected-window))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
80 (in-minibuf-p (eq y (1- (frame-height))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
81 (same-window-p (and (not in-minibuf-p) (eq window old-window)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
82 (in-modeline-p (eq y (1- (nth 3 edges))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
83 (in-scrollbar-p (>= x (1- (nth 2 edges)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
84 (setq x (- x (nth 0 edges)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
85 (setq y (- y (nth 1 edges)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
86
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
87 ; (error "mouse-hit %d %d %d" buttons x y) ;;;; debug
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
88
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
89 (cond (in-modeline-p
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
90 (select-window window)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
91 (cond ((= buttons mouse-left)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
92 (scroll-up))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
93 ((= buttons mouse-right)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
94 (scroll-down))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
95 ((= buttons mouse-center)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
96 (goto-char (/ (* x
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
97 (- (point-max) (point-min)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
98 (1- (window-width))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
99 (beginning-of-line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
100 (what-cursor-position)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
101 (select-window old-window))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
102 (in-scrollbar-p
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
103 (select-window window)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
104 (scroll-up
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
105 (cond ((= buttons mouse-left)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
106 y)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
107 ((= buttons mouse-right)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
108 (+ y (- 2 (window-height))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
109 ((= buttons mouse-center)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
110 (/ (+ 2 y y (- (window-height))) 2))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
111 (t
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
112 0)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
113 (select-window old-window))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
114 (same-window-p
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
115 (cond ((= buttons mouse-left)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
116 (sup-move-point-to-x-y x y))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
117 ((= buttons mouse-2left)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
118 (sup-move-point-to-x-y x y)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
119 (kill-word 1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
120 ((= buttons mouse-3left)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
121 (sup-move-point-to-x-y x y)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
122 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
123 (copy-region-as-kill
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
124 (point) (progn (forward-word 1) (point))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
125 (setq this-command 'yank)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
126 )
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
127 ((= buttons mouse-right)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
128 (push-mark)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
129 (sup-move-point-to-x-y x y)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
130 (exchange-point-and-mark))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
131 ((= buttons mouse-2right)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
132 (push-mark)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
133 (sup-move-point-to-x-y x y)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
134 (kill-region (mark) (point)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
135 ((= buttons mouse-3right)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
136 (push-mark)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
137 (sup-move-point-to-x-y x y)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
138 (copy-region-as-kill (mark) (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
139 (setq this-command 'yank))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
140 ((= buttons mouse-center)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
141 (sup-move-point-to-x-y x y)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
142 (setq this-command 'yank)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
143 (yank))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
144 ((= buttons mouse-2center)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
145 (yank-pop 1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
146 )
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
147 )
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
148 (in-minibuf-p
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
149 (cond ((= buttons mouse-right)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
150 (call-interactively 'eval-expression))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
151 ((= buttons mouse-left)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
152 (call-interactively 'execute-extended-command))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
153 ((= buttons mouse-center)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
154 (describe-function 'sup-mouse-report)); silly self help
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
155 ))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
156 (t ;in another window
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
157 (select-window window)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
158 (cond ((not sup-mouse-fast-select-window))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
159 ((= buttons mouse-left)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
160 (sup-move-point-to-x-y x y))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
161 ((= buttons mouse-right)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
162 (push-mark)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
163 (sup-move-point-to-x-y x y)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
164 (exchange-point-and-mark))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
165 ((= buttons mouse-center)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
166 (sup-move-point-to-x-y x y)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
167 (setq this-command 'yank)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
168 (yank))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
169 ))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
170 )))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
171
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
172
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
173 (defun sup-get-tty-num (term-char)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
174 "Read from terminal until TERM-CHAR is read, and return intervening number.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
175 Upon non-numeric not matching TERM-CHAR signal an error."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
176 (let
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
177 ((num 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
178 (char (read-char)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
179 (while (and (>= char ?0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
180 (<= char ?9))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
181 (setq num (+ (* num 10) (- char ?0)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
182 (setq char (read-char)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
183 (or (eq term-char char)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
184 (error "Invalid data format in mouse command"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
185 num))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
186
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
187 (defun sup-move-point-to-x-y (x y)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
188 "Position cursor in window coordinates.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
189 X and Y are 0-based character positions in the window."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
190 (move-to-window-line y)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
191 (move-to-column x)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
192 )
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
193
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
194 (defun sup-pos-to-window (x y)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
195 "Find window corresponding to frame coordinates.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
196 X and Y are 0-based character positions on the frame."
772
d682c0f82a71 [xemacs-hg @ 2002-03-13 10:00:06 by ben]
ben
parents: 0
diff changeset
197 (let ((edges (sup-window-edges))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
198 (window nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
199 (while (and (not (eq window (selected-window)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
200 (or (< y (nth 1 edges))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
201 (>= y (nth 3 edges))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
202 (< x (nth 0 edges))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
203 (>= x (nth 2 edges))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
204 (setq window (next-window window))
772
d682c0f82a71 [xemacs-hg @ 2002-03-13 10:00:06 by ben]
ben
parents: 0
diff changeset
205 (setq edges (sup-window-edges window))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
206 )
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
207 (or window (selected-window))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
208 )
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
209 )
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
210
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
211 ;;; sup-mouse.el ends here