(FILECREATED "22-Jul-86 17:07:22" {ERIS}<LISPCORE>LIBRARY>FILEBROWSER.;53 178340
changes to: (RECORDS FILEBROWSER)
(FNS FB.COPY/RENAME.MANY)
previous date: " 9-Apr-86 15:11:43" {ERIS}<LISPCORE>LIBRARY>FILEBROWSER.;52)
(* Copyright (c) 1983, 1984, 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT FILEBROWSERCOMS)
(RPAQQ FILEBROWSERCOMS
[(COMS (FILES ATTACHEDWINDOW ICONW TABLEBROWSER)
(INITVARS (FB.EXPUNGE?MENU)
(FB.ICONFONT (FONTCREATE (QUOTE HELVETICA)
8
(QUOTE MRR)))
(FB.BROWSERFONT (FONTCREATE (QUOTE GACHA)
10
(QUOTE MRR)))
(FB.PROMPTFONT (FONTCREATE (QUOTE GACHA)
8
(QUOTE MRR)))
(FB.PROMPTLINES 3)
(FB.MENUFONT (FONTCREATE (QUOTE HELVETICA)
10
(QUOTE MRR)))
(FB.OVERFLOW.MAXABSOLUTE 30)
(FB.OVERFLOW.MAXFRAC .06))
(VARS FB.CLOSEMENUITEMS FB.MENU.ITEMS FB.DEFAULT.INFO FB.DEFAULT.NAME.WIDTH
FB.INFOFIELDS FB.INFOSHADE FB.INFOMENUITEMS FB.ITEMUNSELECTEDSHADE
FB.ITEMSELECTEDSHADE)
(COMS (BITMAPS FILEDRAWER)
(VARS FILEDRAWERREGION)))
(COMS (* Entries)
(FNS FB FILEBROWSER FB.PRINTFN FB.COPYFN)
(* Setup)
(FNS FB.STARTUP FB.MAKERIGIDWINDOW))
(COMS (* commands and major subfunctions)
(FNS FB.MENU.WHENSELECTEDFN FB.COMMANDSELECTEDFN FB.SUBITEMP FB.MAKE.BROWSER.BUSY)
(FNS FB.SELECTEDFILES FB.TABLEBROWSER FB.FETCHFILENAME)
(FNS FB.DELETECOMMAND FB.DELVERCOMMAND FB.IS.NOT.SUBDIRECTORY.ITEM FB.DELVER.FILES
FB.DELETE.FILE FB.UNDELETE.FILE FB.UNDELETECOMMAND FB.UNDELETEALLCOMMAND
FB.HARDCOPYCOMMAND FB.HARDCOPY.TOFILE FB.LOADCOMMAND FB.EDITCOMMAND
FB.VIEW.SUBDIRECTORY? FB.EDITLISPFILE FB.COMPILECOMMAND FB.OPERATE.ON.FILES
FB.COPYCOMMAND FB.RENAMECOMMAND FB.COPY/RENAME.COMMAND FB.COPY/RENAME.ONE
FB.COPY/RENAME.MANY FB.GREATEST.PREFIX FB.MAYBE.INSERT.FILE FB.GET.NEW.FILE.SPEC)
(FNS FB.UPDATECOMMAND FB.MAYBE.EXPUNGE FB.UPDATEBROWSERITEMS FB.CLEANUP.UPDATE
FB.ABORT.UPDATE FB.MAYBE.WIDEN.NAMES FB.SET.DEFAULT.NAME.WIDTH
FB.CREATE.FILEBUCKET FB.CHECK.NAME.LENGTH FB.ADD.FILEGROUP FB.INSERT.DIRECTORY
FB.MAKE.SUBDIRECTORY.ITEM FB.ADD.FILE FB.INSERT.FILE FB.ANALYZE.PATTERN
FB.GETALLFILEINFO)
(FNS FB.SORT.VERSIONS FB.DECREASING.VERSION FB.INCREASING.VERSION
FB.NAMES.DECREASING.VERSION FB.NAMES.INCREASING.VERSION FB.DECREASING.NUMERIC.ATTR
FB.INCREASING.NUMERIC.ATTR FB.ALPHABETIC.ATTR)
(FNS FB.SORTCOMMAND FB.INSERT.SUBDIRECTORIES FB.GET.SORT.MENU)
(FNS FB.EXPUNGECOMMAND FB.REMOVE.FILE FB.COUNT.FILE.CHANGE FB.NEWPATTERNCOMMAND
FB.SETNEWPATTERN FB.NEWINFOCOMMAND FB.GET.NEWPATTERN FB.OPTIONSCOMMAND))
(COMS (* window functions)
(FNS FB.PROMPTWPRINT FB.PROMPTFORINPUT FB.INFOMENU.SHADEINITIALSELECTIONS
FB.\ItemWithTag)
(FNS FB.MAKECOUNTERWINDOW FB.COUNTERW.REDISPLAYFN FB.UPDATE.COUNTERS
FB.DISPLAY.COUNTERS FB.COUNTER.STRING)
(FNS FB.MAKEHEADINGWINDOW FB.HEADINGW.REDISPLAYFN FB.HEADINGW.RESHAPEFN
FB.HEADINGW.DISPLAY)
(FNS FB.ICONFN FB.SCROLLFN FB.UPDATE.HEADING.EXTENT FB.INFOMENU.WHENSELECTEDFN
FB.CLOSEFN FB.EXPUNGE?.MENU FB.AFTERCLOSEFN FB.CLOSE&EXPUNGE)
(FNS FB.FASTSEECOMMAND FB.FASTSEE.ONEFILE FB.SEEFULLFN FB.SEEBUTTONFN))
(DECLARE: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
TABLEBROWSERDECLS)
(RECORDS INFOFIELD FBFILEDATA FILEBROWSER)
(CONSTANTS FB.MORE.BORDER FB.NULL.VERSION)
(MACROS NULL.VERSIONP NULL.FIELDP)
(GLOBALVARS FB.ICONFONT FB.BROWSERFONT FB.PROMPTFONT FB.MENUFONT FB.EXPUNGE?MENU
FILEDRAWER FB.CLOSEMENUITEMS FB.MENU.ITEMS FB.DEFAULT.INFO INFOLISTINGWIDTHS
FB.INFOSHADE FB.INFOMENUITEMS FB.ITEMUNSELECTEDSHADE FB.ITEMSELECTEDSHADE
DIRCOMMANDS FB.PROMPTLINES FB.INFOFIELDS WindowTitleDisplayStream
FILEDRAWERREGION FB.DEFAULT.NAME.WIDTH FB.OVERFLOW.MAXABSOLUTE
FB.OVERFLOW.MAXFRAC WBorder))
(INITRECORDS FILEBROWSER FBFILEDATA)
(SYSRECORDS FILEBROWSER FBFILEDATA)
(DECLARE: DONTEVAL@LOAD DOCOPY (ADDVARS (BackgroundMenuCommands ("FileBrowser" (QUOTE (
FILEBROWSER
))
"Opens a filebrowser window; prompts for pattern"
)))
(VARS (BackgroundMenu)))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA FB)
(NLAML)
(LAMA FB.PROMPTWPRINT])
(FILESLOAD ATTACHEDWINDOW ICONW TABLEBROWSER)
(RPAQ? FB.EXPUNGE?MENU )
(RPAQ? FB.ICONFONT (FONTCREATE (QUOTE HELVETICA)
8
(QUOTE MRR)))
(RPAQ? FB.BROWSERFONT (FONTCREATE (QUOTE GACHA)
10
(QUOTE MRR)))
(RPAQ? FB.PROMPTFONT (FONTCREATE (QUOTE GACHA)
8
(QUOTE MRR)))
(RPAQ? FB.PROMPTLINES 3)
(RPAQ? FB.MENUFONT (FONTCREATE (QUOTE HELVETICA)
10
(QUOTE MRR)))
(RPAQ? FB.OVERFLOW.MAXABSOLUTE 30)
(RPAQ? FB.OVERFLOW.MAXFRAC .06)
(RPAQQ FB.CLOSEMENUITEMS (("Expunge deleted files" (QUOTE EXPUNGE)
"Erases all files still marked 'deleted'")
("Don't expunge" (QUOTE NOEXPUNGE)
"Proceeds (closes or updates browser) without expunging deleted files.
Your deletions are thus ignored.")))
(RPAQQ FB.MENU.ITEMS ((Delete FB.DELETECOMMAND
"Marks selected files for deletion.
(Use EXPUNGE to remove files from system)" (SUBITEMS ("Delete Selected Files" FB.DELETECOMMAND
"Marks the selected files for deletion."
)
("Delete Old Versions" FB.DELVERCOMMAND "Marks for deletion old versions of all files in the browser.
You specify how many versions to keep.")))
(Undelete FB.UNDELETECOMMAND "Removes deletion mark for selected files"
(SUBITEMS ("Undelete ALL Files" FB.UNDELETEALLCOMMAND
"Removes deletion mark from all files in the browser"))
)
(Copy FB.COPYCOMMAND
"Copies selected files (prompts for new file name/directory)")
(Rename FB.RENAMECOMMAND
"Renames (moves) selected files (prompts for new name/directory)")
(Hardcopy FB.HARDCOPYCOMMAND
"Produces hardcopy of selected files on your default printer"
(SUBITEMS ("To a file" (FB.HARDCOPYCOMMAND FILE)
"Generates a hardcopy master of selected file; prompts for filename and format"
)
("To a printer" (FB.HARDCOPYCOMMAND PRINTER)
"Sends hardcopy of selected files to a printer of your choosing"
)))
(See FB.FASTSEECOMMAND
"Displays selected files one at a time in a separate window"
(SUBITEMS ("Fast SEE Pretty" FB.FASTSEECOMMAND
"Views file quickly, uses font information, no scrolling backwards"
)
("Fast SEE Unformatted" (FB.FASTSEECOMMAND T)
"Views file quickly, shows raw characters, no scrolling backwards"
)
("Scrollable & Pretty" (FB.EDITCOMMAND READONLY)
"Views file with font information in a fully scrollable window"
)))
(Edit FB.EDITCOMMAND
"Calls an editor on the selected files:
DEDIT for LISP source & TEDIT for other files" (SUBITEMS (TEDIT (FB.EDITCOMMAND TEDIT)
"Calls TEdit (text editor) on selected files"
)
(DEDIT (FB.EDITCOMMAND DEDIT)
"Calls DEdit (Lisp editor) on selected files"
)))
(Load FB.LOADCOMMAND "LOADs selected files" (SUBITEMS (LOAD FB.LOADCOMMAND
"Performs LOAD on selected files"
)
("Load PROP" (FB.LOADCOMMAND
PROP)
"Loads the selected files with LDFLG = PROP"
)
("Load SYSLOAD" (
FB.LOADCOMMAND
SYSLOAD)
"System-loads the files (fast but not undoable)"
)
(LOADFROM (FB.LOADCOMMAND
LOADFROM)
"Performs LOADFROM on selected files"
)
(LOADCOMP (FB.LOADCOMMAND
LOADCOMP)
"Performs LOADCOMP on selected files"
)))
(Compile FB.COMPILECOMMAND "Compiles selected LISP source files"
(SUBITEMS (TCOMPL (FB.COMPILECOMMAND TCOMPL)
"Does TCOMPL on selected files")
(BCOMPL FB.COMPILECOMMAND "Does BCOMPL on selected files")))
(Expunge FB.EXPUNGECOMMAND
"Permanently removes from the file system all files marked for deletion"
)
(Recompute FB.UPDATECOMMAND
"Recomputes set of files satisfying selection pattern"
(SUBITEMS ("Same Pattern" FB.UPDATECOMMAND
"Recomputes set of files satisfying current pattern")
("New Pattern" FB.NEWPATTERNCOMMAND
"Prompts for a new selection pattern and updates browser")
("New Info" FB.NEWINFOCOMMAND
"Change the set of file attributes that are displayed")))
(Sort FB.SORTCOMMAND
"Sorts all the files in the browser by the attribute of your choice")))
(RPAQQ FB.DEFAULT.INFO (SIZE CREATIONDATE AUTHOR))
(RPAQQ FB.DEFAULT.NAME.WIDTH 140)
(RPAQQ FB.INFOFIELDS ((LENGTH " Length" 70 (FIX 56))
(SIZE "Pages" 50 (FIX 35))
(BYTESIZE "Bits" 40 (FIX 21))
(TYPE "Type" 55)
(CREATIONDATE "Created" 170)
(READDATE "Read" 170)
(WRITEDATE "Written" 180)
(AUTHOR "Author" 120)))
(RPAQQ FB.INFOSHADE 32800)
(RPAQQ FB.INFOMENUITEMS ((Length LENGTH "Toggles Length display")
(ByteSize BYTESIZE "Toggles ByteSize 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")
(Author AUTHOR "Toggles Author display")))
(RPAQQ FB.ITEMUNSELECTEDSHADE 0)
(RPAQQ FB.ITEMSELECTEDSHADE 4672)
(RPAQ FILEDRAWER (READBITMAP))
(83 70
"OOOOOOOOOOOOOOOOOOOON@@@"
"OOOOOOOOOOOOOOOOOOOON@@@"
"L@@@@@@@@@@@@@@@@@@@F@@@"
"L@@@@@@@@@@@@@@@@@@@F@@@"
"LOOOOOOOOOOOOOOOOOONF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@GOOOOOL@@@@@BF@@@"
"LH@@@@@D@@@@@D@@@@@BF@@@"
"LH@@@@@D@@@@@D@@@@@BF@@@"
"LH@@@@@DCOOOHD@@@@@BF@@@"
"LH@@@@@D@@@@@D@@@@@BF@@@"
"LH@@@@@DOOOOND@@@@@BF@@@"
"LH@@@@@D@@@@@D@@@@@BF@@@"
"LH@@@@@D@@@@@D@@@@@BF@@@"
"LH@@@@@GOOOOOL@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@COOOOOH@@@@@BF@@@"
"LH@@@@@COOOOOH@@@@@BF@@@"
"LH@@@@@B@@@@@H@@@@@BF@@@"
"LH@@@@@A@@@@A@@@@@@BF@@@"
"LH@@@@@@OOOON@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LH@@@@@@@@@@@@@@@@@BF@@@"
"LOOOOOOOOOOOOOOOOOONF@@@"
"L@@@@@@@@@@@@@@@@@@@F@@@"
"L@@@@@@@@@@@@@@@@@@@F@@@"
"OOOOOOOOOOOOOOOOOOOON@@@"
"OOOOOOOOOOOOOOOOOOOON@@@")
(RPAQQ FILEDRAWERREGION (5 5 73 40))
(* Entries)
(DEFINEQ
(FB
[NLAMBDA PATTERN (* bvm: " 4-Sep-85 22:13")
(* * FILEBROWSER entry from top-level exec: FB PATTERN ...
PROPS ...)
(LET ((PAT&PROPS (NLAMBDA.ARGS PATTERN)))
(FILEBROWSER (CAR PAT&PROPS)
(CDR PAT&PROPS)))
NIL])
(FILEBROWSER
[LAMBDA (FILESPEC ATTRIBUTES OPTIONS) (* bvm: "20-Dec-85 21:39")
(PROG ((TITLEFONT (DSPFONT NIL WindowTitleDisplayStream))
(BROWSERFONTHEIGHT (FONTPROP FB.BROWSERFONT (QUOTE HEIGHT)))
BROWSER PROMPTWHEIGHT COUNTERHEIGHT COMMANDMENUWINDOW COMMANDMENUWIDTH BROWSERWIDTH
BROWSERWINDOW COMMANDMENU HEADINGW COUNTERW REGION TITLE)
[COND
([AND (LISTP OPTIONS)
(SMALLP (CAR OPTIONS))
(AND (EQLENGTH OPTIONS 4)
(EVERY OPTIONS (FUNCTION NUMBERP] (* Old style)
(SETQ REGION OPTIONS)
(SETQ OPTIONS))
(T (SETQ REGION (LISTGET OPTIONS (QUOTE REGION]
(PROGN (* Figure out the size of the fixed
pieces before prompting for a region)
(SETQ COMMANDMENU (create MENU
MENUFONT ← FB.MENUFONT
ITEMS ← (OR (LISTGET OPTIONS (QUOTE MENU.ITEMS))
FB.MENU.ITEMS)
CENTERFLG ← T
MENUCOLUMNS ← 1
WHENSELECTEDFN ← (FUNCTION FB.MENU.WHENSELECTEDFN)
TITLE ← (OR (LISTGET OPTIONS (QUOTE MENU.TITLE))
"FB Commands")))
(SETQ COMMANDMENUWIDTH (fetch (MENU IMAGEWIDTH) of COMMANDMENU))
[SETQ PROMPTWHEIGHT (HEIGHTIFWINDOW (ITIMES FB.PROMPTLINES (FONTPROP FB.PROMPTFONT
(QUOTE HEIGHT]
(SETQ COUNTERHEIGHT (HEIGHTIFWINDOW (FONTPROP TITLEFONT (QUOTE HEIGHT))
T)))
[PROGN (* First make the main window, carved
out of the space in REGION leftover
after the fixed parts are accounted
for)
[OR REGION (SETQ REGION (GETREGION (PROG1 (IPLUS COMMANDMENUWIDTH
FB.DEFAULT.NAME.WIDTH
TB.LEFT.MARGIN)
(* Min width is menu plus enough space
to print a name)
)
(PROG1 (IPLUS PROMPTWHEIGHT COUNTERHEIGHT
(ITIMES 6 BROWSERFONTHEIGHT))
(* Min height is prompt window plus
counter window plus heading plus 5
lines of files)
]
[SETQ BROWSERWINDOW (CREATEW (create REGION using REGION WIDTH ←
(SETQ BROWSERWIDTH
(IDIFFERENCE (fetch (REGION
WIDTH)
of REGION)
COMMANDMENUWIDTH))
HEIGHT ←
(IDIFFERENCE (fetch (REGION HEIGHT
)
of REGION)
(IPLUS COUNTERHEIGHT
PROMPTWHEIGHT
BROWSERFONTHEIGHT]
(DSPFONT FB.BROWSERFONT BROWSERWINDOW)
[WINDOWPROP BROWSERWINDOW (QUOTE FILEBROWSER)
(SETQ BROWSER (create FILEBROWSER
BROWSERWINDOW ← BROWSERWINDOW
BROWSERFONT ← FB.BROWSERFONT
OVERFLOWSPACING ← (ITIMES 3 (CHARWIDTH (CHARCODE a)
FB.BROWSERFONT))
SORTBY ← (FUNCTION FB.NAMES.DECREASING.VERSION)
FIXEDTITLE ← (SETQ TITLE (LISTGET OPTIONS (QUOTE TITLE]
(replace (FILEBROWSER TABLEBROWSER) of BROWSER
with (TB.MAKE.BROWSER NIL BROWSERWINDOW (LIST (QUOTE PRINTFN)
(FUNCTION FB.PRINTFN)
(QUOTE COPYFN)
(FUNCTION FB.COPYFN)
(QUOTE USERDATA)
BROWSER
(QUOTE CLOSEFN)
(FUNCTION FB.CLOSEFN)
(QUOTE AFTERCLOSEFN)
(FUNCTION FB.AFTERCLOSEFN]
(PROGN (* Atop this sits the black heading
window, with labels for each column in
browser)
(FB.MAKEHEADINGWINDOW BROWSERWINDOW BROWSERWIDTH BROWSERFONTHEIGHT FB.BROWSERFONT))
(PROGN (* Atop that is the counter window,
whose title contains the file pattern)
(FB.MAKECOUNTERWINDOW BROWSERWINDOW TITLEFONT BROWSERWIDTH COUNTERHEIGHT TITLE))
(PROGN (* Main command menu sits on the right
side)
(SETQ COMMANDMENUWINDOW (MENUWINDOW COMMANDMENU))
(ATTACHWINDOW COMMANDMENUWINDOW BROWSERWINDOW (QUOTE RIGHT)
(QUOTE TOP)))
[PROGN (* Finally the prompt window atop it
all)
(replace (FILEBROWSER PROMPTWINDOW) of BROWSER with (FB.MAKERIGIDWINDOW (
GETPROMPTWINDOW
BROWSERWINDOW
FB.PROMPTLINES
FB.PROMPTFONT
]
(PROGN (* Now make them all open.
For some reason, attaching the menu
didn't open it)
(TOTOPW BROWSERWINDOW))
(WINDOWPROP BROWSERWINDOW (QUOTE SCROLLFN)
(FUNCTION FB.SCROLLFN))
(COND
[ATTRIBUTES (* User specifies which attributes to
use)
(for X on ATTRIBUTES do (OR (FB.\ItemWithTag (CAR X)
FB.INFOMENUITEMS)
(AND (LISTP DIRCOMMANDS)
(MISSPELLED? (CAR X)
99 DIRCOMMANDS NIL X]
(T (SETQ ATTRIBUTES FB.DEFAULT.INFO)))
(replace (FILEBROWSER INFOMENUCHOICES) of BROWSER with ATTRIBUTES)
(WINDOWPROP BROWSERWINDOW (QUOTE ICONFN)
(FUNCTION FB.ICONFN))
(ADD.PROCESS (LIST (FUNCTION FB.STARTUP)
BROWSER COMMANDMENU (KWOTE FILESPEC))
(QUOTE NAME)
(QUOTE FB-Update)
(QUOTE BEFOREEXIT)
(QUOTE DON'T))
(RETURN BROWSERWINDOW])
(FB.PRINTFN
[LAMBDA (TBROWSER ITEM WINDOW) (* bvm: "16-Oct-85 00:12")
(LET ((FBROWSER (TB.USERDATA TBROWSER))
(FDATA (fetch TIDATA of ITEM))
FONT XPOS INFOWANTED FILEINFO NEXTPOS HEADING INFO VERSION FORMAT TEMP CHEAT ACTUALNEXT
CHAR0)
(COND
((fetch (FBFILEDATA DIRECTORYP) of FDATA)
(PRIN1 " " WINDOW)))
(PRIN1 (fetch (FBFILEDATA PRINTNAME) of FDATA)
WINDOW)
(COND
([NOT (NULL.VERSIONP (SETQ VERSION (fetch (FBFILEDATA VERSION) of FDATA]
(PRINTOUT WINDOW (QUOTE ;)
.I1 VERSION)))
(SETQ NEXTPOS (fetch (FILEBROWSER INFOSTART) of FBROWSER))
(COND
((SETQ INFOWANTED (fetch (FILEBROWSER INFODISPLAYED) of FBROWSER))
(SETQ FILEINFO (fetch (FBFILEDATA FILEINFO) of FDATA))
(for SPEC in FB.INFOFIELDS when (FMEMB (SETQ HEADING (fetch INFONAME of SPEC))
INFOWANTED)
do (SETQ FORMAT (fetch INFOFORMAT of SPEC))
(SETQ INFO (LISTGET FILEINFO HEADING))
(SETQ XPOS (DSPXPOSITION NIL WINDOW))
(SETQ ACTUALNEXT NEXTPOS)
[COND
((AND FORMAT (FIXP INFO))
(SETQ INFO (MKSTRING INFO)) (* Get numbers to line up right
justified)
(SETQ ACTUALNEXT (IMAX [IDIFFERENCE (IPLUS NEXTPOS (CADR FORMAT))
(STRINGWIDTH INFO (SETQ FONT (fetch (FILEBROWSER
BROWSERFONT
)
of FBROWSER]
(IPLUS XPOS (CHARWIDTH (CHARCODE 0)
FONT]
(COND
((LESSP XPOS ACTUALNEXT)
(TB.CLEAR.LINE TBROWSER ITEM XPOS (DIFFERENCE ACTUALNEXT XPOS))
(DSPXPOSITION ACTUALNEXT WINDOW))
(INFO (* Need some space before next item)
(PRIN1 " " WINDOW)))
(COND
(INFO (PRIN1 INFO WINDOW)))
(add NEXTPOS (fetch INFOWIDTH of SPEC])
(FB.COPYFN
[LAMBDA (TBROWSER ITEM) (* bvm: "13-Oct-85 17:44")
(BKSYSBUF (fetch (FBFILEDATA FILENAME) of (fetch TIDATA of ITEM])
)
(* Setup)
(DEFINEQ
(FB.STARTUP
[LAMBDA (BROWSER COMMANDMENU FILESPEC) (* bvm: "18-Sep-85 22:18")
(RESETLST (FB.MAKE.BROWSER.BUSY BROWSER (FASSOC (QUOTE Recompute)
(fetch (MENU ITEMS) of COMMANDMENU))
COMMANDMENU)
(COND
(FILESPEC (replace PATTERN of BROWSER with (SETQ FILESPEC (DIRECTORY.FILL.PATTERN
FILESPEC)))
(FB.UPDATEBROWSERITEMS BROWSER))
(T (FB.NEWPATTERNCOMMAND BROWSER])
(FB.MAKERIGIDWINDOW
[LAMBDA (WINDOW) (* bvm: "22-Jul-85 16:14")
(* * make the argument window immutable w/r/to attachedwindow package)
(LET [(HEIGHT (fetch (REGION HEIGHT) of (WINDOWPROP WINDOW (QUOTE REGION]
(WINDOWPROP WINDOW (QUOTE MINSIZE)
(CONS 0 HEIGHT))
(WINDOWPROP WINDOW (QUOTE MAXSIZE)
(CONS SCREENWIDTH HEIGHT))
WINDOW])
)
(* commands and major subfunctions)
(DEFINEQ
(FB.MENU.WHENSELECTEDFN
[LAMBDA (Item Menu Key) (* bvm: "18-Sep-85 17:16")
(ADD.PROCESS (LIST (FUNCTION FB.COMMANDSELECTEDFN)
(KWOTE Item)
(KWOTE Menu)
(KWOTE Key))
(QUOTE NAME)
(PACK* (QUOTE FB-)
(CAR Item))
(QUOTE BEFOREEXIT)
(QUOTE DON'T])
(FB.COMMANDSELECTEDFN
[LAMBDA (ITEM MENU KEY) (* bvm: "14-Sep-85 15:53")
(RESETLST (LET* [(REALITEM ITEM)
(WINDOW (WINDOWPROP (WFROMMENU MENU)
(QUOTE MAINWINDOW)))
(FBROWSER (WINDOWPROP WINDOW (QUOTE FILEBROWSER]
[COND
((NOT (MEMBER ITEM (fetch (MENU ITEMS) of MENU)))
(* A subitem -- fetch main item)
(SETQ ITEM (for I in (fetch (MENU ITEMS) of MENU)
thereis (FB.SUBITEMP ITEM I]
(COND
((FB.MAKE.BROWSER.BUSY FBROWSER ITEM MENU)
(LET ((FN (CADR REALITEM))
(PWINDOW (fetch (FILEBROWSER PROMPTWINDOW) of FBROWSER))
EXTRA)
(COND
((OPENWP PWINDOW)
(CLEARW PWINDOW)))
[COND
((LISTP FN)
(SETQ EXTRA (CADR FN))
(SETQ FN (CAR FN]
(APPLY* FN FBROWSER KEY REALITEM MENU EXTRA)))
(T (* Used to be (FB.PROMPTWPRINT WINDOW
"This filebrowser is busy") but that
trashes the prompt window)
(FLASHWINDOW WINDOW])
(FB.SUBITEMP
[LAMBDA (SUBITEM ITEM) (* bvm: "22-Jul-85 15:08")
(* * True if SUBITEM appears among the subitems of ITEM or descendents)
(LET ((SUB (CADDDR ITEM)))
(AND SUB (EQ (CAR (LISTP SUB))
(QUOTE SUBITEMS))
(OR (MEMBER SUBITEM SUB)
(for I in (CDR SUB) thereis (FB.SUBITEMP SUBITEM I])
(FB.MAKE.BROWSER.BUSY
[LAMBDA (BROWSER ITEM MENU DONTWAIT) (* bvm: "14-Sep-85 15:59")
(* * Makes browser "busy" doing ITEM of MENU.
Must be called under RESETLST)
(COND
((OBTAIN.MONITORLOCK (fetch (FILEBROWSER TBLOCK) of BROWSER)
DONTWAIT T)
(RESETSAVE NIL (LIST [FUNCTION (LAMBDA (ITEM MENU)
(SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE]
ITEM MENU))
(SHADEITEM ITEM MENU FB.ITEMSELECTEDSHADE)
T])
)
(DEFINEQ
(FB.SELECTEDFILES
[LAMBDA (BROWSER NOERRORFLG) (* bvm: "12-Sep-85 18:33")
(COND
((TB.COLLECT.ITEMS (fetch (FILEBROWSER TABLEBROWSER) of BROWSER)
(QUOTE SELECTED)))
((NOT NOERRORFLG)
(FB.PROMPTWPRINT BROWSER T "No files are selected")
NIL])
(FB.TABLEBROWSER
[LAMBDA (FILEBROWSER) (* bvm: "18-Sep-85 19:06")
(fetch (FILEBROWSER TABLEBROWSER) of FILEBROWSER])
(FB.FETCHFILENAME
[LAMBDA (ITEM) (* bvm: "13-Oct-85 17:44")
(fetch (FBFILEDATA FILENAME) of (fetch TIDATA of ITEM])
)
(DEFINEQ
(FB.DELETECOMMAND
[LAMBDA (BROWSER) (* bvm: "12-Sep-85 15:44")
(TB.MAP.SELECTED.ITEMS (fetch (FILEBROWSER TABLEBROWSER) of BROWSER)
(FUNCTION FB.DELETE.FILE))
(FB.UPDATE.COUNTERS BROWSER])
(FB.DELVERCOMMAND
[LAMBDA (FBROWSER) (* bvm: "13-Oct-85 16:52")
(LET ((NVERSIONS (FB.PROMPTFORINPUT "Number of versions to keep: " "1" FBROWSER T))
TBROWSER NDELETED FILES)
(COND
((NOT NVERSIONS)
NIL)
([NOT (FIXP (SETQ NVERSIONS (MKATOM NVERSIONS]
(FB.PROMPTWPRINT FBROWSER T "?? " NVERSIONS " not an integer."))
(T (SETQ FILES (TB.COLLECT.ITEMS (SETQ TBROWSER (fetch (FILEBROWSER TABLEBROWSER)
of FBROWSER))
(FUNCTION FB.IS.NOT.SUBDIRECTORY.ITEM)))
(SETQ NDELETED (FB.DELVER.FILES TBROWSER (SELECTQ (fetch (FILEBROWSER SORTBY)
of FBROWSER)
(FB.NAMES.DECREASING.VERSION
(* Just right)
FILES)
(FB.NAMES.INCREASING.VERSION
(* Close, but no cigar)
(FB.SORT.VERSIONS
FILES
(FUNCTION FB.DECREASING.VERSION)))
(SORT FILES (FUNCTION
FB.NAMES.DECREASING.VERSION)
))
NVERSIONS))
(FB.UPDATE.COUNTERS FBROWSER (QUOTE DELETED))
(FB.PROMPTWPRINT FBROWSER T "Done, " NDELETED " files marked for deletion."])
(FB.IS.NOT.SUBDIRECTORY.ITEM
[LAMBDA (BROWSER ITEM) (* bvm: "13-Oct-85 16:51")
(NOT (fetch TIUNSELECTABLE of ITEM])
(FB.DELVER.FILES
[LAMBDA (TBROWSER FILES NVERSIONS) (* bvm: "15-Oct-85 00:20")
(for FILE in FILES bind (#DELETED ← 0)
(#SEENSOFAR ← 0)
THISNAME LASTNAME do (* Files now all lined up, decreasing
version. Just pass by NVERSIONS of
each file)
(COND
[(STRING-EQUAL (SETQ THISNAME
(fetch (FBFILEDATA
VERSIONLESSNAME)
of (fetch TIDATA of FILE)))
LASTNAME)
(COND
((GREATERP (add #SEENSOFAR 1)
NVERSIONS)
(COND
((FB.DELETE.FILE TBROWSER FILE)
(add #DELETED 1]
(T (SETQ LASTNAME THISNAME)
(SETQ #SEENSOFAR 1)))
finally (RETURN #DELETED])
(FB.DELETE.FILE
[LAMBDA (TBROWSER ITEM) (* bvm: "13-Oct-85 17:44")
(COND
((NOT (fetch TIDELETED of ITEM))
(LET ((FBROWSER (TB.USERDATA TBROWSER))
SIZE)
(TB.DELETE.ITEM TBROWSER ITEM)
(add (fetch (FILEBROWSER DELETEDFILES) of FBROWSER)
1)
(COND
((SETQ SIZE (fetch (FBFILEDATA SIZE) of (fetch TIDATA of ITEM)))
(add (fetch (FILEBROWSER DELETEDPAGES) of FBROWSER)
SIZE)))
T])
(FB.UNDELETE.FILE
[LAMBDA (TBROWSER ITEM) (* bvm: "13-Oct-85 17:44")
(COND
((fetch TIDELETED of ITEM)
(LET ((FBROWSER (TB.USERDATA TBROWSER))
SIZE)
(TB.UNDELETE.ITEM TBROWSER ITEM)
(add (fetch (FILEBROWSER DELETEDFILES) of FBROWSER)
-1)
(COND
((SETQ SIZE (fetch (FBFILEDATA SIZE) of (fetch TIDATA of ITEM)))
(add (fetch (FILEBROWSER DELETEDPAGES) of FBROWSER)
(IMINUS SIZE])
(FB.UNDELETECOMMAND
[LAMBDA (BROWSER) (* bvm: "12-Sep-85 15:44")
(TB.MAP.SELECTED.ITEMS (fetch (FILEBROWSER TABLEBROWSER) of BROWSER)
(FUNCTION FB.UNDELETE.FILE))
(FB.UPDATE.COUNTERS BROWSER])
(FB.UNDELETEALLCOMMAND
[LAMBDA (BROWSER) (* bvm: "18-Sep-85 12:20")
(TB.MAP.ITEMS (fetch (FILEBROWSER TABLEBROWSER) of BROWSER)
(FUNCTION FB.UNDELETE.FILE))
(FB.UPDATE.COUNTERS BROWSER])
(FB.HARDCOPYCOMMAND
[LAMBDA (BROWSER KEY ITEM MENU OPTION) (* bvm: "13-Oct-85 15:40")
(* * Produces hardcopy of selected files.
Subcommands allow directing output to particular printer, or to a file)
(LET ((FILES (FB.SELECTEDFILES BROWSER))
PRINTOPTIONS)
(COND
((AND FILES (SELECTQ OPTION
(FILE (FB.HARDCOPY.TOFILE BROWSER FILES)
NIL)
(PRINTER (COND
((SETQ PRINTOPTIONS (GetPrinterName))
(SETQ PRINTOPTIONS (LIST (QUOTE SERVER)
PRINTOPTIONS))
T)))
T))
(for ITEM in FILES do (LISTFILES1 (FB.FETCHFILENAME ITEM)
PRINTOPTIONS])
(FB.HARDCOPY.TOFILE
[LAMBDA (BROWSER FILES) (* bvm: " 6-Mar-86 15:52")
(PROG ((HCOPYFILE (FB.PROMPTFORINPUT (COND
((CDR FILES)
"Hardcopy file name pattern: ")
(T "Hardcopy file name: "))
[COND
((CDR FILES)
(PACKFILENAME.STRING (QUOTE NAME)
(QUOTE *)
(QUOTE EXTENSION)
(PRINTERTYPE)))
(T (PACKFILENAME.STRING (QUOTE VERSION)
NIL
(QUOTE EXTENSION)
(PRINTERTYPE)
(QUOTE BODY)
(FB.FETCHFILENAME (CAR FILES]
BROWSER T))
HCOPYFIELDS PRINTFILETYPE MSG I HCOPYTAIL FORE AFT EXT)
(COND
((NULL HCOPYFILE)
(RETURN)))
[COND
[(CDR FILES)
(COND
([for TAIL on (SETQ HCOPYFIELDS (UNPACKFILENAME.STRING HCOPYFILE))
by (CDDR TAIL) do (COND
[(EQ (CAR TAIL)
(QUOTE NAME))
(COND
((SETQ I (STRPOS (QUOTE *)
(CADR TAIL)))
(SETQ HCOPYTAIL (CDR TAIL))
(SETQ FORE (OR (SUBSTRING (CADR TAIL)
1
(SUB1 I))
""))
(SETQ AFT (OR (SUBSTRING (CADR TAIL)
(ADD1 I))
"")))
(T (RETURN (SETQ MSG
"Name must have * for multiple hardcopy files"
]
((STRPOS (QUOTE *)
(CADR TAIL))
(* Can't handle wildcards anywhere
else)
(RETURN (SETQ MSG "Only name portion can contain *")))
((EQ (CAR TAIL)
(QUOTE EXTENSION))
(SETQ EXT (MKATOM (U-CASE (CADR TAIL]
(FB.PROMPTWPRINT BROWSER "Bad pattern -- " MSG)
(RETURN]
(T (SETQ EXT (U-CASE (FILENAMEFIELD HCOPYFILE (QUOTE EXTENSION]
(COND
([AND [NULL (SETQ PRINTFILETYPE (for TYPE in PRINTFILETYPES
when [FMEMB EXT (CADR (ASSOC (QUOTE EXTENSION)
(CDR TYPE]
do (* Opencoded
PRINTFILETYPE.FROM.EXTENSION because
that one's buggy)
(RETURN (CAR TYPE]
(NULL (SETQ PRINTFILETYPE (MENU (MakeMenuOfImageTypes "File type?"]
(RETURN)))
(for ITEM in FILES bind (CONVERTERS ← (PRINTFILEPROP PRINTFILETYPE (QUOTE CONVERSION)))
FILETYPE NAME FN
do (SETQ ITEM (FB.FETCHFILENAME ITEM))
(SETQ FILETYPE (OR (PRINTFILETYPE ITEM)
(QUOTE TEXT)))
(COND
((SETQ FN (LISTGET CONVERTERS FILETYPE))
(FB.PROMPTWPRINT BROWSER T "Writing " (SETQ NAME
(COND
((CDR FILES)
(RPLACA HCOPYTAIL
(CONCAT FORE
(FILENAMEFIELD
ITEM
(QUOTE NAME))
AFT))
(PACKFILENAME.STRING (QUOTE VERSION)
NIL
(QUOTE BODY)
HCOPYFIELDS
(QUOTE BODY)
ITEM))
(T HCOPYFILE)))
(QUOTE ...))
(SETQ NAME (APPLY* FN ITEM NAME))
[COND
((LISTP NAME) (* Result is (SOURCE DESTINATION))
(SETQ NAME (CADR NAME]
(FB.PROMPTWPRINT BROWSER "done.")
(FB.MAYBE.INSERT.FILE BROWSER NAME))
(T (FB.PROMPTWPRINT BROWSER T "Failed to hardcopy " ITEM " -- " "Can't convert a "
FILETYPE " file to format " PRINTFILETYPE])
(FB.LOADCOMMAND
[LAMBDA (BROWSER KEY ITEM MENU LOADOP) (* bvm: "18-Sep-85 17:16")
(LET ((FILES (FB.SELECTEDFILES BROWSER)))
(AND FILES (ADD.PROCESS (LIST (FUNCTION FB.OPERATE.ON.FILES)
(KWOTE (OR LOADOP (FUNCTION LOAD)))
(KWOTE FILES))
(QUOTE NAME)
(QUOTE LOAD)
(QUOTE BEFOREEXIT)
(QUOTE DON'T])
(FB.EDITCOMMAND
[LAMBDA (BROWSER KEY ITEM MENU OPTION) (* bvm: "15-Oct-85 01:10")
(for FILE in (FB.SELECTEDFILES BROWSER)
do
(COND
((FB.VIEW.SUBDIRECTORY? (SETQ FILE (FB.FETCHFILENAME FILE))
BROWSER))
(T
(SELECTQ OPTION
(READONLY (* From SEE command)
[COND
((NOT (GETD (QUOTE OPENTEXTSTREAM)))
(FB.FASTSEECOMMAND BROWSER KEY ITEM MENU))
(T
(RESETLST
(LET ((WINDOW (CREATEW NIL FILE))
(STR (OPENSTREAM FILE (QUOTE INPUT)))
SRC)
[COND
((LISPSOURCEFILEP STR)
(RESETSAVE NIL (LIST (QUOTE CLOSEF)
STR))
(SETQ STR (LET ((NSTR (OPENTEXTSTREAM)))
(COPY.TEXT.TO.IMAGE STR NSTR)
NSTR)))
((NOT (RANDACCESSP STR))
(RESETSAVE NIL (LIST (QUOTE CLOSEF)
STR))
(SETQ STR
(LET [(NSTR (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE NEW)
NIL
(LIST (LIST (QUOTE TYPE)
(GETFILEINFO STR (QUOTE TYPE]
(COPYBYTES STR NSTR)
NSTR]
(OPENTEXTSTREAM STR WINDOW NIL NIL (QUOTE (READONLY T])
(TEDIT (TEDIT (MKATOM FILE)))
(DEDIT (FB.EDITLISPFILE FILE BROWSER))
(COND
((LISPSOURCEFILEP FILE)
(FB.EDITLISPFILE FILE BROWSER))
(T (TEDIT (MKATOM FILE])
(FB.VIEW.SUBDIRECTORY?
[LAMBDA (FILENAME BROWSER) (* bvm: "15-Oct-85 01:10")
(* * If FILENAME is a directory name, view it by sprouting a recursive file
browser on it and return T)
(LET ((FIELDS (UNPACKFILENAME.STRING FILENAME)))
(COND
((AND (NULL.FIELDP (LISTGET FIELDS (QUOTE NAME)))
(NULL.FIELDP (LISTGET FIELDS (QUOTE EXTENSION)))
(DIRECTORYNAMEP FILENAME)) (* Item is a directory, so open a sub
filebrowser on it)
(FILEBROWSER (PACKFILENAME.STRING (QUOTE VERSION)
(QUOTE *)
(QUOTE NAME)
(QUOTE *)
(QUOTE EXTENSION)
(QUOTE *)
(QUOTE BODY)
FIELDS)
(fetch INFODISPLAYED of BROWSER))
T])
(FB.EDITLISPFILE
[LAMBDA (FILE BROWSER) (* bvm: "12-Sep-85 18:05")
(PROG (ROOT)
[COND
((NOT (STREQUAL (CDAR (GETPROP (SETQ ROOT (U-CASE (ROOTFILENAME FILE)))
(QUOTE FILEDATES)))
FILE))
(COND
[(MOUSECONFIRM (CONCAT "The file " FILE
" is not loaded or is not current. (LOADFROM '" FILE ")?")
NIL
(fetch (FILEBROWSER PROMPTWINDOW) of BROWSER))
(LISPXEVAL (BQUOTE (LOADFROM %, (KWOTE (MKATOM FILE]
(T (RETURN]
(LISPXEVAL (BQUOTE (EDITDEF (QUOTE %, ROOT)
(QUOTE FILES])
(FB.COMPILECOMMAND
[LAMBDA (BROWSER KEY ITEM MENU COMPILEOP) (* bvm: "18-Sep-85 17:16")
(LET ((FILES (FB.SELECTEDFILES BROWSER)))
(AND FILES (ADD.PROCESS (LIST (FUNCTION FB.OPERATE.ON.FILES)
(KWOTE (OR COMPILEOP (FUNCTION BCOMPL)))
(KWOTE FILES))
(QUOTE NAME)
(QUOTE COMPILE)
(QUOTE BEFOREEXIT)
(QUOTE DON'T])
(FB.OPERATE.ON.FILES
[LAMBDA (FN FILELIST) (* bvm: "25-Jul-85 12:05")
(LET (LDFLG)
(SELECTQ FN
((PROP SYSLOAD)
(SETQ LDFLG FN)
(SETQ FN (QUOTE LOAD)))
NIL)
[LISPXEVAL (CONS (QUOTE PROGN)
(for FILEENTRY in FILELIST
collect (CONS FN (CONS (KWOTE (MKATOM (FB.FETCHFILENAME FILEENTRY)))
(AND LDFLG (LIST (KWOTE LDFLG]
(CLOSEW (TTYDISPLAYSTREAM])
(FB.COPYCOMMAND
[LAMBDA (BROWSER) (* bvm: "12-Sep-85 15:48")
(FB.COPY/RENAME.COMMAND BROWSER (QUOTE Copy)
(FUNCTION COPYFILE])
(FB.RENAMECOMMAND
[LAMBDA (BROWSER) (* bvm: "12-Sep-85 15:48")
(FB.COPY/RENAME.COMMAND BROWSER (QUOTE Rename)
(FUNCTION RENAMEFILE])
(FB.COPY/RENAME.COMMAND
[LAMBDA (FBROWSER CMD MOVEFN) (* bvm: "27-Sep-85 13:06")
(LET ((FILELIST (FB.SELECTEDFILES FBROWSER)))
(COND
((NULL FILELIST))
((CDR FILELIST)
(FB.COPY/RENAME.MANY FBROWSER FILELIST CMD MOVEFN))
(T (* Just one file)
(LET* ((OLDNAME (FB.FETCHFILENAME (CAR FILELIST)))
(NEWNAME (FB.GET.NEW.FILE.SPEC OLDNAME FBROWSER CMD)))
(COND
(NEWNAME (FB.COPY/RENAME.ONE FBROWSER (CAR FILELIST)
OLDNAME NEWNAME CMD MOVEFN])
(FB.COPY/RENAME.ONE
[LAMBDA (FBROWSER ITEM OLDNAME NEWNAME CMD MOVEFN) (* bvm: " 6-Mar-86 17:05")
(* * Copies or renames a single file ITEM from OLDNAME to NEWNAME and updates
browser accordingly)
(LET (ACTUALNEWNAME CHANGETYPE)
(COND
[(SETQ ACTUALNEWNAME (APPLY* MOVEFN OLDNAME NEWNAME))
(FB.PROMPTWPRINT FBROWSER T OLDNAME (SELECTQ CMD
(Copy " copied to ")
(Rename " renamed to ")
(SHOULDNT))
ACTUALNEWNAME)
[COND
((EQ CMD (QUOTE Rename))
(FB.REMOVE.FILE (fetch (FILEBROWSER TABLEBROWSER) of FBROWSER)
FBROWSER ITEM)
(SETQ CHANGETYPE (COND
((fetch TIDELETED of ITEM)
(QUOTE BOTH))
(T (QUOTE TOTAL] (* And then we need to see if
ACTUALNEWNAME belongs in this or some
other browser)
[COND
((FB.MAYBE.INSERT.FILE FBROWSER ACTUALNEWNAME ITEM CMD)
(OR CHANGETYPE (SETQ CHANGETYPE (QUOTE TOTAL]
(COND
(CHANGETYPE (FB.UPDATE.COUNTERS FBROWSER CHANGETYPE]
(T (FB.PROMPTWPRINT FBROWSER T "Could not " (L-CASE CMD)
" " OLDNAME " to " NEWNAME])
(FB.COPY/RENAME.MANY
[LAMBDA (FBROWSER FILELIST CMD MOVEFN) (* bvm: "22-Jul-86 16:05")
(PROG (PREFIX OLDNAME FIELDS SUBDIR RETAIN)
(COND
((NULL (SETQ PREFIX (FB.PROMPTFORINPUT (CONCAT CMD " " (LENGTH FILELIST)
" files to which directory? ")
(OR (fetch (FILEBROWSER DEFAULTDIR) of FBROWSER)
(DIRECTORYNAME T))
FBROWSER T))) (* Aborted)
)
((STRPOS "*" PREFIX)
(FB.PROMPTWPRINT FBROWSER "Sorry, patterns not supported"))
([AND (OR (LISTGET (SETQ FIELDS (UNPACKFILENAME.STRING PREFIX))
(QUOTE HOST))
(LISTGET FIELDS (QUOTE DIRECTORY))
(LISTGET FIELDS (QUOTE DEVICE)))
(OR (LISTGET FIELDS (QUOTE NAME))
(LISTGET FIELDS (QUOTE EXTENSION))
(LISTGET FIELDS (QUOTE VERSION] (* Not a pure directory specification,
and not just a simple directory name)
(FB.PROMPTWPRINT FBROWSER "Not a well-formed directory specification."))
(T (replace (FILEBROWSER DEFAULTDIR) of FBROWSER with (PACKFILENAME.STRING (QUOTE BODY)
FIELDS
(QUOTE DIRECTORY)
(DIRECTORYNAME T)))
(* Now make sure the files are sorted
by increasing version, so that
multiple versions get copied in the
right order)
[SETQ SUBDIR (fetch (FBFILEDATA SUBDIRECTORY) of (fetch TIDATA of (CAR FILELIST]
[COND
([for ITEM in (CDR FILELIST)
thereis (NOT (STRING-EQUAL SUBDIR (fetch (FBFILEDATA SUBDIRECTORY)
of (fetch TIDATA of ITEM]
(FB.PROMPTWPRINT FBROWSER "Selected files are in multiple subdirectories")
(SETQ RETAIN
(FB.PROMPTFORINPUT
(CONCAT "Retain subdirectory names below level of "
[for ITEM in (CDR FILELIST)
do [SETQ SUBDIR (FB.GREATEST.PREFIX SUBDIR
(fetch (FBFILEDATA SUBDIRECTORY)
of (fetch TIDATA of ITEM]
finally (RETURN (OR SUBDIR (SETQ SUBDIR
(SUBSTRING (fetch (FILEBROWSER PATTERN)
of FBROWSER)
1
(SUB1 (fetch (FILEBROWSER
NAMESTART)
of FBROWSER]
"?")
"Yes" FBROWSER T T))
(SETQ RETAIN (COND
((NULL RETAIN) (* Aborted)
(RETURN))
((OR (STRING-EQUAL RETAIN "YES")
(STRING-EQUAL RETAIN "Y"))
(SETQ SUBDIR (ADD1 (NCHARS SUBDIR)))
(* First character that changes)
T)
((OR (STRING-EQUAL RETAIN "NO")
(STRING-EQUAL RETAIN "N"))
NIL)
(T (FB.PROMPTWPRINT FBROWSER "?? ...Aborted.")
(RETURN]
(SELECTQ (fetch (FILEBROWSER SORTBY) of FBROWSER)
(FB.NAMES.INCREASING.VERSION (* Okay)
)
(FB.NAMES.DECREASING.VERSION
(SETQ FILELIST (FB.SORT.VERSIONS FILELIST (FUNCTION FB.INCREASING.VERSION))))
(SORT FILELIST (FUNCTION FB.NAMES.INCREASING.VERSION)))
(SETQ PREFIX (\ADD.CONNECTED.DIR PREFIX))
(for ITEM in FILELIST
do (FB.COPY/RENAME.ONE FBROWSER ITEM (SETQ OLDNAME (FB.FETCHFILENAME ITEM))
(PACKFILENAME.STRING (QUOTE DIRECTORY)
PREFIX
(QUOTE DIRECTORY)
[COND
(RETAIN (* Subdirectory of name between common
prefix and root)
(SUBSTRING OLDNAME SUBDIR
(SUB1 (fetch (FBFILEDATA STARTOFNAME)
of (fetch TIDATA of ITEM]
(QUOTE VERSION)
NIL
(QUOTE BODY)
OLDNAME)
CMD MOVEFN])
(FB.GREATEST.PREFIX
[LAMBDA (X Y) (* bvm: " 6-Mar-86 16:52")
(* * Greatest common prefix of X and Y)
(AND X Y (COND
((STRPOS X Y 1 NIL T NIL UPPERCASEARRAY) (* X is prefix of Y)
X)
((STRPOS Y X 1 NIL T NIL UPPERCASEARRAY)
Y)
(T (LET [(MISMATCH (find I from 1 suchthat (NEQ (NTHCHARCODE X I)
(NTHCHARCODE Y I]
(AND (NEQ MISMATCH 1)
(SUBSTRING X 1 (SUB1 MISMATCH])
(FB.MAYBE.INSERT.FILE
[LAMBDA (FBROWSER NEWNAME OLDITEM CMD) (* bvm: "20-Oct-85 16:38")
(* * If NEWNAME matches the pattern of files displayed in FBROWSER, insert it
in that browser and return T. OLDITEM is the tableitem that formed the source
of NEWNAME. CMD is the command that created NEWNAME --
Copy or Rename)
(LET (FILEINFO N FULLNAME CRDATE CRDATE2 ITEMDATA VERSION NEWITEM)
(COND
((AND (DIRECTORY.MATCH (fetch (FILEBROWSER PREPAREDPATTERN) of FBROWSER)
NEWNAME)
(STRING-EQUAL [SUBSTRING NEWNAME 1 (SETQ N (SUB1 (fetch (FILEBROWSER DIRECTORYSTART
) of FBROWSER]
(SUBSTRING (fetch (FILEBROWSER PATTERN) of FBROWSER)
1 N))) (* NEWNAME belongs in this browser, so
add it)
[COND
(OLDITEM (for TAIL on (SETQ FILEINFO (fetch (FBFILEDATA FILEINFO)
of (fetch TIDATA of OLDITEM)))
by (CDDR TAIL) do (SELECTQ (CAR TAIL)
((WRITEDATE READDATE)
(* Copy or Rename does not preserve
these fields)
(RPLACA (CDR TAIL)
NIL))
(AUTHOR (COND
((NEQ CMD (QUOTE Rename))
(* On Copy, author changes to current
user. Don't try to guess)
(RPLACA (CDR TAIL)
NIL))))
NIL)))
(T (for ATTR in (fetch (FILEBROWSER INFODISPLAYED) of FBROWSER)
when (SETQ N (GETFILEINFO NEWNAME ATTR)) do (push FILEINFO ATTR N]
(SETQ NEWITEM (FB.CREATE.FILEBUCKET FBROWSER NEWNAME FILEINFO))
(COND
([AND [NULL.VERSIONP (fetch (FBFILEDATA VERSION) of (SETQ ITEMDATA
(fetch TIDATA of NEWITEM]
(SETQ FULLNAME (INFILEP NEWNAME))
(OR [NULL (SETQ CRDATE (LISTGET FILEINFO (QUOTE CREATIONDATE]
(AND (SETQ CRDATE (IDATE CRDATE))
(SETQ CRDATE2 (GETFILEINFO FULLNAME (QUOTE ICREATIONDATE)))
(IEQP CRDATE2 CRDATE]
(* Grumble. IFS version of Rename does not return a full file name, due to
shortcoming in ftp protocol. Have to assume that it's the newest version.
If creation date of old file is available, verify that they agree)
(SETQ NEWITEM (FB.CREATE.FILEBUCKET FBROWSER [SETQ NEWNAME
(PACKFILENAME.STRING
(QUOTE BODY)
NEWNAME
(QUOTE EXTENSION)
""
(QUOTE VERSION)
(FILENAMEFIELD FULLNAME (QUOTE
VERSION
]
FILEINFO)) (* Canonicalize NEWNAME --
some cases where final period was left
out)
))
(COND
((AND OLDITEM (EQ CMD (QUOTE Rename))
(fetch TISELECTED of OLDITEM)) (* If old item was selected, keep the
renamed version selected as well)
(replace TISELECTED of NEWITEM with T)))
(FB.INSERT.FILE FBROWSER NEWITEM)
T])
(FB.GET.NEW.FILE.SPEC
[LAMBDA (OLDNAME BROWSER CMD) (* bvm: "20-Oct-85 16:51")
(* For Copy and Rename commands, derives a new name to copy/rename to from
OLDNAME. PREFIX if given is a DIRECTORY spec;
if not given, we prompt for a destination file.
Returns NIL if user aborts)
(LET (NEWNAME NAMEFIELD FIELDS DIR)
[COND
((NULL (SETQ NEWNAME (FB.PROMPTFORINPUT (CONCAT CMD " file " OLDNAME (SELECTQ CMD
(Rename
" to be: ")
(Copy
" to new file name: ")
(SHOULDNT)))
(PACKFILENAME.STRING (QUOTE DIRECTORY)
(OR (fetch (FILEBROWSER DEFAULTDIR) of BROWSER)
(DIRECTORYNAME T))
(QUOTE VERSION)
NIL
(QUOTE BODY)
OLDNAME)
BROWSER T))) (* Aborted)
)
([NULL (SETQ NAMEFIELD (LISTGET (SETQ FIELDS (UNPACKFILENAME.STRING NEWNAME))
(QUOTE NAME] (* Assume directory spec)
(replace (FILEBROWSER DEFAULTDIR) of BROWSER with (\ADD.CONNECTED.DIR NEWNAME))
(SETQ NEWNAME (PACKFILENAME.STRING (QUOTE DIRECTORY)
NEWNAME
(QUOTE VERSION)
NIL
(QUOTE BODY)
OLDNAME)))
((EQ (NCHARS NAMEFIELD)
0) (* Directory spec with some more
pieces after it?)
(FB.PROMPTWPRINT BROWSER "Failed, malformed name")
(SETQ NEWNAME NIL))
(T (for TAIL on FIELDS by (CDDR TAIL) bind PREVTAIL
do [SELECTQ (CAR TAIL)
((HOST DIRECTORY DEVICE) (* Keep these)
)
(RETURN (COND
((EQ TAIL FIELDS)
(SETQ FIELDS NIL))
(T (RPLACD (CDR PREVTAIL]
(SETQ PREVTAIL TAIL))
(replace (FILEBROWSER DEFAULTDIR) of BROWSER with (COND
[FIELDS (SETQ DIR (
PACKFILENAME.STRING
FIELDS))
(COND
((EQ (CAR FIELDS)
(QUOTE HOST))
DIR)
(T (\ADD.CONNECTED.DIR
DIR]
(T (DIRECTORYNAME T]
(COND
(NEWNAME (\ADD.CONNECTED.DIR NEWNAME])
)
(DEFINEQ
(FB.UPDATECOMMAND
[LAMBDA (BROWSER) (* bvm: "27-Sep-85 12:30")
(COND
((FB.MAYBE.EXPUNGE BROWSER (QUOTE Recompute))
(FB.UPDATEBROWSERITEMS BROWSER])
(FB.MAYBE.EXPUNGE
[LAMBDA (BROWSER COMMAND) (* bvm: "27-Sep-85 12:30")
(* * If BROWSER has files marked for deletion, ask whether user wants to
expunge them. Returns T if it is okay to proceed, NIL if not
(user aborted or expunge failed))
(COND
((EQ (fetch (FILEBROWSER DELETEDFILES) of BROWSER)
0)
T)
(T (FB.PROMPTWPRINT BROWSER
"Some files are marked for deletion.
Do you want to expunge them first?")
(SELECTQ (MENU (FB.EXPUNGE?.MENU))
(EXPUNGE (* Do expunge in another process, not
here in mouse)
(FB.EXPUNGECOMMAND BROWSER NIL NIL NIL COMMAND))
(NOEXPUNGE T)
NIL])
(FB.UPDATEBROWSERITEMS
[LAMBDA (BROWSER) (* bvm: "20-Dec-85 21:38")
(RESETLST (PROG ((WINDOW (fetch (FILEBROWSER BROWSERWINDOW) of BROWSER))
(TBROWSER (fetch (FILEBROWSER TABLEBROWSER) of BROWSER))
(TITLEWINDOW (fetch (FILEBROWSER COUNTERWINDOW) of BROWSER))
PATTERN INFOWANTED FILEGENERATOR FILENAME)
(OR (SETQ PATTERN (fetch PATTERN of BROWSER))
(RETURN))
(RESETSAVE NIL (LIST (FUNCTION FB.CLEANUP.UPDATE)
BROWSER))
(replace (FILEBROWSER UPDATEPROC) of BROWSER with (THIS.PROCESS))
(* So that CLOSE can abort it)
(WINDOWADDPROP WINDOW (QUOTE CLOSEFN)
(FUNCTION FB.ABORT.UPDATE)
T)
(FB.PROMPTWPRINT BROWSER T "Enumerating " PATTERN (QUOTE ...))
(replace (FILEBROWSER INFODISPLAYED) of BROWSER with (SETQ INFOWANTED
(fetch (FILEBROWSER
INFOMENUCHOICES
)
of BROWSER)))
(OR (fetch (FILEBROWSER FIXEDTITLE) of BROWSER)
(WINDOWPROP TITLEWINDOW (QUOTE TITLE)
(CONCAT PATTERN " browser")))
(CLEARW TITLEWINDOW)
(TB.REPLACE.ITEMS TBROWSER NIL)
(FB.SET.DEFAULT.NAME.WIDTH BROWSER)
[replace (FILEBROWSER PAGECOUNT?) of BROWSER
with (CAR (OR (MEMB (QUOTE SIZE)
INFOWANTED)
(MEMB (QUOTE LENGTH)
INFOWANTED]
[replace (FILEBROWSER DELETEDFILES) of BROWSER
with (replace (FILEBROWSER DELETEDPAGES) of BROWSER
with (replace (FILEBROWSER TOTALPAGES) of BROWSER
with (replace (FILEBROWSER TOTALFILES) of BROWSER with 0]
(replace (FILEBROWSER SORTMENU) of BROWSER with (replace (FILEBROWSER
PATTERNPARSED?)
of BROWSER with NIL))
(PROGN (replace (FILEBROWSER NOSUBDIRECTORIES) of BROWSER with NIL)
(replace (FILEBROWSER SORTATTRIBUTE) of BROWSER with NIL)
(replace (FILEBROWSER SORTBY) of BROWSER with (FUNCTION
FB.NAMES.DECREASING.VERSION
)))
[SETQ FILEGENERATOR (\GENERATEFILES PATTERN INFOWANTED (QUOTE (SORT RESETLST]
(FB.HEADINGW.DISPLAY BROWSER (fetch HEADINGWINDOW of BROWSER))
(while (SETQ FILENAME (\GENERATENEXTFILE FILEGENERATOR))
bind PREVSUBDIR LASTFILE LASTFILENAME OTHERFILES NEWFILEITEM NEWFILEDATA
do [COND
((LISTP FILENAME)
(SETQ FILENAME (CONCATCODES FILENAME]
[SETQ NEWFILEDATA (fetch TIDATA of (SETQ NEWFILEITEM
(FB.CREATE.FILEBUCKET BROWSER FILENAME
(FB.GETALLFILEINFO FILENAME
FILEGENERATOR INFOWANTED]
[COND
((AND LASTFILE (STRING-EQUAL (fetch (FBFILEDATA VERSIONLESSNAME)
of NEWFILEDATA)
LASTFILENAME))
(* This file same name as previous
one, so save it in case we need to
sort versions)
(push OTHERFILES NEWFILEITEM))
(T [COND
(LASTFILE (FB.ADD.FILEGROUP TBROWSER BROWSER LASTFILE OTHERFILES
PREVSUBDIR)
(SETQ PREVSUBDIR (fetch (FBFILEDATA SUBDIRECTORY)
of (fetch TIDATA of LASTFILE]
(SETQ OTHERFILES NIL)
(SETQ LASTFILE NEWFILEITEM)
(SETQ LASTFILENAME (fetch (FBFILEDATA VERSIONLESSNAME) of NEWFILEDATA
]
finally (AND LASTFILE (FB.ADD.FILEGROUP TBROWSER BROWSER LASTFILE OTHERFILES
PREVSUBDIR)))
[COND
((EQ (TB.NUMBER.OF.ITEMS TBROWSER)
0)
(FB.PROMPTWPRINT BROWSER (QUOTE CLEAR)
"No files in group " PATTERN))
(T (FB.PROMPTWPRINT BROWSER (QUOTE done))
(COND
((FB.MAYBE.WIDEN.NAMES BROWSER)
(FB.HEADINGW.DISPLAY BROWSER (fetch HEADINGWINDOW of BROWSER))
(TB.REDISPLAY.ITEMS (fetch (FILEBROWSER TABLEBROWSER) of BROWSER]
(FB.UPDATE.HEADING.EXTENT BROWSER WINDOW)
(FB.DISPLAY.COUNTERS BROWSER])
(FB.CLEANUP.UPDATE
[LAMBDA (BROWSER) (* bvm: "27-Sep-85 14:55")
(* * Cleans up after an Update, whether aborted or not)
(LET ((WINDOW (fetch (FILEBROWSER BROWSERWINDOW) of BROWSER)))
(WINDOWDELPROP WINDOW (QUOTE CLOSEFN)
(FUNCTION FB.ABORT.UPDATE))
(replace (FILEBROWSER UPDATEPROC) of BROWSER with NIL)
(COND
(RESETSTATE (FB.PROMPTWPRINT BROWSER " aborted."])
(FB.ABORT.UPDATE
[LAMBDA (WINDOW) (* bvm: "20-Oct-85 17:46")
(* * CLOSEFN on browser window during Update --
aborts it.)
(LET ((BROWSER (WINDOWPROP WINDOW (QUOTE FILEBROWSER)))
PROCESS)
(COND
((AND BROWSER (SETQ PROCESS (fetch (FILEBROWSER UPDATEPROC) of BROWSER)))
(COND
((fetch (FILEBROWSER ABORTING) of BROWSER)
(PRINTOUT PROMPTWINDOW T "Abort is already in progress on that File Browser")
(QUOTE DON'T))
(T (DEL.PROCESS PROCESS)
(replace (FILEBROWSER ABORTING) of BROWSER with T)
(ALLOW.BUTTON.EVENTS)
(while (PROCESSP PROCESS) do (BLOCK)) (* Wait for process to die --
should be (PROCESS.RESULT PROCESS T)
but that has a bug)
NIL])
(FB.MAYBE.WIDEN.NAMES
[LAMBDA (BROWSER) (* bvm: "18-Oct-85 17:32")
(* * Examines the OVERFLOWWIDTHS field to see if we should widen the name area
of the browser, shoving everything else to the right.
If it changes the width, returns T so that caller knows whether to update
display)
(LET ((OVERFLOW (fetch (FILEBROWSER OVERFLOWWIDTHS) of BROWSER))
(CURRENTSTART (fetch (FILEBROWSER INFOSTART) of BROWSER))
THRESHOLD)
(COND
(OVERFLOW (* See if enough files were too wide
for print spec)
(SETQ THRESHOLD (IMIN (IMAX (FIXR (FTIMES (fetch (FILEBROWSER TOTALFILES)
of BROWSER)
FB.OVERFLOW.MAXFRAC))
1)
FB.OVERFLOW.MAXABSOLUTE))
(for PAIR in OVERFLOW when (AND (IGREATERP (CAR PAIR)
CURRENTSTART)
(LESSP (SETQ THRESHOLD (IDIFFERENCE THRESHOLD
(CADR PAIR)))
0)) do
(* Stop here! Any further than this
and we would have more than the max
files overflowing)
(replace (FILEBROWSER INFOSTART)
of BROWSER with (CAR PAIR))
(RETURN T])
(FB.SET.DEFAULT.NAME.WIDTH
[LAMBDA (BROWSER) (* bvm: "18-Oct-85 17:54")
(LET ((FONT (fetch (FILEBROWSER BROWSERFONT) of BROWSER)))
(replace (FILEBROWSER INFOSTART) of BROWSER
with (IPLUS (replace (FILEBROWSER NAMEOVERHEAD) of BROWSER
with (IPLUS (DSPLEFTMARGIN NIL (fetch (FILEBROWSER BROWSERWINDOW)
of BROWSER))
(CHARWIDTH (CHARCODE SPACE)
FONT)
(CHARWIDTH (CHARCODE ;)
FONT)))
FB.DEFAULT.NAME.WIDTH))
(replace (FILEBROWSER DIGITWIDTH) of BROWSER with (CHARWIDTH (CHARCODE 8)
FONT))
(replace (FILEBROWSER OVERFLOWWIDTHS) of BROWSER with NIL])
(FB.CREATE.FILEBUCKET
[LAMBDA (BROWSER FILENAME FILEINFO) (* bvm: "20-Oct-85 16:37")
(COND
((NULL (fetch (FILEBROWSER PATTERNPARSED?) of BROWSER))
(FB.ANALYZE.PATTERN BROWSER FILENAME)))
(LET ((STARTOFNAME (fetch (FILEBROWSER NAMESTART) of BROWSER))
(LASTCHAR (NCHARS FILENAME))
STARTOFSHORTNAME LASTDIR SUBDIR VERSION CH HASDIRPREFIX ATTR)
[while (DIGITCHARP (SETQ CH (NTHCHARCODE FILENAME LASTCHAR))) do (SETQ LASTCHAR (SUB1
LASTCHAR
))
finally (* not a version char)
(COND
((OR (EQ CH (CHARCODE ;))
(EQ CH (CHARCODE %.))) (* Pull off the version from the end,
so that we can sort with it, etc)
(SETQ VERSION (SUBATOM FILENAME (ADD1 LASTCHAR)))
(SETQ LASTCHAR (SUB1 LASTCHAR)))
(T (SETQ LASTCHAR NIL]
(for (N ← STARTOFNAME) do (SELCHARQ (NTHCHARCODE FILENAME (add N 1))
(> (SETQ LASTDIR N))
(NIL (RETURN))
NIL))
(COND
(LASTDIR [COND
((NEQ STARTOFNAME (SETQ STARTOFSHORTNAME (ADD1 LASTDIR)))
(SETQ HASDIRPREFIX T)
(OR (fetch (FILEBROWSER NOSUBDIRECTORIES) of BROWSER)
(SETQ STARTOFNAME STARTOFSHORTNAME]
(SETQ SUBDIR (SUBSTRING FILENAME 1 LASTDIR)))
(T (SETQ STARTOFSHORTNAME STARTOFNAME)))
(SETQ FILENAME (create FBFILEDATA
FILENAME ← FILENAME
FILEINFO ← FILEINFO
PRINTNAME ← (SUBSTRING FILENAME STARTOFNAME LASTCHAR)
VERSION ← (OR VERSION FB.NULL.VERSION)
VERSIONLESSNAME ← (COND
(LASTCHAR (SUBSTRING FILENAME 1 LASTCHAR))
(T FILENAME))
SIZE ← (SELECTQ (fetch (FILEBROWSER PAGECOUNT?) of BROWSER)
(SIZE (LISTGET FILEINFO (QUOTE SIZE)))
(LENGTH (AND (SETQ LASTCHAR (LISTGET FILEINFO (QUOTE LENGTH
)))
(FOLDHI LASTCHAR BYTESPERPAGE)))
NIL)
SUBDIRECTORY ← SUBDIR
STARTOFNAME ← STARTOFSHORTNAME
HASDIRPREFIX ← HASDIRPREFIX))
(FB.CHECK.NAME.LENGTH BROWSER FILENAME)
(COND
((SETQ ATTR (fetch (FILEBROWSER SORTATTRIBUTE) of BROWSER))
(SETQ ATTR (LISTGET FILEINFO ATTR))
[COND
((AND ATTR (fetch (FILEBROWSER SORTBYDATE) of BROWSER))
(SETQ ATTR (IDATE ATTR]
(replace (FBFILEDATA SORTVALUE) of FILENAME with ATTR)))
(create TABLEITEM
TIDATA ← FILENAME])
(FB.CHECK.NAME.LENGTH
[LAMBDA (BROWSER FILEDATA) (* bvm: "18-Oct-85 17:50")
(* * Checks the name in FILEDATA to see if printing it would overflow the space
set aside for the name column in the browser.
If so, updates some information that will help us decide later whether to
expand the column)
(LET [(PRINTLENGTH (IPLUS (STRINGWIDTH (fetch (FBFILEDATA PRINTNAME) of FILEDATA)
(fetch (FILEBROWSER BROWSERFONT) of BROWSER))
(TIMES (fetch (FILEBROWSER DIGITWIDTH) of BROWSER)
(NCHARS (fetch (FBFILEDATA VERSION) of FILEDATA)))
(fetch (FILEBROWSER NAMEOVERHEAD) of BROWSER]
(COND
((GEQ PRINTLENGTH (fetch (FILEBROWSER INFOSTART) of BROWSER))
(* Name is longer than allotted space in browser.
Shall we allot more space? Don't know until we're thru.
For now, record a list of elements (width occurrences)%, where each name is
recorded in the closest entry)
(LET ((OVERFLOW (fetch (FILEBROWSER OVERFLOWWIDTHS) of BROWSER))
(SPACING (fetch (FILEBROWSER OVERFLOWSPACING) of BROWSER)))
(COND
((OR (NULL OVERFLOW)
(GREATERP PRINTLENGTH (CAAR OVERFLOW)))
(replace (FILEBROWSER OVERFLOWWIDTHS) of BROWSER with (CONS (LIST PRINTLENGTH 1
)
OVERFLOW)))
(T (for (TAIL ← OVERFLOW) bind PREVTAIL
when [OR [NULL (SETQ TAIL (CDR (SETQ PREVTAIL TAIL]
(GREATERP PRINTLENGTH (CAR (CAR TAIL]
do (* Longer than some previously
recorded length, so either add a new
entry or bump the preceding one)
(COND
((ILESSP PRINTLENGTH (IDIFFERENCE (CAR (CAR PREVTAIL))
SPACING))
(RPLACD PREVTAIL (CONS (LIST PRINTLENGTH 1)
TAIL)))
(T (add (CADR (CAR PREVTAIL))
1)))
(RETURN])
(FB.ADD.FILEGROUP
[LAMBDA (TBROWSER FBROWSER LASTFILE OTHERFILES LASTSUBDIR) (* bvm: "13-Oct-85 17:44")
(LET (THISSUBDIR)
(COND
((AND (NOT (fetch (FILEBROWSER NOSUBDIRECTORIES) of FBROWSER))
(NEQ (SETQ THISSUBDIR (fetch (FBFILEDATA SUBDIRECTORY) of (fetch TIDATA
of LASTFILE)))
LASTSUBDIR)
(NOT (STRING-EQUAL THISSUBDIR LASTSUBDIR)))(* Subsequent files have a different
subdirectory, so insert a
non-selectable line item here)
(FB.INSERT.DIRECTORY TBROWSER FBROWSER THISSUBDIR)))
(COND
(OTHERFILES (for ITEM in (SORT (CONS LASTFILE OTHERFILES)
(FUNCTION FB.DECREASING.VERSION))
do (FB.ADD.FILE TBROWSER FBROWSER ITEM)))
(T (FB.ADD.FILE TBROWSER FBROWSER LASTFILE])
(FB.INSERT.DIRECTORY
[LAMBDA (TBROWSER FBROWSER SUBDIRECTORY BEFOREITEM) (* bvm: "18-Oct-85 17:16")
(TB.INSERT.ITEM TBROWSER (FB.MAKE.SUBDIRECTORY.ITEM FBROWSER SUBDIRECTORY)
BEFOREITEM])
(FB.MAKE.SUBDIRECTORY.ITEM
[LAMBDA (FBROWSER SUBDIRECTORY) (* bvm: "18-Oct-85 17:16")
(* * Creates a TABLEITEM containing a subdirectory line SUBDIRECTORY.
SUBDIRECTORY = NIL defaults to the browser's pattern directory)
(create TABLEITEM
TIUNSELECTABLE ← T
TIDATA ← (create FBFILEDATA
FILENAME ← [OR SUBDIRECTORY (SETQ SUBDIRECTORY
(SUBSTRING (fetch (FILEBROWSER PATTERN)
of FBROWSER)
1
(SUB1 (fetch (FILEBROWSER NAMESTART)
of FBROWSER]
PRINTNAME ← (SUBSTRING SUBDIRECTORY (fetch (FILEBROWSER DIRECTORYSTART)
of FBROWSER))
VERSIONLESSNAME ← SUBDIRECTORY
DIRECTORYP ← T])
(FB.ADD.FILE
[LAMBDA (TBROWSER FBROWSER ITEM BEFOREITEM) (* bvm: "13-Oct-85 17:44")
(* * Inserts one file in TBROWSER / FBROWSER before item BEFOREITEM or at end
if BEFOREITEM is NIL)
(LET [(SIZE (fetch (FBFILEDATA SIZE) of (fetch TIDATA of ITEM]
(COND
(SIZE (add (fetch (FILEBROWSER TOTALPAGES) of FBROWSER)
SIZE)))
(add (fetch (FILEBROWSER TOTALFILES) of FBROWSER)
1)
(TB.INSERT.ITEM TBROWSER ITEM BEFOREITEM])
(FB.INSERT.FILE
[LAMBDA (BROWSER FILE) (* bvm: "13-Oct-85 17:44")
(LET ((TBROWSER (fetch (FILEBROWSER TABLEBROWSER) of BROWSER))
(FBSORTFN (fetch (FILEBROWSER SORTBY) of BROWSER))
(MYSUBDIR (fetch (FBFILEDATA SUBDIRECTORY) of (fetch TIDATA of FILE)))
(NOSUBDIRS (fetch (FILEBROWSER NOSUBDIRECTORIES) of BROWSER))
OTHERDIR NEXTITEM PREVITEM N)
[SETQ NEXTITEM (TB.FIND.ITEM TBROWSER (FUNCTION (LAMBDA (BROWSER ITEM)
(AND (NOT (fetch TIUNSELECTABLE
of ITEM))
(APPLY* FBSORTFN FILE ITEM]
(COND
((AND NEXTITEM (NOT NOSUBDIRS)
(NEQ (SETQ N (fetch TI# of NEXTITEM))
1)
[fetch TIUNSELECTABLE of (SETQ PREVITEM (TB.NTH.ITEM TBROWSER (SUB1 N]
(NOT (STRING-EQUAL (fetch (FBFILEDATA SUBDIRECTORY) of (fetch TIDATA of NEXTITEM))
MYSUBDIR)))
(* * We sort before NEXTITEM, but it's preceded by a subdirectory line that
isn't ours, so insert in front of the subdirectory)
(SETQ NEXTITEM PREVITEM)))
(TB.INSERT.ITEM TBROWSER FILE NEXTITEM)
[COND
(NOSUBDIRS)
((AND NEXTITEM (NOT (fetch TIUNSELECTABLE of NEXTITEM))
(STRING-EQUAL (SETQ OTHERDIR (fetch (FBFILEDATA SUBDIRECTORY)
of (fetch TIDATA of NEXTITEM)))
MYSUBDIR))
(* All ok -- next item is not a subdirectory line, and its subdir is the same
as mine, so I must be properly qualified already)
)
(T
(* * Inserted at end, or newly inserted item has different subdirectory from
the item that follows it)
(COND
((AND NEXTITEM (NOT (fetch TIUNSELECTABLE of NEXTITEM)))
(* Need subdirectory id in front of
next file)
(FB.INSERT.DIRECTORY TBROWSER BROWSER OTHERDIR NEXTITEM)))
(COND
([COND
((EQ (SETQ N (fetch TI# of FILE))
1) (* Inserted at front, needs
qualification if it has a subdir)
(NOT (NULL MYSUBDIR)))
(T (NOT (STRING-EQUAL [fetch (FBFILEDATA SUBDIRECTORY)
of (fetch TIDATA of (SETQ PREVITEM (TB.NTH.ITEM
TBROWSER
(SUB1 N]
MYSUBDIR] (* Need id in front of new file as
well)
(FB.INSERT.DIRECTORY TBROWSER BROWSER MYSUBDIR FILE]
(FB.COUNT.FILE.CHANGE BROWSER FILE (QUOTE ADD])
(FB.ANALYZE.PATTERN
[LAMBDA (BROWSER SAMPLE) (* bvm: "20-Dec-85 21:34")
(* * Figures out what the "real pattern" is from SAMPLE, one of the files that
is claimed to match the pattern. Sets the NAMESTART field to where the pattern
ends and the distinguishable names start.
Also resets PATTERN to be the canonicalized pattern)
(LET ((PATTERN (fetch (FILEBROWSER PATTERN) of BROWSER))
(PATHOSTEND 0)
(SAMPLEHOSTEND 0)
LASTPATDIR STARTOFNAME)
(do (SELCHARQ (NTHCHARCODE PATTERN (add PATHOSTEND 1))
(' (add PATHOSTEND 1))
(} (* End of directory, now look for end
of matchable pattern)
(RETURN (for (N ← PATHOSTEND) do (SELCHARQ (NTHCHARCODE PATTERN (add N 1))
(' (add N 1))
((: >)
(SETQ LASTPATDIR N))
((NIL * #)
(* End of pattern or wildcard, can't
match beyond here)
(RETURN))
NIL))))
(NIL (* End of file name without end of
brace?)
(RETURN (SETQ PATHOSTEND 0)))
NIL))
(* * From PATHOSTEND thru LASTPATDIR is now a segment that ought to appear in
SAMPLE)
(do (SELCHARQ (NTHCHARCODE SAMPLE (add SAMPLEHOSTEND 1))
(' (add SAMPLEHOSTEND 1))
(} (* End of directory)
(RETURN))
(NIL (* End of file name without end of
brace?)
(RETURN (SETQ SAMPLEHOSTEND 0)))
NIL))
[COND
[(AND LASTPATDIR (SETQ STARTOFNAME (STRPOS (SUBSTRING PATTERN (ADD1 PATHOSTEND)
LASTPATDIR)
SAMPLE
(ADD1 SAMPLEHOSTEND)
NIL NIL T UPPERCASEARRAY)))
(* Anything before the first match of
the pattern is assumed to be
canonicalization added by the device)
(SETQ PATTERN (CONCAT (SUBSTRING SAMPLE 1 (SUB1 STARTOFNAME))
(SUBSTRING PATTERN (ADD1 LASTPATDIR]
(T (* Should only happen for devices
without directories)
(SETQ STARTOFNAME (ADD1 SAMPLEHOSTEND))
(COND
([OR (NEQ PATHOSTEND SAMPLEHOSTEND)
(NOT (STREQUAL (SUBSTRING PATTERN 1 PATHOSTEND)
(SUBSTRING SAMPLE 1 PATHOSTEND]
(* At least canonicalize the host part)
(SETQ PATTERN (CONCAT (SUBSTRING SAMPLE 1 SAMPLEHOSTEND)
(SUBSTRING PATTERN (ADD1 PATHOSTEND]
(FB.SETNEWPATTERN BROWSER PATTERN)
(OR (fetch (FILEBROWSER FIXEDTITLE) of BROWSER)
(WINDOWPROP (fetch (FILEBROWSER COUNTERWINDOW) of BROWSER)
(QUOTE TITLE)
(CONCAT PATTERN " browser")))
(replace (FILEBROWSER PATTERNPARSED?) of BROWSER with T)
(replace (FILEBROWSER DIRECTORYSTART) of BROWSER with (ADD1 SAMPLEHOSTEND))
(replace (FILEBROWSER NAMESTART) of BROWSER with STARTOFNAME])
(FB.GETALLFILEINFO
[LAMBDA (FILE GENERATOR ATTRIBUTES) (* bvm: "11-Sep-85 12:34")
(for ATTR in ATTRIBUTES bind INFO RESULT when (SETQ INFO (\GENERATEFILEINFO GENERATOR ATTR))
do (push RESULT ATTR INFO) finally (RETURN RESULT])
)
(DEFINEQ
(FB.SORT.VERSIONS
[LAMBDA (ITEMS SORTFN) (* bvm: "13-Oct-85 17:44")
(* * Sort ITEMS so that equal names are sorted by version according to SORTFN.
Assumes that ITEMS are already sorted by name)
(LET ((TAIL ITEMS)
PREVTAIL NEXTTAIL NEWTAIL THISNAME)
[while (CDR TAIL) do (COND
[[STRING-EQUAL [SETQ THISNAME (fetch (FBFILEDATA PRINTNAME)
of (fetch TIDATA
of (CAR TAIL]
(fetch (FBFILEDATA PRINTNAME) of (fetch TIDATA
of (CADR TAIL]
(* Same name as next, so gather up all
equal names)
(SETQ NEXTTAIL (CDDR TAIL))
(while [AND NEXTTAIL (STRING-EQUAL THISNAME
(fetch (FBFILEDATA PRINTNAME)
of (fetch TIDATA of (CAR NEXTTAIL]
do (SETQ NEXTTAIL (CDR NEXTTAIL)))
(SETQ NEWTAIL (SORT (until (EQ TAIL NEXTTAIL)
collect (pop TAIL))
SORTFN))
(* Now splice NEWTAIL into list
between PREVTAIL and NEXTTAIL)
(COND
(PREVTAIL (RPLACD PREVTAIL NEWTAIL))
(T (SETQ ITEMS NEWTAIL)))
(COND
((SETQ TAIL NEXTTAIL)
(RPLACD (SETQ PREVTAIL (LAST NEWTAIL))
NEXTTAIL]
(T (SETQ TAIL (CDR (SETQ PREVTAIL TAIL]
ITEMS])
(FB.DECREASING.VERSION
[LAMBDA (X Y) (* bvm: "13-Oct-85 17:53")
(* * Comparefn for sorting a group of same named files by decreasing version.
Null version considered high)
(AND [NOT (NULL.VERSIONP (SETQ Y (fetch (FBFILEDATA VERSION) of (fetch TIDATA of Y]
(OR [NULL.VERSIONP (SETQ X (fetch (FBFILEDATA VERSION) of (fetch TIDATA of X]
(IGREATERP X Y])
(FB.INCREASING.VERSION
[LAMBDA (X Y) (* bvm: "13-Oct-85 17:55")
(* * Comparefn for sorting a group of same named files by increasing version.
Null version considered high)
(OR [NULL.VERSIONP (SETQ Y (fetch (FBFILEDATA VERSION) of (fetch TIDATA of Y]
(AND [NOT (NULL.VERSIONP (SETQ X (fetch (FBFILEDATA VERSION) of (fetch TIDATA of X]
(ILESSP X Y])
(FB.NAMES.DECREASING.VERSION
[LAMBDA (X Y) (* bvm: "13-Oct-85 17:57")
(* * Comparison function for sorting file names in alphabetical order,
decreasing versions)
(SELECTQ (ALPHORDER (fetch (FBFILEDATA VERSIONLESSNAME) of (SETQ X (fetch TIDATA of X)))
(fetch (FBFILEDATA VERSIONLESSNAME) of (SETQ Y (fetch TIDATA of Y)))
UPPERCASEARRAY)
(LESSP T)
(EQUAL (AND (NOT (NULL.VERSIONP (SETQ Y (fetch (FBFILEDATA VERSION) of Y))
0))
(OR (NULL.VERSIONP (SETQ X (fetch (FBFILEDATA VERSION) of X)))
(IGREATERP X Y))))
NIL])
(FB.NAMES.INCREASING.VERSION
[LAMBDA (X Y) (* bvm: "13-Oct-85 17:54")
(* * Comparison function for sorting file names in alphabetical order,
increasing versions)
(SELECTQ (ALPHORDER (fetch (FBFILEDATA VERSIONLESSNAME) of (SETQ X (fetch TIDATA of X)))
(fetch (FBFILEDATA VERSIONLESSNAME) of (SETQ Y (fetch TIDATA of Y)))
UPPERCASEARRAY)
(LESSP T)
(EQUAL (OR (NULL.VERSIONP (SETQ Y (fetch (FBFILEDATA VERSION) of Y)))
(AND [NOT (NULL.VERSIONP (SETQ X (fetch (FBFILEDATA VERSION) of X]
(ILESSP X Y))))
NIL])
(FB.DECREASING.NUMERIC.ATTR
[LAMBDA (X Y) (* bvm: "13-Oct-85 17:44")
(* * Comparison function for sorting file names in decreasing order of some
numeric attribute. If values are equal, fall back on names decreasing version)
(LET ((XVAL (OR (fetch (FBFILEDATA SORTVALUE) of (fetch TIDATA of X))
0))
(YVAL (OR (fetch (FBFILEDATA SORTVALUE) of (fetch TIDATA of Y))
0)))
(OR (IGREATERP XVAL YVAL)
(AND (NOT (IGREATERP YVAL XVAL))
(FB.NAMES.DECREASING.VERSION X Y])
(FB.INCREASING.NUMERIC.ATTR
[LAMBDA (X Y) (* bvm: "13-Oct-85 17:44")
(* * Comparison function for sorting file names in increasing order of some
numeric attribute. If values are equal, fall back on names decreasing version)
(LET ((XVAL (OR (fetch (FBFILEDATA SORTVALUE) of (fetch TIDATA of X))
0))
(YVAL (OR (fetch (FBFILEDATA SORTVALUE) of (fetch TIDATA of Y))
0)))
(OR (ILESSP XVAL YVAL)
(AND (NOT (ILESSP YVAL XVAL))
(FB.NAMES.DECREASING.VERSION X Y])
(FB.ALPHABETIC.ATTR
[LAMBDA (X Y) (* bvm: "20-Oct-85 18:07")
(* * Comparison function for sorting file names in order of some textual
attribute. If values are equal, fall back on names decreasing version)
(SELECTQ (ALPHORDER (fetch (FBFILEDATA SORTVALUE) of (fetch TIDATA of X))
(fetch (FBFILEDATA SORTVALUE) of (fetch TIDATA of Y))
UPPERCASEARRAY)
(LESSP T)
(EQUAL (FB.NAMES.DECREASING.VERSION X Y))
NIL])
)
(DEFINEQ
(FB.SORTCOMMAND
[LAMBDA (BROWSER) (* bvm: "20-Oct-85 17:28")
(LET ((TBROWSER (fetch (FILEBROWSER TABLEBROWSER) of BROWSER))
(SORTATTR (MENU (FB.GET.SORT.MENU BROWSER)))
(HADNOSUBDIRS (fetch (FILEBROWSER NOSUBDIRECTORIES) of BROWSER))
SORTFN REVERSED ALLFILES DATETYPE BYNAME)
(COND
(SORTATTR [COND
((LISTP SORTATTR)
(SETQ REVERSED T)
(SETQ SORTATTR (CAR SORTATTR]
(SETQ SORTFN (SELECTQ SORTATTR
((SIZE LENGTH BYTESIZE)
(COND
(REVERSED (FUNCTION FB.INCREASING.NUMERIC.ATTR))
(T (FUNCTION FB.DECREASING.NUMERIC.ATTR))))
((CREATIONDATE WRITEDATE READDATE)
(SETQ DATETYPE T)
(COND
(REVERSED (FUNCTION FB.INCREASING.NUMERIC.ATTR))
(T (FUNCTION FB.DECREASING.NUMERIC.ATTR))))
(NAME (SETQ BYNAME T)
(COND
(REVERSED (FUNCTION FB.NAMES.INCREASING.VERSION))
(T (FUNCTION FB.NAMES.DECREASING.VERSION))))
(FUNCTION FB.ALPHABETIC.ATTR)))
(FB.PROMPTWPRINT BROWSER "Sorting by " SORTATTR (QUOTE ...))
(SETQ ALLFILES (TB.COLLECT.ITEMS TBROWSER (FUNCTION FB.IS.NOT.SUBDIRECTORY.ITEM)))
[COND
[(NOT BYNAME) (* Need to compute the attribute on
which we sort)
(for ITEM in ALLFILES bind (NAMESTART ← (AND (NOT HADNOSUBDIRS)
(fetch (FILEBROWSER NAMESTART)
of BROWSER)))
DATA VALUE
do (SETQ DATA (fetch TIDATA of ITEM))
(SETQ VALUE (LISTGET (fetch (FBFILEDATA FILEINFO) of DATA)
SORTATTR))
[COND
((AND VALUE DATETYPE)
(SETQ VALUE (IDATE VALUE]
(replace (FBFILEDATA SORTVALUE) of DATA with VALUE)
(COND
((AND NAMESTART (fetch (FBFILEDATA HASDIRPREFIX) of DATA))
(* Need to go back to "full" names,
since subdirectories are senseless
when not sorted by name)
(replace (FBFILEDATA PRINTNAME) of DATA
with (SUBSTRING (fetch (FBFILEDATA VERSIONLESSNAME) of DATA)
NAMESTART))
(FB.CHECK.NAME.LENGTH BROWSER DATA]
(HADNOSUBDIRS (* We're sorting by name, so switch
back to print names without subdirs)
(FB.SET.DEFAULT.NAME.WIDTH BROWSER)
(for DATA in ALLFILES do [COND
((fetch (FBFILEDATA HASDIRPREFIX)
of (SETQ DATA (fetch TIDATA of DATA)))
(replace (FBFILEDATA PRINTNAME)
of DATA
with (SUBSTRING (fetch (FBFILEDATA
VERSIONLESSNAME)
of DATA)
(fetch (FBFILEDATA
STARTOFNAME)
of DATA]
(FB.CHECK.NAME.LENGTH BROWSER DATA]
(SETQ ALLFILES (SORT ALLFILES SORTFN))
(COND
((EQ BYNAME HADNOSUBDIRS) (* Were wide names, now narrow, or
vice versa)
(FB.MAYBE.WIDEN.NAMES BROWSER)))
(COND
(BYNAME (FB.INSERT.SUBDIRECTORIES BROWSER ALLFILES)))
(FB.HEADINGW.DISPLAY BROWSER (fetch (FILEBROWSER HEADINGWINDOW) of BROWSER))
(TB.REPLACE.ITEMS TBROWSER ALLFILES)
(replace (FILEBROWSER NOSUBDIRECTORIES) of BROWSER with (NOT BYNAME))
(replace (FILEBROWSER SORTBY) of BROWSER with SORTFN)
(replace (FILEBROWSER SORTATTRIBUTE) of BROWSER with (AND (NOT BYNAME)
SORTATTR))
(replace (FILEBROWSER SORTBYDATE) of BROWSER with DATETYPE)
(FB.PROMPTWPRINT BROWSER "done"])
(FB.INSERT.SUBDIRECTORIES
[LAMBDA (BROWSER FILES) (* bvm: "18-Oct-85 17:23")
(for TAIL on FILES bind [LASTSUBDIR ← (AND (NEQ (fetch (FILEBROWSER NAMESTART) of BROWSER)
(fetch (FILEBROWSER DIRECTORYSTART) of BROWSER))
(SUBSTRING (fetch (FILEBROWSER PATTERN) of BROWSER)
1
(SUB1 (fetch (FILEBROWSER NAMESTART)
of BROWSER]
do (COND
([NOT (STRING-EQUAL LASTSUBDIR (SETQ LASTSUBDIR (fetch (FBFILEDATA SUBDIRECTORY)
of (fetch TIDATA of (CAR TAIL]
(ATTACH (FB.MAKE.SUBDIRECTORY.ITEM BROWSER LASTSUBDIR)
TAIL)
(SETQ TAIL (CDR TAIL])
(FB.GET.SORT.MENU
[LAMBDA (BROWSER) (* bvm: " 9-Apr-86 15:10")
(OR (fetch (FILEBROWSER SORTMENU) of BROWSER)
(replace (FILEBROWSER SORTMENU) of BROWSER
with (create
MENU
ITEMS ←
(CONS [QUOTE ("Name" (QUOTE NAME)
"Sort files by name, decreasing version numbers"
(SUBITEMS ("Decreasing version" (QUOTE NAME)
"Sort files by name, decreasing version numbers"
)
("Increasing version" (QUOTE (NAME T))
"Sort files by name, increasing version numbers"]
(for ATTR in (fetch (FILEBROWSER INFODISPLAYED) of BROWSER)
collect (LIST ATTR (LIST (QUOTE QUOTE)
ATTR)
"Sort by this attribute"
(SELECTQ ATTR
((SIZE LENGTH BYTESIZE)
(BQUOTE (SUBITEMS ("Decreasing" (QUOTE (\, ATTR))
"Sort files in order of decreasing size"
)
("Increasing" (QUOTE ((\, ATTR)
T))
"Sort files in order of increasing size"
))))
((CREATIONDATE WRITEDATE READDATE)
(BQUOTE (SUBITEMS ("Newer first" (QUOTE (\, ATTR))
"Sort files with newer dates appearing before older dates"
)
("Older first" (QUOTE ((\, ATTR)
T))
"Sort files with older dates appearing before newer dates"
))))
NIL])
)
(DEFINEQ
(FB.EXPUNGECOMMAND
[LAMBDA (FBROWSER KEY ITEM MENU CMD) (* bvm: "27-Sep-85 14:25")
(PROG ((TBROWSER (fetch (FILEBROWSER TABLEBROWSER) of FBROWSER))
(NDELETED 0)
FILES FILENAME FAILED FILE)
(COND
[(SETQ FILES (TB.COLLECT.ITEMS TBROWSER (QUOTE DELETED)))
(FB.PROMPTWPRINT FBROWSER T "Expunging deleted files...")
[for ITEM in FILES do (COND
((DELFILE (SETQ FILENAME (FB.FETCHFILENAME ITEM)))
(add NDELETED 1)
(FB.REMOVE.FILE TBROWSER FBROWSER ITEM)
(FB.UPDATE.COUNTERS FBROWSER (QUOTE BOTH)))
(T (FB.PROMPTWPRINT FBROWSER T "Couldn't expunge " FILENAME)
(SETQ FAILED T]
(FB.PROMPTWPRINT FBROWSER (COND
((EQ NDELETED 0)
"
No")
(T (CONCAT (COND
(FAILED "
Done, but only ")
(T "done, "))
NDELETED)))
" files expunged.")
(COND
(FAILED (COND
(CMD (FB.PROMPTWPRINT FBROWSER " " CMD " aborted.")))
(RETURN]
(T (FB.PROMPTWPRINT FBROWSER T "No files were marked for deletion")))
(RETURN T])
(FB.REMOVE.FILE
[LAMBDA (TBROWSER FBROWSER ITEM) (* bvm: "13-Oct-85 17:44")
(* * Removes ITEM from browser display, counts its removal)
(LET ((N (fetch TI# of ITEM))
PREVITEM NEXTITEM NEXTNEXTITEM)
[COND
((AND (NEQ N 1)
[fetch TIUNSELECTABLE of (SETQ PREVITEM (TB.NTH.ITEM TBROWSER (SUB1 N]
(OR [NULL (SETQ NEXTITEM (TB.NTH.ITEM TBROWSER (ADD1 N]
(fetch TIUNSELECTABLE of NEXTITEM))) (* ITEM is between two subdirectory
lines, so remove at least the
preceding line)
(TB.REMOVE.ITEM TBROWSER PREVITEM)
(COND
([AND NEXTITEM (SETQ NEXTNEXTITEM (TB.NTH.ITEM TBROWSER (ADD1 N)))
(COND
[(EQ (add N -1)
1) (* N decremented because of the remove
above. Now removing first file, so see
if next file has no subdir)
(NULL (fetch (FBFILEDATA SUBDIRECTORY) of (fetch TIDATA of NEXTNEXTITEM]
(T (STRING-EQUAL (fetch (FBFILEDATA SUBDIRECTORY)
of (fetch TIDATA of NEXTNEXTITEM))
(fetch (FBFILEDATA SUBDIRECTORY) of (fetch TIDATA
of (TB.NTH.ITEM
TBROWSER
(SUB1 N]
(* The next subdirectory line is
superfluous, because the file after it
and the file before us have the same
subdirectory)
(TB.REMOVE.ITEM TBROWSER NEXTITEM]
(TB.REMOVE.ITEM TBROWSER ITEM)
(FB.COUNT.FILE.CHANGE FBROWSER ITEM (QUOTE REMOVE])
(FB.COUNT.FILE.CHANGE
[LAMBDA (FBROWSER ITEM FLG) (* bvm: "13-Oct-85 17:47")
(* * Account for the addition or removal of ITEM from FBROWSER --
FLG is ADD or REMOVE)
(LET ((SIGN (SELECTQ FLG
(ADD 1)
(REMOVE -1)
(SHOULDNT)))
(SIZE (fetch (FBFILEDATA SIZE) of (fetch TIDATA of ITEM)))
(DELETEDP (fetch TIDELETED of ITEM)))
(replace (FILEBROWSER TOTALFILES) of FBROWSER with (add (fetch (FILEBROWSER TOTALFILES)
of FBROWSER)
SIGN))
[COND
(DELETEDP (replace (FILEBROWSER DELETEDFILES) of FBROWSER
with (add (fetch (FILEBROWSER DELETEDFILES) of FBROWSER)
SIGN]
(COND
(SIZE (add (fetch (FILEBROWSER TOTALPAGES) of FBROWSER)
(SETQ SIZE (ITIMES SIZE SIGN)))
(COND
(DELETEDP (add (fetch (FILEBROWSER DELETEDPAGES) of FBROWSER)
SIZE])
(FB.NEWPATTERNCOMMAND
[LAMBDA (BROWSER) (* bvm: "27-Sep-85 12:31")
(LET (PATTERN)
(COND
((AND (FB.MAYBE.EXPUNGE BROWSER "New Pattern")
(SETQ PATTERN (FB.GET.NEWPATTERN BROWSER)))
(FB.SETNEWPATTERN BROWSER PATTERN)
(FB.UPDATEBROWSERITEMS BROWSER])
(FB.SETNEWPATTERN
[LAMBDA (FBROWSER PATTERN) (* bvm: "12-Sep-85 18:07")
(LET (ICON)
(replace (FILEBROWSER PATTERN) of FBROWSER with PATTERN)
(replace (FILEBROWSER PREPAREDPATTERN) of FBROWSER with (DIRECTORY.MATCH.SETUP PATTERN))
(replace (FILEBROWSER PATTERNPARSED?) of FBROWSER with NIL)
(COND
((SETQ ICON (WINDOWPROP (fetch (FILEBROWSER BROWSERWINDOW) of FBROWSER)
(QUOTE ICONWINDOW))) (* Change the icon label)
(ICONW.TITLE ICON PATTERN)))
PATTERN])
(FB.NEWINFOCOMMAND
[LAMBDA (BROWSER) (* bvm: "18-Sep-85 23:37")
(LET ((WINDOW (fetch (FILEBROWSER BROWSERWINDOW) of BROWSER))
(INFOMENUW (fetch (FILEBROWSER INFOMENUW) of BROWSER))
REG)
(COND
((NOT (OPENWP INFOMENUW))
[SETQ INFOMENUW
(MENUWINDOW (create MENU
ITEMS ← FB.INFOMENUITEMS
MENUROWS ← 2
TITLE ← "Info Options"
CENTERFLG ← T
MENUFONT ← FB.MENUFONT
WHENSELECTEDFN ← (FUNCTION FB.INFOMENU.WHENSELECTEDFN]
(ATTACHWINDOW INFOMENUW WINDOW (QUOTE BOTTOM)
(QUOTE JUSTIFY)
(QUOTE LOCALCLOSE))
[COND
((LESSP [fetch (REGION BOTTOM) of (SETQ REG (WINDOWPROP INFOMENUW (QUOTE REGION]
0) (* Bump whole window up on screen so
we can see it)
(MOVEW WINDOW (create POSITION
XCOORD ← (fetch (REGION LEFT) of REG)
YCOORD ← (fetch (REGION HEIGHT) of REG]
(FB.INFOMENU.SHADEINITIALSELECTIONS INFOMENUW (fetch INFOMENUCHOICES of BROWSER))
(replace INFOMENUW of BROWSER with INFOMENUW)
(WINDOWADDPROP INFOMENUW (QUOTE CLOSEFN)
[FUNCTION (LAMBDA (W)
(AND (SETQ W (WINDOWPROP (MAINWINDOW W T)
(QUOTE FILEBROWSER)))
(replace INFOMENUW of W with NIL]
T)))
(FB.PROMPTWPRINT BROWSER (QUOTE CLEAR)
"Select from the lower menu which attributes are to be displayed,
then click Recompute"])
(FB.GET.NEWPATTERN
[LAMBDA (BROWSER) (* bvm: "12-Sep-85 18:10")
(LET* ((OLDPATTERN (fetch PATTERN of BROWSER))
(PATTERN (FB.PROMPTFORINPUT (COND
(OLDPATTERN "New file group description: ")
(T "File group description: "))
OLDPATTERN BROWSER T)))
(COND
(PATTERN (DIRECTORY.FILL.PATTERN PATTERN])
(FB.OPTIONSCOMMAND
[LAMBDA (BROWSER) (* bvm: "13-Sep-85 16:13")
(FB.PROMPTWPRINT BROWSER
"Please use the Options roll-out submenu to select the option you desire."])
)
(* window functions)
(DEFINEQ
(FB.PROMPTWPRINT
[LAMBDA U (* bvm: "12-Sep-85 18:35")
(COND
((ILESSP U 2)
(ERROR "not enough args to PROMPTWPRINT"))
(T (LET ((WINDOW (fetch (FILEBROWSER PROMPTWINDOW) of (ARG U 1)))
THING) (* CAR is window, CDR is height in
lines)
(for ITEM from 2 to U do (SELECTQ (SETQ THING (ARG U ITEM))
(T (TERPRI WINDOW))
(CLEAR (CLEARW WINDOW))
(FRESH (FRESHLINE WINDOW))
(PRIN1 THING WINDOW])
(FB.PROMPTFORINPUT
[LAMBDA (PROMPT DEFAULT BROWSER ABORTFLG DONTCLEAR) (* bvm: " 6-Mar-86 16:56")
(* * Prompt for input for browser BROWSER with question PROMPT offering default
answer DEFAULT. If ABORTFLG is true and response is NIL, prints "... aborted")
(LET* ((PWINDOW (fetch (FILEBROWSER PROMPTWINDOW) of BROWSER))
(PROMPTWIDTH (STRINGWIDTH PROMPT PWINDOW))
(WINDOWWIDTH (WINDOWPROP PWINDOW (QUOTE WIDTH)))
RESULT)
(COND
(DONTCLEAR (FRESHLINE PWINDOW))
(T (CLEARW PWINDOW)))
[COND
((IGREATERP (IPLUS PROMPTWIDTH (STRINGWIDTH (OR DEFAULT "XXX")
PWINDOW))
WINDOWWIDTH) (* Prompt plus default response will
overflow the width of the window, so
be a nice guy and break it up)
(for I from (DIFFERENCE (NCHARS PROMPT)
4) to 10 by -1 bind (EXCESSWIDTH ← (IDIFFERENCE PROMPTWIDTH
WINDOWWIDTH))
when (AND (EQ (NTHCHARCODE PROMPT I)
(CHARCODE SPACE))
(IGREATERP (STRINGWIDTH (SUBSTRING PROMPT I)
PWINDOW)
EXCESSWIDTH)) do (RETURN (SETQ PROMPT (CONCAT (SUBSTRING
PROMPT 1
(SUB1 I))
"
"
(SUBSTRING
PROMPT
(ADD1 I]
[SETQ RESULT (CAR (NLSETQ (PROMPTFORWORD PROMPT DEFAULT NIL PWINDOW NIL (QUOTE TTY)
(CHARCODE (CR ESC]
(COND
((AND (NULL RESULT)
ABORTFLG)
(PRINTOUT PWINDOW "... aborted")))
(TERPRI PWINDOW)
RESULT])
(FB.INFOMENU.SHADEINITIALSELECTIONS
[LAMBDA (MENUWINDOW INITIALSELECTIONS) (* bvm: "11-Sep-85 14:52")
(LET* ([MENU (CAR (WINDOWPROP MENUWINDOW (QUOTE MENU]
(MENUITEMS (fetch (MENU ITEMS) of MENU)))
(for SELECTION in INITIALSELECTIONS do (SHADEITEM (FB.\ItemWithTag SELECTION MENUITEMS)
MENU FB.INFOSHADE MENUWINDOW])
(FB.\ItemWithTag
[LAMBDA (TAG ITEMS) (* hdj "16-Sep-84 16:16")
(* * search a menu's items for one with tag TAG)
(for ITEM in ITEMS do (COND
((EQ (CADR ITEM)
TAG)
(RETURN ITEM])
)
(DEFINEQ
(FB.MAKECOUNTERWINDOW
[LAMBDA (BROWSERWINDOW FONT WIDTH HEIGHT TITLE) (* bvm: "20-Dec-85 21:17")
(LET ((COUNTERW (CREATEW (create REGION
LEFT ← 0
BOTTOM ← 0
HEIGHT ← HEIGHT
WIDTH ← WIDTH)
(OR TITLE "File Browser Window")
NIL T)))
(FB.MAKERIGIDWINDOW COUNTERW)
(DSPFONT FONT COUNTERW)
(ATTACHWINDOW COUNTERW BROWSERWINDOW (QUOTE TOP))
(replace COUNTERWINDOW of (WINDOWPROP BROWSERWINDOW (QUOTE FILEBROWSER)) with COUNTERW)
(WINDOWPROP COUNTERW (QUOTE REPAINTFN)
(FUNCTION FB.COUNTERW.REDISPLAYFN))
(WINDOWPROP COUNTERW (QUOTE RESHAPEFN)
(FUNCTION FB.COUNTERW.REDISPLAYFN))
(WINDOWPROP COUNTERW (QUOTE PAGEFULLFN)
(FUNCTION NILL))
COUNTERW])
(FB.COUNTERW.REDISPLAYFN
[LAMBDA (COUNTERWINDOW) (* bvm: "11-Sep-85 12:44")
(CLEARW COUNTERWINDOW)
(FB.DISPLAY.COUNTERS (WINDOWPROP (MAINWINDOW COUNTERWINDOW T)
(QUOTE FILEBROWSER])
(FB.UPDATE.COUNTERS
[LAMBDA (FBROWSER TYPE) (* bvm: "13-Sep-85 15:56")
(LET* ((COUNTERW (fetch COUNTERWINDOW of FBROWSER))
(XPOSPAIRS (fetch (FILEBROWSER COUNTERPOSITIONS) of FBROWSER))
(TOTAL (fetch (FILEBROWSER TOTALFILES) of FBROWSER))
(TOTALPAGES (fetch (FILEBROWSER TOTALPAGES) of FBROWSER))
(DEL (fetch (FILEBROWSER DELETEDFILES) of FBROWSER))
(DELPAGES (fetch (FILEBROWSER DELETEDPAGES) of FBROWSER))
(PAGESTRING (fetch (FILEBROWSER COUNTERPAGESTRING) of FBROWSER))
(HEIGHT (WINDOWPROP COUNTERW (QUOTE HEIGHT)))
HERE LABELS)
[SETQ LABELS (LIST (COND
((fetch (FILEBROWSER SHOWUNDELETED?) of FBROWSER)
(FB.COUNTER.STRING FBROWSER (IDIFFERENCE TOTAL DEL)
(IDIFFERENCE TOTALPAGES DELPAGES)))
((NEQ TYPE (QUOTE DELETED)) (* Don't need to update total if only
deleted count changed)
(FB.COUNTER.STRING FBROWSER TOTAL TOTALPAGES)))
(AND (NEQ TYPE (QUOTE TOTAL))
(FB.COUNTER.STRING FBROWSER DEL DELPAGES]
(DSPXPOSITION 0 COUNTERW)
(for LAB in LABELS as PAIR in XPOSPAIRS when LAB do (DSPXPOSITION (CAR PAIR)
COUNTERW)
(PRIN3 LAB COUNTERW)
(PRIN3 PAGESTRING COUNTERW)
(BLTSHADE WHITESHADE COUNTERW
(SETQ HERE (DSPXPOSITION NIL
COUNTERW))
0
(IDIFFERENCE (CADR PAIR)
HERE)
HEIGHT
(QUOTE REPLACE])
(FB.DISPLAY.COUNTERS
[LAMBDA (FBROWSER) (* bvm: "11-Sep-85 15:45")
(LET* ((COUNTERW (fetch COUNTERWINDOW of FBROWSER))
(TOTAL (fetch (FILEBROWSER TOTALFILES) of FBROWSER))
(TOTALPAGES (fetch (FILEBROWSER TOTALPAGES) of FBROWSER))
(DEL (fetch (FILEBROWSER DELETEDFILES) of FBROWSER))
(DELPAGES (fetch (FILEBROWSER DELETEDPAGES) of FBROWSER))
(COUNTERWIDTH (WINDOWPROP COUNTERW (QUOTE WIDTH)))
(COUNTERFONT (DSPFONT NIL COUNTERW))
(SECTIONWIDTH (IQUOTIENT COUNTERWIDTH 2))
[THRESHOLDWIDTH (IDIFFERENCE SECTIONWIDTH (ITIMES 2 (CHARWIDTH (CHARCODE a)
COUNTERFONT]
(HEIGHT (WINDOWPROP COUNTERW (QUOTE HEIGHT)))
PAGESTRING MAXWIDTH HERE LABELS)
[SETQ LABELS (LIST [COND
[(fetch (FILEBROWSER SHOWUNDELETED?) of FBROWSER)
(LIST "Undeleted: " (FB.COUNTER.STRING FBROWSER (IDIFFERENCE TOTAL
DEL)
(IDIFFERENCE TOTALPAGES DELPAGES]
(T (LIST "Total: " (FB.COUNTER.STRING FBROWSER TOTAL TOTALPAGES]
(LIST "Deleted: " (FB.COUNTER.STRING FBROWSER DEL DELPAGES]
(DSPXPOSITION 0 COUNTERW)
(DSPRIGHTMARGIN MAX.SMALLP COUNTERW)
(LINELENGTH MAX.SMALLP COUNTERW)
(SETQ MAXWIDTH 0)
[for LAB in LABELS do (SETQ MAXWIDTH (IMAX MAXWIDTH (IPLUS (STRINGWIDTH (CAR LAB)
COUNTERFONT)
(STRINGWIDTH (CADR LAB)
COUNTERFONT]
(COND
((NOT (fetch (FILEBROWSER PAGECOUNT?) of FBROWSER))
(SETQ PAGESTRING ""))
((IGREATERP (PLUS MAXWIDTH (STRINGWIDTH (SETQ PAGESTRING " pages")
COUNTERFONT))
THRESHOLDWIDTH) (* Try a shorter word)
(SETQ PAGESTRING " pgs")))
[COND
((IGREATERP (PLUS MAXWIDTH (STRINGWIDTH PAGESTRING COUNTERFONT))
THRESHOLDWIDTH) (* The long labels are too long, so
abbreviate them. Only have to do this
for very narrow windows)
(for LAB in LABELS do (RPLACA LAB (CONCAT (SUBSTRING (CAR LAB)
1 3)
": "]
[replace (FILEBROWSER COUNTERPOSITIONS) of FBROWSER
with (for LAB in LABELS as NEXTPOS from SECTIONWIDTH by SECTIONWIDTH
collect (PRIN3 (CAR LAB)
COUNTERW)
(LIST (DSPXPOSITION NIL COUNTERW)
(PROGN (PRIN3 (CADR LAB)
COUNTERW)
(PRIN3 PAGESTRING COUNTERW)
(BLTSHADE WHITESHADE COUNTERW (SETQ HERE (DSPXPOSITION NIL
COUNTERW))
0
(IDIFFERENCE NEXTPOS HERE)
HEIGHT
(QUOTE REPLACE))
(DSPXPOSITION NEXTPOS COUNTERW)
NEXTPOS]
(replace (FILEBROWSER COUNTERPAGESTRING) of FBROWSER with PAGESTRING])
(FB.COUNTER.STRING
[LAMBDA (FBROWSER NFILES NPAGES) (* bvm: "11-Sep-85 11:44")
(COND
((fetch (FILEBROWSER PAGECOUNT?) of FBROWSER)
(CONCAT NFILES " / " NPAGES))
(T (MKSTRING NFILES])
)
(DEFINEQ
(FB.MAKEHEADINGWINDOW
[LAMBDA (BROWSERWINDOW WIDTH HEIGHT FONT) (* bvm: "13-Oct-85 14:26")
(LET ((HEADINGW (CREATEW (create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ← WIDTH
HEIGHT ← HEIGHT)
NIL 0 T)))
(DSPFONT FONT HEADINGW)
(FB.MAKERIGIDWINDOW HEADINGW)
(ATTACHWINDOW HEADINGW BROWSERWINDOW (QUOTE TOP))
(WINDOWPROP HEADINGW (QUOTE PASSTOMAINCOMS)
T) (* Pass ALL window ops to main window,
since we look sort of like a title bar)
(DSPTEXTURE BLACKSHADE HEADINGW)
(WINDOWPROP HEADINGW (QUOTE REPAINTFN)
(FUNCTION FB.HEADINGW.REDISPLAYFN))
(WINDOWPROP HEADINGW (QUOTE RESHAPEFN)
(FUNCTION FB.HEADINGW.RESHAPEFN)) (* This is a white on black window)
(DSPOPERATION (QUOTE INVERT)
HEADINGW)
(DSPFILL NIL BLACKSHADE (QUOTE REPLACE)
HEADINGW)
(replace HEADINGWINDOW of (WINDOWPROP BROWSERWINDOW (QUOTE FILEBROWSER)) with HEADINGW)
HEADINGW])
(FB.HEADINGW.REDISPLAYFN
[LAMBDA (WINDOW) (* bvm: "19-Sep-85 14:39")
(FB.HEADINGW.DISPLAY (WINDOWPROP (WINDOWPROP WINDOW (QUOTE MAINWINDOW))
(QUOTE FILEBROWSER))
WINDOW])
(FB.HEADINGW.RESHAPEFN
[LAMBDA (WINDOW) (* bvm: "19-Sep-85 14:39")
(* * Redraw the heading window after a reshape)
(LET [(FBROWSER (WINDOWPROP (WINDOWPROP WINDOW (QUOTE MAINWINDOW))
(QUOTE FILEBROWSER]
(CLEARW WINDOW)
(FB.HEADINGW.DISPLAY FBROWSER WINDOW)
(FB.UPDATE.HEADING.EXTENT FBROWSER WINDOW])
(FB.HEADINGW.DISPLAY
[LAMBDA (FBROWSER WINDOW) (* bvm: "13-Oct-85 14:29")
(LET ((NEXTPOS (fetch (FILEBROWSER INFOSTART) of FBROWSER))
(HEADINGS (fetch (FILEBROWSER INFODISPLAYED) of FBROWSER)))
(DSPFILL NIL BLACKSHADE (QUOTE REPLACE)
WINDOW)
(COND
(NEXTPOS (DSPRIGHTMARGIN 32000 WINDOW)
(DSPXPOSITION (IPLUS TB.LEFT.MARGIN WBorder)
WINDOW)
(PRIN3 "Name" WINDOW)
(for SPEC in FB.INFOFIELDS when (FMEMB (fetch INFONAME of SPEC)
HEADINGS)
do (DSPXPOSITION NEXTPOS WINDOW)
(PRIN3 (fetch (INFOFIELD INFOLABEL) of SPEC)
WINDOW)
(add NEXTPOS (fetch (INFOFIELD INFOWIDTH) of SPEC])
)
(DEFINEQ
(FB.ICONFN
[LAMBDA (WINDOW OLDICON) (* bvm: "11-Sep-85 14:52")
(OR OLDICON (TITLEDICONW (create TITLEDICON
ICON ← FILEDRAWER
TITLEREG ← FILEDRAWERREGION)
(fetch PATTERN of (WINDOWPROP WINDOW (QUOTE FILEBROWSER)))
FB.ICONFONT NIL NIL NIL (QUOTE FILE])
(FB.SCROLLFN
[LAMBDA (WINDOW HORIZ VERT CONTINUOUS?) (* bvm: "14-Sep-85 15:56")
(* * Scroll FB window up/down and right/left.
In right/left case, tell heading window to scroll also)
(* * only scroll an integral number of text lines)
(RESETLST (LET [(FBROWSER (WINDOWPROP WINDOW (QUOTE FILEBROWSER]
(COND
((OBTAIN.MONITORLOCK (fetch (FILEBROWSER TBLOCK) of FBROWSER)
T T)
(COND
((NEQ HORIZ 0)
(COND
((fetch EXTENTCHANGED of FBROWSER)
(FB.UPDATE.HEADING.EXTENT FBROWSER WINDOW)))
(SCROLLW (fetch HEADINGWINDOW of FBROWSER)
HORIZ VERT CONTINUOUS?))
((NEQ VERT 0) (* Horizontal extent might change as
we print new items to the window --
be conservative)
(replace EXTENTCHANGED of FBROWSER with T)))
(SCROLLBYREPAINTFN WINDOW HORIZ VERT CONTINUOUS?))
(T (TB.BROWSER.BUSY (fetch (FILEBROWSER TABLEBROWSER) of FBROWSER])
(FB.UPDATE.HEADING.EXTENT
[LAMBDA (FBROWSER WINDOW) (* bvm: "19-Sep-85 14:32")
(* * Keep the heading window with the same horizontal extent as the main window
so that they scroll together correctly)
(LET [(EXT (WINDOWPROP WINDOW (QUOTE EXTENT]
[COND
(EXT (WINDOWPROP (fetch HEADINGWINDOW of FBROWSER)
(QUOTE EXTENT)
(create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ← (fetch (REGION WIDTH) of EXT)
HEIGHT ← -1]
(replace EXTENTCHANGED of FBROWSER with NIL])
(FB.INFOMENU.WHENSELECTEDFN
[LAMBDA (ITEM MENU KEY) (* bvm: "18-Sep-85 11:51")
(LET* ((INFO (CADR ITEM))
(WINDOW (WINDOWPROP (WFROMMENU MENU)
(QUOTE MAINWINDOW)))
(BROWSER (WINDOWPROP WINDOW (QUOTE FILEBROWSER)))
(CHOSEN (fetch (FILEBROWSER INFOMENUCHOICES) of BROWSER)))
[COND
((FMEMB INFO CHOSEN)
(SHADEITEM ITEM MENU WHITESHADE)
(SETQ CHOSEN (REMOVE INFO CHOSEN)))
(T (SHADEITEM ITEM MENU FB.INFOSHADE)
(SETQ CHOSEN (CONS INFO CHOSEN]
(replace (FILEBROWSER INFOMENUCHOICES) of BROWSER with CHOSEN])
(FB.CLOSEFN
[LAMBDA (TBROWSER WINDOW FLG) (* bvm: "14-Sep-85 15:56")
(* did you really want to close up
shop?)
(COND
((NEQ (TB.NUMBER.OF.ITEMS TBROWSER (QUOTE DELETED))
0)
(SELECTQ (MENU (FB.EXPUNGE?.MENU))
(EXPUNGE (* Do expunge in another process, not
here in mouse)
(FUNCTION FB.CLOSE&EXPUNGE))
(NOEXPUNGE NIL)
(QUOTE DON'T])
(FB.EXPUNGE?.MENU
[LAMBDA NIL (* bvm: "27-Sep-85 13:08")
(OR FB.EXPUNGE?MENU
(SETQ FB.EXPUNGE?MENU
(create MENU
ITEMS ← FB.CLOSEMENUITEMS
MENUROWS ← 2
CENTERFLG ← T
TITLE ← "Do what with deleted files?"
MENUFONT ← FB.BROWSERFONT])
(FB.AFTERCLOSEFN
[LAMBDA (TBROWSER WINDOW) (* bvm: "12-Sep-85 15:12")
(* * Snap circularities before window vanishes)
(LET ((FBROWSER (WINDOWPROP WINDOW (QUOTE FILEBROWSER)
NIL)))
(replace (FILEBROWSER TABLEBROWSER) of FBROWSER with NIL)
(TB.USERDATA TBROWSER NIL])
(FB.CLOSE&EXPUNGE
[LAMBDA (TBROWSER WINDOW FLG) (* bvm: "27-Sep-85 14:27")
(LET ((BROWSER (TB.USERDATA TBROWSER))
MENU ITEM)
[find W in (ATTACHEDWINDOWS WINDOW) suchthat (AND [SETQ MENU (CAR (WINDOWPROP W (QUOTE
MENU]
(EQ 1 (fetch (MENU MENUCOLUMNS)
of MENU]
(SETQ ITEM (ASSOC (QUOTE Expunge)
(fetch (MENU ITEMS) of MENU)))
(RESETLST (FB.MAKE.BROWSER.BUSY BROWSER ITEM MENU)
(COND
((FB.EXPUNGECOMMAND BROWSER NIL NIL NIL FLG)
(* Expunge succeeded.
Unshade the Expunge item before we
shrink, or else it will still be
shaded when we expand)
(SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
(TB.FINISH.CLOSE TBROWSER (fetch (FILEBROWSER BROWSERWINDOW) of BROWSER)
FLG])
)
(DEFINEQ
(FB.FASTSEECOMMAND
[LAMBDA (BROWSER KEY ITEM MENU UNFORMATTED) (* bvm: "15-Oct-85 01:10")
(PROG (FILELIST SEEWINDOW)
(OR (SETQ FILELIST (for FILE in (FB.SELECTEDFILES BROWSER) collect FILE
unless (FB.VIEW.SUBDIRECTORY? (SETQ FILE (FB.FETCHFILENAME FILE))
BROWSER)))
(RETURN))
(* * if the last created see window is in use, or there isn't one, create a new
one)
[COND
((OR [NOT (WINDOWP (SETQ SEEWINDOW (fetch SEEWINDOW of BROWSER]
(WINDOWPROP SEEWINDOW (QUOTE INUSE)))
(SETQ SEEWINDOW (CREATEW NIL "SEE window"))
(DSPSCROLL T SEEWINDOW)
(replace SEEWINDOW of BROWSER with SEEWINDOW)
(WINDOWPROP SEEWINDOW (QUOTE PAGEFULLFN)
(FUNCTION FB.SEEFULLFN))
(WINDOWADDPROP SEEWINDOW (QUOTE CLOSEFN)
(FUNCTION (LAMBDA (W)
(WINDOWPROP W (QUOTE INUSE)
NIL)
(DEL.PROCESS (WINDOWPROP W (QUOTE PROCESS]
(RESETSAVE (WINDOWPROP SEEWINDOW (QUOTE INUSE)
T)
(LIST (FUNCTION WINDOWPROP)
SEEWINDOW
(QUOTE INUSE)
NIL))
(RESETSAVE (WINDOWPROP SEEWINDOW (QUOTE PROCESS)
(THIS.PROCESS))
(LIST (FUNCTION WINDOWPROP)
SEEWINDOW
(QUOTE PROCESS)
NIL))
(TTYDISPLAYSTREAM SEEWINDOW) (* Has to be our TTYDISPLAYSTREAM in
order for page holding to work)
(for TAIL on FILELIST do (ERSETQ (FB.FASTSEE.ONEFILE (CAR TAIL)
SEEWINDOW UNFORMATTED (CDR TAIL])
(FB.FASTSEE.ONEFILE
[LAMBDA (FILE WINDOW UNFORMATTED MORE) (* bvm: "18-Sep-85 23:28")
(RESETLST (WINDOWPROP WINDOW (QUOTE TITLE)
(CONCAT "Viewing " FILE))
(CLEARW WINDOW)
[WINDOWPROP WINDOW (QUOTE MORETYPE)
(COND
(MORE (QUOTE YETMOREBUTTONS))
(T (QUOTE LASTMOREBUTTONS]
[RESETSAVE NIL (LIST (QUOTE CLOSEF)
(SETQ FILE (OPENSTREAM FILE (QUOTE INPUT)
NIL
(QUOTE ((SEQUENTIAL T]
(RESETSAVE NIL (LIST [FUNCTION (LAMBDA (WINDOW)
(AND RESETSTATE (OPENWP WINDOW)
(WINDOWPROP WINDOW (QUOTE TITLE)
(CONCAT (WINDOWPROP WINDOW (QUOTE TITLE))
" -- " "Aborted"]
WINDOW))
(COND
(UNFORMATTED (COPYBYTES FILE WINDOW))
(T (PFCOPYBYTES FILE WINDOW)))
(WINDOWPROP WINDOW (QUOTE TITLE)
(CONCAT (WINDOWPROP WINDOW (QUOTE TITLE))
" -- " "Finished"))
(COND
(MORE (* Wait for OK to proceed)
(FB.SEEFULLFN (WINDOWPROP WINDOW (QUOTE DSP))
(QUOTE FINISHEDMOREBUTTONS])
(FB.SEEFULLFN
[LAMBDA (DSP PROP) (* bvm: "18-Sep-85 23:29")
(* PAGEFULLFN for a fast SEE window)
(LET* [(WINDOW (WFROMDS DSP))
[BUTTONS (WINDOWPROP WINDOW (OR PROP (SETQ PROP (WINDOWPROP WINDOW (QUOTE MORETYPE]
(EVENT (WINDOWPROP WINDOW (QUOTE MOREEVENT]
(COND
((NOT BUTTONS)
(SETQ BUTTONS (create MENU
ITEMS ← [SELECTQ PROP
(YETMOREBUTTONS
(QUOTE (("More" MORE
"View another screenfull of the file"
)
(" Next File " NEXT
"Abort view of this file, go on to next one"
)
("Abort" ABORT
"Abort viewing of this and any further files"
))))
(FINISHEDMOREBUTTONS
(QUOTE ((" Next File " NEXT
"Go on to view the next file")
("Abort" ABORT
"Abort the SEE command -- see no more files"
))))
(QUOTE ((" More " MORE
"View another screenfull of the file")
(" Abort " ABORT
"Abort view; allow this window to be re-used"
]
MENUROWS ← 1
WHENSELECTEDFN ← (FUNCTION FB.SEEBUTTONFN)
CENTERFLG ← T))
(SETQ BUTTONS (ADDMENU BUTTONS (CREATEW (CREATEREGION 0 0 (WIDTHIFWINDOW
(fetch (MENU IMAGEWIDTH)
of BUTTONS)
FB.MORE.BORDER)
(HEIGHTIFWINDOW (fetch (MENU IMAGEHEIGHT
)
of BUTTONS)
NIL FB.MORE.BORDER))
NIL FB.MORE.BORDER T)
NIL T))
(WINDOWPROP WINDOW PROP BUTTONS)))
[COND
((NOT EVENT)
(WINDOWPROP WINDOW (QUOTE MOREEVENT)
(SETQ EVENT (CREATE.EVENT (WINDOWPROP WINDOW (QUOTE TITLE]
(ATTACHWINDOW BUTTONS WINDOW (COND
([GREATERP (fetch (REGION HEIGHT)
of (WINDOWPROP BUTTONS (QUOTE REGION)))
(fetch (REGION BOTTOM) of (WINDOWPROP WINDOW
(QUOTE REGION]
(QUOTE TOP))
(T (QUOTE BOTTOM)))
(QUOTE LEFT))
(do (TOTOPW BUTTONS)
(AWAIT.EVENT EVENT) repeatuntil (WINDOWPROP WINDOW (QUOTE MOREOK)
NIL])
(FB.SEEBUTTONFN
[LAMBDA (ITEM MENU) (* bvm: "14-Oct-85 23:02")
(* * WHENSELECTEDFN for the More/Abort menu)
(LET* ((MENUW (WFROMMENU MENU))
(WINDOW (MAINWINDOW MENUW)))
(DETACHWINDOW MENUW)
(CLOSEW MENUW)
(SELECTQ (CADR ITEM)
(MORE (WINDOWPROP WINDOW (QUOTE MOREOK)
T)
(NOTIFY.EVENT (WINDOWPROP WINDOW (QUOTE MOREEVENT))))
(NEXT (PROCESS.EVAL (WINDOWPROP WINDOW (QUOTE PROCESS))
(QUOTE (ERROR!))))
(ABORT (PROCESS.EVAL (WINDOWPROP WINDOW (QUOTE PROCESS))
(QUOTE (PROCESS.RETURN))))
(SHOULDNT])
)
(DECLARE: EVAL@COMPILE DONTCOPY
(FILESLOAD (SOURCE)
TABLEBROWSERDECLS)
[DECLARE: EVAL@COMPILE
(RECORD INFOFIELD (INFONAME INFOLABEL INFOWIDTH INFOFORMAT))
(DATATYPE FBFILEDATA ((FILENAME POINTER)
(FILEINFO POINTER)
(PRINTNAME POINTER)
(VERSIONLESSNAME POINTER)
(DIRECTORYP FLAG)
(HASDIRPREFIX FLAG)
(NIL 6 FLAG)
(SUBDIRECTORY POINTER)
(VERSION WORD)
(STARTOFNAME WORD)
(SIZE POINTER)
(SORTVALUE POINTER)))
(DATATYPE FILEBROWSER ((NOSUBDIRECTORIES FLAG) (*
"True if we don't want separate subdirectory lines -- subdirs then included in name")
(EXTENTCHANGED FLAG) (*
"True after a vertical scroll, which could have changed the horizontal extent")
(SHOWUNDELETED? FLAG) (*
"True if counter window should show `Undeleted' rather than `Total' counts")
(PATTERNPARSED? FLAG) (*
"True if PREPAREDPATTERN, NAMESTART, DIRECTORYSTART are valid")
(SORTBYDATE FLAG) (*
"True if SORTATTRIBUTE is one of the date attributes")
(SORTVERSIONSINCREASING FLAG)
(ABORTING FLAG) (*
"True if enumeration is being aborted")
(FIXEDTITLE FLAG) (* "True if caller supplied title")
(TABLEBROWSER POINTER) (*
"Pointer to TABLEBROWSER object controlling the browser")
(BROWSERWINDOW POINTER) (* "Main window")
(COUNTERWINDOW POINTER) (*
"Window that counts files, pages, deletions")
(HEADINGWINDOW POINTER) (*
"Window with headings for browser columns")
(INFOMENUW POINTER) (*
"Window containing choices for info to be displayed, or NIL if none yet")
(PROMPTWINDOW POINTER) (* "GETPROMPTWINDOW BROWSERWINDOW")
(INFODISPLAYED POINTER) (* "List of attributes to be displayed")
(PATTERN POINTER) (* "Directory pattern being enumerated")
(PREPAREDPATTERN POINTER) (* "DIRECTORY.MATCH.SETUP of same")
(SEEWINDOW POINTER) (*
"Primary window used by FAST SEE command")
(BROWSERFONT POINTER) (* "Font of BROWSERWINDOW")
(SORTBY POINTER) (*
"Sorting function or NIL for default sort")
(NAMESTART WORD) (*
"Index of first character in file name beyond the common prefix shared by all")
(DIRECTORYSTART WORD) (*
"Index of first character of directory in file names")
(INFOSTART WORD) (*
"X position in browser where first col of info is displayed")
(NAMEOVERHEAD WORD) (*
"This plus width of name gives is how much to allow before INFOSTART")
(OVERFLOWSPACING WORD) (*
"Increment between sizes considered for INFOSTART")
(DIGITWIDTH WORD)
(TOTALFILES WORD) (*
"Total number of files, deleted files, pages, deleted pages at the moment")
(DELETEDFILES WORD)
(TOTALPAGES POINTER)
(DELETEDPAGES POINTER)
(PAGECOUNT? POINTER) (*
"True if INFOCHOICES includes SIZE or LENGTH, so that we can count pages")
(COUNTERPOSITIONS POINTER) (*
"List of pairs (left right) describing regions where the values of the counters are displayed")
(COUNTERPAGESTRING POINTER) (*
"String to print after file/page count")
(OVERFLOWWIDTHS POINTER) (*
"List of (xpos occurrences) describing files whose names exceed default INFOSTART")
(INFOMENUCHOICES POINTER) (*
"Selections user has made in Info window, not necessarily the info currently displayed")
(UPDATEPROC POINTER) (* "Process doing an Update (Recompute)")
(DEFAULTDIR POINTER) (* Default directory for destination
of Copy/Rename)
(SORTATTRIBUTE POINTER) (* Attribute being sorted on, or NIL
if by name)
(SORTMENU POINTER)
(NIL POINTER)))
]
(/DECLAREDATATYPE (QUOTE FBFILEDATA)
(QUOTE (POINTER POINTER POINTER POINTER FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER WORD
WORD POINTER POINTER))
(QUOTE ((FBFILEDATA 0 POINTER)
(FBFILEDATA 2 POINTER)
(FBFILEDATA 4 POINTER)
(FBFILEDATA 6 POINTER)
(FBFILEDATA 6 (FLAGBITS . 0))
(FBFILEDATA 6 (FLAGBITS . 16))
(FBFILEDATA 6 (FLAGBITS . 32))
(FBFILEDATA 6 (FLAGBITS . 48))
(FBFILEDATA 6 (FLAGBITS . 64))
(FBFILEDATA 6 (FLAGBITS . 80))
(FBFILEDATA 6 (FLAGBITS . 96))
(FBFILEDATA 6 (FLAGBITS . 112))
(FBFILEDATA 8 POINTER)
(FBFILEDATA 10 (BITS . 15))
(FBFILEDATA 11 (BITS . 15))
(FBFILEDATA 12 POINTER)
(FBFILEDATA 14 POINTER)))
(QUOTE 16))
(/DECLAREDATATYPE (QUOTE FILEBROWSER)
(QUOTE (FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER WORD WORD WORD WORD WORD
WORD WORD WORD POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER))
(QUOTE ((FILEBROWSER 0 (FLAGBITS . 0))
(FILEBROWSER 0 (FLAGBITS . 16))
(FILEBROWSER 0 (FLAGBITS . 32))
(FILEBROWSER 0 (FLAGBITS . 48))
(FILEBROWSER 0 (FLAGBITS . 64))
(FILEBROWSER 0 (FLAGBITS . 80))
(FILEBROWSER 0 (FLAGBITS . 96))
(FILEBROWSER 0 (FLAGBITS . 112))
(FILEBROWSER 0 POINTER)
(FILEBROWSER 2 POINTER)
(FILEBROWSER 4 POINTER)
(FILEBROWSER 6 POINTER)
(FILEBROWSER 8 POINTER)
(FILEBROWSER 10 POINTER)
(FILEBROWSER 12 POINTER)
(FILEBROWSER 14 POINTER)
(FILEBROWSER 16 POINTER)
(FILEBROWSER 18 POINTER)
(FILEBROWSER 20 POINTER)
(FILEBROWSER 22 POINTER)
(FILEBROWSER 24 (BITS . 15))
(FILEBROWSER 25 (BITS . 15))
(FILEBROWSER 26 (BITS . 15))
(FILEBROWSER 27 (BITS . 15))
(FILEBROWSER 28 (BITS . 15))
(FILEBROWSER 29 (BITS . 15))
(FILEBROWSER 30 (BITS . 15))
(FILEBROWSER 31 (BITS . 15))
(FILEBROWSER 32 POINTER)
(FILEBROWSER 34 POINTER)
(FILEBROWSER 36 POINTER)
(FILEBROWSER 38 POINTER)
(FILEBROWSER 40 POINTER)
(FILEBROWSER 42 POINTER)
(FILEBROWSER 44 POINTER)
(FILEBROWSER 46 POINTER)
(FILEBROWSER 48 POINTER)
(FILEBROWSER 50 POINTER)
(FILEBROWSER 52 POINTER)
(FILEBROWSER 54 POINTER)))
(QUOTE 56))
(DECLARE: EVAL@COMPILE
(RPAQQ FB.MORE.BORDER 8)
(RPAQQ FB.NULL.VERSION 0)
(CONSTANTS FB.MORE.BORDER FB.NULL.VERSION)
)
(DECLARE: EVAL@COMPILE
(PUTPROPS NULL.VERSIONP MACRO ((V)
(EQ V 0)))
[PUTPROPS NULL.FIELDP MACRO (OPENLAMBDA (STR)
(OR (NULL STR)
(EQ (NCHARS STR)
0]
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS FB.ICONFONT FB.BROWSERFONT FB.PROMPTFONT FB.MENUFONT FB.EXPUNGE?MENU FILEDRAWER
FB.CLOSEMENUITEMS FB.MENU.ITEMS FB.DEFAULT.INFO INFOLISTINGWIDTHS FB.INFOSHADE
FB.INFOMENUITEMS FB.ITEMUNSELECTEDSHADE FB.ITEMSELECTEDSHADE DIRCOMMANDS FB.PROMPTLINES
FB.INFOFIELDS WindowTitleDisplayStream FILEDRAWERREGION FB.DEFAULT.NAME.WIDTH
FB.OVERFLOW.MAXABSOLUTE FB.OVERFLOW.MAXFRAC WBorder)
)
)
(/DECLAREDATATYPE (QUOTE FILEBROWSER)
(QUOTE (FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER WORD WORD WORD WORD WORD
WORD WORD WORD POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER))
(QUOTE ((FILEBROWSER 0 (FLAGBITS . 0))
(FILEBROWSER 0 (FLAGBITS . 16))
(FILEBROWSER 0 (FLAGBITS . 32))
(FILEBROWSER 0 (FLAGBITS . 48))
(FILEBROWSER 0 (FLAGBITS . 64))
(FILEBROWSER 0 (FLAGBITS . 80))
(FILEBROWSER 0 (FLAGBITS . 96))
(FILEBROWSER 0 (FLAGBITS . 112))
(FILEBROWSER 0 POINTER)
(FILEBROWSER 2 POINTER)
(FILEBROWSER 4 POINTER)
(FILEBROWSER 6 POINTER)
(FILEBROWSER 8 POINTER)
(FILEBROWSER 10 POINTER)
(FILEBROWSER 12 POINTER)
(FILEBROWSER 14 POINTER)
(FILEBROWSER 16 POINTER)
(FILEBROWSER 18 POINTER)
(FILEBROWSER 20 POINTER)
(FILEBROWSER 22 POINTER)
(FILEBROWSER 24 (BITS . 15))
(FILEBROWSER 25 (BITS . 15))
(FILEBROWSER 26 (BITS . 15))
(FILEBROWSER 27 (BITS . 15))
(FILEBROWSER 28 (BITS . 15))
(FILEBROWSER 29 (BITS . 15))
(FILEBROWSER 30 (BITS . 15))
(FILEBROWSER 31 (BITS . 15))
(FILEBROWSER 32 POINTER)
(FILEBROWSER 34 POINTER)
(FILEBROWSER 36 POINTER)
(FILEBROWSER 38 POINTER)
(FILEBROWSER 40 POINTER)
(FILEBROWSER 42 POINTER)
(FILEBROWSER 44 POINTER)
(FILEBROWSER 46 POINTER)
(FILEBROWSER 48 POINTER)
(FILEBROWSER 50 POINTER)
(FILEBROWSER 52 POINTER)
(FILEBROWSER 54 POINTER)))
(QUOTE 56))
(/DECLAREDATATYPE (QUOTE FBFILEDATA)
(QUOTE (POINTER POINTER POINTER POINTER FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER WORD
WORD POINTER POINTER))
(QUOTE ((FBFILEDATA 0 POINTER)
(FBFILEDATA 2 POINTER)
(FBFILEDATA 4 POINTER)
(FBFILEDATA 6 POINTER)
(FBFILEDATA 6 (FLAGBITS . 0))
(FBFILEDATA 6 (FLAGBITS . 16))
(FBFILEDATA 6 (FLAGBITS . 32))
(FBFILEDATA 6 (FLAGBITS . 48))
(FBFILEDATA 6 (FLAGBITS . 64))
(FBFILEDATA 6 (FLAGBITS . 80))
(FBFILEDATA 6 (FLAGBITS . 96))
(FBFILEDATA 6 (FLAGBITS . 112))
(FBFILEDATA 8 POINTER)
(FBFILEDATA 10 (BITS . 15))
(FBFILEDATA 11 (BITS . 15))
(FBFILEDATA 12 POINTER)
(FBFILEDATA 14 POINTER)))
(QUOTE 16))
[ADDTOVAR SYSTEMRECLST
(DATATYPE FILEBROWSER ((NOSUBDIRECTORIES FLAG)
(EXTENTCHANGED FLAG)
(SHOWUNDELETED? FLAG)
(PATTERNPARSED? FLAG)
(SORTBYDATE FLAG)
(SORTVERSIONSINCREASING FLAG)
(ABORTING FLAG)
(FIXEDTITLE FLAG)
(TABLEBROWSER POINTER)
(BROWSERWINDOW POINTER)
(COUNTERWINDOW POINTER)
(HEADINGWINDOW POINTER)
(INFOMENUW POINTER)
(PROMPTWINDOW POINTER)
(INFODISPLAYED POINTER)
(PATTERN POINTER)
(PREPAREDPATTERN POINTER)
(SEEWINDOW POINTER)
(BROWSERFONT POINTER)
(SORTBY POINTER)
(NAMESTART WORD)
(DIRECTORYSTART WORD)
(INFOSTART WORD)
(NAMEOVERHEAD WORD)
(OVERFLOWSPACING WORD)
(DIGITWIDTH WORD)
(TOTALFILES WORD)
(DELETEDFILES WORD)
(TOTALPAGES POINTER)
(DELETEDPAGES POINTER)
(PAGECOUNT? POINTER)
(COUNTERPOSITIONS POINTER)
(COUNTERPAGESTRING POINTER)
(OVERFLOWWIDTHS POINTER)
(INFOMENUCHOICES POINTER)
(UPDATEPROC POINTER)
(DEFAULTDIR POINTER)
(SORTATTRIBUTE POINTER)
(SORTMENU POINTER)
(NIL POINTER)))
(DATATYPE FBFILEDATA ((FILENAME POINTER)
(FILEINFO POINTER)
(PRINTNAME POINTER)
(VERSIONLESSNAME POINTER)
(DIRECTORYP FLAG)
(HASDIRPREFIX FLAG)
(NIL 6 FLAG)
(SUBDIRECTORY POINTER)
(VERSION WORD)
(STARTOFNAME WORD)
(SIZE POINTER)
(SORTVALUE POINTER)))
]
(DECLARE: DONTEVAL@LOAD DOCOPY
(ADDTOVAR BackgroundMenuCommands ("FileBrowser" (QUOTE (FILEBROWSER))
"Opens a filebrowser window; prompts for pattern"))
(RPAQQ BackgroundMenu NIL)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA FB)
(ADDTOVAR NLAML )
(ADDTOVAR LAMA FB.PROMPTWPRINT)
)
(PUTPROPS FILEBROWSER COPYRIGHT ("Xerox Corporation" 1983 1984 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (17116 30208 (FB 17126 . 17471) (FILEBROWSER 17473 . 27225) (FB.PRINTFN 27227 . 30008) (
FB.COPYFN 30010 . 30206)) (30227 31361 (FB.STARTUP 30237 . 30873) (FB.MAKERIGIDWINDOW 30875 . 31359))
(31406 34643 (FB.MENU.WHENSELECTEDFN 31416 . 31842) (FB.COMMANDSELECTEDFN 31844 . 33586) (FB.SUBITEMP
33588 . 34035) (FB.MAKE.BROWSER.BUSY 34037 . 34641)) (34644 35388 (FB.SELECTEDFILES 34654 . 35002) (
FB.TABLEBROWSER 35004 . 35191) (FB.FETCHFILENAME 35193 . 35386)) (35389 73750 (FB.DELETECOMMAND 35399
. 35677) (FB.DELVERCOMMAND 35679 . 37720) (FB.IS.NOT.SUBDIRECTORY.ITEM 37722 . 37899) (
FB.DELVER.FILES 37901 . 39571) (FB.DELETE.FILE 39573 . 40208) (FB.UNDELETE.FILE 40210 . 40834) (
FB.UNDELETECOMMAND 40836 . 41118) (FB.UNDELETEALLCOMMAND 41120 . 41396) (FB.HARDCOPYCOMMAND 41398 .
42416) (FB.HARDCOPY.TOFILE 42418 . 48809) (FB.LOADCOMMAND 48811 . 49343) (FB.EDITCOMMAND 49345 . 51865
) (FB.VIEW.SUBDIRECTORY? 51867 . 52990) (FB.EDITLISPFILE 52992 . 53815) (FB.COMPILECOMMAND 53817 .
54360) (FB.OPERATE.ON.FILES 54362 . 54971) (FB.COPYCOMMAND 54973 . 55173) (FB.RENAMECOMMAND 55175 .
55381) (FB.COPY/RENAME.COMMAND 55383 . 56113) (FB.COPY/RENAME.ONE 56115 . 57821) (FB.COPY/RENAME.MANY
57823 . 63990) (FB.GREATEST.PREFIX 63992 . 64662) (FB.MAYBE.INSERT.FILE 64664 . 69676) (
FB.GET.NEW.FILE.SPEC 69678 . 73748)) (73751 104742 (FB.UPDATECOMMAND 73761 . 73990) (FB.MAYBE.EXPUNGE
73992 . 74926) (FB.UPDATEBROWSERITEMS 74928 . 81540) (FB.CLEANUP.UPDATE 81542 . 82074) (
FB.ABORT.UPDATE 82076 . 83185) (FB.MAYBE.WIDEN.NAMES 83187 . 85349) (FB.SET.DEFAULT.NAME.WIDTH 85351
. 86428) (FB.CREATE.FILEBUCKET 86430 . 90126) (FB.CHECK.NAME.LENGTH 90128 . 93021) (FB.ADD.FILEGROUP
93023 . 94168) (FB.INSERT.DIRECTORY 94170 . 94397) (FB.MAKE.SUBDIRECTORY.ITEM 94399 . 95618) (
FB.ADD.FILE 95620 . 96230) (FB.INSERT.FILE 96232 . 99802) (FB.ANALYZE.PATTERN 99804 . 104436) (
FB.GETALLFILEINFO 104438 . 104740)) (104743 111735 (FB.SORT.VERSIONS 104753 . 107158) (
FB.DECREASING.VERSION 107160 . 107667) (FB.INCREASING.VERSION 107669 . 108172) (
FB.NAMES.DECREASING.VERSION 108174 . 108978) (FB.NAMES.INCREASING.VERSION 108980 . 109743) (
FB.DECREASING.NUMERIC.ATTR 109745 . 110435) (FB.INCREASING.NUMERIC.ATTR 110437 . 111121) (
FB.ALPHABETIC.ATTR 111123 . 111733)) (111736 122017 (FB.SORTCOMMAND 111746 . 117884) (
FB.INSERT.SUBDIRECTORIES 117886 . 118950) (FB.GET.SORT.MENU 118952 . 122015)) (122018 131578 (
FB.EXPUNGECOMMAND 122028 . 123759) (FB.REMOVE.FILE 123761 . 126267) (FB.COUNT.FILE.CHANGE 126269 .
127623) (FB.NEWPATTERNCOMMAND 127625 . 128011) (FB.SETNEWPATTERN 128013 . 128690) (FB.NEWINFOCOMMAND
128692 . 130823) (FB.GET.NEWPATTERN 130825 . 131334) (FB.OPTIONSCOMMAND 131336 . 131576)) (131608
135786 (FB.PROMPTWPRINT 131618 . 132434) (FB.PROMPTFORINPUT 132436 . 134961) (
FB.INFOMENU.SHADEINITIALSELECTIONS 134963 . 135418) (FB.\ItemWithTag 135420 . 135784)) (135787 144167
(FB.MAKECOUNTERWINDOW 135797 . 136803) (FB.COUNTERW.REDISPLAYFN 136805 . 137079) (FB.UPDATE.COUNTERS
137081 . 139640) (FB.DISPLAY.COUNTERS 139642 . 143903) (FB.COUNTER.STRING 143905 . 144165)) (144168
147262 (FB.MAKEHEADINGWINDOW 144178 . 145537) (FB.HEADINGW.REDISPLAYFN 145539 . 145816) (
FB.HEADINGW.RESHAPEFN 145818 . 146265) (FB.HEADINGW.DISPLAY 146267 . 147260)) (147263 153625 (
FB.ICONFN 147273 . 147705) (FB.SCROLLFN 147707 . 149201) (FB.UPDATE.HEADING.EXTENT 149203 . 149976) (
FB.INFOMENU.WHENSELECTEDFN 149978 . 150709) (FB.CLOSEFN 150711 . 151416) (FB.EXPUNGE?.MENU 151418 .
151814) (FB.AFTERCLOSEFN 151816 . 152219) (FB.CLOSE&EXPUNGE 152221 . 153623)) (153626 162424 (
FB.FASTSEECOMMAND 153636 . 155761) (FB.FASTSEE.ONEFILE 155763 . 157356) (FB.SEEFULLFN 157358 . 161645)
(FB.SEEBUTTONFN 161647 . 162422)))))
STOP