(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP" BASE 10)
(FILECREATED "19-Oct-87 12:36:56" "{FireFS:CS:Univ Rochester}<koomen>LispUsers>Lyric>FILEWATCH.;12" 57289
changes to%: (VARS FILEWATCHCOMS)
previous date%: "30-Sep-87 12:06:45"
"{FireFS:CS:Univ Rochester}<koomen>LispUsers>Lyric>FILEWATCH.;11")
(* "
Copyright (c) 1986, 1987 by Johannes A. G. M. Koomen. All rights reserved.
")
(PRETTYCOMPRINT FILEWATCHCOMS)
(RPAQQ FILEWATCHCOMS
[(PROP MAKEFILE-ENVIRONMENT FILEWATCH)
(* ;;; "FILEWATCH is a facility for keeping an eye on the status of open files. It maintains a display containing the names of open files and their file pointer positions including a percentage bar.")
(* ;;; "Interface")
(FNS FILEWATCH FILEWATCHPROP)
(* ;;; "Implementation")
(COMS (DECLARE%: DONTCOPY (RECORDS FW-OFD))
(INITRECORDS FW-OFD))
(FNS FW-ADJUST-PLACEMENT FW-ADJUST-REGION FW-AFTERMOVEFN FW-BUTTONEVENTFN FW-CHANGE-ANCHOR
FW-CHANGE-JUSTIFICATION FW-CHANGE-POSITION FW-CLOSE-CMD FW-CLOSE-OLD-OFD-WINDOWS
FW-CLOSEFN FW-CREATE-OFD FW-CREATE-OFD-LIST FW-CREATE-OFD-WINDOWS FW-CREATEW
FW-FILTERED-FILE? FW-FORGET-CMD FW-INIT FW-INIT-MENUS FW-INIT-PROPS FW-INTERACT FW-LOOP
FW-MOVE-OFD-WINDOWS FW-MOVEW FW-OFD-EXISTS? FW-OPENP FW-PERCENTAGE FW-RE-INIT
FW-RECALL-CMD FW-REPAINTFN FW-RESET FW-RESIZE-OFD FW-SHAPEW FW-SORT-FN
FW-UPDATE-OFD-WINDOW FW-UPDATE-OFD-WINDOWS FW-WIPE)
(DECLARE%: DONTCOPY DONTEVAL@LOAD EVAL@COMPILE (FILES (SOURCE FROM LISPUSERS)
SYSEDIT))
[INITVARS (FW-OFDList NIL)
(FW-OpenP-ScratchList (CONS))
(FW-Commands '(FORGET FORGET-MANY RECALL RECALL-MANY CLOSE CLOSE-MANY MOVE SET-ANCHOR
SET-POSITION SET-JUSTIFICATION QUIT))
(FW-Properties `(FONT (GACHA 8)
ALL-FILES? NIL POSITION ,(CREATEPOSITION SCREENWIDTH 0) ANCHOR
BOTTOM-RIGHT SHADE ,GRAYSHADE INTERVAL 1000]
(P (FW-INIT-MENUS))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA FILEWATCHPROP])
(PUTPROPS FILEWATCH MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP" :BASE 10))
(* ;;;
"FILEWATCH is a facility for keeping an eye on the status of open files. It maintains a display containing the names of open files and their file pointer positions including a percentage bar."
)
(* ;;; "Interface")
(DEFINEQ
(FILEWATCH
[LAMBDA (COMMAND) (* Koomen "15-May-87 01:47")
(DECLARE (GLOBALVARS FW-Running?))
(PROG [(FW-PROC (FIND.PROCESS 'FileWatcher]
(SELECTQ (SELECTQ [if (OR (LITATOM COMMAND)
(STRINGP COMMAND))
then (SETQ COMMAND (MKATOM (U-CASE COMMAND]
(ON (if (NULL FW-PROC)
then 'ON))
((OFF QUIT)
(if FW-PROC
then (SETQ COMMAND 'OFF)))
(MENU (SETQ COMMAND NIL)
'MENU)
(if (OR COMMAND FW-PROC)
then 'MENU
else 'ON))
(ON (SETQ FW-PROC (ADD.PROCESS (LIST (FUNCTION FW-LOOP))
'NAME
'FileWatcher
'RESTARTABLE
'HARDRESET)))
(OFF (SETQ FW-PROC (SETQ FW-Running? NIL)))
(MENU (if (NULL FW-PROC)
then (FILEWATCH 'ON)
(BLOCK))
(FW-INTERACT NIL COMMAND))
NIL)
(RETURN FW-PROC])
(FILEWATCHPROP
[LAMBDA FILEWATCH#ARGS (* Koomen "12-Jan-87 21:31")
(DECLARE (GLOBALVARS FW-Properties FW-ReInit?))
(if (EQ FILEWATCH#ARGS 1)
then (LET ((PROPNAME (ARG FILEWATCH#ARGS 1)))
(LISTGET FW-Properties PROPNAME))
elseif (EQ FILEWATCH#ARGS 2)
then (LET* ((PROPNAME (ARG FILEWATCH#ARGS 1))
(PROPVALUE (ARG FILEWATCH#ARGS 2))
(OLDPROPVALUE (LISTGET FW-Properties PROPNAME)))
(if (NOT (EQUAL PROPVALUE OLDPROPVALUE))
then (LISTPUT FW-Properties PROPNAME PROPVALUE)
(SETQ FW-ReInit? T))
OLDPROPVALUE)
else (ERROR "FILEWATCH: Expecting 1 or 2 args -- " FILEWATCH#ARGS])
)
(* ;;; "Implementation")
(DECLARE%: DONTCOPY
(DECLARE%: EVAL@COMPILE
(DATATYPE FW-OFD
(FILESTREAM FULLNAME NAMEWIDTH LEFT BOTTOM WIDTH HEIGHT OFDLEFT OFDBOTTOM OFDWIDTH
OFDHEIGHT OFDWINDOW OFDSTREAM OFDSTATUS CURPOS EOFPOS PCTPOS CURPOSXOFFSET
EOFPOSXOFFSET PCTPOSXOFFSET ACCESSXOFFSET PCTREGION READING? WRITING? RANDOM?))
)
(/DECLAREDATATYPE 'FW-OFD
'(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER)
'((FW-OFD 0 POINTER)
(FW-OFD 2 POINTER)
(FW-OFD 4 POINTER)
(FW-OFD 6 POINTER)
(FW-OFD 8 POINTER)
(FW-OFD 10 POINTER)
(FW-OFD 12 POINTER)
(FW-OFD 14 POINTER)
(FW-OFD 16 POINTER)
(FW-OFD 18 POINTER)
(FW-OFD 20 POINTER)
(FW-OFD 22 POINTER)
(FW-OFD 24 POINTER)
(FW-OFD 26 POINTER)
(FW-OFD 28 POINTER)
(FW-OFD 30 POINTER)
(FW-OFD 32 POINTER)
(FW-OFD 34 POINTER)
(FW-OFD 36 POINTER)
(FW-OFD 38 POINTER)
(FW-OFD 40 POINTER)
(FW-OFD 42 POINTER)
(FW-OFD 44 POINTER)
(FW-OFD 46 POINTER)
(FW-OFD 48 POINTER))
'50)
)
(/DECLAREDATATYPE 'FW-OFD
'(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER)
'((FW-OFD 0 POINTER)
(FW-OFD 2 POINTER)
(FW-OFD 4 POINTER)
(FW-OFD 6 POINTER)
(FW-OFD 8 POINTER)
(FW-OFD 10 POINTER)
(FW-OFD 12 POINTER)
(FW-OFD 14 POINTER)
(FW-OFD 16 POINTER)
(FW-OFD 18 POINTER)
(FW-OFD 20 POINTER)
(FW-OFD 22 POINTER)
(FW-OFD 24 POINTER)
(FW-OFD 26 POINTER)
(FW-OFD 28 POINTER)
(FW-OFD 30 POINTER)
(FW-OFD 32 POINTER)
(FW-OFD 34 POINTER)
(FW-OFD 36 POINTER)
(FW-OFD 38 POINTER)
(FW-OFD 40 POINTER)
(FW-OFD 42 POINTER)
(FW-OFD 44 POINTER)
(FW-OFD 46 POINTER)
(FW-OFD 48 POINTER))
'50)
(DEFINEQ
(FW-ADJUST-PLACEMENT
[LAMBDA (OFDLIST) (* Koomen "12-Jan-87 21:19")
(* * Recursively (post-order) position each window, so that the first element
ends up on top of the display. Note that, for downward-growing lists, the
sorter actually forces reverse sort.)
(DECLARE (GLOBALVARS FW-WindowBottom FW-WindowBottomDelta))
(if OFDLIST
then (FW-ADJUST-PLACEMENT (CDR OFDLIST))
(PROG ((OFD (CAR OFDLIST)))
(SELECTQ (fetch (FW-OFD OFDSTATUS) of OFD)
((NEW CURRENT)
(replace (FW-OFD BOTTOM) of OFD with FW-WindowBottom)
(if (OR (NEQ (fetch (FW-OFD OFDWIDTH) of OFD)
(fetch (FW-OFD WIDTH) of OFD))
(NEQ (fetch (FW-OFD OFDHEIGHT) of OFD)
(fetch (FW-OFD HEIGHT) of OFD)))
then (FW-SHAPEW OFD)
(replace (FW-OFD OFDSTATUS) of OFD with 'NEW)
elseif (OR (NEQ (fetch (FW-OFD LEFT) of OFD)
(fetch (FW-OFD OFDLEFT) of OFD))
(NEQ (fetch (FW-OFD BOTTOM) of OFD)
(fetch (FW-OFD OFDBOTTOM) of OFD)))
then (FW-MOVEW OFD))
(SETQ FW-WindowBottom (IPLUS FW-WindowBottom FW-WindowBottomDelta)))
(FORGOTTEN)
(SHOULDNT (CONS "Unexpected OFDSTATUS : " (fetch (FW-OFD OFDSTATUS)
of OFD])
(FW-ADJUST-REGION
[LAMBDA NIL (* Koomen "12-Jan-87 21:29")
(DECLARE (GLOBALVARS FW-Anchor FW-Justified? FW-OFDList FW-Position FW-WindowBottom
FW-WindowBottomDelta FW-WindowHeight WBorder))
[if FW-Justified?
then (* Recompute maximum name field width)
(PROG (NAMEWIDTH (MAXNAMEWIDTH 0))
[for OFD in FW-OFDList do (SELECTQ (fetch (FW-OFD OFDSTATUS) of OFD)
((NEW CURRENT)
(SETQ NAMEWIDTH (fetch (FW-OFD NAMEWIDTH)
of OFD))
(if (IGREATERP NAMEWIDTH MAXNAMEWIDTH)
then (SETQ MAXNAMEWIDTH NAMEWIDTH)))
(FORGOTTEN)
(SHOULDNT (CONS "Unexpected OFDSTATUS : "
(fetch (FW-OFD OFDSTATUS)
of OFD]
(for OFD in FW-OFDList do (FW-RESIZE-OFD OFD MAXNAMEWIDTH]
(SETQ FW-WindowBottom (fetch (POSITION YCOORD) of FW-Position))
(SETQ FW-WindowBottomDelta (IDIFFERENCE FW-WindowHeight (IQUOTIENT WBorder 2)))
(SELECTQ FW-Anchor
((TOP-LEFT TOP-RIGHT)
(SETQ FW-WindowBottom (IDIFFERENCE FW-WindowBottom FW-WindowHeight))
(SETQ FW-WindowBottomDelta (IMINUS FW-WindowBottomDelta)))
((BOTTOM-LEFT BOTTOM-RIGHT))
(ERROR "Unsupported anchor spec: " FW-Anchor])
(FW-AFTERMOVEFN
[LAMBDA (W) (* ; "Edited 30-Sep-87 11:53 by Koomen")
(* ;; "[30-Sep-87] Added FW-Dormant? flag: If moving a FileWatch window causes the FileWatch anchor position to move off the screen, then go to sleep. This is to accomodate the Rooms package.")
(DECLARE (GLOBALVARS FW-Dormant? FW-OFDList SCREENHEIGHT SCREENWIDTH))
(SETQ FW-Dormant? NIL)
(if (NEQ 'FileWatcher (PROCESS.NAME (THIS.PROCESS)))
then (for OFD in FW-OFDList when (EQ W (fetch (FW-OFD OFDWINDOW) of OFD))
bind REGION DELTAX DELTAY OLDPOS NEWX NEWY
do (SETQ OLDPOS (FILEWATCHPROP 'POSITION))
(SETQ REGION (WINDOWREGION W))
(SETQ DELTAX (IDIFFERENCE (fetch (REGION LEFT) of REGION)
(fetch (FW-OFD OFDLEFT) of OFD)))
(SETQ NEWX (IPLUS DELTAX (fetch (POSITION XCOORD) of OLDPOS)))
(SETQ DELTAY (IDIFFERENCE (fetch (REGION BOTTOM) of REGION)
(fetch (FW-OFD OFDBOTTOM) of OFD)))
(SETQ NEWY (IPLUS DELTAY (fetch (POSITION YCOORD) of OLDPOS)))
(if (OR (ILESSP NEWX 0)
(IGREATERP NEWX SCREENWIDTH)
(ILESSP NEWY 0)
(IGREATERP NEWY SCREENHEIGHT))
then (SETQ FW-Dormant? T)
else (FILEWATCHPROP 'POSITION (create POSITION
XCOORD ← NEWX
YCOORD ← NEWY)))
(RETURN])
(FW-BUTTONEVENTFN
[LAMBDA (W) (* Koomen "16-Apr-87 15:28")
(DECLARE (GLOBALVARS LASTMOUSEBUTTONS))
(if (MOUSESTATE (ONLY RIGHT))
then (FW-INTERACT W)
elseif (MOUSESTATE (ONLY MIDDLE))
then (FW-MOVE-OFD-WINDOWS 'POSITION)
elseif (MOUSESTATE (ONLY LEFT))
then (FW-REPAINTFN W))
NIL])
(FW-CHANGE-ANCHOR
[LAMBDA NIL (* Koomen "16-Apr-87 15:55")
(DECLARE (GLOBALVARS PROMPTWINDOW))
(PROG [NEWANCHOR (OLDANCHOR (FILEWATCHPROP 'ANCHOR]
(CLRPROMPT)
(printout PROMPTWINDOW "Current anchor is " OLDANCHOR T T)
(printout PROMPTWINDOW "Indicate new anchor: ")
[SETQ NEWANCHOR (MENU (create MENU
CENTERFLG ← T
TITLE ← "Anchor: "
ITEMS ← '(("Top Left" 'TOP-LEFT)
("Top Right" 'TOP-RIGHT)
("Bottom Left" 'BOTTOM-LEFT)
("Bottom Right" 'BOTTOM-RIGHT]
(if (AND NEWANCHOR (NEQ NEWANCHOR OLDANCHOR))
then (FILEWATCHPROP 'ANCHOR NEWANCHOR])
(FW-CHANGE-JUSTIFICATION
[LAMBDA NIL (* Koomen "16-Apr-87 15:55")
(DECLARE (GLOBALVARS PROMPTWINDOW))
(PROG [NEWJUST? (OLDJUST? (FILEWATCHPROP 'JUSTIFIED?]
(CLRPROMPT)
(printout PROMPTWINDOW "Window justification is " OLDJUST? T T)
(SETQ NEWJUST? (MOUSECONFIRM "Turn justification on?"))
(if (NEQ NEWJUST? OLDJUST?)
then (FILEWATCHPROP 'JUSTIFIED? NEWJUST?])
(FW-CHANGE-POSITION
[LAMBDA NIL (* Koomen "16-Apr-87 15:48")
(DECLARE (GLOBALVARS FW-OFDList PROMPTWINDOW))
(PROG ((OLDPOS (FILEWATCHPROP 'POSITION))
NEWPOS BOX R)
(for OFD in FW-OFDList when (EQ (fetch (FW-OFD OFDSTATUS) of OFD)
'CURRENT) do (SETQ R (WINDOWREGION (fetch (FW-OFD OFDWINDOW
)
of OFD)))
(SETQ BOX (if BOX
then (UNIONREGIONS BOX R)
else R)))
(if BOX
then (SETQ NEWPOS (GETBOXPOSITION (fetch (REGION WIDTH) of BOX)
(fetch (REGION HEIGHT) of BOX)
(fetch (REGION LEFT) of BOX)
(fetch (REGION BOTTOM) of BOX)))
(* ;; "Now translate since anchor may not have been bottom-left")
[SETQ NEWPOS (create POSITION
XCOORD ← (IPLUS (fetch (POSITION XCOORD) of OLDPOS)
(IDIFFERENCE (fetch (POSITION XCOORD)
of NEWPOS)
(fetch (REGION LEFT) of BOX)))
YCOORD ← (IPLUS (fetch (POSITION YCOORD) of OLDPOS)
(IDIFFERENCE (fetch (POSITION YCOORD)
of NEWPOS)
(fetch (REGION BOTTOM) of BOX]
else (CLRPROMPT)
(printout PROMPTWINDOW "Current position is " OLDPOS T T)
(printout PROMPTWINDOW "Indicate new position: ")
(SETQ NEWPOS (GETPOSITION)))
(if (NOT (EQUAL NEWPOS OLDPOS))
then (FILEWATCHPROP 'POSITION NEWPOS])
(FW-CLOSE-CMD
[LAMBDA (W MANY?) (* ; "Edited 22-Sep-87 11:50 by Koomen")
(DECLARE (GLOBALVARS FW-OFDList))
(if (AND W (NOT MANY?))
then (for OFD in FW-OFDList
do (if (EQ (fetch (FW-OFD OFDWINDOW) of OFD)
W)
then (if (MOUSECONFIRM (CONCAT "Closing " (fetch (FW-OFD FILESTREAM)
of OFD)))
then (CLOSEF? (fetch (FW-OFD FILESTREAM) of OFD)))
(RETURN)))
else (PROG (OPEN-STREAMS STREAM-TO-CLOSE)
(SETQ OPEN-STREAMS (FW-OPENP))
(if (NULL OPEN-STREAMS)
then (PROMPTPRINT "FileWatch: no open files.")
(RETURN))
CLOSE-ANOTHER
(SETQ STREAM-TO-CLOSE (MENU (create MENU
TITLE ← "Select stream to close: "
ITEMS ← OPEN-STREAMS)))
(if (NULL STREAM-TO-CLOSE)
then (RETURN))
(CLOSEF? STREAM-TO-CLOSE)
(BLOCK) (* ; "Give FileWatch a chance")
(if (AND MANY? (SETQ OPEN-STREAMS (FW-OPENP)))
then (GO CLOSE-ANOTHER])
(FW-CLOSE-OLD-OFD-WINDOWS
[LAMBDA NIL (* Koomen " 1-Oct-86 23:48")
(DECLARE (GLOBALVARS FW-OFDList))
(for OFD in FW-OFDList do (SELECTQ (fetch (FW-OFD OFDSTATUS) of OFD)
(OLD (CLOSEW (fetch (FW-OFD OFDWINDOW) of OFD)))
((NEW CURRENT FORGOTTEN))
(SHOULDNT (CONS "Unexpected OFDSTATUS : " (fetch (FW-OFD OFDSTATUS)
of OFD])
(FW-CLOSEFN
[LAMBDA (W) (* Koomen " 2-Oct-86 00:17")
(DECLARE (GLOBALVARS FW-OFDList FW-OpenFiles FW-Reset?))
(if (NEQ (PROCESS.NAME (THIS.PROCESS))
'FileWatcher)
then (for OFD in FW-OFDList when (EQ W (fetch (FW-OFD OFDWINDOW) of OFD))
do (replace (FW-OFD OFDSTATUS) of OFD with 'FORGOTTEN)
(RETURN)) (* Force recomputing OFDList)
(push FW-OpenFiles T)
(SETQ FW-Reset? T])
(FW-CREATE-OFD
[LAMBDA (FULLNAME FILESTREAM) (* ; "Edited 22-Sep-87 13:04 by Koomen")
(DECLARE (GLOBALVARS FW-Font))
(FW-RESIZE-OFD (create FW-OFD
FILESTREAM ← FILESTREAM
FULLNAME ← FULLNAME
NAMEWIDTH ← (STRINGWIDTH FULLNAME FW-Font)
EOFPOS ← (if (RANDACCESSP FILESTREAM)
then (GETEOFPTR FILESTREAM)
else (GETFILEINFO FILESTREAM 'LENGTH))
READING? ← (if (OPENP FILESTREAM 'INPUT)
then T)
WRITING? ← (if (OPENP FILESTREAM 'OUTPUT)
then T)
RANDOM? ← (if (RANDACCESSP FILESTREAM)
then T)
OFDSTATUS ← 'NEW])
(FW-CREATE-OFD-LIST
[LAMBDA NIL (* ; "Edited 22-Sep-87 13:34 by Koomen")
(DECLARE (GLOBALVARS FW-OFDList FW-OpenFiles FW-SortFn))
(for FILESTREAM in FW-OpenFiles bind FULLNAME eachtime (SETQ FULLNAME (FULLNAME FILESTREAM))
unless (OR (FW-FILTERED-FILE? FULLNAME)
(FW-OFD-EXISTS? FULLNAME FILESTREAM)) do (push FW-OFDList (FW-CREATE-OFD FULLNAME
FILESTREAM)))
[SETQ FW-OFDList (for OFD in FW-OFDList
join (SELECTQ (fetch (FW-OFD OFDSTATUS) of OFD)
((NEW CURRENT FORGOTTEN)
(LIST OFD))
(OLD (CLOSEW (fetch (FW-OFD OFDWINDOW) of OFD))
NIL)
(SHOULDNT (CONS "Unexpected OFDSTATUS : " (fetch (FW-OFD OFDSTATUS)
of OFD]
(if (AND FW-OFDList FW-SortFn)
then (SETQ FW-OFDList (SORT FW-OFDList (FUNCTION FW-SORT-FN])
(FW-CREATE-OFD-WINDOWS
[LAMBDA NIL (* Koomen "16-Apr-87 15:29")
(DECLARE (GLOBALVARS FW-Font FW-OFDList))
(FW-ADJUST-REGION)
(for OFD in FW-OFDList bind OFDWINDOW OFDSTREAM unless (fetch (FW-OFD OFDWINDOW) of OFD)
do (SETQ OFDWINDOW (FW-CREATEW OFD))
(SETQ OFDSTREAM (WINDOWPROP OFDWINDOW 'DSP))
(replace (FW-OFD OFDSTREAM) of OFD with OFDSTREAM)
(DSPFONT FW-Font OFDSTREAM)
(WINDOWPROP OFDWINDOW 'RIGHTBUTTONFN (FUNCTION FW-BUTTONEVENTFN))
(WINDOWPROP OFDWINDOW 'BUTTONEVENTFN (FUNCTION FW-BUTTONEVENTFN))
(WINDOWPROP OFDWINDOW 'REPAINTFN (FUNCTION FW-REPAINTFN))
(WINDOWPROP OFDWINDOW 'RESHAPEFN (FUNCTION NILL))
(WINDOWPROP OFDWINDOW 'CLOSEFN (FUNCTION FW-CLOSEFN))
(WINDOWPROP OFDWINDOW 'AFTERMOVEFN (FUNCTION FW-AFTERMOVEFN)))
(FW-ADJUST-PLACEMENT FW-OFDList])
(FW-CREATEW
[LAMBDA (OFD) (* Koomen "29-Sep-86 23:16")
(replace (FW-OFD OFDWINDOW) of OFD with (CREATEW (create REGION
LEFT ← (replace (FW-OFD OFDLEFT)
of OFD
with (fetch (FW-OFD LEFT)
of OFD))
BOTTOM ← (replace (FW-OFD OFDBOTTOM)
of OFD
with (fetch (FW-OFD BOTTOM)
of OFD))
WIDTH ← (replace (FW-OFD OFDWIDTH)
of OFD
with (fetch (FW-OFD WIDTH)
of OFD))
HEIGHT ← (replace (FW-OFD OFDHEIGHT)
of OFD
with (fetch (FW-OFD HEIGHT)
of OFD)))
NIL NIL T])
(FW-FILTERED-FILE?
[LAMBDA (FULLNAME) (* ; "Edited 22-Sep-87 13:31 by Koomen")
(DECLARE (GLOBALVARS FW-Filters))
(* ;; "filters are precompiled for matching. Note that the system function DIRECTORY.MATCH.SETUP has stripped off the host, so we have to match it seperatedly.")
(for FILTER in FW-Filters thereis (AND (DIRECTORY.MATCH (CDR FILTER)
FULLNAME)
(DIRECTORY.MATCH (CAR FILTER)
(FILENAMEFIELD FULLNAME 'HOST])
(FW-FORGET-CMD
[LAMBDA (W MANY?) (* Koomen "27-May-87 15:27")
(DECLARE (GLOBALVARS FW-OFDList))
(if (AND W (NOT MANY?))
then (CLOSEW W)
else (PROG (CURRENT-OFDS FORGET-OFD)
(SETQ CURRENT-OFDS (for OFD in FW-OFDList when (EQ (fetch (FW-OFD OFDSTATUS)
of OFD)
'CURRENT) collect OFD))
(if (NULL CURRENT-OFDS)
then (PROMPTPRINT "FileWatch: no current files.")
(RETURN))
FORGET-ANOTHER
[SETQ FORGET-OFD (MENU (create MENU
TITLE ← "Select file to forget: "
ITEMS ← (for OFD in CURRENT-OFDS
collect (LIST (fetch (FW-OFD FULLNAME)
of OFD)
(KWOTE OFD]
(if (NULL FORGET-OFD)
then (RETURN))
(CLOSEW (fetch (FW-OFD OFDWINDOW) of FORGET-OFD))
(if (AND MANY? (SETQ CURRENT-OFDS (REMOVE FORGET-OFD CURRENT-OFDS)))
then (GO FORGET-ANOTHER])
(FW-INIT
[LAMBDA NIL (* ; "Edited 30-Sep-87 11:53 by Koomen")
(DECLARE (GLOBALVARS FW-Dormant? FW-Running?))
(* * Clean up possible left-overs from a previously killed FileWatch process,
then initialize the world)
(FW-WIPE)
(FW-RE-INIT)
(FW-RESET)
(SETQ FW-Dormant? NIL)
(SETQ FW-Running? T])
(FW-INIT-MENUS
[LAMBDA NIL (* Koomen "15-May-87 01:50")
(DECLARE (GLOBALVARS BackgroundMenu BackgroundMenuCommands FW-Commands FW-InteractMenu))
(* * When changing the list of control menu items, do
(SETQ FW-InteractMenu))
(PROG [(ITEMS '(("Forget File" 'FORGET "Stop watching this file" (SUBITEMS ("Forget Many Files"
'FORGET-MANY
"Stop watching several files"
)))
("Recall File" 'RECALL "Start watching a forgotten file again"
(SUBITEMS ("Recall Many Files" 'RECALL-MANY
"Start watching several forgotten files again")))
("" NIL "No-op")
("Close File" 'CLOSE "Close this file (user beware!)" (SUBITEMS
("Close Many Files"
'CLOSE-MANY
"Close several files")))
("" NIL "No-op")
("Move Display" 'MOVE "Change the display orientation specs"
(SUBITEMS ("Set Anchor" 'SET-ANCHOR "Corner of the display to be anchored"
)
("Set Position" 'SET-POSITION
"Position of display (relative to anchor)")
("Set Justification" 'SET-JUSTIFICATION
"Windows to be shrunk or grown depending on maximum filename width"
)))
("Quit File Watcher" 'QUIT ""]
(if (NOT (type? MENU FW-InteractMenu))
then (SETQ FW-InteractMenu (create MENU
TITLE ← "FileWatch:"
CENTERFLG ← T
MENUOFFSET ← '(-1 . 58)
CHANGEOFFSETFLG ← 'Y
ITEMS ← ITEMS)))
(if (NULL (CDDDR (FASSOC 'FileWatch BackgroundMenuCommands)))
then
(* ;; "Not there, or no subitems (older version)")
(for C in FW-Commands
do (SETQ ITEMS (SUBST `'(FILEWATCH ',C) `',C ITEMS)))
[push BackgroundMenuCommands `(FileWatch '(FILEWATCH 'ON)
"Display and continuously update list of open files and and the location of their file pointers"
(SUBITEMS ,@ITEMS]
(SETQ BackgroundMenu])
(FW-INIT-PROPS
[LAMBDA NIL (* ; "Edited 22-Sep-87 14:30 by Koomen")
(DECLARE (GLOBALVARS FW-AllFiles? FW-Anchor FW-Filters FW-Font FW-Interval FW-Justified?
FW-Position FW-Properties FW-Shade FW-SortFn))
[SETQ FW-AllFiles? (NOT (NULL (LISTGET FW-Properties 'ALL-FILES?]
(SETQ FW-Anchor (OR [CAR (MEMB (LISTGET FW-Properties 'ANCHOR)
'(TOP-LEFT TOP-RIGHT BOTTOM-LEFT BOTTOM-RIGHT]
'BOTTOM-LEFT))
(* ;; "precompile filters for matching. Note that the system function DIRECTORY.MATCH.SETUP strips off the host, so we have to match it seperatedly.")
(SETQ FW-Filters (for FILTER inside (LISTGET FW-Properties 'FILTERS)
join (if (OR (STRINGP FILTER)
(LITATOM FILTER))
then (SETQ FILTER (DIRECTORY.FILL.PATTERN FILTER))
(LIST (CONS (DIRECTORY.MATCH.SETUP (OR (FILENAMEFIELD
FILTER
'HOST)
"*"))
(DIRECTORY.MATCH.SETUP FILTER)))
else (printout PROMPTWINDOW 0
"FileWatch: filter not a string or symbol: " T FILTER
" ignored." T)
NIL)))
[SETQ FW-Font (FONTCREATE (LISTGET FW-Properties 'FONT]
[SETQ FW-Interval (FIXP (LISTGET FW-Properties 'INTERVAL]
[SETQ FW-Justified? (NOT (NULL (LISTGET FW-Properties 'JUSTIFIED?]
(SETQ FW-Position (OR (POSITIONP (LISTGET FW-Properties 'POSITION))
(create POSITION
XCOORD ← 0
YCOORD ← 0)))
(LET ((X (fetch (POSITION XCOORD) of FW-Position))
(Y (fetch (POSITION YCOORD) of FW-Position))
(W SCREENWIDTH)
(H SCREENHEIGHT)
(XMIN 100)
(XMAX (IDIFFERENCE SCREENWIDTH 100))
(YMIN 100)
(YMAX (IDIFFERENCE SCREENHEIGHT 100)))
(SELECTQ FW-Anchor
(TOP-LEFT (if (IGEQ X XMAX)
then (SETQ X XMAX))
(if (ILEQ Y YMIN)
then (SETQ Y YMIN)))
(TOP-RIGHT (if (ILEQ X XMIN)
then (SETQ X XMIN))
(if (ILEQ Y YMIN)
then (SETQ Y YMIN)))
(BOTTOM-LEFT (if (IGEQ X XMAX)
then (SETQ X XMAX))
(if (IGEQ Y YMAX)
then (SETQ Y YMAX)))
(BOTTOM-RIGHT (if (ILEQ X XMIN)
then (SETQ X XMIN))
(if (IGEQ Y YMAX)
then (SETQ Y YMAX)))
(SHOULDNT))
(SETQ FW-Position (create POSITION
XCOORD ← X
YCOORD ← Y)))
[SETQ FW-Shade (SMALLP (LISTGET FW-Properties 'SHADE]
(SETQ FW-SortFn (LET [(FN (LISTGET FW-Properties 'SORTFN]
(if (AND (LITATOM FN)
(GETD FN))
then FN])
(FW-INTERACT
[LAMBDA (W MENUCMD) (* Koomen "15-May-87 01:03")
(DECLARE (GLOBALVARS FW-InteractMenu FW-Running?))
(SELECTQ (OR MENUCMD (SETQ MENUCMD (MENU FW-InteractMenu)))
(NIL NIL)
(FORGET (FW-FORGET-CMD W))
(FORGET-MANY (FW-FORGET-CMD W T))
(RECALL (FW-RECALL-CMD))
(RECALL-MANY (FW-RECALL-CMD T))
(CLOSE (FW-CLOSE-CMD W))
(CLOSE-MANY (FW-CLOSE-CMD W T))
(MOVE (FW-MOVE-OFD-WINDOWS))
(SET-ANCHOR (FW-MOVE-OFD-WINDOWS 'ANCHOR))
(SET-POSITION (FW-MOVE-OFD-WINDOWS 'POSITION))
(SET-JUSTIFICATION
(FW-MOVE-OFD-WINDOWS 'JUSTIFIED?))
(QUIT (SETQ FW-Running? NIL))
(PROMPTPRINT "Unrecognized FileWatch Control Menu command: " MENUCMD])
(FW-LOOP
[LAMBDA NIL (* ; "Edited 30-Sep-87 11:53 by Koomen")
(DECLARE (GLOBALVARS FW-Dormant? FW-Interval FW-OpenFiles FW-ReInit? FW-Reset? FW-Running?))
(bind OPENFILES first (FW-INIT) while FW-Running?
do (if (NOT FW-Dormant?)
then (SETQ OPENFILES (FW-OPENP))
(if (OR FW-Reset? FW-ReInit? (NOT (EQUAL OPENFILES FW-OpenFiles)))
then (if FW-ReInit?
then (FW-RE-INIT))
(FW-RESET)
(if (SETQ FW-OpenFiles (APPEND OPENFILES))
then (FW-CREATE-OFD-LIST)
(FW-CREATE-OFD-WINDOWS)
else (FW-CLOSE-OLD-OFD-WINDOWS))
(SETQ FW-ReInit?))
(FW-UPDATE-OFD-WINDOWS))
(BLOCK FW-Interval) finally (FW-WIPE])
(FW-MOVE-OFD-WINDOWS
[LAMBDA (WHAT) (* Koomen "16-Apr-87 15:55")
(if (OR (NULL WHAT)
(EQ WHAT 'ANCHOR))
then (FW-CHANGE-ANCHOR))
(if (OR (NULL WHAT)
(EQ WHAT 'POSITION))
then (FW-CHANGE-POSITION))
(if (OR (NULL WHAT)
(EQ WHAT 'JUSTIFIED?))
then (FW-CHANGE-JUSTIFICATION])
(FW-MOVEW
[LAMBDA (OFD) (* Koomen "29-Sep-86 23:10")
(MOVEW (fetch (FW-OFD OFDWINDOW) of OFD)
(replace (FW-OFD OFDLEFT) of OFD with (fetch (FW-OFD LEFT) of OFD))
(replace (FW-OFD OFDBOTTOM) of OFD with (fetch (FW-OFD BOTTOM) of OFD])
(FW-OFD-EXISTS?
[LAMBDA (FULLNAME FILESTREAM) (* ; "Edited 22-Sep-87 13:27 by Koomen")
(DECLARE (GLOBALVARS FW-OFDList FW-ReInit?))
(for OFD in FW-OFDList when (AND (EQ (fetch (FW-OFD FULLNAME) of OFD)
FULLNAME)
(EQ (fetch (FW-OFD FILESTREAM) of OFD)
FILESTREAM)
(EQ (fetch (FW-OFD READING?) of OFD)
(if (OPENP FILESTREAM 'INPUT)
then T))
(EQ (fetch (FW-OFD WRITING?) of OFD)
(if (OPENP FILESTREAM 'OUTPUT)
then T)))
do (SELECTQ (fetch (FW-OFD OFDSTATUS) of OFD)
(OLD (replace (FW-OFD OFDSTATUS) of OFD with (if FW-ReInit?
then 'NEW
else 'CURRENT))
(RETURN T))
((NEW CURRENT FORGOTTEN)
(RETURN T))
(SHOULDNT (CONS "Unexpected OFDSTATUS : " (fetch (FW-OFD OFDSTATUS) of OFD])
(FW-OPENP
[LAMBDA NIL (* ; "Edited 22-Sep-87 11:32 by Koomen")
(* ;; "Computes the list of currently open files (actually, streams). If the globalvar FW-AllFiles? is non-NIL, streams with flag USERVISIBLE=NIL are included as well.")
(* ;;
"Note: Uses a scratchlist, so be sure to copy result if you need it across calls to FW-OPENP")
(DECLARE (GLOBALVARS FW-AllFiles? FW-OpenP-ScratchList \FILEDEVICES))
(SCRATCHLIST FW-OpenP-ScratchList
(for FD in \FILEDEVICES bind OPENPFN
do (SETQ OPENPFN (fetch (FDEV OPENP) of FD))
(if (EQ OPENPFN '\GENERIC.OPENP)
then (for S in (fetch (FDEV OPENFILELST) of FD)
when (OR FW-AllFiles? (fetch (STREAM USERVISIBLE) of S))
do (ADDTOSCRATCHLIST S))
else (for FNAME in (APPLY* OPENPFN NIL NIL FD) do (ADDTOSCRATCHLIST (\GETSTREAM
FNAME])
(FW-PERCENTAGE
[LAMBDA (X Y) (* ; "Edited 30-Sep-87 01:00 by Koomen")
(if (IGEQ X Y)
then 100
elseif (IGREATERP X 0)
then (IQUOTIENT (ITIMES X 100)
Y)
else 0])
(FW-RE-INIT
[LAMBDA NIL (* ; "Edited 22-Sep-87 13:05 by Koomen")
(* * Called from FW-INIT, or from FW-LOOP because a prop has changed.)
(DECLARE (GLOBALVARS FW-AccessTab FW-AccessWidth FW-CurPosTab FW-EofPosTab FW-FieldWidth FW-Font
FW-OFDList FW-PercentHeight FW-PercentTab FW-PercentWidth FW-SeprWidth
FW-WindowBottom FW-WindowHeight FW-WindowNoNameWidth WBorder))
(FW-INIT-PROPS)
(SETQ FW-SeprWidth (STRINGWIDTH "AA" FW-Font))
(SETQ FW-AccessWidth (IMAX (STRINGWIDTH "b " FW-Font)
(STRINGWIDTH "r " FW-Font)
(STRINGWIDTH "w " FW-Font)))
(SETQ FW-FieldWidth (STRINGWIDTH "99999999" FW-Font))
(SETQ FW-PercentWidth (ITIMES 2 FW-FieldWidth))
[SETQ FW-PercentHeight (IDIFFERENCE (FONTHEIGHT FW-Font)
(ITIMES 2 (ADD1 (FONTPROP FW-Font 'DESCENT]
(SETQ FW-CurPosTab FW-SeprWidth)
(SETQ FW-EofPosTab (IPLUS FW-CurPosTab FW-FieldWidth FW-SeprWidth))
(SETQ FW-PercentTab (IPLUS FW-EofPosTab FW-FieldWidth FW-SeprWidth))
(SETQ FW-AccessTab (IPLUS FW-PercentTab FW-FieldWidth FW-PercentWidth FW-SeprWidth))
(SETQ FW-WindowNoNameWidth (WIDTHIFWINDOW (IPLUS FW-AccessTab FW-AccessWidth)
WBorder))
(SETQ FW-WindowBottom 0)
(SETQ FW-WindowHeight (HEIGHTIFWINDOW (FONTHEIGHT FW-Font)
NIL WBorder))
(for OFD in FW-OFDList do (DSPFONT FW-Font (fetch (FW-OFD OFDSTREAM) of OFD))
(replace (FW-OFD NAMEWIDTH) of OFD with (STRINGWIDTH
(fetch (FW-OFD FULLNAME)
of OFD)
FW-Font))
(FW-RESIZE-OFD OFD])
(FW-RECALL-CMD
[LAMBDA (MANY?) (* Koomen "14-May-87 23:46")
(DECLARE (GLOBALVARS FW-OFDList FW-Reset?))
(PROG (FORGOTTEN-OFDS RECALL-OFD)
(SETQ FORGOTTEN-OFDS (for OFD in FW-OFDList when (EQ (fetch (FW-OFD OFDSTATUS) of OFD)
'FORGOTTEN) collect OFD))
(if (NULL FORGOTTEN-OFDS)
then (PROMPTPRINT "FileWatch: no forgotten files.")
(RETURN))
RECALL-ANOTHER
[SETQ RECALL-OFD (MENU (create MENU
TITLE ← "Select file to recall: "
CENTERFLG ← T
ITEMS ← (for OFD in FORGOTTEN-OFDS
collect (LIST (fetch (FW-OFD FULLNAME)
of OFD)
(KWOTE OFD]
(if (NULL RECALL-OFD)
then (RETURN))
(replace (FW-OFD OFDSTATUS) of RECALL-OFD with (if (OPENP (fetch (FW-OFD FULLNAME)
of RECALL-OFD))
then (FW-UPDATE-OFD-WINDOW RECALL-OFD T)
'CURRENT
else (PROMPTPRINT
"FileWatch: file has been closed."
)
'OLD))
(SETQ FW-Reset? T)
(if (AND MANY? (SETQ FORGOTTEN-OFDS (REMOVE RECALL-OFD FORGOTTEN-OFDS)))
then (GO RECALL-ANOTHER])
(FW-REPAINTFN
[LAMBDA (W) (* Koomen "25-Sep-86 00:44")
(DECLARE (GLOBALVARS FW-OFDList))
(for OFD in FW-OFDList when (EQ W (fetch (FW-OFD OFDWINDOW) of OFD))
do (if (OPENP (fetch (FW-OFD OFDSTREAM) of OFD))
then (FW-UPDATE-OFD-WINDOW OFD T))
(RETURN])
(FW-RESET
[LAMBDA NIL (* Koomen "29-Sep-86 23:20")
(DECLARE (GLOBALVARS FW-OFDList))
(for OFD in FW-OFDList do (SELECTQ (fetch (FW-OFD OFDSTATUS) of OFD)
(CURRENT (replace (FW-OFD OFDSTATUS) of OFD with 'OLD))
((OLD FORGOTTEN))
(SHOULDNT (CONS "Unexpected OFDSTATUS : " (fetch (FW-OFD OFDSTATUS)
of OFD])
(FW-RESIZE-OFD
[LAMBDA (OFD MAXNAMEWIDTH) (* ; "Edited 22-Sep-87 12:56 by Koomen")
(* * If MAXNAMEWIDTH=NIL, uses OFD's own NAMEWIDTH)
(DECLARE (GLOBALVARS FW-AccessTab FW-Anchor FW-CurPosTab FW-EofPosTab FW-PercentHeight
FW-PercentTab FW-PercentWidth FW-Position FW-WindowBottom FW-WindowHeight
FW-WindowNoNameWidth))
(PROG [(NAMEWIDTH (OR MAXNAMEWIDTH (fetch (FW-OFD NAMEWIDTH) of OFD]
(replace (FW-OFD WIDTH) of OFD with (IPLUS FW-WindowNoNameWidth NAMEWIDTH))
(replace (FW-OFD HEIGHT) of OFD with FW-WindowHeight)
(replace (FW-OFD LEFT) of OFD with (SELECTQ FW-Anchor
((TOP-LEFT BOTTOM-LEFT)
(fetch (POSITION XCOORD) of FW-Position))
((TOP-RIGHT BOTTOM-RIGHT)
(IDIFFERENCE (fetch (POSITION XCOORD)
of FW-Position)
(fetch (FW-OFD WIDTH) of OFD)))
(ERROR "Unsupported anchor spec: " FW-Anchor)))
(replace (FW-OFD BOTTOM) of OFD with FW-WindowBottom)
(replace (FW-OFD CURPOSXOFFSET) of OFD with (IPLUS FW-CurPosTab NAMEWIDTH))
(replace (FW-OFD EOFPOSXOFFSET) of OFD with (IPLUS FW-EofPosTab NAMEWIDTH))
(replace (FW-OFD PCTPOSXOFFSET) of OFD with (IPLUS FW-PercentTab NAMEWIDTH))
(replace (FW-OFD ACCESSXOFFSET) of OFD with (IPLUS FW-AccessTab NAMEWIDTH))
(replace (FW-OFD PCTREGION) of OFD
with (create REGION
LEFT ← NIL
BOTTOM ← NIL
WIDTH ← FW-PercentWidth
HEIGHT ← FW-PercentHeight))
(RETURN OFD])
(FW-SHAPEW
[LAMBDA (OFD) (* Koomen "29-Sep-86 23:09")
(SHAPEW (fetch (FW-OFD OFDWINDOW) of OFD)
(create REGION
LEFT ← (replace (FW-OFD OFDLEFT) of OFD with (fetch (FW-OFD LEFT) of OFD))
BOTTOM ← (replace (FW-OFD OFDBOTTOM) of OFD with (fetch (FW-OFD BOTTOM)
of OFD))
WIDTH ← (replace (FW-OFD OFDWIDTH) of OFD with (fetch (FW-OFD WIDTH) of OFD))
HEIGHT ← (replace (FW-OFD OFDHEIGHT) of OFD with (fetch (FW-OFD HEIGHT)
of OFD])
(FW-SORT-FN
[LAMBDA (OFD1 OFD2) (* Koomen "24-Sep-86 23:24")
(DECLARE (GLOBALVARS FW-Anchor FW-SortFn))
(SELECTQ FW-Anchor
((TOP-LEFT TOP-RIGHT) (* growing downwards *)
(APPLY* FW-SortFn (fetch (FW-OFD FULLNAME) of OFD2)
(fetch (FW-OFD FULLNAME) of OFD1)))
((BOTTOM-LEFT BOTTOM-RIGHT) (* growing upwards *)
(APPLY* FW-SortFn (fetch (FW-OFD FULLNAME) of OFD1)
(fetch (FW-OFD FULLNAME) of OFD2)))
(ERROR "Unsupported anchor spec: " FW-Anchor])
(FW-UPDATE-OFD-WINDOW
[LAMBDA (OFD NEW?) (* ; "Edited 22-Sep-87 12:43 by Koomen")
(DECLARE (GLOBALVARS FW-PercentHeight FW-PercentWidth FW-Shade))
(PROG ((OFDSTREAM (fetch (FW-OFD OFDSTREAM) of OFD))
(FILESTREAM (fetch (FW-OFD FILESTREAM) of OFD))
(OLDCURPOS (fetch (FW-OFD CURPOS) of OFD))
(OLDEOFPOS (fetch (FW-OFD EOFPOS) of OFD))
(OLDPCTPOS (fetch (FW-OFD PCTPOS) of OFD))
(PCTREGION (fetch (FW-OFD PCTREGION) of OFD))
(BOXBORDER 1)
NEWCURPOS NEWEOFPOS NEWPCTPOS X Y)
(if (NOT (OPENP FILESTREAM))
then
(* * May just have created some windows, in which case there may have been a
BLOCK underneath during which this file was closed, so make sure file is still
open)
(RETURN))
(SETQ NEWCURPOS (GETFILEPTR FILESTREAM))
(SETQ NEWEOFPOS (if (NOT (fetch (FW-OFD WRITING?) of OFD))
then OLDEOFPOS
elseif (NOT (fetch (FW-OFD RANDOM?) of OFD))
then NEWCURPOS
else (GETEOFPTR FILESTREAM)))
(if (AND (FIXP NEWCURPOS)
(FIXP NEWEOFPOS))
then (if (ILESSP NEWEOFPOS NEWCURPOS)
then (SETQ NEWEOFPOS NEWCURPOS))
elseif (FIXP NEWCURPOS)
then (SETQ NEWEOFPOS NEWCURPOS)
elseif (FIXP NEWEOFPOS)
then (SETQ NEWCURPOS NEWEOFPOS)
else (SETQ NEWCURPOS (SETQ NEWEOFPOS 0)))
(SETQ NEWPCTPOS (FW-PERCENTAGE NEWCURPOS NEWEOFPOS))
(if NEW?
then (DSPRESET OFDSTREAM)
(printout OFDSTREAM (fetch (FW-OFD FULLNAME) of OFD))
(DSPXPOSITION (fetch (FW-OFD ACCESSXOFFSET) of OFD)
OFDSTREAM)
(printout OFDSTREAM
(LET ((R (fetch (FW-OFD READING?) of OFD))
(W (fetch (FW-OFD WRITING?) of OFD)))
(if (AND R W)
then "b"
elseif R
then "r"
elseif W
then "w"
else "*")))
(replace (FW-OFD OFDSTATUS) of OFD with 'CURRENT))
(if (OR NEW? (NOT (EQUAL NEWCURPOS OLDCURPOS)))
then (DSPXPOSITION (fetch (FW-OFD CURPOSXOFFSET) of OFD)
OFDSTREAM)
(printout OFDSTREAM |.I8| NEWCURPOS)
(replace (FW-OFD CURPOS) of OFD with NEWCURPOS))
(if (OR NEW? (NOT (EQUAL NEWEOFPOS OLDEOFPOS)))
then (DSPXPOSITION (fetch (FW-OFD EOFPOSXOFFSET) of OFD)
OFDSTREAM)
(printout OFDSTREAM |.I8| NEWEOFPOS)
(replace (FW-OFD EOFPOS) of OFD with NEWEOFPOS))
(if (OR NEW? (NOT (EQUAL NEWPCTPOS OLDPCTPOS)))
then (DSPXPOSITION (fetch (FW-OFD PCTPOSXOFFSET) of OFD)
OFDSTREAM)
(printout OFDSTREAM |.I5| NEWPCTPOS)
(printout OFDSTREAM " %% ")
[SETQ X (OR (fetch (REGION LEFT) of PCTREGION)
(replace (REGION LEFT) of PCTREGION with (IPLUS BOXBORDER
(DSPXPOSITION NIL
OFDSTREAM]
[SETQ Y (OR (fetch (REGION BOTTOM) of PCTREGION)
(replace (REGION BOTTOM) of PCTREGION with (ADD1 (DSPYPOSITION NIL
OFDSTREAM]
(if (OR NEW? (ILESSP NEWPCTPOS (OR OLDPCTPOS 100)))
then (GRAYBOXAREA X Y FW-PercentWidth FW-PercentHeight BOXBORDER BLACKSHADE
OFDSTREAM))
(replace (REGION WIDTH) of PCTREGION with (IQUOTIENT (ITIMES NEWPCTPOS
FW-PercentWidth)
100))
(DSPFILL PCTREGION FW-Shade NIL OFDSTREAM)
(replace (FW-OFD PCTPOS) of OFD with NEWPCTPOS])
(FW-UPDATE-OFD-WINDOWS
[LAMBDA NIL (* Koomen " 9-Oct-86 17:18")
(DECLARE (GLOBALVARS FW-OFDList))
(for OFD in FW-OFDList do (SELECTQ (fetch (FW-OFD OFDSTATUS) of OFD)
(NEW (FW-UPDATE-OFD-WINDOW OFD T))
(CURRENT (FW-UPDATE-OFD-WINDOW OFD))
((OLD FORGOTTEN))
(SHOULDNT (CONS "Unexpected OFDSTATUS : " (fetch (FW-OFD OFDSTATUS)
of OFD])
(FW-WIPE
[LAMBDA NIL (* Koomen "15-May-87 01:49")
(DECLARE (GLOBALVARS FW-AllFiles? FW-Anchor FW-CurPosTab FW-EofPosTab FW-FieldWidth FW-Filters
FW-Font FW-FullNameWidth FW-Interval FW-Justified? FW-OFDList FW-OpenFiles
FW-PercentHeight FW-PercentTab FW-PercentWidth FW-Position FW-ReInit? FW-Reset?
FW-Running? FW-SeprWidth FW-Shade FW-SortFn FW-WindowBottom FW-WindowBottomDelta
FW-WindowHeight FW-WindowNoNameWidth))
(* * Clean up possible left-overs, then set all private vars to NIL)
(for OFD in FW-OFDList do (CLOSEW (fetch (FW-OFD OFDWINDOW) of OFD)))
(SETQ FW-AllFiles?)
(SETQ FW-Anchor)
(SETQ FW-CurPosTab)
(SETQ FW-EofPosTab)
(SETQ FW-FieldWidth)
(SETQ FW-Filters)
(SETQ FW-Font)
(SETQ FW-FullNameWidth)
(SETQ FW-Interval)
(SETQ FW-Justified?)
(SETQ FW-OFDList)
(SETQ FW-OpenFiles)
(SETQ FW-PercentHeight)
(SETQ FW-PercentWidth)
(SETQ FW-PercentTab)
(SETQ FW-Position)
(SETQ FW-ReInit?)
(SETQ FW-Reset?)
(SETQ FW-Running?)
(SETQ FW-SeprWidth)
(SETQ FW-Shade)
(SETQ FW-SortFn)
(SETQ FW-WindowBottom)
(SETQ FW-WindowBottomDelta)
(SETQ FW-WindowHeight)
(SETQ FW-WindowNoNameWidth])
)
(DECLARE%: DONTCOPY DONTEVAL@LOAD EVAL@COMPILE
(FILESLOAD (SOURCE FROM LISPUSERS)
SYSEDIT)
)
(RPAQ? FW-OFDList NIL)
(RPAQ? FW-OpenP-ScratchList (CONS))
(RPAQ? FW-Commands '(FORGET FORGET-MANY RECALL RECALL-MANY CLOSE CLOSE-MANY MOVE SET-ANCHOR
SET-POSITION SET-JUSTIFICATION QUIT))
(RPAQ? FW-Properties `(FONT (GACHA 8)
ALL-FILES? NIL POSITION ,(CREATEPOSITION SCREENWIDTH 0) ANCHOR
BOTTOM-RIGHT SHADE ,GRAYSHADE INTERVAL 1000))
(FW-INIT-MENUS)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA FILEWATCHPROP)
)
(PUTPROPS FILEWATCH COPYRIGHT ("Johannes A. G. M. Koomen" 1986 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2864 5130 (FILEWATCH 2874 . 4290) (FILEWATCHPROP 4292 . 5128)) (7522 56492 (
FW-ADJUST-PLACEMENT 7532 . 9494) (FW-ADJUST-REGION 9496 . 11393) (FW-AFTERMOVEFN 11395 . 13234) (
FW-BUTTONEVENTFN 13236 . 13666) (FW-CHANGE-ANCHOR 13668 . 14638) (FW-CHANGE-JUSTIFICATION 14640 .
15141) (FW-CHANGE-POSITION 15143 . 17638) (FW-CLOSE-CMD 17640 . 19184) (FW-CLOSE-OLD-OFD-WINDOWS 19186
. 19797) (FW-CLOSEFN 19799 . 20411) (FW-CREATE-OFD 20413 . 21453) (FW-CREATE-OFD-LIST 21455 . 22720)
(FW-CREATE-OFD-WINDOWS 22722 . 23717) (FW-CREATEW 23719 . 25518) (FW-FILTERED-FILE? 25520 . 26183) (
FW-FORGET-CMD 26185 . 27732) (FW-INIT 27734 . 28168) (FW-INIT-MENUS 28170 . 31316) (FW-INIT-PROPS
31318 . 35020) (FW-INTERACT 35022 . 35876) (FW-LOOP 35878 . 36938) (FW-MOVE-OFD-WINDOWS 36940 . 37377)
(FW-MOVEW 37379 . 37745) (FW-OFD-EXISTS? 37747 . 39157) (FW-OPENP 39159 . 40374) (FW-PERCENTAGE 40376
. 40666) (FW-RE-INIT 40668 . 42729) (FW-RECALL-CMD 42731 . 44781) (FW-REPAINTFN 44783 . 45182) (
FW-RESET 45184 . 45782) (FW-RESIZE-OFD 45784 . 47971) (FW-SHAPEW 47973 . 48792) (FW-SORT-FN 48794 .
49486) (FW-UPDATE-OFD-WINDOW 49488 . 54434) (FW-UPDATE-OFD-WINDOWS 54436 . 55093) (FW-WIPE 55095 .
56490)))))
STOP