LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760032472. :SYSTEM-TYPE :LOGICAL :VERSION 1. :TYPE "LISP" :NAME "MOUSE" :DIRECTORY ("REL3-SOURCE" "ZMACS") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-SOURCE\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :VERSION-LIMIT 0. :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2758739411. :AUTHOR "REL3" :LENGTH-IN-BYTES 30210. :LENGTH-IN-BLOCKS 30. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 ;;; Mouse commands for ZWEI -*- Mode:Common-Lisp; Package:ZWEI; Base:8 -*-;;;                           RESTRICTED RIGHTS LEGEND;;;Use, duplication, or disclosure by the Government is subject to;;;restrictions as set forth in subdivision (b)(3)(ii) of the Rights in;;;Technical Data and Computer Software clause at 52.227-7013.;;;;;;                     TEXAS INSTRUMENTS INCORPORATED.;;;                              P.O. BOX 2909;;;                           AUSTIN, TEXAS 78769;;;                                 MS 2151;;;;;; Copyright (C) 1985, 1987 Texas Instruments Incorporated. All rights reserved.;;; Copyright (C) 1980, Massachusetts Institute of Technology;;; Note: some screen system primitives live in SCREEN;;; Proposed mouse command table for ZWEI windows:;;;  [1] Mark some characters.;;;  [11] No region -> Select window, Region -> You are moving it.;;;  [2] Mark some things.;;;  [22] Kill, Yank, Yank-pop;;;  [3] Put ZWEI menu here.;;;  [33] Call system menu;;; Called by the editor to initialize the mouse(DEFUN INITIALIZE-MOUSE (&AUX (INHIBIT-SCHEDULING-FLAG T))  (AND (BOUNDP '*MOUSE-CHAR-BLINKER*)       (W:OPEN-BLINKER *MOUSE-CHAR-BLINKER*))  (SETQ *MOUSE-P* NIL*MOUSE-CHAR-BLINKER* (W:MAKE-BLINKER W:MOUSE-SHEET 'W:CHARACTER-BLINKER      :VISIBILITY NIL      :HALF-PERIOD 4      :FONT (W:SCREEN-DEFAULT-FONT W:DEFAULT-SCREEN)      :CHAR #\?)*MOUSE-BOX-BLINKER* (W:MAKE-BLINKER W:MOUSE-SHEET 'W:HOLLOW-RECTANGULAR-BLINKER     :VISIBILITY NIL)*MOUSE-BLINKER* *MOUSE-BOX-BLINKER**MOUSE-LINE-BOX-BLINKER* (W:MAKE-BLINKER W:MOUSE-SHEET 'W:HOLLOW-RECTANGULAR-BLINKER  :VISIBILITY NIL)*GLOBAL-MOUSE-CHAR-BLINKER* (W:MAKE-BLINKER W:MOUSE-SHEET 'W:HOLLOW-RECTANGULAR-BLINKER     :VISIBILITY NIL     :HALF-PERIOD 4)*GLOBAL-MOUSE-CHAR-BLINKER-HANDLER* NIL*GLOBAL-MOUSE-CHAR-BLINKER-DOCUMENTATION-STRING* NIL)) ;;;Wait for the mouse to do something, return non-nil if released buttons or left window;;;LAST-X, LAST-Y are relative to the inside of the window (like *MOUSE-X*, *MOUSE-Y*).(DEFUN WAIT-FOR-MOUSE (LAST-X LAST-Y &OPTIONAL MAX-SPEED)  "Wait for the mouse to move from LAST-X, LAST-Y, or for all buttons to be released.If MAX-SPEED is supplied, we do not return until mouse slows to that speed.Returns NIL if all buttons released or the mouse has left the window.LAST-X and LAST-Y are relative to inside the window margins."  (LET ((SHEET (WINDOW-SHEET *WINDOW*)))    (MULTIPLE-VALUE-BIND (XOFF YOFF)(W:SHEET-CALCULATE-OFFSETS SHEET W:MOUSE-SHEET)      (PROCESS-WAIT "Mouse"    #'(LAMBDA (LX LY MS)(OR (AND (OR (NOT (= SYSTEM:MOUSE-X LX))     (NOT (= SYSTEM:MOUSE-Y LY))) (OR (NULL MS)     (<= W:MOUSE-SPEED MS)))    (ZEROP (W:MOUSE-BUTTONS T))    (NOT *MOUSE-P*)))    (+ LAST-X (W:SHEET-INSIDE-LEFT SHEET) XOFF)    (+ LAST-Y (W:SHEET-INSIDE-TOP SHEET) YOFF)    MAX-SPEED)))  (AND (NOT (ZEROP (W:MOUSE-BUTTONS T)))       *MOUSE-P*)) (DEFUN MOUSE-POSITION (&OPTIONAL (WINDOW *WINDOW*))  "Return the X and Y position of the mouse in window-defstruct WINDOW.Returns NIL if the mouse is not in that window.The values are relative to the margins of the window."  (LET ((SHEET (WINDOW-SHEET WINDOW)))    (MULTIPLE-VALUE-BIND (XOFF YOFF)(W:SHEET-CALCULATE-OFFSETS SHEET W:MOUSE-SHEET)      (VALUES (- SYSTEM:MOUSE-X XOFF (W:SHEET-INSIDE-LEFT SHEET))      (- SYSTEM:MOUSE-Y YOFF (W:SHEET-INSIDE-TOP SHEET)))))) ;;; Call MOUSE-CHAR so we can be sure that the BP points the thing that's blinking;;; If X and Y are supplied, they are the coordinates to use, otherwise;;; we use the coordinates of where the mouse is now.(DEFUN MOUSE-BP (WINDOW &OPTIONAL X Y &AUX CHAR LINE CHAR-POS)  "Returns a BP to the character the mouse is pointing at, in window-defstruct WINDOW.Returns NIL if the mouse is not in that window or not pointing at text.X and Y, if non-NIL, are used instead of the mouse position.They should be relative to the window margins."  (MULTIPLE-VALUE-SETQ (CHAR X Y LINE CHAR-POS)    (MOUSE-CHAR WINDOW T X Y))  (COND ((NULL CHAR)   ;Couldn't anything, use end of buffer for want of anything better (COPY-BP (INTERVAL-LAST-BP (WINDOW-INTERVAL WINDOW))))(T (CREATE-BP LINE CHAR-POS)))) ;;; The mouse must be in the selected window's area of the screen;;; Returns the character at which the mouse points, and the X and Y positions;;; of that character relative to its sheet.  If the mouse is not at a character,;;; returns NIL.(DEFUN MOUSE-CHAR (WINDOW &OPTIONAL FIXUP-P X Y)  "Return information on where the mouse points, in the window-defstruct WINDOW.Uses X and Y if specified, or else the mouse position.  X, Y are relative to the margins!All values are NIL if the mouse is not in the window or not pointing at text.Otherwise, the values are CHAR, X, Y, LINE, INDEX, WIDTH. CHAR is the character object for the character pointed at. X is the X position within the window margins of the left edge of the character. Y is the Y position within the window margins of the top edge of the character. LINE is the line the character is in.  INDEX is the position in that line. WIDTH is the width in pixels of the character."  (DECLARE (VALUES CHAR X Y LINE INDEX WIDTH))  (PROG (SHEET LINE PLINE CHAR-POS LH REAL-PLINE START END)(SETQ SHEET (WINDOW-SHEET WINDOW))(COND ((NULL Y)       (MULTIPLE-VALUE-SETQ (X Y) (MOUSE-POSITION WINDOW))))(SETQ LH (W:SHEET-LINE-HEIGHT SHEET)      PLINE (SETQ REAL-PLINE (FLOOR Y LH)));; If mouse moves to out of range, protect against error and return(AND (OR (MINUSP PLINE) (>= PLINE (WINDOW-N-PLINES WINDOW)))     (IF FIXUP-P (SETQ PLINE (MAX 0 (MIN PLINE (1- (WINDOW-N-PLINES WINDOW))))) (RETURN NIL)))(DO ()    ((SETQ LINE (PLINE-LINE WINDOW PLINE)))  (AND (ZEROP PLINE) (RETURN NIL))  (SETQ PLINE (1- PLINE)))(OR LINE (RETURN NIL))(SETQ START (PLINE-FROM-INDEX WINDOW PLINE));; I can't see why this could happen, but it did, so avoid blowing out.(OR START (RETURN NIL))(COND ((WINDOW-INTERVAL WINDOW)    ;for robustness...       (LET ((BP (INTERVAL-FIRST-BP (WINDOW-INTERVAL WINDOW)))) (AND (EQ LINE (BP-LINE BP))      (SETQ START (MAX START (BP-INDEX BP)))))       (LET ((BP (INTERVAL-LAST-BP (WINDOW-INTERVAL WINDOW)))) (AND (EQ LINE (BP-LINE BP))      (SETQ END (BP-INDEX BP))))       (MULTIPLE-VALUE-SETQ (X Y CHAR-POS);Find character to right of mouse (W:SHEET-COMPUTE-MOTION SHEET 0 (* PLINE LH) LINE  START END NIL (MAX 0 X) (* REAL-PLINE LH)))       (COND ((NULL CHAR-POS);Mouse is off end of line, pointing at the CR      (RETURN (VALUES #\NEWLINE X Y LINE (OR END (LINE-LENGTH LINE)))))     (T      ;; X, Y, CHAR-POS are for char to right of mouse      ;; Find the character which is just over the mouse      (SETQ CHAR-POS (MAX 0 (1- CHAR-POS)))      (LET ((CHAR (IF (= CHAR-POS (LINE-LENGTH LINE))      #\NEWLINE      (AREF LINE CHAR-POS)))    (FONT-MAP (W:SHEET-FONT-MAP SHEET)))(LET ((CH (MAKE-CHAR CHAR))      (FONT (CHAR-FONT CHAR))      CHAR-X      CHAR-WIDTH)  (SETQ FONT (AREF FONT-MAP (IF (>= FONT (ARRAY-ACTIVE-LENGTH FONT-MAP))0FONT)))  (IF (CHAR= CH #\TAB)      (SETQ CHAR-X (W:SHEET-COMPUTE-MOTION SHEET 0 0 LINE START CHAR-POS)    CHAR-WIDTH (- X CHAR-X))      (SETQ CHAR-WIDTH (W:SHEET-CHARACTER-WIDTH SHEET CH FONT)    CHAR-X (MAX 0 (- X CHAR-WIDTH))))  (RETURN (VALUES CHAR CHAR-X  (+ Y (- (W:SHEET-BASELINE SHEET) (W:FONT-BASELINE FONT)))  LINE CHAR-POS CHAR-WIDTH)))))))))) ;; Macro for suggestions added by rpm 11-26-86.(DEFUN READ-FUNCTION-NAME (PROMPT &OPTIONAL DEFAULT MUST-BE-DEFINED STRINGP HELP ;;gsl 3-14-85   &AUX EXPLICIT-PACKAGE-P PROMPT-WITHOUT-DEFAULT   (*MINI-BUFFER-DEFAULT-STRING* DEFAULT)   (READ-FUNCTION-NAME-MUST-BE-DEFINED     MUST-BE-DEFINED)   (READ-FUNCTION-NAME-OLD-GLOBAL-MOUSE-CHAR-BLINKER-HANDLER     *GLOBAL-MOUSE-CHAR-BLINKER-HANDLER*)   (READ-FUNCTION-NAME-OLD-GLOBAL-MOUSE-CHAR-BLINKER-DOCUMENTATION-STRING     *GLOBAL-MOUSE-CHAR-BLINKER-DOCUMENTATION-STRING*)   (READ-FUNCTION-NAME-OLD-MOUSE-FONT-CHAR *MOUSE-FONT-CHAR*)   (READ-FUNCTION-NAME-OLD-MOUSE-X-OFFSET *MOUSE-X-OFFSET*)   (READ-FUNCTION-NAME-OLD-MOUSE-Y-OFFSET *MOUSE-Y-OFFSET*))  "Read a function name using mini buffer or mouse.PROMPT is a string that goes in the mode line.DEFAULT is a function spec to return if the user types just Return.MUST-BE-DEFINED can be T (allow only defined functions), NIL (allow anything) or AARRAY-OK (allow anything either defined as a function or known as a section by the editor).STRINGP can be T, NIL, ALWAYS-READ or MULTIPLE-OK. T means if user types text, just return a string; don't try to intern it. ALWAYS-READ means intern the user's string afresh now;  don't use the symbol or list recorded in the completion aarray. MULTIPLE-OK means it is ok to return more than one possible function  the user could have meant, if they differ only in their package.The first value is a list of function specs (only one, unless STRINGP is MULTIPLE-OK). If STRINGP is T, this is NIL.The second value is the string the user typed, sans package prefix.The third value is T if the user typed a package prefix."  (DECLARE (VALUES COMPLETIONS STRING EXPLICIT-PACKAGE-P))  (DECLARE (SPECIAL READ-FUNCTION-NAME-MUST-BE-DEFINED    READ-FUNCTION-NAME-OLD-GLOBAL-MOUSE-CHAR-BLINKER-HANDLER    READ-FUNCTION-NAME-OLD-GLOBAL-MOUSE-CHAR-BLINKER-DOCUMENTATION-STRING    READ-FUNCTION-NAME-OLD-MOUSE-FONT-CHAR    READ-FUNCTION-NAME-OLD-MOUSE-X-OFFSET    READ-FUNCTION-NAME-OLD-MOUSE-Y-OFFSET))  (SYS:WITH-SUGGESTIONS-MENUS-FOR ZWEI:READ-FUNCTION-NAME    (WHEN (EQ MUST-BE-DEFINED T)      (SETQ STRINGP 'ALWAYS-READ))    (SETQ PROMPT-WITHOUT-DEFAULT PROMPT  PROMPT (FORMAT NIL "~A~:[:~; (Default: ~S)~]" PROMPT DEFAULT DEFAULT))    (LET ((NAME (LET ((*POST-COMMAND-HOOK* (APPEND *POST-COMMAND-HOOK* '(READ-FUNCTION-NAME-COMMAND-HOOK)))      (*MINI-BUFFER-VALUE-HISTORY* *DEFINITION-NAME-HISTORY*))  (LET ((*BATCH-UNDO-SAVE* T))    (DELETE-INTERVAL (WINDOW-INTERVAL *MINI-BUFFER-WINDOW*)))  (UNWIND-PROTECT      (PROGN(READ-FUNCTION-NAME-COMMAND-HOOK NIL)(COMPLETING-READ-FROM-MINI-BUFFER PROMPT *ZMACS-COMPLETION-AARRAY*  (OR (NEQ STRINGP 'ALWAYS-READ)      'ALWAYS-STRING)  NIL HELP)) ;;gsl 3-14-85    (READ-FUNCTION-NAME-COMMAND-HOOK T))))  SYM  ERROR-P)      (COND ((EQUAL NAME "")     (UNLESS DEFAULT (BARF))     (SETQ SYM DEFAULT   NAME (IF (SYMBOLP NAME)    (STRING NAME)    (WITH-OUTPUT-TO-STRING (*STANDARD-OUTPUT*) (PRINC DEFAULT)))))    ((CONSP NAME)     (SETQ SYM (CDR NAME)   NAME (CAR NAME))     (WHEN (AND (CONSP SYM)(NEQ STRINGP 'MULTIPLE-OK))       (SETQ SYM (CAR SYM))))    ((EQ STRINGP T);If returning a string, don't intern it     (SETQ SYM NAME))    (T     ;; If the string that was specified started with a package prefix,     ;; return a flag saying so.     ;; SYMBOL-FROM-STRING will flush the prefix from NAME.     (LET ((NON-LETTER-INDEX (STRING-SEARCH-NOT-SET " ABCDEFGHIJKLMNOPQRSTUVWXYZ-" NAME)))       (COND ((AND NON-LETTER-INDEX   (CHAR= (AREF NAME NON-LETTER-INDEX) #\:))      (SETQ EXPLICIT-PACKAGE-P T))))     (MULTIPLE-VALUE-SETQ (SYM NAME ERROR-P)       (SYMBOL-FROM-STRING NAME NIL T))     (COND ((AND (CONSP SYM) (EQ STRINGP 'MULTIPLE-OK))    (SETQ SYM (CONS SYM NIL))))     (COND (ERROR-P    (BARF "Read error")))))      (COND ((AND (EQ MUST-BE-DEFINED T)  (NOT (OR (FDEFINEDP SYM)   (AND (SYMBOLP SYM)(SI:MEMQ-ALTERNATED 'ARGLIST (SYMBOL-PLIST SYM))))))     (COND ((NOT (DOLIST (SPEC (PACKAGE-LOOKALIKE-SYMBOLS SYM))   (COND ((FQUERY '(:SELECT T)  ;; Always print prefix  ;; Don't leave PACKAGE in keyword during query.  (LET ((*PACKAGE* PKG-KEYWORD-PACKAGE))    (FORMAT NIL "Do you mean ~S? " SPEC)))  (RETURN (SETQ SYM SPEC))))))    (BARF "~S is not defined" SYM)))))      (PUSH-ON-HISTORY SYM *DEFINITION-NAME-HISTORY*)      (PROMPT-LINE "~A ~S" PROMPT-WITHOUT-DEFAULT   (IF (AND (EQ STRINGP 'MULTIPLE-OK)    (NOT (ATOM SYM)))       (FIRST SYM)       SYM))      (VALUES SYM NAME EXPLICIT-PACKAGE-P)))) (DEFPROP READ-FUNCTION-NAME-COMMAND-HOOK 10000000 COMMAND-HOOK-PRIORITY) ;; CHAR-OR-T is T meaning turn off special blinker hack;;; otherwise turn it on iff mini buffer is empty.(DEFUN READ-FUNCTION-NAME-COMMAND-HOOK (CHAR-OR-T)  (DECLARE (SPECIAL READ-FUNCTION-NAME-MUST-BE-DEFINED    READ-FUNCTION-NAME-OLD-GLOBAL-MOUSE-CHAR-BLINKER-HANDLER    READ-FUNCTION-NAME-OLD-GLOBAL-MOUSE-CHAR-BLINKER-DOCUMENTATION-STRING    READ-FUNCTION-NAME-OLD-MOUSE-FONT-CHAR    READ-FUNCTION-NAME-OLD-MOUSE-X-OFFSET    READ-FUNCTION-NAME-OLD-MOUSE-Y-OFFSET))  (COND ((AND (NEQ CHAR-OR-T T)      (BP-= (INTERVAL-FIRST-BP (WINDOW-INTERVAL *MINI-BUFFER-WINDOW*))    (INTERVAL-LAST-BP (WINDOW-INTERVAL *MINI-BUFFER-WINDOW*)))) (WITHOUT-INTERRUPTS                                                                ;;gsl   (SETQ *GLOBAL-MOUSE-CHAR-BLINKER-HANDLER* (IF READ-FUNCTION-NAME-MUST-BE-DEFINED #'BLINK-FUNCTION #'BLINK-ATOM) *GLOBAL-MOUSE-CHAR-BLINKER-DOCUMENTATION-STRING* "Click left on highlighted name to select it." *MOUSE-HOOK* #'(LAMBDA (WINDOW CHAR IGNORE IGNORE &AUX TEM)  (AND (CHAR= CHAR #\MOUSE-L)       (MULTIPLE-VALUE-BIND (FCTN LINE START END)   (ATOM-UNDER-MOUSE WINDOW) (WHEN (AND LINE    (OR (FBOUNDP (SETQ TEM FCTN))(GET TEM :SOURCE-FILE-NAME)(GET TEM 'ZMACS-BUFFERS)(STRING-IN-AARRAY-P TEM *ZMACS-COMPLETION-AARRAY*)(AND (NOT READ-FUNCTION-NAME-MUST-BE-DEFINED) TEM)))   (LET ((INT (WINDOW-INTERVAL *MINI-BUFFER-WINDOW*)))     (DELETE-INTERVAL INT)     (INSERT (INTERVAL-FIRST-BP INT) LINE START END))   (THROW 'RETURN-FROM-COMMAND-LOOP  (SUBSEQ LINE START END)))))) *MOUSE-FONT-CHAR* 0 *MOUSE-X-OFFSET* 4 *MOUSE-Y-OFFSET* 0 *SAVED-MOUSE-STATE* (LIST *GLOBAL-MOUSE-CHAR-BLINKER-HANDLER*              ;;gsl   *GLOBAL-MOUSE-CHAR-BLINKER-DOCUMENTATION-STRING* ;;gsl   *MOUSE-HOOK* *MOUSE-FONT-CHAR*                   ;;gsl   *MOUSE-X-OFFSET* *MOUSE-Y-OFFSET*)))             ;;gsl (W:MOUSE-SET-BLINKER-DEFINITION :CHARACTER *MOUSE-X-OFFSET* *MOUSE-Y-OFFSET*  :ON :SET-CHARACTER *MOUSE-FONT-CHAR*))(T (WITHOUT-INTERRUPTS                                                                ;;gsl   (SEND *GLOBAL-MOUSE-CHAR-BLINKER* :SET-VISIBILITY NIL)   (SETQ *SAVED-MOUSE-STATE*                                                             ;;gsl & next 6 lines (LIST READ-FUNCTION-NAME-OLD-GLOBAL-MOUSE-CHAR-BLINKER-HANDLER       READ-FUNCTION-NAME-OLD-GLOBAL-MOUSE-CHAR-BLINKER-DOCUMENTATION-STRING       NIL       READ-FUNCTION-NAME-OLD-MOUSE-FONT-CHAR       READ-FUNCTION-NAME-OLD-MOUSE-X-OFFSET       READ-FUNCTION-NAME-OLD-MOUSE-Y-OFFSET) *GLOBAL-MOUSE-CHAR-BLINKER-HANDLER* READ-FUNCTION-NAME-OLD-GLOBAL-MOUSE-CHAR-BLINKER-HANDLER *GLOBAL-MOUSE-CHAR-BLINKER-DOCUMENTATION-STRING* READ-FUNCTION-NAME-OLD-GLOBAL-MOUSE-CHAR-BLINKER-DOCUMENTATION-STRING *MOUSE-HOOK* NIL *MOUSE-FONT-CHAR* READ-FUNCTION-NAME-OLD-MOUSE-FONT-CHAR *MOUSE-X-OFFSET* READ-FUNCTION-NAME-OLD-MOUSE-X-OFFSET *MOUSE-Y-OFFSET* READ-FUNCTION-NAME-OLD-MOUSE-Y-OFFSET)) (W:MOUSE-SET-BLINKER-DEFINITION :CHARACTER *MOUSE-X-OFFSET* *MOUSE-Y-OFFSET*  :ON :SET-CHARACTER *MOUSE-FONT-CHAR*)))  (SYSTEM:MOUSE-WAKEUP)) (DEFUN ATOM-UNDER-MOUSE (WINDOW &OPTIONAL CHAR X Y LINE INDEX &AUX SYMBOL END)  "Returns the symbol which the mouse is pointing at in WINDOW.  NIL if not pointing at one.Normally, CHAR, X, Y, LINE, and INDEX are set from the mouse position.If you pass them, then the mouse position is irrelevant.Actually, X and Y are irrelevant in any case.All that matters is LINE and INDEX, and CHAR which would be the character there.The values are the symbol pointed at, the line it is in,and the start and end indices of the symbol as a substring in that line.All values are NIL if the position is not on a valid symbol."  (DECLARE (VALUES SYMBOL LINE START END))  (OR CHAR (MULTIPLE-VALUE-SETQ (CHAR X Y LINE INDEX)     (MOUSE-CHAR WINDOW)))  (AND CHAR       (NOT (CHAR= CHAR #\NEWLINE))       (DO ((I INDEX (1- I)))   ((OR (ZEROP I)(NOT (= (ATOM-WORD-SYNTAX (AREF LINE I)) WORD-ALPHABETIC)))    (AND (NOT (= I INDEX)) (CATCH-ERROR   (LET ((*PACKAGE* *PACKAGE*) (*PRINT-BASE* *PRINT-BASE*) (*READ-BASE* *READ-BASE*) (INTERVAL (WINDOW-INTERVAL WINDOW)))     (COMPUTE-BUFFER-PACKAGE INTERVAL)     (MULTIPLE-VALUE-SETQ (SYMBOL END)       (READ-FROM-STRING LINE NIL NIL :START (IF (AND (ZEROP I) (= (ATOM-WORD-SYNTAX (AREF LINE I)) WORD-ALPHABETIC))    I    (SETQ I (1+ I))) :PRESERVE-WHITESPACE T))     (SETQ END (MIN (ARRAY-ACTIVE-LENGTH LINE) END)))   NIL) (SYMBOLP SYMBOL) (VALUES SYMBOL LINE I END)))))) ;;; This blinks functions that you point to;;; This maximum speed thing is a crock, since the mouse can be moving fast;;; and at the same time have come to rest, such that another :MOUSE-MOVES;;; message is not going to be sent.  I guess I'll just set the number very high.;;; This was probably put in to make mouse tracking smoother, and hence is no;;; longer needed.(DEFUN BLINK-FUNCTION (BLINKER WINDOW CHAR X Y LINE INDEX &OPTIONAL NOT-DEFINED-OK &AUX SYMBOL BEG END SHEET)  (COND ((> W:MOUSE-SPEED *BLINKING-FUNCTION-MAXIMUM-MOUSE-SPEED*) (W:BLINKER-SET-VISIBILITY BLINKER NIL));Moving too fast, forget it(T (MULTIPLE-VALUE-SETQ (SYMBOL NIL BEG END)   (ATOM-UNDER-MOUSE WINDOW CHAR X Y LINE INDEX)) (COND ((AND (NOT (NULL BEG))     (OR NOT-DEFINED-OK (FBOUNDP SYMBOL) (GET SYMBOL 'ZMACS-BUFFERS) (GET SYMBOL :SOURCE-FILE-NAME) (STRING-IN-AARRAY-P SYMBOL *ZMACS-COMPLETION-AARRAY*)))(SETQ SHEET (WINDOW-SHEET WINDOW))(W:BLINKER-SET-SHEET BLINKER SHEET)(SHEET-SET-BLINKER-CURSORPOS SHEET     BLINKER     (- X (W:SHEET-STRING-LENGTH SHEET LINE BEG INDEX))     Y)(W:BLINKER-SET-SIZE BLINKER     (W:SHEET-STRING-LENGTH SHEET LINE BEG END)     (W:FONT-CHAR-HEIGHT (AREF (W:SHEET-FONT-MAP SHEET) (CHAR-FONT CHAR))))(W:BLINKER-SET-VISIBILITY BLINKER T))       (T(W:BLINKER-SET-VISIBILITY BLINKER NIL)))))) (DEFUN BLINK-ATOM (BLINKER WINDOW CHAR X Y LINE INDEX)  (BLINK-FUNCTION BLINKER WINDOW CHAR X Y LINE INDEX T)) ;;; rb 9/19/85;;; Auxiliary function for BLINK-LINE following(DEFUN LINE-PLINE (WINDOW LINE)  "Find the pline that starts real LINE and the number of plines it occupies."  ;; The algorithm is simple linear search through the pline array.  (DECLARE (VALUES PLINE PLINES-PER-LINE))  (LET ((NLINES (WINDOW-N-PLINES WINDOW))(PLINE NIL)(PLINES-PER-LINE 0))    (DOTIMES (I NLINES)      (COND ((EQ LINE (PLINE-LINE WINDOW I))     (SETQ PLINE I)     (RETURN (DOTIMES (J (- NLINES I))       (IF (EQ LINE (PLINE-LINE WINDOW (+ J I)))   (INCF PLINES-PER-LINE)   (RETURN)))))))    (VALUES PLINE PLINES-PER-LINE))) ;;; rb 9/19/85(DEFUN BLINK-LINE (BLINKER WINDOW CHAR X Y LINE INDEX PREDICATE   &AUX SHEET PLINE PLINES-PER-LINE)  "Turn on BLINKER in WINDOW to box a complete line that function PREDICATE is true for."  ;; This routine boxes real lines, not screen lines.  ;; The box is the entire width of the window.  (DECLARE (VALUES IGNORE))  X  INDEX  (COND ((NULL (FUNCALL PREDICATE LINE));Don't box these kinds of lines (W:BLINKER-SET-VISIBILITY BLINKER NIL))(CHAR (SETQ SHEET (WINDOW-SHEET WINDOW)) (W:BLINKER-SET-SHEET BLINKER SHEET) (MULTIPLE-VALUE-SETQ (PLINE PLINES-PER-LINE)   (LINE-PLINE WINDOW LINE)) (SETQ Y (* PLINE (W:SHEET-LINE-HEIGHT SHEET))) (SHEET-SET-BLINKER-CURSORPOS SHEET BLINKER 0 Y) (W:BLINKER-SET-SIZE BLINKER      (W:SHEET-WIDTH SHEET)      (* (W:SHEET-LINE-HEIGHT SHEET) PLINES-PER-LINE)) (W:BLINKER-SET-VISIBILITY BLINKER T))(:ELSE;not in a proper window (W:BLINKER-SET-VISIBILITY BLINKER NIL)))) ;;; The commands themselves;;; Single click on the left button.(DEFPROP COM-MOUSE-MARK-REGION "Move point" :MOUSE-SHORT-DOCUMENTATION) (DEFCOM COM-MOUSE-MARK-REGION "Jump point and mark to where the mouse is.Then as the mouse is moved with the button held down point follows the mouse." (KM)  ;; Changed to turn off region marking flag if point and mark are the same. - rpm 9-8-86.   (REDISPLAY *WINDOW* :NONE)  (LET ((POINT (POINT))(MARK (MARK))(BP (MOUSE-BP *WINDOW* *MOUSE-X* *MOUSE-Y*)))    (MOVE-BP MARK BP)    (SETF (WINDOW-MARK-P *WINDOW*) T)    (DO ((LAST-X *MOUSE-X*) (LAST-Y *MOUSE-Y*))(NIL)      (MOVE-TO-BP BP) ;;gsl 3-10-85      (MUST-REDISPLAY *WINDOW* DIS-BPS)      (REDISPLAY *WINDOW* :POINT)      (OR (WAIT-FOR-MOUSE LAST-X LAST-Y)  (RETURN NIL))      (MULTIPLE-VALUE-SETQ (LAST-X LAST-Y) (MOUSE-POSITION))      (SETQ BP (MOUSE-BP *WINDOW* LAST-X LAST-Y)))    (AND (BP-= POINT MARK) (SETF (WINDOW-MARK-P *WINDOW*) NIL)))  DIS-NONE) (DEFPROP COM-MOUSE-MOVE-REGION "Move to point" :MOUSE-SHORT-DOCUMENTATION) (DEFCOM COM-MOUSE-MOVE-REGION "Select window, or adjust the region.If there is a region, jump the mouse to point or mark (whicheveris closer), and move it with the mouse as long as the button isheld down.  If there is no region, select the window withoutaffecting point (or mark)." (KM)  (LET ((SHEET (WINDOW-SHEET *WINDOW*))PX PY MX MY BP BP1 LAST-X LAST-Y)    (MULTIPLE-VALUE-SETQ (MX MY)      (FIND-BP-IN-WINDOW-COORDS (MARK) *WINDOW*))    (MULTIPLE-VALUE-SETQ (PX PY)      (FIND-BP-IN-WINDOW-COORDS (POINT) *WINDOW*))    (MULTIPLE-VALUE-SETQ (LAST-X LAST-Y)      (MOUSE-POSITION))    (SETQ BP (COND ((NOT (AND (WINDOW-MARK-P *WINDOW*) MX))    (IF PX(POINT)(BARF)))   ((AND PX (< (+ (EXPT (- LAST-X PX) 2) (EXPT (- LAST-Y PY) 2))    (+ (EXPT (- LAST-X MX) 2) (EXPT (- LAST-Y MY) 2))))    (POINT))   (T    (SETQ PX MX  PY MY)    (MARK))))    (SEND SHEET :SET-MOUSE-CURSORPOS  (+ PX (FLOOR (W:SHEET-CHAR-WIDTH SHEET) 2))  (+ PY (FLOOR (* 3 (W:SHEET-LINE-HEIGHT SHEET)) 4)))    (DO ()(NIL)      (OR (WAIT-FOR-MOUSE LAST-X LAST-Y)  (RETURN NIL))      (MULTIPLE-VALUE-SETQ (LAST-X LAST-Y)(MOUSE-POSITION))      (SETQ BP1 (MOUSE-BP *WINDOW* LAST-X LAST-Y))      (MOVE-BP BP BP1)      (MUST-REDISPLAY *WINDOW* DIS-BPS)      (REDISPLAY *WINDOW* :POINT)))  DIS-NONE) (DEFPROP COM-MOUSE-MARK-THING "Mark thing" :MOUSE-SHORT-DOCUMENTATION) (DEFCOM COM-MOUSE-MARK-THING "Mark the thing you are pointing at." (SM)  (DO ((POINT (POINT))       (MARK (MARK))       (LAST-X *MOUSE-X*)       (LAST-Y *MOUSE-Y*)       (X)       (Y)       (CHAR)       (LINE)       (CHAR-POS)       (OL)       (OCP))      (NIL)    (MULTIPLE-VALUE-SETQ (CHAR X Y LINE CHAR-POS)      (MOUSE-CHAR *WINDOW* NIL LAST-X LAST-Y));Figure out where mouse is    (COND ((AND CHAR (OR (NEQ LINE OL) (NOT (= CHAR-POS OCP))))   (SETQ OL LINE OCP CHAR-POS)   (MOVE-BP POINT LINE CHAR-POS)   (FUNCALL (CASE (GET *MAJOR-MODE* 'EDITING-TYPE)  (:LISP 'LISP-MARK-THING)  (:TEXT 'TEXT-MARK-THING)  (OTHERWISE 'DEFAULT-MARK-THING))    POINT MARK CHAR LINE CHAR-POS)   (MUST-REDISPLAY *WINDOW* DIS-BPS)   (REDISPLAY *WINDOW* :POINT)))    (OR (WAIT-FOR-MOUSE LAST-X LAST-Y)(RETURN NIL))    (MULTIPLE-VALUE-SETQ (LAST-X LAST-Y)      (MOUSE-POSITION)))  DIS-NONE) (DEFUN LISP-MARK-THING (POINT MARK CHAR LINE CHAR-POS)  (ATOM-WORD-SYNTAX-BIND    (SELECT (LIST-SYNTAX CHAR)      ((LIST-OPEN LIST-SINGLE-QUOTE)       (MOVE-BP MARK (FORWARD-SEXP POINT 1 T)))      (LIST-CLOSE       (MOVE-BP POINT (FORWARD-CHAR POINT 1))       (MOVE-BP MARK (FORWARD-SEXP POINT -1 T 0 NIL NIL)))      (LIST-DOUBLE-QUOTE       (COND ((LISP-BP-SYNTACTIC-CONTEXT POINT)      (MOVE-BP POINT (FORWARD-CHAR POINT 1 T))      (MOVE-BP MARK (FORWARD-SEXP POINT -1)))     (T      (MOVE-BP MARK (FORWARD-SEXP POINT 1 T)))))      (LIST-COMMENT       (MOVE-BP POINT (BACKWARD-OVER *BLANKS* POINT))       (MOVE-BP MARK LINE (LINE-LENGTH LINE)))      (OTHERWISE       (DEFAULT-MARK-THING POINT MARK CHAR LINE CHAR-POS))))) (DEFUN TEXT-MARK-THING (POINT MARK CHAR LINE CHAR-POS)  (COND ((MEMBER CHAR '(#\. #\? #\!) :TEST #'EQ) (MOVE-BP POINT (FORWARD-CHAR POINT 1)) (MOVE-BP MARK (FORWARD-SENTENCE POINT -1 T)))((MEMBER CHAR '(#\: #\; #\,) :TEST #'EQ) (MOVE-BP MARK (FORWARD-OVER *BLANKS* (FORWARD-CHAR(SEARCH-SET POINT    (IF (CHAR= CHAR #\,)'(#\. #\? #\! #\: #\; #\,)'(#\, #\? #\! #\: #\;))    T T)1 T))) (MOVE-BP POINT (FORWARD-CHAR POINT 1)))(T (DEFAULT-MARK-THING POINT MARK CHAR LINE CHAR-POS)))) (DEFUN DEFAULT-MARK-THING (POINT MARK CHAR LINE CHAR-POS &AUX TEM)  (COND ((CHAR= CHAR #\PAGE) (MOVE-BP MARK (FORWARD-PAGE POINT -1 T)))((MEMBER CHAR '(#\SPACE #\TAB) :TEST #'EQ) (COND ((STRING-REVERSE-SEARCH-NOT-SET *BLANKS* LINE CHAR-POS)(MOVE-BP MARK (FORWARD-WORD POINT 1 T)))       (T(MOVE-BP POINT LINE 0)(MOVE-BP MARK LINE (LINE-LENGTH LINE)))))((CHAR= CHAR #\NEWLINE) (MOVE-BP MARK LINE 0))((SETQ TEM (ASSOC CHAR '((#\( . #\)) (#\[ . #\]) (#\< . #\>) (#\{ . #\})) :TEST 'CHAR-EQUAL)) (MOVE-BP MARK (SEARCH POINT (CDR TEM) NIL T)))((SETQ TEM (RASSOC CHAR '((#\( . #\)) (#\[ . #\]) (#\< . #\>) (#\{ . #\})) :TEST 'CHAR-EQUAL)) (MOVE-BP POINT (FORWARD-CHAR POINT 1 T)) (MOVE-BP MARK (SEARCH POINT (CAR TEM) T T)))(T (MOVE-BP MARK (FORWARD-WORD POINT 1 T)) (MOVE-BP POINT (FORWARD-WORD MARK -1 T)) ;; Now try to attach the right whitespace to the word (OR *KILL-INTERVAL-SMARTS*     (LET ((BP (FORWARD-OVER *BLANKS* MARK)))       (COND ((NOT (BP-= BP MARK))      (MOVE-BP MARK BP))     (T      (SETQ BP (BACKWARD-OVER *BLANKS* POINT))      (OR (ZEROP (BP-INDEX BP))  (MOVE-BP POINT BP))))))))) (DEFPROP COM-MOUSE-KILL-YANK "Save/Kill/Yank" :MOUSE-SHORT-DOCUMENTATION) (DEFCOM COM-MOUSE-KILL-YANK "Kill region, unkill, or unkill pop.If there is a region, save it; if it was saved last time, kill it;else if the last command was an unkill, do unkill-pop, else unkill." ()  (COND ((EQ *LAST-COMMAND-TYPE* 'SAVE) (DELETE-INTERVAL (POINT) (MARK)) DIS-TEXT)((WINDOW-MARK-P *WINDOW*) (SETQ *CURRENT-COMMAND-TYPE* 'SAVE) (COM-SAVE-REGION))((EQ *LAST-COMMAND-TYPE* 'YANK) (COM-YANK-POP))(T (COM-YANK))));;; Put mouse-doc on mouse-list-completions so we don't see "R: NIL".(DEFPROP COM-MOUSE-LIST-COMPLETIONS "List completions" :MOUSE-SHORT-DOCUMENTATION);;; This is on mouse-right in the completing-reader, give a menu of the possibilities(DEFCOM COM-MOUSE-LIST-COMPLETIONS "Give a menu of possible completions" ()  (MULTIPLE-VALUE-BIND (NIL POSS)      (COMPLETE-STRING (BP-LINE (POINT)) *COMPLETING-ALIST* *COMPLETING-DELIMS*)    (OR POSS (BARF))    (MULTIPLE-VALUE-BIND (CHOICE ITEM)(W:MENU-CHOOSE (SORT POSS #'STRING-LESSP :KEY #'CAR))      (IF CHOICE  (THROW 'RETURN-FROM-COMMAND-LOOP ITEM)  DIS-NONE))))       (DEFCOM COM-MOUSE-INDENT-RIGIDLY "Track indentation with the mouse.If there is a region, moves the whole region, else the current line.Continues until the mouse is released." (KM)  (LET ((POINT (POINT))(SHEET (WINDOW-SHEET *WINDOW*))(START-LINE)(END-LINE))    (COND ((WINDOW-MARK-P *WINDOW*);If there is a region, use it   (REGION (BP1 BP2)     (SETQ START-LINE (BP-LINE BP1)   END-LINE (BP-LINE BP2))     (OR (ZEROP (BP-INDEX BP2)) (SETQ END-LINE (LINE-NEXT END-LINE)))))  (T   (SETQ START-LINE (BP-LINE POINT) END-LINE (LINE-NEXT START-LINE))))    (MULTIPLE-VALUE-BIND (X Y)(FIND-BP-IN-WINDOW-COORDS (FORWARD-OVER *BLANKS* (BEG-OF-LINE START-LINE)) *WINDOW*)      (WHEN (NULL X)(REDISPLAY *WINDOW* :START START-LINE 0)(MULTIPLE-VALUE-SETQ (X Y)  (FIND-BP-IN-WINDOW-COORDS (FORWARD-OVER *BLANKS* (BEG-OF-LINE START-LINE))    *WINDOW*)))      (SEND SHEET :SET-MOUSE-CURSORPOS X Y))    ;;  Friendlier user interface -- let the user release the keys, then hold down.    (PROCESS-WAIT "Release mouse keys" #'(LAMBDA () (AND *MOUSE-P* (ZEROP (W:MOUSE-BUTTONS T)))))    (PROCESS-WAIT "Hold down a mouse key" #'(LAMBDA () (AND *MOUSE-P* (NOT (ZEROP (W:MOUSE-BUTTONS T))))))    (W:READ-ANY)    (DO ((LAST-X) (LAST-Y) (BP (COPY-BP POINT)) (DELTA))(NIL)      (MULTIPLE-VALUE-SETQ (LAST-X LAST-Y)(MOUSE-POSITION))      (SETQ DELTA (LINE-INDENTATION START-LINE SHEET))      (MOVE-BP BP START-LINE 0)      (INDENT-LINE BP (MAX 0 LAST-X) SHEET)      (SETQ DELTA (- (LINE-INDENTATION START-LINE SHEET) DELTA))      (OR (= DELTA 0)  (DO ((LINE START-LINE (LINE-NEXT LINE)))      ((EQ LINE END-LINE))    (AND (NEQ LINE START-LINE) (INDENT-LINE (MOVE-BP BP LINE 0)      (MAX 0 (+ DELTA (LINE-INDENTATION LINE SHEET)))      SHEET))))      (MUST-REDISPLAY *WINDOW* DIS-TEXT)      (REDISPLAY *WINDOW* :POINT)      (OR (WAIT-FOR-MOUSE LAST-X LAST-Y 5)  (RETURN NIL))))  DIS-TEXT) ;;; *** This should figure out some other kind of mouse-blinker ***;; Redefinition of function from patch 94.211.   ddd/gsl, 3/5/84.(DEFCOM COM-MOUSE-INDENT-UNDER"Indent the line containing the keyboard cursor to the column that the mouse is in." (KM)  (LET ((OLD-MOUSE-FONT-CHAR *MOUSE-FONT-CHAR*))    (UNWIND-PROTECT(PROGN  (FORMAT *QUERY-IO*  "~&Line with keyboard cursor will be indented to column of mouse with a left click.~   ~&Typing a string will cause alignment of cursor and line with most recent such string above.")  (SETQ *MOUSE-FONT-CHAR* 55)  (LET ((CH (W:READ-ANY)))    (COND ((AND (CONSP CH)(CHAR= (INT-CHAR (SECOND CH)) #\MOUSE-L))   (INDENT-LINE (POINT) (BP-INDENTATION (MOUSE-BP *WINDOW*)))   (INDENT-BP-ADJUSTMENT (POINT))   DIS-TEXT)  (T   (W:UNREAD-ANY CH)   (COM-INDENT-UNDER)))))      (SETQ *MOUSE-FONT-CHAR* OLD-MOUSE-FONT-CHAR)      (SETQ W::MOUSE-RECONSIDER T)))  DIS-TEXT) AND-P (CHAR)  "T if CHAR is a command that should expand word abbrevs."  (AND (ZEROP (CHAR-BITS CHAR))       (NOT (ZEROP (AREF *WORD-ABBREV-TABLE* (CHAR-CODE CHAR)))))) (DEFUN EXPAND-ABBREV (&AUX BP STRING SYM TEM PROP)  "Expand the word abbrev before point, if there is one."  (AND (NOT (DELIMCHAR-P (BP-CHAR-BEFORE (POINT))))       (MULTIPLE-VALUE-SETQ (STRING BP)    (BOUND-WORD (POINT))))  (COND ((AND STRING      (SETQ SYM (FIND-SYMBOL (STRING-UPCASE STRING) *UTILITY-PACKAGE*))      (SET