(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "18-Jul-2023 22:14:56" {WMEDLEY}FILEWATCH.;7 59497 :EDIT-BY rmk :CHANGES-TO (FNS FW-COPY-FILENAME) :PREVIOUS-DATE "18-Jul-2023 19:21:38" {WMEDLEY}FILEWATCH.;6) (* ; " Copyright (c) 1986-1987, 1998, 2021 by Johannes A. G. M. Koomen. ") (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-FORGET-STREAM) (FNS FW-ADJUST-PLACEMENT FW-ADJUST-REGION FW-AFTERMOVEFN FW-BUTTONEVENTFN FW-COPY-FILENAME 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) (MOVD? 'CL:IDENTITY 'PSEUDOFILENAME)) (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 rÿñ±ÿcriminateur EOFPOSXOFFSET PCTPOSXOFFSET ACCESSXOFFSET PCTREGION READING? WRITING? RANDOM? CURPOSXOFFSET)) ) (/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 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) (FW-OFD 50 POINTER)) '52) ) (/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 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) (FW-OFD 50 POINTER)) '52) (DEFINEQ (FW-FORGET-STREAM [LAMBDA (STREAM) (* ; "Edited 21-Mar-98 14:42 by rmk:") (* ;; "Closes the window associated with STREAM") (SETQ STREAM (GETSTREAM STREAM)) (FOR OFD IN FW-OFDList WHEN (AND (EQ STREAM (FETCH (FW-OFD FILESTREAM) OF OFD)) (FETCH (FW-OFD OFDWINDOW) OF OFD)) DO (REPLACE (FW-OFD OFDSTATUS) OF OFD WITH 'FORGOTTEN) (CLOSEW (FETCH (FW-OFD OFDWINDOW) OF OFD]) ) (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) (* ; "Edited 18-Jul-2023 19:00 by rmk") (* 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 (IF (OR (SHIFTDOWNP 'SHIFT) (KEYDOWNP 'COPY)) then (FW-COPY-FILENAME W) else (FW-REPAINTFN W))) NIL]) (FW-COPY-FILENAME [LAMBDA (W) (* ; "Edited 18-Jul-2023 22:14 by rmk") (bind (REG _ (DSPCLIPPINGREGION NIL W)) unless (OR (SHIFTDOWNP 'SHIFT) (KEYDOWNP 'COPY)) do (GETMOUSESTATE) (CL:WHEN (INSIDEP REG (LASTMOUSEX W) (LASTMOUSEY W)) [COPYINSERT (MKSTRING (PSEUDOFILENAME (fetch (FW-OFD FULLNAME) of (OR (find OFD in FW-OFDList suchthat (EQ (fetch (FW-OFD OFDWINDOW) of OFD) W)) (RETURN] (RETURN))]) (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 18-Jul-2023 19:15 by rmk") (* ; "Edited 22-Sep-87 13:04 by Koomen") (DECLARE (GLOBALVARS FW-Font)) (SETQ FULLNAME (PSEUDOFILENAME FULLNAME)) (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) (* ; "Edited 18-Jul-2023 18:54 by rmk") (* Koomen "15-May-87 01:03") (DECLARE (GLOBALVARS FW-InteractMenu FW-Running?)) (SETQ FOO W) (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) (MOVD? 'CL:IDENTITY 'PSEUDOFILENAME) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA ) (ADDTOVAR NLAML ) (ADDTOVAR LAMA FILEWATCHPROP) ) (PUTPROPS FILEWATCH COPYRIGHT ("Johannes A. G. M. Koomen" 1986 1987 1998 2021)) (DECLARE%: DONTCOPY (FILEMAP (NIL (2909 5175 (FILEWATCH 2919 . 4335) (FILEWATCHPROP 4337 . 5173)) (7679 8314 ( FW-FORGET-STREAM 7689 . 8312)) (8315 58647 (FW-ADJUST-PLACEMENT 8325 . 10287) (FW-ADJUST-REGION 10289 . 12186) (FW-AFTERMOVEFN 12188 . 14027) (FW-BUTTONEVENTFN 14029 . 14711) (FW-COPY-FILENAME 14713 . 15577) (FW-CHANGE-ANCHOR 15579 . 16549) (FW-CHANGE-JUSTIFICATION 16551 . 17052) (FW-CHANGE-POSITION 17054 . 19549) (FW-CLOSE-CMD 19551 . 21095) (FW-CLOSE-OLD-OFD-WINDOWS 21097 . 21708) (FW-CLOSEFN 21710 . 22322) (FW-CREATE-OFD 22324 . 23486) (FW-CREATE-OFD-LIST 23488 . 24753) (FW-CREATE-OFD-WINDOWS 24755 . 25750) (FW-CREATEW 25752 . 27551) (FW-FILTERED-FILE? 27553 . 28216) (FW-FORGET-CMD 28218 . 29765) (FW-INIT 29767 . 30201) (FW-INIT-MENUS 30203 . 33349) (FW-INIT-PROPS 33351 . 37053) ( FW-INTERACT 37055 . 38031) (FW-LOOP 38033 . 39093) (FW-MOVE-OFD-WINDOWS 39095 . 39532) (FW-MOVEW 39534 . 39900) (FW-OFD-EXISTS? 39902 . 41312) (FW-OPENP 41314 . 42529) (FW-PERCENTAGE 42531 . 42821) ( FW-RE-INIT 42823 . 44884) (FW-RECALL-CMD 44886 . 46936) (FW-REPAINTFN 46938 . 47337) (FW-RESET 47339 . 47937) (FW-RESIZE-OFD 47939 . 50126) (FW-SHAPEW 50128 . 50947) (FW-SORT-FN 50949 . 51641) ( FW-UPDATE-OFD-WINDOW 51643 . 56589) (FW-UPDATE-OFD-WINDOWS 56591 . 57248) (FW-WIPE 57250 . 58645))))) STOP