(FILECREATED " 9-Apr-86 15:11:43" {ERIS}<LISPCORE>LIBRARY>FILEBROWSER.;52 150799
changes to: (FNS FB.GET.SORT.MENU)
previous date: " 6-Mar-86 17:11:36" {ERIS}<LISPCORE>LIBRARY>FILEBROWSER.;51)
(* 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:
" 6-Mar-86 17:04")
(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
(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 (17072 25958 (FB 17082 . 17404) (FILEBROWSER 17406 . 23571) (FB.PRINTFN 23573 . 25758) (
FB.COPYFN 25760 . 25956)) (25977 26975 (FB.STARTUP 25987 . 26490) (FB.MAKERIGIDWINDOW 26492 . 26973))
(27020 29646 (FB.MENU.WHENSELECTEDFN 27030 . 27411) (FB.COMMANDSELECTEDFN 27413 . 28687) (FB.SUBITEMP
28689 . 29124) (FB.MAKE.BROWSER.BUSY 29126 . 29644)) (29647 30368 (FB.SELECTEDFILES 29657 . 29990) (
FB.TABLEBROWSER 29992 . 30175) (FB.FETCHFILENAME 30177 . 30366)) (30369 63927 (FB.DELETECOMMAND 30379
. 30656) (FB.DELVERCOMMAND 30658 . 32052) (FB.IS.NOT.SUBDIRECTORY.ITEM 32054 . 32231) (
FB.DELVER.FILES 32233 . 33061) (FB.DELETE.FILE 33063 . 33618) (FB.UNDELETE.FILE 33620 . 34175) (
FB.UNDELETECOMMAND 34177 . 34458) (FB.UNDELETEALLCOMMAND 34460 . 34733) (FB.HARDCOPYCOMMAND 34735 .
35481) (FB.HARDCOPY.TOFILE 35483 . 42147) (FB.LOADCOMMAND 42149 . 42581) (FB.EDITCOMMAND 42583 . 44194
) (FB.VIEW.SUBDIRECTORY? 44196 . 45062) (FB.EDITLISPFILE 45064 . 45792) (FB.COMPILECOMMAND 45794 .
46237) (FB.OPERATE.ON.FILES 46239 . 46804) (FB.COPYCOMMAND 46806 . 47006) (FB.RENAMECOMMAND 47008 .
47214) (FB.COPY/RENAME.COMMAND 47216 . 47851) (FB.COPY/RENAME.ONE 47853 . 49763) (FB.COPY/RENAME.MANY
49765 . 57251) (FB.GREATEST.PREFIX 57253 . 58036) (FB.MAYBE.INSERT.FILE 58038 . 61450) (
FB.GET.NEW.FILE.SPEC 61452 . 63925)) (63928 87501 (FB.UPDATECOMMAND 63938 . 64163) (FB.MAYBE.EXPUNGE
64165 . 64926) (FB.UPDATEBROWSERITEMS 64928 . 69686) (FB.CLEANUP.UPDATE 69688 . 70202) (
FB.ABORT.UPDATE 70204 . 71147) (FB.MAYBE.WIDEN.NAMES 71149 . 72572) (FB.SET.DEFAULT.NAME.WIDTH 72574
. 73431) (FB.CREATE.FILEBUCKET 73433 . 76214) (FB.CHECK.NAME.LENGTH 76216 . 78345) (FB.ADD.FILEGROUP
78347 . 79333) (FB.INSERT.DIRECTORY 79335 . 79559) (FB.MAKE.SUBDIRECTORY.ITEM 79561 . 80380) (
FB.ADD.FILE 80382 . 80932) (FB.INSERT.FILE 80934 . 83699) (FB.ANALYZE.PATTERN 83701 . 87187) (
FB.GETALLFILEINFO 87189 . 87499)) (87502 93630 (FB.SORT.VERSIONS 87512 . 89135) (FB.DECREASING.VERSION
89137 . 89647) (FB.INCREASING.VERSION 89649 . 90144) (FB.NAMES.DECREASING.VERSION 90146 . 90960) (
FB.NAMES.INCREASING.VERSION 90962 . 91746) (FB.DECREASING.NUMERIC.ATTR 91748 . 92399) (
FB.INCREASING.NUMERIC.ATTR 92401 . 93046) (FB.ALPHABETIC.ATTR 93048 . 93628)) (93631 101987 (
FB.SORTCOMMAND 93641 . 97716) (FB.INSERT.SUBDIRECTORIES 97718 . 98583) (FB.GET.SORT.MENU 98585 .
101985)) (101988 109478 (FB.EXPUNGECOMMAND 101998 . 103221) (FB.REMOVE.FILE 103223 . 105074) (
FB.COUNT.FILE.CHANGE 105076 . 106147) (FB.NEWPATTERNCOMMAND 106149 . 106506) (FB.SETNEWPATTERN 106508
. 107158) (FB.NEWINFOCOMMAND 107160 . 108826) (FB.GET.NEWPATTERN 108828 . 109242) (FB.OPTIONSCOMMAND
109244 . 109476)) (109508 113675 (FB.PROMPTWPRINT 109518 . 110132) (FB.PROMPTFORINPUT 110134 . 112947)
(FB.INFOMENU.SHADEINITIALSELECTIONS 112949 . 113376) (FB.\ItemWithTag 113378 . 113673)) (113676
119907 (FB.MAKECOUNTERWINDOW 113686 . 114578) (FB.COUNTERW.REDISPLAYFN 114580 . 114843) (
FB.UPDATE.COUNTERS 114845 . 116497) (FB.DISPLAY.COUNTERS 116499 . 119644) (FB.COUNTER.STRING 119646 .
119905)) (119908 122631 (FB.MAKEHEADINGWINDOW 119918 . 121105) (FB.HEADINGW.REDISPLAYFN 121107 .
121366) (FB.HEADINGW.RESHAPEFN 121368 . 121799) (FB.HEADINGW.DISPLAY 121801 . 122629)) (122632 127770
(FB.ICONFN 122642 . 123006) (FB.SCROLLFN 123008 . 124137) (FB.UPDATE.HEADING.EXTENT 124139 . 124777) (
FB.INFOMENU.WHENSELECTEDFN 124779 . 125487) (FB.CLOSEFN 125489 . 126026) (FB.EXPUNGE?.MENU 126028 .
126355) (FB.AFTERCLOSEFN 126357 . 126736) (FB.CLOSE&EXPUNGE 126738 . 127768)) (127771 133891 (
FB.FASTSEECOMMAND 127781 . 129538) (FB.FASTSEE.ONEFILE 129540 . 130790) (FB.SEEFULLFN 130792 . 133154)
(FB.SEEBUTTONFN 133156 . 133889)))))
STOP