diff --git a/library/FILEBROWSER b/library/FILEBROWSER
index 045202a0..75e82857 100644
--- a/library/FILEBROWSER
+++ b/library/FILEBROWSER
@@ -1 +1 @@
-(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
(FILECREATED "25-Feb-2021 13:24:50" 
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>FILEBROWSER.;27| 258499 

      |changes| |to:|  (FNS FB.EDITCOMMAND.ONEFILE)

      |previous| |date:| "22-Feb-2021 12:41:59" 
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>FILEBROWSER.;25|)


; Copyright (c) 1983-1991, 1993-1994, 1999-2001, 2021 by Venue & Xerox Corporation.

(PRETTYCOMPRINT FILEBROWSERCOMS)

(RPAQQ FILEBROWSERCOMS
       ((COMS (DECLARE\: EVAL@COMPILE DONTCOPY (P (CL:UNLESS (GETP 'EXPORTS.ALL 'FILE)
                                                      (TERPRI T)
                                                      (PRIN1 
                                                            "NOTE:  FILEBROWSER requires EXPORTS.ALL"
                                                             T)
                                                      (TERPRI T)
                                                      (TERPRI T))))
              (FILES ATTACHEDWINDOW ICONW TABLEBROWSER)
              (P 
                 (* |;;| "Set up for MODERNIZE windows, whether or not MODERNIZE is pre-loaded")

                 (MOVD? 'NILL 'TOTOPW.MODERNIZE))
              
              (* |;;| "JDS 11/94 FB.ICONSPEC is now an INITVAR so we can create smaller ones in profiles for, e.g., laptops.")

              (INITVARS (FB.EXPUNGE?MENU)
                     (FB.BROWSERFONT DEFAULTFONT)
                     (FB.BROWSER.DIRECTORY.FONT BOLDFONT)
                     (FB.PROMPTFONT LITTLEFONT)
                     (FB.HARDCOPY.FONT)
                     (FB.HARDCOPY.DIRECTORY.FONT)
                     (FB.PROMPTLINES 3)
                     (FB.MENUFONT MENUFONT)
                     (FB.OVERFLOW.MAXABSOLUTE 30)
                     (FB.OVERFLOW.MAXFRAC 0.06)
                     (FB.DEFAULT.EDITOR 'TEDIT)
                     (FB.DEFAULT.INFO '(SIZE CREATIONDATE AUTHOR)))
              (APPENDVARS (FONTVARS (FB.ICONFONT LITTLEFONT)
                                 (FB.BROWSERFONT DEFAULTFONT)
                                 (FB.PROMPTFONT LITTLEFONT)
                                 (FB.BROWSER.DIRECTORY.FONT BOLDFONT)))
              (P 
                 (* |;;| "FONTSET fills in the variables in FONTVARS for us, so do it.")

                 (FONTSET (FONTSET)))
              (ADDVARS (CACHEDMENUS FB.EXPUNGE?MENU))
              (INITVARS (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)"
                                                (SUBITEMS ("Copy using TEXT FileType" 
                                                                 FB.COPYTEXTCOMMAND 
                                      "Forces the copying of selected files to be done as TEXT-files"
                                                                 )
                                                       ("Copy using BINARY FileType" 
                                                              FB.COPYBINARYCOMMAND 
                                    "Forces the copying of selected files to be done as BINARY-files"
                                                              )))
                                         (|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.EDITCOMMAND READONLY)
                                                
                                         "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"
                                                ))))
              (VARS FB.VERSION.MENU.ITEMS FB.CLOSE.MENU.ITEMS FB.DEPTH.MENU.ITEMS FB.INFO.MENU.ITEMS
                    FB.DEFAULT.NAME.WIDTH FB.INFO.FIELDS FB.INFOSHADE FB.ITEMUNSELECTEDSHADE 
                    FB.ITEMSELECTEDSHADE))
        (COMS                                                (* \; "Entries")
              (COMMANDS "fb")
              (FNS FB FB.COPYBINARYCOMMAND FB.COPYTEXTCOMMAND FILEBROWSER FB.TABLEBROWSER 
                   FB.SELECTEDFILES FB.FETCHFILENAME FB.DIRECTORYP FB.PROMPTWPRINT FB.PROMPTW.FORMAT
                   FB.PROMPTFORINPUT FB.YES-OR-NO-P FB.ALLOW.ABORT \\FB.HARDCOPY.TOFILE.EXTENSION)
                                                             (* \; "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.MERGE.DIRECTORIES FB.GREATEST.PREFIX FB.MAYBE.INSERT.FILE 
                   FB.GET.NEW.FILE.SPEC FB.CANONICAL.DIRECTORY)
              (FNS FB.HARDCOPYCOMMAND FB.HARDCOPY.TOFILE)
              (FNS FB.EDITCOMMAND FB.EDITCOMMAND.ONEFILE 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.CANONICALIZE.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 FB.BROWSER.DIRECTORY.FONT ITALICFONT PRINTFILETYPES)
               (LOCALVARS . T))
        (INITRECORDS FILEBROWSER FBFILEDATA)
        (SYSRECORDS FILEBROWSER FBFILEDATA)
        (DECLARE\: DONTEVAL@LOAD DOCOPY (P (MOVD? 'PROMPTFORWORD 'TTYINPROMPTFORWORD NIL T))
               (ADDVARS (*ATTACHED-WINDOW-COMMAND-SYNONYMS* (HARDCOPYIMAGEW.TOFILE . HARDCOPYIMAGEW)
                               (HARDCOPYIMAGEW.TOPRINTER . HARDCOPYIMAGEW))
                      (|BackgroundMenuCommands| ("FileBrowser" '(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)))
        ))
(DECLARE\: EVAL@COMPILE DONTCOPY 

(CL:UNLESS (GETP 'EXPORTS.ALL 'FILE)
    (TERPRI T)
    (PRIN1 "NOTE:  FILEBROWSER requires EXPORTS.ALL" T)
    (TERPRI T)
    (TERPRI T))
)

(FILESLOAD ATTACHEDWINDOW ICONW TABLEBROWSER)


(* |;;| "Set up for MODERNIZE windows, whether or not MODERNIZE is pre-loaded")


(MOVD? 'NILL 'TOTOPW.MODERNIZE)



(* |;;| 
"JDS 11/94 FB.ICONSPEC is now an INITVAR so we can create smaller ones in profiles for, e.g., laptops."
)


(RPAQ? FB.EXPUNGE?MENU )

(RPAQ? FB.BROWSERFONT DEFAULTFONT)

(RPAQ? FB.BROWSER.DIRECTORY.FONT BOLDFONT)

(RPAQ? FB.PROMPTFONT LITTLEFONT)

(RPAQ? FB.HARDCOPY.FONT )

(RPAQ? FB.HARDCOPY.DIRECTORY.FONT )

(RPAQ? FB.PROMPTLINES 3)

(RPAQ? FB.MENUFONT MENUFONT)

(RPAQ? FB.OVERFLOW.MAXABSOLUTE 30)

(RPAQ? FB.OVERFLOW.MAXFRAC 0.06)

(RPAQ? FB.DEFAULT.EDITOR 'TEDIT)

(RPAQ? FB.DEFAULT.INFO '(SIZE CREATIONDATE AUTHOR))

(APPENDTOVAR FONTVARS (FB.ICONFONT LITTLEFONT)
                          (FB.BROWSERFONT DEFAULTFONT)
                          (FB.PROMPTFONT LITTLEFONT)
                          (FB.BROWSER.DIRECTORY.FONT BOLDFONT))


(* |;;| "FONTSET fills in the variables in FONTVARS for us, so do it.")


(FONTSET (FONTSET))

(ADDTOVAR CACHEDMENUS FB.EXPUNGE?MENU)

(RPAQ? 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)"
                (SUBITEMS ("Copy using TEXT FileType" FB.COPYTEXTCOMMAND 
                                 "Forces the copying of selected files to be done as TEXT-files")
                       ("Copy using BINARY FileType" FB.COPYBINARYCOMMAND 
                              "Forces the copying of selected files to be done as BINARY-files")))
         (|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.EDITCOMMAND READONLY)
                "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.VERSION.MENU.ITEMS (("1" 1 "Keep only one version of the files")
                                  ("2" 2 "Keep two versions of the files")
                                  ("3" 3 "Keep three versions of the files")
                                  ("4" 4 "Keep four versions of the files")
                                  ("Other" :NUMBER "Select number of versions to keep")))

(RPAQQ FB.CLOSE.MENU.ITEMS (("Expunge deleted files" 'EXPUNGE 
                                       "Erases all files still marked 'deleted'")
                                ("Don't expunge" '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.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)



(* \; "Entries")


(DEFCOMMAND "fb" (&REST PAT&PROPS) (APPLY '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 `(,(FUNCTION FILEBROWSER)
                               ',PAT
                               ',PROPS
                               ',OPTIONS)
                       'NAME
                       'FB)))
    NIL))

(FB.COPYBINARYCOMMAND
  (LAMBDA (BROWSER)                                          (* \; 
                                                           "Edited 19-Oct-90 18:18 by gadener")
    (FB.COPY/RENAME.COMMAND BROWSER '|Copy| (CONS (FUNCTION COPYFILE)
                                                      '((TYPE BINARY))))))

(FB.COPYTEXTCOMMAND
  (LAMBDA (BROWSER)                                          (* \; 
                                                           "Edited 19-Oct-90 18:55 by gadener")
    (FB.COPY/RENAME.COMMAND BROWSER '|Copy| (CONS (FUNCTION COPYFILE)
                                                      '((TYPE TEXT))))))

(FILEBROWSER
  (LAMBDA (FILESPEC ATTRIBUTES OPTIONS)                      (* \; "Edited 30-Aug-94 19:45 by jds")
    (PROG ((TITLEFONT (DSPFONT NIL |WindowTitleDisplayStream|))
           (BROWSERFONTHEIGHT (FONTPROP FB.BROWSERFONT '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
                                                                                  'HEIGHT))))
                 (SETQ COUNTERHEIGHT (HEIGHTIFWINDOW (FONTPROP TITLEFONT '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 '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| (FILEBROWSER 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 'RIGHT '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 _ '(("--Abort--" NIL 
                                                            "Abort the current FileBrowser operation"
                                                                  ))
                                                 CENTERFLG _ T
                                                 MENUOUTLINESIZE _ 2
                                                 MENUFONT _ (FONTCOPY FB.MENUFONT 'WEIGHT
                                                                   '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 'PASSTOMAINCOMS)))
             |do|                                        (* \; 
                                    "Make all these subwindows pass hardcopy on to the main window")
                   (WINDOWPROP W 'PASSTOMAINCOMS (UNION '(HARDCOPYIMAGEW)
                                                        OLDCOMS)))
          (|replace| (FILEBROWSER TABLEBROWSER) |of| BROWSER
             |with| (TB.MAKE.BROWSER NIL BROWSERWINDOW (LIST 'PRINTFN (FUNCTION FB.PRINTFN)
                                                                 'COPYFN
                                                                 (FUNCTION FB.COPYFN)
                                                                 'USERDATA BROWSER 'CLOSEFN
                                                                 (FUNCTION FB.CLOSEFN)
                                                                 'AFTERCLOSEFN
                                                                 (FUNCTION FB.AFTERCLOSEFN)
                                                                 'HEADINGWINDOW HEADINGWINDOW)))
          (WINDOWPROP BROWSERWINDOW 'HARDCOPYFN (FUNCTION FB.HARDCOPY.DIRECTORY))
          (WINDOWPROP BROWSERWINDOW '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 `(,(FUNCTION FB.STARTUP)
                                   ',BROWSER
                                   ',COMMANDMENU
                                   ',(FUNCTION FB.UPDATEBROWSERITEMS))
                           'NAME
                           '|FB-Update|
                           'BEFOREEXIT
                           'DON\'T))
          (RETURN BROWSERWINDOW))))

(FB.TABLEBROWSER
  (LAMBDA (BROWSER)                                          (* \; "Edited  4-Feb-88 23:13 by bvm:")
    (|ffetch| (FILEBROWSER TABLEBROWSER) |of| (\\DTEST BROWSER '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
                                                                                       'FILEBROWSER))
               '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
                                                                                     'TABLEITEM)))))

(FB.DIRECTORYP
  (LAMBDA (FILE)                                       (* \; "Edited 20-Feb-2021 20:05 by rmk:")

    (* |;;| "Does FILE denote a directory?")

    (CL:WHEN (TYPE? TABLEITEM FILE)
        (SETQ FILE (FETCH TIDATA OF FILE)))
    (|fetch| (FBFILEDATA DIRECTORYFILEP) |of| FILE)))

(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)
                                                                                     '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
                                                                                    '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 22-Nov-88 15:33 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
                                                                                 'FILEBROWSER)))
           (PROMPTWIDTH (STRINGWIDTH PROMPT PWINDOW))
           (WINDOWWIDTH (WINDOWPROP PWINDOW '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))
                                                      (CONSTANT (CHARACTER (CHARCODE CR)))
                                                      (SUBSTRING PROMPT (ADD1 I))))))))
          (SETQ RESULT (CAR (NLSETQ (TTYINPROMPTFORWORD PROMPT DEFAULT NIL PWINDOW NIL 'TTY
                                           (CHARCODE (CR))))))
          (WINDOWPROP PWINDOW 'PROCESS NIL)                  (* \; 
                                                           "Get rid of process from prompt window")
          (COND
             ((AND (NULL RESULT)
                   ABORTFLG)
              (PRINTOUT PWINDOW "... aborted")))
          (TERPRI PWINDOW)
          RESULT)))

(FB.YES-OR-NO-P
  (LAMBDA (PROMPT FBROWSER DEFAULT)                          (* \; "Edited 22-Nov-88 15:30 by bvm")

    (* |;;| 
  "Return Y, N or NIL, indicating whether response to question is Yes, No or some kind of abort")

    (LET ((ANSWER (FB.PROMPTFORINPUT PROMPT (SELECTQ DEFAULT
                                                    (Y "Yes")
                                                    (N "No")
                                                    NIL)
                         FBROWSER T T)))
         (COND
            ((NULL ANSWER)                                   (* \; "Aborted")
             NIL)
            ((OR (STRING-EQUAL ANSWER "YES")
                 (STRING-EQUAL ANSWER "Y"))
             'Y)
            ((OR (STRING-EQUAL ANSWER "NO")
                 (STRING-EQUAL ANSWER "N"))
             'N)
            (T (FB.PROMPTWPRINT FBROWSER "?? ...Aborted.")
                                                             (* \; "Confused somehow")
               NIL)))))

(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 'FILEBROWSER)
       |with| (THIS.PROCESS))
    (LET ((W (|ffetch| (FILEBROWSER ABORTWINDOW) |of| BROWSER)))
         (|if| (NOT (OPENWP (CAR W)))
             |then| (ATTACHWINDOW (CAR W)
                               (CDR W)
                               'BOTTOM)                      (* \; 
                                                     "And repaint it in case it was used last time")
                   (REDISPLAYW (CAR W))))))

(\\FB.HARDCOPY.TOFILE.EXTENSION
  (LAMBDA NIL                                                (* \; 
                                                           "Edited 25-Feb-91 15:15 by gadener")
    (LET ((TYPE (PRINTERTYPE)))
         (CASE TYPE
             (INTERPRESS 'IP)
             (POSTSCRIPT 'PS)
             (DEFAULT TYPE)))))
)



(* \; "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 '|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 'REGION))))
         (WINDOWPROP WINDOW 'MINSIZE (CONS 0 HEIGHT))
         (WINDOWPROP WINDOW 'MAXSIZE (CONS SCREENWIDTH HEIGHT))
         WINDOW)))
)
(DEFINEQ

(FB.PRINTFN
  (LAMBDA (TBROWSER ITEM WINDOW)                             (* \; "Edited 30-Aug-94 19:12 by jds")
    (LET ((FBROWSER (TB.USERDATA TBROWSER))
          (FDATA (|fetch| TIDATA |of| ITEM))
          (STREAM (WINDOWPROP WINDOW 'DSP))
          NEXTPOS INFO OLDFONT)
         (COND
            ((|fetch| (FBFILEDATA DIRECTORYP) |of| FDATA)
             (PRIN3 "  " STREAM)
             (|if| FB.BROWSER.DIRECTORY.FONT
                 |then| (SETQ OLDFONT (DSPFONT FB.BROWSER.DIRECTORY.FONT 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| (INFOFIELD 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 '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| (INFOFIELD INFOWIDTH) |of| SPEC)))
         (TB.CLEAR.LINE TBROWSER ITEM (DSPXPOSITION NIL STREAM))
         (AND OLDFONT (DSPFONT OLDFONT STREAM)))))

(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 `(,(FUNCTION FB.COMMANDSELECTEDFN)
                   ',ITEM
                   ',MENU
                   ',KEY)
           'NAME
           (PACK* 'FB- (CAR ITEM))
           'BEFOREEXIT
           'DON\'T)))

(FB.COMMANDSELECTEDFN
  (LAMBDA (ITEM MENU KEY)                                    (* \; "Edited 12-Jan-87 12:57 by bvm:")
    (RESETLST
        (LET* ((REALITEM ITEM)
               (WINDOW (WINDOWPROP (WFROMMENU MENU)
                              'MAINWINDOW))
               (FBROWSER (WINDOWPROP WINDOW '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))
                      '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
                                                                                   '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)
                          '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 15-Feb-91 17:19 by gadener")
    (LET (NVERSIONS TBROWSER NDELETED FILES)
         (|if| (EQ (SETQ NVERSIONS
                        (MENU (|create| MENU
                                     TITLE _ "Versions to keep ?"
                                     ITEMS _ FB.VERSION.MENU.ITEMS
                                     CENTERFLG _ T)))
                       :NUMBER)
             |then| (FB.ALLOW.ABORT FBROWSER)
                   (SETQ NVERSIONS (RNUMBER "Number of versions to keep ?" NIL NIL NIL T NIL T)))
         (COND
            ((NOT NVERSIONS)
             NIL)
            ((NOT (FIXP (SETQ NVERSIONS (MKATOM NVERSIONS))))
             (FB.PROMPTW.FORMAT FBROWSER "~%?? ~A not an integer." NVERSIONS))
            ((EQ NVERSIONS 0)
             NIL)
            (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 '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)                                          (* \; 
                                                           "Edited 19-Oct-90 17:44 by gadener")
    (FB.COPY/RENAME.COMMAND BROWSER '|Copy| (CONS (FUNCTION COPYFILE)))))

(FB.RENAMECOMMAND
  (LAMBDA (BROWSER)                                          (* \; 
                                                           "Edited 19-Oct-90 18:57 by gadener")
    (FB.COPY/RENAME.COMMAND BROWSER '|Rename| (CONS (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 19-Oct-90 17:50 by gadener")

(* |;;;| 
"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 (CAR MOVEFN)
                                 OLDNAME NEWNAME (CDR MOVEFN)))
           (COND
              (ACTUALNEWNAME (FB.PROMPTW.FORMAT FBROWSER "~%~A ~Aed to ~A" OLDNAME
                                    (SELECTQ CMD
                                        (|Copy| "copi")
                                        (|Rename| "renam")
                                        (SHOULDNT))
                                    ACTUALNEWNAME)
                     (LET ((CHANGETYPE (COND
                                          ((EQ CMD '|Rename|)
                                           (FB.REMOVE.FILE (|fetch| (FILEBROWSER 
                                                                                   TABLEBROWSER)
                                                                  |of| FBROWSER)
                                                  FBROWSER ITEM)
                                           (COND
                                              ((|fetch| TIDELETED |of| ITEM)
                                               'BOTH)
                                              (T 'TOTAL))))))
                          (COND
                             ((FB.MAYBE.INSERT.FILE FBROWSER ACTUALNEWNAME ITEM CMD)
                                                             (* \; 
                                 "ACTUALNEWNAME belongs in this browser, so TOTAL may have changed")
                              (OR CHANGETYPE (SETQ CHANGETYPE '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 22-Jan-94 20:24 by ")
    (PROG (PREFIX OLDNAME FIELDS SUBDIR FIRSTDATA RETAIN HOST DIR DEVICE)
          (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))
                              'HOST)
                       (LISTGET FIELDS 'DIRECTORY)
                       (LISTGET FIELDS 'DEVICE))
                   (OR (LISTGET FIELDS 'NAME)
                       (LISTGET FIELDS 'EXTENSION)
                       (LISTGET FIELDS 'VERSION)))           (* \; 
                         "Not a pure directory specification, and not just a simple directory name")
              (FB.PROMPTWPRINT FBROWSER "Not a well-formed directory specification."))
             ((SETQ PREFIX (FB.CANONICAL.DIRECTORY (\\ADD.CONNECTED.DIR PREFIX)
                                  FBROWSER CMD))
              (SETQ HOST (LISTGET (SETQ FIELDS (UNPACKFILENAME.STRING PREFIX))
                                'HOST))
              (SETQ DIR (OR (LISTGET FIELDS 'DIRECTORY)
                            (LISTGET FIELDS 'RELATIVEDIRECTORY)))
              (SETQ DEVICE (LISTGET FIELDS 'DEVICE))
              (|replace| (FILEBROWSER DEFAULTDIR) |of| FBROWSER |with| 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
                   (SELECTQ (FB.YES-OR-NO-P
                             (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)))))))
                                    "?")
                             FBROWSER
                             'Y)
                       (NIL                                  (* \; "Aborted")
                            (RETURN))
                       (Y (SETQ SUBDIR (ADD1 (NCHARS SUBDIR)))
                                                             (* \; "First character that changes")
                          T)
                       NIL))))

              (* |;;| "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 'HOST HOST 'DEVICE DEVICE 'DIRECTORY
                                  (|if| (NOT RETAIN)
                                      |then| DIR
                                    |else|               (* \; 
             "Merge destination directory with subdirectory of name between common prefix and root")
                                          (FB.MERGE.DIRECTORIES DIR
                                                 (SUBSTRING OLDNAME SUBDIR
                                                        (SUB1 (|fetch| (FBFILEDATA STARTOFNAME)
                                                                 |of| (|fetch| TIDATA
                                                                             |of| ITEM))))))
                                  'VERSION NIL 'BODY OLDNAME)
                           CMD MOVEFN)))))))

(FB.MERGE.DIRECTORIES
  (LAMBDA (PREFIX RETAIN)                                    (* \; "Edited 22-Jun-90 11:29 by nm")
    (COND
       (PREFIX (|if| RETAIN
                   |then| (CONCAT PREFIX (CL:SECOND \\FILENAME.SYNTAX)
                                     RETAIN)
                 |else| PREFIX))
       (T (|if| RETAIN
              |then| RETAIN
            |else| NIL)))))

(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 19-Oct-90 12:32 by gadener")

(* |;;;| "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)

                  (* |;;| 
                "Need to check that at least the FB pattern is not  longer than the NEWNAME")

                  (GEQ (NCHARS NEWNAME)
                       (SETQ N (SUB1 (|fetch| (FILEBROWSER DIRECTORYSTART) |of| FBROWSER)
                                     )))

                  (* |;;| 
                "Checks for match up to where the directory part start. i.e. the host part")

                  (STRING-EQUAL NEWNAME (|fetch| (FILEBROWSER PATTERN) |of| FBROWSER)
                         :END1 N :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 'VERSION NIL
                                                           '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 'CREATIONDATE (|fetch|
                                                                                   (FILEBROWSER
                                                                                    INFODISPLAYED)
                                                                                     |of| 
                                                                                           FBROWSER))
                                           ))
                                    (NULL (SETQ CRDATE (CL:NTH CRDATE FILEINFO)))
                                    (AND (SETQ CRDATE (IDATE CRDATE))
                                         (SETQ CRDATE2 (GETFILEINFO FULLNAME '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
                                                                      'BODY NEWNAME 'EXTENSION ""
                                                                      '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 '|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 '|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)                              (* \; "Edited 22-Nov-88 16:55 by bvm")

    (* |;;| "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 'DIRECTORY (OR (|fetch| (
                                                                                        FILEBROWSER
                                                                                          DEFAULTDIR)
                                                                               |of| BROWSER)
                                                                            (DIRECTORYNAME T))
                                               'VERSION NIL 'BODY OLDNAME)
                                        BROWSER T)))         (* \; "Aborted")
             NIL)
            ((NULL (SETQ NAMEFIELD (LISTGET (SETQ FIELDS (UNPACKFILENAME.STRING NEWNAME))
                                          'NAME)))           (* \; "Assume directory spec")
             (SETQ NEWNAME (\\ADD.CONNECTED.DIR NEWNAME))
             (|replace| (FILEBROWSER DEFAULTDIR) |of| BROWSER |with| NEWNAME)
             (PACKFILENAME.STRING 'DIRECTORY NEWNAME 'VERSION NIL 'BODY OLDNAME))
            ((AND (EQ (NCHARS NAMEFIELD)
                      0)
                  (OR (NULL (SETQ NAMEFIELD (LISTGET FIELDS 'EXTENSION)))
                      (EQ (NCHARS NAMEFIELD)
                          0)))                               (* \; 
                                                   "Directory spec with some more pieces after it?")
             (FB.PROMPTWPRINT BROWSER "Failed, malformed name")
             NIL)
            (T                                               (* \; "A plain old file name")
               (|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))
               (COND
                  ((SETQ DIR (COND
                                (FIELDS (SETQ DIR (PACKFILENAME.STRING FIELDS))
                                       (FB.CANONICAL.DIRECTORY (COND
                                                                      ((NEQ (CAR FIELDS)
                                                                            'HOST)
                                                                       (\\ADD.CONNECTED.DIR DIR))
                                                                      (T DIR))
                                              BROWSER CMD))
                                (T (DIRECTORYNAME T))))
                   (|replace| (FILEBROWSER DEFAULTDIR) |of| BROWSER |with| DIR)
                   (\\ADD.CONNECTED.DIR NEWNAME))))))))

(FB.CANONICAL.DIRECTORY
  (LAMBDA (DIRNAME FBROWSER CMD)                             (* \; "Edited 22-Nov-88 16:58 by bvm")
    (LET* ((PWINDOW (|ffetch| (FILEBROWSER PROMPTWINDOW) |of| (\\DTEST FBROWSER
                                                                                 'FILEBROWSER)))
           (OLDTTYSTREAM (TTYDISPLAYSTREAM PWINDOW))
           (OLDTTYPROC (TTY.PROCESS (THIS.PROCESS))))        (* \; 
                           "Point tty at our prompt window in case DIRECTORYNAME tries to interact")
          (CL:UNWIND-PROTECT
              (COND
                 ((DIRECTORYNAME DIRNAME NIL 'ASK))
                 ((EQ (FB.YES-OR-NO-P (CL:FORMAT NIL 
                                                 "Directory ~A does not exist yet; ~A anyway?" 
                                                 DIRNAME CMD)
                             FBROWSER)
                      'Y)
                  DIRNAME))
              (TTY.PROCESS OLDTTYPROC)
              (TTYDISPLAYSTREAM OLDTTYSTREAM)
              (WINDOWPROP PWINDOW 'PROCESS NIL)))))
)
(DEFINEQ

(FB.HARDCOPYCOMMAND
  (LAMBDA (BROWSER KEY ITEM MENU OPTION)                     (* \; 
                                                           "Edited 18-Feb-91 10:44 by gadener")

(* |;;;| "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 '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 15-Feb-91 17:13 by gadener")

    (* |;;| "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 'NAME '* 'EXTENSION (
                                                                     \\FB.HARDCOPY.TOFILE.EXTENSION
                                                                           )))
                                (T (PACKFILENAME.STRING 'VERSION NIL 'EXTENSION (
                                                                     \\FB.HARDCOPY.TOFILE.EXTENSION
                                                                                 )
                                          '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 '* (CADR TAIL)))
                                  (|if| (NEQ (CAR TAIL)
                                                 '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
                                                                              'DIRECTORY NIL)))
                  (FB.PROMPTWPRINT BROWSER "Bad pattern -- " MSG)
                  (RETURN))))
             (T (SETQ EXT (U-CASE (FILENAMEFIELD HCOPYFILE 'EXTENSION)))))
          (COND
             ((AND (NULL (SETQ PRINTFILETYPE (|for| TYPE |in| PRINTFILETYPES
                                                |when| (FMEMB EXT (CADR (ASSOC '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
                                                                         'CONVERSION))
                                               FILETYPE NAME FN FIELDS
             |do| (SETQ ITEM (FB.FETCHFILENAME ITEM))
                   (SETQ FILETYPE (OR (PRINTFILETYPE ITEM)
                                      '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
                                                                 'TENEX))
                                             (RPLACA HCOPYTAIL (CONCAT FORE (LISTGET FIELDS
                                                                                   'NAME)
                                                                      AFT))
                                             (CL:APPLY (FUNCTION PACKFILENAME.STRING)
                                                    '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 21-Feb-2021 15:56 by rmk:")
                                                             (* \; "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))
             (IF (DIRECTORYNAMEP FILE)
                 THEN (FB.BROWSECOMMAND BROWSER)
               ELSEIF (GETD 'OPENTEXTSTREAM)
                 THEN (FB.EDITCOMMAND.ONEFILE BROWSER FILE OPTION)
               ELSE (FB.FASTSEECOMMAND BROWSER KEY ITEM MENU)))))

(FB.EDITCOMMAND.ONEFILE
  (LAMBDA (BROWSER FILE OPTION)                        (* \; "Edited 25-Feb-2021 12:31 by rmk:")
                                                             (* \; "Edited  1-Feb-88 19:00 by bvm:")

    (* |;;| "Called when we know that FILE is a file, not a directory, and that TEDIT exists.  If OPTION is READONLY, we don't want to edit, just view.  If FILE is a lisp sourcefile, we execute the font changes by COPY.TEXT.TO.IMAGE")

    (CL:UNLESS OPTION (SETQ OPTION FB.DEFAULT.EDITOR))
    (CL:MULTIPLE-VALUE-BIND
     (IGNORE CONDITION)
     (IGNORE-ERRORS
      (IF (LISPSOURCEFILEP FILE)
          THEN (SELECTQ OPTION
                       ((LISP NIL TEDIT) 
                                         (* |;;| 
"Asks to load prop and edits the coms.  We really don't want to use a text editor on a source file.")

                            
                            (* |;;| "The FUNCALL at the bottom is concerning.")

                            (FB.EDITLISPFILE FILE BROWSER))
                       (READONLY                             (* \; "READONLY on call from SEE")
                                 (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT)
                                        (LET ((NSTR (OPENTEXTSTREAM)))
                                             (COPY.TEXT.TO.IMAGE STREAM NSTR)
                                             (TEDIT NSTR NIL NIL '(READONLY T)))))
                       (CL:FUNCALL OPTION (MKATOM FILE)))
        ELSE (SELECTQ OPTION
                     (READONLY 
                               (* |;;| "From SEE command. We want to be able to scroll around in the content, can't do that if it isn't random access.  So in that case we do a secret NODIRCORE copy and look at that.")

                               (CL:WITH-OPEN-FILE
                                (STREAM FILE :DIRECTION :INPUT)
                                (LET ((NSTR))
                                     (CL:UNLESS (RANDACCESSP STREAM)
                                         (SETQ NSTR (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW NIL
                                                           (LIST (LIST 'TYPE (GETFILEINFO
                                                                              STREAM
                                                                              'TYPE)))))
                                         (COPYBYTES STREAM NSTR))
                                     (TEDIT (OR NSTR STREAM)
                                            NIL NIL '(READONLY T)))))
                     ((TEDIT NIL) 
                          (TEDIT (MKATOM FILE)))
                     (LISP (FB.PROMPTW.FORMAT BROWSER "Failed because not a Lisp source file"))
                     (CL:FUNCALL OPTION (MKATOM FILE)))))
     (|if| CONDITION
         |then| (FB.PROMPTW.FORMAT BROWSER "Failed because ~A" CONDITION)))))

(FB.EDITLISPFILE
  (LAMBDA (FILE BROWSER)                               (* \; "Edited 21-Feb-2021 17:29 by rmk:")
                                                             (* \; "Edited 28-Jan-88 00:38 by bvm")
    (PROG (ROOT)
          (COND
             ((OR (NOT (STRING-EQUAL (CDAR (GETPROP (SETQ ROOT (U-CASE (ROOTFILENAME FILE)))
                                                  'FILEDATES))
                              FILE))
                  (NOT (GET ROOT 'FILE))
                  (NOT (BOUNDP (FILECOMS ROOT))))
              (FB.PROMPTW.FORMAT BROWSER "The file ~A is not loaded or is not current." FILE)
              (COND
                 ((MOUSECONFIRM (CONCAT "(LOAD '" FILE " 'PROP)?   ")
                         NIL
                         (|fetch| (FILEBROWSER PROMPTWINDOW) |of| BROWSER))
                  (EXEC-EVAL `(LOAD ',FILE 'PROP)))
                 (T (RETURN)))))
          (RESETFORM (TTYDISPLAYSTREAM PROMPTWINDOW)
                 (ED ROOT '(FILES :DONTWAIT))))))

(FB.BROWSECOMMAND
  (LAMBDA (BROWSER KEY ITEM MENU OPTION)               (* \; "Edited 20-Feb-2021 20:10 by rmk:")
                                                             (* \; "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 NAME (FB.FETCHFILENAME FILE))
       (|if|
        (OR
         (FB.DIRECTORYP FILE)
         (AND
          (NOT (|fetch| (FILEBROWSER NSPATTERN?) |of| BROWSER))
          (LET*
           ((FIELDS (UNPACKFILENAME.STRING NAME NIL NIL 'TENEX))
            (NAMETAIL (MEMB '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)
                                              '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 'DIRECTORY))
                  (SETQ SUBDIR (CL:APPLY (FUNCTION PACKFILENAME.STRING)
                                      NAMETAIL))
                  (LISTPUT FIELDS 'DIRECTORY
                         (|if| (NULL MAINDIR)
                             |then| SUBDIR
                           |else| (CONCAT MAINDIR (|if| (STRPOS "/" MAINDIR)
                                                          |then| "/"
                                                        |elseif| (STRPOS ">" MAINDIR)
                                                          |then| ">"
                                                        |elseif|
                                                        (EQ (GETHOSTINFO (LISTGET FIELDS 'HOST)
                                                                   'OSTYPE)
                                                            '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 `(,(FUNCTION FILEBROWSER)
                                     ',NAME
                                     ',(MAPCAR (|fetch| (FILEBROWSER INFODISPLAYED)
                                                  |of| BROWSER)
                                              (FUNCTION CAR))
                                     ,@(AND DEPTH `('(:DEPTH ,DEPTH)))))
         |else| (FB.PROMPTW.FORMAT BROWSER "~A is not a directory" NAME)))))
)
(DEFINEQ

(FB.FASTSEECOMMAND
  (LAMBDA (BROWSER KEY ITEM MENU UNFORMATTED)                (* \; "Edited 30-Aug-94 19:46 by jds")
    (PROG ((*UPPER-CASE-FILE-NAMES* NIL)
           FILELIST SEEWINDOW)
          (OR (SETQ FILELIST (FB.SELECTEDFILES BROWSER))
              (RETURN))
          (FB.ALLOW.ABORT BROWSER)
          (COND
             ((AND (NOT (WINDOWP (SETQ SEEWINDOW (|fetch| (FILEBROWSER SEEWINDOW)
                                                    |of| BROWSER))))
                   (FOR FILE IN FILELIST THEREIS 

                                               (* |;;| "Only need a SEE window if there's going to be a file to really SEE, as opposed to directories to browse.")

                                                       (OR (UNPACKFILENAME (FB.FETCHFILENAME
                                                                            FILE)
                                                                  'NAME)
                                                           (UNPACKFILENAME (FB.FETCHFILENAME
                                                                            FILE)
                                                                  'EXTENSION))))
                                                             (* \; "Create the SEE window")
              (SETQ SEEWINDOW (CREATEW NIL "SEE window"))
              (DSPSCROLL T SEEWINDOW)
              (|replace| (FILEBROWSER SEEWINDOW) |of| BROWSER |with| SEEWINDOW)
              (WINDOWPROP SEEWINDOW 'PAGEFULLFN (FUNCTION FB.SEEFULLFN))
              (WINDOWADDPROP SEEWINDOW 'CLOSEFN (FUNCTION (LAMBDA (W)
                                                            (WINDOWPROP W 'INUSE NIL)
                                                            (DEL.PROCESS (WINDOWPROP W 'PROCESS))))))
             )
          (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (WINDOW)
                                           (WINDOWPROP WINDOW 'PROCESS NIL)
                                                             (* \; 
                                                 "Remove process attached here by ttydisplaystream")
                                           (LET ((BUTTONS (WINDOWPROP WINDOW (WINDOWPROP WINDOW
                                                                                    '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 21-Feb-2021 14:46 by rmk:")
                                                           (* \; "Edited 20-Nov-2000 14:23 by rmk:")
                                                             (* \; "Edited 19-Aug-91 13:06 by jds")
    (COND
       ((DIRECTORYNAMEP FILE)

        (* |;;| "We're trying to SEE a directory.  Browse it instead. ")

        (FB.BROWSECOMMAND BROWSER))
       (T 
          (* |;;| "We're really browsing a file here, so SEE it.")

          (CLEARW WINDOW)
          (WINDOWPROP WINDOW 'TITLE (CONCAT "Viewing " FILE))
          (CL:MULTIPLE-VALUE-BIND
           (STREAM CONDITION)
           (IGNORE-ERRORS (OPENSTREAM FILE 'INPUT NIL '((TYPE TEXT)
                                                        (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
                                                                   'TITLE
                                                                   (CONCAT (WINDOWPROP WINDOW
                                                                                  'TITLE)
                                                                          " -- " "Aborted")))
                                                             (CLOSEF STREAM)))
                                                 STREAM WINDOW))
                            (WINDOWPROP WINDOW 'MORETYPE (COND
                                                            (MORE 'YETMOREBUTTONS)
                                                            (T 'LASTMOREBUTTONS)))
                            (COND
                               (UNFORMATTED (COPYCHARS STREAM WINDOW))
                               (T (PFCOPYBYTES STREAM WINDOW)))
                            (WINDOWPROP WINDOW 'TITLE (CONCAT (WINDOWPROP WINDOW 'TITLE)
                                                             " -- " "Finished"))
                            (COND
                               (MORE                         (* \; "Wait for OK to proceed")
                                     (FB.SEEFULLFN (WINDOWPROP WINDOW 'DSP)
                                            '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 'MORETYPE)))))
           (EVENT (WINDOWPROP WINDOW 'MOREEVENT)))
          (COND
             ((NOT BUTTONS)
              (SETQ BUTTONS (|create| MENU
                                   ITEMS _ (SELECTQ PROP
                                               (YETMOREBUTTONS 
                                                    '(("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 
                                                    '((" Next File " NEXT 
                                                             "Go on to view the next file")
                                                      ("Abort" ABORT 
                                                         "Abort the SEE command -- see no more files"
                                                             )))
                                               '((" 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 'MOREEVENT (SETQ EVENT (CREATE.EVENT (WINDOWPROP WINDOW 'TITLE))))))
          (ATTACHWINDOW BUTTONS WINDOW (COND
                                          ((GREATERP (|fetch| (REGION HEIGHT)
                                                        |of| (WINDOWPROP BUTTONS 'REGION))
                                                  (|fetch| (REGION BOTTOM)
                                                     |of| (WINDOWPROP WINDOW 'REGION)))
                                           'TOP)
                                          (T 'BOTTOM))
                 'LEFT)
          (|do| (TOTOPW BUTTONS)
                 (AWAIT.EVENT EVENT) |repeatuntil| (WINDOWPROP WINDOW '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 'MOREOK T)
                    (NOTIFY.EVENT (WINDOWPROP WINDOW 'MOREEVENT)))
              (NEXT                                          (* \; 
                                                   "Throw to the loop that is displaying each file")
                    (PROCESS.EVAL (WINDOWPROP WINDOW 'PROCESS)
                           '(CL:THROW :NEXT)))
              (ABORT                                         (* \; "Kill it")
                     (DEL.PROCESS (WINDOWPROP WINDOW '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))
                           'NAME
                           'LOAD
                           'BEFOREEXIT
                           '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))
                           'NAME
                           'COMPILE
                           'BEFOREEXIT
                           '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 'LOAD))
             NIL)
         (SETQ FORMS (|for| FILEENTRY |in| FILELIST
                        |collect| `(,FN ',(FB.FETCHFILENAME FILEENTRY)
                                            ,@(AND LDFLG `(',LDFLG)))))
         (EXEC-EVAL (|if| (CDR FORMS)
                        |then| (CONS 'PROGN FORMS)
                      |else| (CAR FORMS)))
         (CLOSEW (TTYDISPLAYSTREAM)))))
)
(DEFINEQ

(FB.UPDATECOMMAND
  (LAMBDA (BROWSER)                                          (* |bvm:| "27-Sep-85 12:30")
    (COND
       ((FB.MAYBE.EXPUNGE BROWSER '|Recompute|)
        (FB.UPDATEBROWSERITEMS BROWSER)))))

(FB.MAYBE.EXPUNGE
  (LAMBDA (BROWSER COMMAND)                            (* \; "Edited 22-Feb-2021 12:33 by rmk:")
                                                             (* |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 30-Aug-94 19:46 by jds")
    (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| (FILEBROWSER 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| (INFOFIELD INFONAME) |of| SPEC)
                                       WANTED)
                      |collect| (SETQ SPEC (COPY SPEC))
                            (|if| (SETQ PROTO (|fetch| (INFOFIELD INFOPROTOTYPE) |of|
                                                                                         SPEC))
                                |then|                   (* \; 
                                  "Have prototypical example, use it to get better width estimate.")
                                      (SETQ W (STRINGWIDTH PROTO FONT))
                                      (|replace| (INFOFIELD INFOWIDTH) |of| SPEC
                                         |with| (+ W (TIMES 2 (CHARWIDTH (CHARCODE X)
                                                                         FONT))))
                                      (|if| (LISTP (|fetch| (INFOFIELD INFOFORMAT)
                                                          |of| SPEC))
                                          |then| (RPLACA (CDR (|fetch| (INFOFIELD 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 'SIZE INFOWANTED :KEY (FUNCTION CAR))
                                        (CL:POSITION '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
                                                                         '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 'SUBTREE.SIZE))
                                    (|replace| (FILEBROWSER FBDISPLAYEDDEPTH) |of| 
                                                                                            BROWSER
                                       |with| (|replace| (FILEBROWSER FBCOMPUTEDDEPTH)
                                                     |of| BROWSER |with| (OR (FIXP DEPTH)
                                                                                     0)))
                                    (\\GENERATEFILES PATTERN DESIREDPROPS '(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 'CLEAR "No files in group " PATTERN))
                 (T (FB.PROMPTWPRINT BROWSER '|done|)
                    (SETQ WIDENED (FB.MAYBE.WIDEN.NAMES BROWSER))
                    (COND
                       ((OR (FB.ADJUST.DATE.WIDTH BROWSER INFOWANTED)
                            WIDENED)
                        (FB.HEADINGW.DISPLAY BROWSER (|fetch| (FILEBROWSER 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 30-Aug-94 19:40 by jds")

    (* |;;| "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| (INFOFIELD INFOFORMAT) |of| (SETQ SPEC (CAR TAIL)))
                           '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| (INFOFIELD 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)
               '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 'ADD))))

(FB.ANALYZE.PATTERN
  (LAMBDA (BROWSER SAMPLE)                                   (* \; "Edited  6-Apr-90 20:00 by NM")

(* |;;;| "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")

    (PROG ((PATTERN (|fetch| (FILEBROWSER PATTERN) |of| BROWSER))
           (SAMPLEHOSTEND 0)
           PATHOSTEND LASTPATDIR STARTOFNAME)
          (|do|                                          (* \; "Find end of sample's host name")
                 (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))
      RETRY
          (SETQ PATHOSTEND 0)
          (|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))
                                                     ((\: < > /) 
                                                             (* \; "{DSK} and {UNIX} on Sun represent root directory in a form of \"{DSK}<vmunix\" or \"{DSK}/vmunix\".")
                                                          (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")

          (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)))))
             ((NOT (STREQUAL PATTERN (SETQ PATTERN (FB.CANONICALIZE.PATTERN PATTERN SAMPLE 
                                                          PATHOSTEND SAMPLEHOSTEND LASTPATDIR))))
                                                             (* \; 
       "Pattern didn't seem to match what came back, but we could canonicalize into something else")
              (GO RETRY))
             (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.CANONICALIZE.PATTERN
  (LAMBDA (PATTERN SAMPLE PATHOSTEND SAMPLEHOSTEND LASTPATDIR)
                                                             (* \; "Edited  6-Jan-89 15:40 by bvm")

    (* |;;| "Get the \"canonical\" version of PATTERN so that its apparent directory matches what is coming back from the server.  E.g., {DSK} might become {DSK}<LispFiles>, or {x/n}<~> might become {x/n}<usr>jones>.")

    (OR (SELCHARQ (NTHCHARCODE SAMPLE (|add| SAMPLEHOSTEND 1))
             ((< /)                                          (* \; 
                                                     "Good, there's a directory -- canonicalize it")
                  (LET ((CANONICAL (DIRECTORYNAME (SUBSTRING PATTERN 1 (OR LASTPATDIR (SETQ 
                                                                                       LASTPATDIR 
                                                                                       PATHOSTEND))))
                               ))
                       (AND CANONICAL (CONCAT CANONICAL (SUBSTRING PATTERN (ADD1 LASTPATDIR))))))
             (PROGN                                          (* \; 
                          "File coming back has no directory, so there's nothing interesting to do")
                    NIL))
        PATTERN)))

(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)
                                   '(SIZE LENGTH))
                            (SETQ TREESIZE (\\GENERATEFILEINFO GENERATOR '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 '("Name" 'NAME "Sort files by name, decreasing version numbers"
                       (SUBITEMS ("Decreasing version" 'NAME 
                                        "Sort files by name, decreasing version numbers")
                              ("Increasing version" '(NAME T)
                                     "Sort files by name, increasing version numbers")))
               (|for| ATTR |in| (|fetch| (FILEBROWSER INFODISPLAYED) |of| BROWSER
                                               )
                  |collect| `(,(SETQ ATTR (CAR ATTR))
                                  ',ATTR "Sort by this attribute"
                                  ,(SELECTQ ATTR
                                       ((SIZE LENGTH BYTESIZE) 
                                            `(SUBITEMS ("Decreasing" ',ATTR 
                                                             "Sort files in order of decreasing size"
                                                              )
                                                    ("Increasing" '(,ATTR T)
                                                           "Sort files in order of increasing size")))
                                       ((CREATIONDATE WRITEDATE READDATE) 
                                            `(SUBITEMS ("Newer first" ',ATTR 
                                           "Sort files with newer dates appearing before older dates"
                                                              )
                                                    ("Older first" '(,ATTR T)
                                                           
                                           "Sort files with older dates appearing before newer dates"
                                                           )))
                                       NIL)))))))))
)
(DEFINEQ

(FB.EXPUNGECOMMAND
  (LAMBDA (FBROWSER KEY ITEM MENU CMD)                 (* \; "Edited 22-Feb-2021 12:36 by rmk:")
                                                             (* \; "Edited  9-Apr-93 22:07 by jds")
    (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 '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
                                                                 'BOTH))
                                                         (T (FB.PROMPTWPRINT FBROWSER T 
                                                                   "Couldn't expunge " FILENAME)
                                                            (SETQ FAILED T))) 

                                                   (* |;;| 
                            "Let other things run (Like the mouse, so user can ABORT the expunge!)")

                                                   (BLOCK))
              (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 22-Feb-2021 12:35 by rmk:")
                                                             (* \; "Edited 30-Aug-94 19:47 by jds")
    (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 'BOTTOM 'JUSTIFY 'LOCALCLOSE)
             (COND
                ((LESSP (|fetch| (REGION BOTTOM) |of| (SETQ REG (WINDOWPROP INFOMENUW
                                                                               '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| (FILEBROWSER 
                                                                                   INFOMENUCHOICES)
                                                                  |of| BROWSER))
             (|replace| (FILEBROWSER INFOMENUW) |of| BROWSER |with| INFOMENUW)
             (WINDOWADDPROP INFOMENUW 'CLOSEFN (FUNCTION (LAMBDA (W)
                                                           (AND (SETQ W (WINDOWPROP (MAINWINDOW
                                                                                     W T)
                                                                               'FILEBROWSER))
                                                                (|replace| (FILEBROWSER
                                                                                INFOMENUW)
                                                                   |of| W |with| NIL))))
                    T)))
         (FB.PROMPTWPRINT BROWSER '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 '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 'WIDTH)))
                                          (- SCREENWIDTH SCROLLBARWIDTH))))
          (|if| (AND (> (SETQ EXCESSHEIGHT (- (WINDOWPROP WINDOW '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
                                                                                 'REGION))
                                          (|fetch| (REGION HEIGHT)
                                             |of| (WINDOWPROP (|fetch| (FILEBROWSER
                                                                                PROMPTWINDOW)
                                                                     |of| BROWSER)
                                                             '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 '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 'HOST)))
         (COND
            ((SETQ ICON (WINDOWPROP (|fetch| (FILEBROWSER BROWSERWINDOW) |of| FBROWSER)
                               'ICONWINDOW))                 (* \; "Change the icon label")
             (ICONW.TITLE ICON PATTERN)))
         PATTERN)))

(FB.GET.NEWPATTERN
  (LAMBDA (BROWSER)                                          (* \; "Edited 30-Aug-94 19:47 by jds")
    (FB.ALLOW.ABORT BROWSER)
    (LET* ((OLDPATTERN (|fetch| (FILEBROWSER 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 '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)      (* \; "Edited 22-Feb-2021 12:41 by rmk:")
                                                             (* \; "Edited 30-Aug-94 19:47 by jds")
    (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 'TOP)
         (|replace| (FILEBROWSER COUNTERWINDOW) |of| (WINDOWPROP BROWSERWINDOW
                                                                        'FILEBROWSER) |with|
                                                                                      COUNTERW)
         (WINDOWPROP COUNTERW 'REPAINTFN (FUNCTION FB.COUNTERW.REDISPLAYFN))
         (WINDOWPROP COUNTERW 'RESHAPEFN (FUNCTION FB.COUNTERW.REDISPLAYFN))
         (WINDOWPROP COUNTERW 'PAGEFULLFN (FUNCTION NILL))   (* \; 
                                                      "Set up for modernized window moving/shaping")
         (WINDOWPROP COUNTERW 'BUTTONEVENTFN (FUNCTION TOTOPW.MODERNIZE))
         (WINDOWPROP BROWSERWINDOW 'TOPMARGIN 0)
         COUNTERW)))

(FB.COUNTERW.REDISPLAYFN
  (LAMBDA (COUNTERWINDOW)                                    (* \; "Edited  4-Feb-88 15:11 by bvm:")
    (LET ((BROWSER (WINDOWPROP (MAINWINDOW COUNTERWINDOW T)
                          '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)                                    (* \; "Edited 30-Aug-94 19:48 by jds")
    (LET* ((COUNTERW (|fetch| (FILEBROWSER 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 'HEIGHT))
           HERE LABELS)
          (SETQ LABELS (LIST (COND
                                ((|fetch| (FILEBROWSER SHOWUNDELETED?) |of| FBROWSER)
                                 (FB.COUNTER.STRING FBROWSER (IDIFFERENCE TOTAL DEL)
                                        (IDIFFERENCE TOTALPAGES DELPAGES)))
                                ((NEQ TYPE 'DELETED)         (* \; 
                                         "Don't need to update total if only deleted count changed")
                                 (FB.COUNTER.STRING FBROWSER TOTAL TOTALPAGES)))
                             (AND (NEQ TYPE '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
                          'REPLACE)))))

(FB.DISPLAY.COUNTERS
  (LAMBDA (FBROWSER)                                         (* \; "Edited 30-Aug-94 19:48 by jds")
    (LET* ((COUNTERW (|fetch| (FILEBROWSER 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 'WIDTH))
           (COUNTERFONT (DSPFONT NIL COUNTERW))
           (SECTIONWIDTH (IQUOTIENT COUNTERWIDTH 2))
           (THRESHOLDWIDTH (IDIFFERENCE SECTIONWIDTH (ITIMES 2 (CHARWIDTH (CHARCODE \a)
                                                                      COUNTERFONT))))
           (HEIGHT (WINDOWPROP COUNTERW '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
                                                                           '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-Feb-2021 12:29 by rmk:")
                                                             (* \; "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 'TOP)
         (WINDOWPROP HEADINGW 'PASSTOMAINCOMS T)             (* \; 
                       "Pass ALL window ops to main window, since we look sort of like a title bar")
         (DSPTEXTURE BLACKSHADE HEADINGW)
         (WINDOWPROP HEADINGW 'REPAINTFN (FUNCTION FB.HEADINGW.REDISPLAYFN))
         (WINDOWPROP HEADINGW 'RESHAPEFN (FUNCTION FB.HEADINGW.RESHAPEFN))
                                                             (* \; 
                                                           "This is a white on black window")
         (DSPOPERATION 'INVERT HEADINGW)
         (DSPFILL NIL BLACKSHADE 'REPLACE HEADINGW)          (* \; 
                                                      "Set up for modernized window moving/shaping")
         (WINDOWPROP HEADINGW 'BUTTONEVENTFN (FUNCTION TOTOPW.MODERNIZE))
         (WINDOWPROP BROWSERWINDOW 'TOPMARGIN 0)
         HEADINGW)))

(FB.HEADINGW.REDISPLAYFN
  (LAMBDA (WINDOW)                                           (* |bvm:| "19-Sep-85 14:39")
    (FB.HEADINGW.DISPLAY (WINDOWPROP (WINDOWPROP WINDOW 'MAINWINDOW)
                                    '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 'MAINWINDOW)
                           'FILEBROWSER)))
         (CLEARW WINDOW)
         (FB.HEADINGW.DISPLAY FBROWSER WINDOW))))

(FB.HEADINGW.DISPLAY
  (LAMBDA (FBROWSER WINDOW)                                  (* \; "Edited 30-Aug-94 19:42 by jds")
    (LET* ((STREAM (WINDOWPROP WINDOW 'DSP))
           (CLIP (DSPCLIPPINGREGION NIL WINDOW))
           (RMARG (|fetch| (REGION RIGHT) |of| CLIP))
           (BORDER (WINDOWPROP (MAINWINDOW WINDOW)
                          'BORDER))
           (NEXTPOS (+ BORDER (|fetch| (FILEBROWSER INFOSTART) |of| FBROWSER)))
           (DEPTH (|fetch| (FILEBROWSER FBDISPLAYEDDEPTH) |of| FBROWSER))
           FORMAT)
          (DSPFILL CLIP BLACKSHADE '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| (INFOFIELD 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 POSITION)                          (* \; "Edited 30-Aug-94 19:48 by jds")
    (OR OLDICON (TITLEDICONW FB.ICONSPEC (|fetch| (FILEBROWSER PATTERN)
                                            |of| (WINDOWPROP WINDOW 'FILEBROWSER))
                       FB.ICONFONT POSITION NIL NIL 'FILE))))

(FB.INFOMENU.WHENSELECTEDFN
  (LAMBDA (ITEM MENU KEY)                                    (* |bvm:| "18-Sep-85 11:51")
    (LET* ((INFO (CADR ITEM))
           (WINDOW (WINDOWPROP (WFROMMENU MENU)
                          'MAINWINDOW))
           (BROWSER (WINDOWPROP WINDOW '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"))
            'DON\'T)
           ((NEQ (TB.NUMBER.OF.ITEMS TBROWSER '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)
                '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 '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 'MENU)))
                                (EQ 1 (|fetch| (MENU MENUCOLUMNS) |of| MENU))))
         (SETQ ITEM (ASSOC '|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 30-Aug-94 19:42 by jds")
    (RESETLST
        (LET
         ((FBROWSER (WINDOWPROP WINDOW 'FILEBROWSER))
          (TBROWSER (WINDOWPROP WINDOW '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 'PRINTOPTIONS (LIST* 'DOCUMENT.NAME TITLE (STREAMPROP IMAGESTREAM
                                                                                  'PRINTOPTIONS)))
                                                             (* \; "Give the document a nice name")
         (FB.HARDCOPY.PRINT.TITLE (CONCAT "Directory of " (WINDOWPROP (|fetch| (FILEBROWSER
                                                                                        COUNTERWINDOW
                                                                                        )
                                                                             |of| FBROWSER)
                                                                     '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| (INFOFIELD INFOPROTOTYPE)
                                                          |of| SPEC))
                                     |then| (STRINGWIDTH PROTO IMAGESTREAM)
                                   |elseif| (EQ (|fetch| (INFOFIELD INFOFORMAT) |of|
                                                                                        SPEC)
                                                    '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| (INFOFIELD 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| (INFOFIELD 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")
                          (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")
                          DUMMY)
                         (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")
                           (FBCOMPUTEDDEPTH BYTE)            (* \; 
                                    "Depth at the time we enumerated directory (zero for infinite)")
                           (FBDISPLAYEDDEPTH BYTE)           (* \; 
                                            "Depth we are currently displaying (zero for infinite)")
                           (TABLEBROWSER POINTER)            (* \; 
                                           "Pointer to TABLEBROWSER object controlling the browser")
                           (BROWSERWINDOW POINTER)           (* \; "Main window")
                           (COUNTERWINDOW POINTER)           (* \; 
                                                       "Window that counts files, pages, deletions")
                           (HEADINGWINDOW POINTER)           (* \; 
                                                         "Window with headings for browser columns")
                           (INFOMENUW POINTER)               (* \; 
                           "Window containing choices for info to be displayed, or NIL if none yet")
                           (PROMPTWINDOW POINTER)            (* \; "GETPROMPTWINDOW BROWSERWINDOW")
                           (INFODISPLAYED POINTER)           (* \; 
                                                          "List of 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.")
                           DUMMY))
)

(/DECLAREDATATYPE 'FBFILEDATA
       '(POINTER POINTER POINTER FLAG FLAG FLAG POINTER BYTE POINTER WORD WORD WORD WORD POINTER)
       '((FBFILEDATA 0 POINTER)
         (FBFILEDATA 2 POINTER)
         (FBFILEDATA 4 POINTER)
         (FBFILEDATA 4 (FLAGBITS . 0))
         (FBFILEDATA 4 (FLAGBITS . 16))
         (FBFILEDATA 4 (FLAGBITS . 32))
         (FBFILEDATA 6 POINTER)
         (FBFILEDATA 8 (BITS . 7))
         (FBFILEDATA 10 POINTER)
         (FBFILEDATA 9 (BITS . 15))
         (FBFILEDATA 12 (BITS . 15))
         (FBFILEDATA 13 (BITS . 15))
         (FBFILEDATA 14 (BITS . 15))
         (FBFILEDATA 16 POINTER))
       '18)

(/DECLAREDATATYPE 'FILEBROWSER
       '(FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG BYTE BYTE POINTER POINTER POINTER POINTER POINTER 
              POINTER POINTER POINTER POINTER POINTER POINTER POINTER WORD WORD WORD WORD WORD WORD 
              WORD WORD POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
              POINTER POINTER POINTER WORD WORD POINTER POINTER POINTER)
       '((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 (BITS . 135))
         (FILEBROWSER 1 (BITS . 7))
         (FILEBROWSER 2 POINTER)
         (FILEBROWSER 4 POINTER)
         (FILEBROWSER 6 POINTER)
         (FILEBROWSER 8 POINTER)
         (FILEBROWSER 10 POINTER)
         (FILEBROWSER 12 POINTER)
         (FILEBROWSER 14 POINTER)
         (FILEBROWSER 16 POINTER)
         (FILEBROWSER 18 POINTER)
         (FILEBROWSER 20 POINTER)
         (FILEBROWSER 22 POINTER)
         (FILEBROWSER 24 POINTER)
         (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 (BITS . 15))
         (FILEBROWSER 33 (BITS . 15))
         (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 POINTER)
         (FILEBROWSER 58 (BITS . 15))
         (FILEBROWSER 59 (BITS . 15))
         (FILEBROWSER 60 POINTER)
         (FILEBROWSER 62 POINTER)
         (FILEBROWSER 64 POINTER))
       '66)

(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 FB.BROWSER.DIRECTORY.FONT ITALICFONT PRINTFILETYPES)
)

(DECLARE\: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)
)

(/DECLAREDATATYPE 'FILEBROWSER
       '(FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG BYTE BYTE POINTER POINTER POINTER POINTER POINTER 
              POINTER POINTER POINTER POINTER POINTER POINTER POINTER WORD WORD WORD WORD WORD WORD 
              WORD WORD POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
              POINTER POINTER POINTER WORD WORD POINTER POINTER POINTER)
       '((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 (BITS . 135))
         (FILEBROWSER 1 (BITS . 7))
         (FILEBROWSER 2 POINTER)
         (FILEBROWSER 4 POINTER)
         (FILEBROWSER 6 POINTER)
         (FILEBROWSER 8 POINTER)
         (FILEBROWSER 10 POINTER)
         (FILEBROWSER 12 POINTER)
         (FILEBROWSER 14 POINTER)
         (FILEBROWSER 16 POINTER)
         (FILEBROWSER 18 POINTER)
         (FILEBROWSER 20 POINTER)
         (FILEBROWSER 22 POINTER)
         (FILEBROWSER 24 POINTER)
         (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 (BITS . 15))
         (FILEBROWSER 33 (BITS . 15))
         (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 POINTER)
         (FILEBROWSER 58 (BITS . 15))
         (FILEBROWSER 59 (BITS . 15))
         (FILEBROWSER 60 POINTER)
         (FILEBROWSER 62 POINTER)
         (FILEBROWSER 64 POINTER))
       '66)

(/DECLAREDATATYPE 'FBFILEDATA
       '(POINTER POINTER POINTER FLAG FLAG FLAG POINTER BYTE POINTER WORD WORD WORD WORD POINTER)
       '((FBFILEDATA 0 POINTER)
         (FBFILEDATA 2 POINTER)
         (FBFILEDATA 4 POINTER)
         (FBFILEDATA 4 (FLAGBITS . 0))
         (FBFILEDATA 4 (FLAGBITS . 16))
         (FBFILEDATA 4 (FLAGBITS . 32))
         (FBFILEDATA 6 POINTER)
         (FBFILEDATA 8 (BITS . 7))
         (FBFILEDATA 10 POINTER)
         (FBFILEDATA 9 (BITS . 15))
         (FBFILEDATA 12 (BITS . 15))
         (FBFILEDATA 13 (BITS . 15))
         (FBFILEDATA 14 (BITS . 15))
         (FBFILEDATA 16 POINTER))
       '18)
(ADDTOVAR SYSTEMRECLST

(DATATYPE FILEBROWSER ((NOSUBDIRECTORIES FLAG)
                           (NSPATTERN? FLAG)
                           (SHOWUNDELETED? FLAG)
                           (PATTERNPARSED? FLAG)
                           (SORTBYDATE FLAG)
                           (FBREADY FLAG)
                           (ABORTING FLAG)
                           (FIXEDTITLE FLAG)
                           (FBCOMPUTEDDEPTH BYTE)
                           (FBDISPLAYEDDEPTH BYTE)
                           (TABLEBROWSER POINTER)
                           (BROWSERWINDOW POINTER)
                           (COUNTERWINDOW POINTER)
                           (HEADINGWINDOW POINTER)
                           (INFOMENUW POINTER)
                           (PROMPTWINDOW POINTER)
                           (INFODISPLAYED POINTER)
                           (PATTERN POINTER)
                           (PREPAREDPATTERN POINTER)
                           (SEEWINDOW POINTER)
                           (BROWSERFONT POINTER)
                           (SORTBY POINTER)
                           (NAMESTART WORD)
                           (DIRECTORYSTART WORD)
                           (INFOSTART WORD)
                           (NAMEOVERHEAD WORD)
                           (OVERFLOWSPACING WORD)
                           (DIGITWIDTH WORD)
                           (TOTALFILES WORD)
                           (DELETEDFILES WORD)
                           (TOTALPAGES POINTER)
                           (DELETEDPAGES POINTER)
                           (PAGECOUNT? POINTER)
                           (COUNTERPOSITIONS POINTER)
                           (COUNTERPAGESTRING POINTER)
                           (OVERFLOWWIDTHS POINTER)
                           (INFOMENUCHOICES POINTER)
                           (UPDATEPROC POINTER)
                           (DEFAULTDIR POINTER)
                           (SORTATTRIBUTE POINTER)
                           (SORTMENU POINTER)
                           (FBLOCK POINTER)
                           (SORTINDEX WORD)
                           (SIZEINDEX WORD)
                           (FBDEPTH POINTER)
                           (ABORTWINDOW POINTER)
                           DUMMY))

(DATATYPE FBFILEDATA ((FILENAME POINTER)
                          (FILEINFO POINTER)
                          (VERSIONLESSNAME POINTER)
                          (DIRECTORYP FLAG)
                          (HASDIRPREFIX FLAG)
                          (DIRECTORYFILEP FLAG)
                          (SIZE POINTER)
                          (FILEDEPTH BYTE)
                          (SORTVALUE POINTER)
                          (SUBDIREND WORD)
                          (STARTOFPNAME WORD)
                          (VERSION WORD)
                          (STARTOFNAME WORD)
                          DUMMY))
)
(DECLARE\: DONTEVAL@LOAD DOCOPY 

(MOVD? 'PROMPTFORWORD 'TTYINPROMPTFORWORD NIL T)


(ADDTOVAR *ATTACHED-WINDOW-COMMAND-SYNONYMS* (HARDCOPYIMAGEW.TOFILE . HARDCOPYIMAGEW)
                                                 (HARDCOPYIMAGEW.TOPRINTER . HARDCOPYIMAGEW))

(ADDTOVAR |BackgroundMenuCommands| ("FileBrowser" '(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 ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 
1991 1993 1994 1999 2000 2001 2021))
(DECLARE\: DONTCOPY
  (FILEMAP (NIL (28103 50739 (FB 28113 . 29069) (FB.COPYBINARYCOMMAND 29071 . 29417) (FB.COPYTEXTCOMMAND
 29419 . 29761) (FILEBROWSER 29763 . 42869) (FB.TABLEBROWSER 42871 . 43088) (FB.SELECTEDFILES 43090 . 
43727) (FB.FETCHFILENAME 43729 . 44121) (FB.DIRECTORYP 44123 . 44451) (FB.PROMPTWPRINT 44453 . 45499) 
(FB.PROMPTW.FORMAT 45501 . 46238) (FB.PROMPTFORINPUT 46240 . 48492) (FB.YES-OR-NO-P 48494 . 49528) (
FB.ALLOW.ABORT 49530 . 50384) (\\FB.HARDCOPY.TOFILE.EXTENSION 50386 . 50737)) (50763 51716 (FB.STARTUP
 50773 . 51288) (FB.MAKERIGIDWINDOW 51290 . 51714)) (51717 57089 (FB.PRINTFN 51727 . 56880) (FB.COPYFN
 56882 . 57087)) (57139 62464 (FB.MENU.WHENSELECTEDFN 57149 . 57507) (FB.COMMANDSELECTEDFN 57509 . 
59048) (FB.SUBITEMP 59050 . 59485) (FB.MAKE.BROWSER.BUSY 59487 . 60039) (FB.FINISH.COMMAND 60041 . 
61475) (FB.HANDLE.ABORT.BUTTON 61477 . 62462)) (62465 67981 (FB.DELETECOMMAND 62475 . 62756) (
FB.DELVERCOMMAND 62758 . 65951) (FB.IS.NOT.SUBDIRECTORY.ITEM 65953 . 66134) (FB.DELVER.FILES 66136 . 
67225) (FB.DELETE.FILE 67227 . 67979)) (67982 69307 (FB.UNDELETECOMMAND 67992 . 68277) (
FB.UNDELETEALLCOMMAND 68279 . 68558) (FB.UNDELETE.FILE 68560 . 69305)) (69308 93489 (FB.COPYCOMMAND 
69318 . 69587) (FB.RENAMECOMMAND 69589 . 69864) (FB.COPY/RENAME.COMMAND 69866 . 70789) (
FB.COPY/RENAME.ONE 70791 . 73113) (FB.COPY/RENAME.MANY 73115 . 79335) (FB.MERGE.DIRECTORIES 79337 . 
79755) (FB.GREATEST.PREFIX 79757 . 81113) (FB.MAYBE.INSERT.FILE 81115 . 88555) (FB.GET.NEW.FILE.SPEC 
88557 . 92388) (FB.CANONICAL.DIRECTORY 92390 . 93487)) (93490 101274 (FB.HARDCOPYCOMMAND 93500 . 94630
) (FB.HARDCOPY.TOFILE 94632 . 101272)) (101275 110817 (FB.EDITCOMMAND 101285 . 102076) (
FB.EDITCOMMAND.ONEFILE 102078 . 105033) (FB.EDITLISPFILE 105035 . 106074) (FB.BROWSECOMMAND 106076 . 
110815)) (110818 122611 (FB.FASTSEECOMMAND 110828 . 114278) (FB.FASTSEE.ONEFILE 114280 . 117309) (
FB.SEEFULLFN 117311 . 121442) (FB.SEEBUTTONFN 121444 . 122609)) (122612 124358 (FB.LOADCOMMAND 122622
 . 123129) (FB.COMPILECOMMAND 123131 . 123669) (FB.OPERATE.ON.FILES 123671 . 124356)) (124359 171408 (
FB.UPDATECOMMAND 124369 . 124594) (FB.MAYBE.EXPUNGE 124596 . 125591) (FB.UPDATEBROWSERITEMS 125593 . 
138808) (FB.DATE 138810 . 139551) (FB.ADJUST.DATE.WIDTH 139553 . 142521) (FB.SET.BROWSER.TITLE 142523
 . 143380) (FB.MAYBE.WIDEN.NAMES 143382 . 145501) (FB.SET.DEFAULT.NAME.WIDTH 145503 . 146867) (
FB.CREATE.FILEBUCKET 146869 . 154089) (FB.CHECK.NAME.LENGTH 154091 . 156512) (FB.ADD.FILEGROUP 156514
 . 158041) (FB.INSERT.DIRECTORY 158043 . 158281) (FB.MAKE.SUBDIRECTORY.ITEM 158283 . 159692) (
FB.ADD.FILE 159694 . 160307) (FB.INSERT.FILE 160309 . 163721) (FB.ANALYZE.PATTERN 163723 . 168987) (
FB.CANONICALIZE.PATTERN 168989 . 170301) (FB.GETALLFILEINFO 170303 . 171406)) (171409 179568 (
FB.SORT.VERSIONS 171419 . 174190) (FB.DECREASING.VERSION 174192 . 174861) (FB.INCREASING.VERSION 
174863 . 175484) (FB.NAMES.DECREASING.VERSION 175486 . 176521) (FB.NAMES.INCREASING.VERSION 176523 . 
177520) (FB.DECREASING.NUMERIC.ATTR 177522 . 178202) (FB.INCREASING.NUMERIC.ATTR 178204 . 178878) (
FB.ALPHABETIC.ATTR 178880 . 179566)) (179569 189411 (FB.SORTCOMMAND 179579 . 186409) (
FB.INSERT.SUBDIRECTORIES 186411 . 187208) (FB.GET.SORT.MENU 187210 . 189409)) (189412 205501 (
FB.EXPUNGECOMMAND 189422 . 191941) (FB.NEWPATTERNCOMMAND 191943 . 192341) (FB.NEWINFOCOMMAND 192343 . 
195109) (FB.DEPTHCOMMAND 195111 . 196886) (FB.SHAPECOMMAND 196888 . 200230) (FB.REMOVE.FILE 200232 . 
202053) (FB.COUNT.FILE.CHANGE 202055 . 203500) (FB.SETNEWPATTERN 203502 . 204672) (FB.GET.NEWPATTERN 
204674 . 205258) (FB.OPTIONSCOMMAND 205260 . 205499)) (205536 206548 (
FB.INFOMENU.SHADEINITIALSELECTIONS 205546 . 206193) (FB.INFO.ITEM.NAMED 206195 . 206546)) (206549 
216015 (FB.MAKECOUNTERWINDOW 206559 . 208021) (FB.COUNTERW.REDISPLAYFN 208023 . 208610) (
FB.UPDATE.COUNTERS 208612 . 210684) (FB.DISPLAY.COUNTERS 210686 . 215746) (FB.COUNTER.STRING 215748 . 
216013)) (216016 220659 (FB.MAKEHEADINGWINDOW 216026 . 217574) (FB.HEADINGW.REDISPLAYFN 217576 . 
217842) (FB.HEADINGW.RESHAPEFN 217844 . 218220) (FB.HEADINGW.DISPLAY 218222 . 220657)) (220660 224843 
(FB.ICONFN 220670 . 221017) (FB.INFOMENU.WHENSELECTEDFN 221019 . 221749) (FB.CLOSEFN 221751 . 222954) 
(FB.EXPUNGE?.MENU 222956 . 223368) (FB.AFTERCLOSEFN 223370 . 223731) (FB.CLOSE&EXPUNGE 223733 . 224841
)) (224844 236902 (FB.HARDCOPY.DIRECTORY 224854 . 235211) (FB.HARDCOPY.PRINT.TITLE 235213 . 235539) (
FB.HARDCOPY.MAXWIDTH 235541 . 236900)))))
STOP
\ No newline at end of file
+(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
(FILECREATED "27-Feb-2021 20:08:26" 
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>FILEBROWSER.;33| 261320 

      |changes| |to:|  (FNS FB.EDITCOMMAND.ONEFILE FB.FINISH.COMMAND FB.MAKE.BROWSER.BUSY 
                            FB.EDITCOMMAND)

      |previous| |date:| "25-Feb-2021 13:24:50" 
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>FILEBROWSER.;27|)


; Copyright (c) 1983-1991, 1993-1994, 1999-2001, 2021 by Venue & Xerox Corporation.

(PRETTYCOMPRINT FILEBROWSERCOMS)

(RPAQQ FILEBROWSERCOMS
       ((COMS (DECLARE\: EVAL@COMPILE DONTCOPY (P (CL:UNLESS (GETP 'EXPORTS.ALL 'FILE)
                                                      (TERPRI T)
                                                      (PRIN1 
                                                            "NOTE:  FILEBROWSER requires EXPORTS.ALL"
                                                             T)
                                                      (TERPRI T)
                                                      (TERPRI T))))
              (FILES ATTACHEDWINDOW ICONW TABLEBROWSER)
              (P 
                 (* |;;| "Set up for MODERNIZE windows, whether or not MODERNIZE is pre-loaded")

                 (MOVD? 'NILL 'TOTOPW.MODERNIZE))
              
              (* |;;| "JDS 11/94 FB.ICONSPEC is now an INITVAR so we can create smaller ones in profiles for, e.g., laptops.")

              (INITVARS (FB.EXPUNGE?MENU)
                     (FB.BROWSERFONT DEFAULTFONT)
                     (FB.BROWSER.DIRECTORY.FONT BOLDFONT)
                     (FB.PROMPTFONT LITTLEFONT)
                     (FB.HARDCOPY.FONT)
                     (FB.HARDCOPY.DIRECTORY.FONT)
                     (FB.PROMPTLINES 3)
                     (FB.MENUFONT MENUFONT)
                     (FB.OVERFLOW.MAXABSOLUTE 30)
                     (FB.OVERFLOW.MAXFRAC 0.06)
                     (FB.DEFAULT.EDITOR 'TEDIT)
                     (FB.DEFAULT.INFO '(SIZE CREATIONDATE AUTHOR)))
              (APPENDVARS (FONTVARS (FB.ICONFONT LITTLEFONT)
                                 (FB.BROWSERFONT DEFAULTFONT)
                                 (FB.PROMPTFONT LITTLEFONT)
                                 (FB.BROWSER.DIRECTORY.FONT BOLDFONT)))
              (P 
                 (* |;;| "FONTSET fills in the variables in FONTVARS for us, so do it.")

                 (FONTSET (FONTSET)))
              (ADDVARS (CACHEDMENUS FB.EXPUNGE?MENU))
              (INITVARS (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)"
                                                (SUBITEMS ("Copy using TEXT FileType" 
                                                                 FB.COPYTEXTCOMMAND 
                                      "Forces the copying of selected files to be done as TEXT-files"
                                                                 )
                                                       ("Copy using BINARY FileType" 
                                                              FB.COPYBINARYCOMMAND 
                                    "Forces the copying of selected files to be done as BINARY-files"
                                                              )))
                                         (|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.EDITCOMMAND READONLY)
                                                
                                         "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"
                                                ))))
              (VARS FB.VERSION.MENU.ITEMS FB.CLOSE.MENU.ITEMS FB.DEPTH.MENU.ITEMS FB.INFO.MENU.ITEMS
                    FB.DEFAULT.NAME.WIDTH FB.INFO.FIELDS FB.INFOSHADE FB.ITEMUNSELECTEDSHADE 
                    FB.ITEMSELECTEDSHADE))
        (COMS                                                (* \; "Entries")
              (COMMANDS "fb")
              (FNS FB FB.COPYBINARYCOMMAND FB.COPYTEXTCOMMAND FILEBROWSER FB.TABLEBROWSER 
                   FB.SELECTEDFILES FB.FETCHFILENAME FB.DIRECTORYP FB.PROMPTWPRINT FB.PROMPTW.FORMAT
                   FB.PROMPTFORINPUT FB.YES-OR-NO-P FB.ALLOW.ABORT \\FB.HARDCOPY.TOFILE.EXTENSION)
                                                             (* \; "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.MERGE.DIRECTORIES FB.GREATEST.PREFIX FB.MAYBE.INSERT.FILE 
                   FB.GET.NEW.FILE.SPEC FB.CANONICAL.DIRECTORY)
              (FNS FB.HARDCOPYCOMMAND FB.HARDCOPY.TOFILE)
              (FNS FB.EDITCOMMAND FB.EDITCOMMAND.ONEFILE 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.CANONICALIZE.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 FB.BROWSER.DIRECTORY.FONT ITALICFONT PRINTFILETYPES)
               (LOCALVARS . T))
        (INITRECORDS FILEBROWSER FBFILEDATA)
        (SYSRECORDS FILEBROWSER FBFILEDATA)
        (DECLARE\: DONTEVAL@LOAD DOCOPY (P (MOVD? 'PROMPTFORWORD 'TTYINPROMPTFORWORD NIL T))
               (ADDVARS (*ATTACHED-WINDOW-COMMAND-SYNONYMS* (HARDCOPYIMAGEW.TOFILE . HARDCOPYIMAGEW)
                               (HARDCOPYIMAGEW.TOPRINTER . HARDCOPYIMAGEW))
                      (|BackgroundMenuCommands| ("FileBrowser" '(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)))
        ))
(DECLARE\: EVAL@COMPILE DONTCOPY 

(CL:UNLESS (GETP 'EXPORTS.ALL 'FILE)
    (TERPRI T)
    (PRIN1 "NOTE:  FILEBROWSER requires EXPORTS.ALL" T)
    (TERPRI T)
    (TERPRI T))
)

(FILESLOAD ATTACHEDWINDOW ICONW TABLEBROWSER)


(* |;;| "Set up for MODERNIZE windows, whether or not MODERNIZE is pre-loaded")


(MOVD? 'NILL 'TOTOPW.MODERNIZE)



(* |;;| 
"JDS 11/94 FB.ICONSPEC is now an INITVAR so we can create smaller ones in profiles for, e.g., laptops."
)


(RPAQ? FB.EXPUNGE?MENU )

(RPAQ? FB.BROWSERFONT DEFAULTFONT)

(RPAQ? FB.BROWSER.DIRECTORY.FONT BOLDFONT)

(RPAQ? FB.PROMPTFONT LITTLEFONT)

(RPAQ? FB.HARDCOPY.FONT )

(RPAQ? FB.HARDCOPY.DIRECTORY.FONT )

(RPAQ? FB.PROMPTLINES 3)

(RPAQ? FB.MENUFONT MENUFONT)

(RPAQ? FB.OVERFLOW.MAXABSOLUTE 30)

(RPAQ? FB.OVERFLOW.MAXFRAC 0.06)

(RPAQ? FB.DEFAULT.EDITOR 'TEDIT)

(RPAQ? FB.DEFAULT.INFO '(SIZE CREATIONDATE AUTHOR))

(APPENDTOVAR FONTVARS (FB.ICONFONT LITTLEFONT)
                          (FB.BROWSERFONT DEFAULTFONT)
                          (FB.PROMPTFONT LITTLEFONT)
                          (FB.BROWSER.DIRECTORY.FONT BOLDFONT))


(* |;;| "FONTSET fills in the variables in FONTVARS for us, so do it.")


(FONTSET (FONTSET))

(ADDTOVAR CACHEDMENUS FB.EXPUNGE?MENU)

(RPAQ? 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)"
                (SUBITEMS ("Copy using TEXT FileType" FB.COPYTEXTCOMMAND 
                                 "Forces the copying of selected files to be done as TEXT-files")
                       ("Copy using BINARY FileType" FB.COPYBINARYCOMMAND 
                              "Forces the copying of selected files to be done as BINARY-files")))
         (|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.EDITCOMMAND READONLY)
                "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.VERSION.MENU.ITEMS (("1" 1 "Keep only one version of the files")
                                  ("2" 2 "Keep two versions of the files")
                                  ("3" 3 "Keep three versions of the files")
                                  ("4" 4 "Keep four versions of the files")
                                  ("Other" :NUMBER "Select number of versions to keep")))

(RPAQQ FB.CLOSE.MENU.ITEMS (("Expunge deleted files" 'EXPUNGE 
                                       "Erases all files still marked 'deleted'")
                                ("Don't expunge" '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.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)



(* \; "Entries")


(DEFCOMMAND "fb" (&REST PAT&PROPS) (APPLY '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 `(,(FUNCTION FILEBROWSER)
                               ',PAT
                               ',PROPS
                               ',OPTIONS)
                       'NAME
                       'FB)))
    NIL))

(FB.COPYBINARYCOMMAND
  (LAMBDA (BROWSER)                                          (* \; 
                                                           "Edited 19-Oct-90 18:18 by gadener")
    (FB.COPY/RENAME.COMMAND BROWSER '|Copy| (CONS (FUNCTION COPYFILE)
                                                      '((TYPE BINARY))))))

(FB.COPYTEXTCOMMAND
  (LAMBDA (BROWSER)                                          (* \; 
                                                           "Edited 19-Oct-90 18:55 by gadener")
    (FB.COPY/RENAME.COMMAND BROWSER '|Copy| (CONS (FUNCTION COPYFILE)
                                                      '((TYPE TEXT))))))

(FILEBROWSER
  (LAMBDA (FILESPEC ATTRIBUTES OPTIONS)                      (* \; "Edited 30-Aug-94 19:45 by jds")
    (PROG ((TITLEFONT (DSPFONT NIL |WindowTitleDisplayStream|))
           (BROWSERFONTHEIGHT (FONTPROP FB.BROWSERFONT '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
                                                                                  'HEIGHT))))
                 (SETQ COUNTERHEIGHT (HEIGHTIFWINDOW (FONTPROP TITLEFONT '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 '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| (FILEBROWSER 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 'RIGHT '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 _ '(("--Abort--" NIL 
                                                            "Abort the current FileBrowser operation"
                                                                  ))
                                                 CENTERFLG _ T
                                                 MENUOUTLINESIZE _ 2
                                                 MENUFONT _ (FONTCOPY FB.MENUFONT 'WEIGHT
                                                                   '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 'PASSTOMAINCOMS)))
             |do|                                        (* \; 
                                    "Make all these subwindows pass hardcopy on to the main window")
                   (WINDOWPROP W 'PASSTOMAINCOMS (UNION '(HARDCOPYIMAGEW)
                                                        OLDCOMS)))
          (|replace| (FILEBROWSER TABLEBROWSER) |of| BROWSER
             |with| (TB.MAKE.BROWSER NIL BROWSERWINDOW (LIST 'PRINTFN (FUNCTION FB.PRINTFN)
                                                                 'COPYFN
                                                                 (FUNCTION FB.COPYFN)
                                                                 'USERDATA BROWSER 'CLOSEFN
                                                                 (FUNCTION FB.CLOSEFN)
                                                                 'AFTERCLOSEFN
                                                                 (FUNCTION FB.AFTERCLOSEFN)
                                                                 'HEADINGWINDOW HEADINGWINDOW)))
          (WINDOWPROP BROWSERWINDOW 'HARDCOPYFN (FUNCTION FB.HARDCOPY.DIRECTORY))
          (WINDOWPROP BROWSERWINDOW '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 `(,(FUNCTION FB.STARTUP)
                                   ',BROWSER
                                   ',COMMANDMENU
                                   ',(FUNCTION FB.UPDATEBROWSERITEMS))
                           'NAME
                           '|FB-Update|
                           'BEFOREEXIT
                           'DON\'T))
          (RETURN BROWSERWINDOW))))

(FB.TABLEBROWSER
  (LAMBDA (BROWSER)                                          (* \; "Edited  4-Feb-88 23:13 by bvm:")
    (|ffetch| (FILEBROWSER TABLEBROWSER) |of| (\\DTEST BROWSER '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
                                                                                       'FILEBROWSER))
               '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
                                                                                     'TABLEITEM)))))

(FB.DIRECTORYP
  (LAMBDA (FILE)                                       (* \; "Edited 20-Feb-2021 20:05 by rmk:")

    (* |;;| "Does FILE denote a directory?")

    (CL:WHEN (TYPE? TABLEITEM FILE)
        (SETQ FILE (FETCH TIDATA OF FILE)))
    (|fetch| (FBFILEDATA DIRECTORYFILEP) |of| FILE)))

(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)
                                                                                     '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
                                                                                    '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 22-Nov-88 15:33 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
                                                                                 'FILEBROWSER)))
           (PROMPTWIDTH (STRINGWIDTH PROMPT PWINDOW))
           (WINDOWWIDTH (WINDOWPROP PWINDOW '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))
                                                      (CONSTANT (CHARACTER (CHARCODE CR)))
                                                      (SUBSTRING PROMPT (ADD1 I))))))))
          (SETQ RESULT (CAR (NLSETQ (TTYINPROMPTFORWORD PROMPT DEFAULT NIL PWINDOW NIL 'TTY
                                           (CHARCODE (CR))))))
          (WINDOWPROP PWINDOW 'PROCESS NIL)                  (* \; 
                                                           "Get rid of process from prompt window")
          (COND
             ((AND (NULL RESULT)
                   ABORTFLG)
              (PRINTOUT PWINDOW "... aborted")))
          (TERPRI PWINDOW)
          RESULT)))

(FB.YES-OR-NO-P
  (LAMBDA (PROMPT FBROWSER DEFAULT)                          (* \; "Edited 22-Nov-88 15:30 by bvm")

    (* |;;| 
  "Return Y, N or NIL, indicating whether response to question is Yes, No or some kind of abort")

    (LET ((ANSWER (FB.PROMPTFORINPUT PROMPT (SELECTQ DEFAULT
                                                    (Y "Yes")
                                                    (N "No")
                                                    NIL)
                         FBROWSER T T)))
         (COND
            ((NULL ANSWER)                                   (* \; "Aborted")
             NIL)
            ((OR (STRING-EQUAL ANSWER "YES")
                 (STRING-EQUAL ANSWER "Y"))
             'Y)
            ((OR (STRING-EQUAL ANSWER "NO")
                 (STRING-EQUAL ANSWER "N"))
             'N)
            (T (FB.PROMPTWPRINT FBROWSER "?? ...Aborted.")
                                                             (* \; "Confused somehow")
               NIL)))))

(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 'FILEBROWSER)
       |with| (THIS.PROCESS))
    (LET ((W (|ffetch| (FILEBROWSER ABORTWINDOW) |of| BROWSER)))
         (|if| (NOT (OPENWP (CAR W)))
             |then| (ATTACHWINDOW (CAR W)
                               (CDR W)
                               'BOTTOM)                      (* \; 
                                                     "And repaint it in case it was used last time")
                   (REDISPLAYW (CAR W))))))

(\\FB.HARDCOPY.TOFILE.EXTENSION
  (LAMBDA NIL                                                (* \; 
                                                           "Edited 25-Feb-91 15:15 by gadener")
    (LET ((TYPE (PRINTERTYPE)))
         (CASE TYPE
             (INTERPRESS 'IP)
             (POSTSCRIPT 'PS)
             (DEFAULT TYPE)))))
)



(* \; "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 '|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 'REGION))))
         (WINDOWPROP WINDOW 'MINSIZE (CONS 0 HEIGHT))
         (WINDOWPROP WINDOW 'MAXSIZE (CONS SCREENWIDTH HEIGHT))
         WINDOW)))
)
(DEFINEQ

(FB.PRINTFN
  (LAMBDA (TBROWSER ITEM WINDOW)                             (* \; "Edited 30-Aug-94 19:12 by jds")
    (LET ((FBROWSER (TB.USERDATA TBROWSER))
          (FDATA (|fetch| TIDATA |of| ITEM))
          (STREAM (WINDOWPROP WINDOW 'DSP))
          NEXTPOS INFO OLDFONT)
         (COND
            ((|fetch| (FBFILEDATA DIRECTORYP) |of| FDATA)
             (PRIN3 "  " STREAM)
             (|if| FB.BROWSER.DIRECTORY.FONT
                 |then| (SETQ OLDFONT (DSPFONT FB.BROWSER.DIRECTORY.FONT 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| (INFOFIELD 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 '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| (INFOFIELD INFOWIDTH) |of| SPEC)))
         (TB.CLEAR.LINE TBROWSER ITEM (DSPXPOSITION NIL STREAM))
         (AND OLDFONT (DSPFONT OLDFONT STREAM)))))

(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 `(,(FUNCTION FB.COMMANDSELECTEDFN)
                   ',ITEM
                   ',MENU
                   ',KEY)
           'NAME
           (PACK* 'FB- (CAR ITEM))
           'BEFOREEXIT
           'DON\'T)))

(FB.COMMANDSELECTEDFN
  (LAMBDA (ITEM MENU KEY)                                    (* \; "Edited 12-Jan-87 12:57 by bvm:")
    (RESETLST
        (LET* ((REALITEM ITEM)
               (WINDOW (WINDOWPROP (WFROMMENU MENU)
                              'MAINWINDOW))
               (FBROWSER (WINDOWPROP WINDOW '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))
                      '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 27-Feb-2021 19:21 by rmk:")
                                                             (* \; "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)
                  (PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM FB.ITEMSELECTEDSHADE)))
        T))))

(FB.FINISH.COMMAND
  (LAMBDA (BROWSER ITEM MENU)                          (* \; "Edited 27-Feb-2021 19:52 by rmk:")
                                                             (* \; "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)

    (* |;;| "RMK: Don't reshade the item if it isn't needed.  This will prevent the FB window from popping on top of any windows that the menu command created (SEE, EDIT), if they clear it before they open their windows.")

    (LET ((W (CAR (|fetch| (FILEBROWSER ABORTWINDOW) |of| BROWSER)))
          M)
         (|if| (OPENWP W)
             |then|                                      (* \; 
                                                      "Take down the abort button if there was one")
                   (DETACHWINDOW W)
                   (SHADEITEM (CAR (|fetch| (MENU ITEMS) |of| (SETQ M
                                                                       (CAR (WINDOWPROP W
                                                                                   'MENU)))))
                          M FB.ITEMUNSELECTEDSHADE)
                   (CLOSEW W)))
    (|if| (AND ITEM (EQ ITEM (CAR (GETMENUPROP MENU 'ITEMSHADE)))
                   (NEQ FB.ITEMUNSELECTEDSHADE (CDR (GETMENUPROP MENU 'ITEMSHADE))))
        |then| (SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
              (PUTMENUPROP MENU 'FB.ITEMUNSELECTEDSHADE NIL))
    (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)
                          '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 15-Feb-91 17:19 by gadener")
    (LET (NVERSIONS TBROWSER NDELETED FILES)
         (|if| (EQ (SETQ NVERSIONS
                        (MENU (|create| MENU
                                     TITLE _ "Versions to keep ?"
                                     ITEMS _ FB.VERSION.MENU.ITEMS
                                     CENTERFLG _ T)))
                       :NUMBER)
             |then| (FB.ALLOW.ABORT FBROWSER)
                   (SETQ NVERSIONS (RNUMBER "Number of versions to keep ?" NIL NIL NIL T NIL T)))
         (COND
            ((NOT NVERSIONS)
             NIL)
            ((NOT (FIXP (SETQ NVERSIONS (MKATOM NVERSIONS))))
             (FB.PROMPTW.FORMAT FBROWSER "~%?? ~A not an integer." NVERSIONS))
            ((EQ NVERSIONS 0)
             NIL)
            (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 '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)                                          (* \; 
                                                           "Edited 19-Oct-90 17:44 by gadener")
    (FB.COPY/RENAME.COMMAND BROWSER '|Copy| (CONS (FUNCTION COPYFILE)))))

(FB.RENAMECOMMAND
  (LAMBDA (BROWSER)                                          (* \; 
                                                           "Edited 19-Oct-90 18:57 by gadener")
    (FB.COPY/RENAME.COMMAND BROWSER '|Rename| (CONS (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 19-Oct-90 17:50 by gadener")

(* |;;;| 
"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 (CAR MOVEFN)
                                 OLDNAME NEWNAME (CDR MOVEFN)))
           (COND
              (ACTUALNEWNAME (FB.PROMPTW.FORMAT FBROWSER "~%~A ~Aed to ~A" OLDNAME
                                    (SELECTQ CMD
                                        (|Copy| "copi")
                                        (|Rename| "renam")
                                        (SHOULDNT))
                                    ACTUALNEWNAME)
                     (LET ((CHANGETYPE (COND
                                          ((EQ CMD '|Rename|)
                                           (FB.REMOVE.FILE (|fetch| (FILEBROWSER 
                                                                                   TABLEBROWSER)
                                                                  |of| FBROWSER)
                                                  FBROWSER ITEM)
                                           (COND
                                              ((|fetch| TIDELETED |of| ITEM)
                                               'BOTH)
                                              (T 'TOTAL))))))
                          (COND
                             ((FB.MAYBE.INSERT.FILE FBROWSER ACTUALNEWNAME ITEM CMD)
                                                             (* \; 
                                 "ACTUALNEWNAME belongs in this browser, so TOTAL may have changed")
                              (OR CHANGETYPE (SETQ CHANGETYPE '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 22-Jan-94 20:24 by ")
    (PROG (PREFIX OLDNAME FIELDS SUBDIR FIRSTDATA RETAIN HOST DIR DEVICE)
          (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))
                              'HOST)
                       (LISTGET FIELDS 'DIRECTORY)
                       (LISTGET FIELDS 'DEVICE))
                   (OR (LISTGET FIELDS 'NAME)
                       (LISTGET FIELDS 'EXTENSION)
                       (LISTGET FIELDS 'VERSION)))           (* \; 
                         "Not a pure directory specification, and not just a simple directory name")
              (FB.PROMPTWPRINT FBROWSER "Not a well-formed directory specification."))
             ((SETQ PREFIX (FB.CANONICAL.DIRECTORY (\\ADD.CONNECTED.DIR PREFIX)
                                  FBROWSER CMD))
              (SETQ HOST (LISTGET (SETQ FIELDS (UNPACKFILENAME.STRING PREFIX))
                                'HOST))
              (SETQ DIR (OR (LISTGET FIELDS 'DIRECTORY)
                            (LISTGET FIELDS 'RELATIVEDIRECTORY)))
              (SETQ DEVICE (LISTGET FIELDS 'DEVICE))
              (|replace| (FILEBROWSER DEFAULTDIR) |of| FBROWSER |with| 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
                   (SELECTQ (FB.YES-OR-NO-P
                             (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)))))))
                                    "?")
                             FBROWSER
                             'Y)
                       (NIL                                  (* \; "Aborted")
                            (RETURN))
                       (Y (SETQ SUBDIR (ADD1 (NCHARS SUBDIR)))
                                                             (* \; "First character that changes")
                          T)
                       NIL))))

              (* |;;| "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 'HOST HOST 'DEVICE DEVICE 'DIRECTORY
                                  (|if| (NOT RETAIN)
                                      |then| DIR
                                    |else|               (* \; 
             "Merge destination directory with subdirectory of name between common prefix and root")
                                          (FB.MERGE.DIRECTORIES DIR
                                                 (SUBSTRING OLDNAME SUBDIR
                                                        (SUB1 (|fetch| (FBFILEDATA STARTOFNAME)
                                                                 |of| (|fetch| TIDATA
                                                                             |of| ITEM))))))
                                  'VERSION NIL 'BODY OLDNAME)
                           CMD MOVEFN)))))))

(FB.MERGE.DIRECTORIES
  (LAMBDA (PREFIX RETAIN)                                    (* \; "Edited 22-Jun-90 11:29 by nm")
    (COND
       (PREFIX (|if| RETAIN
                   |then| (CONCAT PREFIX (CL:SECOND \\FILENAME.SYNTAX)
                                     RETAIN)
                 |else| PREFIX))
       (T (|if| RETAIN
              |then| RETAIN
            |else| NIL)))))

(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 19-Oct-90 12:32 by gadener")

(* |;;;| "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)

                  (* |;;| 
                "Need to check that at least the FB pattern is not  longer than the NEWNAME")

                  (GEQ (NCHARS NEWNAME)
                       (SETQ N (SUB1 (|fetch| (FILEBROWSER DIRECTORYSTART) |of| FBROWSER)
                                     )))

                  (* |;;| 
                "Checks for match up to where the directory part start. i.e. the host part")

                  (STRING-EQUAL NEWNAME (|fetch| (FILEBROWSER PATTERN) |of| FBROWSER)
                         :END1 N :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 'VERSION NIL
                                                           '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 'CREATIONDATE (|fetch|
                                                                                   (FILEBROWSER
                                                                                    INFODISPLAYED)
                                                                                     |of| 
                                                                                           FBROWSER))
                                           ))
                                    (NULL (SETQ CRDATE (CL:NTH CRDATE FILEINFO)))
                                    (AND (SETQ CRDATE (IDATE CRDATE))
                                         (SETQ CRDATE2 (GETFILEINFO FULLNAME '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
                                                                      'BODY NEWNAME 'EXTENSION ""
                                                                      '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 '|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 '|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)                              (* \; "Edited 22-Nov-88 16:55 by bvm")

    (* |;;| "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 'DIRECTORY (OR (|fetch| (
                                                                                        FILEBROWSER
                                                                                          DEFAULTDIR)
                                                                               |of| BROWSER)
                                                                            (DIRECTORYNAME T))
                                               'VERSION NIL 'BODY OLDNAME)
                                        BROWSER T)))         (* \; "Aborted")
             NIL)
            ((NULL (SETQ NAMEFIELD (LISTGET (SETQ FIELDS (UNPACKFILENAME.STRING NEWNAME))
                                          'NAME)))           (* \; "Assume directory spec")
             (SETQ NEWNAME (\\ADD.CONNECTED.DIR NEWNAME))
             (|replace| (FILEBROWSER DEFAULTDIR) |of| BROWSER |with| NEWNAME)
             (PACKFILENAME.STRING 'DIRECTORY NEWNAME 'VERSION NIL 'BODY OLDNAME))
            ((AND (EQ (NCHARS NAMEFIELD)
                      0)
                  (OR (NULL (SETQ NAMEFIELD (LISTGET FIELDS 'EXTENSION)))
                      (EQ (NCHARS NAMEFIELD)
                          0)))                               (* \; 
                                                   "Directory spec with some more pieces after it?")
             (FB.PROMPTWPRINT BROWSER "Failed, malformed name")
             NIL)
            (T                                               (* \; "A plain old file name")
               (|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))
               (COND
                  ((SETQ DIR (COND
                                (FIELDS (SETQ DIR (PACKFILENAME.STRING FIELDS))
                                       (FB.CANONICAL.DIRECTORY (COND
                                                                      ((NEQ (CAR FIELDS)
                                                                            'HOST)
                                                                       (\\ADD.CONNECTED.DIR DIR))
                                                                      (T DIR))
                                              BROWSER CMD))
                                (T (DIRECTORYNAME T))))
                   (|replace| (FILEBROWSER DEFAULTDIR) |of| BROWSER |with| DIR)
                   (\\ADD.CONNECTED.DIR NEWNAME))))))))

(FB.CANONICAL.DIRECTORY
  (LAMBDA (DIRNAME FBROWSER CMD)                             (* \; "Edited 22-Nov-88 16:58 by bvm")
    (LET* ((PWINDOW (|ffetch| (FILEBROWSER PROMPTWINDOW) |of| (\\DTEST FBROWSER
                                                                                 'FILEBROWSER)))
           (OLDTTYSTREAM (TTYDISPLAYSTREAM PWINDOW))
           (OLDTTYPROC (TTY.PROCESS (THIS.PROCESS))))        (* \; 
                           "Point tty at our prompt window in case DIRECTORYNAME tries to interact")
          (CL:UNWIND-PROTECT
              (COND
                 ((DIRECTORYNAME DIRNAME NIL 'ASK))
                 ((EQ (FB.YES-OR-NO-P (CL:FORMAT NIL 
                                                 "Directory ~A does not exist yet; ~A anyway?" 
                                                 DIRNAME CMD)
                             FBROWSER)
                      'Y)
                  DIRNAME))
              (TTY.PROCESS OLDTTYPROC)
              (TTYDISPLAYSTREAM OLDTTYSTREAM)
              (WINDOWPROP PWINDOW 'PROCESS NIL)))))
)
(DEFINEQ

(FB.HARDCOPYCOMMAND
  (LAMBDA (BROWSER KEY ITEM MENU OPTION)                     (* \; 
                                                           "Edited 18-Feb-91 10:44 by gadener")

(* |;;;| "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 '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 15-Feb-91 17:13 by gadener")

    (* |;;| "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 'NAME '* 'EXTENSION (
                                                                     \\FB.HARDCOPY.TOFILE.EXTENSION
                                                                           )))
                                (T (PACKFILENAME.STRING 'VERSION NIL 'EXTENSION (
                                                                     \\FB.HARDCOPY.TOFILE.EXTENSION
                                                                                 )
                                          '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 '* (CADR TAIL)))
                                  (|if| (NEQ (CAR TAIL)
                                                 '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
                                                                              'DIRECTORY NIL)))
                  (FB.PROMPTWPRINT BROWSER "Bad pattern -- " MSG)
                  (RETURN))))
             (T (SETQ EXT (U-CASE (FILENAMEFIELD HCOPYFILE 'EXTENSION)))))
          (COND
             ((AND (NULL (SETQ PRINTFILETYPE (|for| TYPE |in| PRINTFILETYPES
                                                |when| (FMEMB EXT (CADR (ASSOC '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
                                                                         'CONVERSION))
                                               FILETYPE NAME FN FIELDS
             |do| (SETQ ITEM (FB.FETCHFILENAME ITEM))
                   (SETQ FILETYPE (OR (PRINTFILETYPE ITEM)
                                      '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
                                                                 'TENEX))
                                             (RPLACA HCOPYTAIL (CONCAT FORE (LISTGET FIELDS
                                                                                   'NAME)
                                                                      AFT))
                                             (CL:APPLY (FUNCTION PACKFILENAME.STRING)
                                                    '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 27-Feb-2021 19:07 by rmk:")
                                                             (* \; "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))
             (IF (DIRECTORYNAMEP FILE)
                 THEN (FB.BROWSECOMMAND BROWSER)
               ELSEIF (GETD 'OPENTEXTSTREAM)
                 THEN (FB.EDITCOMMAND.ONEFILE BROWSER FILE OPTION ITEM MENU)
               ELSE (FB.FASTSEECOMMAND BROWSER KEY ITEM MENU)))))

(FB.EDITCOMMAND.ONEFILE
  (LAMBDA (BROWSER FILE OPTION ITEM MENU)              (* \; "Edited 27-Feb-2021 20:07 by rmk:")
                                                             (* \; "Edited  1-Feb-88 19:00 by bvm:")

    (* |;;| "Called when we know that FILE is a file, not a directory, and that TEDIT exists.  If OPTION is READONLY, we don't want to edit, just view.  If FILE is a lisp sourcefile, we execute the font changes by COPY.TEXT.TO.IMAGE.")

    (* |;;| "We clear the shade stuff here because we don't want the FB to come up on top of our see/edit region.  We don't factor it to the top because we want to do whatever heavy lifting (copying files) before.  Don't factor to the end because then it is too late--the TEDIT window was up and then buried.  (If TEDIT had a don'topen option, we could set things up, then change the shade, then open.  We could also do the manufactured title on the window before it shows.")

    (CL:UNLESS OPTION (SETQ OPTION FB.DEFAULT.EDITOR))
    (CL:MULTIPLE-VALUE-BIND
     (IGNORE CONDITION)
     (IGNORE-ERRORS
      (IF (LISPSOURCEFILEP FILE)
          THEN (SELECTQ OPTION
                       ((LISP NIL TEDIT) 
                                         (* |;;| 
"Asks to load prop and edits the coms.  We really don't want to use a text editor on a source file.")

                            
                            (* |;;| "The FUNCALL at the bottom is concerning.")

                            (SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
                            (PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM FB.ITEMUNSELECTEDSHADE))
                            (FB.EDITLISPFILE FILE BROWSER))
                       (READONLY                             (* \; "READONLY on call from SEE")
                                 (CL:WITH-OPEN-FILE
                                  (STREAM FILE :DIRECTION :INPUT)
                                  (LET ((NSTR (OPENTEXTSTREAM)))
                                       (COPY.TEXT.TO.IMAGE STREAM NSTR)

                                 (* |;;| "Unshade the item before we create the TEDIT window, and tell FB.FINISH.COMMAND that we did that.  That way, the FB window won't pop up on top.")

                                       (SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
                                       (PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM FB.ITEMUNSELECTEDSHADE
                                                                          ))
                                       (WINDOWPROP (WFROMDS (TEXTSTREAM (TEDIT NSTR NIL NIL
                                                                               '(READONLY T))))
                                              'TITLE
                                              (CONCAT "SEE window for " (FULLNAME STREAM))))))
                       (CL:FUNCALL OPTION (MKATOM FILE)))
        ELSE (SELECTQ OPTION
                     (READONLY 
                               (* |;;| "From SEE command. We want to be able to scroll around in the content, can't do that if it isn't random access.  So in that case we do a secret NODIRCORE copy and look at that.")

                               (CL:WITH-OPEN-FILE
                                (STREAM FILE :DIRECTION :INPUT)
                                (LET ((NSTR))
                                     (CL:UNLESS (RANDACCESSP STREAM)
                                         (SETQ NSTR (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW NIL
                                                           (LIST (LIST 'TYPE (GETFILEINFO
                                                                              STREAM
                                                                              'TYPE)))))
                                         (COPYBYTES STREAM NSTR))
                                     (SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
                                     (PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM FB.ITEMUNSELECTEDSHADE))
                                     (WINDOWPROP (WFROMDS (TEXTSTREAM (TEDIT (OR NSTR STREAM)
                                                                             NIL NIL
                                                                             '(READONLY T))))
                                            'TITLE
                                            (CONCAT "SEE window for " (FULLNAME STREAM))))))
                     ((TEDIT NIL) 
                          (SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
                          (PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM FB.ITEMUNSELECTEDSHADE))
                          (TEDIT (MKATOM FILE)))
                     (LISP (FB.PROMPTW.FORMAT BROWSER "Failed because not a Lisp source file"))
                     (CL:FUNCALL OPTION (MKATOM FILE)))))
     (|if| CONDITION
         |then| (FB.PROMPTW.FORMAT BROWSER "Failed because ~A" CONDITION)))))

(FB.EDITLISPFILE
  (LAMBDA (FILE BROWSER)                               (* \; "Edited 21-Feb-2021 17:29 by rmk:")
                                                             (* \; "Edited 28-Jan-88 00:38 by bvm")
    (PROG (ROOT)
          (COND
             ((OR (NOT (STRING-EQUAL (CDAR (GETPROP (SETQ ROOT (U-CASE (ROOTFILENAME FILE)))
                                                  'FILEDATES))
                              FILE))
                  (NOT (GET ROOT 'FILE))
                  (NOT (BOUNDP (FILECOMS ROOT))))
              (FB.PROMPTW.FORMAT BROWSER "The file ~A is not loaded or is not current." FILE)
              (COND
                 ((MOUSECONFIRM (CONCAT "(LOAD '" FILE " 'PROP)?   ")
                         NIL
                         (|fetch| (FILEBROWSER PROMPTWINDOW) |of| BROWSER))
                  (EXEC-EVAL `(LOAD ',FILE 'PROP)))
                 (T (RETURN)))))
          (RESETFORM (TTYDISPLAYSTREAM PROMPTWINDOW)
                 (ED ROOT '(FILES :DONTWAIT))))))

(FB.BROWSECOMMAND
  (LAMBDA (BROWSER KEY ITEM MENU OPTION)               (* \; "Edited 20-Feb-2021 20:10 by rmk:")
                                                             (* \; "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 NAME (FB.FETCHFILENAME FILE))
       (|if|
        (OR
         (FB.DIRECTORYP FILE)
         (AND
          (NOT (|fetch| (FILEBROWSER NSPATTERN?) |of| BROWSER))
          (LET*
           ((FIELDS (UNPACKFILENAME.STRING NAME NIL NIL 'TENEX))
            (NAMETAIL (MEMB '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)
                                              '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 'DIRECTORY))
                  (SETQ SUBDIR (CL:APPLY (FUNCTION PACKFILENAME.STRING)
                                      NAMETAIL))
                  (LISTPUT FIELDS 'DIRECTORY
                         (|if| (NULL MAINDIR)
                             |then| SUBDIR
                           |else| (CONCAT MAINDIR (|if| (STRPOS "/" MAINDIR)
                                                          |then| "/"
                                                        |elseif| (STRPOS ">" MAINDIR)
                                                          |then| ">"
                                                        |elseif|
                                                        (EQ (GETHOSTINFO (LISTGET FIELDS 'HOST)
                                                                   'OSTYPE)
                                                            '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 `(,(FUNCTION FILEBROWSER)
                                     ',NAME
                                     ',(MAPCAR (|fetch| (FILEBROWSER INFODISPLAYED)
                                                  |of| BROWSER)
                                              (FUNCTION CAR))
                                     ,@(AND DEPTH `('(:DEPTH ,DEPTH)))))
         |else| (FB.PROMPTW.FORMAT BROWSER "~A is not a directory" NAME)))))
)
(DEFINEQ

(FB.FASTSEECOMMAND
  (LAMBDA (BROWSER KEY ITEM MENU UNFORMATTED)                (* \; "Edited 30-Aug-94 19:46 by jds")
    (PROG ((*UPPER-CASE-FILE-NAMES* NIL)
           FILELIST SEEWINDOW)
          (OR (SETQ FILELIST (FB.SELECTEDFILES BROWSER))
              (RETURN))
          (FB.ALLOW.ABORT BROWSER)
          (COND
             ((AND (NOT (WINDOWP (SETQ SEEWINDOW (|fetch| (FILEBROWSER SEEWINDOW)
                                                    |of| BROWSER))))
                   (FOR FILE IN FILELIST THEREIS 

                                               (* |;;| "Only need a SEE window if there's going to be a file to really SEE, as opposed to directories to browse.")

                                                       (OR (UNPACKFILENAME (FB.FETCHFILENAME
                                                                            FILE)
                                                                  'NAME)
                                                           (UNPACKFILENAME (FB.FETCHFILENAME
                                                                            FILE)
                                                                  'EXTENSION))))
                                                             (* \; "Create the SEE window")
              (SETQ SEEWINDOW (CREATEW NIL "SEE window"))
              (DSPSCROLL T SEEWINDOW)
              (|replace| (FILEBROWSER SEEWINDOW) |of| BROWSER |with| SEEWINDOW)
              (WINDOWPROP SEEWINDOW 'PAGEFULLFN (FUNCTION FB.SEEFULLFN))
              (WINDOWADDPROP SEEWINDOW 'CLOSEFN (FUNCTION (LAMBDA (W)
                                                            (WINDOWPROP W 'INUSE NIL)
                                                            (DEL.PROCESS (WINDOWPROP W 'PROCESS))))))
             )
          (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (WINDOW)
                                           (WINDOWPROP WINDOW 'PROCESS NIL)
                                                             (* \; 
                                                 "Remove process attached here by ttydisplaystream")
                                           (LET ((BUTTONS (WINDOWPROP WINDOW (WINDOWPROP WINDOW
                                                                                    '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 21-Feb-2021 14:46 by rmk:")
                                                           (* \; "Edited 20-Nov-2000 14:23 by rmk:")
                                                             (* \; "Edited 19-Aug-91 13:06 by jds")
    (COND
       ((DIRECTORYNAMEP FILE)

        (* |;;| "We're trying to SEE a directory.  Browse it instead. ")

        (FB.BROWSECOMMAND BROWSER))
       (T 
          (* |;;| "We're really browsing a file here, so SEE it.")

          (CLEARW WINDOW)
          (WINDOWPROP WINDOW 'TITLE (CONCAT "Viewing " FILE))
          (CL:MULTIPLE-VALUE-BIND
           (STREAM CONDITION)
           (IGNORE-ERRORS (OPENSTREAM FILE 'INPUT NIL '((TYPE TEXT)
                                                        (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
                                                                   'TITLE
                                                                   (CONCAT (WINDOWPROP WINDOW
                                                                                  'TITLE)
                                                                          " -- " "Aborted")))
                                                             (CLOSEF STREAM)))
                                                 STREAM WINDOW))
                            (WINDOWPROP WINDOW 'MORETYPE (COND
                                                            (MORE 'YETMOREBUTTONS)
                                                            (T 'LASTMOREBUTTONS)))
                            (COND
                               (UNFORMATTED (COPYCHARS STREAM WINDOW))
                               (T (PFCOPYBYTES STREAM WINDOW)))
                            (WINDOWPROP WINDOW 'TITLE (CONCAT (WINDOWPROP WINDOW 'TITLE)
                                                             " -- " "Finished"))
                            (COND
                               (MORE                         (* \; "Wait for OK to proceed")
                                     (FB.SEEFULLFN (WINDOWPROP WINDOW 'DSP)
                                            '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 'MORETYPE)))))
           (EVENT (WINDOWPROP WINDOW 'MOREEVENT)))
          (COND
             ((NOT BUTTONS)
              (SETQ BUTTONS (|create| MENU
                                   ITEMS _ (SELECTQ PROP
                                               (YETMOREBUTTONS 
                                                    '(("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 
                                                    '((" Next File " NEXT 
                                                             "Go on to view the next file")
                                                      ("Abort" ABORT 
                                                         "Abort the SEE command -- see no more files"
                                                             )))
                                               '((" 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 'MOREEVENT (SETQ EVENT (CREATE.EVENT (WINDOWPROP WINDOW 'TITLE))))))
          (ATTACHWINDOW BUTTONS WINDOW (COND
                                          ((GREATERP (|fetch| (REGION HEIGHT)
                                                        |of| (WINDOWPROP BUTTONS 'REGION))
                                                  (|fetch| (REGION BOTTOM)
                                                     |of| (WINDOWPROP WINDOW 'REGION)))
                                           'TOP)
                                          (T 'BOTTOM))
                 'LEFT)
          (|do| (TOTOPW BUTTONS)
                 (AWAIT.EVENT EVENT) |repeatuntil| (WINDOWPROP WINDOW '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 'MOREOK T)
                    (NOTIFY.EVENT (WINDOWPROP WINDOW 'MOREEVENT)))
              (NEXT                                          (* \; 
                                                   "Throw to the loop that is displaying each file")
                    (PROCESS.EVAL (WINDOWPROP WINDOW 'PROCESS)
                           '(CL:THROW :NEXT)))
              (ABORT                                         (* \; "Kill it")
                     (DEL.PROCESS (WINDOWPROP WINDOW '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))
                           'NAME
                           'LOAD
                           'BEFOREEXIT
                           '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))
                           'NAME
                           'COMPILE
                           'BEFOREEXIT
                           '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 'LOAD))
             NIL)
         (SETQ FORMS (|for| FILEENTRY |in| FILELIST
                        |collect| `(,FN ',(FB.FETCHFILENAME FILEENTRY)
                                            ,@(AND LDFLG `(',LDFLG)))))
         (EXEC-EVAL (|if| (CDR FORMS)
                        |then| (CONS 'PROGN FORMS)
                      |else| (CAR FORMS)))
         (CLOSEW (TTYDISPLAYSTREAM)))))
)
(DEFINEQ

(FB.UPDATECOMMAND
  (LAMBDA (BROWSER)                                          (* |bvm:| "27-Sep-85 12:30")
    (COND
       ((FB.MAYBE.EXPUNGE BROWSER '|Recompute|)
        (FB.UPDATEBROWSERITEMS BROWSER)))))

(FB.MAYBE.EXPUNGE
  (LAMBDA (BROWSER COMMAND)                            (* \; "Edited 22-Feb-2021 12:33 by rmk:")
                                                             (* |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 30-Aug-94 19:46 by jds")
    (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| (FILEBROWSER 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| (INFOFIELD INFONAME) |of| SPEC)
                                       WANTED)
                      |collect| (SETQ SPEC (COPY SPEC))
                            (|if| (SETQ PROTO (|fetch| (INFOFIELD INFOPROTOTYPE) |of|
                                                                                         SPEC))
                                |then|                   (* \; 
                                  "Have prototypical example, use it to get better width estimate.")
                                      (SETQ W (STRINGWIDTH PROTO FONT))
                                      (|replace| (INFOFIELD INFOWIDTH) |of| SPEC
                                         |with| (+ W (TIMES 2 (CHARWIDTH (CHARCODE X)
                                                                         FONT))))
                                      (|if| (LISTP (|fetch| (INFOFIELD INFOFORMAT)
                                                          |of| SPEC))
                                          |then| (RPLACA (CDR (|fetch| (INFOFIELD 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 'SIZE INFOWANTED :KEY (FUNCTION CAR))
                                        (CL:POSITION '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
                                                                         '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 'SUBTREE.SIZE))
                                    (|replace| (FILEBROWSER FBDISPLAYEDDEPTH) |of| 
                                                                                            BROWSER
                                       |with| (|replace| (FILEBROWSER FBCOMPUTEDDEPTH)
                                                     |of| BROWSER |with| (OR (FIXP DEPTH)
                                                                                     0)))
                                    (\\GENERATEFILES PATTERN DESIREDPROPS '(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 'CLEAR "No files in group " PATTERN))
                 (T (FB.PROMPTWPRINT BROWSER '|done|)
                    (SETQ WIDENED (FB.MAYBE.WIDEN.NAMES BROWSER))
                    (COND
                       ((OR (FB.ADJUST.DATE.WIDTH BROWSER INFOWANTED)
                            WIDENED)
                        (FB.HEADINGW.DISPLAY BROWSER (|fetch| (FILEBROWSER 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 30-Aug-94 19:40 by jds")

    (* |;;| "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| (INFOFIELD INFOFORMAT) |of| (SETQ SPEC (CAR TAIL)))
                           '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| (INFOFIELD 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)
               '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 'ADD))))

(FB.ANALYZE.PATTERN
  (LAMBDA (BROWSER SAMPLE)                                   (* \; "Edited  6-Apr-90 20:00 by NM")

(* |;;;| "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")

    (PROG ((PATTERN (|fetch| (FILEBROWSER PATTERN) |of| BROWSER))
           (SAMPLEHOSTEND 0)
           PATHOSTEND LASTPATDIR STARTOFNAME)
          (|do|                                          (* \; "Find end of sample's host name")
                 (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))
      RETRY
          (SETQ PATHOSTEND 0)
          (|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))
                                                     ((\: < > /) 
                                                             (* \; "{DSK} and {UNIX} on Sun represent root directory in a form of \"{DSK}<vmunix\" or \"{DSK}/vmunix\".")
                                                          (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")

          (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)))))
             ((NOT (STREQUAL PATTERN (SETQ PATTERN (FB.CANONICALIZE.PATTERN PATTERN SAMPLE 
                                                          PATHOSTEND SAMPLEHOSTEND LASTPATDIR))))
                                                             (* \; 
       "Pattern didn't seem to match what came back, but we could canonicalize into something else")
              (GO RETRY))
             (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.CANONICALIZE.PATTERN
  (LAMBDA (PATTERN SAMPLE PATHOSTEND SAMPLEHOSTEND LASTPATDIR)
                                                             (* \; "Edited  6-Jan-89 15:40 by bvm")

    (* |;;| "Get the \"canonical\" version of PATTERN so that its apparent directory matches what is coming back from the server.  E.g., {DSK} might become {DSK}<LispFiles>, or {x/n}<~> might become {x/n}<usr>jones>.")

    (OR (SELCHARQ (NTHCHARCODE SAMPLE (|add| SAMPLEHOSTEND 1))
             ((< /)                                          (* \; 
                                                     "Good, there's a directory -- canonicalize it")
                  (LET ((CANONICAL (DIRECTORYNAME (SUBSTRING PATTERN 1 (OR LASTPATDIR (SETQ 
                                                                                       LASTPATDIR 
                                                                                       PATHOSTEND))))
                               ))
                       (AND CANONICAL (CONCAT CANONICAL (SUBSTRING PATTERN (ADD1 LASTPATDIR))))))
             (PROGN                                          (* \; 
                          "File coming back has no directory, so there's nothing interesting to do")
                    NIL))
        PATTERN)))

(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)
                                   '(SIZE LENGTH))
                            (SETQ TREESIZE (\\GENERATEFILEINFO GENERATOR '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 '("Name" 'NAME "Sort files by name, decreasing version numbers"
                       (SUBITEMS ("Decreasing version" 'NAME 
                                        "Sort files by name, decreasing version numbers")
                              ("Increasing version" '(NAME T)
                                     "Sort files by name, increasing version numbers")))
               (|for| ATTR |in| (|fetch| (FILEBROWSER INFODISPLAYED) |of| BROWSER
                                               )
                  |collect| `(,(SETQ ATTR (CAR ATTR))
                                  ',ATTR "Sort by this attribute"
                                  ,(SELECTQ ATTR
                                       ((SIZE LENGTH BYTESIZE) 
                                            `(SUBITEMS ("Decreasing" ',ATTR 
                                                             "Sort files in order of decreasing size"
                                                              )
                                                    ("Increasing" '(,ATTR T)
                                                           "Sort files in order of increasing size")))
                                       ((CREATIONDATE WRITEDATE READDATE) 
                                            `(SUBITEMS ("Newer first" ',ATTR 
                                           "Sort files with newer dates appearing before older dates"
                                                              )
                                                    ("Older first" '(,ATTR T)
                                                           
                                           "Sort files with older dates appearing before newer dates"
                                                           )))
                                       NIL)))))))))
)
(DEFINEQ

(FB.EXPUNGECOMMAND
  (LAMBDA (FBROWSER KEY ITEM MENU CMD)                 (* \; "Edited 22-Feb-2021 12:36 by rmk:")
                                                             (* \; "Edited  9-Apr-93 22:07 by jds")
    (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 '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
                                                                 'BOTH))
                                                         (T (FB.PROMPTWPRINT FBROWSER T 
                                                                   "Couldn't expunge " FILENAME)
                                                            (SETQ FAILED T))) 

                                                   (* |;;| 
                            "Let other things run (Like the mouse, so user can ABORT the expunge!)")

                                                   (BLOCK))
              (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 22-Feb-2021 12:35 by rmk:")
                                                             (* \; "Edited 30-Aug-94 19:47 by jds")
    (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 'BOTTOM 'JUSTIFY 'LOCALCLOSE)
             (COND
                ((LESSP (|fetch| (REGION BOTTOM) |of| (SETQ REG (WINDOWPROP INFOMENUW
                                                                               '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| (FILEBROWSER 
                                                                                   INFOMENUCHOICES)
                                                                  |of| BROWSER))
             (|replace| (FILEBROWSER INFOMENUW) |of| BROWSER |with| INFOMENUW)
             (WINDOWADDPROP INFOMENUW 'CLOSEFN (FUNCTION (LAMBDA (W)
                                                           (AND (SETQ W (WINDOWPROP (MAINWINDOW
                                                                                     W T)
                                                                               'FILEBROWSER))
                                                                (|replace| (FILEBROWSER
                                                                                INFOMENUW)
                                                                   |of| W |with| NIL))))
                    T)))
         (FB.PROMPTWPRINT BROWSER '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 '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 'WIDTH)))
                                          (- SCREENWIDTH SCROLLBARWIDTH))))
          (|if| (AND (> (SETQ EXCESSHEIGHT (- (WINDOWPROP WINDOW '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
                                                                                 'REGION))
                                          (|fetch| (REGION HEIGHT)
                                             |of| (WINDOWPROP (|fetch| (FILEBROWSER
                                                                                PROMPTWINDOW)
                                                                     |of| BROWSER)
                                                             '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 '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 'HOST)))
         (COND
            ((SETQ ICON (WINDOWPROP (|fetch| (FILEBROWSER BROWSERWINDOW) |of| FBROWSER)
                               'ICONWINDOW))                 (* \; "Change the icon label")
             (ICONW.TITLE ICON PATTERN)))
         PATTERN)))

(FB.GET.NEWPATTERN
  (LAMBDA (BROWSER)                                          (* \; "Edited 30-Aug-94 19:47 by jds")
    (FB.ALLOW.ABORT BROWSER)
    (LET* ((OLDPATTERN (|fetch| (FILEBROWSER 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 '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)      (* \; "Edited 22-Feb-2021 12:41 by rmk:")
                                                             (* \; "Edited 30-Aug-94 19:47 by jds")
    (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 'TOP)
         (|replace| (FILEBROWSER COUNTERWINDOW) |of| (WINDOWPROP BROWSERWINDOW
                                                                        'FILEBROWSER) |with|
                                                                                      COUNTERW)
         (WINDOWPROP COUNTERW 'REPAINTFN (FUNCTION FB.COUNTERW.REDISPLAYFN))
         (WINDOWPROP COUNTERW 'RESHAPEFN (FUNCTION FB.COUNTERW.REDISPLAYFN))
         (WINDOWPROP COUNTERW 'PAGEFULLFN (FUNCTION NILL))   (* \; 
                                                      "Set up for modernized window moving/shaping")
         (WINDOWPROP COUNTERW 'BUTTONEVENTFN (FUNCTION TOTOPW.MODERNIZE))
         (WINDOWPROP BROWSERWINDOW 'TOPMARGIN 0)
         COUNTERW)))

(FB.COUNTERW.REDISPLAYFN
  (LAMBDA (COUNTERWINDOW)                                    (* \; "Edited  4-Feb-88 15:11 by bvm:")
    (LET ((BROWSER (WINDOWPROP (MAINWINDOW COUNTERWINDOW T)
                          '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)                                    (* \; "Edited 30-Aug-94 19:48 by jds")
    (LET* ((COUNTERW (|fetch| (FILEBROWSER 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 'HEIGHT))
           HERE LABELS)
          (SETQ LABELS (LIST (COND
                                ((|fetch| (FILEBROWSER SHOWUNDELETED?) |of| FBROWSER)
                                 (FB.COUNTER.STRING FBROWSER (IDIFFERENCE TOTAL DEL)
                                        (IDIFFERENCE TOTALPAGES DELPAGES)))
                                ((NEQ TYPE 'DELETED)         (* \; 
                                         "Don't need to update total if only deleted count changed")
                                 (FB.COUNTER.STRING FBROWSER TOTAL TOTALPAGES)))
                             (AND (NEQ TYPE '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
                          'REPLACE)))))

(FB.DISPLAY.COUNTERS
  (LAMBDA (FBROWSER)                                         (* \; "Edited 30-Aug-94 19:48 by jds")
    (LET* ((COUNTERW (|fetch| (FILEBROWSER 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 'WIDTH))
           (COUNTERFONT (DSPFONT NIL COUNTERW))
           (SECTIONWIDTH (IQUOTIENT COUNTERWIDTH 2))
           (THRESHOLDWIDTH (IDIFFERENCE SECTIONWIDTH (ITIMES 2 (CHARWIDTH (CHARCODE \a)
                                                                      COUNTERFONT))))
           (HEIGHT (WINDOWPROP COUNTERW '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
                                                                           '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-Feb-2021 12:29 by rmk:")
                                                             (* \; "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 'TOP)
         (WINDOWPROP HEADINGW 'PASSTOMAINCOMS T)             (* \; 
                       "Pass ALL window ops to main window, since we look sort of like a title bar")
         (DSPTEXTURE BLACKSHADE HEADINGW)
         (WINDOWPROP HEADINGW 'REPAINTFN (FUNCTION FB.HEADINGW.REDISPLAYFN))
         (WINDOWPROP HEADINGW 'RESHAPEFN (FUNCTION FB.HEADINGW.RESHAPEFN))
                                                             (* \; 
                                                           "This is a white on black window")
         (DSPOPERATION 'INVERT HEADINGW)
         (DSPFILL NIL BLACKSHADE 'REPLACE HEADINGW)          (* \; 
                                                      "Set up for modernized window moving/shaping")
         (WINDOWPROP HEADINGW 'BUTTONEVENTFN (FUNCTION TOTOPW.MODERNIZE))
         (WINDOWPROP BROWSERWINDOW 'TOPMARGIN 0)
         HEADINGW)))

(FB.HEADINGW.REDISPLAYFN
  (LAMBDA (WINDOW)                                           (* |bvm:| "19-Sep-85 14:39")
    (FB.HEADINGW.DISPLAY (WINDOWPROP (WINDOWPROP WINDOW 'MAINWINDOW)
                                    '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 'MAINWINDOW)
                           'FILEBROWSER)))
         (CLEARW WINDOW)
         (FB.HEADINGW.DISPLAY FBROWSER WINDOW))))

(FB.HEADINGW.DISPLAY
  (LAMBDA (FBROWSER WINDOW)                                  (* \; "Edited 30-Aug-94 19:42 by jds")
    (LET* ((STREAM (WINDOWPROP WINDOW 'DSP))
           (CLIP (DSPCLIPPINGREGION NIL WINDOW))
           (RMARG (|fetch| (REGION RIGHT) |of| CLIP))
           (BORDER (WINDOWPROP (MAINWINDOW WINDOW)
                          'BORDER))
           (NEXTPOS (+ BORDER (|fetch| (FILEBROWSER INFOSTART) |of| FBROWSER)))
           (DEPTH (|fetch| (FILEBROWSER FBDISPLAYEDDEPTH) |of| FBROWSER))
           FORMAT)
          (DSPFILL CLIP BLACKSHADE '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| (INFOFIELD 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 POSITION)                          (* \; "Edited 30-Aug-94 19:48 by jds")
    (OR OLDICON (TITLEDICONW FB.ICONSPEC (|fetch| (FILEBROWSER PATTERN)
                                            |of| (WINDOWPROP WINDOW 'FILEBROWSER))
                       FB.ICONFONT POSITION NIL NIL 'FILE))))

(FB.INFOMENU.WHENSELECTEDFN
  (LAMBDA (ITEM MENU KEY)                                    (* |bvm:| "18-Sep-85 11:51")
    (LET* ((INFO (CADR ITEM))
           (WINDOW (WINDOWPROP (WFROMMENU MENU)
                          'MAINWINDOW))
           (BROWSER (WINDOWPROP WINDOW '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"))
            'DON\'T)
           ((NEQ (TB.NUMBER.OF.ITEMS TBROWSER '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)
                '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 '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 'MENU)))
                                (EQ 1 (|fetch| (MENU MENUCOLUMNS) |of| MENU))))
         (SETQ ITEM (ASSOC '|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 30-Aug-94 19:42 by jds")
    (RESETLST
        (LET
         ((FBROWSER (WINDOWPROP WINDOW 'FILEBROWSER))
          (TBROWSER (WINDOWPROP WINDOW '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 'PRINTOPTIONS (LIST* 'DOCUMENT.NAME TITLE (STREAMPROP IMAGESTREAM
                                                                                  'PRINTOPTIONS)))
                                                             (* \; "Give the document a nice name")
         (FB.HARDCOPY.PRINT.TITLE (CONCAT "Directory of " (WINDOWPROP (|fetch| (FILEBROWSER
                                                                                        COUNTERWINDOW
                                                                                        )
                                                                             |of| FBROWSER)
                                                                     '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| (INFOFIELD INFOPROTOTYPE)
                                                          |of| SPEC))
                                     |then| (STRINGWIDTH PROTO IMAGESTREAM)
                                   |elseif| (EQ (|fetch| (INFOFIELD INFOFORMAT) |of|
                                                                                        SPEC)
                                                    '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| (INFOFIELD 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| (INFOFIELD 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")
                          (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")
                          DUMMY)
                         (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")
                           (FBCOMPUTEDDEPTH BYTE)            (* \; 
                                    "Depth at the time we enumerated directory (zero for infinite)")
                           (FBDISPLAYEDDEPTH BYTE)           (* \; 
                                            "Depth we are currently displaying (zero for infinite)")
                           (TABLEBROWSER POINTER)            (* \; 
                                           "Pointer to TABLEBROWSER object controlling the browser")
                           (BROWSERWINDOW POINTER)           (* \; "Main window")
                           (COUNTERWINDOW POINTER)           (* \; 
                                                       "Window that counts files, pages, deletions")
                           (HEADINGWINDOW POINTER)           (* \; 
                                                         "Window with headings for browser columns")
                           (INFOMENUW POINTER)               (* \; 
                           "Window containing choices for info to be displayed, or NIL if none yet")
                           (PROMPTWINDOW POINTER)            (* \; "GETPROMPTWINDOW BROWSERWINDOW")
                           (INFODISPLAYED POINTER)           (* \; 
                                                          "List of 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.")
                           DUMMY))
)

(/DECLAREDATATYPE 'FBFILEDATA
       '(POINTER POINTER POINTER FLAG FLAG FLAG POINTER BYTE POINTER WORD WORD WORD WORD POINTER)
       '((FBFILEDATA 0 POINTER)
         (FBFILEDATA 2 POINTER)
         (FBFILEDATA 4 POINTER)
         (FBFILEDATA 4 (FLAGBITS . 0))
         (FBFILEDATA 4 (FLAGBITS . 16))
         (FBFILEDATA 4 (FLAGBITS . 32))
         (FBFILEDATA 6 POINTER)
         (FBFILEDATA 8 (BITS . 7))
         (FBFILEDATA 10 POINTER)
         (FBFILEDATA 9 (BITS . 15))
         (FBFILEDATA 12 (BITS . 15))
         (FBFILEDATA 13 (BITS . 15))
         (FBFILEDATA 14 (BITS . 15))
         (FBFILEDATA 16 POINTER))
       '18)

(/DECLAREDATATYPE 'FILEBROWSER
       '(FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG BYTE BYTE POINTER POINTER POINTER POINTER POINTER 
              POINTER POINTER POINTER POINTER POINTER POINTER POINTER WORD WORD WORD WORD WORD WORD 
              WORD WORD POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
              POINTER POINTER POINTER WORD WORD POINTER POINTER POINTER)
       '((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 (BITS . 135))
         (FILEBROWSER 1 (BITS . 7))
         (FILEBROWSER 2 POINTER)
         (FILEBROWSER 4 POINTER)
         (FILEBROWSER 6 POINTER)
         (FILEBROWSER 8 POINTER)
         (FILEBROWSER 10 POINTER)
         (FILEBROWSER 12 POINTER)
         (FILEBROWSER 14 POINTER)
         (FILEBROWSER 16 POINTER)
         (FILEBROWSER 18 POINTER)
         (FILEBROWSER 20 POINTER)
         (FILEBROWSER 22 POINTER)
         (FILEBROWSER 24 POINTER)
         (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 (BITS . 15))
         (FILEBROWSER 33 (BITS . 15))
         (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 POINTER)
         (FILEBROWSER 58 (BITS . 15))
         (FILEBROWSER 59 (BITS . 15))
         (FILEBROWSER 60 POINTER)
         (FILEBROWSER 62 POINTER)
         (FILEBROWSER 64 POINTER))
       '66)

(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 FB.BROWSER.DIRECTORY.FONT ITALICFONT PRINTFILETYPES)
)

(DECLARE\: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)
)

(/DECLAREDATATYPE 'FILEBROWSER
       '(FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG BYTE BYTE POINTER POINTER POINTER POINTER POINTER 
              POINTER POINTER POINTER POINTER POINTER POINTER POINTER WORD WORD WORD WORD WORD WORD 
              WORD WORD POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
              POINTER POINTER POINTER WORD WORD POINTER POINTER POINTER)
       '((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 (BITS . 135))
         (FILEBROWSER 1 (BITS . 7))
         (FILEBROWSER 2 POINTER)
         (FILEBROWSER 4 POINTER)
         (FILEBROWSER 6 POINTER)
         (FILEBROWSER 8 POINTER)
         (FILEBROWSER 10 POINTER)
         (FILEBROWSER 12 POINTER)
         (FILEBROWSER 14 POINTER)
         (FILEBROWSER 16 POINTER)
         (FILEBROWSER 18 POINTER)
         (FILEBROWSER 20 POINTER)
         (FILEBROWSER 22 POINTER)
         (FILEBROWSER 24 POINTER)
         (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 (BITS . 15))
         (FILEBROWSER 33 (BITS . 15))
         (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 POINTER)
         (FILEBROWSER 58 (BITS . 15))
         (FILEBROWSER 59 (BITS . 15))
         (FILEBROWSER 60 POINTER)
         (FILEBROWSER 62 POINTER)
         (FILEBROWSER 64 POINTER))
       '66)

(/DECLAREDATATYPE 'FBFILEDATA
       '(POINTER POINTER POINTER FLAG FLAG FLAG POINTER BYTE POINTER WORD WORD WORD WORD POINTER)
       '((FBFILEDATA 0 POINTER)
         (FBFILEDATA 2 POINTER)
         (FBFILEDATA 4 POINTER)
         (FBFILEDATA 4 (FLAGBITS . 0))
         (FBFILEDATA 4 (FLAGBITS . 16))
         (FBFILEDATA 4 (FLAGBITS . 32))
         (FBFILEDATA 6 POINTER)
         (FBFILEDATA 8 (BITS . 7))
         (FBFILEDATA 10 POINTER)
         (FBFILEDATA 9 (BITS . 15))
         (FBFILEDATA 12 (BITS . 15))
         (FBFILEDATA 13 (BITS . 15))
         (FBFILEDATA 14 (BITS . 15))
         (FBFILEDATA 16 POINTER))
       '18)
(ADDTOVAR SYSTEMRECLST

(DATATYPE FILEBROWSER ((NOSUBDIRECTORIES FLAG)
                           (NSPATTERN? FLAG)
                           (SHOWUNDELETED? FLAG)
                           (PATTERNPARSED? FLAG)
                           (SORTBYDATE FLAG)
                           (FBREADY FLAG)
                           (ABORTING FLAG)
                           (FIXEDTITLE FLAG)
                           (FBCOMPUTEDDEPTH BYTE)
                           (FBDISPLAYEDDEPTH BYTE)
                           (TABLEBROWSER POINTER)
                           (BROWSERWINDOW POINTER)
                           (COUNTERWINDOW POINTER)
                           (HEADINGWINDOW POINTER)
                           (INFOMENUW POINTER)
                           (PROMPTWINDOW POINTER)
                           (INFODISPLAYED POINTER)
                           (PATTERN POINTER)
                           (PREPAREDPATTERN POINTER)
                           (SEEWINDOW POINTER)
                           (BROWSERFONT POINTER)
                           (SORTBY POINTER)
                           (NAMESTART WORD)
                           (DIRECTORYSTART WORD)
                           (INFOSTART WORD)
                           (NAMEOVERHEAD WORD)
                           (OVERFLOWSPACING WORD)
                           (DIGITWIDTH WORD)
                           (TOTALFILES WORD)
                           (DELETEDFILES WORD)
                           (TOTALPAGES POINTER)
                           (DELETEDPAGES POINTER)
                           (PAGECOUNT? POINTER)
                           (COUNTERPOSITIONS POINTER)
                           (COUNTERPAGESTRING POINTER)
                           (OVERFLOWWIDTHS POINTER)
                           (INFOMENUCHOICES POINTER)
                           (UPDATEPROC POINTER)
                           (DEFAULTDIR POINTER)
                           (SORTATTRIBUTE POINTER)
                           (SORTMENU POINTER)
                           (FBLOCK POINTER)
                           (SORTINDEX WORD)
                           (SIZEINDEX WORD)
                           (FBDEPTH POINTER)
                           (ABORTWINDOW POINTER)
                           DUMMY))

(DATATYPE FBFILEDATA ((FILENAME POINTER)
                          (FILEINFO POINTER)
                          (VERSIONLESSNAME POINTER)
                          (DIRECTORYP FLAG)
                          (HASDIRPREFIX FLAG)
                          (DIRECTORYFILEP FLAG)
                          (SIZE POINTER)
                          (FILEDEPTH BYTE)
                          (SORTVALUE POINTER)
                          (SUBDIREND WORD)
                          (STARTOFPNAME WORD)
                          (VERSION WORD)
                          (STARTOFNAME WORD)
                          DUMMY))
)
(DECLARE\: DONTEVAL@LOAD DOCOPY 

(MOVD? 'PROMPTFORWORD 'TTYINPROMPTFORWORD NIL T)


(ADDTOVAR *ATTACHED-WINDOW-COMMAND-SYNONYMS* (HARDCOPYIMAGEW.TOFILE . HARDCOPYIMAGEW)
                                                 (HARDCOPYIMAGEW.TOPRINTER . HARDCOPYIMAGEW))

(ADDTOVAR |BackgroundMenuCommands| ("FileBrowser" '(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 ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 
1991 1993 1994 1999 2000 2001 2021))
(DECLARE\: DONTCOPY
  (FILEMAP (NIL (28186 50822 (FB 28196 . 29152) (FB.COPYBINARYCOMMAND 29154 . 29500) (FB.COPYTEXTCOMMAND
 29502 . 29844) (FILEBROWSER 29846 . 42952) (FB.TABLEBROWSER 42954 . 43171) (FB.SELECTEDFILES 43173 . 
43810) (FB.FETCHFILENAME 43812 . 44204) (FB.DIRECTORYP 44206 . 44534) (FB.PROMPTWPRINT 44536 . 45582) 
(FB.PROMPTW.FORMAT 45584 . 46321) (FB.PROMPTFORINPUT 46323 . 48575) (FB.YES-OR-NO-P 48577 . 49611) (
FB.ALLOW.ABORT 49613 . 50467) (\\FB.HARDCOPY.TOFILE.EXTENSION 50469 . 50820)) (50846 51799 (FB.STARTUP
 50856 . 51371) (FB.MAKERIGIDWINDOW 51373 . 51797)) (51800 57172 (FB.PRINTFN 51810 . 56963) (FB.COPYFN
 56965 . 57170)) (57222 63264 (FB.MENU.WHENSELECTEDFN 57232 . 57590) (FB.COMMANDSELECTEDFN 57592 . 
59131) (FB.SUBITEMP 59133 . 59568) (FB.MAKE.BROWSER.BUSY 59570 . 60308) (FB.FINISH.COMMAND 60310 . 
62275) (FB.HANDLE.ABORT.BUTTON 62277 . 63262)) (63265 68781 (FB.DELETECOMMAND 63275 . 63556) (
FB.DELVERCOMMAND 63558 . 66751) (FB.IS.NOT.SUBDIRECTORY.ITEM 66753 . 66934) (FB.DELVER.FILES 66936 . 
68025) (FB.DELETE.FILE 68027 . 68779)) (68782 70107 (FB.UNDELETECOMMAND 68792 . 69077) (
FB.UNDELETEALLCOMMAND 69079 . 69358) (FB.UNDELETE.FILE 69360 . 70105)) (70108 94289 (FB.COPYCOMMAND 
70118 . 70387) (FB.RENAMECOMMAND 70389 . 70664) (FB.COPY/RENAME.COMMAND 70666 . 71589) (
FB.COPY/RENAME.ONE 71591 . 73913) (FB.COPY/RENAME.MANY 73915 . 80135) (FB.MERGE.DIRECTORIES 80137 . 
80555) (FB.GREATEST.PREFIX 80557 . 81913) (FB.MAYBE.INSERT.FILE 81915 . 89355) (FB.GET.NEW.FILE.SPEC 
89357 . 93188) (FB.CANONICAL.DIRECTORY 93190 . 94287)) (94290 102074 (FB.HARDCOPYCOMMAND 94300 . 95430
) (FB.HARDCOPY.TOFILE 95432 . 102072)) (102075 113638 (FB.EDITCOMMAND 102085 . 102886) (
FB.EDITCOMMAND.ONEFILE 102888 . 107854) (FB.EDITLISPFILE 107856 . 108895) (FB.BROWSECOMMAND 108897 . 
113636)) (113639 125432 (FB.FASTSEECOMMAND 113649 . 117099) (FB.FASTSEE.ONEFILE 117101 . 120130) (
FB.SEEFULLFN 120132 . 124263) (FB.SEEBUTTONFN 124265 . 125430)) (125433 127179 (FB.LOADCOMMAND 125443
 . 125950) (FB.COMPILECOMMAND 125952 . 126490) (FB.OPERATE.ON.FILES 126492 . 127177)) (127180 174229 (
FB.UPDATECOMMAND 127190 . 127415) (FB.MAYBE.EXPUNGE 127417 . 128412) (FB.UPDATEBROWSERITEMS 128414 . 
141629) (FB.DATE 141631 . 142372) (FB.ADJUST.DATE.WIDTH 142374 . 145342) (FB.SET.BROWSER.TITLE 145344
 . 146201) (FB.MAYBE.WIDEN.NAMES 146203 . 148322) (FB.SET.DEFAULT.NAME.WIDTH 148324 . 149688) (
FB.CREATE.FILEBUCKET 149690 . 156910) (FB.CHECK.NAME.LENGTH 156912 . 159333) (FB.ADD.FILEGROUP 159335
 . 160862) (FB.INSERT.DIRECTORY 160864 . 161102) (FB.MAKE.SUBDIRECTORY.ITEM 161104 . 162513) (
FB.ADD.FILE 162515 . 163128) (FB.INSERT.FILE 163130 . 166542) (FB.ANALYZE.PATTERN 166544 . 171808) (
FB.CANONICALIZE.PATTERN 171810 . 173122) (FB.GETALLFILEINFO 173124 . 174227)) (174230 182389 (
FB.SORT.VERSIONS 174240 . 177011) (FB.DECREASING.VERSION 177013 . 177682) (FB.INCREASING.VERSION 
177684 . 178305) (FB.NAMES.DECREASING.VERSION 178307 . 179342) (FB.NAMES.INCREASING.VERSION 179344 . 
180341) (FB.DECREASING.NUMERIC.ATTR 180343 . 181023) (FB.INCREASING.NUMERIC.ATTR 181025 . 181699) (
FB.ALPHABETIC.ATTR 181701 . 182387)) (182390 192232 (FB.SORTCOMMAND 182400 . 189230) (
FB.INSERT.SUBDIRECTORIES 189232 . 190029) (FB.GET.SORT.MENU 190031 . 192230)) (192233 208322 (
FB.EXPUNGECOMMAND 192243 . 194762) (FB.NEWPATTERNCOMMAND 194764 . 195162) (FB.NEWINFOCOMMAND 195164 . 
197930) (FB.DEPTHCOMMAND 197932 . 199707) (FB.SHAPECOMMAND 199709 . 203051) (FB.REMOVE.FILE 203053 . 
204874) (FB.COUNT.FILE.CHANGE 204876 . 206321) (FB.SETNEWPATTERN 206323 . 207493) (FB.GET.NEWPATTERN 
207495 . 208079) (FB.OPTIONSCOMMAND 208081 . 208320)) (208357 209369 (
FB.INFOMENU.SHADEINITIALSELECTIONS 208367 . 209014) (FB.INFO.ITEM.NAMED 209016 . 209367)) (209370 
218836 (FB.MAKECOUNTERWINDOW 209380 . 210842) (FB.COUNTERW.REDISPLAYFN 210844 . 211431) (
FB.UPDATE.COUNTERS 211433 . 213505) (FB.DISPLAY.COUNTERS 213507 . 218567) (FB.COUNTER.STRING 218569 . 
218834)) (218837 223480 (FB.MAKEHEADINGWINDOW 218847 . 220395) (FB.HEADINGW.REDISPLAYFN 220397 . 
220663) (FB.HEADINGW.RESHAPEFN 220665 . 221041) (FB.HEADINGW.DISPLAY 221043 . 223478)) (223481 227664 
(FB.ICONFN 223491 . 223838) (FB.INFOMENU.WHENSELECTEDFN 223840 . 224570) (FB.CLOSEFN 224572 . 225775) 
(FB.EXPUNGE?.MENU 225777 . 226189) (FB.AFTERCLOSEFN 226191 . 226552) (FB.CLOSE&EXPUNGE 226554 . 227662
)) (227665 239723 (FB.HARDCOPY.DIRECTORY 227675 . 238032) (FB.HARDCOPY.PRINT.TITLE 238034 . 238360) (
FB.HARDCOPY.MAXWIDTH 238362 . 239721)))))
STOP
\ No newline at end of file
diff --git a/library/FILEBROWSER.LCOM b/library/FILEBROWSER.LCOM
index 78f5bd47..444d474d 100644
Binary files a/library/FILEBROWSER.LCOM and b/library/FILEBROWSER.LCOM differ
