Context Navigation

mouse.lisp @ 257

Revision 257, 17.9 KB (checked in by rjs, 22 months ago)
Initial versions.

Line
1	;;; Mouse commands for ZWEI --Mode:LISP;Package:ZWEI--
2	;;; (c) Copyright 1980 Massachusetts Institute of Technology
3	;;; Note: some screen system primitives live in SCREEN
4
5	;;; Proposed mouse command table for ZWEI windows:
6	;;; [1] Mark some characters.
7	;;; [11] No region -> Select window, Region -> You are moving it.
8	;;; [2] Mark some things.
9	;;; [22] Kill, Yank, Yank-pop
10	;;; [3] Put ZWEI menu here.
11	;;; [33] Call system menu
12
13	(DEFVAR MOUSE-P)
14	(DEFVAR MOUSE-CHAR-BLINKER)
15	(DEFVAR GLOBAL-MOUSE-CHAR-BLINKER)
16	(DEFVAR GLOBAL-MOUSE-CHAR-BLINKER-HANDLER)
17
18	;;; Called by the editor to initialize the mouse
19	(DEFUN INITIALIZE-MOUSE (&AUX (INHIBIT-SCHEDULING-FLAG T))
20	(AND (BOUNDP 'MOUSE-CHAR-BLINKER)
21	(TV:OPEN-BLINKER MOUSE-CHAR-BLINKER))
22	(SETQ MOUSE-P NIL
23	MOUSE-CHAR-BLINKER (TV:DEFINE-BLINKER TV:MOUSE-SHEET 'TV:CHARACTER-BLINKER
24	':VISIBILITY NIL
25	':HALF-PERIOD 4
26	':FONT TV:(SCREEN-DEFAULT-FONT DEFAULT-SCREEN)
27	':CHAR #/?)
28	GLOBAL-MOUSE-CHAR-BLINKER (TV:DEFINE-BLINKER TV:MOUSE-SHEET 'TV:RECTANGULAR-BLINKER
29	':VISIBILITY NIL
30	':HALF-PERIOD 4)
31	GLOBAL-MOUSE-CHAR-BLINKER-HANDLER NIL))
32
33	;;;Wait for the mouse to do something, return non-nil if released buttons or left window
34	(DEFUN WAIT-FOR-MOUSE (LAST-X LAST-Y &OPTIONAL MAX-SPEED)
35	(PROCESS-WAIT "MOUSE"
36	#'(LAMBDA (LX LY MS)
37	(OR (AND (OR ( TV:MOUSE-X LX) ( TV:MOUSE-Y LY))
38	(OR (NULL MS) ( TV:MOUSE-SPEED MS)))
39	(ZEROP TV:MOUSE-LAST-BUTTONS)
40	(NOT MOUSE-P)))
41	LAST-X LAST-Y MAX-SPEED)
42	(AND (NOT (ZEROP TV:MOUSE-LAST-BUTTONS)) MOUSE-P))
43
44	;;; Call MOUSE-CHAR so we can be sure that the BP points the thing that's blinking
45	(DEFUN MOUSE-BP (WINDOW &AUX CHAR X Y LINE CHAR-POS)
46	(MULTIPLE-VALUE (CHAR X Y LINE CHAR-POS)
47	(MOUSE-CHAR WINDOW))
48	(COND ((NULL CHAR) ;Couldn't anything, use end of buffer for want of anything better
49	(COPY-BP (INTERVAL-LAST-BP (WINDOW-INTERVAL WINDOW))))
50	(T
51	(CREATE-BP LINE CHAR-POS))))
52
53	;;; The mouse must be in the selected window's area of the screen
54	;;; Returns the character at which the mouse points, and the X and Y positions
55	;;; of that character relative to its sheet. If the mouse is not at a character,
56	;;; returns NIL.
57	(DEFUN MOUSE-CHAR (WINDOW)
58	(PROG (SHEET LINE PLINE CHAR-POS LH X Y REAL-PLINE START END)
59	(SETQ SHEET (WINDOW-SHEET WINDOW))
60	(MULTIPLE-VALUE (X Y)
61	(TV:SHEET-CALCULATE-OFFSETS SHEET TV:MOUSE-SHEET))
62	(SETQ LH (TV:SHEET-LINE-HEIGHT SHEET)
63	PLINE (SETQ REAL-PLINE (// (- TV:MOUSE-Y Y) LH)))
64	;; If mouse moves to out of range, protect against error and return
65	(AND (OR (MINUSP PLINE) ( PLINE (WINDOW-N-PLINES WINDOW)))
66	(RETURN NIL))
67	(DO NIL ((AND (PLINE-LINE WINDOW PLINE)
68	(ZEROP (PLINE-FROM-INDEX WINDOW PLINE))))
69	(AND (ZEROP PLINE) (RETURN))
70	(SETQ PLINE (1- PLINE)))
71	(OR (SETQ LINE (PLINE-LINE WINDOW PLINE))
72	(RETURN))
73	(SETQ START (PLINE-FROM-INDEX WINDOW PLINE))
74	(LET ((BP (INTERVAL-FIRST-BP (WINDOW-INTERVAL WINDOW))))
75	(AND (EQ LINE (BP-LINE BP)) (SETQ START (MIN START (BP-INDEX BP)))))
76	(LET ((BP (INTERVAL-LAST-BP (WINDOW-INTERVAL WINDOW))))
77	(AND (EQ LINE (BP-LINE BP)) (SETQ END (BP-INDEX BP))))
78	(MULTIPLE-VALUE (X Y CHAR-POS) ;Find character to right of mouse
79	(TV:SHEET-COMPUTE-MOTION SHEET 0 (* PLINE LH) LINE START END NIL
80	(MAX 0 (- TV:MOUSE-X X))
81	(* REAL-PLINE LH)))
82	(COND ((NULL CHAR-POS) ;Mouse if off end of line, pointing at the CR
83	(RETURN #\CR X Y LINE (OR END (LINE-LENGTH LINE))))
84	(T
85	;; X, Y, CHAR-POS are for char to right of mouse
86	;; Find the character which is just over the mouse
87	(SETQ CHAR-POS (MAX 0 (1- CHAR-POS)))
88	(LET ((CHAR (IF (= CHAR-POS (LINE-LENGTH LINE)) #\CR
89	(AREF LINE CHAR-POS)))
90	(FONT-MAP (TV:SHEET-FONT-MAP SHEET)))
91	(LET ((FONT (AREF FONT-MAP (LDB %%CH-FONT CHAR))))
92	(RETURN CHAR
93	(MAX 0
94	(- X (TV:SHEET-CHARACTER-WIDTH SHEET (LDB %%CH-CHAR CHAR) FONT)))
95	(+ Y (- (TV:SHEET-BASELINE SHEET) (FONT-BASELINE FONT)))
96	LINE CHAR-POS)))))))
97
98	;;; This returns the name of a function, either from the buffer with the mouse, or the
99	;;; mini-buffer.
100	;;; STRINGP of T means return a string if one is typed, don't intern it now.
101	;;; STRINGP of ALWAYS-READ means always return a newly read symbol, even if a completion
102	;;; was typed.
103	(DEFUN READ-FUNCTION-NAME (PROMPT &OPTIONAL DEFAULT MUST-BE-DEFINED STRINGP
104	&AUX TEM CH)
105	(AND (EQ MUST-BE-DEFINED T) (SETQ STRINGP 'ALWAYS-READ))
106	(SETQ PROMPT (FORMAT NIL "~A~:[:~; (Default: ~S)~]" PROMPT DEFAULT DEFAULT))
107	(COND ((OR MINI-BUFFER-REPEATED-COMMAND (FUNCALL STANDARD-INPUT ':LISTEN))
108	(SETQ TEM 0 CH NIL)) ;C-X , no opportunity for mouse
109	(T
110	(LET ((MODE-LINE-LIST (NCONS PROMPT)))
111	(REDISPLAY-MODE-LINE)) ;Make correct for later
112	(DELETE-INTERVAL (WINDOW-INTERVAL MINI-BUFFER-WINDOW))
113	(MUST-REDISPLAY MINI-BUFFER-WINDOW DIS-ALL)
114	(SELECT-WINDOW MINI-BUFFER-WINDOW)
115	;;KLUDGE, position blinker
116	(DO L (WINDOW-SPECIAL-BLINKER-LIST MINI-BUFFER-WINDOW) (CDR L) (NULL L)
117	(TV:BLINKER-SET-VISIBILITY (CDAR L) NIL))
118	(LET ((BL (WINDOW-POINT-BLINKER MINI-BUFFER-WINDOW)))
119	(TV:BLINKER-SET-CURSORPOS BL 0 0)
120	(TV:BLINKER-SET-VISIBILITY BL ':BLINK))
121	(UNWIND-PROTECT
122	(LET-GLOBALLY ((GLOBAL-MOUSE-CHAR-BLINKER-HANDLER (IF MUST-BE-DEFINED
123	#'BLINK-FUNCTION
124	#'BLINK-ATOM))
125	(MOUSE-FONT-CHAR 0)
126	(MOUSE-X-OFFSET 4)
127	(MOUSE-Y-OFFSET 0))
128	(SETQ TV:MOUSE-RECONSIDER T)
129	(MULTIPLE-VALUE (TEM CH)
130	(FUNCALL STANDARD-INPUT ':MOUSE-OR-KBD-TYI)))
131	(TV:BLINKER-SET-VISIBILITY GLOBAL-MOUSE-CHAR-BLINKER NIL)
132	(SETQ TV:MOUSE-RECONSIDER T))))
133	(COND ((AND (= TEM #\MOUSE-1-1) (OR (FBOUNDP (SETQ TEM (ATOM-UNDER-MOUSE (CADR CH))))
134	(STRING-IN-AARRAY-P TEM ZMACS-COMPLETION-AARRAY)
135	(GET TEM ':SOURCE-FILE-NAME)
136	(AND (NOT MUST-BE-DEFINED) TEM)))
137	(SELECT-WINDOW WINDOW)
138	(DISAPPEAR-MINI-BUFFER-WINDOW)
139	TEM)
140	(T
141	(FUNCALL STANDARD-INPUT ':UNTYI CH)
142	(LET ((NAME (COMPLETING-READ-FROM-MINI-BUFFER PROMPT ZMACS-COMPLETION-AARRAY
143	(OR (NEQ STRINGP 'ALWAYS-READ)
144	'ALWAYS-STRING)))
145	SYM)
146	(COND ((EQUAL NAME "")
147	(OR DEFAULT (BARF))
148	(SETQ SYM DEFAULT NAME (STRING DEFAULT)))
149	((LISTP NAME)
150	(SETQ SYM (CDR NAME)
151	NAME (CAR NAME)))
152	((EQ STRINGP T) ;If returning a string, don't intern it
153	(SETQ SYM NAME))
154	(T
155	(MULTIPLE-VALUE (SYM NAME)
156	(SYMBOL-FROM-STRING NAME))))
157	(AND (EQ MUST-BE-DEFINED T) (NOT (FDEFINEDP SYM)) (BARF "~S is not defined" SYM))
158	(MVRETURN SYM NAME)))))
159
160	;;; This finds the atom the mouse is pointing to
161	(DEFUN ATOM-UNDER-MOUSE (WINDOW &OPTIONAL CHAR X Y LINE INDEX &AUX SYMBOL END)
162	(OR CHAR (MULTIPLE-VALUE (CHAR X Y LINE INDEX)
163	(MOUSE-CHAR WINDOW)))
164	(AND CHAR
165	( CHAR #\CR)
166	(DO ((I INDEX (1- I)))
167	((OR (ZEROP I)
168	( (ATOM-WORD-SYNTAX (AREF LINE I)) WORD-ALPHABETIC))
169	(AND ( I INDEX)
170	(ERRSET (LET ((PACKAGE PACKAGE)
171	(READ-PRESERVE-DELIMITERS T)
172	(INTERVAL (WINDOW-INTERVAL WINDOW)))
173	(AND (ZMACS-BUFFER-P INTERVAL BUFFER-FILE-GROUP-SYMBOL)
174	(COMPUTE-BUFFER-PACKAGE INTERVAL))
175	(MULTIPLE-VALUE (SYMBOL END)
176	(READ-FROM-STRING LINE NIL (SETQ I (1+ I))))
177	(SETQ END (MIN (ARRAY-ACTIVE-LENGTH LINE) END)))
178	NIL)
179	(SYMBOLP SYMBOL)
180	(MVRETURN SYMBOL I END))))))
181
182	;;; This blinks functions that you point to
183	(DEFVAR BLINKING-FUNCTION-MAXIMUM-MOUSE-SPEED 0.5s0)
184	(DEFUN BLINK-FUNCTION (BLINKER WINDOW CHAR X Y LINE INDEX &OPTIONAL NOT-DEFINED-OK
185	&AUX SYMBOL BEG END SHEET)
186	(COND ((> TV:MOUSE-SPEED BLINKING-FUNCTION-MAXIMUM-MOUSE-SPEED)
187	(TV:BLINKER-SET-VISIBILITY BLINKER NIL)) ;Moving too fast, forget it
188	(T
189	(MULTIPLE-VALUE (SYMBOL BEG END)
190	(ATOM-UNDER-MOUSE WINDOW CHAR X Y LINE INDEX))
191	(COND ((AND (NOT (NULL BEG))
192	(OR (FBOUNDP SYMBOL)
193	(STRING-IN-AARRAY-P SYMBOL ZMACS-COMPLETION-AARRAY)
194	(GET SYMBOL 'SOURCE-FILE-NAME)
195	NOT-DEFINED-OK))
196	(SETQ SHEET (WINDOW-SHEET WINDOW))
197	(TV:BLINKER-SET-SHEET BLINKER SHEET)
198	(SHEET-SET-BLINKER-CURSORPOS SHEET BLINKER
199	(- X (* (TV:SHEET-CHAR-WIDTH SHEET)
200	(- INDEX BEG)))
201	Y)
202	(TV:BLINKER-SET-SIZE BLINKER
203	(TV:SHEET-STRING-LENGTH SHEET LINE BEG END)
204	(FONT-CHAR-HEIGHT (AREF (TV:SHEET-FONT-MAP SHEET)
205	(LDB %%CH-FONT CHAR))))
206	(TV:BLINKER-SET-VISIBILITY BLINKER T))
207	(T
208	(TV:BLINKER-SET-VISIBILITY BLINKER NIL))))))
209
210	(DEFUN BLINK-ATOM (BLINKER WINDOW CHAR X Y LINE INDEX)
211	(BLINK-FUNCTION BLINKER WINDOW CHAR X Y LINE INDEX T))
212
213	;;; The commands themselves
214
215	;;; Single click on the left button.
216	(DEFCOM COM-MOUSE-MARK-REGION "Jump point and mark to where the mouse is.
217	Then as the mouse is moved with the button held down point follows the mouse." (KM)
218	(REDISPLAY WINDOW ':NONE)
219	(FUNCALL (WINDOW-SHEET WINDOW) ':SET-MOUSE-POSITION MOUSE-X MOUSE-Y)
220	(LET ((POINT (POINT))
221	(MARK (MARK))
222	(OLD-REGION-P (WINDOW-MARK-P WINDOW))
223	(BP (MOUSE-BP WINDOW)))
224	(MOVE-BP MARK BP)
225	(SETF (WINDOW-MARK-P WINDOW) T)
226	(DO ((LAST-X TV:MOUSE-X TV:MOUSE-X)
227	(LAST-Y TV:MOUSE-Y TV:MOUSE-Y))
228	(NIL)
229	(MOVE-BP POINT BP)
230	(MUST-REDISPLAY WINDOW DIS-BPS)
231	(REDISPLAY WINDOW ':POINT)
232	(OR (WAIT-FOR-MOUSE LAST-X LAST-Y) (RETURN NIL))
233	(SETQ BP (MOUSE-BP WINDOW)))
234	(AND (BP-= POINT MARK)
235	(SETF (WINDOW-MARK-P WINDOW) OLD-REGION-P)))
236	DIS-NONE)
237
238	(DEFCOM COM-MOUSE-MOVE-REGION "Select window, or adjust the region.
239	If there is a region, jump the mouse to point or mark (whichever
240	is closer), and move it with the mouse as long as the button is
241	held down. If there is no region, select the window without
242	affecting point (or mark)." (KM)
243	(LET ((SHEET (WINDOW-SHEET WINDOW))
244	PX PY MX MY BP BP1 XOFF YOFF)
245	(MULTIPLE-VALUE (MX MY)
246	(FIND-BP-IN-WINDOW-COORDS (MARK) WINDOW))
247	(MULTIPLE-VALUE (PX PY)
248	(FIND-BP-IN-WINDOW-COORDS (POINT) WINDOW))
249	(MULTIPLE-VALUE (XOFF YOFF)
250	(TV:SHEET-CALCULATE-OFFSETS SHEET TV:MOUSE-SHEET))
251	(SETQ BP (COND ((NOT (AND (WINDOW-MARK-P WINDOW) MX)) (POINT))
252	((LET ((X (- TV:MOUSE-X XOFF))
253	(Y (- TV:MOUSE-Y YOFF)))
254	(< (+ (^ (ABS (- X PX)) 2) (^ (ABS (- Y PY)) 2))
255	(+ (^ (ABS (- X MX)) 2) (^ (ABS (- Y MY)) 2))))
256	(POINT))
257	(T
258	(SETQ PX MX PY MY)
259	(MARK))))
260	(FUNCALL SHEET ':SET-MOUSE-POSITION PX (+ PY (// (* 3 (TV:SHEET-LINE-HEIGHT SHEET)) 4)))
261	(DO ((LAST-X TV:MOUSE-X TV:MOUSE-X)
262	(LAST-Y TV:MOUSE-Y TV:MOUSE-Y))
263	(NIL)
264	(OR (WAIT-FOR-MOUSE LAST-X LAST-Y) (RETURN NIL))
265	(SETQ BP1 (MOUSE-BP WINDOW))
266	(MOVE-BP BP BP1)
267	(MUST-REDISPLAY WINDOW DIS-BPS)
268	(REDISPLAY WINDOW ':POINT)))
269	DIS-NONE)
270
271	(DEFCOM COM-MOUSE-MARK-THING "Mark the thing you are pointing at." (SM)
272	(FUNCALL (WINDOW-SHEET WINDOW) ':SET-MOUSE-POSITION MOUSE-X MOUSE-Y)
273	(DO ((POINT (POINT))
274	(MARK (MARK))
275	(LAST-X TV:MOUSE-X TV:MOUSE-X)
276	(LAST-Y TV:MOUSE-Y TV:MOUSE-Y)
277	(CHAR) (X) (Y)
278	(LINE) (CHAR-POS)
279	(OL) (OCP))
280	(NIL)
281	(MULTIPLE-VALUE (CHAR X Y LINE CHAR-POS)
282	(MOUSE-CHAR WINDOW)) ;Figure out where mouse it
283	(COND ((AND CHAR (OR (NEQ LINE OL) ( CHAR-POS OCP)))
284	(SETQ OL LINE OCP CHAR-POS)
285	(MOVE-BP POINT LINE CHAR-POS)
286	(FUNCALL (SELECTQ MAJOR-MODE
287	(LISP-MODE 'LISP-MARK-THING)
288	((TEXT-MODE FUNDAMENTAL-MODE BOLIO-MODE) 'TEXT-MARK-THING)
289	(OTHERWISE 'DEFAULT-MARK-THING))
290	POINT MARK CHAR LINE CHAR-POS)
291	(MUST-REDISPLAY WINDOW DIS-BPS)
292	(REDISPLAY WINDOW ':POINT)))
293	(OR (WAIT-FOR-MOUSE LAST-X LAST-Y) (RETURN NIL)))
294	DIS-NONE)
295
296	(DEFUN LISP-MARK-THING (POINT MARK CHAR LINE CHAR-POS)
297	(ATOM-WORD-SYNTAX-BIND
298	(SELECT (LIST-SYNTAX CHAR)
299	((LIST-OPEN LIST-SINGLE-QUOTE)
300	(MOVE-BP MARK (FORWARD-SEXP POINT 1 T)))
301	(LIST-CLOSE
302	(MOVE-BP POINT (FORWARD-CHAR POINT 1))
303	(MOVE-BP MARK (FORWARD-SEXP POINT -1 T)))
304	(LIST-DOUBLE-QUOTE
305	(COND ((LISP-BP-SYNTACTIC-CONTEXT POINT)
306	(MOVE-BP POINT (FORWARD-CHAR POINT 1 T))
307	(MOVE-BP MARK (FORWARD-SEXP POINT -1)))
308	(T
309	(MOVE-BP MARK (FORWARD-SEXP POINT 1 T)))))
310	(LIST-COMMENT
311	(MOVE-BP POINT (BACKWARD-OVER BLANKS POINT))
312	(MOVE-BP MARK LINE (LINE-LENGTH LINE)))
313	(OTHERWISE
314	(DEFAULT-MARK-THING POINT MARK CHAR LINE CHAR-POS)))))
315
316	(DEFUN TEXT-MARK-THING (POINT MARK CHAR LINE CHAR-POS)
317	(COND ((MEMQ CHAR '(#/. #/? #/!))
318	(MOVE-BP POINT (FORWARD-CHAR POINT 1))
319	(MOVE-BP MARK (FORWARD-SENTENCE POINT -1 T)))
320	((MEMQ CHAR '(#/: #/; #/,))
321	(MOVE-BP MARK (FORWARD-OVER BLANKS (FORWARD-CHAR
322	(SEARCH-SET POINT
323	(IF (= CHAR #/,)
324	'(#/. #/? #/! #/: #/; #/,)
325	'(#/, #/? #/! #/: #/;))
326	T T)
327	1 T)))
328	(MOVE-BP POINT (FORWARD-CHAR POINT 1)))
329	(T
330	(DEFAULT-MARK-THING POINT MARK CHAR LINE CHAR-POS))))
331
332	(DEFUN DEFAULT-MARK-THING (POINT MARK CHAR LINE CHAR-POS &AUX TEM)
333	(COND ((= CHAR #\FF)
334	(MOVE-BP MARK (FORWARD-PAGE POINT -1 T)))
335	((MEMQ CHAR '(#\SP #\TAB))
336	(COND ((STRING-REVERSE-SEARCH-NOT-SET BLANKS LINE CHAR-POS)
337	(MOVE-BP MARK (FORWARD-WORD POINT 1 T)))
338	(T
339	(MOVE-BP POINT LINE 0)
340	(MOVE-BP MARK LINE (LINE-LENGTH LINE)))))
341	((= CHAR #\CR)
342	(MOVE-BP MARK LINE 0))
343	((SETQ TEM (ASSOC CHAR '((#/( . #/)) (#/[ . #/]) (#/< . #/>) (#/{ . #/}))))
344	(MOVE-BP MARK (SEARCH POINT (CDR TEM) NIL T)))
345	((SETQ TEM (RASSOC CHAR '((#/( . #/)) (#/[ . #/]) (#/< . #/>) (#/{ . #/}))))
346	(MOVE-BP POINT (FORWARD-CHAR POINT 1 T))
347	(MOVE-BP MARK (SEARCH POINT (CAR TEM) T T)))
348	(T
349	(MOVE-BP MARK (FORWARD-WORD POINT 1 T))
350	(MOVE-BP POINT (FORWARD-WORD MARK -1 T))
351	;; Now try to attach the right whitespace to the word
352	(LET ((BP (FORWARD-OVER BLANKS MARK)))
353	(COND ((NOT (BP-= BP MARK))
354	(MOVE-BP MARK BP))
355	(T
356	(SETQ BP (BACKWARD-OVER BLANKS POINT))
357	(OR (ZEROP (BP-INDEX BP)) (MOVE-BP POINT BP))))))))
358
359	(DEFCOM COM-MOUSE-KILL-YANK "Kill region, unkill, or unkill pop.
360	If there is a region, save it; if it was saved last time, kill it;
361	else if the last command was an unkill, do unkill-pop, else unkill." ()
362	(COND ((EQ LAST-COMMAND-TYPE 'SAVE)
363	(DELETE-INTERVAL (POINT) (MARK))
364	DIS-TEXT)
365	((WINDOW-MARK-P WINDOW)
366	(SETQ CURRENT-COMMAND-TYPE 'SAVE)
367	(COM-SAVE-REGION))
368	((EQ LAST-COMMAND-TYPE 'YANK)
369	(COM-YANK-POP))
370	(T
371	(COM-YANK))))
372
373	;;; This is on mouse-left in the mini-buffer, exit if you are pointing in it, else
374	;;; do the standard thing
375	(DEFCOM COM-MOUSE-END-OF-MINI-BUFFER "Finish up the mini-buffer command" ()
376	(COND ((NEQ WINDOW MINI-BUFFER-WINDOW)
377	(COMMAND-EXECUTE (COMMAND-LOOKUP 2000 STANDARD-COMTAB) 2000))
378	(T
379	(KEY-EXECUTE #\CR))))
380
381	;;; This is on mouse-right in the completing-reader, give a menu of the possibilities
382	(DEFCOM COM-MOUSE-LIST-COMPLETIONS "Give a menu of possible completions" ()
383	(MULTIPLE-VALUE-BIND (NIL POSS)
384	(COMPLETE-STRING (BP-LINE (POINT)) COMPLETING-ALIST COMPLETING-DELIMS)
385	(OR POSS (BARF))
386	(LET ((CHOICE (TV:MENU-CHOOSE POSS)))
387	(COND (CHOICE
388	(*THROW 'RETURN-FROM-COMMAND-LOOP CHOICE))
389	(T
390	DIS-NONE)))))
391
392	(DEFCOM COM-MOUSE-INDENT-RIGIDLY "Track indentation with the mouse.
393	If there is a region, moves the whole region, else the current line. Continues until the
394	mouse is released." (KM)
395	(LET ((POINT (POINT))
396	(SHEET (WINDOW-SHEET WINDOW))
397	(START-LINE)
398	(END-LINE))
399	(COND ((WINDOW-MARK-P WINDOW) ;If there is a region, use it
400	(REGION (BP1 BP2)
401	(SETQ START-LINE (BP-LINE BP1)
402	END-LINE (BP-LINE BP2))
403	(OR (ZEROP (BP-INDEX BP2))
404	(SETQ END-LINE (LINE-NEXT END-LINE)))))
405	(T
406	(SETQ START-LINE (BP-LINE POINT)
407	END-LINE (LINE-NEXT START-LINE))))
408	(MULTIPLE-VALUE-BIND (X Y)
409	(FIND-BP-IN-WINDOW-COORDS (FORWARD-OVER BLANKS (BEG-OF-LINE START-LINE)) WINDOW)
410	(FUNCALL SHEET ':SET-MOUSE-POSITION X Y))
411	(PROCESS-WAIT "MOUSE" #'(LAMBDA () (OR (ZEROP TV:MOUSE-LAST-BUTTONS) MOUSE-P)))
412	(DO ((LAST-X TV:MOUSE-X TV:MOUSE-X)
413	(LAST-Y TV:MOUSE-Y TV:MOUSE-Y)
414	(LM (TV:SHEET-INSIDE-LEFT SHEET))
415	(BP (COPY-BP POINT))
416	(DELTA))
417	(NIL)
418	(SETQ DELTA (LINE-INDENTATION START-LINE SHEET))
419	(MOVE-BP BP START-LINE 0)
420	(INDENT-LINE BP (MAX 0 (- TV:MOUSE-X LM)) SHEET)
421	(SETQ DELTA (- (LINE-INDENTATION START-LINE SHEET) DELTA))
422	(OR (= DELTA 0)
423	(DO ((LINE START-LINE (LINE-NEXT LINE)))
424	((EQ LINE END-LINE))
425	(AND (NEQ LINE START-LINE)
426	(INDENT-LINE (MOVE-BP BP LINE 0)
427	(MAX 0 (+ DELTA (LINE-INDENTATION LINE SHEET))) SHEET))))
428	(MUST-REDISPLAY WINDOW DIS-TEXT)
429	(REDISPLAY WINDOW ':POINT)
430	(OR (WAIT-FOR-MOUSE LAST-X LAST-Y 5) (RETURN NIL))))
431	DIS-TEXT)
432
433	;;; * This should figure out some other kind of mouse-blinker *
434	(DEFCOM COM-MOUSE-INDENT-UNDER "Indent the current line as selected by the mouse." (KM)
435	(LET ((CH (FUNCALL STANDARD-INPUT ':MOUSE-OR-KBD-TYI)))
436	(COND ((= CH #\MOUSE-1-1)
437	(INDENT-LINE (POINT) (BP-INDENTATION (MOUSE-BP WINDOW)))
438	DIS-TEXT)
439	(T
440	(FUNCALL STANDARD-INPUT ':UNTYI CH)
441	(COM-INDENT-UNDER)))))

Note: See TracBrowser for help on using the browser.

Download in other formats:

Original Format