(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "26-Feb-88 14:10:50" {ERIS}<LISPCORE>LIBRARY>FILEBROWSER.;62 124448
changes to%: (FNS FB) (VARS FILEBROWSERCOMS)
previous date%: " 5-Feb-88 03:27:25" {ERIS}<LISPCORE>LIBRARY>FILEBROWSER.;60)
(* "
Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988 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.HARDCOPY.FONT) (FB.HARDCOPY.DIRECTORY.FONT) (FB.PROMPTLINES 3) (FB.MENUFONT (FONTCREATE (QUOTE HELVETICA) 10 (QUOTE MRR))) (FB.OVERFLOW.MAXABSOLUTE 30) (FB.OVERFLOW.MAXFRAC 0.06) (FB.DEFAULT.EDITOR (QUOTE TEDIT))) (VARS FB.MENU.ITEMS FB.CLOSE.MENU.ITEMS FB.DEPTH.MENU.ITEMS FB.INFO.MENU.ITEMS FB.DEFAULT.INFO FB.DEFAULT.NAME.WIDTH FB.INFO.FIELDS FB.INFOSHADE FB.ITEMUNSELECTEDSHADE FB.ITEMSELECTEDSHADE FB.ICONSPEC)) (COMS (* ; "Entries") (COMMANDS "fb") (FNS FB FILEBROWSER FB.TABLEBROWSER FB.SELECTEDFILES FB.FETCHFILENAME FB.PROMPTWPRINT FB.PROMPTW.FORMAT FB.PROMPTFORINPUT FB.ALLOW.ABORT) (* ; "Setup") (FNS FB.STARTUP FB.MAKERIGIDWINDOW) (FNS FB.PRINTFN FB.COPYFN)) (COMS (* ; "commands and major subfunctions") (FNS FB.MENU.WHENSELECTEDFN FB.COMMANDSELECTEDFN FB.SUBITEMP FB.MAKE.BROWSER.BUSY FB.FINISH.COMMAND FB.HANDLE.ABORT.BUTTON) (FNS FB.DELETECOMMAND FB.DELVERCOMMAND FB.IS.NOT.SUBDIRECTORY.ITEM FB.DELVER.FILES FB.DELETE.FILE) (FNS FB.UNDELETECOMMAND FB.UNDELETEALLCOMMAND FB.UNDELETE.FILE) (FNS 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.HARDCOPYCOMMAND FB.HARDCOPY.TOFILE) (FNS FB.EDITCOMMAND FB.EDITLISPFILE FB.BROWSECOMMAND) (FNS FB.FASTSEECOMMAND FB.FASTSEE.ONEFILE FB.SEEFULLFN FB.SEEBUTTONFN) (FNS FB.LOADCOMMAND FB.COMPILECOMMAND FB.OPERATE.ON.FILES) (FNS FB.UPDATECOMMAND FB.MAYBE.EXPUNGE FB.UPDATEBROWSERITEMS FB.DATE FB.ADJUST.DATE.WIDTH FB.SET.BROWSER.TITLE 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.NEWPATTERNCOMMAND FB.NEWINFOCOMMAND FB.DEPTHCOMMAND FB.SHAPECOMMAND FB.REMOVE.FILE FB.COUNT.FILE.CHANGE FB.SETNEWPATTERN FB.GET.NEWPATTERN FB.OPTIONSCOMMAND)) (COMS (* ; "window functions") (FNS FB.INFOMENU.SHADEINITIALSELECTIONS FB.INFO.ITEM.NAMED) (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.INFOMENU.WHENSELECTEDFN FB.CLOSEFN FB.EXPUNGE?.MENU FB.AFTERCLOSEFN FB.CLOSE&EXPUNGE) (FNS FB.HARDCOPY.DIRECTORY FB.HARDCOPY.PRINT.TITLE FB.HARDCOPY.MAXWIDTH)) (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE) TABLEBROWSERDECLS) (RECORDS INFOFIELD FBFILEDATA FILEBROWSER) (CONSTANTS FB.MORE.BORDER FB.NULL.VERSION) (MACROS NULL.VERSIONP NULL.DIRECTORYP EQ.DIRECTORYP NULL.FIELDP) (GLOBALVARS FB.ICONFONT FB.BROWSERFONT FB.PROMPTFONT FB.MENUFONT FB.HARDCOPY.FONT FB.HARDCOPY.DIRECTORY.FONT FB.EXPUNGE?MENU FB.CLOSE.MENU.ITEMS FB.DEPTH.MENU.ITEMS FB.MENU.ITEMS FB.DEFAULT.INFO FB.INFOSHADE FB.INFO.MENU.ITEMS FB.ITEMUNSELECTEDSHADE FB.ITEMSELECTEDSHADE DIRCOMMANDS FB.PROMPTLINES FB.INFO.FIELDS WindowTitleDisplayStream FB.ICONSPEC FB.DEFAULT.NAME.WIDTH FB.OVERFLOW.MAXABSOLUTE FB.OVERFLOW.MAXFRAC FB.DEFAULT.EDITOR) (LOCALVARS . T)) (INITRECORDS FILEBROWSER FBFILEDATA) (SYSRECORDS FILEBROWSER FBFILEDATA) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (COND ((EQ MAKESYSNAME :LYRIC) (* ; "Get patches for ignore-errors") (FILESLOAD (SYSLOAD) MVALUESPATCH))) (MOVD? (QUOTE PROMPTFORWORD) (QUOTE TTYINPROMPTFORWORD) NIL T)) (ADDVARS (*ATTACHED-WINDOW-COMMAND-SYNONYMS* (HARDCOPYIMAGEW.TOFILE . HARDCOPYIMAGEW) (HARDCOPYIMAGEW.TOPRINTER . HARDCOPYIMAGEW)) (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.PROMPTW.FORMAT 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.HARDCOPY.FONT )
(RPAQ? FB.HARDCOPY.DIRECTORY.FONT )
(RPAQ? FB.PROMPTLINES 3)
(RPAQ? FB.MENUFONT (FONTCREATE (QUOTE HELVETICA) 10 (QUOTE MRR)))
(RPAQ? FB.OVERFLOW.MAXABSOLUTE 30)
(RPAQ? FB.OVERFLOW.MAXFRAC 0.06)
(RPAQ? FB.DEFAULT.EDITOR (QUOTE TEDIT))
(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") ("FileBrowse" FB.BROWSECOMMAND "Recursively call FileBrowser on the selected subdirectory"))) (Edit FB.EDITCOMMAND "Calls an editor on the selected files (use submenu to specify editor)" (SUBITEMS ("TEdit" (FB.EDITCOMMAND TEDIT) "Calls TEdit (text editor) on selected files") ("Lisp Edit" (FB.EDITCOMMAND LISP) "Calls Lisp editor on selected files"))) (Load FB.LOADCOMMAND "LOADs selected files" (SUBITEMS ("IL:LOAD" FB.LOADCOMMAND "LOADs selected files") ("CL:LOAD" (FB.LOADCOMMAND CL:LOAD) "Performs CL: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 using default compiler" (SUBITEMS (TCOMPL (FB.COMPILECOMMAND TCOMPL) "Calls TCOMPL on selected files") (BCOMPL (FB.COMPILECOMMAND BCOMPL) "Calls BCOMPL on selected files") (COMPILE-FILE (FB.COMPILECOMMAND CL:COMPILE-FILE) "COMPILE-FILE's 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") ("Set Depth" FB.DEPTHCOMMAND "Change the depth to which future Recomputes will enumerate the directory (NS servers only)") ("Shape to Fit" FB.SHAPECOMMAND "Widen or narrow the browser so that all information is visible"))) (Sort FB.SORTCOMMAND "Sorts all the files in the browser by the attribute of your choice"))
)
(RPAQQ FB.CLOSE.MENU.ITEMS (("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.DEPTH.MENU.ITEMS (("Global default" :GLOBAL "Set depth using the global default (FILING.ENUMERATION.DEPTH)") ("Infinite" T "Set depth to infinity, i.e., enumerate all levels of directory") ("1" 1 "Set depth to 1, i.e., enumerate just the top level of the directory") ("2" 2 "Set depth to 2") ("Other" :NUMBER "Set depth to some other finite depth"))
)
(RPAQQ FB.INFO.MENU.ITEMS ((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.DEFAULT.INFO (SIZE CREATIONDATE AUTHOR))
(RPAQQ FB.DEFAULT.NAME.WIDTH 140)
(RPAQQ FB.INFO.FIELDS ((LENGTH " Length" 70 (FIX 56) "99999999") (SIZE "Pages" 50 (FIX 35) "99999") (BYTESIZE "Byt" 28 (FIX 14) "99") (TYPE "Type" 55 NIL "INTERPRESS") (CREATIONDATE "Created" 170 DATE) (READDATE "Read" 170 DATE) (WRITEDATE "Written" 170 DATE) (AUTHOR "Author" 120))
)
(RPAQQ FB.INFOSHADE 32800)
(RPAQQ FB.ITEMUNSELECTEDSHADE 0)
(RPAQQ FB.ITEMSELECTEDSHADE 4672)
(RPAQQ FB.ICONSPEC (#*(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@@@ NIL (5 5 73 40))
)
(* ; "Entries")
(DEFCOMMAND "fb" (&REST PAT&PROPS) (APPLY (QUOTE FB) PAT&PROPS))
(DEFINEQ
(FB
(NLAMBDA PATTERN (* ; "Edited 26-Feb-88 13:50 by bvm") (* ;;; "FILEBROWSER entry from top-level exec: FB PATTERN ... PROPS ...") (DESTRUCTURING-BIND (PAT . PROPS) (NLAMBDA.ARGS PATTERN) (LET (OPTIONS) (for TAIL on PROPS when (AND (CL:KEYWORDP (CAR TAIL)) (CDR TAIL)) do (* ; "Interpret keyword tail of attributes as OPTIONS.") (RETURN (SETQ PROPS (LDIFF PROPS (SETQ OPTIONS TAIL))))) (ADD.PROCESS (BQUOTE ((\, (FUNCTION FILEBROWSER)) (QUOTE (\, PAT)) (QUOTE (\, PROPS)) (QUOTE (\, OPTIONS)))) (QUOTE NAME) (QUOTE FB)))) NIL)
)
(FILEBROWSER
(LAMBDA (FILESPEC ATTRIBUTES OPTIONS) (* ; "Edited 1-Feb-88 15:25 by bvm:") (PROG ((TITLEFONT (DSPFONT NIL WindowTitleDisplayStream)) (BROWSERFONTHEIGHT (FONTPROP FB.BROWSERFONT (QUOTE HEIGHT))) (MENU-ITEMS FB.MENU.ITEMS) (MENU-TITLE "FB Commands") BROWSER PROMPTWHEIGHT COUNTERHEIGHT BROWSERWINDOW BROWSERWIDTH COMMANDMENU COMMANDMENUWIDTH COMMANDMENUWINDOW HEADINGWINDOW REGION TITLE DEPTH) (COND ((AND (LISTP OPTIONS) (SMALLP (CAR OPTIONS)) (AND (EQLENGTH OPTIONS 4) (EVERY OPTIONS (FUNCTION NUMBERP)))) (* ; "Old style") (SETQ REGION OPTIONS) (SETQ OPTIONS)) (T (for TAIL on OPTIONS by (CDDR TAIL) do (PROG ((KEY (CAR TAIL)) (VALUE (CADR TAIL))) RETRY (SELECTQ KEY (:REGION (SETQ REGION VALUE)) (:TITLE (SETQ TITLE VALUE)) ((:MENU-TITLE MENU.TITLE) (SETQ MENU-TITLE VALUE)) ((:MENU-ITEMS MENU.ITEMS) (SETQ MENU-ITEMS VALUE)) (:DEPTH (SETQ DEPTH VALUE)) (if (AND (NOT (CL:KEYWORDP KEY)) (SETQ KEY (CL:FIND-SYMBOL (STRING KEY) *KEYWORD-PACKAGE*))) then (* ; "for backward compatibility, coerce other symbols to keywords") (GO RETRY))))))) (SETQ ATTRIBUTES (COND (ATTRIBUTES (* ; "Caller specifies which attributes to use") (for X in ATTRIBUTES collect (OR (CADR (FB.INFO.ITEM.NAMED X FB.INFO.MENU.ITEMS)) (AND (LISTP DIRCOMMANDS) (OR (for PAIR in DIRCOMMANDS when (AND (LISTP PAIR) (STRING-EQUAL X (CAR PAIR))) do (* ; "Found synonym in dircommands. This also takes care of attribute being in different packages") (RETURN (CDR PAIR))) (PROGN (* ; "Try spelling correction. Wanted to get synonyms this way, but MISSPELLED? seems to be package-sensitive.") (MISSPELLED? X 90 DIRCOMMANDS)))) (\ILLEGAL.ARG X)))) (T FB.DEFAULT.INFO))) (PROGN (* ; "Figure out the size of the fixed pieces before prompting for a region") (SETQ COMMANDMENU (create MENU MENUFONT ← FB.MENUFONT ITEMS ← MENU-ITEMS CENTERFLG ← T MENUCOLUMNS ← 1 WHENSELECTEDFN ← (FUNCTION FB.MENU.WHENSELECTEDFN) TITLE ← MENU-TITLE)) (SETQ COMMANDMENUWIDTH (fetch (MENU IMAGEWIDTH) of COMMANDMENU)) (SETQ PROMPTWHEIGHT (HEIGHTIFWINDOW (TIMES 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") (COND ((NOT REGION) (PROMPTPRINT (CL:FORMAT NIL "Specify region for FileBrowser~@[ on ~A~]" FILESPEC)) (SETQ REGION (GETREGION (PROGN (* ; "Min width is menu plus enough space to print a name") (+ COMMANDMENUWIDTH FB.DEFAULT.NAME.WIDTH TB.LEFT.MARGIN)) (PROGN (* ; "Min height is prompt window plus counter window plus heading plus 5 lines of files") (+ PROMPTWHEIGHT COUNTERHEIGHT (TIMES 6 BROWSERFONTHEIGHT))))) (CLRPROMPT))) (if (AND (NULL FILESPEC) (NOT (TTY.PROCESSP))) then (* ; "Grab the tty now, so that user can start typing ahead") (TTY.PROCESS (THIS.PROCESS)) (ALLOW.BUTTON.EVENTS)) (SETQ BROWSERWINDOW (CREATEW (create REGION using REGION WIDTH ← (SETQ BROWSERWIDTH (- (fetch (REGION WIDTH) of REGION) COMMANDMENUWIDTH)) HEIGHT ← (- (fetch (REGION HEIGHT) of REGION) (+ COUNTERHEIGHT PROMPTWHEIGHT BROWSERFONTHEIGHT))))) (DSPFONT FB.BROWSERFONT BROWSERWINDOW) (WINDOWPROP BROWSERWINDOW (QUOTE FILEBROWSER) (SETQ BROWSER (create FILEBROWSER BROWSERWINDOW ← BROWSERWINDOW BROWSERFONT ← FB.BROWSERFONT OVERFLOWSPACING ← (TIMES 3 (CHARWIDTH (CHARCODE a) FB.BROWSERFONT)) SORTBY ← (FUNCTION FB.NAMES.DECREASING.VERSION) FIXEDTITLE ← TITLE INFOMENUCHOICES ← ATTRIBUTES FBLOCK ← (CREATE.MONITORLOCK) FBDEPTH ← DEPTH)))) (PROGN (* ; "Atop this sits the black heading window, with labels for each column in browser") (replace HEADINGWINDOW of BROWSER with (SETQ HEADINGWINDOW (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)) (replace (FILEBROWSER ABORTWINDOW) of BROWSER with (CONS (MENUWINDOW (create MENU ITEMS ← (QUOTE (("--Abort--" NIL "Abort the current FileBrowser operation"))) CENTERFLG ← T MENUOUTLINESIZE ← 2 MENUFONT ← (FONTCOPY FB.MENUFONT (QUOTE WEIGHT) (QUOTE BOLD)) WHENSELECTEDFN ← (FUNCTION FB.HANDLE.ABORT.BUTTON))) COMMANDMENUWINDOW)) (for W in (LIST COMMANDMENUWINDOW (CAR (fetch (FILEBROWSER ABORTWINDOW) of BROWSER)) (fetch (FILEBROWSER COUNTERWINDOW) of BROWSER) (fetch (FILEBROWSER PROMPTWINDOW) of BROWSER)) bind OLDCOMS when (LISTP (SETQ OLDCOMS (WINDOWPROP W (QUOTE PASSTOMAINCOMS)))) do (* ; "Make all these subwindows pass hardcopy on to the main window") (WINDOWPROP W (QUOTE PASSTOMAINCOMS) (UNION (QUOTE (HARDCOPYIMAGEW)) OLDCOMS))) (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) (QUOTE HEADINGWINDOW) HEADINGWINDOW))) (WINDOWPROP BROWSERWINDOW (QUOTE HARDCOPYFN) (FUNCTION FB.HARDCOPY.DIRECTORY)) (WINDOWPROP BROWSERWINDOW (QUOTE ICONFN) (FUNCTION FB.ICONFN)) (if (SETQ FILESPEC (if FILESPEC then (DIRECTORY.FILL.PATTERN FILESPEC) else (FB.STARTUP BROWSER COMMANDMENU (FUNCTION FB.GET.NEWPATTERN)))) then (* ; "Have a pattern to work with. Now enumerate it in a new process.") (FB.SETNEWPATTERN BROWSER FILESPEC) (ADD.PROCESS (BQUOTE ((\, (FUNCTION FB.STARTUP)) (QUOTE (\, BROWSER)) (QUOTE (\, COMMANDMENU)) (QUOTE (\, (FUNCTION FB.UPDATEBROWSERITEMS))))) (QUOTE NAME) (QUOTE FB-Update) (QUOTE BEFOREEXIT) (QUOTE DON'T))) (RETURN BROWSERWINDOW)))
)
(FB.TABLEBROWSER
(LAMBDA (BROWSER) (* ; "Edited 4-Feb-88 23:13 by bvm:") (ffetch (FILEBROWSER TABLEBROWSER) of (\DTEST BROWSER (QUOTE FILEBROWSER))))
)
(FB.SELECTEDFILES
(LAMBDA (BROWSER NOERRORFLG) (* ; "Edited 29-Jan-88 12:38 by bvm") (* ;; "User entry to get the set of selected files, as tableitems, from a filebrowser. If NOERRORFLG is NIL, will print a message if no files are selected.") (COND ((TB.COLLECT.ITEMS (ffetch (FILEBROWSER TABLEBROWSER) of (\DTEST BROWSER (QUOTE FILEBROWSER))) (QUOTE SELECTED))) ((NOT NOERRORFLG) (FB.PROMPTWPRINT BROWSER T "No files are selected") NIL)))
)
(FB.FETCHFILENAME
(LAMBDA (ITEM) (* ; "Edited 29-Jan-88 12:37 by bvm") (* ;; "User entry to get filename from a browser tableitem.") (fetch (FBFILEDATA FILENAME) of (ffetch TIDATA of (\DTEST ITEM (QUOTE TABLEITEM)))))
)
(FB.PROMPTWPRINT
(LAMBDA U (* ; "Edited 4-Feb-88 23:08 by bvm:") (COND ((< U 2) (ERROR "not enough args to PROMPTWPRINT")) (T (LET ((WINDOW (ffetch (FILEBROWSER PROMPTWINDOW) of (\DTEST (ARG U 1) (QUOTE FILEBROWSER)))) 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.PROMPTW.FORMAT
(CL:LAMBDA (BROWSER FORMAT-STRING &REST ARGS) (* ; "Edited 4-Feb-88 23:15 by bvm:") (* ;; "Outputs to FOLDER's prompt window using FORMAT.") (LET ((*PRINT-CASE* :UPCASE) (*PRINT-BASE* 10) (WINDOW (ffetch (FILEBROWSER PROMPTWINDOW) of (\DTEST BROWSER (QUOTE FILEBROWSER))))) (* ;; "*PRINT-CASE* is bound so symbols get printed in %"expected%" case. *PRINT-BASE* is 10 for benefit of printing numbers in the non-format case.") (CL:APPLY (FUNCTION CL:FORMAT) WINDOW FORMAT-STRING ARGS)))
)
(FB.PROMPTFORINPUT
(LAMBDA (PROMPT DEFAULT BROWSER ABORTFLG DONTCLEAR) (* ; "Edited 4-Feb-88 23:10 by bvm:") (* ;;; "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 (ffetch (FILEBROWSER PROMPTWINDOW) of (\DTEST BROWSER (QUOTE FILEBROWSER)))) (PROMPTWIDTH (STRINGWIDTH PROMPT PWINDOW)) (WINDOWWIDTH (WINDOWPROP PWINDOW (QUOTE WIDTH))) RESULT) (COND (DONTCLEAR (FRESHLINE PWINDOW)) (T (CLEARW PWINDOW))) (COND ((> (+ 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 (- (NCHARS PROMPT) 4) to 10 by -1 bind (EXCESSWIDTH ← (- PROMPTWIDTH WINDOWWIDTH)) when (AND (EQ (NTHCHARCODE PROMPT I) (CHARCODE SPACE)) (> (STRINGWIDTH (SUBSTRING PROMPT I) PWINDOW) EXCESSWIDTH)) do (RETURN (SETQ PROMPT (CONCAT (SUBSTRING PROMPT 1 (SUB1 I)) "
" (SUBSTRING PROMPT (ADD1 I)))))))) (SETQ RESULT (CAR (NLSETQ (TTYINPROMPTFORWORD PROMPT DEFAULT NIL PWINDOW NIL (QUOTE TTY) (CHARCODE (CR)))))) (COND ((AND (NULL RESULT) ABORTFLG) (PRINTOUT PWINDOW "... aborted"))) (TERPRI PWINDOW) RESULT))
)
(FB.ALLOW.ABORT
(LAMBDA (BROWSER) (* ; "Edited 4-Feb-88 23:11 by bvm:") (* ;; "Arranges that this browser have an abort button armed. Must be called underneath a FileBrowser command, so that the cleanup in fb.make.browser.busy is enabled.") (freplace (FILEBROWSER UPDATEPROC) of (\DTEST BROWSER (QUOTE FILEBROWSER)) with (THIS.PROCESS)) (LET ((W (ffetch (FILEBROWSER ABORTWINDOW) of BROWSER))) (if (NOT (OPENWP (CAR W))) then (ATTACHWINDOW (CAR W) (CDR W) (QUOTE BOTTOM)) (* ; "And repaint it in case it was used last time") (REDISPLAYW (CAR W)))))
)
)
(* ; "Setup")
(DEFINEQ
(FB.STARTUP
(LAMBDA (BROWSER COMMANDMENU FN) (* ; "Edited 21-Jan-88 17:53 by bvm") (* ;; "Apply FN to browser with Recompute grayed out.") (RESETLST (FB.MAKE.BROWSER.BUSY BROWSER (FASSOC (QUOTE Recompute) (fetch (MENU ITEMS) of COMMANDMENU)) COMMANDMENU) (CL:FUNCALL FN 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))
)
)
(DEFINEQ
(FB.PRINTFN
(LAMBDA (TBROWSER ITEM WINDOW) (* ; "Edited 1-Feb-88 18:57 by bvm:") (LET ((FBROWSER (TB.USERDATA TBROWSER)) (FDATA (fetch TIDATA of ITEM)) (STREAM (WINDOWPROP WINDOW (QUOTE DSP))) NEXTPOS INFO) (COND ((fetch (FBFILEDATA DIRECTORYP) of FDATA) (PRIN3 " " STREAM))) (LET* ((FILENAME (fetch (FBFILEDATA FILENAME) of FDATA)) (OFF (ffetch (STRINGP OFFST) of FILENAME)) (BASE (ffetch (STRINGP BASE) of FILENAME)) (FATP (ffetch (STRINGP FATSTRINGP) of FILENAME)) (END (+ OFF (ffetch (STRINGP LENGTH) of FILENAME))) C) (* ;; "This loop is a performance optimization so I don't have to cons up a substring in the display loop. This is essentially (for c instring (fetch (fbfiledata filename) of fdata) do (\outchar stream c)), except that I want to start at STARTOFPNAME rather than 1.") (* ;; "Slow version: (prin3 (fetch (fbfiledata printname) of fdata) stream), except it doesn't let me intercept cr's.") (add OFF (- (fetch (FBFILEDATA STARTOFPNAME) of FDATA) 2)) (* ; "Skip to start of name to print") (while (< (add OFF 1) END) do (SETQ C (COND (FATP (\GETBASEFAT BASE OFF)) (T (\GETBASETHIN BASE OFF)))) (\OUTCHAR STREAM (if (EQ C (CHARCODE CR)) then (* ; "make it a blotch instead of new line #o377 is in char set 0, but is an illegal char, so can't have a glyph") 255 else C)))) (SETQ NEXTPOS (fetch (FILEBROWSER INFOSTART) of FBROWSER)) (for SPEC in (fetch (FILEBROWSER INFODISPLAYED) of FBROWSER) as INFO in (fetch (FBFILEDATA FILEINFO) of FDATA) bind (FONT ← (fetch (FILEBROWSER BROWSERFONT) of FBROWSER)) FORMAT ACTUALNEXT XPOS do (COND (INFO (* ; "Make sure there's always some space before next item") (PRIN3 " " STREAM))) (SETQ XPOS (DSPXPOSITION NIL STREAM)) (SETQ FORMAT (fetch INFOFORMAT of SPEC)) (SETQ ACTUALNEXT (COND ((AND (LISTP FORMAT) (FIXP INFO)) (* ; "Get numbers to line up right justified") (IMAX (- (+ NEXTPOS (CADR FORMAT)) (STRINGWIDTH INFO FONT)) XPOS)) (T (* ; "All other fields are left-justified") NEXTPOS))) (COND ((< XPOS ACTUALNEXT) (* ; "Clear any previous junk between last position and start of field") (if (AND INFO (EQ FORMAT (QUOTE DATE)) (EQ (CHCON1 INFO) (CHARCODE SPACE))) then (* ; "Small nicety for variable-width font: account for the difference between a space and a digit, so that dates line up a little better") (add ACTUALNEXT (- (CHARWIDTH (CHARCODE 9) FONT) (CHARWIDTH (CHARCODE SPACE) FONT)))) (TB.CLEAR.LINE TBROWSER ITEM XPOS (- ACTUALNEXT XPOS)) (DSPXPOSITION ACTUALNEXT STREAM))) (COND (INFO (PRIN3 INFO STREAM))) (add NEXTPOS (fetch INFOWIDTH of SPEC))) (TB.CLEAR.LINE TBROWSER ITEM (DSPXPOSITION NIL WINDOW))))
)
(FB.COPYFN
(LAMBDA (TBROWSER ITEM) (* bvm%: "13-Oct-85 17:44") (BKSYSBUF (fetch (FBFILEDATA FILENAME) of (fetch TIDATA of ITEM))))
)
)
(* ; "commands and major subfunctions")
(DEFINEQ
(FB.MENU.WHENSELECTEDFN
(LAMBDA (ITEM MENU KEY) (* ; "Edited 21-Jan-88 11:40 by bvm") (ADD.PROCESS (BQUOTE ((\, (FUNCTION FB.COMMANDSELECTEDFN)) (QUOTE (\, ITEM)) (QUOTE (\, MENU)) (QUOTE (\, KEY)))) (QUOTE NAME) (PACK* (QUOTE FB-) (CAR ITEM)) (QUOTE BEFOREEXIT) (QUOTE DON'T)))
)
(FB.COMMANDSELECTEDFN
(LAMBDA (ITEM MENU KEY) (* ; "Edited 12-Jan-87 12:57 by bvm:") (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)))) (CL:FUNCALL 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) (* ; "Edited 1-Feb-88 16:43 by bvm:") (* ;;; "Makes browser 'busy' doing ITEM of MENU. Must be called under RESETLST") (COND ((OBTAIN.MONITORLOCK (fetch (FILEBROWSER FBLOCK) of BROWSER) DONTWAIT T) (RESETSAVE NIL (LIST (FUNCTION FB.FINISH.COMMAND) BROWSER ITEM MENU)) (if ITEM then (SHADEITEM ITEM MENU FB.ITEMSELECTEDSHADE)) T)))
)
(FB.FINISH.COMMAND
(LAMBDA (BROWSER ITEM MENU) (* ; "Edited 1-Feb-88 16:34 by bvm:") (* ;; "Cleanup after generic command on BROWSER. ITEM and MENU (optional) specify the shaded item. This is called under a RESETLST by anyone calling FB.MAKE.BROWSER.BUSY, but needs to be called explicitly by anyone who closes/shrinks the window before that cleanup would happen.") (replace (FILEBROWSER UPDATEPROC) of BROWSER with NIL) (replace (FILEBROWSER ABORTING) of BROWSER with NIL) (LET ((W (CAR (fetch (FILEBROWSER ABORTWINDOW) of BROWSER))) M) (if (OPENWP W) then (* ; "Take down the abort button if there was one") (SHADEITEM (CAR (fetch (MENU ITEMS) of (SETQ M (CAR (WINDOWPROP W (QUOTE MENU)))))) M FB.ITEMUNSELECTEDSHADE) (DETACHWINDOW W) (CLOSEW W))) (if ITEM then (SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)) (COND (RESETSTATE (FB.PROMPTWPRINT BROWSER "...command aborted."))))
)
(FB.HANDLE.ABORT.BUTTON
(LAMBDA (ITEM MENU) (* ; "Edited 27-Jan-88 23:38 by bvm") (* ;; "Called when the ABORT button on a Filebrowser is pressed.") (LET ((BROWSER (WINDOWPROP (MAINWINDOW (WFROMMENU MENU) T) (QUOTE FILEBROWSER))) PROC) (if (AND BROWSER (SETQ PROC (fetch (FILEBROWSER UPDATEPROC) of BROWSER)) (NOT (fetch (FILEBROWSER ABORTING) of BROWSER))) then (* ; "We're connected to a browser, there's a process running, and it's not already aborting") (SHADEITEM ITEM MENU FB.ITEMSELECTEDSHADE) (replace (FILEBROWSER ABORTING) of BROWSER with T) (DEL.PROCESS PROC))))
)
)
(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) (* ; "Edited 29-Jan-88 12:50 by bvm") (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.PROMPTW.FORMAT FBROWSER "~%%?? ~A not an integer." NVERSIONS)) (T (SETQ FILES (TB.COLLECT.ITEMS (SETQ TBROWSER (fetch (FILEBROWSER TABLEBROWSER) of FBROWSER)) (FUNCTION (LAMBDA (BROWSER ITEM) (* ; "Collect everything that is not a directory item and that has an actual version (to avoid unix lossage)") (AND (NOT (fetch TIUNSELECTABLE of ITEM)) (NOT (NULL.VERSIONP (fetch (FBFILEDATA VERSION) of (fetch TIDATA of 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.PROMPTW.FORMAT FBROWSER "~%%Done, ~D files marked for deletion." NDELETED)))))
)
(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))))
)
)
(DEFINEQ
(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.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))))))))
)
)
(DEFINEQ
(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) (* ; "Edited 28-Jan-88 00:27 by bvm") (LET ((*UPPER-CASE-FILE-NAMES* NIL) (FILELIST (FB.SELECTEDFILES FBROWSER))) (if FILELIST then (FB.ALLOW.ABORT FBROWSER) (COND ((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) (* ; "Edited 1-Feb-88 16:55 by bvm:") (* ;;; "Copies or renames a single file ITEM from OLDNAME to NEWNAME and updates browser accordingly") (CL:MULTIPLE-VALUE-BIND (ACTUALNEWNAME CONDITION) (IGNORE-ERRORS (CL:FUNCALL MOVEFN OLDNAME NEWNAME)) (COND (ACTUALNEWNAME (FB.PROMPTW.FORMAT FBROWSER "~%%~A ~Aed to ~A" OLDNAME (SELECTQ CMD (Copy "copi") (Rename "renam") (SHOULDNT)) ACTUALNEWNAME) (LET ((CHANGETYPE (COND ((EQ CMD (QUOTE Rename)) (FB.REMOVE.FILE (fetch (FILEBROWSER TABLEBROWSER) of FBROWSER) FBROWSER ITEM) (COND ((fetch TIDELETED of ITEM) (QUOTE BOTH)) (T (QUOTE TOTAL))))))) (COND ((FB.MAYBE.INSERT.FILE FBROWSER ACTUALNEWNAME ITEM CMD) (* ; "ACTUALNEWNAME belongs in this browser, so TOTAL may have changed") (OR CHANGETYPE (SETQ CHANGETYPE (QUOTE TOTAL))))) (COND (CHANGETYPE (FB.UPDATE.COUNTERS FBROWSER CHANGETYPE))))) (T (FB.PROMPTW.FORMAT FBROWSER "~%%Could not ~(~A~) ~A ~A ~A" CMD OLDNAME (if CONDITION then "because" else "to") (OR CONDITION NEWNAME))))))
)
(FB.COPY/RENAME.MANY
(LAMBDA (FBROWSER FILELIST CMD MOVEFN) (* ; "Edited 2-Feb-88 14:19 by bvm:") (PROG (PREFIX OLDNAME FIELDS SUBDIR FIRSTDATA 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 (SETQ PREFIX (\ADD.CONNECTED.DIR PREFIX))) (* ;; "First scan to see if the files are in multiple subdirectories, since then it's unclear how the new files should be named.") (SETQ FIRSTDATA (fetch TIDATA of (CAR FILELIST))) (COND ((for ITEM in (CDR FILELIST) thereis (NOT (EQ.DIRECTORYP FIRSTDATA (fetch TIDATA of ITEM)))) (SETQ SUBDIR (fetch (FBFILEDATA SUBDIRECTORY) of FIRSTDATA)) (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) repeatwhile (SETQ SUBDIR (FB.GREATEST.PREFIX SUBDIR (fetch (FBFILEDATA FILENAME) of (fetch TIDATA of ITEM)))) finally (RETURN (OR SUBDIR (SETQ SUBDIR (SUBSTRING (fetch (FILEBROWSER PATTERN) of FBROWSER) 1 (SUB1 (fetch (FILEBROWSER NAMESTART) of FBROWSER))))))) "?") "Yes" FBROWSER T T)) (SETQ RETAIN (COND ((NULL RETAIN) (* ; "Aborted") (RETURN)) ((OR (STRING-EQUAL RETAIN "YES") (STRING-EQUAL RETAIN "Y")) (SETQ SUBDIR (ADD1 (NCHARS SUBDIR))) (* ; "First character that changes") T) ((OR (STRING-EQUAL RETAIN "NO") (STRING-EQUAL RETAIN "N")) NIL) (T (FB.PROMPTWPRINT FBROWSER "?? ...Aborted.") (RETURN)))))) (* ;; "Now make sure the files are sorted by increasing version, so that multiple versions get copied in the right order") (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))) (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 (DIR FILENAME) (* ; "Edited 25-Jan-88 16:37 by bvm") (* ;;; "Greatest common directory prefix of DIR and FILENAME") (AND DIR FILENAME (COND ((STRPOS DIR FILENAME 1 NIL T NIL UPPERCASEARRAY) (* ; "DIR is prefix of FILENAME") DIR) (T (for I from 1 bind LASTDIR C do (if (OR (NULL (SETQ C (NTHCHARCODE DIR I))) (NEQ C (NTHCHARCODE FILENAME I))) then (* ; "Came to end of DIR or a non-matching character. Return the substring of DIR up to the last directory delimiter we saw.") (RETURN (AND LASTDIR (SUBSTRING DIR 1 LASTDIR))) else (SELCHARQ C ((/ >) (* ; "end of a subdirectory") (SETQ LASTDIR I)) NIL)))))))
)
(FB.MAYBE.INSERT.FILE
(LAMBDA (FBROWSER NEWNAME OLDITEM CMD) (* ; "Edited 1-Feb-88 14:46 by bvm:") (* ;;; "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 ((*UPPER-CASE-FILE-NAMES* NIL) FILEINFO N FULLNAME CRDATE CRDATE2 VERSION NEWDATA NEWITEM FILE-UNCERTAIN) (COND ((AND (DIRECTORY.MATCH (fetch (FILEBROWSER PREPAREDPATTERN) of FBROWSER) NEWNAME) (STRING-EQUAL NEWNAME (fetch (FILEBROWSER PATTERN) of FBROWSER) :END1 (SETQ N (SUB1 (fetch (FILEBROWSER DIRECTORYSTART) of FBROWSER))) :END2 N)) (* ; "NEWNAME belongs in this browser, so add it. First create some attributes for it") (SETQ NEWDATA (FB.CREATE.FILEBUCKET FBROWSER NEWNAME (SETQ FILEINFO (COND (OLDITEM (* ; "Info from old item will do for starters") (APPEND (fetch (FBFILEDATA FILEINFO) of (fetch TIDATA of OLDITEM)))) (T (for ATTR in (fetch (FILEBROWSER INFODISPLAYED) of FBROWSER) collect (GETFILEINFO NEWNAME (CAR ATTR)))))))) (COND ((NULL.VERSIONP (fetch (FBFILEDATA VERSION) of NEWDATA)) (* ;; "Grumble. IFS version of Rename does not return a full file name, due to shortcoming in ftp protocol, so we won't know the version. Best we can do is assume that it's the newest version. If creation date of old file is available, verify that they agree") (if (NULL (SETQ FULLNAME (INFILEP NEWNAME))) then (* ; "Can't find file?") (SETQ FILE-UNCERTAIN T) elseif (NULL (SETQ VERSION (UNPACKFILENAME.STRING FULLNAME (QUOTE VERSION) NIL (QUOTE TENEX)))) then (* ; "Was versionless file after all, say Unix. Nothing to do. Pass TENEX as ostype because we know the name was in canonical form from device, and don't want periods turned spuriously into semi-colons") elseif (OR (NULL (SETQ CRDATE (CL:POSITION (QUOTE CREATIONDATE) (fetch (FILEBROWSER INFODISPLAYED) of FBROWSER)))) (NULL (SETQ CRDATE (CL:NTH CRDATE FILEINFO))) (AND (SETQ CRDATE (IDATE CRDATE)) (SETQ CRDATE2 (GETFILEINFO FULLNAME (QUOTE ICREATIONDATE))) (= CRDATE2 CRDATE))) then (* ; "Assume we're right about it being newest version") (SETQ NEWDATA (FB.CREATE.FILEBUCKET FBROWSER (SETQ NEWNAME (PROGN (* ; "Canonicalize NEWNAME -- some cases where final period was left out") (PACKFILENAME.STRING (QUOTE BODY) NEWNAME (QUOTE EXTENSION) "" (QUOTE VERSION) VERSION))) FILEINFO)) else (SETQ FILE-UNCERTAIN T)))) (SETQ NEWITEM (create TABLEITEM TIDATA ← NEWDATA)) (if OLDITEM then (* ; "Update info--some is same as old file, some is new") (for TAIL on FILEINFO as SPEC in (fetch (FILEBROWSER INFODISPLAYED) of FBROWSER) unless (SELECTQ (CAR SPEC) (AUTHOR (* ; "Rename usually preserves this, but Copy sometimes changes it") (EQ CMD (QUOTE Rename))) ((CREATIONDATE SIZE LENGTH TYPE BYTESIZE) (* ; "These are preserved by both copy and rename, assuming that the source and destination device are the same") T) (PROGN (* ; "Read and Write dates are generally changed. Also, conservatively assume that Copy/Rename could change any attribute we don't know about") NIL)) do (RPLACA TAIL (AND (NOT FILE-UNCERTAIN) (GETFILEINFO NEWNAME (CAR SPEC))))) (COND ((AND (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.HARDCOPYCOMMAND
(LAMBDA (BROWSER KEY ITEM MENU OPTION) (* ; "Edited 28-Jan-88 00:28 by bvm") (* ;;; "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.ALLOW.ABORT BROWSER) (FB.HARDCOPY.TOFILE BROWSER FILES) NIL) (PRINTER (COND ((SETQ PRINTOPTIONS (GetPrinterName)) (SETQ PRINTOPTIONS (LIST (QUOTE SERVER) PRINTOPTIONS)) T))) T)) (FB.ALLOW.ABORT BROWSER) (for ITEM in FILES do (LISTFILES1 (FB.FETCHFILENAME ITEM) PRINTOPTIONS))))))
)
(FB.HARDCOPY.TOFILE
(LAMBDA (BROWSER FILES) (* ; "Edited 2-Feb-88 15:30 by bvm:") (* ;; "Handle the %"Hardcopy>To File%" command.") (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 HCOPYTAIL FORE AFT EXT) (COND ((NULL HCOPYFILE) (RETURN))) (COND ((CDR FILES) (* ;; "Hardcopying multiple files. Take apart the pattern so we can figure out how to make the destination names. We insist that the * be in the name.") (COND ((for TAIL on (SETQ HCOPYFIELDS (UNPACKFILENAME.STRING HCOPYFILE)) by (CDDR TAIL) bind HOST HAVEDIRECTORY I do (COND ((SETQ I (STRPOS (QUOTE *) (CADR TAIL))) (if (NEQ (CAR TAIL) (QUOTE NAME)) then (RETURN (SETQ MSG "Only name portion can contain *"))) (* ; "Take apart name into FORE*AFT") (SETQ HCOPYTAIL (CDR TAIL)) (SETQ FORE (OR (SUBSTRING (CADR TAIL) 1 (SUB1 I)) "")) (SETQ AFT (OR (SUBSTRING (CADR TAIL) (ADD1 I)) ""))) (T (SELECTQ (CAR TAIL) (NAME (RETURN (SETQ MSG "Name must have * for multiple hardcopy files"))) (EXTENSION (SETQ EXT (MKATOM (U-CASE (CADR TAIL))))) (DIRECTORY (SETQ HAVEDIRECTORY T)) (HOST (SETQ HOST (CADR TAIL))) NIL))) finally (if (AND HOST (NOT HAVEDIRECTORY)) then (* ; "E.g., {DSK}*.IP. This pattern explicitly has no directory") (push HCOPYFIELDS (QUOTE DIRECTORY) NIL))) (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 FIELDS do (SETQ ITEM (FB.FETCHFILENAME ITEM)) (SETQ FILETYPE (OR (PRINTFILETYPE ITEM) (QUOTE TEXT))) (COND ((SETQ FN (LISTGET CONVERTERS FILETYPE)) (FB.PROMPTW.FORMAT BROWSER "~%%Writing ~A..." (SETQ NAME (COND ((CDR FILES) (SETQ FIELDS (UNPACKFILENAME.STRING ITEM NIL NIL (QUOTE TENEX))) (RPLACA HCOPYTAIL (CONCAT FORE (LISTGET FIELDS (QUOTE NAME)) AFT)) (CL:APPLY (FUNCTION PACKFILENAME.STRING) (QUOTE VERSION) NIL (APPEND HCOPYFIELDS FIELDS))) (T HCOPYFILE)))) (SETQ NAME (CL:FUNCALL 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.PROMPTW.FORMAT BROWSER "~%%Failed to hardcopy ~A -- Can't convert a ~A file to format ~A" ITEM FILETYPE PRINTFILETYPE))))))
)
)
(DEFINEQ
(FB.EDITCOMMAND
(LAMBDA (BROWSER KEY ITEM MENU OPTION) (* ; "Edited 1-Feb-88 19:00 by bvm:") (FB.ALLOW.ABORT BROWSER) (for FILE in (FB.SELECTEDFILES BROWSER) bind (*UPPER-CASE-FILE-NAMES* ← NIL) do (SETQ FILE (FB.FETCHFILENAME FILE)) (CL:MULTIPLE-VALUE-BIND (IGNORE CONDITION) (IGNORE-ERRORS (SELECTQ (OR OPTION FB.DEFAULT.EDITOR) (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)))) (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))) (LISP (FB.EDITLISPFILE FILE BROWSER)) (NIL (COND ((LISPSOURCEFILEP FILE) (FB.EDITLISPFILE FILE BROWSER)) (T (TEDIT (MKATOM FILE))))) (CL:FUNCALL OPTION (MKATOM FILE)))) (if CONDITION then (FB.PROMPTW.FORMAT BROWSER "Failed because ~A" CONDITION)))))
)
(FB.EDITLISPFILE
(LAMBDA (FILE BROWSER) (* ; "Edited 28-Jan-88 00:38 by bvm") (PROG (ROOT) (COND ((OR (NOT (STRING-EQUAL (CDAR (GETPROP (SETQ ROOT (U-CASE (ROOTFILENAME FILE))) (QUOTE FILEDATES))) FILE)) (NOT (GET ROOT (QUOTE FILE))) (NOT (BOUNDP (FILECOMS ROOT)))) (COND ((MOUSECONFIRM (CONCAT "The file " FILE " is not loaded or is not current. (LOAD '" FILE " 'PROP)?") NIL (fetch (FILEBROWSER PROMPTWINDOW) of BROWSER)) (EXEC-EVAL (BQUOTE (LOAD (QUOTE (\, FILE)) (QUOTE PROP))))) (T (RETURN))))) (RESETFORM (TTYDISPLAYSTREAM PROMPTWINDOW) (ED ROOT (QUOTE (FILES :DONTWAIT))))))
)
(FB.BROWSECOMMAND
(LAMBDA (BROWSER KEY ITEM MENU OPTION) (* ; "Edited 1-Feb-88 18:31 by bvm:") (* ;;; "view selected file by sprouting a recursive file browser on it") (FB.ALLOW.ABORT BROWSER) (for FILE in (FB.SELECTEDFILES BROWSER) bind (DEPTH ← (fetch (FILEBROWSER FBDEPTH) of BROWSER)) NAME do (SETQ FILE (fetch TIDATA of FILE)) (SETQ NAME (fetch (FBFILEDATA FILENAME) of FILE)) (if (OR (fetch (FBFILEDATA DIRECTORYFILEP) of FILE) (AND (NOT (fetch (FILEBROWSER NSPATTERN?) of BROWSER)) (LET* ((FIELDS (UNPACKFILENAME.STRING NAME NIL NIL (QUOTE TENEX))) (NAMETAIL (MEMB (QUOTE NAME) FIELDS)) INTERESTING SUBDIR MAINDIR) (* ; "File is not syntactically a directory. Perhaps the device returned foo.;1 instead of foo>. We know ns servers don't do this.") (for TAIL on NAMETAIL by (CDDR TAIL) do (if (OR (EQ 0 (NCHARS (CADR TAIL))) (AND (EQ (CAR TAIL) (QUOTE VERSION)) (if (NEQ (MKATOM (CADR TAIL)) 1) then (* ; "It has a version--most unlikely for a directory") (RETURN NIL) else T))) then (* ; "turn empty or boring fields into omitted fields") (RPLACA (CDR TAIL) NIL) else (SETQ INTERESTING T)) finally (SETQ FIELDS (LDIFF FIELDS NAMETAIL)) (if INTERESTING then (* ;; "Would like just to do (CL:APPLY (function packfilename.string) (nconc fields `(SUBDIRECTORY subdir))), but PACKFILENAME.STRING doesn't seem to know about unix.") (SETQ MAINDIR (LISTGET FIELDS (QUOTE DIRECTORY))) (SETQ SUBDIR (CL:APPLY (FUNCTION PACKFILENAME.STRING) NAMETAIL)) (LISTPUT FIELDS (QUOTE DIRECTORY) (if (NULL MAINDIR) then SUBDIR else (CONCAT MAINDIR (if (STRPOS "/" MAINDIR) then "/" elseif (STRPOS ">" MAINDIR) then ">" elseif (EQ (GETHOSTINFO (LISTGET FIELDS (QUOTE HOST)) (QUOTE OSTYPE)) (QUOTE UNIX)) then (* ; "Resort to GETHOSTINFO only if the name hasn't given it away yet.") "/" else ">") SUBDIR)))) (RETURN (DIRECTORYNAMEP (SETQ NAME (CL:APPLY (FUNCTION PACKFILENAME.STRING) FIELDS)))))))) then (ADD.PROCESS (BQUOTE ((\, (FUNCTION FILEBROWSER)) (QUOTE (\, NAME)) (QUOTE (\, (MAPCAR (fetch (FILEBROWSER INFODISPLAYED) of BROWSER) (FUNCTION CAR)))) (\,@ (AND DEPTH (BQUOTE ((QUOTE (:DEPTH (\, DEPTH)))))))))) else (FB.PROMPTW.FORMAT BROWSER "~A is not a directory" NAME))))
)
)
(DEFINEQ
(FB.FASTSEECOMMAND
(LAMBDA (BROWSER KEY ITEM MENU UNFORMATTED) (* ; "Edited 1-Feb-88 17:01 by bvm:") (PROG ((*UPPER-CASE-FILE-NAMES* NIL) FILELIST SEEWINDOW) (OR (SETQ FILELIST (FB.SELECTEDFILES BROWSER)) (RETURN)) (FB.ALLOW.ABORT BROWSER) (COND ((NOT (WINDOWP (SETQ SEEWINDOW (fetch SEEWINDOW of BROWSER)))) (* ; "Create the SEE window") (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 NIL (LIST (FUNCTION (LAMBDA (WINDOW) (WINDOWPROP WINDOW (QUOTE PROCESS) NIL) (* ; "Remove process attached here by ttydisplaystream") (LET ((BUTTONS (WINDOWPROP WINDOW (WINDOWPROP WINDOW (QUOTE MORETYPE))))) (if (AND BUTTONS (OPENWP BUTTONS)) then (* ; "If More button still open, detach it") (DETACHWINDOW BUTTONS) (CLOSEW BUTTONS))))) SEEWINDOW)) (TTYDISPLAYSTREAM SEEWINDOW) (* ; "Has to be our TTYDISPLAYSTREAM in order for page holding to work") (for TAIL on FILELIST do (CL:CATCH :NEXT (FB.FASTSEE.ONEFILE BROWSER (FB.FETCHFILENAME (CAR TAIL)) SEEWINDOW UNFORMATTED (CDR TAIL))))))
)
(FB.FASTSEE.ONEFILE
(LAMBDA (BROWSER FILE WINDOW UNFORMATTED MORE) (* ; "Edited 1-Feb-88 17:07 by bvm:") (CLEARW WINDOW) (WINDOWPROP WINDOW (QUOTE TITLE) (CONCAT "Viewing " FILE)) (CL:MULTIPLE-VALUE-BIND (STREAM CONDITION) (IGNORE-ERRORS (OPENSTREAM FILE (QUOTE INPUT) NIL (QUOTE ((SEQUENTIAL T))))) (if CONDITION then (* ;; "Failed on this file. If this was the only file, the message can be a little more terse (which is desirable, because the typical message is %"File not found xxx%")") (FB.PROMPTW.FORMAT BROWSER "~:[Failed~;~:*Couldn't see ~A~] because ~A" (AND MORE FILE) CONDITION) else (RESETLST (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (STREAM WINDOW) (AND RESETSTATE (OPENWP WINDOW) (WINDOWPROP WINDOW (QUOTE TITLE) (CONCAT (WINDOWPROP WINDOW (QUOTE TITLE)) " -- " "Aborted"))) (CLOSEF STREAM))) STREAM WINDOW)) (WINDOWPROP WINDOW (QUOTE MORETYPE) (COND (MORE (QUOTE YETMOREBUTTONS)) (T (QUOTE LASTMOREBUTTONS)))) (COND (UNFORMATTED (COPYBYTES STREAM WINDOW)) (T (PFCOPYBYTES STREAM 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) (* ; "Edited 28-Jan-88 00:05 by bvm") (* ;;; "WHENSELECTEDFN for the More/Abort menu") (LET* ((MENUW (WFROMMENU MENU)) (WINDOW (MAINWINDOW MENUW))) (DETACHWINDOW MENUW) (* ; "Take the buttons down") (CLOSEW MENUW) (SELECTQ (CADR ITEM) (MORE (* ; "Notify pagefullfn that it can continue") (WINDOWPROP WINDOW (QUOTE MOREOK) T) (NOTIFY.EVENT (WINDOWPROP WINDOW (QUOTE MOREEVENT)))) (NEXT (* ; "Throw to the loop that is displaying each file") (PROCESS.EVAL (WINDOWPROP WINDOW (QUOTE PROCESS)) (QUOTE (CL:THROW :NEXT)))) (ABORT (* ; "Kill it") (DEL.PROCESS (WINDOWPROP WINDOW (QUOTE PROCESS)))) (SHOULDNT))))
)
)
(DEFINEQ
(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.COMPILECOMMAND
(LAMBDA (BROWSER KEY ITEM MENU COMPILEOP) (* ; "Edited 5-Mar-87 17:39 by bvm:") (LET ((FILES (FB.SELECTEDFILES BROWSER))) (AND FILES (ADD.PROCESS (LIST (FUNCTION FB.OPERATE.ON.FILES) (KWOTE (OR COMPILEOP *DEFAULT-CLEANUP-COMPILER*)) (KWOTE FILES)) (QUOTE NAME) (QUOTE COMPILE) (QUOTE BEFOREEXIT) (QUOTE DON'T)))))
)
(FB.OPERATE.ON.FILES
(LAMBDA (FN FILELIST) (* ; "Edited 4-Feb-88 15:14 by bvm:") (LET (LDFLG FORMS) (SELECTQ FN ((PROP SYSLOAD) (SETQ LDFLG FN) (SETQ FN (QUOTE LOAD))) NIL) (SETQ FORMS (for FILEENTRY in FILELIST collect (BQUOTE ((\, FN) (QUOTE (\, (FB.FETCHFILENAME FILEENTRY))) (\,@ (AND LDFLG (BQUOTE ((QUOTE (\, LDFLG)))))))))) (EXEC-EVAL (if (CDR FORMS) then (CONS (QUOTE PROGN) FORMS) else (CAR FORMS))) (CLOSEW (TTYDISPLAYSTREAM))))
)
)
(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) (* ; "Edited 4-Feb-88 15:11 by bvm:") (RESETLST (PROG ((WINDOW (fetch (FILEBROWSER BROWSERWINDOW) of BROWSER)) (TBROWSER (fetch (FILEBROWSER TABLEBROWSER) of BROWSER)) (FONT FB.BROWSERFONT) PATTERN INFOWANTED FILEGENERATOR FILENAME NOW INDEX WIDENED CONDITION) (FB.ALLOW.ABORT BROWSER) (COND ((SETQ PATTERN (fetch PATTERN of BROWSER))) ((SETQ PATTERN (FB.GET.NEWPATTERN BROWSER)) (* ; "Didn't have a pattern before--got one now") (FB.SETNEWPATTERN BROWSER PATTERN)) (T (* ; "Refused to give me a pattern") (RETURN))) (PROGN (* ; "Restore browser to empty state--clear the counter window, set the title, remove any items, reset counters.") (replace (FILEBROWSER INFODISPLAYED) of BROWSER with (SETQ INFOWANTED (for SPEC in FB.INFO.FIELDS bind (WANTED ← (fetch (FILEBROWSER INFOMENUCHOICES) of BROWSER)) W PROTO when (MEMB (fetch INFONAME of SPEC) WANTED) collect (SETQ SPEC (COPY SPEC)) (if (SETQ PROTO (fetch INFOPROTOTYPE of SPEC)) then (* ; "Have prototypical example, use it to get better width estimate.") (SETQ W (STRINGWIDTH PROTO FONT)) (replace INFOWIDTH of SPEC with (+ W (TIMES 2 (CHARWIDTH (CHARCODE X) FONT)))) (if (LISTP (fetch INFOFORMAT of SPEC)) then (RPLACA (CDR (fetch INFOFORMAT of SPEC)) W))) SPEC))) (FB.SET.BROWSER.TITLE BROWSER) (CLEARW (fetch (FILEBROWSER COUNTERWINDOW) of BROWSER)) (CLEARW (fetch (FILEBROWSER HEADINGWINDOW) of BROWSER)) (* ; "Clear header window in case it has been scrolled.") (TB.REPLACE.ITEMS TBROWSER NIL) (replace (FILEBROWSER FBREADY) of BROWSER with NIL) (TB.SET.FONT TBROWSER FONT) (replace (FILEBROWSER BROWSERFONT) of BROWSER with FONT) (FB.SET.DEFAULT.NAME.WIDTH BROWSER) (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))) (if (SETQ INDEX (OR (CL:POSITION (QUOTE SIZE) INFOWANTED :KEY (FUNCTION CAR)) (CL:POSITION (QUOTE LENGTH) INFOWANTED :KEY (FUNCTION CAR)))) then (replace (FILEBROWSER SIZEINDEX) of BROWSER with INDEX)) (replace (FILEBROWSER PAGECOUNT?) of BROWSER with (AND INDEX (CAR (CL:NTH INDEX INFOWANTED)))) (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))) (CL:MULTIPLE-VALUE-SETQ (FILEGENERATOR CONDITION) (IGNORE-ERRORS (LET* ((DESIREDPROPS (MAPCAR INFOWANTED (FUNCTION CAR))) (NSP (fetch (FILEBROWSER NSPATTERN?) of BROWSER)) (DEPTH (OR (fetch (FILEBROWSER FBDEPTH) of BROWSER) (if NSP then (* ; "FILING.ENUMERATION.DEPTH is significant for NS servers") FILING.ENUMERATION.DEPTH))) (FILING.ENUMERATION.DEPTH (OR DEPTH FILING.ENUMERATION.DEPTH))) (DECLARE (SPECVARS FILING.ENUMERATION.DEPTH)) (FB.PROMPTW.FORMAT BROWSER "~%%Enumerating ~A ~@[to depth ~D ~]..." PATTERN (FIXP DEPTH)) (if (AND NSP (fetch (FILEBROWSER PAGECOUNT?) of BROWSER) (OR DEPTH (NOT (UNPACKFILENAME.STRING PATTERN (QUOTE DIRECTORY))))) then (* ; "Ask for SUBTREE.SIZE also, so we can give page estimates of subdirectories, or in the case of enumerating a host, the top-level directories") (push DESIREDPROPS (QUOTE SUBTREE.SIZE))) (replace (FILEBROWSER FBDISPLAYEDDEPTH) of BROWSER with (replace (FILEBROWSER FBCOMPUTEDDEPTH) of BROWSER with (OR (FIXP DEPTH) 0))) (\GENERATEFILES PATTERN DESIREDPROPS (QUOTE (SORT RESETLST)))))) (if CONDITION then (FB.PROMPTW.FORMAT BROWSER "Failed because ~A" CONDITION) (RETURN)) (SETQ NOW (FB.DATE)) (* ; "Time as of which the enumeration is reasonably valid") (FB.HEADINGW.DISPLAY BROWSER (fetch (FILEBROWSER HEADINGWINDOW) of BROWSER)) (while (SETQ FILENAME (\GENERATENEXTFILE FILEGENERATOR)) bind LASTFILEDATA NEWFILEDATA PREVGROUPDATA OTHERFILES do (* ;; "For each file, create an FBFILEDATA object. Gather together files with the same name, different version, so that we can sort versions. Thus, the display is always (at least) one file behind the generator: LASTFILEDATA is the first item of a given name, OTHERFILES are the remaining versions. PREVGROUPDATA is representative of the previous group.") (COND ((LISTP FILENAME) (* ; "Old kind of generator. Extinct?") (SETQ FILENAME (CONCATCODES FILENAME)))) (SETQ NEWFILEDATA (FB.CREATE.FILEBUCKET BROWSER FILENAME (FB.GETALLFILEINFO BROWSER FILEGENERATOR INFOWANTED) LASTFILEDATA)) (COND ((AND LASTFILEDATA (EQ (fetch (FBFILEDATA VERSIONLESSNAME) of LASTFILEDATA) (fetch (FBFILEDATA VERSIONLESSNAME) of NEWFILEDATA))) (* ; "This file same name as previous one, so save it in case we need to sort versions. Note that FB.CREATE.FILEBUCKET canonicalizes the VERSIONLESSNAME, so EQ suffices") (push OTHERFILES NEWFILEDATA)) (T (COND ((AND LASTFILEDATA (OR (NOT (fetch (FBFILEDATA DIRECTORYFILEP) of LASTFILEDATA)) (NOT (STRPOS (fetch (FBFILEDATA FILENAME) of LASTFILEDATA) (fetch (FBFILEDATA FILENAME) of NEWFILEDATA) 1 NIL T NIL UPPERCASEARRAY)))) (* ;; "Add the previous group we have accumulated. Second clause says not to add a line for a subdirectory file which is not a leaf, i.e., for which there are files below it in the enumeration (it would be nice if NS filing did this filtering itself).") (FB.ADD.FILEGROUP TBROWSER BROWSER LASTFILEDATA OTHERFILES PREVGROUPDATA) (SETQ PREVGROUPDATA LASTFILEDATA))) (SETQ OTHERFILES NIL) (SETQ LASTFILEDATA NEWFILEDATA))) finally (AND LASTFILEDATA (FB.ADD.FILEGROUP TBROWSER BROWSER LASTFILEDATA OTHERFILES PREVGROUPDATA))) (COND ((EQ (TB.NUMBER.OF.ITEMS TBROWSER) 0) (FB.PROMPTWPRINT BROWSER (QUOTE CLEAR) "No files in group " PATTERN)) (T (FB.PROMPTWPRINT BROWSER (QUOTE done)) (SETQ WIDENED (FB.MAYBE.WIDEN.NAMES BROWSER)) (COND ((OR (FB.ADJUST.DATE.WIDTH BROWSER INFOWANTED) WIDENED) (FB.HEADINGW.DISPLAY BROWSER (fetch HEADINGWINDOW of BROWSER)) (TB.REDISPLAY.ITEMS (fetch (FILEBROWSER TABLEBROWSER) of BROWSER)))))) (FB.SET.BROWSER.TITLE BROWSER NOW) (replace (FILEBROWSER FBREADY) of BROWSER with T) (FB.DISPLAY.COUNTERS BROWSER))))
)
(FB.DATE
(LAMBDA NIL (* ; "Edited 21-Jan-88 18:40 by bvm") (LET ((DT (DATE (DATEFORMAT DAY.OF.WEEK DAY.SHORT NO.SECONDS)))) (* ;; "DT is in the form %"dd-mon-yy hh:mm (day)%". Turn it into %"hh:mm day dd-mon-yy%".") (CONCAT (SUBSTRING DT 11 16) (SUBSTRING DT 18 20) " " (SUBSTRING DT (if (EQ (CHCON1 DT) (CHARCODE SPACE)) then (* ; "Trim leading space from date") 2 else 1) 9))))
)
(FB.ADJUST.DATE.WIDTH
(LAMBDA (BROWSER INFOWANTED) (* ; "Edited 27-Jan-88 12:32 by bvm") (* ;; "Adjust the expected with field of any date fields (other than the last) to reflect the width of actual dates this device returns. Returns T if it did anything.") (for TAIL on INFOWANTED as INDEX from 0 while (CDR TAIL) bind (FONT ← (fetch (FILEBROWSER BROWSERFONT) of BROWSER)) SPEC RESULT when (AND (EQ (fetch INFOFORMAT of (SETQ SPEC (CAR TAIL))) (QUOTE DATE)) (TB.FIND.ITEM (fetch (FILEBROWSER TABLEBROWSER) of BROWSER) (FUNCTION (LAMBDA (TBROWSER ITEM) (if (SETQ ITEM (CL:NTH INDEX (fetch (FBFILEDATA FILEINFO) of (fetch TIDATA of ITEM)))) then (* ;; "Got a sample date. Assuming all dates have the same number of characters, compute a width that fits this date plus a couple spaces. Computation here for variable-width font assumes %"MAY%" is about as wide as you get, and finesses the issue of whether this date happens to start with leading space and/or contain some especially skinny letters.") (replace INFOWIDTH of SPEC with (+ (STRINGWIDTH "XX99-MAY-88 99:99:99" FONT) (if (> (NCHARS ITEM) 18) then (* ; "Have a time-zone, too, or something") (STRINGWIDTH (SUBSTRING ITEM 19) FONT) else 0))) T))))) do (SETQ RESULT T) finally (RETURN RESULT)))
)
(FB.SET.BROWSER.TITLE
(LAMBDA (BROWSER TIME) (* ; "Edited 21-Jan-88 18:37 by bvm") (* ;; "(Re)display the title on BROWSER's window. If Time is supplied, it is the time at which the enumeration happened, and we include it in the title. Title is not changed if user supplied own title.") (COND ((NOT (fetch (FILEBROWSER FIXEDTITLE) of BROWSER)) (WINDOWPROP (fetch (FILEBROWSER COUNTERWINDOW) of BROWSER) (QUOTE TITLE) (if TIME then (CONCAT (fetch (FILEBROWSER PATTERN) of BROWSER) " at " TIME) else (CONCAT (fetch (FILEBROWSER PATTERN) of BROWSER) " browser"))))))
)
(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 LASTFILEDATA) (* ; "Edited 1-Feb-88 14:44 by bvm:") (* ;; "Create a FBFILEDATA encapsulating FILENAME and its FILEINFO. If LASTFILEDATA is supplied, it is the filedata from the previous file parsed, which we make use of to create canonical VERSIONLESSNAME fields.") (if (NOT (STRINGP FILENAME)) then (* ; "Some things are nicer if we force everything to be a string.") (SETQ FILENAME (STRING FILENAME))) (COND ((NULL (fetch (FILEBROWSER PATTERNPARSED?) of BROWSER)) (FB.ANALYZE.PATTERN BROWSER FILENAME))) (LET ((STARTOFNAME (fetch (FILEBROWSER NAMESTART) of BROWSER)) (NAMELENGTH (NCHARS FILENAME)) (VERSION 0) (DEPTH 0) STARTOFSHORTNAME LASTDIR PREVDIR LASTNAMECHAR HASDIRPREFIX DIRP ATTR TEM NEWFILEDATA) (SETQ LASTNAMECHAR NAMELENGTH) (bind (DEC ← 1) CH while (DIGITCHARP (SETQ CH (NTHCHARCODE FILENAME LASTNAMECHAR))) do (add VERSION (TIMES (- CH (CHARCODE 0)) DEC)) (SETQ DEC (TIMES 10 DEC)) (SETQ LASTNAMECHAR (SUB1 LASTNAMECHAR)) finally (* ; "not a version char") (COND ((EQ CH (CHARCODE ;)) (* ; "Pull off the version from the end, so that we can sort with it, etc. Note that we assume that all devices have converted native syntax to Lisp here.") (SETQ LASTNAMECHAR (SUB1 LASTNAMECHAR))) (T (SETQ VERSION 0) (* ; "Null version") (SETQ LASTNAMECHAR NIL)))) (SETQ NEWFILEDATA (if (AND LASTFILEDATA (STRING-EQUAL (fetch (FBFILEDATA VERSIONLESSNAME) of LASTFILEDATA) FILENAME :END2 (OR LASTNAMECHAR NAMELENGTH))) then (* ; "This file is just like the previous one, except for attributes, full name and version") (create FBFILEDATA using LASTFILEDATA) else (for (N ← STARTOFNAME) do (SELCHARQ (NTHCHARCODE FILENAME (add N 1)) ((> /) (SETQ PREVDIR LASTDIR) (SETQ LASTDIR N) (add DEPTH 1)) (%' (* ; "Next char is quoted") (add N 1)) (NIL (RETURN)) NIL)) (if (EQ LASTDIR NAMELENGTH) then (* ; "It's a directory name (e.g., with ns), so make the name be the last subdirectory") (SETQ LASTDIR PREVDIR) (SETQ DIRP T) (add DEPTH -1)) (COND (LASTDIR (* ; "We found a directory delimiter following the common directory prefix of the pattern. ") (SETQ HASDIRPREFIX T) (SETQ STARTOFSHORTNAME (ADD1 LASTDIR)) (* ; "Directoryless name starts here") (COND ((NOT (fetch (FILEBROWSER NOSUBDIRECTORIES) of BROWSER)) (* ; "Use short name if allowed.") (SETQ STARTOFNAME STARTOFSHORTNAME)))) (T (SETQ STARTOFSHORTNAME STARTOFNAME))) (* ; "Note optimization: SUBDIREND is zero (SUBDIRECTORY null) when HASDIRPREFIX is NIL.") (create FBFILEDATA STARTOFPNAME ← STARTOFNAME VERSIONLESSNAME ← (COND (LASTNAMECHAR (SUBSTRING FILENAME 1 LASTNAMECHAR)) (T FILENAME)) SUBDIREND ← (OR LASTDIR 0) STARTOFNAME ← STARTOFSHORTNAME HASDIRPREFIX ← HASDIRPREFIX DIRECTORYFILEP ← DIRP FILEDEPTH ← DEPTH))) (replace (FBFILEDATA FILENAME) of NEWFILEDATA with FILENAME) (replace (FBFILEDATA VERSION) of NEWFILEDATA with VERSION) (replace (FBFILEDATA FILEINFO) of NEWFILEDATA with FILEINFO) (replace (FBFILEDATA SIZE) of NEWFILEDATA with (AND (SETQ ATTR (fetch (FILEBROWSER PAGECOUNT?) of BROWSER)) (SETQ TEM (CL:NTH (fetch (FILEBROWSER SIZEINDEX) of BROWSER) FILEINFO)) (SELECTQ ATTR (LENGTH (FOLDHI TEM BYTESPERPAGE)) TEM))) (FB.CHECK.NAME.LENGTH BROWSER NEWFILEDATA) (COND ((SETQ ATTR (fetch (FILEBROWSER SORTATTRIBUTE) of BROWSER)) (SETQ ATTR (CL:NTH (fetch (FILEBROWSER SORTINDEX) of BROWSER) FILEINFO)) (COND ((AND ATTR (fetch (FILEBROWSER SORTBYDATE) of BROWSER)) (SETQ ATTR (IDATE ATTR)))) (replace (FBFILEDATA SORTVALUE) of NEWFILEDATA with ATTR))) NEWFILEDATA))
)
(FB.CHECK.NAME.LENGTH
(LAMBDA (BROWSER FILEDATA) (* ; "Edited 25-Jan-88 15:44 by bvm") (* ;;; "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 (+ (STRINGWIDTH (fetch (FBFILEDATA PRINTNAME) of FILEDATA) (fetch (FILEBROWSER BROWSERFONT) of BROWSER)) (fetch (FILEBROWSER NAMEOVERHEAD) of BROWSER)))) (COND ((>= 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) (> 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)))) (> PRINTLENGTH (CAR (CAR TAIL)))) do (* ; "Longer than some previously recorded length, so either add a new entry or bump the preceding one") (COND ((< PRINTLENGTH (- (CAR (CAR PREVTAIL)) SPACING)) (RPLACD PREVTAIL (CONS (LIST PRINTLENGTH 1) TAIL))) (T (add (CADR (CAR PREVTAIL)) 1))) (RETURN)))))))))
)
(FB.ADD.FILEGROUP
(LAMBDA (TBROWSER FBROWSER FIRSTDATA OTHERDATA PREVDATA) (* ; "Edited 1-Feb-88 14:43 by bvm:") (* ;; "Appends to FBROWSER the set of files FIRSTDATA plus each of OTHERDATA, all of which are known to have the same name save version number. PREVDATA is representative of the last item we inserted.") (COND ((AND (NOT (fetch (FILEBROWSER NOSUBDIRECTORIES) of FBROWSER)) (NOT (if PREVDATA then (EQ.DIRECTORYP PREVDATA FIRSTDATA) else (NULL.DIRECTORYP FIRSTDATA)))) (* ; "The new files have a different subdirectory, so insert a non-selectable line item here") (FB.INSERT.DIRECTORY TBROWSER FBROWSER FIRSTDATA))) (COND (OTHERDATA (* ; "More than one file to add, so sort versions") (for ITEM in (SORT (for D in (CONS FIRSTDATA OTHERDATA) collect (create TABLEITEM TIDATA ← D)) (FUNCTION FB.DECREASING.VERSION)) do (FB.ADD.FILE TBROWSER FBROWSER ITEM))) (T (FB.ADD.FILE TBROWSER FBROWSER (create TABLEITEM TIDATA ← FIRSTDATA)))))
)
(FB.INSERT.DIRECTORY
(LAMBDA (TBROWSER FBROWSER DATAWITHSUBDIR BEFOREITEM) (* ; "Edited 25-Jan-88 17:13 by bvm") (TB.INSERT.ITEM TBROWSER (FB.MAKE.SUBDIRECTORY.ITEM FBROWSER DATAWITHSUBDIR) BEFOREITEM))
)
(FB.MAKE.SUBDIRECTORY.ITEM
(LAMBDA (FBROWSER DATAWITHSUBDIR) (* ; "Edited 26-Jan-88 10:58 by bvm") (* ;;; "Creates a TABLEITEM containing a subdirectory line identifying the subdirectory in DATAWITHSUBDIR. If item has no subdirectory, we use the browser's pattern directory") (LET* ((SUBDIRECTORY (OR (fetch (FBFILEDATA SUBDIRECTORY) of DATAWITHSUBDIR) (SUBSTRING (fetch (FILEBROWSER PATTERN) of FBROWSER) 1 (SUB1 (fetch (FILEBROWSER NAMESTART) of FBROWSER))))) (DIRSTART (fetch (FILEBROWSER DIRECTORYSTART) of FBROWSER))) (create TABLEITEM TIUNSELECTABLE ← T TIDATA ← (create FBFILEDATA FILENAME ← SUBDIRECTORY STARTOFPNAME ← (if (<= DIRSTART (NCHARS SUBDIRECTORY)) then DIRSTART else (* ; "No directory--use whole name") 1) 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) (* ; "Edited 25-Jan-88 18:31 by bvm") (LET ((TBROWSER (fetch (FILEBROWSER TABLEBROWSER) of BROWSER)) (FBSORTFN (fetch (FILEBROWSER SORTBY) of BROWSER)) (MYDATA (fetch TIDATA of FILE)) (NOSUBDIRS (fetch (FILEBROWSER NOSUBDIRECTORIES) of BROWSER)) OTHERDATA NEXTITEM PREVITEM N) (SETQ NEXTITEM (TB.FIND.ITEM TBROWSER (FUNCTION (LAMBDA (BROWSER ITEM) (AND (NOT (fetch TIUNSELECTABLE of ITEM)) (CL:FUNCALL 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 (EQ.DIRECTORYP MYDATA (fetch TIDATA of NEXTITEM)))) (* ;; "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)) (EQ.DIRECTORYP MYDATA (SETQ OTHERDATA (fetch TIDATA of NEXTITEM)))) (* ;; "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 OTHERDATA NEXTITEM))) (COND ((COND ((EQ (SETQ N (fetch TI# of FILE)) 1) (* ; "Inserted at front, needs qualification if it has a subdir") (NOT (NULL.DIRECTORYP MYDATA))) (T (NOT (EQ.DIRECTORYP MYDATA (fetch TIDATA of (SETQ PREVITEM (TB.NTH.ITEM TBROWSER (SUB1 N)))))))) (* ; "Need id in front of new file as well") (FB.INSERT.DIRECTORY TBROWSER BROWSER MYDATA FILE))))) (FB.COUNT.FILE.CHANGE BROWSER FILE (QUOTE ADD))))
)
(FB.ANALYZE.PATTERN
(LAMBDA (BROWSER SAMPLE) (* ; "Edited 21-Jan-88 18:32 by bvm") (* ;;; "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) (FB.SET.BROWSER.TITLE 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 (BROWSER GENERATOR ATTRIBUTES) (* ; "Edited 1-Feb-88 15:50 by bvm:") (* ;; "Returns a FILEINFO field for the given attribute specs") (for ATTR in ATTRIBUTES bind VALUE TREESIZE collect (SETQ VALUE (\GENERATEFILEINFO GENERATOR (CAR ATTR))) (if (AND (EQ VALUE 0) (fetch (FILEBROWSER NSPATTERN?) of BROWSER) (FMEMB (CAR ATTR) (QUOTE (SIZE LENGTH))) (SETQ TREESIZE (\GENERATEFILEINFO GENERATOR (QUOTE SUBTREE.SIZE)))) then (* ;; "This is an NS directory node, so get its subtree size, which is much more interesting than size, which is always zero (directories have no data)") (SELECTQ (CAR ATTR) (SIZE (FOLDHI TREESIZE BYTESPERPAGE)) (LENGTH TREESIZE) (SHOULDNT)) else VALUE)))
)
)
(DEFINEQ
(FB.SORT.VERSIONS
(LAMBDA (ITEMS SORTFN) (* ; "Edited 25-Jan-88 15:22 by bvm") (* ;;; "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 VERSIONLESSNAME) of (fetch TIDATA of (CAR TAIL)))) (fetch (FBFILEDATA VERSIONLESSNAME) 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 VERSIONLESSNAME) 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) (* ; "Edited 29-Jan-88 12:47 by bvm") (PROG ((TBROWSER (fetch (FILEBROWSER TABLEBROWSER) of BROWSER)) (HADNOSUBDIRS (fetch (FILEBROWSER NOSUBDIRECTORIES) of BROWSER)) SORTATTR SORT# SORTFN REVERSED ALLFILES DATETYPE BYNAME) (COND ((NULL (SETQ SORTATTR (MENU (FB.GET.SORT.MENU BROWSER)))) (RETURN)) ((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.PROMPTW.FORMAT BROWSER "Sorting by ~A..." SORTATTR) (SETQ ALLFILES (TB.COLLECT.ITEMS TBROWSER (FUNCTION FB.IS.NOT.SUBDIRECTORY.ITEM))) (COND ((NOT BYNAME) (* ; "Need to compute the attribute on which we sort") (SETQ SORT# (OR (CL:POSITION SORTATTR (fetch (FILEBROWSER INFODISPLAYED) of BROWSER) :KEY (FUNCTION CAR)) (HELP "Couldn't find sort attribute" SORTATTR))) (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 (CL:NTH SORT# (fetch (FBFILEDATA FILEINFO) of DATA))) (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 STARTOFPNAME) of DATA with 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 STARTOFPNAME) of DATA with (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)) (if SORT# then (replace (FILEBROWSER SORTINDEX) of BROWSER with SORT#)) (replace (FILEBROWSER SORTBYDATE) of BROWSER with DATETYPE) (FB.PROMPTWPRINT BROWSER "done")))
)
(FB.INSERT.SUBDIRECTORIES
(LAMBDA (BROWSER FILES) (* ; "Edited 26-Jan-88 10:45 by bvm") (for TAIL on FILES bind (LASTDATA ← (create FBFILEDATA SUBDIREND ← 0)) when (NOT (EQ.DIRECTORYP LASTDATA (SETQ LASTDATA (fetch TIDATA of (CAR TAIL))))) do (* ; "This guy's directory differs from previous, so add subdirectory item") (ATTACH (FB.MAKE.SUBDIRECTORY.ITEM BROWSER LASTDATA) TAIL) (SETQ TAIL (CDR TAIL))))
)
(FB.GET.SORT.MENU
(LAMBDA (BROWSER) (* ; "Edited 26-Jan-88 12:38 by bvm") (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 (BQUOTE ((\, (SETQ ATTR (CAR ATTR))) (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) (* ; "Edited 28-Jan-88 00:50 by bvm") (PROG ((*UPPER-CASE-FILE-NAMES* NIL) (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...") (FB.ALLOW.ABORT FBROWSER) (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.PROMPTW.FORMAT FBROWSER " ~A aborted." CMD))) (RETURN NIL)))) (T (FB.PROMPTWPRINT FBROWSER T "No files were marked for deletion"))) (RETURN T)))
)
(FB.NEWPATTERNCOMMAND
(LAMBDA (BROWSER) (* ; "Edited 28-Jan-88 01:11 by bvm") (LET (PATTERN) (COND ((AND (FB.MAYBE.EXPUNGE BROWSER "New Pattern") (SETQ PATTERN (FB.GET.NEWPATTERN BROWSER))) (FB.SETNEWPATTERN BROWSER PATTERN) (FB.UPDATEBROWSERITEMS BROWSER)))))
)
(FB.NEWINFOCOMMAND
(LAMBDA (BROWSER) (* ; "Edited 1-Feb-88 15:25 by bvm:") (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.INFO.MENU.ITEMS 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.DEPTHCOMMAND
(LAMBDA (FBROWSER) (* ; "Edited 1-Feb-88 13:54 by bvm:") (LET ((OLDDEPTH (fetch (FILEBROWSER FBDEPTH) of FBROWSER)) NEWDEPTH) (FB.PROMPTWPRINT FBROWSER "Current depth is " (SELECTQ OLDDEPTH (NIL "global default") (T "infinite") OLDDEPTH) T "Specify new depth") (if (EQ (SETQ NEWDEPTH (MENU (create MENU ITEMS ← FB.DEPTH.MENU.ITEMS CENTERFLG ← T))) :NUMBER) then (FB.ALLOW.ABORT FBROWSER) (SETQ NEWDEPTH (RNUMBER "Enumeration Depth" NIL NIL NIL T NIL T))) (if (NULL NEWDEPTH) then (FB.PROMPTWPRINT FBROWSER T "Depth unchanged") else (FB.PROMPTWPRINT FBROWSER T "Depth set to " (SELECTQ NEWDEPTH (:GLOBAL (SETQ NEWDEPTH NIL) "global default") (T "infinity") NEWDEPTH) " for future Recomputes") (replace (FILEBROWSER FBDEPTH) of FBROWSER with NEWDEPTH))))
)
(FB.SHAPECOMMAND
(LAMBDA (BROWSER) (* ; "Edited 2-Feb-88 12:02 by bvm:") (* ;; "Widen or narrow the browser so that all information is visible") (LET* ((WINDOW (fetch (FILEBROWSER BROWSERWINDOW) of BROWSER)) (WREG (WINDOWREGION WINDOW)) (WWIDTH (fetch (REGION WIDTH) of WREG)) (EXTENT (WINDOWPROP WINDOW (QUOTE EXTENT))) EXCESSHEIGHT MENUW) (* ;; "Add enough to the whole region width to compensate for the excess of the extent over the actual width, but don't get wider than the screen less a scroll bar. Using the EXTENT is not entirely correct--EXTENT's width reflects the widest line we have attempted to print, not the widest line we MIGHT print if window were scrolled to other items.") (replace (REGION WIDTH) of WREG with (SETQ WWIDTH (MIN (+ WWIDTH (- (fetch (REGION WIDTH) of EXTENT) (WINDOWPROP WINDOW (QUOTE WIDTH)))) (- SCREENWIDTH SCROLLBARWIDTH)))) (if (AND (> (SETQ EXCESSHEIGHT (- (WINDOWPROP WINDOW (QUOTE HEIGHT)) (fetch (REGION HEIGHT) of EXTENT))) 0) (SETQ MENUW (CDR (fetch (FILEBROWSER ABORTWINDOW) of BROWSER)))) then (* ; "Window is also taller than it needs to be--shrink it back, though not smaller than the minimum height") (replace (REGION HEIGHT) of WREG with (MAX (- (fetch (REGION HEIGHT) of WREG) EXCESSHEIGHT) (+ (fetch (REGION HEIGHT) of (WINDOWPROP MENUW (QUOTE REGION))) (fetch (REGION HEIGHT) of (WINDOWPROP (fetch (FILEBROWSER PROMPTWINDOW) of BROWSER) (QUOTE REGION)))))) else (SETQ EXCESSHEIGHT NIL)) (if (> (fetch (REGION PRIGHT) of WREG) SCREENWIDTH) then (* ; "If we're sticking over the edge on the right, move the region leftward.") (replace (REGION LEFT) of WREG with (- SCREENWIDTH WWIDTH))) (RESHAPEALLWINDOWS WINDOW WREG) (if EXCESSHEIGHT then (* ; "Silly reshaping routine tried to preserve the bottom, so scrolled the window up. Let's scroll it back down.") (SCROLLW WINDOW 0 (- EXCESSHEIGHT)))))
)
(FB.REMOVE.FILE
(LAMBDA (TBROWSER FBROWSER ITEM) (* ; "Edited 25-Jan-88 17:24 by bvm") (* ;;; "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.DIRECTORYP (fetch TIDATA of NEXTNEXTITEM))) (T (EQ.DIRECTORYP (fetch TIDATA of NEXTNEXTITEM) (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.SETNEWPATTERN
(LAMBDA (FBROWSER PATTERN) (* ; "Edited 1-Feb-88 15:46 by bvm:") (* ;; "Called to install a new PATTERN in a filebrowser. PATTERN should already have been passed thru DIRECTORY.FILL.PATTERN.") (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) (replace (FILEBROWSER NSPATTERN?) of FBROWSER with (STRPOS ":" (UNPACKFILENAME.STRING PATTERN (QUOTE HOST)))) (COND ((SETQ ICON (WINDOWPROP (fetch (FILEBROWSER BROWSERWINDOW) of FBROWSER) (QUOTE ICONWINDOW))) (* ; "Change the icon label") (ICONW.TITLE ICON PATTERN))) PATTERN))
)
(FB.GET.NEWPATTERN
(LAMBDA (BROWSER) (* ; "Edited 28-Jan-88 01:11 by bvm") (FB.ALLOW.ABORT BROWSER) (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.INFOMENU.SHADEINITIALSELECTIONS
(LAMBDA (MENUWINDOW INITIALSELECTIONS) (* ; "Edited 21-Jan-88 18:36 by bvm") (LET* ((MENU (CAR (WINDOWPROP MENUWINDOW (QUOTE MENU)))) (MENUITEMS (fetch (MENU ITEMS) of MENU))) (for SELECTION in INITIALSELECTIONS do (SHADEITEM (FB.INFO.ITEM.NAMED SELECTION MENUITEMS) MENU FB.INFOSHADE MENUWINDOW))))
)
(FB.INFO.ITEM.NAMED
(LAMBDA (TAG ITEMS) (* ; "Edited 21-Jan-88 17:38 by bvm") (* ;;; "search list items for one with second element TAG") (for ITEM in ITEMS when (STRING-EQUAL (CADR ITEM) TAG) do (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) (* ; "Edited 4-Feb-88 15:11 by bvm:") (LET ((BROWSER (WINDOWPROP (MAINWINDOW COUNTERWINDOW T) (QUOTE FILEBROWSER)))) (if (fetch (FILEBROWSER FBREADY) of BROWSER) then (* ; "Don't do this if user reshapes while we're still enumerating.") (CLEARW COUNTERWINDOW) (FB.DISPLAY.COUNTERS BROWSER))))
)
(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) (* ; "Edited 22-Jan-88 17:45 by bvm") (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) 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) (* ; "Edited 22-Jan-88 17:51 by bvm") (* ;;; "Redraw the heading window after a reshape") (LET ((FBROWSER (WINDOWPROP (WINDOWPROP WINDOW (QUOTE MAINWINDOW)) (QUOTE FILEBROWSER)))) (CLEARW WINDOW) (FB.HEADINGW.DISPLAY FBROWSER WINDOW)))
)
(FB.HEADINGW.DISPLAY
(LAMBDA (FBROWSER WINDOW) (* ; "Edited 1-Feb-88 15:36 by bvm:") (LET* ((STREAM (WINDOWPROP WINDOW (QUOTE DSP))) (CLIP (DSPCLIPPINGREGION NIL WINDOW)) (RMARG (fetch (REGION RIGHT) of CLIP)) (BORDER (WINDOWPROP (MAINWINDOW WINDOW) (QUOTE BORDER))) (NEXTPOS (+ BORDER (fetch (FILEBROWSER INFOSTART) of FBROWSER))) (DEPTH (fetch (FILEBROWSER FBDISPLAYEDDEPTH) of FBROWSER)) FORMAT) (DSPFILL CLIP BLACKSHADE (QUOTE REPLACE) STREAM) (* ; "Note: title window has no border, so add the main window's border width to all x computations here.") (DSPRIGHTMARGIN 32000 STREAM) (if (< (fetch (REGION LEFT) of CLIP) NEXTPOS) then (* ; "Some of %"Name (depth n)%" field may be visible.") (DSPXPOSITION (+ TB.LEFT.MARGIN BORDER) STREAM) (PRIN3 "Name" STREAM) (if (NEQ DEPTH 0) then (CL:FORMAT STREAM " (depth ~D)" DEPTH))) (for SPEC in (fetch (FILEBROWSER INFODISPLAYED) of FBROWSER) until (> NEXTPOS RMARG) do (DSPXPOSITION (if (LISTP (SETQ FORMAT (fetch INFOFORMAT of SPEC))) then (* ; "Right-justified integer field, so right-justify title") (- (+ NEXTPOS (CADR FORMAT)) (STRINGWIDTH (fetch (INFOFIELD INFOLABEL) of SPEC) STREAM)) else NEXTPOS) STREAM) (PRIN3 (fetch (INFOFIELD INFOLABEL) of SPEC) STREAM) (add NEXTPOS (fetch (INFOFIELD INFOWIDTH) of SPEC)))))
)
)
(DEFINEQ
(FB.ICONFN
(LAMBDA (WINDOW OLDICON) (* ; "Edited 26-Jan-88 15:55 by bvm") (OR OLDICON (TITLEDICONW FB.ICONSPEC (fetch PATTERN of (WINDOWPROP WINDOW (QUOTE FILEBROWSER))) FB.ICONFONT NIL NIL NIL (QUOTE FILE))))
)
(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) (* ; "Edited 27-Jan-88 23:52 by bvm") (* ;; "did you really want to close up shop?") (RESETLST (COND ((NOT (OBTAIN.MONITORLOCK (fetch (FILEBROWSER FBLOCK) of (TB.USERDATA TBROWSER)) T T)) (* ; "We're busy") (PROMPTPRINT (CONCAT "Can't " (L-CASE FLG) " window while browser is busy")) (QUOTE DON'T)) ((NEQ (TB.NUMBER.OF.ITEMS TBROWSER (QUOTE DELETED)) 0) (* ; "There are deleted items. Shall we expunge?") (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 (* ; "Edited 1-Feb-88 15:25 by bvm:") (OR FB.EXPUNGE?MENU (SETQ FB.EXPUNGE?MENU (create MENU ITEMS ← FB.CLOSE.MENU.ITEMS 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) (* ; "Edited 1-Feb-88 16:37 by bvm:") (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 and get rid of Abort before we shrink, or else they will still be shaded/Open when we expand") (FB.FINISH.COMMAND BROWSER ITEM MENU) (TB.FINISH.CLOSE TBROWSER (fetch (FILEBROWSER BROWSERWINDOW) of BROWSER) FLG))))))
)
)
(DEFINEQ
(FB.HARDCOPY.DIRECTORY
(LAMBDA (WINDOW IMAGESTREAM) (* ; "Edited 1-Feb-88 19:00 by bvm:") (RESETLST (LET ((FBROWSER (WINDOWPROP WINDOW (QUOTE FILEBROWSER))) (TBROWSER (WINDOWPROP WINDOW (QUOTE TABLEBROWSER))) (SCALE (DSPSCALE NIL IMAGESTREAM)) (RMARG (DSPRIGHTMARGIN MAX.SMALLP IMAGESTREAM)) (LMARG (DSPLEFTMARGIN NIL IMAGESTREAM)) (MAXNAMEWIDTH 0) (MAINFONT FB.HARDCOPY.FONT) (DIRFONT (OR FB.HARDCOPY.DIRECTORY.FONT ITALICFONT)) FDATA INFO W LABEL COLUMNSPECS INFOLMARG PROPS FILES TITLE PAD DATEWIDTH) (ALLOW.BUTTON.EVENTS) (* ; "Ensure that we are no longer the mouse process (should be redundant)") (FB.MAKE.BROWSER.BUSY FBROWSER) (* ; "Grab the browser, so it doesn't change out from under us") (FB.ALLOW.ABORT FBROWSER) (* ; "Enable abort button") (FB.PROMPTWPRINT FBROWSER T "Producing hardcopy listing of directory...") (if MAINFONT then (* ; "User-settable font for listing to appear in") (DSPFONT MAINFONT IMAGESTREAM)) (SETQ MAINFONT (DSPFONT NIL IMAGESTREAM)) (* ; "Get coerced font, or default") (SETQ TITLE (CONCAT "Directory of " (fetch (FILEBROWSER PATTERN) of FBROWSER))) (STREAMPROP IMAGESTREAM (QUOTE PRINTOPTIONS) (LIST* (QUOTE DOCUMENT.NAME) TITLE (STREAMPROP IMAGESTREAM (QUOTE PRINTOPTIONS)))) (* ; "Give the document a nice name") (FB.HARDCOPY.PRINT.TITLE (CONCAT "Directory of " (WINDOWPROP (fetch (FILEBROWSER COUNTERWINDOW) of FBROWSER) (QUOTE TITLE))) IMAGESTREAM LMARG RMARG) (if (fetch (FILEBROWSER PAGECOUNT?) of FBROWSER) then (FB.HARDCOPY.PRINT.TITLE (CONCAT (fetch (FILEBROWSER TOTALFILES) of FBROWSER) " files in " (fetch (FILEBROWSER TOTALPAGES) of FBROWSER) " pages") IMAGESTREAM LMARG RMARG)) (SETQ PAD (TIMES SCALE 12)) (* ; "Space between columns") (for ITEM in (SETQ FILES (TB.COLLECT.ITEMS TBROWSER)) unless (fetch (FBFILEDATA DIRECTORYP) of (SETQ FDATA (fetch TIDATA of ITEM))) do (SETQ MAXNAMEWIDTH (IMAX (STRINGWIDTH (fetch (FBFILEDATA PRINTNAME) of FDATA) MAINFONT) MAXNAMEWIDTH))) (SETQ COLUMNSPECS (for SPEC in (fetch (FILEBROWSER INFODISPLAYED) of FBROWSER) as INDEX from 0 bind PROTO collect (* ; "For each bit of info to print, compute how much space we expect it to need. Second slot filled in below") (LIST* (+ PAD (if (SETQ PROTO (fetch INFOPROTOTYPE of SPEC)) then (STRINGWIDTH PROTO IMAGESTREAM) elseif (EQ (fetch INFOFORMAT of SPEC) (QUOTE DATE)) then (OR DATEWIDTH (SETQ DATEWIDTH (FB.HARDCOPY.MAXWIDTH FILES INDEX MAINFONT T))) else (FB.HARDCOPY.MAXWIDTH FILES INDEX MAINFONT))) NIL SPEC))) (SETQ INFOLMARG (- RMARG (for PAIR in COLUMNSPECS sum (CAR PAIR)))) (LET ((NAMERIGHTMARG (+ LMARG MAXNAMEWIDTH PAD))) (if (< NAMERIGHTMARG INFOLMARG) then (* ; "Enough space for name plus all info with room left over") (SETQ INFOLMARG NAMERIGHTMARG) elseif (> INFOLMARG LMARG) then (* ; "Ok, there's enough space for info, though it might end up on a separate line from file name") else (* ; "Ugh, want to print more info than fits on a line. Punt") (SETQ INFOLMARG NAMERIGHTMARG) (DSPRIGHTMARGIN RMARG IMAGESTREAM) (* ; "make it wrap after all"))) (LET ((FIRSTINFOCOLUMN INFOLMARG)) (for PAIR in COLUMNSPECS do (* ; "Print headers") (SETQ LABEL (fetch INFOLABEL of (CDDR PAIR))) (SETQ W (FIXR (CAR PAIR))) (DSPXPOSITION (+ FIRSTINFOCOLUMN (IQUOTIENT (- (- W PAD) (STRINGWIDTH LABEL IMAGESTREAM)) 2)) IMAGESTREAM) (* ; "Center the label") (PRIN3 LABEL IMAGESTREAM) (RPLACA PAIR (PROG1 FIRSTINFOCOLUMN (add FIRSTINFOCOLUMN W))) (* ; "First element is left position of the entry ") (if (fetch INFOFORMAT of (CDDR PAIR)) then (* ; "Second element is right margin (for right-justified items)") (RPLACA (CDR PAIR) (- FIRSTINFOCOLUMN PAD)))) (TERPRI IMAGESTREAM) (TERPRI IMAGESTREAM)) (for ITEM in FILES bind FILEINFO INFO FORMAT HERE NEXT do (SETQ FDATA (fetch TIDATA of ITEM)) (if (fetch (FBFILEDATA DIRECTORYP) of FDATA) then (DSPFONT DIRFONT IMAGESTREAM) (DSPXPOSITION (+ LMARG (TIMES SCALE 16)) IMAGESTREAM) (PRIN3 (fetch (FBFILEDATA PRINTNAME) of FDATA) IMAGESTREAM) (DSPFONT MAINFONT IMAGESTREAM) else (PRIN3 (fetch (FBFILEDATA PRINTNAME) of FDATA) IMAGESTREAM) (if COLUMNSPECS then (SETQ FILEINFO (fetch (FBFILEDATA FILEINFO) of FDATA)) (if (AND (> (SETQ HERE (DSPXPOSITION NIL IMAGESTREAM)) INFOLMARG) (OR (NULL (SETQ NEXT (CADR (CAR COLUMNSPECS)))) (> HERE NEXT) (AND (SETQ INFO (CAR FILEINFO)) (> (+ HERE (TIMES SCALE 6)) (- NEXT (STRINGWIDTH INFO MAINFONT)))))) then (* ; "name overran start of info--go to next line. The complex second clause lets us cheat in the case where the first info column is right-justified and will turn out to be short enough to leave space") (TERPRI IMAGESTREAM)) (for PAIR in COLUMNSPECS as INFO in FILEINFO do (DSPXPOSITION (COND ((SETQ NEXT (CADR PAIR)) (* ; "Get numbers to line up right justified") (- NEXT (STRINGWIDTH INFO MAINFONT))) (T (CAR PAIR))) IMAGESTREAM) (if INFO then (PRIN3 INFO IMAGESTREAM))))) (TERPRI IMAGESTREAM) (BLOCK)) (FB.PROMPTWPRINT FBROWSER "done") (DSPRIGHTMARGIN RMARG IMAGESTREAM))))
)
(FB.HARDCOPY.PRINT.TITLE
(LAMBDA (TITLE IMAGESTREAM LMARG RMARG) (* ; "Edited 5-Mar-87 17:59 by bvm:") (DSPXPOSITION (+ LMARG (IQUOTIENT (- RMARG (+ LMARG (STRINGWIDTH TITLE IMAGESTREAM))) 2)) IMAGESTREAM) (printout IMAGESTREAM TITLE T T))
)
(FB.HARDCOPY.MAXWIDTH
(LAMBDA (FILES ATTRINDEX FONT DATEP) (* ; "Edited 27-Jan-88 13:10 by bvm") (* ;; "Compute maximum width of values of the ATTRIBUTE prop of each of the items in FILES.") (* ;; "If DATEP is true, we assume all dates are created equal, and just return the first one") (if (AND DATEP (NEQ (CHARWIDTH (CHARCODE W) FONT) (CHARWIDTH (CHARCODE i) FONT))) then (* ; "Variable-width font, let's compute it for real") (SETQ DATEP NIL)) (for ITEM in FILES bind (MAXWIDTH ← 0) INFO WIDTH when (AND (SETQ INFO (CL:NTH ATTRINDEX (fetch (FBFILEDATA FILEINFO) of (fetch TIDATA of ITEM)))) (> (SETQ WIDTH (STRINGWIDTH INFO FONT)) MAXWIDTH)) do (if DATEP then (RETURN WIDTH)) (SETQ MAXWIDTH WIDTH) finally (RETURN MAXWIDTH)))
)
)
(DECLARE%: EVAL@COMPILE DONTCOPY
(FILESLOAD (SOURCE) TABLEBROWSERDECLS)
(DECLARE%: EVAL@COMPILE
(RECORD INFOFIELD (INFONAME INFOLABEL INFOWIDTH INFOFORMAT INFOPROTOTYPE))
(DATATYPE FBFILEDATA ((FILENAME POINTER) (* ; "Full name of this file") (FILEINFO POINTER) (* ; "Plist of attributes") (VERSIONLESSNAME POINTER) (* ; "FILENAME sans version") (DIRECTORYP FLAG) (* ; "True if it's a directory line") (HASDIRPREFIX FLAG) (* ; "True if it has a directory prefix beyond that in common to all the files") (DIRECTORYFILEP FLAG) (* ; "True if the %"file%" in this item is actually a subdirectory") (NIL 5 FLAG) (SIZE POINTER) (* ; "Size of file, for stats") (FILEDEPTH BYTE) (* ; "Number of levels of subdirectory beneath the main pattern--zero for files at that level") (SORTVALUE POINTER) (* ; "Cached value by which we are sorting the dir.") (SUBDIREND WORD) (* ; "Index of last char in subdirectory, or zero if HASDIRPREFIX is false") (STARTOFPNAME WORD) (* ; "Start of name for printing purposes. Same as STARTOFNAME when browser sorted by name") (VERSION WORD) (* ; "Version, or zero if none") (STARTOFNAME WORD) (* ; "Index beyond all directory fields"))
(ACCESSFNS FBFILEDATA ((PRINTNAME (SUBSTRING (FETCH (FBFILEDATA FILENAME) OF DATUM) (FETCH (FBFILEDATA STARTOFPNAME) OF DATUM))) (SUBDIRECTORY (SUBSTRING (FETCH (FBFILEDATA FILENAME) OF DATUM) 1 (FETCH (FBFILEDATA SUBDIREND) OF DATUM)))))
)
(DATATYPE FILEBROWSER ((NOSUBDIRECTORIES FLAG) (* ; "True if we don't want separate subdirectory lines -- subdirs then included in name") (NSPATTERN? FLAG) (* ; "True if host is an ns host") (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") (FBREADY FLAG) (* ; "False while FB is enumerating.") (ABORTING FLAG) (* ; "True if enumeration is being aborted") (FIXEDTITLE FLAG) (* ; "True if caller supplied title") (TABLEBROWSER POINTER) (* ; "Pointer to TABLEBROWSER object controlling the browser") (FBDISPLAYEDDEPTH BYTE) (* ; "Depth we are currently displaying (zero for infinite)") (BROWSERWINDOW POINTER) (* ; "Main window") (FBCOMPUTEDDEPTH BYTE) (* ; "Depth at the time we enumerated directory (zero for infinite)") (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 attribute specs 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) (FBLOCK POINTER) (* ; "Lock acquired by filebrowser operations") (SORTINDEX WORD) (* ; "Index (zero-based) in file info of the sort attribute") (SIZEINDEX WORD) (* ; "Index of size attribute") (FBDEPTH POINTER) (* ; "Enumeration depth, or NIL for default") (ABORTWINDOW POINTER) (* ; "Dotted pair of (abortwindow . menuw) for this browser's abort window."))
)
)
(/DECLAREDATATYPE (QUOTE FBFILEDATA) (QUOTE (POINTER POINTER POINTER FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER BYTE POINTER WORD WORD WORD WORD)) (QUOTE ((FBFILEDATA 0 POINTER) (FBFILEDATA 2 POINTER) (FBFILEDATA 4 POINTER) (FBFILEDATA 4 (FLAGBITS . 0)) (FBFILEDATA 4 (FLAGBITS . 16)) (FBFILEDATA 4 (FLAGBITS . 32)) (FBFILEDATA 4 (FLAGBITS . 48)) (FBFILEDATA 4 (FLAGBITS . 64)) (FBFILEDATA 4 (FLAGBITS . 80)) (FBFILEDATA 4 (FLAGBITS . 96)) (FBFILEDATA 4 (FLAGBITS . 112)) (FBFILEDATA 6 POINTER) (FBFILEDATA 6 (BITS . 7)) (FBFILEDATA 8 POINTER) (FBFILEDATA 10 (BITS . 15)) (FBFILEDATA 11 (BITS . 15)) (FBFILEDATA 12 (BITS . 15)) (FBFILEDATA 13 (BITS . 15)))) (QUOTE 14))
(/DECLAREDATATYPE (QUOTE FILEBROWSER) (QUOTE (FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER BYTE POINTER BYTE 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 WORD WORD 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 (BITS . 7)) (FILEBROWSER 2 POINTER) (FILEBROWSER 4 (BITS . 7)) (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) (FILEBROWSER 56 (BITS . 15)) (FILEBROWSER 57 (BITS . 15)) (FILEBROWSER 58 POINTER) (FILEBROWSER 60 POINTER))) (QUOTE 62))
(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.DIRECTORYP MACRO ((FILEDATA) (EQ (FETCH (FBFILEDATA SUBDIREND) OF FILEDATA) 0)))
(PUTPROPS EQ.DIRECTORYP MACRO (OPENLAMBDA (FD1 FD2) (STRING-EQUAL (fetch (FBFILEDATA FILENAME) of FD1) (fetch (FBFILEDATA FILENAME) of FD2) :END1 (fetch (FBFILEDATA SUBDIREND) of FD1) :END2 (fetch (FBFILEDATA SUBDIREND) of FD2))))
(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.HARDCOPY.FONT FB.HARDCOPY.DIRECTORY.FONT FB.EXPUNGE?MENU FB.CLOSE.MENU.ITEMS FB.DEPTH.MENU.ITEMS FB.MENU.ITEMS FB.DEFAULT.INFO FB.INFOSHADE FB.INFO.MENU.ITEMS FB.ITEMUNSELECTEDSHADE FB.ITEMSELECTEDSHADE DIRCOMMANDS FB.PROMPTLINES FB.INFO.FIELDS WindowTitleDisplayStream FB.ICONSPEC FB.DEFAULT.NAME.WIDTH FB.OVERFLOW.MAXABSOLUTE FB.OVERFLOW.MAXFRAC FB.DEFAULT.EDITOR)
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
)
(/DECLAREDATATYPE (QUOTE FILEBROWSER) (QUOTE (FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER BYTE POINTER BYTE 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 WORD WORD 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 (BITS . 7)) (FILEBROWSER 2 POINTER) (FILEBROWSER 4 (BITS . 7)) (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) (FILEBROWSER 56 (BITS . 15)) (FILEBROWSER 57 (BITS . 15)) (FILEBROWSER 58 POINTER) (FILEBROWSER 60 POINTER))) (QUOTE 62))
(/DECLAREDATATYPE (QUOTE FBFILEDATA) (QUOTE (POINTER POINTER POINTER FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER BYTE POINTER WORD WORD WORD WORD)) (QUOTE ((FBFILEDATA 0 POINTER) (FBFILEDATA 2 POINTER) (FBFILEDATA 4 POINTER) (FBFILEDATA 4 (FLAGBITS . 0)) (FBFILEDATA 4 (FLAGBITS . 16)) (FBFILEDATA 4 (FLAGBITS . 32)) (FBFILEDATA 4 (FLAGBITS . 48)) (FBFILEDATA 4 (FLAGBITS . 64)) (FBFILEDATA 4 (FLAGBITS . 80)) (FBFILEDATA 4 (FLAGBITS . 96)) (FBFILEDATA 4 (FLAGBITS . 112)) (FBFILEDATA 6 POINTER) (FBFILEDATA 6 (BITS . 7)) (FBFILEDATA 8 POINTER) (FBFILEDATA 10 (BITS . 15)) (FBFILEDATA 11 (BITS . 15)) (FBFILEDATA 12 (BITS . 15)) (FBFILEDATA 13 (BITS . 15)))) (QUOTE 14))
(ADDTOVAR SYSTEMRECLST
(DATATYPE FILEBROWSER ((NOSUBDIRECTORIES FLAG) (NSPATTERN? FLAG) (SHOWUNDELETED? FLAG) (PATTERNPARSED? FLAG) (SORTBYDATE FLAG) (FBREADY FLAG) (ABORTING FLAG) (FIXEDTITLE FLAG) (TABLEBROWSER POINTER) (FBDISPLAYEDDEPTH BYTE) (BROWSERWINDOW POINTER) (FBCOMPUTEDDEPTH BYTE) (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) (FBLOCK POINTER) (SORTINDEX WORD) (SIZEINDEX WORD) (FBDEPTH POINTER) (ABORTWINDOW POINTER))
)
(DATATYPE FBFILEDATA ((FILENAME POINTER) (FILEINFO POINTER) (VERSIONLESSNAME POINTER) (DIRECTORYP FLAG) (HASDIRPREFIX FLAG) (DIRECTORYFILEP FLAG) (NIL 5 FLAG) (SIZE POINTER) (FILEDEPTH BYTE) (SORTVALUE POINTER) (SUBDIREND WORD) (STARTOFPNAME WORD) (VERSION WORD) (STARTOFNAME WORD))
)
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(COND ((EQ MAKESYSNAME :LYRIC) (* ; "Get patches for ignore-errors") (FILESLOAD (SYSLOAD) MVALUESPATCH)))
(MOVD? (QUOTE PROMPTFORWORD) (QUOTE TTYINPROMPTFORWORD) NIL T)
(ADDTOVAR *ATTACHED-WINDOW-COMMAND-SYNONYMS* (HARDCOPYIMAGEW.TOFILE . HARDCOPYIMAGEW) (HARDCOPYIMAGEW.TOPRINTER . HARDCOPYIMAGEW)
)
(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.PROMPTW.FORMAT FB.PROMPTWPRINT)
)
(PUTPROPS FILEBROWSER COPYRIGHT ("Xerox Corporation" 1983 1984 1985 1986 1987 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (12044 22260 (FB 12054 . 12589) (FILEBROWSER 12591 . 18678) (FB.TABLEBROWSER 18680 .
18836) (FB.SELECTEDFILES 18838 . 19284) (FB.FETCHFILENAME 19286 . 19509) (FB.PROMPTWPRINT 19511 .
19947) (FB.PROMPTW.FORMAT 19949 . 20460) (FB.PROMPTFORINPUT 20462 . 21700) (FB.ALLOW.ABORT 21702 .
22258)) (22283 22929 (FB.STARTUP 22293 . 22579) (FB.MAKERIGIDWINDOW 22581 . 22927)) (22930 25666 (
FB.PRINTFN 22940 . 25526) (FB.COPYFN 25528 . 25664)) (25715 29027 (FB.MENU.WHENSELECTEDFN 25725 .
26009) (FB.COMMANDSELECTEDFN 26011 . 26851) (FB.SUBITEMP 26853 . 27156) (FB.MAKE.BROWSER.BUSY 27158 .
27555) (FB.FINISH.COMMAND 27557 . 28444) (FB.HANDLE.ABORT.BUTTON 28446 . 29025)) (29028 31452 (
FB.DELETECOMMAND 29038 . 29233) (FB.DELVERCOMMAND 29235 . 30389) (FB.IS.NOT.SUBDIRECTORY.ITEM 30391 .
30513) (FB.DELVER.FILES 30515 . 31067) (FB.DELETE.FILE 31069 . 31450)) (31453 32248 (
FB.UNDELETECOMMAND 31463 . 31662) (FB.UNDELETEALLCOMMAND 31664 . 31857) (FB.UNDELETE.FILE 31859 .
32246)) (32249 42591 (FB.COPYCOMMAND 32259 . 32393) (FB.RENAMECOMMAND 32395 . 32535) (
FB.COPY/RENAME.COMMAND 32537 . 33054) (FB.COPY/RENAME.ONE 33056 . 34110) (FB.COPY/RENAME.MANY 34112 .
36967) (FB.GREATEST.PREFIX 36969 . 37609) (FB.MAYBE.INSERT.FILE 37611 . 40995) (FB.GET.NEW.FILE.SPEC
40997 . 42589)) (42592 46099 (FB.HARDCOPYCOMMAND 42602 . 43202) (FB.HARDCOPY.TOFILE 43204 . 46097)) (
46100 50153 (FB.EDITCOMMAND 46110 . 47387) (FB.EDITLISPFILE 47389 . 47976) (FB.BROWSECOMMAND 47978 .
50151)) (50154 54913 (FB.FASTSEECOMMAND 50164 . 51434) (FB.FASTSEE.ONEFILE 51436 . 52664) (
FB.SEEFULLFN 52666 . 54263) (FB.SEEBUTTONFN 54265 . 54911)) (54914 56019 (FB.LOADCOMMAND 54924 . 55229
) (FB.COMPILECOMMAND 55231 . 55570) (FB.OPERATE.ON.FILES 55572 . 56017)) (56020 78692 (
FB.UPDATECOMMAND 56030 . 56186) (FB.MAYBE.EXPUNGE 56188 . 56775) (FB.UPDATEBROWSERITEMS 56777 . 62880)
(FB.DATE 62882 . 63268) (FB.ADJUST.DATE.WIDTH 63270 . 64529) (FB.SET.BROWSER.TITLE 64531 . 65102) (
FB.MAYBE.WIDEN.NAMES 65104 . 66049) (FB.SET.DEFAULT.NAME.WIDTH 66051 . 66602) (FB.CREATE.FILEBUCKET
66604 . 70106) (FB.CHECK.NAME.LENGTH 70108 . 71559) (FB.ADD.FILEGROUP 71561 . 72510) (
FB.INSERT.DIRECTORY 72512 . 72720) (FB.MAKE.SUBDIRECTORY.ITEM 72722 . 73504) (FB.ADD.FILE 73506 .
73933) (FB.INSERT.FILE 73935 . 75770) (FB.ANALYZE.PATTERN 75772 . 77980) (FB.GETALLFILEINFO 77982 .
78690)) (78693 82911 (FB.SORT.VERSIONS 78703 . 79753) (FB.DECREASING.VERSION 79755 . 80126) (
FB.INCREASING.VERSION 80128 . 80496) (FB.NAMES.DECREASING.VERSION 80498 . 81021) (
FB.NAMES.INCREASING.VERSION 81023 . 81541) (FB.DECREASING.NUMERIC.ATTR 81543 . 82018) (
FB.INCREASING.NUMERIC.ATTR 82020 . 82489) (FB.ALPHABETIC.ATTR 82491 . 82909)) (82912 87321 (
FB.SORTCOMMAND 82922 . 85819) (FB.INSERT.SUBDIRECTORIES 85821 . 86230) (FB.GET.SORT.MENU 86232 . 87319
)) (87322 95532 (FB.EXPUNGECOMMAND 87332 . 88297) (FB.NEWPATTERNCOMMAND 88299 . 88565) (
FB.NEWINFOCOMMAND 88567 . 89771) (FB.DEPTHCOMMAND 89773 . 90549) (FB.SHAPECOMMAND 90551 . 92408) (
FB.REMOVE.FILE 92410 . 93556) (FB.COUNT.FILE.CHANGE 93558 . 94300) (FB.SETNEWPATTERN 94302 . 95016) (
FB.GET.NEWPATTERN 95018 . 95356) (FB.OPTIONSCOMMAND 95358 . 95530)) (95566 96138 (
FB.INFOMENU.SHADEINITIALSELECTIONS 95576 . 95917) (FB.INFO.ITEM.NAMED 95919 . 96136)) (96139 100758 (
FB.MAKECOUNTERWINDOW 96149 . 96795) (FB.COUNTERW.REDISPLAYFN 96797 . 97145) (FB.UPDATE.COUNTERS 97147
. 98356) (FB.DISPLAY.COUNTERS 98358 . 100563) (FB.COUNTER.STRING 100565 . 100756)) (100759 103274 (
FB.MAKEHEADINGWINDOW 100769 . 101533) (FB.HEADINGW.REDISPLAYFN 101535 . 101712) (FB.HEADINGW.RESHAPEFN
101714 . 101995) (FB.HEADINGW.DISPLAY 101997 . 103272)) (103275 105888 (FB.ICONFN 103285 . 103500) (
FB.INFOMENU.WHENSELECTEDFN 103502 . 104014) (FB.CLOSEFN 104016 . 104634) (FB.EXPUNGE?.MENU 104636 .
104888) (FB.AFTERCLOSEFN 104890 . 105167) (FB.CLOSE&EXPUNGE 105169 . 105886)) (105889 111795 (
FB.HARDCOPY.DIRECTORY 105899 . 110809) (FB.HARDCOPY.PRINT.TITLE 110811 . 111057) (FB.HARDCOPY.MAXWIDTH
111059 . 111793)))))
STOP