(FILECREATED " 1-Aug-85 18:34:18" {PHYLUM}<LANNING>LISP>USERS>FILEPERCENT.;4
 5517   

      changes to:  (FNS GetPercentWindow ShowPercent ClosePercentWindow NewLoad ReadInLoad)

      previous date: "26-Jul-85 18:56:53" {PHYLUM}<LANNING>LISP>USERS>FILEPERCENT.;3)


(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT FILEPERCENTCOMS)

(RPAQQ FILEPERCENTCOMS
 [(* * First some generic stuff to show percent windows)
			(FNS ClosePercentWindow GetPercentWindow ShowPercent)
			(VARS (PercentWindowBottoms (LIST SCREENHEIGHT)))
			(* * Enable the percent window for LOADing files)
			(FNS NewLoad ReadInLoad)
			(P (* This ridiculous stuff is needed in case LOAD is already advised!)
			   (LET [(fn (OR (GETPROP (QUOTE LOAD)
						  (QUOTE ADVISED))
					 (QUOTE LOAD]
				(MOVD? fn (QUOTE OldLoadBeforePercentStuff))
				(/MOVD (QUOTE NewLoad)
				       fn)
				(CHANGENAME (QUOTE OldLoadBeforePercentStuff)
					    (QUOTE READ)
					    (QUOTE ReadInLoad))
				(UNDOSAVE (QUOTE (CHANGENAME OldLoadBeforePercentStuff ReadInLoad 
							     READ)))
				(CHANGENAME (QUOTE LAPRD)
					    (QUOTE READ)
					    (QUOTE ReadInLoad))
				(UNDOSAVE (QUOTE (CHANGENAME LAPRD ReadInLoad READ])
(* * First some generic stuff to show percent windows)


(DEFINEQ

(ClosePercentWindow

  [LAMBDA (window)                                           (* smL " 1-Aug-85 17:44")


          (* * Get rid of the percent window)



    (DECLARE
 (
GLOBALVARS
 PercentWindowBottoms))
    (if
 (
WINDOWP
 window)
	then
 (
CLOSEW
 window)
	     (
SETQ
 PercentWindowBottoms (
DREMOVE
 (fetch
 BOTTOM of
 (
WINDOWPROP
 window (
QUOTE
 REGION)))
						 PercentWindowBottoms])

(GetPercentWindow

  [LAMBDA (title maximum)                                    (* smL " 1-Aug-85 17:41")


          (* * Get the next percent window)



    (DECLARE
 (
GLOBALVARS
 SCREENWIDTH GRAYSHADE PercentWindowBottoms))
    (LET ((percentWindowHeight (
HEIGHTIFWINDOW
 10 T))
       (percentWindowWidth (
WIDTHIFWINDOW
 100)))
      (LET ((window (
CREATEW
 (
CREATEREGION
 (
DIFFERENCE
 (
SUB1
 SCREENWIDTH)
						       percentWindowWidth)
					   (
CAR
 (push
 PercentWindowBottoms (
DIFFERENCE
 (
CAR
 
									     PercentWindowBottoms)
										       
									      percentWindowHeight)))
					   percentWindowWidth percentWindowHeight)
			     title)))
	(
BITBLT
 NIL NIL NIL window NIL NIL NIL NIL (
QUOTE
 TEXTURE)
		(
QUOTE
 INPUT)
		GRAYSHADE)
	(
WINDOWPROP
 window (
QUOTE
 Percent)
		    0)
	(
WINDOWPROP
 window (
QUOTE
 maximum)
		    maximum)
	window])

(ShowPercent

  [LAMBDA (currentSize statusWindow)                         (* smL " 1-Aug-85 17:55")


          (* * Black out percent of statusWindow)



    (DECLARE
 (
GLOBALVARS
 BLACKSHADE GRAYSHADE))
    (if
 (
AND
 (
WINDOWP
 statusWindow)
	     (
WINDOWPROP
 statusWindow (
QUOTE
 Percent)))
	then
 (LET [(percent (
QUOTIENT
 (
TIMES
 100 currentSize)
				      (
WINDOWPROP
 statusWindow (
QUOTE
 maximum]
	       (
BITBLT
 NIL NIL NIL statusWindow NIL NIL percent NIL (
QUOTE
 TEXTURE)
		       (
QUOTE
 INPUT)
		       BLACKSHADE)
	       (
BITBLT
 NIL NIL NIL statusWindow percent NIL NIL NIL (
QUOTE
 TEXTURE)
		       (
QUOTE
 INPUT)
		       GRAYSHADE)
	       (
WINDOWPROP
 statusWindow (
QUOTE
 Percent)
			   percent])
)

(RPAQ PercentWindowBottoms
 (LIST SCREENHEIGHT))
(* * Enable the percent window for LOADing files)


(DEFINEQ

(NewLoad

  [LAMBDA (
FILE
 LDFLG PRINTFLG)                              (* smL " 1-Aug-85 18:34")


          (* * Updates the percent completed window)



    (DECLARE
 (
SPECVARS
 LoadStatusWindow))
    (LET* ((fullFileName (
FINDFILE
 FILE))
       [loadFileLength (
AND
 fullFileName (
GETFILEINFO
 fullFileName (
QUOTE
 LENGTH]
       LoadStatusWindow)
      (
RESETLST
 [
RESETSAVE
 (if
 (
WINDOWP
 LoadStatusWindow)
			       then
 (
WINDOWPROP
 LoadStatusWindow (
QUOTE
 loadFile)
						fullFileName))
			   (
LIST
 (
FUNCTION
 ClosePercentWindow)
				 (
SETQ
 LoadStatusWindow (
AND
 loadFileLength
							     (GetPercentWindow

							       (
CONCAT
 "file " (
FILENAMEFIELD

									 fullFileName
									 (
QUOTE
 NAME)))
							       loadFileLength]
		(
OldLoadBeforePercentStuff
 (
OR
 fullFileName FILE)
					   LDFLG PRINTFLG])

(ReadInLoad

  [LAMBDA (
FILE
 RDTBL FLG)                                   (* smL " 1-Aug-85 18:26")


          (* * Adds a little advise to READ in LOAD to update the percent window)



    (DECLARE
 (
SPECVARS
 LoadStatusWindow))
    (if
 (
BOUNDP
 (
QUOTE
 LoadStatusWindow))
	then
 (ShowPercent
 (
GETFILEPTR
 FILE)
			  LoadStatusWindow))
    (
READ
 FILE RDTBL FLG])
)
(* This ridiculous stuff is needed in case LOAD is already advised!)
[LET [(fn (OR (GETPROP (QUOTE LOAD)
		       (QUOTE ADVISED))
	      (QUOTE LOAD]
     (MOVD? fn (QUOTE OldLoadBeforePercentStuff))
     (/MOVD (QUOTE NewLoad)
	    fn)
     (CHANGENAME (QUOTE OldLoadBeforePercentStuff)
		 (QUOTE READ)
		 (QUOTE ReadInLoad))
     (UNDOSAVE (QUOTE (CHANGENAME OldLoadBeforePercentStuff ReadInLoad READ)))
     (CHANGENAME (QUOTE LAPRD)
		 (QUOTE READ)
		 (QUOTE ReadInLoad))
     (UNDOSAVE (QUOTE (CHANGENAME LAPRD ReadInLoad READ]
(PUTPROPS FILEPERCENT COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1291 3460 (ClosePercentWindow 1301 . 1736) (GetPercentWindow 1738 . 2667) (ShowPercent 
2669 . 3458)) (3570 4901 (NewLoad 3580 . 4490) (ReadInLoad 4492 . 4899)))))
STOP