;;; -*- Package: TV; Mode: LISP; Base:8.; Patch-File:T -*-


;;;  Be sure to define this macro before we use it!
(defmacro zwei:top-menu-active-p (window)
  `(and (typep ,window 'zwei:zmacs-window-pane)
       (boundp 'zwei:*editor-command-menu-height*)
       (plusp zwei:*editor-command-menu-height*)))


;;; The upper case cruft below is from: lm3:>lmwin>mouse.lisp, "borrowed" 5/23/83...
(DEFUN-METHOD FLASHY-SCROLLING-MOUSE-MOVES FLASHY-SCROLLING-MIXIN
	      (W X Y &AUX REGION TOP-P)
  (COND ;;; This is the part that is different: disable when top menu present:
    ((zwei:top-menu-active-p w) nil)
    ((AND ( X 0) (< X WIDTH))
     (SETQ REGION (IF (SETQ TOP-P (< Y (// HEIGHT 2)))
		      (FIRST FLASHY-SCROLLING-REGION)
		      (SECOND FLASHY-SCROLLING-REGION)))
     ;; Make sure is within the appropriate region
     (COND ((AND (FUNCALL-SELF ':SCROLL-BAR-P)
		 (IF TOP-P
		     (< Y (FIRST REGION))
		     (> Y (- HEIGHT (FIRST REGION))))
		 (> X (FLASHY-SCROLLING-PARSE-X-SPEC (SECOND REGION)))
		 ( X (FLASHY-SCROLLING-PARSE-X-SPEC (THIRD REGION)))
		 (FUNCALL-SELF (IF TOP-P ':SCROLL-MORE-ABOVE ':SCROLL-MORE-BELOW)))
	    (OR FLASHY-SCROLLING-BLINKER
		(SETQ FLASHY-SCROLLING-BLINKER MOUSE-BLINKER-NAME))
	    (COND (TOP-P
		   (MOUSE-SET-BLINKER-DEFINITION 'FLASHY-CHARACTER 6 0 ':ON
						 ':SET-CHARACTER 10))
		  (T
		   (MOUSE-SET-BLINKER-DEFINITION 'FLASHY-CHARACTER 6 15 ':ON
						 ':SET-CHARACTER 12)))
	    (AND ;; If mouse is moving slowly enough
	      (OR (NULL FLASHY-SCROLLING-MAX-SPEED)
		  (< MOUSE-SPEED FLASHY-SCROLLING-MAX-SPEED))
	      ;; and out the top or bottom
	      (OR (SETQ TOP-P ( Y 0)) ( Y (1- HEIGHT)))
	      ;; then warp the mouse and send the appropriate message and return T
	      (MULTIPLE-VALUE-BIND (NIL WINDOW-Y-OFFSET)
		  (SHEET-CALCULATE-OFFSETS W MOUSE-SHEET)
		(MOUSE-WARP MOUSE-X (+ (IF TOP-P 10. (- HEIGHT 10.)) WINDOW-Y-OFFSET))
		;; Express scrolling 1 line up or down by relations of lines 0 and 1
		(FUNCALL-SELF ':SCROLL-TO (IF TOP-P -1 +1) ':RELATIVE)
		T)))
	   (FLASHY-SCROLLING-BLINKER
	    (MOUSE-SET-BLINKER FLASHY-SCROLLING-BLINKER)
	    (SETQ FLASHY-SCROLLING-BLINKER NIL)
	    NIL)))))


(defvar zwei:*dont-open-blinker* nil)


;;;  This causes the rectangular blinker in the editor not to
;;; go away so much.  Use the with-open-blinker form below.
(DEFUN OPEN-BLINKER (BLINKER)
  (COND ((AND (BLINKER-PHASE BLINKER)		;If blinker on, turn it off
	      (NOT (SHEET-OUTPUT-HELD-P (BLINKER-SHEET BLINKER)))
	      (not (and (boundp 'zwei:*dont-open-blinker*)
			(typep blinker 'rectangular-blinker)
			(not (typep blinker 'hollow-rectangular-blinker))
			zwei:*dont-open-blinker*)))
	 
	 (BLINK BLINKER)
	 (SETF (BLINKER-TIME-UNTIL-BLINK BLINKER) 0)))

  ;; If the editor blinker, and off, turn it back on.
  (cond ((and (not (blinker-phase blinker))
	      (boundp 'zwei:*dont-open-blinker*)
	      (typep blinker 'rectangular-blinker)
	      (not (typep blinker 'hollow-rectangular-blinker))
	      zwei:*dont-open-blinker*)
	 (blink blinker)))
  (COND ((EQ BLINKER MOUSE-BLINKER)
	 (SETQ *MOUSE-BLINKER-OFF-TIME* 0)
	 (%OPEN-MOUSE-CURSOR))))


(eval-when (compile load eval)
 (defmacro with-blinker-on (&body body)
  
  `(unwind-protect (progn (setq zwei:*dont-open-blinker* t)
			  ,@body)
		   (setq zwei:*dont-open-blinker* nil)))
)