(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)


(FILECREATED "19-Jul-2023 09:30:47" |{WMEDLEY}<library>FILEBROWSER.;25|
 265978 

      :EDIT-BY |rmk|

      :CHANGES-TO (VARS FILEBROWSERCOMS)

      :PREVIOUS-DATE "18-Jul-2023 22:19:30" |{WMEDLEY}<library>FILEBROWSER.;24|)


(PRETTYCOMPRINT FILEBROWSERCOMS)

(RPAQQ FILEBROWSERCOMS

       ((COMS (DECLARE\: EVAL@COMPILE DONTCOPY (FILES (FROM LOADUPS)
                                                      EXPORTS.ALL))
              (FILES ATTACHEDWINDOW ICONW TABLEBROWSER)
              (P 
                 (* |;;| "Set up for MODERNIZE windows, whether or not MODERNIZE is pre-loaded")


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


                    (DECLARE\: DONTCOPY (E (SETQ *PRINT-ARRAY* T))
                           
                           (* |;;| "lmm 12/21: *PRINT-ARRAY* also controls printing bitmaps. When doing MAKEFILE set it. It's RESETVAR'd so no need to set it back")


                           DOCOPY
                           (INITVARS (FB.ICONSPEC '(#*(83 70)OOOOOOOOOOOOOOOOOOOON@@@OOOOOOOOOOOOOOOOOOOON@@@L@@@@@@@@@@@@@@@@@@@F@@@L@@@@@@@@@@@@@@@@@@@F@@@LOOOOOOOOOOOOOOOOOONF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@GOOOOOL@@@@@BF@@@LH@@@@@D@@@@@D@@@@@BF@@@LH@@@@@D@@@@@D@@@@@BF@@@LH@@@@@DCOOOHD@@@@@BF@@@LH@@@@@D@@@@@D@@@@@BF@@@LH@@@@@DOOOOND@@@@@BF@@@LH@@@@@D@@@@@D@@@@@BF@@@LH@@@@@D@@@@@D@@@@@BF@@@LH@@@@@GOOOOOL@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@COOOOOH@@@@@BF@@@LH@@@@@COOOOOH@@@@@BF@@@LH@@@@@B@@@@@H@@@@@BF@@@LH@@@@@A@@@@A@@@@@@BF@@@LH@@@@@@OOOON@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LOOOOOOOOOOOOOOOOOONF@@@L@@@@@@@@@@@@@@@@@@@F@@@L@@@@@@@@@@@@@@@@@@@F@@@OOOOOOOOOOOOOOOOOOOON@@@OOOOOOOOOOOOOOOOOOOON@@@
                                                    NIL
                                                    (5 5 73 40))))))
              (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"
                                                              )
                                                       ("Fix directory dates" FB.FIX-DIRECTORY-DATES
                                                              
                                                "Ensure that directory dates match FILECREATED dates"
                                                              )))
                                         (|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.FIX-DIRECTORY-DATES 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.GETWINDOW)
              (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 (LOADCOMP)
                                                TABLEBROWSER)
               (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 

(FILESLOAD (FROM
 LOADUPS)
       EXPORTS.ALL)
)

(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."
)


(DECLARE\: DONTCOPY 
DOCOPY 

(RPAQ? FB.ICONSPEC
 '(#*(83 70)OOOOOOOOOOOOOOOOOOOON@@@OOOOOOOOOOOOOOOOOOOON@@@L@@@@@@@@@@@@@@@@@@@F@@@L@@@@@@@@@@@@@@@@@@@F@@@LOOOOOOOOOOOOOOOOOONF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@GOOOOOL@@@@@BF@@@LH@@@@@D@@@@@D@@@@@BF@@@LH@@@@@D@@@@@D@@@@@BF@@@LH@@@@@DCOOOHD@@@@@BF@@@LH@@@@@D@@@@@D@@@@@BF@@@LH@@@@@DOOOOND@@@@@BF@@@LH@@@@@D@@@@@D@@@@@BF@@@LH@@@@@D@@@@@D@@@@@BF@@@LH@@@@@GOOOOOL@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@COOOOOH@@@@@BF@@@LH@@@@@COOOOOH@@@@@BF@@@LH@@@@@B@@@@@H@@@@@BF@@@LH@@@@@A@@@@A@@@@@@BF@@@LH@@@@@@OOOON@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LOOOOOOOOOOOOOOOOOONF@@@L@@@@@@@@@@@@@@@@@@@F@@@L@@@@@@@@@@@@@@@@@@@F@@@OOOOOOOOOOOOOOOOOOOON@@@OOOOOOOOOOOOOOOOOOOON@@@
                     NIL
                     (5 5 73 40)))
)

