(FILECREATED "29-May-84 09:25:17" {PHYLUM}<LISPCORE>LIBRARY>FILEBROWSER.;4 46770
changes to: (VARS FILEBROWSERCOMS)
(FNS FBROWSERPRINTANDBOX)
previous date: "20-Apr-84 17:25:31" {PHYLUM}<LISPCORE>LIBRARY>FILEBROWSER.;3)
(* Copyright (c) 1983, 1984 by Xerox Corporation)
(PRETTYCOMPRINT FILEBROWSERCOMS)
(RPAQQ FILEBROWSERCOMS [(VARS (FCOMPILEOPS NIL)
(FEDITOPS NIL)
(FUPDATEOPS NIL)
(FLOADOPS NIL)
(FBMENU NIL)
(FBCLOSEMENU NIL)
(DEFAULTBROWSERFONT (FONTCREATE (QUOTE HELVETICA)
10
(QUOTE MRR)))
(DEFAULTBROWSERPRINTFONT (FONTCREATE (QUOTE HELVETICA)
10
(QUOTE MRR)))
(FBPROMPTFONT (FONTCREATE (QUOTE HELVETICA)
8
(QUOTE MRR)))
(BROWSERINFOMENUFONT (FONTCREATE (QUOTE HELVETICA)
10
(QUOTE MRR)))
FBMENUITEMS INFOSHADE FBITEMUNSELECTEDSHADE FBITEMSELECTEDSHADE)
(BITMAPS FILEDRAWER GYPSY.FILEDRAWERMASK)
(FNS CLRPROMPTW FB FBCLOSE FBROWSEBUTTON FBROWSEMOVEDFN FBROWSEOUTFN FBROWSEREPAINTFN
FBROWSERPRINTANDBOX FDELCOMMAND FDIRECTORY PROMPTWPRINT FEDITLISPFILE FEXPNGFILECOMMAND
FGETFILENAME FHARDCPYCOMMAND PROMPTWTERPRI FLOADFILECOMMAND FNEWPTRNCOMMAND FOPENINFOW
FRENAMEFILECOMMAND FBROWSERIGHT FBROWSESELECT FDOEDITCOMMAND FDOFILEBROWSERCOMMAND
FDOSEECOMMAND FILEBROWSER CREATEINFOMENU FILEBROWSERInfoMenuFn FINDFOLDER
FMAKEFOLDERSELECTED FMAKEFOLDERUNSELECTED FMAKESEEWINDOW FCHANGEFOLDERMARK
FCHANGESELMARK FCOMPLFILECOMMAND FCOPYFILECOMMAND FMARKFOLDERSELECTED
FMARKFOLDERUNSELECTED FPRINTFILEINFO FPROMPTEDIT FSEEREPAINTFN FSEERESHAPEFN
FSHORTFILENAME FPRINTHEADER FUNDELCOMMAND FUPDATEBROWSERITEMS FUPDATECOMMAND)
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS BrowserRec)
(CONSTANTS (MarkXPos 10)))
(CURSORS RIGHTARROWCURSOR)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML FB)
(LAMA PROMPTWPRINT])
(RPAQQ FCOMPILEOPS NIL)
(RPAQQ FEDITOPS NIL)
(RPAQQ FUPDATEOPS NIL)
(RPAQQ FLOADOPS NIL)
(RPAQQ FBMENU NIL)
(RPAQQ FBCLOSEMENU NIL)
(RPAQ DEFAULTBROWSERFONT (FONTCREATE (QUOTE HELVETICA)
10
(QUOTE MRR)))
(RPAQ DEFAULTBROWSERPRINTFONT (FONTCREATE (QUOTE HELVETICA)
10
(QUOTE MRR)))
(RPAQ FBPROMPTFONT (FONTCREATE (QUOTE HELVETICA)
8
(QUOTE MRR)))
(RPAQ BROWSERINFOMENUFONT (FONTCREATE (QUOTE HELVETICA)
10
(QUOTE MRR)))
(RPAQQ FBMENUITEMS ((Edit Edit
"Calls an editor on the selected files:
DEDIT for LISP source & TEDIT for other files
(Use MIDDLE mouse button to select options)")
(Delete Delete
"Marks selected files for deletion:
(Use EXPUNGE to remove files from system)")
(Undelete Undelete "Removes deletion mark for selected files")
(Expunge Expunge "Removes files marked for deletion from the system")
(Load Load "LOADs selected files
(Use MIDDLE mouse button to select options)")
(Compile Compile
"Compiles selected LISP source files:
(Use MIDDLE mouse button to select options)")
(Copy Copy "Copies selected files:
(Prompts for new file name)")
(Rename Rename "Renames selected files:
(Prompts for new names)")
(See See "Displays selected files in typescript window")
(Update Update
"Updates list of files satisfying selection pattern:
(Use MIDDLE mouse button to select options)")
(Hardcopy Hardcopy "Produces hardcopy of selected files")
(Info Info "Displays information about selected files")))
(RPAQQ INFOSHADE 1024)
(RPAQQ FBITEMUNSELECTEDSHADE 0)
(RPAQQ FBITEMSELECTEDSHADE 43605)
(RPAQ FILEDRAWER (READBITMAP))
(75 75
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"N@@@@@@@@@@@@@@@@@N@"
"N@@@@@@@@@@@@@@@@@N@"
"NGOOOOOOOOOOOOOOOLN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@AOOOOOOH@@@@DN@"
"ND@@@A@@@@@@H@@@@DN@"
"ND@@@A@@@@@@H@@@@DN@"
"ND@@@A@OOOOHH@@@@DN@"
"ND@@@A@@@@@@H@@@@DN@"
"ND@@@AAOOOOLH@@@@DN@"
"ND@@@A@@@@@@H@@@@DN@"
"ND@@@A@@@@@@H@@@@DN@"
"ND@@@AOOOOOOH@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@OOOOOO@@@@@DN@"
"ND@@@@L@@@@C@@@@@DN@"
"ND@@@@OOOOOO@@@@@DN@"
"ND@@@@GOOOON@@@@@DN@"
"ND@@@@GOOOON@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"NGOOOOOOOOOOOOOOOLN@"
"N@@@@@@@@@@@@@@@@@N@"
"N@@@@@@@@@@@@@@@@@N@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@")
(RPAQ GYPSY.FILEDRAWERMASK (READBITMAP))
(75 75
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@")
(DEFINEQ
(CLRPROMPTW
[LAMBDA (MAINWINDOW) (* edited: "17-Apr-84 13:13")
(CLEARW (GETWINDOWPROP MAINWINDOW (QUOTE PROMPTWINDOW])
(FB
[NLAMBDA (PATTERN) (* edited: "20-Apr-84 14:51")
(FILEBROWSER (OR PATTERN (CAR (PROCESS.READ PROMPTWINDOW "File browser pattern? " T)))
NIL])
(FBCLOSE
[LAMBDA (WINDOW) (* edited: "19-Apr-84 14:04")
(* did you really want to close up shop?)
(COND
((IGREATERP (GETWINDOWPROP WINDOW (QUOTE NUMDELETED))
0)
(SELECTQ (MENU FBCLOSEMENU)
(EXPUNGE (FEXPNGFILECOMMAND WINDOW))
(NOEXPUNGE)
(QUOTE DON'T])
(FBROWSEBUTTON
[LAMBDA (WINDOW) (* SDG "22-JUL-83 13:24")
(COND
[(OR (KEYDOWNP (QUOTE LSHIFT))
(KEYDOWNP (QUOTE RSHIFT)))
(while (OR (KEYDOWNP (QUOTE LSHIFT))
(KEYDOWNP (QUOTE RSHIFT)))
bind FOLDER
do (GETMOUSESTATE)
(if FOLDER
then (FCHANGESELMARK FOLDER WINDOW))
(FCHANGESELMARK (SETQ FOLDER (FINDFOLDER WINDOW))
WINDOW)
finally (FCHANGESELMARK FOLDER WINDOW)
(BKSYSBUF (fetch (BrowserRec USERDATA) of FOLDER]
((FBROWSESELECT WINDOW])
(FBROWSEMOVEDFN
[LAMBDA (WINDOW) (* mdy: "20-OCT-82 16:29")
(SETCURSOR (COND
((IGEQ 30 (fetch XCOORD of (CURSORPOSITION NIL WINDOW)))
RIGHTARROWCURSOR)
(T DEFAULTCURSOR])
(FBROWSEOUTFN
[LAMBDA (WINDOW) (* rao: "30-JUN-82 15:49")
(SETCURSOR DEFAULTCURSOR])
(FBROWSEREPAINTFN
[LAMBDA (WINDOW R) (* lmm "26-Jan-84 14:43")
(DECLARE (SPECVARS MAXWIDTH))
(PROG ((BROWSERITEMMAP (WINDOWPROP WINDOW (QUOTE BROWSERITEMMAP)))
(DIRSTART (WINDOWPROP WINDOW (QUOTE DIRSTART)))
YPOS
[TOP (IPLUS (fetch TOP of R)
(FONTPROP WINDOW (QUOTE DESCENT]
[BOTTOM (IDIFFERENCE (fetch BOTTOM of R)
(FONTPROP WINDOW (QUOTE ASCENT]
(MAXWIDTH 0))
(for BROWSERMAPITEM in BROWSERITEMMAP as ITEMCOUNT from 1
when (AND [IGREATERP TOP (SETQ YPOS (fetch BOTTOM of (fetch (BrowserRec ITEMREGION)
of BROWSERMAPITEM]
(ILESSP BOTTOM YPOS))
do (MOVETO 0 (IPLUS YPOS (FONTPROP WINDOW (QUOTE DESCENT)))
WINDOW)
(replace (BrowserRec ITEMREGION) of BROWSERMAPITEM with (FBROWSERPRINTANDBOX
(fetch (BrowserRec PRINTED)
of BROWSERMAPITEM)
WINDOW 30 10))
(COND
((fetch (BrowserRec SELECTED?) of BROWSERMAPITEM)
(FMARKFOLDERSELECTED BROWSERMAPITEM WINDOW)))
(COND
((fetch (BrowserRec DELETED?) of BROWSERMAPITEM)
(FCHANGEFOLDERMARK BROWSERMAPITEM WINDOW)))
repeatwhile (ILESSP BOTTOM YPOS])
(FBROWSERPRINTANDBOX
[LAMBDA (EXP STREAM LFTMARGIN MINSPACE) (* hdj "29-May-84 09:23")
(DECLARE (GLOBALVARS PLVLFILEFLG)) (* prints EXP on WINDOW starting at LFTMARGIN and
returns the box taken by the characters.
Leaves at least MINSPACE points.)
(* set the left margin so that at least nothing will CR
past it. This does not handle multiple line values.)
(PROG (PREVRM PREVLM YSTART YEND HGHT)
(DSPFONT DEFAULTBROWSERPRINTFONT STREAM)
(SETQ PREVRM (DSPRIGHTMARGIN 50000 STREAM)) (* so that it won't auto carrage return.)
(SETQ PREVLM (DSPLEFTMARGIN LFTMARGIN STREAM))
(AND (FIXP MINSPACE)
(RELMOVETO MINSPACE 0 STREAM))
(COND
((IGREATERP (DSPXPOSITION NIL STREAM)
LFTMARGIN)
(TERPRI STREAM)))
(DSPXPOSITION LFTMARGIN STREAM)
(SETQ YSTART (DSPYPOSITION NIL STREAM))
(RETURN (PROG1 [create REGION
LEFT ← LFTMARGIN
BOTTOM ←[PROGN (RESETLST (RESETSAVE (PRINTLEVEL INSPECTPRINTLEVEL))
(RESETSAVE PLVLFILEFLG T)
(PRIN1 EXP STREAM))
(IDIFFERENCE (SETQ YEND (DSPYPOSITION NIL STREAM))
(FONTPROP STREAM (QUOTE DESCENT]
HEIGHT ←(IPLUS (SETQ HGHT (IDIFFERENCE YSTART YEND))
(FONTPROP STREAM (QUOTE HEIGHT)))
WIDTH ←(COND
((IGREATERP HGHT 0) (* printing the thing did an overflow;
use at least the width of the window.)
(IMAX (IDIFFERENCE (DSPXPOSITION NIL STREAM)
LFTMARGIN)
(IDIFFERENCE (fetch (REGION WIDTH)
of (DSPCLIPPINGREGION NIL STREAM))
LFTMARGIN)))
(T (IDIFFERENCE (DSPXPOSITION NIL STREAM)
LFTMARGIN]
(DSPRIGHTMARGIN PREVRM STREAM)
(DSPLEFTMARGIN PREVLM STREAM])
(FDELCOMMAND
[LAMBDA (FILEENTRY WINDOW) (* edited: "19-Apr-84 13:39")
(COND
((NOT (fetch (BrowserRec DELETED?) of FILEENTRY))
(FCHANGEFOLDERMARK FILEENTRY WINDOW)
(replace (BrowserRec DELETED?) of FILEENTRY with T)
(PUTWINDOWPROP WINDOW (QUOTE NUMDELETED)
(ADD1 (GETWINDOWPROP WINDOW (QUOTE NUMDELETED])
(FDIRECTORY
[LAMBDA (WINDOW SPEC) (* edited: "17-Apr-84 11:35")
(RESETLST (RESETSAVE NIL (LIST (QUOTE CURSOR)
T))
(CURSOR WAITINGCURSOR)
(COND
[(COND
((OR (STRPOS "{DSK" SPEC 1 NIL T))
(SORT (FILDIR SPEC)))
(T (FILDIR SPEC]
(T (PROMPTWPRINT WINDOW "No files in group " SPEC)
NIL])
(PROMPTWPRINT
[LAMBDA U (* edited: "17-Apr-84 12:13")
(PROG (WINDOW)
(COND
((ILESSP U 2)
(ERROR "not enough args to PROMPTWPRINT")))
(SETQ WINDOW (GETWINDOWPROP (ARG U 1)
(QUOTE PROMPTWINDOW)))
(CLEARW WINDOW)
(for ITEM from 2 to U do (PRIN1 (ARG U ITEM)
WINDOW])
(FEDITLISPFILE
[LAMBDA (FILE WINDOW) (* sg: " 3-AUG-83 16:08")
(SETQ WINDOW (OR (WINDOWPROP WINDOW (QUOTE BROWSERINFOW))
(FOPENINFOW WINDOW)))
(RESETLST (RESETSAVE NIL (LIST (QUOTE CLOSEW)
WINDOW))
(TTYDISPLAYSTREAM WINDOW)
(WINDOWPROP WINDOW (QUOTE TITLE)
(CONCAT "Edit COMS for file " FILE))
(CLEARW WINDOW)
(GIVE.TTY.PROCESS WINDOW)
[COND
((NEQ (CDAR (GETPROP (ROOTFILENAME FILE)
(QUOTE FILEDATES)))
(U-CASE FILE))
(printout T "The file " .FONT BOLDFONT FILE .FONT DEFAULTFONT
"is either not loaded or is not the currently loaded version:"
T T)
(printout T "LOADFROM[" FILE "]" T)
(LISPX (LIST (QUOTE LOADFROM)
(KWOTE FILE]
(APPLY* (QUOTE DV)
(PACK (LIST (FILENAMEFIELD FILE (QUOTE NAME))
(QUOTE COMS])
(FEXPNGFILECOMMAND
[LAMBDA (WINDOW) (* edited: "19-Apr-84 15:25")
[for FILEENTRY in (WINDOWPROP WINDOW (QUOTE BROWSERITEMMAP)) do (COND
((fetch (BrowserRec DELETED?)
of FILEENTRY)
(DELFILE (FGETFILENAME
FILEENTRY]
(CLEARW WINDOW)
(WINDOWPROP WINDOW (QUOTE CURRENTFOLDERNUMBERS)
NIL)
(PUTWINDOWPROP WINDOW (QUOTE NUMDELETED)
0)
(FUPDATEBROWSERITEMS (FDIRECTORY WINDOW (WINDOWPROP WINDOW (QUOTE ITEMSPEC)))
(QUOTE FSHORTFILENAME)
WINDOW])
(FGETFILENAME
[LAMBDA (ENTRY) (* SDG " 8-APR-83 14:05")
(fetch (BrowserRec USERDATA)
ENTRY])
(FHARDCPYCOMMAND
[LAMBDA (FILEENTRY KEY WINDOW) (* edited: "18-Apr-84 12:11")
(PROG ((FILE (FGETFILENAME FILEENTRY))
IsLispFile?)
(SETQ IsLispFile? (FILEDATE FILE))
(PROMPTWPRINT WINDOW "Printing " FILE (COND
(IsLispFile? " (Lisp)")
(T "")))
(PROMPTWTERPRI WINDOW)
(COND
(IsLispFile? (APPLY* (QUOTE LISTFILES)
FILE))
(T (EMPRESS FILE])
(PROMPTWTERPRI
[LAMBDA (MAINWINDOW) (* edited: "18-Apr-84 11:49")
(TERPRI (GETWINDOWPROP MAINWINDOW (QUOTE PROMPTWINDOW])
(FLOADFILECOMMAND
[LAMBDA (FILEENTRY KEY WINDOW) (* edited: "17-Apr-84 11:48")
(PROG [(FILE (FGETFILENAME FILEENTRY))
(LOADOP (COND
[(EQ KEY (QUOTE MIDDLE))
(MENU (OR FLOADOPS (SETQ FLOADOPS (create MENU
MENUFONT ← DEFAULTBROWSERFONT
ITEMS ←(QUOTE ((LOAD (QUOTE LOAD)
"Performs LOAD on selected files")
(LOADFROM
(QUOTE LOADFROM)
"Performs LOADFROM on selected files"]
(T (QUOTE LOAD]
(COND
((NULL LOADOP)
(RETURN)))
(COND
((FILEDATE FILE)
(SETQ WINDOW (OR (WINDOWPROP WINDOW (QUOTE BROWSERINFOW))
(FOPENINFOW WINDOW)))
(RESETLST (RESETSAVE NIL (LIST (QUOTE CLOSEW)
WINDOW))
(WINDOWPROP WINDOW (QUOTE TITLE)
(CONCAT LOADOP " on file " FILE))
(CLEARW WINDOW)
(TTYDISPLAYSTREAM WINDOW)
(GIVE.TTY.PROCESS WINDOW)
(LISPX (LIST LOADOP (KWOTE FILE)))
(DISMISS 5000)))
(T (PROMPTWPRINT WINDOW "Can't load " FILE])
(FNEWPTRNCOMMAND
[LAMBDA (WINDOW) (* edited: "19-Apr-84 15:54")
(PROG (ITEMLIST DIRSTART TITLE)
(CLRPROMPTW WINDOW)
(PROMPTWPRINT WINDOW "New file group description? (NIL to abort) ")
[SETQ ITEMLIST (CAR (FPROMPTEDIT (COND
([ATOM (SETQ ITEMLIST (WINDOWPROP WINDOW (QUOTE ITEMSPEC]
ITEMLIST)
(T ""))
WINDOW
(QUOTE PRIN2]
(COND
((NULL ITEMLIST)
(RETURN)))
(SETQ ITEMLIST (\ADD.CONNECTED.DIR ITEMLIST))
(SETQ DIRSTART (LISTGET (UNPACKFILENAME ITEMLIST)
(QUOTE DIRECTORY)))
(WINDOWPROP WINDOW (QUOTE DIRSTART)
(COND
(DIRSTART (PLUS (NCHARS DIRSTART)
2))
(T 1)))
(PUTWINDOWPROP WINDOW (QUOTE ITEMSPEC)
ITEMLIST)
(COND
((ATOM ITEMLIST)
(PUTWINDOWPROP WINDOW (QUOTE TITLE)
(CONCAT "Files in group: " ITEMLIST))
(PUTWINDOWPROP WINDOW (QUOTE ICONTITLE)
(CONCAT "FB: " ITEMLIST)))
(T (PUTWINDOWPROP WINDOW (QUOTE TITLE)
"File Browser")
(PUTWINDOWPROP WINDOW (QUOTE ICONTITLE)
"File Browser")))
(RETURN T])
(FOPENINFOW
[LAMBDA (WINDOW) (* SDG "29-JUL-83 09:37")
(PROG (FILEBROWSERINFOW)
(SETQ FILEBROWSERINFOW
(CREATEW (create REGION
BOTTOM ← 0
LEFT ← 0
WIDTH ← 500
HEIGHT ← 200)
"File Properties")
(WINDOWPROP WINDOW (QUOTE BROWSERINFOW)
FILEBROWSERINFOW))
(WINDOWPROP FILEBROWSERINFOW (QUOTE SCROLLFN)
(QUOTE SCROLLBYREPAINTFN))
[WINDOWPROP FILEBROWSERINFOW (QUOTE EXTENT)
(create REGION
LEFT ← 0
BOTTOM ←(IDIFFERENCE (DSPYPOSITION NIL FILEBROWSERINFOW)
(FONTPROP FILEBROWSERINFOW (QUOTE DESCENT)))
HEIGHT ←(IPLUS (FONTPROP FILEBROWSERINFOW (QUOTE HEIGHT))
(FONTPROP FILEBROWSERINFOW (QUOTE DESCENT]
(RETURN FILEBROWSERINFOW])
(FRENAMEFILECOMMAND
[LAMBDA (PREFIX FILEENTRY WINDOW) (* edited: "17-Apr-84 15:28")
(PROG (TOFILE)
(SETQ FILEENTRY (FGETFILENAME FILEENTRY))
[COND
((NULL PREFIX)
(CLRPROMPTW WINDOW)
(PROMPTWPRINT WINDOW "Rename " FILEENTRY " what (NIL aborts) ? ")
[SETQ TOFILE (CAR (PROCESS.READ (GETWINDOWPROP WINDOW (QUOTE PROMPTWINDOW]
(COND
((NULL TOFILE)
(CLRPROMPTW WINDOW)
(RETURN)))
(SETQ TOFILE (\ADD.CONNECTED.DIR TOFILE)))
(T (SETQ TOFILE (PACKFILENAME (QUOTE DIRECTORY)
PREFIX
(QUOTE VERSION)
NIL
(QUOTE BODY)
FILEENTRY]
(RENAMEFILE FILEENTRY TOFILE)
(CLRPROMPTW WINDOW)
(SETQ FBUPDATE? T)
(PROMPTWPRINT WINDOW FILEENTRY " renamed " TOFILE)
(RETURN TOFILE])
(FBROWSERIGHT
[LAMBDA (WINDOW) (* SDG " 7-APR-83 08:25")
(COND
((IGREATERP (LASTMOUSEX WINDOW)
30)
(DOWINDOWCOM WINDOW))
(T (FBROWSESELECT WINDOW])
(FBROWSESELECT
[LAMBDA (WINDOW) (* lmm "26-Jan-84 14:33")
(PROG (BROWSERITEMMAP FOLDER SETSEL ADDSEL EXTEND CURRENT#S FOLDER# FIRST# LAST#)
(OR (SETQ SETSEL (MOUSESTATE LEFT))
(SETQ ADDSEL (LASTMOUSESTATE MIDDLE))
(SETQ EXTEND (LASTMOUSESTATE RIGHT))
(RETURN))
(SETQ BROWSERITEMMAP (WINDOWPROP WINDOW (QUOTE BROWSERITEMMAP)))
(SETQ FOLDER (FINDFOLDER WINDOW))
(COND
((NULL FOLDER)
(RETURN)))
(COND
(SETSEL (for FOLDER# in (WINDOWPROP WINDOW (QUOTE CURRENTFOLDERNUMBERS))
do (FMAKEFOLDERUNSELECTED (CAR (FNTH BROWSERITEMMAP FOLDER#))
WINDOW))
(FMAKEFOLDERSELECTED FOLDER WINDOW))
[ADDSEL (COND
((fetch (BrowserRec SELECTED?) of FOLDER)
(FMAKEFOLDERUNSELECTED FOLDER WINDOW))
(T (FMAKEFOLDERSELECTED FOLDER WINDOW]
(EXTEND (* have to find all the messages between FOLDER and the
one selected *)
(COND
([SETQ CURRENT#S (SORT (WINDOWPROP WINDOW (QUOTE CURRENTFOLDERNUMBERS]
(SETQ FOLDER# (fetch (BrowserRec #) of FOLDER))
[COND
[(ILESSP FOLDER# (CAR CURRENT#S))
(* before *)
(SETQ FIRST# FOLDER#)
(SETQ LAST# (SUB1 (CAR CURRENT#S]
(T (SETQ LAST# FOLDER#) (* after *)
(SETQ FIRST# (ADD1 (CAR (LAST CURRENT#S]
(for I from FIRST# to LAST# do (FMAKEFOLDERSELECTED (CAR (NTH BROWSERITEMMAP
I))
WINDOW])
(FDOEDITCOMMAND
[LAMBDA (FILEENTRY KEY WINDOW) (* edited: "17-Apr-84 11:56")
(PROG ((FILE (FGETFILENAME FILEENTRY)))
(COND
((EQ KEY (QUOTE MIDDLE))
(SELECTQ [MENU (OR FEDITOPS (SETQ FEDITOPS (create MENU
MENUFONT ← DEFAULTBROWSERFONT
ITEMS ←(QUOTE ((TEDIT (QUOTE TEDIT)
"Calls TEdit (text editor) on selected files")
(DEDIT (QUOTE DEDIT)
"Calls DEdit (symbolic editor) on selected files"]
(TEDIT (TEDIT FILE))
[DEDIT (COND
((FILEDATE FILE)
(FEDITLISPFILE WINDOW FILE))
(T (PROMPTWPRINT WINDOW FILE " is not a Lisp file... can't DEdit"]
(RETURN)))
(T (COND
((FILEDATE FILE)
(FEDITLISPFILE FILE WINDOW))
(T (TEDIT FILE])
(FDOFILEBROWSERCOMMAND
[LAMBDA (ITEM MENU KEY) (* edited: "17-Apr-84 15:24")
(PROG (WINDOW FBUPDATE? FILELIST PREFIX)
(SETQ WINDOW (WINDOWPROP (WFROMMENU MENU)
(QUOTE MAINWINDOW)))
(COND
((GETWINDOWPROP WINDOW (QUOTE FILEBROWSERBUSY))
(PROMPTWPRINT WINDOW "This filebrowser is busy")
(RETURN)))
(OR (FMEMB (CADR ITEM)
(QUOTE (Update Expunge)))
[SETQ FILELIST (for INDEX in (WINDOWPROP WINDOW (QUOTE CURRENTFOLDERNUMBERS))
collect (CAR (NTH (WINDOWPROP WINDOW (QUOTE BROWSERITEMMAP))
INDEX]
(PROGN (PROMPTWPRINT WINDOW "No files are selected")
(RETURN)))
(RESETLST (RESETSAVE NIL (LIST (QUOTE SHADEITEM)
ITEM MENU FBITEMUNSELECTEDSHADE))
(RESETSAVE NIL (LIST (FUNCTION [LAMBDA (W P)
(PUTWINDOWPROP W (QUOTE FILEBROWSERBUSY)
P])
WINDOW NIL))
(PUTWINDOWPROP WINDOW (QUOTE FILEBROWSERBUSY)
T)
(SHADEITEM ITEM MENU FBITEMSELECTEDSHADE)
(SELECTQ (CADR ITEM)
(Edit (for FILEENTRY in FILELIST do (FDOEDITCOMMAND FILEENTRY KEY WINDOW)
))
(See (for FILEENTRY in FILELIST do (FDOSEECOMMAND FILEENTRY KEY)))
(Update (SETQ FBUPDATE? (FUPDATECOMMAND KEY WINDOW)))
(Delete (for FILEENTRY in FILELIST do (FDELCOMMAND FILEENTRY WINDOW)))
(Info (FPRINTFILEINFO WINDOW FILELIST))
(Undelete (for FILEENTRY in FILELIST do (FUNDELCOMMAND FILEENTRY WINDOW))
)
(Expunge (SETQ FBUPDATE? (FEXPNGFILECOMMAND WINDOW)))
(Copy [COND
((IGREATERP (LENGTH FILELIST)
1)
(PROMPTWPRINT WINDOW "Enter destination directory (or NIL): ")
(SETQ PREFIX (CAR (FPROMPTEDIT (DIRECTORYNAME T T)
WINDOW
(QUOTE PRIN2]
(for FILEENTRY in FILELIST do (FCOPYFILECOMMAND PREFIX FILEENTRY
WINDOW)))
(Load (for FILEENTRY in FILELIST do (FLOADFILECOMMAND FILEENTRY KEY
WINDOW)))
(Compile (for FILEENTRY in FILELIST do (FCOMPLFILECOMMAND FILEENTRY KEY
WINDOW)))
(Hardcopy (for FILEENTRY in FILELIST do (FHARDCPYCOMMAND FILEENTRY KEY
WINDOW)))
(Rename [COND
((IGREATERP (LENGTH FILELIST)
1)
(PROMPTWPRINT WINDOW
"Enter destination directory (or NIL): ")
(SETQ PREFIX (CAR (FPROMPTEDIT (DIRECTORYNAME T T)
WINDOW
(QUOTE PRIN2]
(for FILEENTRY in FILELIST do (FRENAMEFILECOMMAND PREFIX
FILEENTRY
WINDOW)))
(SHOULDNT))
(COND
(FBUPDATE? (FUPDATEBROWSERITEMS (FDIRECTORY WINDOW (WINDOWPROP WINDOW
(QUOTE ITEMSPEC))
)
(QUOTE FSHORTFILENAME)
WINDOW])
(FDOSEECOMMAND
[LAMBDA (FILEENTRY KEY) (* edited: "18-Apr-84 11:37")
(PROG ((FILE (FGETFILENAME FILEENTRY))
WINDOW)
(COND
((AND (NULL (FILENAMEFIELD FILE (QUOTE NAME)))
(DIRECTORYNAMEP FILE))
(FILEBROWSER (PACKFILENAME (QUOTE NAME)
(QUOTE *)
(QUOTE VERSION)
NIL
(QUOTE BODY)
FILE)))
(T (FMAKESEEWINDOW FILE])
(FILEBROWSER
[LAMBDA (ITEMLIST BROWSERWINDOW) (* edited: "19-Apr-84 15:57")
(PROG (MENU DIRSTART FILEBROWSERINFOW REGION)
(COND
((NULL ITEMLIST)
(RETURN)))
[SETQ ITEMLIST (COND
[(LISTP ITEMLIST)
(REMOVE NIL (for FILE in ITEMLIST collect (CDAR (GETP (ROOTFILENAME FILE)
(QUOTE FILEDATES]
(T (\ADD.CONNECTED.DIR ITEMLIST]
[SETQ MENU
(OR FBMENU
(SETQ FBMENU
(create MENU
MENUFONT ← DEFAULTBROWSERFONT
ITEMS ← FBMENUITEMS
CENTERFLG ← T
MENUROWS ← 4
WHENSELECTEDFN ←(FUNCTION (LAMBDA (Item Menu Key)
(ADD.PROCESS (LIST (FUNCTION FDOFILEBROWSERCOMMAND)
(KWOTE Item)
(KWOTE Menu)
(KWOTE Key))
(QUOTE NAME)
(PACK (LIST (QUOTE FB-)
(CAR Item]
(OR FBCLOSEMENU (SETQ FBCLOSEMENU (create MENU
ITEMS ←(QUOTE (("Expunge deleted files"
(QUOTE EXPUNGE)
"Erases all files still marked 'deleted'")
("Don't expunge" (QUOTE NOEXPUNGE)
"Closes browser without expunging files marked deleted")))
MENUROWS ← 2
CENTERFLG ← T
TITLE ← "FB close options"
MENUFONT ← DEFAULTBROWSERFONT)))
(SETQ BROWSERWINDOW (CREATEMENUEDWINDOW MENU (COND
((ATOM ITEMLIST)
(CONCAT "Files in group: " ITEMLIST))
(T "File Browser"))
(QUOTE TOP)
BROWSERWINDOW NIL DEFAULTBROWSERFONT))
(ATTACHMENU (CREATEINFOMENU)
BROWSERWINDOW
(QUOTE TOP))
(COND
((ATOM ITEMLIST)
(PUTWINDOWPROP BROWSERWINDOW (QUOTE ICONTITLE)
(CONCAT "FB: " ITEMLIST)))
(T (PUTWINDOWPROP BROWSERWINDOW (QUOTE ICONTITLE)
"File Browser")))
(WINDOWPROP BROWSERWINDOW (QUOTE SELECTBM)
(BITMAPCREATE (WINDOWPROP BROWSERWINDOW (QUOTE WIDTH))
(FONTHEIGHT BROWSERWINDOW)))
(DSPFONT DEFAULTBROWSERPRINTFONT BROWSERWINDOW)
[PUTWINDOWPROP BROWSERWINDOW (QUOTE ICONFN)
(FUNCTION (LAMBDA (W I)
(COND
((NULL I)
(TITLEDICONW (create TITLEDICON
ICON ← FILEDRAWER
MASK ← GYPSY.FILEDRAWERMASK
TITLEREG ←(create REGION
LEFT ← 5
WIDTH ← 60
BOTTOM ← 7
HEIGHT ← 30))
(GETWINDOWPROP W (QUOTE ICONTITLE))
NIL NIL NIL (QUOTE TOP)))
(T I]
(PUTWINDOWPROP BROWSERWINDOW (QUOTE PROMPTWINDOW)
(GETPROMPTWINDOW BROWSERWINDOW 2 FBPROMPTFONT))
(PUTWINDOWPROP BROWSERWINDOW (QUOTE BROWSERFONT)
DEFAULTBROWSERFONT)
(PUTWINDOWPROP BROWSERWINDOW (QUOTE NUMDELETED)
0)
(PUTWINDOWPROP BROWSERWINDOW (QUOTE BUTTONEVENTFN)
(FUNCTION FBROWSEBUTTON))
(PUTWINDOWPROP BROWSERWINDOW (QUOTE RIGHTBUTTONFN)
(FUNCTION FBROWSERIGHT))
(PUTWINDOWPROP BROWSERWINDOW (QUOTE SCROLLFN)
(FUNCTION SCROLLBYREPAINTFN))
(PUTWINDOWPROP BROWSERWINDOW (QUOTE REPAINTFN)
(FUNCTION FBROWSEREPAINTFN))
(PUTWINDOWPROP BROWSERWINDOW (QUOTE CURSORMOVEDFN)
(FUNCTION FBROWSEMOVEDFN))
(PUTWINDOWPROP BROWSERWINDOW (QUOTE CURSOROUTFN)
(FUNCTION FBROWSEOUTFN))
[WINDOWADDPROP BROWSERWINDOW (QUOTE RESHAPEFN)
(FUNCTION (LAMBDA (W)
(REDISPLAYW W]
(PUTWINDOWPROP BROWSERWINDOW (QUOTE BROWSERINFOW)
(SETQ FILEBROWSERINFOW
(CREATEW (PROGN (SETQ REGION (WINDOWPROP BROWSERWINDOW (QUOTE REGION)))
(SETQ REGION (create REGION
BOTTOM ←(IABS (IDIFFERENCE
(fetch BOTTOM
of REGION)
250))
LEFT ←(IABS (IDIFFERENCE
(fetch LEFT
of REGION)
150))
WIDTH ← 500
HEIGHT ← 200)))
"File Properties" NIL T)))
(COND
((OR (ILESSP (fetch BOTTOM of REGION)
0)
(ILESSP (fetch LEFT of REGION)
0)) (* Info window is off the edge of the screen;
let the user move it someplace else.)
(MOVEW FILEBROWSERINFOW)))
(WINDOWADDPROP BROWSERWINDOW (QUOTE SHRINKFN)
(QUOTE FBCLOSE)
T)
(WINDOWADDPROP BROWSERWINDOW (QUOTE CLOSEFN)
(QUOTE FBCLOSE)
T)
[WINDOWADDPROP BROWSERWINDOW (QUOTE CLOSEFN)
(FUNCTION (LAMBDA (W)
(CLOSEW (WINDOWPROP W (QUOTE BROWSERINFOW]
[WINDOWADDPROP BROWSERWINDOW (QUOTE OPENFN)
(FUNCTION (LAMBDA (W)
(OPENW (WINDOWPROP W (QUOTE BROWSERINFOW]
(WINDOWPROP BROWSERWINDOW (QUOTE ITEMSPEC)
ITEMLIST)
(COND
((NLISTP ITEMLIST)
(SETQ DIRSTART (LISTGET (UNPACKFILENAME ITEMLIST)
(QUOTE DIRECTORY)))
(WINDOWPROP BROWSERWINDOW (QUOTE DIRSTART)
(COND
(DIRSTART (PLUS (NCHARS DIRSTART)
2))
(T 1)))
(FUPDATEBROWSERITEMS (FDIRECTORY BROWSERWINDOW ITEMLIST)
(FUNCTION FSHORTFILENAME)
BROWSERWINDOW))
(T (WINDOWPROP BROWSERWINDOW (QUOTE DIRSTART)
1)
(FUPDATEBROWSERITEMS (SORT ITEMLIST)
(FUNCTION EVQ)
BROWSERWINDOW)))
(RETURN BROWSERWINDOW])
(CREATEINFOMENU
[LAMBDA NIL (* edited: "18-Apr-84 12:30")
(create MENU
ITEMS ←(QUOTE ((ByteSize BYTESIZE "Toggles ByteSize display")
(Length LENGTH "Toggles Length display")
(Pages SIZE "Toggles Pages display")
(Type TYPE "Toggles Type display")
(Created CREATIONDATE "Toggles Created display")
(Written WRITEDATE "Toggles Written display")
(Read READDATE "Toggles Read display")))
MENUROWS ← 2
CENTERFLG ← T
MENUFONT ← BROWSERINFOMENUFONT
WHENSELECTEDFN ←(QUOTE FILEBROWSERInfoMenuFn])
(FILEBROWSERInfoMenuFn
[LAMBDA (ITEM MENU KEY) (* edited: "18-Apr-84 14:29")
(PROG (CHOSEN (WINDOW (GETWINDOWPROP (WFROMMENU MENU)
(QUOTE MAINWINDOW)))
(INFO (CADR ITEM)))
(COND
((NULL ITEM)
(RETURN)))
(SETQ CHOSEN (GETWINDOWPROP WINDOW (QUOTE INFOCHOICES)))
[COND
((FMEMB INFO CHOSEN)
(SHADEITEM ITEM MENU WHITESHADE)
(SETQ CHOSEN (DREMOVE INFO CHOSEN)))
(T (SHADEITEM ITEM MENU INFOSHADE)
(SETQ CHOSEN (CONS INFO CHOSEN]
(PUTWINDOWPROP WINDOW (QUOTE INFOCHOICES)
CHOSEN])
(FINDFOLDER
[LAMBDA (WINDOW) (* SDG "22-JUL-83 12:36")
(for FOLDER in (WINDOWPROP WINDOW (QUOTE BROWSERITEMMAP))
bind [YPOS ←(IPLUS (LASTMOUSEY WINDOW)
(FONTPROP WINDOW (QUOTE DESCENT]
thereis (IGREATERP YPOS (fetch BOTTOM of (fetch (BrowserRec ITEMREGION) of FOLDER])
(FMAKEFOLDERSELECTED
[LAMBDA (FOLDER WINDOW) (* SDG " 7-APR-83 08:48")
(COND
(FOLDER (replace (BrowserRec SELECTED?) of FOLDER with T)
(WINDOWADDPROP WINDOW (QUOTE CURRENTFOLDERNUMBERS)
(fetch (BrowserRec #) of FOLDER))
[WINDOWPROP WINDOW (QUOTE CURRENTFOLDERNUMBERS)
(SORT (WINDOWPROP WINDOW (QUOTE CURRENTFOLDERNUMBERS]
(FMARKFOLDERSELECTED FOLDER WINDOW])
(FMAKEFOLDERUNSELECTED
[LAMBDA (MSG WINDOW) (* SDG " 7-APR-83 08:48")
(COND
(MSG (replace (BrowserRec SELECTED?) of MSG with NIL)
[WINDOWPROP WINDOW (QUOTE CURRENTFOLDERNUMBERS)
(REMOVE (fetch (BrowserRec #) of MSG)
(WINDOWPROP WINDOW (QUOTE CURRENTFOLDERNUMBERS]
(FMARKFOLDERUNSELECTED MSG WINDOW])
(FMAKESEEWINDOW
[LAMBDA (FILE) (* edited: "20-Apr-84 16:28")
(PROG (WINDOW COREFILENAME)
(SETQ WINDOW (CREATEW NIL (CONCAT "Listing of " FILE)))
(SETQ COREFILENAME (GENSYM (QUOTE {CORE}SEE)))
(COPYFILE FILE COREFILENAME)
(PUTWINDOWPROP WINDOW (QUOTE COREFILE)
COREFILENAME)
(PUTWINDOWPROP WINDOW (QUOTE REPAINTFN)
(QUOTE FSEEREPAINTFN))
(PUTWINDOWPROP WINDOW (QUOTE RESHAPEFN)
(QUOTE FSEERESHAPEFN))
(PUTWINDOWPROP WINDOW (QUOTE SCROLLFN)
(QUOTE SCROLLBYREPAINTFN))
(PUTWINDOWPROP WINDOW (QUOTE CLOSEFN)
(FUNCTION [LAMBDA (W)
(DELFILE (GETWINDOWPROP W (QUOTE COREFILE)))
W]))
(FSEERESHAPEFN WINDOW)
(RETURN WINDOW])
(FCHANGEFOLDERMARK
[LAMBDA (FOLDER WINDOW) (* edited: "17-Apr-84 09:54")
(PROG ((FOLDERREGION (fetch ITEMREGION of FOLDER)))
(BITBLT NIL 0 0 WINDOW (fetch LEFT of FOLDERREGION)
(IPLUS (fetch BOTTOM of FOLDERREGION)
(IQUOTIENT (FONTPROP WINDOW (QUOTE ASCENT))
2)
2)
(fetch WIDTH of FOLDERREGION)
1
(QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE])
(FCHANGESELMARK
[LAMBDA (FOLDER WINDOW) (* SDG "22-JUL-83 13:25")
(PROG ((FOLDERREGION (fetch ITEMREGION of FOLDER)))
(BITBLT NIL 0 0 WINDOW (fetch LEFT of FOLDERREGION)
(fetch BOTTOM of FOLDERREGION)
(fetch WIDTH of FOLDERREGION)
2
(QUOTE TEXTURE)
(QUOTE INVERT)
GRAYSHADE])
(FCOMPLFILECOMMAND
[LAMBDA (FILEENTRY KEY WINDOW) (* edited: "17-Apr-84 11:57")
(PROG [(FILE (FGETFILENAME FILEENTRY))
(COMPILEOP (COND
[(EQ KEY (QUOTE MIDDLE))
(MENU (OR FCOMPILEOPS (SETQ FCOMPILEOPS
(create MENU
MENUFONT ← DEFAULTBROWSERFONT
ITEMS ←(QUOTE ((TCOMPL (QUOTE TCOMPL)
"Does TCOMPL on selected files")
(BCOMPL (QUOTE BCOMPL)
"Does BCOMPL on selected files"]
(T (QUOTE TCOMPL]
(COND
((NULL COMPILEOP)
(RETURN)))
(COND
((FILEDATE FILE)
(SETQ WINDOW (OR (WINDOWPROP WINDOW (QUOTE BROWSERINFOW))
(FOPENINFOW WINDOW)))
(RESETLST (RESETSAVE NIL (LIST (QUOTE CLOSEW)
WINDOW))
(WINDOWPROP WINDOW (QUOTE TITLE)
(CONCAT COMPILEOP " on file " FILE))
(CLEARW WINDOW)
(TTYDISPLAYSTREAM WINDOW)
(GIVE.TTY.PROCESS WINDOW)
(LISPX (LIST COMPILEOP (KWOTE FILE)))
(DISMISS 5000)))
(T (PROMPTWPRINT WINDOW "Can't compile " FILE])
(FCOPYFILECOMMAND
[LAMBDA (PREFIX FILEENTRY WINDOW) (* edited: "17-Apr-84 13:25")
(PROG (TOFILE)
(SETQ FILEENTRY (FGETFILENAME FILEENTRY))
[SETQ TOFILE (COND
[(NULL PREFIX)
(PROMPTWPRINT WINDOW "Copy file " FILEENTRY " where? (NIL to abort) ")
(CAR (PROCESS.READ (GETWINDOWPROP WINDOW (QUOTE PROMPTWINDOW]
(T (PACKFILENAME (QUOTE DIRECTORY)
PREFIX
(QUOTE VERSION)
NIL
(QUOTE BODY)
FILEENTRY]
(COND
((NULL TOFILE)
(CLRPROMPTW WINDOW)
(RETURN)))
(SETQ TOFILE (\ADD.CONNECTED.DIR TOFILE))
(COPYFILE FILEENTRY TOFILE)
(SETQ FBUPDATE? T)
(PROMPTWPRINT WINDOW FILEENTRY " copied to " TOFILE)
(RETURN TOFILE])
(FMARKFOLDERSELECTED
[LAMBDA (FOLDER WINDOW) (* SDG " 9-MAR-83 15:26")
(\ITEMW.SELECTITEM (LIST (fetch ITEMREGION of FOLDER))
WINDOW])
(FMARKFOLDERUNSELECTED
[LAMBDA (FOLDER WINDOW) (* SDG " 9-MAR-83 15:26")
(\ITEMW.DESELECTITEM (LIST (fetch ITEMREGION of FOLDER))
WINDOW])
(FPRINTFILEINFO
[LAMBDA (WINDOW FILELST) (* edited: "17-Apr-84 10:02")
(PROG ((FILEBROWSERINFOW (WINDOWPROP WINDOW (QUOTE BROWSERINFOW)))
(DIRSTART (WINDOWPROP WINDOW (QUOTE DIRSTART)))
ITEMSPEC ATTRS)
(COND
((NULL FILELST)
(RETURN NIL))
((NULL FILEBROWSERINFOW)
(FOPENINFOW WINDOW))
(T (WINDOWPROP FILEBROWSERINFOW (QUOTE TITLE)
"File Properties")
(CLEARW FILEBROWSERINFOW)))
(SETQ ITEMSPEC (WINDOWPROP WINDOW (QUOTE ITEMSPEC)))
(SETQ DIRSTART (COND
((ATOM ITEMSPEC)
(SETQ DIRSTART (LISTGET (UNPACKFILENAME ITEMSPEC)
(QUOTE DIRECTORY)))
(COND
(DIRSTART (PLUS (NCHARS DIRSTART)
2))
(T 1)))
(T 1)))
(printout FILEBROWSERINFOW # (DSPFONT DEFAULTBROWSERPRINTFONT (OUTPUT))
"Name" # (DSPXPOSITION 148 FILEBROWSERINFOW)
"Size" # (DSPXPOSITION 235 FILEBROWSERINFOW)
"Created" # (DSPXPOSITION 375 FILEBROWSERINFOW)
"Last Written" T T)
(for FILE in FILELST
do [SETQ ATTRS (OR (fetch (BrowserRec FILEINFO) of FILE)
(replace (BrowserRec FILEINFO) of FILE
with (for ATTR in (QUOTE (LENGTH CREATIONDATE WRITEDATE))
collect (COND
((INFILEP (FGETFILENAME FILE))
(GETFILEINFO (FGETFILENAME FILE)
ATTR))
(T (GETFILEINFO (ROOTFILENAME (FGETFILENAME
FILE))
ATTR]
(printout FILEBROWSERINFOW (FILENAMEFIELD (FGETFILENAME FILE)
(QUOTE NAME))
"."
(OR (FILENAMEFIELD (FGETFILENAME FILE)
(QUOTE EXTENSION))
"")
";"
(OR (FILENAMEFIELD (FGETFILENAME FILE)
(QUOTE VERSION))
"")
#
(DSPXPOSITION 140 FILEBROWSERINFOW)
" "
(CAR ATTRS)
#
(DSPXPOSITION 208 FILEBROWSERINFOW)
(CADR ATTRS)
#
(DSPXPOSITION 358 FILEBROWSERINFOW)
(CADDR ATTRS)
T])
(FPROMPTEDIT
[LAMBDA (EXPRS WINDOW PRINTFN) (* edited: "19-Apr-84 17:10")
(OR PRINTFN (SETQ PRINTFN TTYINPRINTFN))
(SETQ WINDOW (GETWINDOWPROP WINDOW (QUOTE PROMPTWINDOW)))
(RESETLST (RESETSAVE (CURSOR DEFAULTCURSOR))
(RESETSAVE (TTYDISPLAYSTREAM WINDOW))
(RESETSAVE (GIVE.TTY.PROCESS WINDOW)) (* Make sure we have something to point with)
(TTYIN TTYINEDITPROMPT NIL NIL (QUOTE LISPXREAD)
NIL NIL EXPRS EDITRDTBL])
(FSEEREPAINTFN
[LAMBDA (WINDOW REGION) (* edited: "20-Apr-84 16:16")
(MOVETO (WINDOWPROP WINDOW (QUOTE XORIG))
(WINDOWPROP WINDOW (QUOTE YORIG))
WINDOW)
(COPYALLBYTES (GETWINDOWPROP WINDOW (QUOTE COREFILE))
WINDOW])
(FSEERESHAPEFN
[LAMBDA (WINDOW) (* edited: "20-Apr-84 16:14")
(PROG (BTM)
(DSPRESET WINDOW)
(PUTWINDOWPROP WINDOW (QUOTE XORIG)
(DSPXPOSITION NIL WINDOW))
(PUTWINDOWPROP WINDOW (QUOTE YORIG)
(DSPYPOSITION NIL WINDOW))
(PUTWINDOWPROP WINDOW (QUOTE YORIG)
(DSPYPOSITION NIL WINDOW))
(FSEEREPAINTFN WINDOW)
[SETQ BTM (IPLUS (DSPYPOSITION NIL WINDOW)
(FONTPROP WINDOW (QUOTE ASCENT]
(PUTWINDOWPROP WINDOW (QUOTE EXTENT)
(create REGION
LEFT ← 0
BOTTOM ← BTM
WIDTH ←(GETWINDOWPROP WINDOW (QUOTE WIDTH))
HEIGHT ←(IDIFFERENCE (GETWINDOWPROP WINDOW (QUOTE HEIGHT))
BTM])
(FSHORTFILENAME
[LAMBDA (FILE DIRSTART) (* SDG " 3-AUG-83 10:39")
(PROG (DIRPART)
(SETQ FILE (UNPACKFILENAME FILE))
(SETQ DIRPART (LISTGET FILE (QUOTE DIRECTORY)))
[COND
(DIRPART (SETQ DIRPART (SUBSTRING DIRPART DIRSTART (NCHARS DIRPART]
(RETURN (COND
[DIRPART (PACKFILENAME (QUOTE DIRECTORY)
DIRPART
(QUOTE NAME)
(LISTGET FILE (QUOTE NAME))
(QUOTE EXTENSION)
(LISTGET FILE (QUOTE EXTENSION))
(QUOTE VERSION)
(LISTGET FILE (QUOTE VERSION]
(T (PACKFILENAME (QUOTE NAME)
(LISTGET FILE (QUOTE NAME))
(QUOTE EXTENSION)
(LISTGET FILE (QUOTE EXTENSION))
(QUOTE VERSION)
(LISTGET FILE (QUOTE VERSION])
(FPRINTHEADER
[LAMBDA (ITEM ITEMMAP ITEMCOUNT WINDOW BROWSERFONT) (* SDG " 7-APR-83 08:15")
(DECLARE (SPECVARS MAXWIDTH))
(printout WINDOW # (DSPFONT DEFAULTBROWSERFONT (OUTPUT))
3 .I4 ITEMCOUNT 8 # (DSPFONT BROWSERFONT (OUTPUT))
ITEM T)
(* keep track of maximum width printed to. If header is allowed to print on two lines, MAXWIDTH was set to right
margin by MAKEBROWSERWINDOW so this should not reset it.)
(COND
((fetch (BrowserRec SELECTED?) of ITEMMAP)
(FMARKFOLDERSELECTED ITEMMAP WINDOW)))
(COND
((fetch (BrowserRec DELETED?) of ITEMMAP)
(FCHANGEFOLDERMARK ITEMMAP WINDOW)))
(COND
((ILESSP MAXWIDTH (DSPXPOSITION NIL WINDOW))
(SETQ MAXWIDTH (DSPXPOSITION NIL WINDOW])
(FUNDELCOMMAND
[LAMBDA (FILEENTRY WINDOW) (* edited: "19-Apr-84 13:40")
(COND
((fetch (BrowserRec DELETED?) of FILEENTRY)
(FCHANGEFOLDERMARK FILEENTRY WINDOW)
(replace (BrowserRec DELETED?) of FILEENTRY with NIL)
(PUTWINDOWPROP WINDOW (QUOTE NUMDELETED)
(SUB1 (GETWINDOWPROP WINDOW (QUOTE NUMDELETED])
(FUPDATEBROWSERITEMS
[LAMBDA (ITEMLIST ITEMPRINTFN WINDOW) (* lmm "26-Jan-84 14:37")
(PROG [MAXWIDTH DIRSTART NEWBROWSERITEM BROWSERITEMMAP (BROWSERFONT (WINDOWPROP WINDOW
(QUOTE
BROWSERFONT]
(DECLARE (SPECVARS MAXWIDTH))
(DSPRIGHTMARGIN 10000 WINDOW)
(LINELENGTH 1000 WINDOW) (* printing headers to arbitrary width, MAXWIDTH is set
by PRINTHEADER.)
(SETQ MAXWIDTH (COND
[(WINDOWPROP WINDOW (QUOTE EXTENT))
(fetch WIDTH of (WINDOWPROP WINDOW (QUOTE EXTENT]
(T 0)))
(CLEARW WINDOW)
(SETQ DIRSTART (WINDOWPROP WINDOW (QUOTE DIRSTART)))
(SETQ BROWSERITEMMAP (for ITEM in ITEMLIST as ITEMCOUNT from 1 bind PRINTED
collect (PROGN (SETQ NEWBROWSERITEM
(create BrowserRec
USERDATA ← ITEM
# ← ITEMCOUNT
ITEMREGION ←(FBROWSERPRINTANDBOX
(SETQ PRINTED (APPLY* ITEMPRINTFN ITEM
DIRSTART))
WINDOW 30 10)
SELECTED? ← NIL
DELETED? ← NIL
FILEINFO ← NIL
PRINTED ← PRINTED))
NEWBROWSERITEM)))
(WINDOWPROP WINDOW (QUOTE BROWSERSTATE)
(QUOTE SELECT))
(WINDOWPROP WINDOW (QUOTE BROWSERITEMMAP)
BROWSERITEMMAP)
[WINDOWPROP WINDOW (QUOTE EXTENT)
(create REGION
LEFT ← 0
BOTTOM ←(IDIFFERENCE (DSPYPOSITION NIL WINDOW)
(FONTPROP WINDOW (QUOTE DESCENT)))
WIDTH ← MAXWIDTH
HEIGHT ←(IPLUS (IDIFFERENCE (OR (fetch BOTTOM
of (fetch (BrowserRec ITEMREGION)
of (CAR BROWSERITEMMAP)))
(DSPYPOSITION NIL WINDOW))
(DSPYPOSITION NIL WINDOW))
(FONTPROP WINDOW (QUOTE HEIGHT))
(FONTPROP WINDOW (QUOTE DESCENT]
(WINDOWPROP WINDOW (QUOTE CURRENTFOLDERNUMBERS)
NIL)
(WINDOWPROP WINDOW (QUOTE CURRENTITEM)
NIL])
(FUPDATECOMMAND
[LAMBDA (KEY WINDOW) (* SDG "25-JUL-83 16:31")
(SELECTQ (if (EQ KEY (QUOTE MIDDLE))
then [MENU (OR FUPDATEOPS (SETQ FUPDATEOPS (create MENU
MENUFONT ← DEFAULTBROWSERFONT
ITEMS ←(QUOTE
((Update (QUOTE UPDATE)
"Updates browser using current selection pattern")
(NewPattern (QUOTE NEWPATTERN)
"Prompts for a new selection pattern and updates browser"]
else (QUOTE UPDATE))
(UPDATE T)
(NEWPATTERN (FNEWPTRNCOMMAND WINDOW))
NIL])
)
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD BrowserRec (USERDATA ITEMREGION # SELECTED? DELETED? FILEINFO PRINTED))
]
(DECLARE: EVAL@COMPILE
(RPAQQ MarkXPos 10)
(CONSTANTS (MarkXPos 10))
)
)
(RPAQ RIGHTARROWCURSOR (CURSORCREATE (READBITMAP) 7 9))
(16 16
"@@@@"
"@@@@"
"@F@@"
"@GH@"
"@GN@"
"@GOH"
"OOON"
"OOOO"
"OOON"
"@GOH"
"@GN@"
"@GH@"
"@F@@"
"@@@@"
"@@@@"
"@@@@")(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML FB)
(ADDTOVAR LAMA PROMPTWPRINT)
)
(PUTPROPS FILEBROWSER COPYRIGHT ("Xerox Corporation" 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (7331 46137 (CLRPROMPTW 7341 . 7511) (FB 7513 . 7719) (FBCLOSE 7721 . 8122) (
FBROWSEBUTTON 8124 . 8734) (FBROWSEMOVEDFN 8736 . 8981) (FBROWSEOUTFN 8983 . 9123) (FBROWSEREPAINTFN
9125 . 10429) (FBROWSERPRINTANDBOX 10431 . 12361) (FDELCOMMAND 12363 . 12754) (FDIRECTORY 12756 .
13141) (PROMPTWPRINT 13143 . 13554) (FEDITLISPFILE 13556 . 14459) (FEXPNGFILECOMMAND 14461 . 15062) (
FGETFILENAME 15064 . 15221) (FHARDCPYCOMMAND 15223 . 15681) (PROMPTWTERPRI 15683 . 15856) (
FLOADFILECOMMAND 15858 . 16943) (FNEWPTRNCOMMAND 16945 . 18163) (FOPENINFOW 18165 . 19004) (
FRENAMEFILECOMMAND 19006 . 19882) (FBROWSERIGHT 19884 . 20108) (FBROWSESELECT 20110 . 21793) (
FDOEDITCOMMAND 21795 . 22629) (FDOFILEBROWSERCOMMAND 22631 . 25663) (FDOSEECOMMAND 25665 . 26099) (
FILEBROWSER 26101 . 31386) (CREATEINFOMENU 31388 . 32006) (FILEBROWSERInfoMenuFn 32008 . 32628) (
FINDFOLDER 32630 . 33005) (FMAKEFOLDERSELECTED 33007 . 33478) (FMAKEFOLDERUNSELECTED 33480 . 33888) (
FMAKESEEWINDOW 33890 . 34703) (FCHANGEFOLDERMARK 34705 . 35176) (FCHANGESELMARK 35178 . 35568) (
FCOMPLFILECOMMAND 35570 . 36639) (FCOPYFILECOMMAND 36641 . 37465) (FMARKFOLDERSELECTED 37467 . 37667)
(FMARKFOLDERUNSELECTED 37669 . 37868) (FPRINTFILEINFO 37870 . 39895) (FPROMPTEDIT 39897 . 40402) (
FSEEREPAINTFN 40404 . 40686) (FSEERESHAPEFN 40688 . 41437) (FSHORTFILENAME 41439 . 42240) (
FPRINTHEADER 42242 . 43045) (FUNDELCOMMAND 43047 . 43436) (FUPDATEBROWSERITEMS 43438 . 45502) (
FUPDATECOMMAND 45504 . 46135)))))
STOP