;;; -*- Mode:Common-Lisp; Package:TV; Fonts:(CPTFONT HL10B HL12BI HL12B CPTFONTB); Base:10Ï1; Ï* Patch-File: T -*-

;Ï1;;                     RESTRICTED RIGHTS LEGEND          Ï*
;Ï1;; Use, duplication, or disclosure by the Government is subject toÏ*
;Ï1;; restrictions as set forth in subdivision (b)(3)(ii) of the Rights inÏ*
;Ï1;; Technical Data and Computer Software clause at 52.227-7013.Ï*
;Ï1;;                   TEXAS INSTRUMENTS INCORPORATED.Ï*
;Ï1;;                            P.O. BOX 149149Ï*
;Ï1;;                         AUSTIN, TEXAS 78714-9149Ï*
;Ï1;;                             MS 2151Ï*
;Ï1;; Copyright (C) 1986,1987, 1988, 1989 Texas Instruments Incorporated. All rights reserved.Ï*

#|
Ï3Overview..

This flavor defines a vertically and horizotally scrolling mouse-sensitive window.  
The logical window is unlimited in size, has possible negative coordinates,  starts off 
the same size as the physical (inside of the visible) window, and expands as required.  
"Things" (items) that you see on the window are instances of flavors such as scrollable-text-item
and scrollable-line-item.  As much as possible is compatible with flavor basic-mouse-sensitive-items.

The overview-mixin handles Mouse-m-2 (same as Sh-c-mouse-m) clicks, and displays
an overview of the entire logical-window, with the physical window shown as a rectangle,
which can be moved with the mouse.

Interesting initable instance variables.

 from x-y-scroll-bars-mixin
   :scroll-bar-thickness - # of pixels, the default is 15
   :use-both-scroll-bars-p - if NON-NIL then both scroll bars will be drawn when the user 
                                     invokes scrolling. Default is t.
   :hor-scroll-bar-always-displayed-p - if NON-NIL the hor-scroll-bar is continuously displayed.
   :ver-scroll-bar-always-displayed-p - ditto. Default for both is nil.

 from mouse-sensitivity
   :item-type-alist - as in basic-mouse-sensitive-items
   :mouse-sensitive-types - a list of types or the keyword :all. Default is :all.

 from x-y-scrolling-mixin
   :scrolling-speed - a positive integer which is how much the screen bitblt's by, when scrolling. 
                            Default is 32. Set to 1000 or more for ZMACS style "whoosh, where am I?" scrolling.

 from ver-auto-scrolling-mixin
   :increment - how much to pop up by, when the cursor reaches the bottom of the screen.  
                Can be a pixel number or one of the keywords :whole :half :quarter.  
                     The default is :half.
Methods.

  x-y-scrolling-window supports the following user-level methods.

  :scrollable-text-item item (&key x y coordinate-type mouse-sensitive-type pre-print-item-modify-function font)
  When you want to display a scrollable item whose printed representation
  is a piece of text, use this method. This makes an instance of scrollable-text-item, 
   and tells the window about the new instance. It returns the instance, to which the 
   user can later send a variety of messages.

     item - can be any lisp object. If it is not a string then you must supply
            a pre-print-item-modify-function which takes one arg, item, and returns a string.

     x - the x position of the upper left edge of the item. If x is in physical coordinates
         (ie. relative to the inside of the window) then coordinate type should be set to
         :physical. If x is in logical coordinates then coordinate-type must be set to :logical 
         (which is the default).  The default for x is the cursor position.

     y - see x above.

     coordinate-type - one of :physical :logical.  :logical is the default.

     mouse-sensitive-type - same as type in basic-mouse-senstive-items. See the methods :set-mouse-sentitive-types
                            and :set-item-type-alist. The defualt is nil, meaning not mouse sensitive.

     pre-print-item-modify-function - a function that takes one arg, the item, and returns a string for 
                                      printing.  The default is #`identity.

     font - The default is the current font of the window.

  :scrollable-line-item from-x from-y to-x to-y &key mouse-senstitive-type coordinate-type
  When you want to display a scrollable item whose printed representation is a line,
  then use this method. It makes an instance of scrollable-line-item, tells the window 
  about the new item instance, and returns the instance.

  For a explanation of the args see scrollable-text-item above.

  :set-item-type-alist (new-alist)
    new-alist - an alist of the form for basic-mouse-senstitive-items.

  :set-mouse-sensitive-types (types)
    types - can be a subset of the types in item-type-alist or the keyword :all
            meaning all the types in the alist.  The default is :all.

  The flavors scrollable-text-item and scrollable-line-item support the following user-level methods.

   :delete-self
       The instance will erase itself, and remove itself from the window's item-list.
   :move-to args
     The args depend on what type of instance.
   :center-window-on-yourself
    No args.

  For scrollable-text-item only

   :blink (how-fast-in-60ths)
   :dont-blink
      
Program internals

There are 4 different coordinate systems used here:
1) The screen coordinates ie. 750 by 1024 roughly.
   Some things in the mouse handler are in this system.

2) The outside window coordinates, which are relative to the outside left and top
   edges of the window.  cursor-x and cursor-y are in this system.  Note however
   that the args to the :set-cursorpos method are inside coordinates (#3).

3) The inside window coordinates, which are relative to the inside edges.
   The inside edges are determined by adding the margin width to the border margin
   width plus maybe the label for the bottom edge. the functions sheet-inside-left,
   sheet-inside-bottom, etc, find the inside edges.  Most higher-level text and graphic
   functions use these coordinates. (eg. :draw-line :set-cursorpos)

4) Logical coordinates, which are boundless and possibly negative.
   They look like this:          -
                                 !
                                 !
                                 !
                      -  ----------------- +
                                 !
                                 !
                                 !
                                 +
  The instance vars x-pl-offset y-pl-offset relate the inside coordinate system of
  the window (which I call the physical system) to the logical system. Specifically
  physical + ?-pl-offset = logical.Ï*

|#
;Ï1;;------- basic-x-y-scrolling-window -----------------------------Ï*

;Ï1;; no methods or instance vars for these two flavors.Ï*

(DEFFLAVOR Ï4basic-x-y-scrolling-windowÏ* ()
	   (basic-x-y-scrolling-mixin
	    overview-mixin
	    mouse-sensitivity-for-instances-mixin
	    ver-auto-scrolling-mixin
	    basic-mouse-sensitive-items-compatibility-mixin
	    fancy-drag-scrolling-mixin 
	    borders-mixin
	    label-mixin
	    graphics-mixin
	    stream-mixin
	    minimum-window
	    ))
  
(DEFFLAVOR Ï4basic-x-y-scrolling-mixinÏ* ()
	   (essential-x-y-scrolling-mixin
	    some-window-extensions
	    x-y-scroll-bars-mixin))


;Ï1;;-------- essential-x-y-scrolling-mixin -----------------------------Ï*