(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")
                       ("Fix directory dates" FB.FIX-DIRECTORY-DATES 
                              "Ensure that directory dates match FILECREATED dates")))
         (|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 29-Oct-2021 21:18 by rmk:")

                                                             (* \; "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)
                               ',(OR 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)
                                   (* \; "Edited 18-Jul-2023 22:19 by rmk")

                                                             (* |bvm:| "13-Oct-85 17:44")

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

                                                           "Edited  2-Dec-2021 19:05 by larry")

                                                             (* |bvm:| "22-Jul-85 15:08")


(* |;;;| "True if SUBITEM appears among the subitems of ITEM or descendents")


    (LET ((SI (CADDDR ITEM)))
         (AND SI (EQ (CAR (LISTP SI))
                     'SUBITEMS)
              (OR (MEMBER SUBITEM SI)
                  (|for|
 I |in|
 (CDR SI) |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 19-Sep-2021 18:07 by rmk:")

                                                             (* \; 

                                                           "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.  .")


    (* |;;| "We clear the shade stuff here because we don't want the FB to come up on top of our see/edit region.   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))       (* \; "Default editor is TEDIT. ")


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

    (* |;;| "The particular item may be a subitem of the EDIT or SEE menu item, in which case we want to unshade that too.  Seems a little bruteforce")


    (CL:UNLESS (MEMBER ITEM (FETCH
 (MENU ITEMS) OF
 MENU))
        (FOR
 I IN
 (FETCH
 (MENU ITEMS) OF
 MENU)
           WHEN
 (MEMBER ITEM (CDR (SASSOC 'SUBITEMS I))) DO
 (SHADEITEM I MENU 
                                                                           FB.ITEMUNSELECTEDSHADE)
                                                                   (PUTMENUPROP MENU 'ITEMSHADE
                                                                          (CONS I 
                                                                               FB.ITEMUNSELECTEDSHADE
                                                                                ))))
    (CL:MULTIPLE-VALUE-BIND (IGNORE CONDITION)
           (IGNORE-ERRORS (SELECTQ OPTION
                              (READONLY (TEDIT-SEE FILE))
                              (LISP                          (* \; 

"Original code allowed OPTION=NIL in thie branch, but NIL should have been coerced to TEDIT above.")


                                    (* |;;| "Asks to load prop and edits the coms, presumably with SEDIT.  We really don't want to use a text editor on a source file.")


                                    (IF
 (LISPSOURCEFILEP FILE)
                                        THEN
 (FB.EDITLISPFILE
 FILE BROWSER)
                                      ELSE
 (FB.PROMPTW.FORMAT
 BROWSER 
                                                      "Failed because not a Lisp source file")))
                              (PROGN 
                                     (* |;;| "Might just be a call to TEDIT (if OPTION = TEDIT)")


                                     (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.FIX-DIRECTORY-DATES

  (LAMBDA (BROWSER)                                          (* \; 

                                                           "Edited 23-Nov-2021 12:15 by rmk:")

                                                             (* \; 

                                                           "Edited 21-Aug-2021 23:33 by rmk:")


    (* |;;| 

"FILEDATE returns the source-file date of a compiled file.  We have to call with CFLG T to be sure.")


    (FOR
 F FD CHANGE IN
 (FILDIR (FETCH
 (FILEBROWSER
 PATTERN) OF
 BROWSER))
       WHEN
 (SETQ FD (OR (FILEDATE F T)
                             (FILEDATE F))) UNLESS
 (IEQP (SETQ FD (IDATE FD))
                                                             (GETFILEINFO F 'ICREATIONDATE))
       DO
 (SETQ CHANGE T)
             (SETFILEINFO F 'ICREATIONDATE FD) FINALLY
 (CL:WHEN CHANGE (FB.UPDATECOMMAND

                                                                            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 16-Oct-2021 14:06 by rmk:")


    (* |;;| "RMK:  Tried to decode and rearrange with Y2K error.  Now just pass it through.  It used to include the short day of week, that seems silly.  It is today's date...or at least the date of the last recompute")


    (* |;;| "(DATEFORMAT NO.LEADING.SPACES NO.SECONDS DAY.OF.WEEK DAY.SHORT)")


    (* |;;| "I think this only goes in the title bar, which is perhaps odd in itself.")


    (DATE (DATEFORMAT NO.LEADING.SPACES NO.SECONDS))))

(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 16-Oct-2021 14:10 by rmk:")


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


    (* |;;| "RMK: Move the date over a bit, so that path stands out")


    (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.GETWINDOW

  (LAMBDA (WINDOW WHICH)                                     (* \; 

                                                           "Edited 16-Oct-2021 15:02 by rmk:")


    (* |;;| "Closed function to get at filebrowser attached windows by type, without need record declarations at runtime. Helps MODERNIZE get the right regions.")


    (LET* ((FBWINDOW (CENTRALWINDOW WINDOW))
           (FILEBROWSER
 (WINDOWPROP FBWINDOW 'FILEBROWSER)))
          (CL:WHEN FILEBROWSER
              (SELECTQ WHICH
                  (HEADING (FETCH
 (FILEBROWSER
 HEADINGWINDOW) OF
 FILEBROWSER))
                  (COUNTER (FETCH
 (FILEBROWSER
 COUNTERWINDOW) OF
 FILEBROWSER))
                  (BROWSER FBWINDOW)
                  (PROMPT (FETCH
 (FILEBROWSER
 PROMPTWINDOW) OF
 FILEBROWSER))
                  (COMMAND (FIND
 W IN
 (WINDOWPROP FBWINDOW 'ATTACHEDWINDOWS)
                              SUCHTHAT
 (EQ 'MENUBUTTONFN (WINDOWPROP W 'BUTTONEVENTFN))))
                  NIL)))))
)
(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 (LOADCOMP)
       TABLEBROWSER)

(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)
)
(DECLARE\: DONTCOPY
  (FILEMAP (NIL (31814 54695 (FB 31824 . 32959) (FB.COPYBINARYCOMMAND 32961 . 33307) (FB.COPYTEXTCOMMAND
 33309 . 33651) (FILEBROWSER 33653 . 46759) (FB.TABLEBROWSER 46761 . 46978) (FB.SELECTEDFILES 46980 . 
47617) (FB.FETCHFILENAME 47619 . 48011) (FB.DIRECTORYP 48013 . 48407) (FB.PROMPTWPRINT 48409 . 49455) 
(FB.PROMPTW.FORMAT 49457 . 50194) (FB.PROMPTFORINPUT 50196 . 52448) (FB.YES-OR-NO-P 52450 . 53484) (
FB.ALLOW.ABORT 53486 . 54340) (\\FB.HARDCOPY.TOFILE.EXTENSION 54342 . 54693)) (54719 55672 (FB.STARTUP
 54729 . 55244) (FB.MAKERIGIDWINDOW 55246 . 55670)) (55673 61156 (FB.PRINTFN 55683 . 60836) (FB.COPYFN
 60838 . 61154)) (61206 67546 (FB.MENU.WHENSELECTEDFN 61216 . 61574) (FB.COMMANDSELECTEDFN 61576 . 
63115) (FB.SUBITEMP 63117 . 63718) (FB.MAKE.BROWSER.BUSY 63720 . 64524) (FB.FINISH.COMMAND 64526 . 
66557) (FB.HANDLE.ABORT.BUTTON 66559 . 67544)) (67547 73063 (FB.DELETECOMMAND 67557 . 67838) (
FB.DELVERCOMMAND 67840 . 71033) (FB.IS.NOT.SUBDIRECTORY.ITEM 71035 . 71216) (FB.DELVER.FILES 71218 . 
72307) (FB.DELETE.FILE 72309 . 73061)) (73064 74389 (FB.UNDELETECOMMAND 73074 . 73359) (
FB.UNDELETEALLCOMMAND 73361 . 73640) (FB.UNDELETE.FILE 73642 . 74387)) (74390 98571 (FB.COPYCOMMAND 
74400 . 74669) (FB.RENAMECOMMAND 74671 . 74946) (FB.COPY/RENAME.COMMAND 74948 . 75871) (
FB.COPY/RENAME.ONE 75873 . 78195) (FB.COPY/RENAME.MANY 78197 . 84417) (FB.MERGE.DIRECTORIES 84419 . 
84837) (FB.GREATEST.PREFIX 84839 . 86195) (FB.MAYBE.INSERT.FILE 86197 . 93637) (FB.GET.NEW.FILE.SPEC 
93639 . 97470) (FB.CANONICAL.DIRECTORY 97472 . 98569)) (98572 106356 (FB.HARDCOPYCOMMAND 98582 . 99712
) (FB.HARDCOPY.TOFILE 99714 . 106354)) (106357 116556 (FB.EDITCOMMAND 106367 . 107234) (
FB.EDITCOMMAND.ONEFILE 107236 . 110640) (FB.EDITLISPFILE 110642 . 111747) (FB.BROWSECOMMAND 111749 . 
116554)) (116557 128478 (FB.FASTSEECOMMAND 116567 . 120017) (FB.FASTSEE.ONEFILE 120019 . 123176) (
FB.SEEFULLFN 123178 . 127309) (FB.SEEBUTTONFN 127311 . 128476)) (128479 130225 (FB.LOADCOMMAND 128489
 . 128996) (FB.COMPILECOMMAND 128998 . 129536) (FB.OPERATE.ON.FILES 129538 . 130223)) (130226 178411 (
FB.UPDATECOMMAND 130236 . 130461) (FB.FIX-DIRECTORY-DATES 130463 . 131486) (FB.MAYBE.EXPUNGE 131488 . 
132549) (FB.UPDATEBROWSERITEMS 132551 . 145766) (FB.DATE 145768 . 146409) (FB.ADJUST.DATE.WIDTH 146411
 . 149379) (FB.SET.BROWSER.TITLE 149381 . 150383) (FB.MAYBE.WIDEN.NAMES 150385 . 152504) (
FB.SET.DEFAULT.NAME.WIDTH 152506 . 153870) (FB.CREATE.FILEBUCKET 153872 . 161092) (
FB.CHECK.NAME.LENGTH 161094 . 163515) (FB.ADD.FILEGROUP 163517 . 165044) (FB.INSERT.DIRECTORY 165046
 . 165284) (FB.MAKE.SUBDIRECTORY.ITEM 165286 . 166695) (FB.ADD.FILE 166697 . 167310) (FB.INSERT.FILE 
167312 . 170724) (FB.ANALYZE.PATTERN 170726 . 175990) (FB.CANONICALIZE.PATTERN 175992 . 177304) (
FB.GETALLFILEINFO 177306 . 178409)) (178412 186571 (FB.SORT.VERSIONS 178422 . 181193) (
FB.DECREASING.VERSION 181195 . 181864) (FB.INCREASING.VERSION 181866 . 182487) (
FB.NAMES.DECREASING.VERSION 182489 . 183524) (FB.NAMES.INCREASING.VERSION 183526 . 184523) (
FB.DECREASING.NUMERIC.ATTR 184525 . 185205) (FB.INCREASING.NUMERIC.ATTR 185207 . 185881) (
FB.ALPHABETIC.ATTR 185883 . 186569)) (186572 196414 (FB.SORTCOMMAND 186582 . 193412) (
FB.INSERT.SUBDIRECTORIES 193414 . 194211) (FB.GET.SORT.MENU 194213 . 196412)) (196415 212636 (
FB.EXPUNGECOMMAND 196425 . 199010) (FB.NEWPATTERNCOMMAND 199012 . 199410) (FB.NEWINFOCOMMAND 199412 . 
202244) (FB.DEPTHCOMMAND 202246 . 204021) (FB.SHAPECOMMAND 204023 . 207365) (FB.REMOVE.FILE 207367 . 
209188) (FB.COUNT.FILE.CHANGE 209190 . 210635) (FB.SETNEWPATTERN 210637 . 211807) (FB.GET.NEWPATTERN 
211809 . 212393) (FB.OPTIONSCOMMAND 212395 . 212634)) (212671 213724 (FB.GETWINDOW 212681 . 213722)) (
213725 214737 (FB.INFOMENU.SHADEINITIALSELECTIONS 213735 . 214382) (FB.INFO.ITEM.NAMED 214384 . 214735
)) (214738 224270 (FB.MAKECOUNTERWINDOW 214748 . 216276) (FB.COUNTERW.REDISPLAYFN 216278 . 216865) (
FB.UPDATE.COUNTERS 216867 . 218939) (FB.DISPLAY.COUNTERS 218941 . 224001) (FB.COUNTER.STRING 224003 . 
224268)) (224271 228980 (FB.MAKEHEADINGWINDOW 224281 . 225895) (FB.HEADINGW.REDISPLAYFN 225897 . 
226163) (FB.HEADINGW.RESHAPEFN 226165 . 226541) (FB.HEADINGW.DISPLAY 226543 . 228978)) (228981 233164 
(FB.ICONFN 228991 . 229338) (FB.INFOMENU.WHENSELECTEDFN 229340 . 230070) (FB.CLOSEFN 230072 . 231275) 
(FB.EXPUNGE?.MENU 231277 . 231689) (FB.AFTERCLOSEFN 231691 . 232052) (FB.CLOSE&EXPUNGE 232054 . 233162
)) (233165 245223 (FB.HARDCOPY.DIRECTORY 233175 . 243532) (FB.HARDCOPY.PRINT.TITLE 243534 . 243860) (
FB.HARDCOPY.MAXWIDTH 243862 . 245221)))))
STOP