;;; -*- Mode:Common-Lisp; Package:TV; Base:10; Fonts:(TVFONT TR10 HL10 TR10I TR10B) -*-

;;; **********************************************************************
;;; Copyright (c) 1990 Stanford University.
;;; Copyright is held by Stanford University except where code has been
;;; modified from TI source code.  In these cases TI code is marked with
;;; a suitable comment.  Where functionality implemented herein replicates
;;; similarly named functionality on Symbolics machines, this code was
;;; developed solely from the interface specification in the documentation
;;; or through guesswork, never by examination of Symbolics source code.

;;; All Stanford Copyright code is in the public domain.  This code may be
;;; distributed and used without restriction as long as this copyright
;;; notice is included and no fee is charged.  This can be thought of as
;;; being equivalent to the Free Software Foundation's Copyleft policy.

;;; TI source code may only be distributed to users who hold valid TI
;;; software licenses.
;;; **********************************************************************

(defmacro with-positioning-flag-set (&rest forms)
  `(progn (setq being-positioned-p t)
	  (unwind-protect (progn ,@forms)
	    (setq being-positioned-p nil))))

(defmacro with-drawing-flag-set (&rest forms)
  `(progn (setq being-drawn-p t)
	  (unwind-protect (progn ,@forms)
	    (setq being-drawn-p nil))))

(defmacro with-moving-flag-set (&rest forms)
  `(progn (setq being-moved-p t)
	  (unwind-protect (progn ,@forms)
	    (setq being-moved-p nil))))

(defmacro with-getting-descendents-flag-set (&rest forms)
  `(progn (setq getting-descendents-p t)
	  (unwind-protect (progn ,@forms)
	    (setq getting-descendents-p nil))))


(1defmacro* with-xor-type-alus ((window) &body body)
 `(1let* ((*draw-alu-to-use*
	  (1if* (color-system-p ,window) alu-add alu-xor)
	)
        (2*erase-alu-to-use**
	  (1if* (color-system-p ,window) alu-sub alu-xor)
	)
       )
       (declare (special *draw-alu-to-use* 2*erase-alu-to-use**))
       ,@body
  )
)

(1def*macro hor-scroll-bar (position)
  `(1nth* (1progn* (1if* (1equal* (1length* hor-scroll-bar) 2)
		  nil
		  (1setq* hor-scroll-bar (1list* nil nil))
	       )
	       (1case* ,position
		 (:Bottom 0)
		 (:Top 1)
	       )
        )
        hor-scroll-bar
   )
)

(1def*macro ver-scroll-bar (position)
  `(1nth* (1progn* (1if* (1equal* (1length* ver-scroll-bar) 2)
		  nil
		  (1setq* ver-scroll-bar (1list* nil nil))
	       )
	       (1case* ,position
		 (:Left 0)
		 (:Right 1)
	       )
        )
        ver-scroll-bar
   )
)

;-------------------------------------------------------------------------------

;;; Some vars too.

(1defvar* 2*Force-On-Screen-P** Nil)