(DEFVAR Ï4default-scrolling-speedÏ* (IF (mx-p) 64 32) 
"Ï2Governs how fast the screen scrolls by.  
 Set to 1000 for ZMACS style --whoosh, where am I?-- scrollingÏ*")

(DEFVAR Ï4*default-x-y-scroll-bar-enabledness*Ï* t
"Ï2The default value used to determine whether x-y scroll windows will
 have the scroll bars switched on or not.Ï*")

(DEFFLAVOR Ï4essential-x-y-scrolling-mixinÏ* 
	   ((x-pl-offset 0)   ;Ï1; pl is physical to logicalÏ*
	    ;Ï1; it's the conversion between the two coordinate systems. Can be negative.Ï*
	    (y-pl-offset 0)
	    (item-list nil)
	    (logical-left-edge 0)
	    (logical-right-edge 0)	   ;Ï1; setq'd in :after :initÏ*
	    (logical-top-edge 0)
	    (logical-bottom-edge 0)	   ;Ï1; setq'd in :after :initÏ*
	    (scrolling-speed default-scrolling-speed)
	    (scroll-bars-enabled-p *default-x-y-scroll-bar-enabledness*)
	    )
	   ()
  (:settable-instance-variables
    item-list
    scrolling-speed
    logical-left-edge
    logical-right-edge
    logical-top-edge
    logical-bottom-edge
    scroll-bars-enabled-p)
  (:initable-instance-variables scrolling-speed scroll-bars-enabled-p)
  :gettable-instance-variables
  (:settable-instance-variables scroll-bars-enabled-p)
  (:default-init-plist :save-bits t
    :blinker-p nil
    :deexposed-typeout-action :permit
    :more-p nil)
  (:required-flavors minimum-window)
  (:required-methods :invoke-hor-scrolling
		     :invoke-ver-scrolling
		     :invoke-hor-scrolling-mouse-handler
		     :invoke-ver-scrolling-mouse-handler)
  (:required-instance-variables hor-scrolling-in-effect
				ver-scrolling-in-effect))

(DEFMETHOD Ï4(essential-x-y-scrolling-mixin :after :initÏ*) (&rest ignore)
  (SETQ logical-bottom-edge (SEND self :inside-height))
  (SETQ logical-right-edge (SEND self :inside-width)))

(DEFMETHOD Ï4(essential-x-y-scrolling-mixin :after :change-of-size-or-marginsÏ*) (&rest ignore)
  "Ï2Recalculate logical edges.Ï*"
  (SETQ logical-bottom-edge (SEND self :inside-height)
        logical-right-edge (SEND self :inside-width)
	logical-top-edge 0
	logical-left-edge 0
	x-pl-offset 0
	y-pl-offset 0)
  (COND ((OR (SEND self :exposed-p)
	     (AND (EQL (SEND self :deexposed-typeout-action) :permit)
		  (SEND self :active-p)))
	 (LET ((temp item-list))
	   (SEND self :clear-window)
	   (SETQ item-list temp))
	 (DOLIST (item item-list)
	   (SEND self :expand-logical-window-maybe item))
	 (DOLIST (item item-list)
	   (SEND item :draw-self)))
	(t (DOLIST (item item-list)  ;Ï1else better not try to draw anything.Ï*
	     (SEND self :expand-logical-window-maybe item)))))

(DEFMETHOD Ï4(essential-x-y-scrolling-mixin :after :refreshÏ*) (&rest args)
  (IF (AND args (EQUAL (FIRST args) :use-old-bits))
      nil
      (DOLIST (item item-list)
	(SEND item :refreshed)
	(SEND item :draw-self))))

(DEFMETHOD Ï4(essential-x-y-scrolling-mixin :logical-heightÏ*) ()
  (- logical-bottom-edge logical-top-edge))

(DEFMETHOD Ï4(essential-x-y-scrolling-mixin :logical-widthÏ*) ()
  (- logical-right-edge logical-left-edge))

(DEFMETHOD Ï4(essential-x-y-scrolling-mixin :re-initializeÏ*) ()
  (SETQ item-list nil
	x-pl-offset 0
	y-pl-offset 0
	logical-left-edge 0
	logical-top-edge 0
	logical-right-edge
	  (IF (EQUAL :recompute logical-right-edge)
	      0
	      (SEND self :inside-width))
	logical-bottom-edge
	  (IF (EQUAL :recompute logical-bottom-edge)
	      0
	      (SEND self :inside-height))))

(DEFMETHOD Ï4(essential-x-y-scrolling-mixin :scrollable-text-itemÏ*)
	   (item &key
	    (mouse-sensitive-type nil)
	    ;Ï1; the defaults below are in pixelsÏ*
	    ;Ï1; relative to the inside coordinate systemÏ*
	    (x (- cursor-x (sheet-inside-left self)))
	    (y (- cursor-y (sheet-inside-top self)))
	    (coordinate-type :logical)
	    (font nil)
	    (pre-print-item-modify-function #'IDENTITY)
	    )
  (LET ((item (MAKE-INSTANCE 'scrollable-text-item
			     :item item
			     :mouse-sensitive-type mouse-sensitive-type
			     :font font
			     :logical-x (IF (EQL coordinate-type :physical)
					    (+ x x-pl-offset)
					    x)
			     :logical-y (IF (EQL coordinate-type :physical)
					    (+ y y-pl-offset)
					    y)
			     :window self
			     :pre-print-item-modify-function pre-print-item-modify-function)))
    (SEND item :draw-self)
    ;Ï1; put item on listÏ*
    (PUSH item item-list)    
    (SEND self :expand-logical-window-maybe item)
    ;Ï1; this will do the boxing if appropriateÏ*
    (SEND self :mouse-moves mouse-x mouse-y)
    item))  ;Ï1; return thisÏ*

(DEFMETHOD Ï4(essential-x-y-scrolling-mixin :scrollable-line-itemÏ*) (from-x from-y to-x to-y)
  "Ï2all coordinates are in logical coordinatesÏ*"
  (LET ((item (MAKE-INSTANCE 'scrollable-line-item
			     :from-x from-x
			     :from-y from-y
                             :to-x to-x
			     :to-y to-y
                             :window self)))
    (SEND item :draw-self)
    (PUSH item item-list)
    (SEND self :expand-logical-window-maybe item)
    (SEND self :mouse-moves mouse-x mouse-y)
    item))  ;Ï1return thisÏ*

(DEFMETHOD Ï4(essential-x-y-scrolling-mixin :expand-logical-window-maybeÏ*) (item)
  (IF (OR (EQUAL :recompute logical-right-edge)
	 (EQUAL :recompute logical-bottom-edge))
     (SEND self :re-initialize)
     nil)
  (IF (OR (< (SEND item :left-edge) logical-left-edge)
	  (> (SEND item :right-edge) logical-right-edge)
	  (< (SEND item :top-edge) logical-top-edge)
	  (> (SEND item :bottom-edge) logical-bottom-edge))
      (SEND self :expand-logical-window item)))

(DEFMETHOD Ï4(essential-x-y-scrolling-mixin :expand-logical-windowÏ*) (item)
  (SETQ  logical-left-edge (MIN (SEND item :left-edge) logical-left-edge))
  (SETQ  logical-right-edge (MAX (SEND item :right-edge) logical-right-edge))
  (SETQ  logical-top-edge (MIN (SEND item :top-edge) logical-top-edge))
  (SETQ  logical-bottom-edge (MAX  (SEND item :bottom-edge) logical-bottom-edge)))

(DEFMETHOD Ï4(essential-x-y-scrolling-mixin :after :expand-logical-windowÏ*) (IGNORE)
  (SEND self :update-scroll-bars))

(DEFUN Ï4scrolling-bitbltÏ* (window dx dy speed)
  "Ï2Special effects. Bitblts the inside of WINDOW by dx and dy in increments of SPEED. 
 If dx or dy is positive the text moves right or down the uncovered space is erased.Ï*"
  (ASSERT (PLUSP speed) (speed) "Ï3speed cannot be negativeÏ*")
  ;Ï1; if how-much is so big that we're going to scroll out into space then just clear the window.Ï*
  (COND ((OR (> (ABS dx) (SEND window :inside-width))
	     (> (ABS dy) (SEND window :inside-height)))
	 (sheet-clear window))	   ;Ï1; we use sheet-clear insead of :clear-window cause it is closer to bitblting,Ï*
	                           ;Ï1; and :clear-window might have some undesirable :after methods.Ï*
	(t (LET* ((num-of-increments (/ (SQRT (+ (* dx dx) (* dy dy))) speed))
		  (x-increment (TRUNCATE dx num-of-increments))
		  (y-increment (TRUNCATE dy num-of-increments)))
	     (DO  ((how-much-x-left-to-do dx (- how-much-x-left-to-do x-increment))
		   (how-much-y-left-to-do dy (- how-much-y-left-to-do y-increment))
		   (how-much-x-done 0 (+ how-much-x-done x-increment))
		   (how-much-y-done 0 (+ how-much-y-done y-increment)))
		  ((AND (ZEROP how-much-x-left-to-do)(ZEROP how-much-y-left-to-do)))
	       ;Ï1; if there's not much left, do it all in one shot.Ï*
	       (IF (OR (< (ABS how-much-x-left-to-do) (ABS (* 2 x-increment)))
		       (< (ABS how-much-y-left-to-do) (ABS (* 2 y-increment))))
		   (SETQ x-increment how-much-x-left-to-do
			 y-increment how-much-y-left-to-do))
	       (bitblt-whole-sheet window x-increment y-increment))))))

(DEFUN Ï4bitblt-whole-sheetÏ* (sheet dx dy)
  "Ï2Bitblt sheet's inside sceen array by dx and dy, and wipe out the uncovered areaÏ*"
  (SEND sheet :bitblt-within-sheet alu-seta
	(IF (PLUSP dx) -2000 2000) ;Ï1; the 2000 will get truncated to window size. Ï*
	(IF (PLUSP dy) -2000 2000) ;Ï1; making the 2000 negative will change how the bitblt is done.Ï*
	0 0 dx dy)
  ;Ï1; wipe out the uncovered area.Ï*
  (UNLESS (ZEROP dx)
    (SEND sheet :draw-rectangle (ABS dx) 2000
	  (IF (PLUSP dx)	
	      0    ;Ï1;window going right, wipe our left edge.Ï*
	      (+ (SEND sheet :inside-width) dx)) ;Ï1;else window going left, wipe out right edge.Ï*
	  0
	  (sheet-erase-aluf sheet)))
  (UNLESS (ZEROP dy)
    (SEND sheet :draw-rectangle 2000 (ABS dy)
	  0
	  (IF (PLUSP dy)	
	      0    ;Ï1;window going down, wipe our top edge.Ï*
	      (+ (SEND sheet :inside-height) dy))
	  (sheet-erase-aluf sheet))))
		   

(DEFMETHOD Ï4(essential-x-y-scrolling-mixin :scroll-relativeÏ*) (x y  &optional (truncate-args-p t) (inhibit-bitblt-p nil))
    (SEND self :scroll-to (+ x-pl-offset x) (+ y-pl-offset y) truncate-args-p inhibit-bitblt-p))

(DEFMETHOD Ï4(essential-x-y-scrolling-mixin :scroll-toÏ*) (logical-x logical-y &optional (truncate-args-p t)
						       (inhibit-bitblt-p nil))
  (COND (truncate-args-p      ;Ï1; truncate args if necessaryÏ*
	 (SETQ logical-x (MAX logical-x logical-left-edge))
	 (SETQ logical-x (MIN logical-x (- logical-right-edge (SEND self :inside-width))))
	 (SETQ logical-y (MAX logical-y logical-top-edge))
	 (SETQ logical-y (MIN logical-y (- logical-bottom-edge (SEND self :inside-height)))))
	(t ;Ï1; else expand the logical windowÏ*
	 (SETQ logical-left-edge (MIN logical-left-edge logical-x))
	 (SETQ logical-right-edge (MAX logical-right-edge (+ logical-x (SEND self :inside-width))))
	 (SETQ logical-top-edge (MIN logical-top-edge logical-y))
	 (SETQ logical-bottom-edge (MAX logical-bottom-edge (+ logical-y (SEND self :inside-height))))))
  (COND ((AND (= logical-x x-pl-offset)
	      (= logical-y y-pl-offset)))	;Ï1; then do nothingÏ*
	(t (UNLESS inhibit-bitblt-p
	     (scrolling-bitblt self (- x-pl-offset logical-x) (- y-pl-offset logical-y) scrolling-speed))
	   (SEND self :scroll-cursor (- x-pl-offset logical-x) (- y-pl-offset logical-y))
	   (SETQ x-pl-offset logical-x
		 y-pl-offset logical-y)
	   (DOLIST (item item-list)
	     (SEND item :draw-self)))))

(DEFMETHOD Ï4(essential-x-y-scrolling-mixin :scroll-cursorÏ*) (dx dy)
  (SEND self :set-cursorpos
	(+ dx (- cursor-x (sheet-inside-left self)))
	(+ dy (- cursor-y (sheet-inside-top self)))))

(DEFMETHOD Ï4(essential-x-y-scrolling-mixin :after :scroll-toÏ*) (&rest ignore)
  (SEND self :update-scroll-bars))
(DEFMETHOD Ï4(essential-x-y-scrolling-mixin :handle-mouseÏ*) ()
  (x-y-scrolling-mouse-handler self))

;Ï1 TAC 07-25-89 - moved up here from a lower position in this file  Ï*
(DEFVAR Ï4*mx-scroll-bar-tollerance*Ï* 10)

(DEFUN Ï4x-y-scrolling-mouse-handlerÏ* (window 				    
				    &aux
				    (window-x-offset 0) (window-y-offset 0)
				    window-x window-y)
  "Ï2Handles the mouse if neither scroll bar is exposed.Ï*"
  ;Ï1; this code pilfered from mouse-default-handler.Ï*
  (UNLESS (SYMBOLP window)
    (MULTIPLE-VALUE-SETQ (window-x-offset window-y-offset)
      (sheet-calculate-offsets self mouse-sheet)))
  
  ;Ï1; Be careful not to do the :update method when the who line documentation windowÏ*
  ;Ï1; isn't there (which is the case during a window system build).Ï*
  (WHEN (AND (BOUNDP 'who-line-documentation-window) who-line-documentation-window)
    ;Ï1; Update who-line when entering new handlers.Ï*
    (SEND who-line-documentation-window :update))
  
  (DO ((dx) (dy) (bu) (bd) (x) (y)
       (old-owner window-owning-mouse window-owning-mouse)
       (left-offset 0)
       (right-offset 0)
       (bottom-offset 0)
       (wait-flag nil t)
       ;Ï1; 10 is really too fast if you have a hor scroll bar also.Ï*
       ;Ï1; If they haven't rebound this to their favorite value, do so.Ï*
       (scroll-bar-max-speed (IF (= scroll-bar-max-speed 10) 3
				 (= scroll-bar-max-speed 10))))
      (mouse-reconsider)
    ;Ï1; Wait until the mouse movesÏ*
    (MULTIPLE-VALUE-SETQ (dx dy bd bu x y) (mouse-input wait-flag))
    ;Ï1; If asked to reconsider, do so immediately.Ï*
    ;Ï1; Don't bother updating blinker since it is likely to change soon, andÏ*
    ;Ï1; in any case we are going to be called back shortly.Ï*
    (WHEN mouse-reconsider (RETURN nil))
    ;Ï1; Update console-idle time when buttons pushedÏ*
    (UNLESS (ZEROP bd) (SETQ kbd-last-activity-time (TIME)))
    ;Ï1; Approximate speed of the mouse in inches per secondÏ*
    (SETQ mouse-speed (/ (ISQRT (+ (* mouse-x-speed mouse-x-speed)
                                   (* mouse-y-speed mouse-y-speed)))
                         100.0s0))
    ;Ï1; If the mouse is moving incredibly fast, flash up something toÏ*
    ;Ï1; help the user find it.  Thus if you can't find the mouse, you must whip it.Ï*
    (WHEN (> mouse-speed mouse-fast-motion-speed)
      (IF mouse-fast-track-bitmap-mouse-p
	  (draw-bitmap-mouse-cursor mouse-speed)
	  ;Ï1;ELSEÏ*
	  (draw-mouse-fast-motion-cursor)))
    
    (SETQ window-x (- x window-x-offset)	;Ï1 X offset of mouse within windowÏ*
          window-y (- y window-y-offset))	;Ï1 Y offset of mouse within windowÏ*
    ;Ï1; Consider entering the scroll bar.  [Perhaps this should be changed so thatÏ*
    ;Ï1; it is in the move-handler rather than here.  Problem with that is LEFT-OFFSET.]Ï*
    ;Ï1; If there is a scroll bar and we are entering it, activate it.Ï*
    ;Ï1; However, the mouse must move at least a certain distance past the edgeÏ*
    ;Ï1; of the window in order to qualify for scrolling (this is set byÏ*
    ;Ï1; the SCROLL-BAR-RELUCTANCE variable in the window).  Before enteringÏ*
    ;Ï1; scroll bar, send a :MOUSE-MOVES message in order to let the window knowÏ*
    ;Ï1; what's happening.Ï*

    ;Ï1; LEFT-OFFSET is how far out the left side of the window the mouse has moved,Ï*
    ;Ï1; or 0 if the mouse is inside the window.Ï*
    ;Ï1; If the window is at the left edge of the screen, MOUSE-X will not itselfÏ*
    ;Ï1; move out the left edge of the window, but DX will.  When the mouse reachesÏ*
    ;Ï1; the left edge of the window, accumulate leftward motion into LEFT-OFFSET.  Ï*
    ;Ï1; RIGHT-OFFSET does the same thing for when the scroll-bar is on the right.Ï*
    (COND ((<= window-x 0)
	   (SETQ left-offset  (IF (PLUSP left-offset)
				  (MAX (- left-offset dx) 1)
				  (- dx))))	
	  ((AND (TYPEP window 'sheet)
		(>= window-x (sheet-width window))
		(SEND window :send-if-handles :scroll-bar-on-right))
	   (SETQ right-offset (IF (PLUSP right-offset)
				  (MAX (+ right-offset dx) 1)
				  dx)))
	  (t (SETQ left-offset 0
		   right-offset 0)))
    ;Ï1;do the same for bottom-offsetÏ*
    (COND ((<= (sheet-height window) window-y)
	   (SETQ bottom-offset (IF (PLUSP bottom-offset) 
				   (MAX (+ bottom-offset dy) 1)
				   dy)))
	  (t (SETQ bottom-offset 0)))
    (COND ((OR old-owner window-owning-mouse (SEND self :dragging-screen-p)))	;Ï1 These disable scroll-bar.Ï*
	  ((AND scroll-bar-max-speed		;Ï1Too fast, pass right throughÏ*
		(> mouse-speed scroll-bar-max-speed)))
	  ((PLUSP left-offset)
	   (COND ((AND (SEND window :scroll-bars-enabled-p)
		       (> left-offset scroll-bar-reluctance)
		       (OR (NOT (mx-p)) (< left-offset *mx-scroll-bar-tollerance*)))
		  (SEND window :mouse-moves window-x window-y)
		  (RETURN (SEND window :invoke-ver-scrolling)))
		 (t (SETQ window-x 0))))	;Ï1Don't escape the window yetÏ*
	  ((PLUSP bottom-offset)
	   (COND ((AND (SEND window :scroll-bars-enabled-p)
		       (> bottom-offset scroll-bar-reluctance))
		  (SEND window :mouse-moves window-x window-y)
		  (RETURN (SEND window :invoke-hor-scrolling)))
		 (t (SETQ window-y (sheet-height window))))))	;Ï1; Don't escape the window yetÏ*
    
    ;Ï1; Update the position of the mouse before checking for button clicks, soÏ*
    ;Ï1; that button clicks get processed with knowledge of where the mouseÏ*
    ;Ï1; was when the button was first clicked.  The arguments to the move handlerÏ*
    ;Ï1; may be where the mouse was when the button was clicked, whereas theÏ*
    ;Ï1; mouse cursor follows MOUSE-X and MOUSE-Y, which may be different.   Ï*
    (SETQ mouse-warp nil)
    (SEND window  :mouse-moves window-x window-y)
    ;Ï1; Check for all the ways of losing control of the mouse.Ï*
    (IF (COND ;Ï1; The move handler may have decided to warp the mouse so that it will notÏ*
	  ;Ï1; move out of the window.  This test is a crock but should work.Ï*
	  (mouse-warp nil)
	  ;Ï1; Check for mouse ceasing to be grabbed.Ï*
	  ((EQ window t)
	   (NEQ window-owning-mouse t))
	  ;Ï1; Check for window becoming grabbed.Ï*
	  ((EQ window-owning-mouse t)
	   (NEQ window t))
	  ;Ï1; Check for some other window (not above this one) being greedy.Ï*
	  (window-owning-mouse
	   (NOT (sheet-me-or-my-kid-p window window-owning-mouse)))
	  ;Ï1; Check for moving into a window when not in anyÏ*
	  ((NULL window)
	   (window-owning-mouse x y))
	  ;Ï1; Check for leaving the boundaries of the current windowÏ*
	  ;Ï1; HYSTERETIC-WINDOW-MIXIN requires that we wait at least once before returningÏ*
	  ((NOT (AND (sheet-exposed-p window)
		     (>= window-x 0)
		     (<  window-x (sheet-width window))
		     (>= window-y 0)
		     (<  window-y (sheet-height window))))
	   wait-flag)
	  ;Ï1; Check for moving into an inferior of the current windowÏ*
	  ((NEQ (lowest-sheet-under-point window window-x window-y
					  :handle-mouse :exposed)
		window)
	   t))
        ;Ï1; Return to overseer, saving any pending button click.Ï*
        (RETURN (mouse-defer-buttons bu bd)))
    ;Ï1; Now process button pushes if mouse is not seized.Ï*
    (UNLESS (OR (ZEROP bd)  old-owner)
      (FUNCALL window :mouse-buttons bd window-x window-y))))

;Ï1;;---------- fancy-drag-scrolling-mixin ---------------------Ï*

(DEFFLAVOR Ï4fancy-drag-scrolling-mixinÏ* 
	   (lx ly start-x start-y (dragging-screen-p)) 
	   () 
  :gettable-instance-variables)

(DEFMETHOD Ï4(fancy-drag-scrolling-mixin :mouse-clickÏ*) (b x y)
  "Ï2Fancy drag scrollingÏ*"
  (WHEN (AND (= b #\mouse-m)
	     (NOT (SEND self :currently-boxed-item))
	     (= (mouse-buttons t) 2)) ;Ï1;still holding middleÏ*
    (SETQ lx x ly y start-x x start-y y dragging-screen-p t)))

(DEFMETHOD Ï4(fancy-drag-scrolling-mixin :after :mouse-movesÏ*) (x y)
  (WHEN dragging-screen-p 
    (COND ((= (mouse-buttons t) 2)
	   (bitblt-whole-sheet self (- x lx) (- y ly))
	   (SETQ lx x ly y))
	  (t (SETQ dragging-screen-p nil)
	     (IF (mx-p) ;Ï1;; This is a strange fix to compensate for the factÏ*
		 ;Ï1;; that the Ï*µÏ1X seems to get strange values for x and yÏ*
		 ;Ï1;; for this method sometimes.  I don't know why, butÏ*
		 ;Ï1;; if you wait until both x and y are plusp, the answerÏ*
		 ;Ï1;; seems to be right.Ï*
		 (LOOP for for (dx dy bd bu lx ly)
		       = (MULTIPLE-VALUE-LIST (mouse-input nil))
		       until (AND (PLUSP lx) (PLUSP ly))
		       finally (SETQ x lx y ly))
		 nil)
	     (SEND self :scroll-relative (- start-x x) (- start-y y) nil t)))))

(DEFMETHOD Ï4(fancy-drag-scrolling-mixin :after :handle-mouseÏ*) (&rest ignore)
  (WHEN dragging-screen-p
    (SETQ dragging-screen-p nil)
    (SEND self :scroll-relative (- start-x lx) (- start-y ly) nil t)))

(DEFMETHOD Ï4(fancy-drag-scrolling-mixin :override :who-line-documentation-stringÏ*) ()
  (UNLESS (SEND self :currently-boxed-item)
    "Ï3R2: System Menu;  MH: Drag ScrollingÏ*"))

;Ï1;;--------- basic scrollable item -------------------------------------Ï*

(DEFFLAVOR Ï4basic-scrollable-itemÏ* 
	   ((item nil)
	    (mouse-sensitive-type nil)		;Ï1; nil means NOT mouse-sensitiveÏ*
	    (left-edge 0)( right-edge 0)
	    (bottom-edge 0) (top-edge 0)	;Ï1; these are the dimensions of the textÏ*
	    msr-left msr-right msr-bottom msr-top	;Ï1; these are the dimensions of the msrÏ*
	    window)				;Ï1; which is Mouse Sensitive Region.Ï*
	   ()
  :gettable-instance-variables
  (:initable-instance-variables mouse-sensitive-type item window)
  (:settable-instance-variables item window mouse-sensitive-type)
  (:required-methods :draw-self)
  ;Ï1;also requires an :after :init to set all the edges.Ï*
  )

(DEFMETHOD Ï4(basic-scrollable-item :draw-boxing-maybeÏ*) (logical-mouse-x logical-mouse-y)
  (COND ((SEND self :boxing-appropriate-p logical-mouse-x logical-mouse-y)
	 ;Ï1;then get the window's item blinker, and turn it onÏ*
	 (LET ((item-blinker (SEND window :item-blinker))
	       ;Ï1;; Fixes for Ï*µÏ1X put in because it doesn't seem able to clipÏ*
	       ;Ï1;; blinkers at the edge of windows.Ï*
	       (left   (IF (mx-p)
			   (MAX 0 (- msr-left (SEND window :x-pl-offset)))
			   (- msr-left (SEND window :x-pl-offset))))
	       (top    (IF (mx-p)
			   (MAX 0 (- msr-top (SEND window :y-pl-offset)))
			   (- msr-top (SEND window :y-pl-offset))))
	       (right  (IF (mx-p)
			   (MIN (SEND window :inside-width)
				(- msr-right (SEND window :x-pl-offset)))
			   (- msr-right (SEND window :x-pl-offset))))
	       (bottom (IF (mx-p)
			   (MIN (SEND window :inside-height)
				(-  msr-bottom (SEND window :y-pl-offset)))
			   (-  msr-bottom (SEND window :y-pl-offset))))
	       bwidth bheight)
	   (SETQ bwidth  (- right  left)
		 bheight (- bottom top))
           ;Ï1; Position the blinker to the item.Ï*
	   (blinker-set-cursorpos item-blinker left top)
                                ;Ï1  (- LEFT (SHEET-INSIDE-LEFT window))Ï*
				;Ï1  (- TOP  (SHEET-INSIDE-TOP window)))Ï*
           ;Ï1; Change the size of the blinker to enclose the item.Ï*
	   (blinker-set-size       item-blinker bwidth bheight)
           ;Ï1; Turn the blinker on.Ï*
	   (blinker-set-visibility item-blinker t))
	 t))) ;Ï1; return t to signify boxing is drawnÏ*

(DEFMETHOD Ï4(basic-scrollable-item :erase-boxingÏ*) ()
  "Ï2Turn the blinker offÏ*"
  (blinker-set-visibility (SEND window :item-blinker) nil))
  
(DEFMETHOD Ï4(basic-scrollable-item :boxing-appropriate-pÏ*) (logical-mouse-x logical-mouse-y)
  "Ï2In order to qualify for boxing the item must be of a current-mouse-sensitive-type,
   and the mouse has to be over the msr (mouse sensitive region) of the item.Ï*"
  (AND (< msr-left logical-mouse-x msr-right)
       (< msr-top logical-mouse-y msr-bottom)
       (SEND window :current-mouse-sensitve-type-p mouse-sensitive-type)))

(DEFMETHOD Ï4(basic-scrollable-item :delete-selfÏ*) ()
  "Ï2Erase self, then removes self from the window's item listÏ*"
  (SEND self :erase-self)
  (SEND window :set-item-list (DELETE self (SEND window :item-list))))

(DEFMETHOD Ï4(basic-scrollable-item :center-window-on-yourselfÏ*) ()
  (LET ((mid-x (TRUNCATE (+ left-edge right-edge) 2))
	(mid-y (TRUNCATE (+ top-edge bottom-edge) 2)))
  (SEND window :scroll-to
	(- mid-x (TRUNCATE (SEND window :inside-width) 2))
	(- mid-y (TRUNCATE (SEND window :inside-height) 2))
	nil)))  ;Ï1;this NIL means expand the logical window to accomodate usÏ*

(DEFMETHOD Ï4(basic-scrollable-item :widthÏ*) ()
  (- right-edge left-edge))

(DEFMETHOD Ï4(basic-scrollable-item :heightÏ*) ()
  (- bottom-edge top-edge))

;Ï1;------- scrollable text item ------------------------------------Ï*

(DEFCONSTANT Ï4default-boxing-offsetÏ* 3 "Ï2How far away from a word to draw the boxing.Ï*")

(DEFFLAVOR Ï4scrollable-text-itemÏ* 
	   ((logical-x 0)
	    (logical-y 0)
	    font	;Ï1; setq'd_maybe  in :after :initÏ*
	    (pre-print-item-modify-function #'IDENTITY)	;Ï1; must return a string. Given item.Ï*
	    (boxing-offset default-boxing-offset)	;Ï1; How far away from a word to draw the boxing.Ï*
	    (blinker))
	   (basic-scrollable-item)
  (:documentation  "Ï3An item whose printed representation is a string of textÏ*")
  (:gettable-instance-variables logical-x logical-y font pre-print-item-modify-function boxing-offset)
  (:initable-instance-variables logical-x logical-y font pre-print-item-modify-function boxing-offset))

;Ï1;; Stub JPR.Ï*
(DEFMETHOD Ï4(scrollable-text-item :refreshedÏ*) ()
 nil
)

(DEFMETHOD Ï4(scrollable-text-item :after :initÏ*) (&rest ignore)
  (UNLESS (AND (VARIABLE-BOUNDP font) font)
    (SETQ font (SEND window :current-font)))
  ;Ï1; Coercion put in by JPR.Ï*
  (SETQ font
	(ETYPECASE font
	  (font font)
	  (symbol (SYMBOL-VALUE font))
	  (number (AREF (SEND window :font-map) font))))
  (ASSERT (STRINGP (FUNCALL pre-print-item-modify-function item)) (pre-print-item-modify-function)
	  "Ï3The pre-print-item-modify-function must result in a string when applied to item.~
          Currently it resuts in ~sÏ*" (FUNCALL pre-print-item-modify-function item))
  (SEND self :set-edges))

(DEFMETHOD Ï4(scrollable-text-item :set-edgesÏ*) ()
  (UNLESS font (SETQ font (SEND window :current-font)))
  (SETQ left-edge logical-x)
  (SETQ top-edge logical-y)
  (MULTIPLE-VALUE-BIND (text-length text-height)
      (SEND window :compute-motion (FUNCALL pre-print-item-modify-function item)
	    0 nil 0 0  nil 0 nil nil nil font)
    (SETQ right-edge (+ logical-x text-length))
    (SETQ bottom-edge (+ logical-y (font-char-height font) text-height)))
  (SETQ msr-left (- left-edge boxing-offset)
	msr-right (+ right-edge boxing-offset)
	msr-bottom (+ bottom-edge boxing-offset)
	msr-top (- top-edge boxing-offset)))


(DEFMETHOD Ï4(scrollable-text-item :move-toÏ*) (x y &optional inhibit-redraw-p)
  (SEND self :erase-self)
  (SETQ logical-x x
	logical-y y)
  (SEND self :set-edges)
  (SEND window :expand-logical-window-maybe self)
  (UNLESS inhibit-redraw-p (SEND self :draw-self)))

(DEFMETHOD Ï4(scrollable-text-item :erase-selfÏ*) ()
    (LET ((physical-x (- logical-x (SEND window :x-pl-offset)))
	  (physical-y (- logical-y (SEND window :y-pl-offset))))
      ;Ï1; since string-out-explicit goes by outside dimensions, and physical-x y are inside dimensions, do:Ï*
      (INCF physical-x (sheet-inside-left window))
      (INCF physical-y (sheet-inside-top window))
      (SEND window :string-out-explicit-within-region
	    (FUNCALL pre-print-item-modify-function item) physical-x physical-y font (SEND window :erase-aluf))))

(DEFMETHOD Ï4(scrollable-text-item :draw-selfÏ*) ()
    (LET ((physical-x (- logical-x (SEND window :x-pl-offset)))
	  (physical-y (- logical-y (SEND window :y-pl-offset))))
      ;Ï1; since string-out-explicit goes by outside dimensions, and physical-x y are inside dimensions, do:Ï*
      (INCF physical-x (sheet-inside-left window))
      (INCF physical-y (sheet-inside-top window))
      (SEND window :string-out-explicit-within-region
	    (FUNCALL pre-print-item-modify-function item) physical-x physical-y font (SEND window :char-aluf))))

(DEFMETHOD Ï4(scrollable-text-item :blinkÏ*) (&optional (how-fast-in-60ths 30))
  (LET ((physical-x (- logical-x (SEND window :x-pl-offset)))
	(physical-y (- logical-y (SEND window :y-pl-offset))))
    (COND (blinker (SEND blinker :set-cursorpos physical-x physical-y)
		    (SEND blinker :set-visibility :blink)
		    (SEND blinker :set-deselected-visibility :blink)
		    (SEND blinker :set-half-period how-fast-in-60ths))
	  (t (SETQ blinker (make-blinker window
					 'rectangular-blinker
					 :width (- right-edge left-edge)
					 :height (- bottom-edge top-edge)
					 :deselected-visibility :blink
					 :x-pos physical-x
					 :y-pos physical-y
					 :half-period how-fast-in-60ths))
	     (SEND blinker :set-visibility :blink)))))

(DEFMETHOD Ï4(scrollable-text-item :dont-blinkÏ*) ()
  (WHEN blinker
    (SEND blinker :set-visibility nil)
    (SEND blinker :set-deselected-visibility nil)))

(DEFMETHOD Ï4(scrollable-text-item :after :draw-selfÏ*) (&rest ignore)
  (WHEN (AND blinker (SEND blinker :visibility))
    (LET ((physical-x (- logical-x (SEND window :x-pl-offset)))
	  (physical-y (- logical-y (SEND window :y-pl-offset))))
      (SEND blinker :set-cursorpos physical-x physical-y))))
  
;Ï1; ------- scrollable-line-item--------------------Ï*

(DEFFLAVOR Ï4scrollable-line-itemÏ* ((from-x 0) (from-y 0)
				 (to-x 0) (to-y 0))
	   (basic-scrollable-item)
  :gettable-instance-variables
  :initable-instance-variables)

;Ï1;; Stub JPR.Ï*
(DEFMETHOD Ï4(scrollable-line-item :refreshedÏ*) ()
  nil
)

(DEFMETHOD Ï4(scrollable-line-item :after :initÏ*) (&rest ignore)
  (UNLESS item 
    (SETQ item (FORMAT nil "Ï3A line from (~a,~a) to (~a,~a)Ï*" from-x from-y to-x to-y)))
  (SEND self :set-edges))

(DEFCONSTANT Ï4line-box-sizeÏ* 8 "Ï2How big a mouse sensitive box to draw on a lineÏ*")

(DEFMETHOD Ï4(scrollable-line-item :set-edgesÏ*) ()
  (SETQ left-edge (MIN from-x to-x)
	right-edge (MAX from-x to-x)
	top-edge (MIN from-y to-y)
	bottom-edge (MAX from-y to-y))
  (LET ((mid-x (TRUNCATE (+ left-edge right-edge) 2))
	(mid-y (TRUNCATE (+ top-edge bottom-edge) 2)))
    (SETQ msr-left (- mid-x  line-box-size)			
	  msr-right (+ mid-x line-box-size)
	  msr-top (- mid-y line-box-size)
	  msr-bottom (+ mid-y line-box-size))))

(DEFMETHOD Ï4(scrollable-line-item :draw-selfÏ*) ()
  ;Ï1; (format lisp "drawing ")Ï*
  (LET ((physical-from-x (- from-x (SEND window :x-pl-offset)))
	(physical-from-y (- from-y (SEND window :y-pl-offset)))
	(physical-to-x (- to-x (SEND window :x-pl-offset)))
	(physical-to-y (- to-y (SEND window :y-pl-offset))))
    (SEND window :draw-line physical-from-x physical-from-y physical-to-x physical-to-y (SEND window :char-aluf))))

(DEFMETHOD Ï4(scrollable-line-item :erase-selfÏ*) ()
  ;Ï1; (format lisp "erasing ")Ï*
  (LET ((physical-from-x (- from-x (SEND window :x-pl-offset)))
	(physical-from-y (- from-y (SEND window :y-pl-offset)))
	(physical-to-x (- to-x (SEND window :x-pl-offset)))
	(physical-to-y (- to-y (SEND window :y-pl-offset))))
    (SEND window :draw-line physical-from-x physical-from-y physical-to-x physical-to-y (SEND window :erase-aluf))))

(DEFMETHOD Ï4(scrollable-line-item :move-toÏ*) (new-from-x new-from-y new-to-x new-to-y &optional inhibit-redraw-p)
  (SEND self :erase-self)
  (SETQ from-x new-from-x
	from-y new-from-y
	to-x new-to-x
	to-y new-to-y)
  (SEND self :set-edges)
  (SEND window :expand-logical-window-maybe self)
  (UNLESS inhibit-redraw-p (SEND self :draw-self)))

;Ï1;------ window extensions ----------------------------------------Ï*

(DEFFLAVOR Ï4some-window-extensionsÏ* () ())

(DEFMETHOD Ï4(some-window-extensions :mouse-warpÏ*) (x y)
  "Ï2X and Y are relative to the outside of self. The pane of a frame is an inferior of the pane, 
   so if you send the pane an :x-offset message you get relative to the frame.  But mouse-warp
   is relative the real tv screen.  In order to warp to a location relative to the pane, you've
   got to get the x-offset for the pane (relative to the frame) and for the frame (relative
   to the screeen). There might be N superiors.Ï*"
    (mouse-warp (+ x (SEND self :real-x-offset)) (+ y (SEND self :real-y-offset))))

(DEFMETHOD Ï4(some-window-extensions :real-x-offsetÏ*) ()
  "Ï2X and Y are relative to the outside of self.  The pane of a frame is an inferior of the pane, 
   so if you send the pane an :x-offset message you get relative to the frame.  But mouse-warp
   is relative the real tv screen.  In order to warp to a location relative to the pane, you've
   got to get the x-offset for the pane (relative to the frame) and for the frame (relative
   to the screeen). There might be N superiors.Ï*"
  (LET ((real-x-offset 0))
    (DO ((superior self (SEND superior :superior)))
	((NOT superior) real-x-offset)
      (INCF real-x-offset (SEND superior :x-offset)))))

(DEFMETHOD Ï4(some-window-extensions :real-y-offsetÏ*) ()
  "Ï2X and Y are relative to the outside of self. The pane of a frame is an inferior of the pane, 
   so if you send the pane an :x-offset message you get relative to the frame.  But mouse-warp
   is relative the real tv screen.  In order to warp to a location relative to the pane, you've
   got to get the x-offset for the pane (relative to the frame) and for the frame (relative
   to the screeen). There might be N superiors.Ï*"
  (LET ((real-y-offset 0))
    (DO ((superior self (SEND superior :superior)))
	((NOT superior) real-y-offset)
      (INCF real-y-offset (SEND superior :y-offset)))))

(DEFMETHOD Ï4(some-window-extensions :string-out-explicit-within-regionÏ*)
	   (STRING start-x start-y font alu 
	    &optional
	    (min-x (sheet-inside-left self))
	    (min-y (sheet-inside-top self))
	    (max-x (sheet-inside-right self))
	    (max-y (sheet-inside-bottom self))	      
	    (start 0) end (multi-line-line-height (+ 2 (font-char-height font))))
  "Ï2Similar to :string-out-explicit except that this will only draw the chars
   if they are in the region defined by min-x min-y max-x max-y.  Basically
   this is a generalization of :string-out-explicit's x-limit y-limit.Ï*"
  ;Ï1; if the text is right of, on top of, or below the region then stop hereÏ*
  (WHEN (AND (<= start-x max-x)
	     (<= start-y max-y)
	     (>= start-y min-y))
    (sheet-string-out-explicit-within-region-1 self string start-x start-y
					       min-x min-y max-x max-y
					       font alu
					       start end multi-line-line-height)))

(DEFUN Ï4sheet-string-out-explicit-within-region-1Ï*
       (sheet string start-x y
	min-x min-y
	xlim ylim font alu
	&optional (start 0) (end nil)
	multi-line-line-height
	&aux fit fwt lkt
	(x start-x))
  "Ï2Output STRING on SHEET without using SHEET's cursor, font, etc.
   Output starts at cursor position START-X, Y if both are greater than
   min-x min-y. SHEET's cursor is not moved. 
   Output stops if x-position XLIM or y-position YLIM is reached.

   Font FONT is used, and alu-function ALU.
   START and END specify a portion of STRING to be used.
   MULTI-LINE-LINE-HEIGHT is how far to move down for Return
   characters; Return also moves back to x-position START-X.
   NIL means output <Return> with a lozenge.

  All position arguments are relative to SHEET's outside edges.Ï*"
  
  (DECLARE (VALUES final-x final-y final-index))
  (coerce-font font sheet)
  (SETQ fit (font-indexing-table   font)
	fwt (font-char-width-table font)
	lkt (font-left-kern-table  font))
  (OR xlim (SETQ xlim (sheet-width sheet)))
  (prepare-sheet (sheet)
    (DO ((i start (1+ i))
	 (n (OR end (ARRAY-ACTIVE-LENGTH string)))
	 (width (font-char-width font))
	 (ch))
	((>= i n) (VALUES x y i))
      (SETQ ch (AREF string i))
      (COND ((AND multi-line-line-height (MEMBER ch '(#\newline #\Return) :test #'CHAR-EQUAL))
	     (SETQ x start-x
                   y (+ y multi-line-line-height))
	     (IF (AND ylim (> (+ y multi-line-line-height) ylim))
		 (RETURN x y i)))
	    ((>= ch 200)
	     (LET* ((STRING (STRING
                              (OR
                                (CAR (RASSOC ch si::xr-special-character-names))
                                ;Ï1; If there is no name for the characterÏ*
                                ;Ï1; then print out its octal character number.Ï*
                                (FORMAT nil "Ï3~3OÏ*" ch))))
		    (nx (+ x (lozenged-string-geometry string))))
	       (IF (> nx xlim) (RETURN x y i))
	       (sheet-display-lozenged-string-internal sheet string
						       x (1+ y) xlim alu)
	       (SETQ x nx)))
	    (t (IF fwt (SETQ width (OR (AREF fwt ch) (font-char-width font))))
	       (IF (> (+ x width) xlim) (RETURN x y i))
	       (WHEN (AND (<= min-x x)		;Ï1; This extra "when", and the lambda list, are the only thingsÏ*
			  (<= min-y y)		;Ï1; different from SHEET-STRING-OUT-EXPLICIT-1Ï*
			  (>= ylim (+ y (font-char-height font))))
		 (draw-char font ch
			    (IF lkt
				(- x (AREF lkt ch))
				;Ï1;ELSEÏ*
				x)
			    y alu sheet))
	       (SETQ x (+ x width)))))))



;Ï1;;Ï*
;Ï1;;   Reed Hastings     Hastings@sumex.stanford.edu     January 1987Ï*
;Ï1;;Ï*
;Ï1;;   The flavor defs and methods for flavor x-y-scroll-bars-mixin.Ï*
;Ï1;;   This flavor sets up horizontal and vertical scroll bars.Ï*
;Ï1;;  Ï*
;Ï1;;   Mix this in with a window if that window:Ï*
;Ï1;;   Ï*
;Ï1;;   a) has a mouse handler that sends self :invoke-ver-scrolling and :invoke-hor-scrolling when appropriate;Ï*
;Ï1;;   b) has the required methods and instance variables below.  They are mostlyÏ*
;Ï1;;      used to calculate the correct scroll bar length and position;Ï*
;Ï1;;   c) handles the :scroll-to message which has two args: new-x-position and new-y-position, which areÏ*
;Ï1;;      in pixels on the logical screen, and might be negative;  the handler should truncate args into range.Ï*
;Ï1;;   d) handles the :scroll-relative message which has two args: how-many-pixels and direction.Ï*
;Ï1;;   Ï*
;Ï1;;   Ï*
;Ï1;;   Overwiew.Ï*
;Ï1;;   Ï*
;Ï1;;   a typical (vertical) scrolling action would go like this:  the window's mouse handler would notice that the mouseÏ*
;Ï1;;   is requesting scrolling (by slowly leaving the top probably). It sends an :invoke-ver-scrollingÏ*
;Ï1;;   message.  The method below would draw the scroll bar, alter the mouse cursor character, andÏ*
;Ï1;;   call the ver-scrolling-mouse-handler.  This handler will keep the mouse in the correct region, sendingÏ*
;Ï1;;   :mouse-moves-scroll  and :mouse-buttons-scroll messages as appropriate. After sending each :mouse-buttons-scrollÏ*
;Ï1;;   message it will redraw the scroll bar to reflect the (possibly) new situation.  This mouse handler willÏ*
;Ï1;;   return when the mouse legally moves out of the scroll bar region, or when the mouse is seized (like byÏ*
;Ï1;;   some other window covering our scrolling window.)  After the mouse handler returns, the Ï*
;Ï1;;   :invoke-ver-scrolling method will erase the scroll bar, and reset the mouse cursor character, beforeÏ*
;Ï1;;   returning (presumably to the window's regular mouse handler).Ï*
;Ï1;;Ï*
;Ï1;;Ï*
;Ï1;;   Notes.Ï*
;Ï1;;Ï*
;Ï1;;   The code was pinched from the TI system code. Mostly from the mouse-default-handler.Ï*
;Ï1;;Ï*
;Ï1;;Ï*

(DEFCONSTANT  Ï4default-scroll-bar-thicknessÏ* 15)
							   
(DEFFLAVOR Ï4x-y-scroll-bars-mixinÏ* 
	   ((hor-scrolling-in-effect nil)      ;Ï1; a flag for general useÏ*
	    (ver-scrolling-in-effect nil)      ;Ï1; a flag for general useÏ*
	    (ver-scroll-bar nil)	       ;Ï1; a record of the scroll bar dimensions, nil if not drawn.Ï*
	    (hor-scroll-bar nil)	       ;Ï1; a record of the scroll bar dimensions, nil if not drawn.Ï*
	    (scroll-bar-thickness default-scroll-bar-thickness)
	    (use-both-scroll-bars-p t)         ;Ï1; if t, both scroll bars are drawn when scrolling invoked.Ï*	
	    (hor-scroll-bar-always-displayed-p nil)
	    (ver-scroll-bar-always-displayed-p nil))
	   ()
  (:required-instance-variables logical-left-edge x-pl-offset logical-top-edge y-pl-offset logical-bottom-edge)
  (:required-methods :scroll-relative :scroll-to :logical-width :logical-height :inside-width :inside-height)
  (:required-flavors minimum-window)
  (:initable-instance-variables scroll-bar-thickness
				use-both-scroll-bars-p
				ver-scroll-bar-always-displayed-p
				hor-scroll-bar-always-displayed-p)
  (:settable-instance-variables scroll-bar-thickness
				use-both-scroll-bars-p
				ver-scroll-bar-always-displayed-p
				hor-scroll-bar-always-displayed-p)) 

(DEFMETHOD Ï4(x-y-scroll-bars-mixin :after :initÏ*) (&rest ignore)
  "Ï2give room for scroll bars on left and top edges.Ï*"
  (SEND self :set-border-margin-width (+ scroll-bar-thickness 1)))

(DEFMETHOD Ï4(x-y-scroll-bars-mixin :after :exposeÏ*) (&rest ignore)
  (WHEN hor-scroll-bar-always-displayed-p (SEND self :draw-hor-scroll-bar))
  (WHEN ver-scroll-bar-always-displayed-p (SEND self :draw-ver-scroll-bar)))

(DEFMETHOD Ï4(x-y-scroll-bars-mixin :before :change-of-size-or-marginsÏ*) (&rest ignore)
  "Ï2We have to get rid of them because they will change in length upredictably,
   and we won't know how to erase them.Ï*"
  (SEND self :erase-hor-scroll-bar)
  (SEND self :erase-ver-scroll-bar))

(DEFMETHOD Ï4(x-y-scroll-bars-mixin :override :who-line-documentation-stringÏ*) ()
  (COND (ver-scrolling-in-effect self
	 (IF (= (SEND self :logical-height) (SEND self :inside-height))
	     "Ï3Nothing to scroll to vertically.  There is nothing above or below.Ï*"
	     '(:mouse-l-1 "Ï3this place to topÏ*"
			  :mouse-l-2 "Ï3this place to bottomÏ*"
			  :mouse-m-1 "Ï3percentage-wiseÏ*"
			  :mouse-r-1 "Ï3top to this placeÏ*"
			  :mouse-r-2 "Ï3bottom to this placeÏ*")))
	(hor-scrolling-in-effect
	 (IF (= (SEND self :logical-width) (SEND self :inside-width))
	     "Ï3Nothing to scroll to horizontally.  There is nothing left or right.Ï*"
	     '(:mouse-l-1 "Ï3this place to left edgeÏ*"
			  :mouse-l-2 "Ï3this place to right edgeÏ*"
			  :mouse-m-1 "Ï3percentage-wiseÏ*"
			  :mouse-r-1 "Ï3left edge to this placeÏ*"
			  :mouse-r-2 "Ï3right edge to this place.Ï*")))))

;Ï1; the mouse char has already been changed so just pass on the :mouse-moves message.Ï*
(DEFMETHOD Ï4(x-y-scroll-bars-mixin :mouse-moves-scrollÏ*) (x y)
  (SEND self :mouse-moves x y))

(DEFMETHOD Ï4(x-y-scroll-bars-mixin :mouse-buttons-scrollÏ*) (bd x y)
  "Ï2decides how much to scroll in what directionÏ*"
  ;Ï1; bd is a mask of what button is down. mouse-button-encode looks for double clicks or whatever.Ï*
  (LET ((button (mouse-character-button-encode bd)))
    (COND (hor-scrolling-in-effect
	   (CASE button
		 (#\mouse-l (SEND self :scroll-relative x 0))
		 (#\mouse-l-2 (SEND self :scroll-relative (- x width) 0))
		 (#\mouse-r (SEND self :scroll-relative (- x) 0))
		 (#\mouse-r-2 (SEND self :scroll-relative (- width x) 0))
		 (#\mouse-m (SEND self :scroll-to
				  (TRUNCATE (+ logical-left-edge (* (SEND self :logical-width)
					       (/ x width))))
				  y-pl-offset))
		 (otherwise (BEEP))))
	  (ver-scrolling-in-effect
	   (CASE button
		 (#\mouse-l (SEND self :scroll-relative 0 y))
		 (#\mouse-l-2 (SEND self :scroll-relative 0 (- y height)))
		 (#\mouse-r (SEND self :scroll-relative 0 (- y)))
		 (#\mouse-r-2 (SEND self :scroll-relative 0 (- height y)))
		 (#\mouse-m (SEND self :scroll-to
				  x-pl-offset
				  (TRUNCATE (+ logical-top-edge (* (SEND self :logical-height)
					       (/ y height))))))
		 (otherwise (BEEP))))
	  (t (CERROR "Ï3ignore safelyÏ*" "Ï3neither scroll bar is inÏ*")))))

(DEFMETHOD Ï4(x-y-scroll-bars-mixin :update-scroll-barsÏ*) ()
  (WHEN ver-scroll-bar
	 (SEND self :erase-ver-scroll-bar)
	 (SEND self :draw-ver-scroll-bar))
  (WHEN hor-scroll-bar
	 (SEND self :erase-hor-scroll-bar)
	 (SEND self :draw-hor-scroll-bar)))

;Ï1;-------- vertical scrolling code. ------ horizontal is symmetric.Ï*

(DEFMETHOD Ï4(x-y-scroll-bars-mixin :invoke-ver-scrollingÏ*) ()
  "Ï2Called by the window's mouse handler when the mouse enters the vertical scroll bar.
   Returns when the mouse leaves the scrolling area.Ï*"
  ;Ï1; Give feedback by changing mouse cursor before calling SCROLL-BAR-DRAW, which pages a lotÏ*
  (SEND self ':set-mouse-position (TRUNCATE scroll-bar-width 2) nil)
  ;Ï1; Change the mouse to a double-headed up-and-down arrow.Ï*
  (mouse-set-blinker-definition ':character 0 7 ':on
				':set-character 4)
  ;Ï1; Draw the scroll bar(s)Ï*
  ;Ï1; We don't care if there already drawn, cause :draw-ver-scroll-bar will do the right thing.Ï*
  (SEND self :draw-ver-scroll-bar)
  (WHEN use-both-scroll-bars-p (SEND self :draw-hor-scroll-bar))
  
  ;Ï1; let this handler run. It will return when the mouse leaves the scrolling area.Ï*
  ;Ï1; while it is running set the flagÏ*
  (SETQ ver-scrolling-in-effect t)
  (SEND self :invoke-ver-scrolling-mouse-handler)
  (SETQ ver-scrolling-in-effect nil)
  ;Ï1; put back blinkerÏ*
  (mouse-standard-blinker self)
  ;Ï1; erase scroll barÏ*
  (UNLESS ver-scroll-bar-always-displayed-p (SEND self :erase-ver-scroll-bar))
  (UNLESS hor-scroll-bar-always-displayed-p (WHEN hor-scroll-bar (SEND self :erase-hor-scroll-bar))))

(DEFMETHOD Ï4(x-y-scroll-bars-mixin :draw-ver-scroll-barÏ*) ()
  (WITHOUT-INTERRUPTS
    (IF (sheet-can-get-lock self)
	(ver-scroll-bar-draw)
	(PROCESS-RUN-FUNCTION "Ï3Draw Scroll BarÏ*"
			      (LET-CLOSED ((self self)
					   (si:self-mapping-table si:self-mapping-table))
				  (sheet-force-access (self)
				    ;Ï1; It is possible that the mouse moved out while we wereÏ*
				    ;Ï1; waiting.  If this is the case, punt drawing.Ï*
				    (AND (SEND self :ver-scrolling-in-effect)
					 (ver-scroll-bar-draw))))))))

(DEFMETHOD Ï4(x-y-scroll-bars-mixin :erase-ver-scroll-barÏ*) ()
  (WITHOUT-INTERRUPTS
    ;Ï1; There is this funny case where the sheet could be locked by the person waiting for us to back out.Ï*
    ;Ï1; For us to block here would be a disaster, so undraw the scroll bar in another process.Ï*
    (IF (sheet-can-get-lock self)
	(sheet-force-access (self) (ver-scroll-bar-erase))
	(PROCESS-RUN-FUNCTION "Ï3Undraw Scroll BarÏ*"
			      (LET-CLOSED ((self self)
					   (si:self-mapping-table si:self-mapping-table))
				  (sheet-force-access (self)
				    ;Ï1; It is possible that the user reentered the scroll bar before this code ran.  Ï*
				    ;Ï1; In that case, don't actually erase it.Ï*
				    (OR (SEND self :ver-scrolling-in-effect)
					(ver-scroll-bar-erase))))))))

(DEFMETHOD Ï4(x-y-scroll-bars-mixin :invoke-ver-scrolling-mouse-handlerÏ*)
				    (&aux
				    (window-x-offset 0) (window-y-offset 0)
				    window-x window-y
				    (window self))
				    
  "Ï2Handles the mouse if vertical scroll bar is engaged.Ï*"
  (MULTIPLE-VALUE-SETQ (window-x-offset window-y-offset)
    (sheet-calculate-offsets self mouse-sheet))
  (DO ((dx) (dy) (bu) (bd)  (x) (y)
       (old-owner window-owning-mouse window-owning-mouse)
       (wait-flag nil t))
      (mouse-reconsider)
    ;Ï1; Wait until the mouse movesÏ*
    (IF (mx-p)
	;Ï1;; Do this twice because otherwise we get bogus values.Ï*
	(MULTIPLE-VALUE-SETQ (dx dy bd bu x y) (mouse-input nil))
	nil)
    (MULTIPLE-VALUE-SETQ (dx dy bd bu x y) (mouse-input wait-flag))
    ;Ï1; If asked to reconsider, do so immediately.Ï*
    ;Ï1; Don't bother updating blinker since it is likely to change soon, andÏ*
    ;Ï1; in any case we are going to be called back shortly.Ï*
    (IF mouse-reconsider (RETURN nil))

    (SETQ window-x (- x window-x-offset)	;Ï1; X offset of mouse within windowÏ*
	  window-y (- y window-y-offset))	;Ï1; Y offset of mouse within windowÏ*
    ;Ï1; Approximate speed of the mouse in inches per secondÏ*
    (SETQ mouse-speed (TRUNCATE (ISQRT (+ (* mouse-x-speed mouse-x-speed)
					  (* mouse-y-speed mouse-y-speed)))
				100))
    ;Ï1; maybe leave the scroll barÏ*
    (COND ((AND scroll-bar-max-exit-speed
		(> mouse-speed scroll-bar-max-exit-speed))
	   ;Ï1; Moving like a bat, let the guy out of the scroll barÏ*
	   (RETURN nil))
	  ((> window-x scroll-bar-width)	        ;Ï1; Escape out rightÏ*
	   (RETURN nil))
	  ((MINUSP window-x)			        ;Ï1; Trying to go out left, shove back inÏ*
	   (WITHOUT-INTERRUPTS
	     (%open-mouse-cursor)
	     (SETQ window-x 0)
	     (SETQ mouse-last-x (SETQ mouse-x window-x-offset))
	     (SETQ mouse-cursor-state mouse-cursor-closed-state
		   prepared-sheet nil)))
	  ((MINUSP window-y)			        ;Ï1; Trying to go out up, shove back inÏ*
	   (WITHOUT-INTERRUPTS
	     (%open-mouse-cursor)
	     (SETQ window-y 0)
	     (SETQ mouse-last-y (SETQ mouse-y window-y-offset))
	     (SETQ mouse-cursor-state mouse-cursor-closed-state
		   prepared-sheet nil)))
	  ((> window-y (SEND window :inside-height))	;Ï1; Trying to go out down, shove back in.Ï*
	   (WITHOUT-INTERRUPTS
	     (%open-mouse-cursor)
	     (SETQ window-y (SEND window :inside-height))
	     (SETQ mouse-last-y (SETQ mouse-y (+ window-y-offset (SEND window :inside-height))))
	     (SETQ mouse-cursor-state mouse-cursor-closed-state
		   prepared-sheet nil))))
    ;Ï1; Update the position of the mouse before checking for button clicks, so that button clicksÏ*
    ;Ï1; get processed with knowledge of where the mouse was when the button was first clicked. Ï*
    ;Ï1; The arguments to the move handler may be where the mouse was when the button was clicked, Ï*
    ;Ï1; whereas the mouse cursor follows MOUSE-X and MOUSE-Y, which may be different.    Ï*
    (SETQ mouse-warp nil)
    (SEND window :mouse-moves-scroll window-x window-y)
    ;Ï1; Check for all the ways of losing control of the mouse.Ï*
    (IF (COND ;Ï1; The move handler may have decided to warp the mouse so that it will notÏ*
	      ;Ï1; move out of the window.  This test is a crock but should work.Ï*
	  (mouse-warp nil)
	  ;Ï1; Check for mouse ceasing to be grabbed.Ï*
	  ((EQ window t)
	   (NEQ window-owning-mouse t))
	  ;Ï1; Check for window becoming grabbed.Ï*
	  ((EQ window-owning-mouse t)
	   (NEQ window t))
	  ;Ï1; Check for some other window (not above this one) being greedy.Ï*
	  (window-owning-mouse
	   (NOT (sheet-me-or-my-kid-p window window-owning-mouse)))
	  ;Ï1; Check for moving into a window when not in anyÏ*
	  ((NULL window)
	   (window-owning-mouse x y))
	  ;Ï1; Check for leaving the boundaries of the current windowÏ*
	  ;Ï1; HYSTERETIC-WINDOW-MIXIN requires that we wait at least once before returningÏ*
	  ((AND (mx-p)
		;Ï1; We can't warp the mouse on the MX when we end up inÏ*
		;Ï1; a scroll bar, so be more lenient.Ï*
		(NOT (AND (sheet-exposed-p window)
			  ;Ï1; When the mouse is outside the window the values of window-xÏ*
			  ;Ï1; and window-y stay constant at the edges of the window, so we  Ï*
			  ;Ï1; need to calculate a certain amount of hysteresis on our own.Ï*
			  (AND (<= y (+ window-y window-y-offset))
			       (AND (>= x (+ (- *mx-scroll-bar-tollerance*)
					     window-x window-x-offset))
				    (<= x (+ *mx-scroll-bar-tollerance*
					     window-x window-x-offset))))
			  (>= window-x (- *mx-scroll-bar-tollerance*))
			  (<  window-x (+ *mx-scroll-bar-tollerance*
					  (sheet-width window)))
			  (>= window-y (- *mx-scroll-bar-tollerance*))
			  (<  window-y (+ *mx-scroll-bar-tollerance*
					  (sheet-height window)))
			  )))
	   wait-flag)
	  ((AND (NOT (mx-p))
		(NOT (AND (sheet-exposed-p window)
			  (>= window-x 0)
			  (<  window-x (sheet-width window))
			  (>= window-y 0)
			  (<  window-y (sheet-height window)))))
	   wait-flag)
	  ;Ï1; Check for moving into an inferior of the current windowÏ*
	  ((NEQ (lowest-sheet-under-point window window-x window-y
					  ':handle-mouse ':exposed)
		window)
	   t))
	;Ï1; Return to overseer, saving any pending button click.Ï*
	(RETURN (mouse-defer-buttons bu bd)))
    ;Ï1; Now process button pushes if mouse is not seized.Ï*
    (UNLESS (OR (ZEROP bd) old-owner)
      (FUNCALL window :mouse-buttons-scroll bd window-x window-y)
      (SEND window :update-scroll-bars))))

;Ï1;;-------- horizontal scrolling ----- symmetric code to above vertical scrollingÏ*

(DEFMETHOD Ï4(x-y-scroll-bars-mixin :invoke-hor-scrollingÏ*) ()
  "Ï2Called when the mouse enters the horizontal scroll bar
     Returns when the mouse leaves the scrolling area.Ï*"
  ;Ï1; Give feedback by changing mouse cursor before calling SCROLL-BAR-DRAW, which pages a lotÏ*
  (SEND self ':set-mouse-position nil (- (sheet-height self) (TRUNCATE scroll-bar-width 2)))

  ;Ï1; Change the mouse to a fat double-headed up-and-down arrow.Ï*
  (mouse-set-blinker-definition ':character 0 7 ':on
				':set-character 5)

  ;Ï1; Draw the scroll barÏ*
  (SEND self :draw-hor-scroll-bar)
  (WHEN use-both-scroll-bars-p (SEND self :draw-ver-scroll-bar))
  ;Ï1; Let this handler run. It will return when the mouse leaves the scrolling area.Ï*
  ;Ï1; while it runs set this flag for the who line and maybe othersÏ*
  (SETQ hor-scrolling-in-effect t)
  (SEND self :invoke-hor-scrolling-mouse-handler)
  (SETQ hor-scrolling-in-effect nil)
  ;Ï1; put back blinkerÏ*
  (mouse-standard-blinker self)
  ;Ï1; erase scroll barÏ*
  (UNLESS hor-scroll-bar-always-displayed-p (SEND self :erase-hor-scroll-bar))
  (UNLESS ver-scroll-bar-always-displayed-p (WHEN ver-scroll-bar (SEND self :erase-ver-scroll-bar))))

(DEFMETHOD Ï4(x-y-scroll-bars-mixin :draw-hor-scroll-barÏ*) ()
  (WITHOUT-INTERRUPTS
    (IF (sheet-can-get-lock self)
	(hor-scroll-bar-draw)
	(PROCESS-RUN-FUNCTION "Ï3Draw Scroll BarÏ*"
			      (LET-CLOSED ((self self)
					   (si:self-mapping-table si:self-mapping-table))
				  (sheet-force-access (self)
				    ;Ï1; It is possible that the mouse moved out while we wereÏ*
				    ;Ï1; waiting.  If this is the case, punt drawing.Ï*
				    (AND (SEND self :hor-scrolling-in-effect)
					 (hor-scroll-bar-draw))))))))

(DEFMETHOD Ï4(x-y-scroll-bars-mixin :erase-hor-scroll-barÏ*) ()
    (WITHOUT-INTERRUPTS
      ;Ï1; There is this funny case where the sheet could be locked by the person waiting for us to back out.Ï*
      ;Ï1; For us to block here would be a disaster, so undraw the scroll bar in another process.Ï*
      (IF (sheet-can-get-lock self)
	  (sheet-force-access (self) (hor-scroll-bar-erase))
	  (PROCESS-RUN-FUNCTION "Ï3Undraw Scroll BarÏ*"
				(LET-CLOSED ((self self)
					   (si:self-mapping-table si:self-mapping-table))
				    (sheet-force-access (self)
				      ;Ï1; It is possible that the user reentered the scroll bar before this code ran. Ï*
				      ;Ï1; In that case, don't actually erase it.Ï*
				      (OR (SEND self :hor-scrolling-in-effect)
					  (hor-scroll-bar-erase))))))))

;Ï1 TAC 07-25-89 - moved up - this has to occur sooner in this file for proper compilationÏ*
;Ï1(defvar *mx-scroll-bar-tollerance* 10)Ï*

(DEFMETHOD Ï4(x-y-scroll-bars-mixin :invoke-hor-scrolling-mouse-handlerÏ*) 
				    (&aux
				    (window-x-offset 0) (window-y-offset 0)
				    window-x window-y
				    (window self))
				    
  "Ï2Handles the mouse if horizontal scroll bar is exposed.Ï*"
  (MULTIPLE-VALUE-SETQ (window-x-offset window-y-offset)
    (sheet-calculate-offsets self mouse-sheet)) 
  (DO ((dx) (dy) (bu) (bd)  (x) (y)
       (old-owner window-owning-mouse window-owning-mouse)
       (wait-flag nil t))
      (mouse-reconsider)
    ;Ï1; Wait until the mouse movesÏ*
    (MULTIPLE-VALUE-SETQ (dx dy bd bu x y) (mouse-input wait-flag))
    ;Ï1; If asked to reconsider, do so immediately.Ï*
    ;Ï1; Don't bother updating blinker since it is likely to change soon, andÏ*
    ;Ï1; in any case we are going to be called back shortly.Ï*
    (IF mouse-reconsider (RETURN nil))

    (SETQ window-x (- x window-x-offset)	;Ï1; X offset of mouse within windowÏ*
	  window-y (- y window-y-offset))	;Ï1; Y offset of mouse within windowÏ*
    ;Ï1; Approximate speed of the mouse in inches per secondÏ*
    (SETQ mouse-speed (TRUNCATE (ISQRT (+ (* mouse-x-speed mouse-x-speed)
					  (* mouse-y-speed mouse-y-speed)))
				100))
    ;Ï1; Maybe leave the scroll bar and maybe move the cursor in.Ï*
    (COND ((AND scroll-bar-max-exit-speed
		(> mouse-speed scroll-bar-max-exit-speed))
	   ;Ï1; Moving like a bat, let the guy out of the scroll barÏ*
	   (RETURN nil))
	  ((< window-y (- (sheet-height window) scroll-bar-width))	;Ï1; Escape out upÏ*
	   (RETURN nil))
	  ((> window-y 	(sheet-height window))		;Ï1; Trying to go out down, shove back inÏ*
	   (WITHOUT-INTERRUPTS
	     (%open-mouse-cursor)
	     (SETQ window-y (sheet-height window))
	     (SETQ mouse-last-y (SETQ mouse-y (+ (sheet-height window) window-y-offset)))
	     (SETQ mouse-cursor-state mouse-cursor-closed-state
		   prepared-sheet nil)))
	  ((MINUSP window-x)			        ;Ï1; Trying to go out left, shove back inÏ*
	   (WITHOUT-INTERRUPTS
	     (%open-mouse-cursor)
	     (SETQ window-x 0)
	     (SETQ mouse-last-x (SETQ mouse-x window-x-offset))
	     (SETQ mouse-cursor-state mouse-cursor-closed-state
		   prepared-sheet nil)))
	  ((> window-x (SEND window :inside-width))	;Ï1; Trying to go out right, shove back in.Ï*
	   (WITHOUT-INTERRUPTS
	     (%open-mouse-cursor)
	     (SETQ window-x (SEND window :inside-width))
	     (SETQ mouse-last-x (SETQ mouse-x (+ window-x-offset (SEND window :inside-width))))
	     (SETQ mouse-cursor-state mouse-cursor-closed-state
		   prepared-sheet nil)))
	  )
    ;Ï1; Update the position of the mouse before checking for button clicks, so that button clicks Ï*
    ;Ï1; get processed with knowledge of where the mouse was when the button was first clicked. Ï*
    ;Ï1; The arguments to the move handler may be where the mouse was when the button was clicked,Ï*
    ;Ï1; whereas the mouse cursor follows MOUSE-X and MOUSE-Y, which may be different.    Ï*
    (SETQ mouse-warp nil)
    (SEND window :mouse-moves-scroll window-x window-y)
    ;Ï1; Check for all the ways of losing control of the mouse.Ï*
    (IF (COND ;Ï1; The move handler may have decided to warp the mouse so that it will notÏ*
	      ;Ï1; move out of the window.  This test is a crock but should work.Ï*
	  (mouse-warp nil)
	  ;Ï1; Check for mouse ceasing to be grabbed.Ï*
	  ((EQ window t)
	   (NEQ window-owning-mouse t))
	  ;Ï1; Check for window becoming grabbed.Ï*
	  ((EQ window-owning-mouse t)
	   (NEQ window t))
	  ;Ï1; Check for some other window (not above this one) being greedy.Ï*
	  (window-owning-mouse
	   (NOT (sheet-me-or-my-kid-p window window-owning-mouse)))
	  ;Ï1; Check for moving into a window when not in anyÏ*
	  ((NULL window)
	   (window-owning-mouse x y))
	  ;Ï1; Check for leaving the boundaries of the current windowÏ*
	  ;Ï1; HYSTERETIC-WINDOW-MIXIN requires that we wait at least once before returningÏ*
	  ((AND (mx-p)
		;Ï1; We can't warp the mouse on the MX when we end up inÏ*
		;Ï1; a scroll bar, so be more lenient.Ï*
		(NOT (AND (sheet-exposed-p window)
			  ;Ï1; When the mouse is outside the window the values of window-xÏ*
			  ;Ï1; and window-y stay constant at the edges of the window, so we Ï*
			  ;Ï1; need to calculate a certain amount of hysteresis on our own.Ï*
			  (OR (EQ window (window-under-mouse))
			      (AND (<= y (+ *mx-scroll-bar-tollerance*
					    window-y window-y-offset))
				   (<= x (+ *mx-scroll-bar-tollerance*
					    window-x window-x-offset)))
			  )
			  (>= window-x (- *mx-scroll-bar-tollerance*))
			  (<  window-x (+ *mx-scroll-bar-tollerance*
					  (sheet-width window)))
			  (>= window-y (- *mx-scroll-bar-tollerance*))
			  (<  window-y (+ *mx-scroll-bar-tollerance*
					  (sheet-height window))))))
	   wait-flag)
	  ((AND (NOT (mx-p))
		(NOT (AND (sheet-exposed-p window)
			  (>= window-x 0)
			  (<  window-x (sheet-width window))
			  (>= window-y 0)
			  (<  window-y (sheet-height window)))))
	   wait-flag)
	  ;Ï1; Check for moving into an inferior of the current windowÏ*
	  ((NEQ (lowest-sheet-under-point window window-x window-y
					  ':handle-mouse ':exposed)
		window)
	   t))
	;Ï1; Return to overseer, saving any pending button click.Ï*
	(RETURN (mouse-defer-buttons bu bd)))
    ;Ï1; Now process button pushes if mouse is not seized.Ï*
    (UNLESS (OR (ZEROP bd) old-owner)
      (FUNCALL window :mouse-buttons-scroll bd window-x window-y)
      (SEND window :update-scroll-bars))))

;Ï1; --------- scroll bar draw and erase functions ------------Ï*
(DEFUN-METHOD Ï4ver-scroll-bar-drawÏ* x-y-scroll-bars-mixin ()
  (WHEN ver-scroll-bar (SEND self :erase-ver-scroll-bar))
  (LET ((LENGTH (TRUNCATE (* height (/ (SEND self :inside-height) (SEND self :logical-height)))))
	(top (TRUNCATE (* height (/ (- y-pl-offset logical-top-edge) (SEND self :logical-height)))))) 
    (prepare-sheet (self)
      ;Ï1; Erase anything there first.Ï*
      (%draw-rectangle scroll-bar-thickness length 0 top  alu-andca self)
      ;Ï1; Now we can draw the scroll bar.Ï*
      (%draw-rectangle scroll-bar-thickness length 0 top  alu-ior self))
    ;Ï1; Make a record of the scroll bar so it can be erased correctlyÏ*
    (SETQ ver-scroll-bar (LIST top length scroll-bar-thickness))))

(DEFUN-METHOD Ï4ver-scroll-bar-eraseÏ* x-y-scroll-bars-mixin ()
  (WHEN ver-scroll-bar
    (LET ((top (FIRST ver-scroll-bar))
	  (LENGTH (SECOND ver-scroll-bar))
	  (thickness (THIRD ver-scroll-bar)))
      (prepare-sheet (self)
	(%draw-rectangle thickness length 0 top  alu-andca self)
	(SEND self :refresh-margins)
	(SETQ ver-scroll-bar nil)))))

(DEFUN-METHOD Ï4hor-scroll-bar-drawÏ* x-y-scroll-bars-mixin ()
  (WHEN hor-scroll-bar (SEND self :erase-hor-scroll-bar))
  (LET ((LENGTH (TRUNCATE (* width (/ (SEND self :inside-width) (SEND self :logical-width)))))
	(left (TRUNCATE (* width (/ (- x-pl-offset logical-left-edge) (SEND self :logical-width))))))
    (prepare-sheet (self)
      ;Ï1; Erase anything there first.Ï*
      (%draw-rectangle length scroll-bar-thickness left (- height scroll-bar-thickness)  alu-andca self)
      ;Ï1; Now we can draw the scroll bar.Ï*
      (%draw-rectangle length  scroll-bar-thickness left (- height scroll-bar-thickness)  alu-ior self))
    ;Ï1; Make a record of the scroll bar so it can be erased correctlyÏ*
    (SETQ hor-scroll-bar (LIST left length scroll-bar-thickness))))

(DEFUN-METHOD Ï4hor-scroll-bar-eraseÏ* x-y-scroll-bars-mixin ()
  (WHEN hor-scroll-bar
    (LET ((left (FIRST hor-scroll-bar))
	  (LENGTH (SECOND hor-scroll-bar))
	  (thickness (THIRD hor-scroll-bar)))
      (prepare-sheet (self)
	(%draw-rectangle length thickness left (- height thickness) alu-andca self)
	(SEND self :refresh-margins)
	(SETQ hor-scroll-bar nil)))))

;Ï1;--------- overview-mixin -------------------------Ï*

(DEFFLAVOR Ï4overview-mixinÏ* ((shrink-factor 1)
			   (overview-window))
	   (always-deactivate-inferiors-mixin)
  (:required-flavors essential-x-y-scrolling-mixin
		     minimum-window)
  (:gettable-instance-variables overview-window shrink-factor))

(DEFMETHOD Ï4(overview-mixin :after :initÏ*) (&rest ignore)
  (SETQ overview-window (MAKE-INSTANCE 'overview-window
				       :graph-window self
				       :superior self
				       )))						    

(DEFMETHOD Ï4(overview-mixin :after :change-of-size-or-marginsÏ*) (&rest ignore)
  "Ï2Set overwiew window's new edges also.Ï*"
  (AND overview-window 
       (SEND overview-window :set-edges
	     (sheet-inside-left self)
	     (sheet-inside-top self)
	     (sheet-inside-right self)
	     (sheet-inside-bottom self))))

(DEFMETHOD Ï4(overview-mixin :mouse-clickÏ*) (b ignore ignore)
  (CASE b
     (#\mouse-m-2 (PROCESS-RUN-FUNCTION '(:name "Ï3overviewÏ*" :priority 2) 
					#'(lambda (w) (SEND w :show-overview)) self))))

(DEFMETHOD Ï4(overview-mixin :show-overviewÏ*) ()
  (SEND overview-window :set-label "Ï3Overview of Ï*")
  (SEND overview-window :expose)
  (SETQ shrink-factor (MIN (/ (SEND overview-window :inside-height) (SEND self :logical-height))
			   (/ (SEND overview-window :inside-width) (SEND self :logical-width))
			   1))
  (DOLIST (item item-list)
    (SEND item :draw-self-shrunken shrink-factor overview-window))
  ;Ï1; draw the box that represents the graph windowÏ*
  (LET* ((left (TRUNCATE (* (- x-pl-offset logical-left-edge) shrink-factor)))
	 (right (TRUNCATE (* (+ (- x-pl-offset logical-left-edge) (SEND self :inside-width)) shrink-factor)))
	 (top (TRUNCATE (* (- y-pl-offset logical-top-edge) shrink-factor)))
	 (bottom (TRUNCATE (* (+ (- y-pl-offset logical-top-edge) (SEND self :inside-height)) shrink-factor)))
	 (bwidth (- right left))
	 (bheight (- bottom top))
	 (box (SEND overview-window :box)))
    (blinker-set-cursorpos box left top)
    (blinker-set-size box bwidth bheight)
    (blinker-set-visibility box t)))

(DEFFLAVOR Ï4overview-windowÏ* 
	   (box ;Ï1; is a blinkerÏ*
	    (box-dragging-on nil)
	    graph-window
	    mouse-box-x-offset
	    mouse-box-y-offset)
	   (save-superiors-bits-mixin
	    label-mixin
	    stream-mixin
	    graphics-mixin
	    minimum-window)
  (:default-init-plist
    :label nil :blinker-p nil
    :deexposed-typeout-action :permit)
  (:gettable-instance-variables box)
  (:initable-instance-variables graph-window))

(DEFFLAVOR Ï4hollow-rectangular-stay-inside-blinkerÏ* ()
	   (stay-inside-blinker-mixin hollow-rectangular-blinker))

(DEFMETHOD Ï4(overview-window :after :initÏ*) (&rest ignore)
  (SETQ box  (make-blinker self 'hollow-rectangular-stay-inside-blinker 
				   :visibility nil)))

(DEFMETHOD Ï4(overview-window :who-line-documentation-stringÏ*) ()
  "Ï2M:  Hold down to drag box;  R:  scroll to the new position.Ï*")

(DEFMETHOD Ï4(overview-window :after :handle-mouseÏ*) (&rest ignore)
  (IF (NEQ self (window-under-mouse))
      (turn-off-box-dragging)))

(DEFMETHOD Ï4(overview-window :mouse-clickÏ*) (button x y)
  "Ï2If is a mouse-m then initiate the draggingÏ*"
    (CASE button
       (#\mouse-m (turn-on-box-dragging x y) t)
       (#\mouse-r (bury-overview-n-scroll) t)))

(DEFUN-METHOD Ï4bury-overview-n-scrollÏ* overview-window ()
  (LET ((logical-x (TRUNCATE (+ (/ (SEND box :x-pos) (SEND graph-window :shrink-factor))
				(SEND graph-window :logical-left-edge))))
	(logical-y (TRUNCATE (+ (/ (SEND box :y-pos) (SEND graph-window :shrink-factor))
				(SEND graph-window :logical-top-edge)))))
  ;Ï1; We have to deactivate and scroll in another process or the mouse process sometimesÏ*
  ;Ï1; blocks in window lock forever.Ï*
    (PROCESS-RUN-FUNCTION '(:name "Ï3deactivate and scrollÏ*" :priority 4)
			  #'(lambda (overview graph lx ly)
			      (SEND overview :deactivate)
			      (SEND graph :scroll-to lx ly))
			  self graph-window logical-x logical-y)
    ;Ï1; Give this other process a chance.Ï*
    (PROCESS-SLEEP 2)))

(DEFMETHOD Ï4(overview-window :after :mouse-movesÏ*) (x y)
  (COND (box-dragging-on
	 (COND ((= (mouse-buttons) 2)		;Ï1middle still downÏ*
		(move-box-to (+ x mouse-box-x-offset) (+ y mouse-box-y-offset))
		;Ï1; Update the offsets, they might have changed if the movement for the box was truncated.Ï*
		(SETQ mouse-box-x-offset (- (SEND box :x-pos) (+ x (sheet-inside-left self)))
		      mouse-box-y-offset (- (SEND box :y-pos) (+ y (sheet-inside-top self))))
		)
	       (t ;Ï1; else turn off draggingÏ*
		(turn-off-box-dragging))))))

(DEFUN-METHOD Ï4move-box-toÏ* overview-window (x y)
    (blinker-set-cursorpos box x y))
  
(DEFUN-METHOD Ï4turn-off-box-draggingÏ* overview-window ()
  (SETQ box-dragging-on nil))

(DEFUN-METHOD Ï4turn-on-box-draggingÏ* overview-window (x y)
  "Ï3record the mouse-box-offsets, and set the flagÏ*"
  ;Ï1; (format self "~a ~a ~a ~a ~%" x y (send box :x-pos) (send box :y-pos))Ï*
  (SETQ mouse-box-x-offset (- (SEND box :x-pos) x)
	mouse-box-y-offset (- (SEND box :y-pos) y)
	box-dragging-on t))

(DEFMETHOD Ï4(scrollable-line-item :draw-self-shrunkenÏ*) (shrink-factor overview-window)
  (SEND overview-window :draw-line
	(TRUNCATE (* (- from-x (SEND window :logical-left-edge)) shrink-factor))
	(TRUNCATE (* (- from-y (SEND window :logical-top-edge)) shrink-factor))
	(TRUNCATE (* (- to-x (SEND window :logical-left-edge)) shrink-factor))
	(TRUNCATE (* (- to-y (SEND window :logical-top-edge)) shrink-factor))))

(DEFMETHOD Ï4(scrollable-text-item :draw-self-shrunkenÏ*) (shrink-factor overview-window)
  (SEND overview-window :draw-rectangle
	(CEILING (* (- right-edge left-edge) shrink-factor))
	(CEILING (* (- bottom-edge top-edge) shrink-factor))
	(CEILING (* (- logical-x (SEND window :logical-left-edge)) shrink-factor))
	(CEILING (* (- logical-y (SEND window :logical-top-edge)) shrink-factor))))

(DEFFLAVOR Ï4always-deactivate-inferiors-mixinÏ* ()
	   ())

(DEFMETHOD Ï4(always-deactivate-inferiors-mixin :after :deexposeÏ*) (&rest ignore)
  (DOLIST (inferior (SEND self :inferiors))
    (SEND inferior :deactivate)))   

;Ï1; this flavor adapted from Rich Acuff's temporary-typeout-window-mixinÏ*

(DEFFLAVOR Ï4save-superiors-bits-mixinÏ* 
	   ((bits-covered?)
	    (covered-bits))
	   ()
  (:required-flavors essential-window))


(DEFMETHOD Ï4(save-superiors-bits-mixin :after :deexposeÏ*) (&rest ignore)
  "Ï2Restore the bits of our superior.Ï*"
  (WHEN bits-covered?
    (sheet-force-access (superior t)
      (BITBLT alu-seta width height
	      covered-bits 0 0
	      (sheet-screen-array superior) x-offset y-offset))
    (SETF bits-covered? nil)))

(DEFMETHOD Ï4(save-superiors-bits-mixin :before :exposeÏ*)
	   (&rest ignore)
  "Ï2Save the bits of our superior.Ï*"
  (IF covered-bits   ;Ï1; Been created yet?Ï*
      ;Ï1; Yes, then make sure it's big enough.Ï*
      (LET ((save-height (ARRAY-DIMENSION covered-bits 0))
	    (save-width (ARRAY-DIMENSION covered-bits 1)))
	(WHEN (OR (< save-height height)   ;Ï1; Need to grow?Ï*
		  (< save-width width))
	  (grow-bit-array covered-bits width height width
			  save-height save-width nil)))
     ;Ï1; Nothing yet, make one.Ï*
      (SETF covered-bits (make-sheet-bit-array self width height)))
  ;Ï1; Save the old stuff if it's there.Ï*
  (WHEN (sheet-screen-array superior)
    (prepare-sheet (superior)
      (BITBLT alu-seta width height
	    (sheet-screen-array superior) x-offset y-offset
	    covered-bits 0 0)
    ;Ï1; Remember we've saved something.Ï*
    (SETF bits-covered? t))))

;Ï1; --------- mouse sensitivity -------------------------------Ï*

(DEFFLAVOR Ï4mouse-sensitivity-for-instances-mixinÏ* 
	   ((item-type-alist nil)	 ;Ï1; Associates actions with types of itemsÏ*
	    menu			 ;Ï1; For when item clicked on with right buttonÏ*
	    item-blinker 
	    (mouse-sensitive-types :all)
	    (currently-boxed-item nil))			
	   ()
  (:settable-instance-variables item-type-alist mouse-sensitive-types)
  (:initable-instance-variables item-type-alist mouse-sensitive-types)
  (:gettable-instance-variables item-blinker currently-boxed-item)
  (:required-flavors essential-x-y-scrolling-mixin))

(DEFMETHOD Ï4(mouse-sensitivity-for-instances-mixin :after :initÏ*) (IGNORE)
  "Ï2Make a pop-up menu.Ï*"
  (setq	menu (make-window 'momentary-menu ':superior self)
	item-blinker (make-blinker self 'hollow-rectangular-blinker
				   :visibility nil)))

(DEFMETHOD Ï4(mouse-sensitivity-for-instances-mixin :after :handle-mouseÏ*) (&rest ignore)
  (WHEN currently-boxed-item
    (SEND currently-boxed-item :erase-boxing)
    (SETQ currently-boxed-item nil)))

(DEFMETHOD Ï4(mouse-sensitivity-for-instances-mixin :current-mouse-sensitve-type-pÏ*) (type)
  (AND (OR (EQL mouse-sensitive-types :all)
	   (AND (LISTP mouse-sensitive-types)
		(MEMBER type mouse-sensitive-types)))
       (ASSOC type item-type-alist :test #'EQ)))

(DEFMETHOD Ï4(mouse-sensitivity-for-instances-mixin :after :mouse-movesÏ*) (x y)  ;Ï1;x and y are in outside coordinatesÏ*
  "Ï2display the boxing around the item under the mouse cursorÏ*"
  (UNLESS (SEND self :dragging-screen-p)
    (LET ((logical-mouse-x (- (+ x x-pl-offset) (sheet-inside-left self)))
	  (logical-mouse-y (- (+ y y-pl-offset) (sheet-inside-top self))))
      (COND (;Ï1; If scrolling is in, erase any boxingÏ*
	     (OR hor-scrolling-in-effect ver-scrolling-in-effect)
	     (AND currently-boxed-item (SEND currently-boxed-item :erase-boxing))
	     (SETQ currently-boxed-item nil))
	    ((NOT currently-boxed-item) ;Ï1; If nothing is boxed, look for something.Ï*
	     (DOLIST (item item-list)
	       (IF (SEND item :draw-boxing-maybe logical-mouse-x logical-mouse-y)
		   (RETURN (SETQ currently-boxed-item item)))))
	    ((SEND currently-boxed-item :boxing-appropriate-p logical-mouse-x logical-mouse-y))	;Ï1; then do nothingÏ*
	    (t (SEND currently-boxed-item :erase-boxing)	;Ï1; else we must have moved off the currently-boxed-itemÏ*
	       (SETQ currently-boxed-item nil))))))

(DEFMETHOD Ï4(mouse-sensitivity-for-instances-mixin :who-line-documentation-stringÏ*) ()
  (WHEN currently-boxed-item
    (LET ((DOCUMENTATION (THIRD (ASSOC (SEND currently-boxed-item :mouse-sensitive-type) item-type-alist :test #'EQ))))
      (COND ((STRINGP documentation) documentation)
	    ((CONSP   documentation)
	     (FUNCALL (CAR documentation) (SEND currently-boxed-item :item)))))))


(DEFMETHOD Ï4(mouse-sensitivity-for-instances-mixin :mouse-clickÏ*) (button ignore ignore)
  "Ï2Mouse-left selects the blinking item, mouse-right pops up a menu near it.Ï*"
  ;Ï1; This code filched from basic-mouse-sensitive-itemsÏ*
  (WHEN currently-boxed-item
    (LET ((item-type (ASSOC (SEND currently-boxed-item :mouse-sensitive-type) item-type-alist :test #'EQ)))
      (WHEN item-type
	(CASE button
	  (#\Mouse-l-1
	   ;Ï1; Form the blip and stuff it into the keyboard buffer.Ï*
	   (SEND self ':force-kbd-input
			 (LIST ':typeout-execute (CADR item-type) (SEND currently-boxed-item :item))))
	  (#\Mouse-r-1
	   (PROCESS-RUN-FUNCTION
	     "Ï3Menu ChooseÏ*" #'choose-an-operation
	     menu (CDDDR item-type) self currently-boxed-item
	     ;Ï1; Compute a label for the menu.Ï*
	     (OR (AND (CONSP (THIRD item-type))
		      (CADR (THIRD item-type))
		      (FUNCALL (CADR (THIRD item-type))
			       (SEND currently-boxed-item :item)))))))))))



(DEFUN Ï4choose-an-operationÏ* (menu alist window item menu-label)
;Ï1; Code from typeout-menu-chooseÏ*
   "Ï2Select a thing to do to mouse-sensitive item TYPEOUT-ITEM.
  ALISTÏ*			Ï2menu item-list to be displayed in MENU.
  item                    is an instance of a scrollable-item
  MENU-LABELÏ*		Ï2a string to display as the menu's label, or NILÏ*
			Ï2  for no label.
  The user's choice is processed by forcing input of the same sort as is
  done by clicking left on the typeout-item, ie like:Ï*
	Ï2(:TYPEOUT-EXECUTE operation item-information).Ï*"
  (LET ((old-x mouse-x)	
	(old-y mouse-y))
    (FUNCALL menu ':set-label menu-label)
    (FUNCALL menu ':set-item-list alist)
    (move-window-near-rectangle menu  ;Ï1; put the following in physcial coordinates.Ï*
				(- (SEND item :left-edge)(SEND window :x-pl-offset))
				(- (SEND item :top-edge) (SEND window :y-pl-offset))
				(- (SEND item :right-edge) (SEND window :x-pl-offset))
				(- (SEND item :bottom-edge) (SEND window :y-pl-offset)))
    (LET ((choice-result (FUNCALL menu ':choose)))
      (AND choice-result
	   (FUNCALL window :force-kbd-input
		    (LIST :typeout-execute choice-result
			  (SEND item :item)))))
    (IGNORE old-x old-y)
    (mouse-standard-blinker window)
    (SEND window :mouse-moves mouse-x mouse-y)))

;Ï1;------- basic-mouse-sensitive-items-compatibility-mixin ---------------Ï*

(DEFFLAVOR Ï4basic-mouse-sensitive-items-compatibility-mixinÏ* () ()
  (:required-instance-variables cursor-x cursor-y item-list))

(DEFMETHOD Ï4(basic-mouse-sensitive-items-compatibility-mixin  :itemÏ*) (type item &rest args)
  "Ï2Does the same as basic-mouse-sensitive-items :item method. ie. it outputs a mouse
   sensitive item at the cursor.Ï*"
  
  ;Ï1; that ol' &rest bug. the lambda exp. blows up later on.Ï*
  (SETQ args (COPY-LIST args))
  
  (COND ((NOT args)
	 (SEND self :scrollable-text-item item
	            :mouse-sensitive-type type
		    :coordinate-type :physical
		    :pre-print-item-modify-function #'(lambda (item)
							(ETYPECASE item
							  (STRING item)
							  (symbol (SYMBOL-NAME item))
							  (instance (SEND item :string-for-printing)))))
	 (PRINC item self)) ;Ï1; Print it again just to move the cursor over.Ï*
	(t (SEND self :scrollable-text-item item
		 :mouse-sensitive-type type
		 :coordinate-type :physical
		 :pre-print-item-modify-function
		 #'(lambda (IGNORE)
		     (APPLY #'FORMAT nil args)))
	   (APPLY #'FORMAT self args)))) ;Ï1; Print it again just to move the cursor over.Ï*

(DEFMETHOD Ï4(basic-mouse-sensitive-items-compatibility-mixin  :extended-itemÏ*) (type item &rest args)
  (APPLY self :item type item args))

(DEFMETHOD Ï4(basic-mouse-sensitive-items-compatibility-mixin  :after :clear-screenÏ*) ()
  (SEND self :re-initialize))

;Ï1;----------- ver-auto-scrolling-mixin -----------------Ï*

(DEFFLAVOR Ï4ver-auto-scrolling-mixinÏ* 
	   ((increment :half)
	    pixel-increment)
	   ()
  (:required-methods :scroll-to)
  (:required-flavors sheet)
  (:initable-instance-variables increment))

(DEFMETHOD Ï4(ver-auto-scrolling-mixin :after :initÏ*) (&rest ignore)
  (SEND self :verify-n-set-pixel-increment))

(DEFMETHOD Ï4(ver-auto-scrolling-mixin :after :change-of-size-or-marginsÏ*) (&rest ignore)
  (SEND self :verify-n-set-pixel-increment))

(DEFMETHOD Ï4(ver-auto-scrolling-mixin :set-incrementÏ*) (new-increment-value)
  "Ï2New-value can be a number in pixels, or one of the keywords:
  :whole :half :quarter. Increment is truncated to a multiple of the line heightÏ*"
  (SETQ increment new-increment-value)
  (SEND self :verify-n-set-pixel-increment))

(DEFMETHOD Ï4(ver-auto-scrolling-mixin :verify-n-set-pixel-incrementÏ*) ()
  (CASE increment
     (:whole (SETQ pixel-increment (SEND self :inside-height)))
     (:half (SETQ pixel-increment (TRUNCATE (SEND self :inside-height) 2)))
     (:quarter (SETQ pixel-increment (TRUNCATE (SEND self :inside-height) 4))))
  (UNLESS (< 0 pixel-increment (SEND self :inside-height))
    (CERROR "Ï3Continue with the increment set to half the window heightÏ*"
	    "Ï3the scrolling increment, ~a, is not between 0 and the window height, ~a.Ï*"
	    pixel-increment (SEND self :inside-height))
    (IF (NOT (< 0 pixel-increment (SEND self :inside-height)))
	(SETQ pixel-increment (TRUNCATE (SEND self :inside-height) 2)))))

(DEFMETHOD Ï4(ver-auto-scrolling-mixin :end-of-page-exceptionÏ*) ()
  "Ï2Redefines sheet's :end-of-page-exception method to scroll up by increment.Ï*"
  (COND ((NOT (ZEROP (sheet-end-page-flag)))
	 (LET ((m-vp more-vpos))
	   ;Ï1; do the next two things instead of (sheet-home self)Ï*
	   (SEND self :scroll-relative
		 0		              
		 pixel-increment	                      
		 nil) ;Ï1; nil means expand the logical windowÏ*
	   (SETF (sheet-exceptions self) 0)
	   (sheet-clear-eol self)
	   ;Ï1; Arrange for more processing next time aroundÏ*
	   (COND ((NULL m-vp))			      ;Ï1; No more processing at allÏ*
		 ((>= m-vp 100000)		      ;Ï1; More processing delayed?Ï*
		  (SETQ more-vpos (- m-vp 100000)))   ;Ï1; Cause to happen next time around.Ï*
		 (t (SETQ more-vpos (sheet-deduce-more-vpos self))))))))

;Ï1;-------- speed initial window creation up -------------

Ï*(COMPILE-FLAVOR-METHODS basic-x-y-scrolling-window)