;;; Called by the editor to initialize the mouse
(DEFUN INITIALIZE-MOUSE (&AUX (INHIBIT-SCHEDULING-FLAG T))
  (AND (BOUNDP '*MOUSE-CHAR-BLINKER*)
       (TV:OPEN-BLINKER *MOUSE-CHAR-BLINKER*))
  (SETQ *MOUSE-P* NIL
	*MOUSE-CHAR-BLINKER* (TV:MAKE-BLINKER TV:MOUSE-SHEET 'TV:CHARACTER-BLINKER
					      ':VISIBILITY NIL
					      ':HALF-PERIOD 4
					      ':FONT TV:(SCREEN-DEFAULT-FONT DEFAULT-SCREEN)
					      ':CHAR #/?)
	*MOUSE-BOX-BLINKER* (TV:MAKE-BLINKER TV:MOUSE-SHEET 'TV:HOLLOW-RECTANGULAR-BLINKER
					     ':VISIBILITY NIL)
	*MOUSE-BLINKER* *MOUSE-BOX-BLINKER*
	*GLOBAL-MOUSE-CHAR-BLINKER* (TV:MAKE-BLINKER TV:MOUSE-SHEET
						     'TV: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.

  (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))
  (flet ((revert-blinker ()
	  (SEND *GLOBAL-MOUSE-CHAR-BLINKER* ':SET-VISIBILITY NIL)
	  (SETQ *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)
	   (TV:MOUSE-SET-BLINKER-DEFINITION ':CHARACTER *MOUSE-X-OFFSET* *MOUSE-Y-OFFSET*
					    ':ON ':SET-CHARACTER *MOUSE-FONT-CHAR*)))
    (COND ((AND (NEQ CHAR-OR-T T)
		(BP-= (INTERVAL-FIRST-BP (WINDOW-INTERVAL *MINI-BUFFER-WINDOW*))
		      (INTERVAL-LAST-BP (WINDOW-INTERVAL *MINI-BUFFER-WINDOW*))))
	   (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, right to pull into mini-buffer"
		 *MOUSE-HOOK*
		 #'(LAMBDA (WINDOW CHAR IGNORE IGNORE &AUX TEM)
		     (case CHAR
		       (#/MOUSE-1-1
			(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))
			    (revert-blinker)
			    (*THROW 'RETURN-FROM-COMMAND-LOOP
				    (SUBSTRING LINE START END)))))
		       (#/MOUSE-3-1
			(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)
			      (move-bp (window-point *mini-buffer-window*)
				       (INSERT (INTERVAL-FIRST-BP INT) LINE START END)))
			    (must-redisplay *mini-buffer-window* dis-text)
			    (revert-blinker)
			    (throw 'zwei-command-loop nil))))))
		 *MOUSE-FONT-CHAR* 0
		 *MOUSE-X-OFFSET* 4
		 *MOUSE-Y-OFFSET* 0)
	   (TV:MOUSE-SET-BLINKER-DEFINITION ':CHARACTER *MOUSE-X-OFFSET* *MOUSE-Y-OFFSET*
					    ':ON ':SET-CHARACTER *MOUSE-FONT-CHAR*))
	  (T (revert-blinker)))
    (TV: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.

				    (*print-base* *print-base*)
				    (*readtable* *readtable*)
				    (READ-PRESERVE-DELIMITERS T)
				    (INTERVAL (WINDOW-INTERVAL WINDOW)))
				(COMPUTE-BUFFER-PACKAGE INTERVAL)
				(MULTIPLE-VALUE (SYMBOL END)
				  (CLI:READ-FROM-STRING LINE NIL NIL
							':START (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

	(T
	 (MULTIPLE-VALUE (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))
		(TV:BLINKER-SET-SHEET BLINKER SHEET)
		(SHEET-SET-BLINKER-CURSORPOS SHEET BLINKER
					     (- X (TV:SHEET-STRING-LENGTH SHEET LINE BEG
									  INDEX))
					     Y)


;;; 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)
  (REDISPLAY *WINDOW* ':NONE)
  (LET ((POINT (POINT))
	(MARK (MARK))
	(OLD-REGION-P (WINDOW-MARK-P *WINDOW*))
	(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-BP POINT BP)
      (MUST-REDISPLAY *WINDOW* DIS-BPS)
      (REDISPLAY *WINDOW* ':POINT)
      (OR (WAIT-FOR-MOUSE LAST-X LAST-Y) (RETURN NIL))
      (MULTIPLE-VALUE (LAST-X LAST-Y) (MOUSE-POSITION))
      (SETQ BP (MOUSE-BP *WINDOW* LAST-X LAST-Y)))
    (AND (BP-= POINT MARK)
	 (SETF (WINDOW-MARK-P *WINDOW*) OLD-REGION-P)))
    DIS-NONE)

                   ((AND PX
			 (< (+ (^ (- LAST-X PX) 2) (^ (- LAST-Y PY) 2))
			    (+ (^ (- LAST-X MX) 2) (^ (- LAST-Y MY) 2))))
                    (POINT))
                   (T
                    (SETQ PX MX PY MY)
                    (MARK))))
    (FUNCALL SHEET ':SET-MOUSE-CURSORPOS
		   (+ PX (FLOOR (TV:SHEET-CHAR-WIDTH SHEET) 2))
		   (+ PY (FLOOR (* 3 (TV:SHEET-LINE-HEIGHT SHEET)) 4)))
    (DO ()
        (NIL)
      (OR (WAIT-FOR-MOUSE LAST-X LAST-Y) (RETURN NIL))
      (MULTIPLE-VALUE (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*)

	   (funcall (or (call-editing-type-function *major-mode*
						    'mark-thing-function
						    nil)
			'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 (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)

		   (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*)
    (FUNCALL SHEET ':SET-MOUSE-CURSORPOS X Y))
    (process-wait "Mouse" #'(lambda () (not (zerop (tv:mouse-buttons)))))
    (DO ((LAST-X)
	 (LAST-Y)
	 (BP (COPY-BP POINT))
         (DELTA))
	(NIL)
      (MULTIPLE-VALUE (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 nil nil t)
      (wait-for-mouse last-x last-y 10)
      (when (zerop (tv:mouse-buttons)) (return))))
  DIS-TEXT)

;;; *** This should figure out some other kind of mouse-blinker ***
(DEFCOM COM-MOUSE-INDENT-UNDER "Indent the current line as selected by the mouse." (KM)
  (LET ((CH (FUNCALL STANDARD-INPUT ':MOUSE-OR-KBD-TYI)))
    (COND ((= CH #/MOUSE-1-1)
	   (INDENT-LINE (POINT) (BP-INDENTATION (MOUSE-BP *WINDOW*)))
	   (INDENT-BP-ADJUSTMENT (POINT))
	   DIS-TEXT)
	  (T
	   (FUNCALL STANDARD-INPUT ':UNTYI CH)
           (COM-INDENT-UNDER)))))