(FILECREATED " 8-Aug-86 12:35:11" {ROSEBOWL}<FEUERMAN>LISP>NCSERVER>FILEBROWSERPATCH.;3 14433
changes to: (FNS FB.UPDATEBROWSERITEMS FB.STARTUP FILEBROWSER)
(VARS FILEBROWSERPATCHCOMS)
previous date: " 8-Aug-86 10:25:41" {ROSEBOWL}<FEUERMAN>LISP>NCSERVER>FILEBROWSERPATCH.;1)
(PRETTYCOMPRINT FILEBROWSERPATCHCOMS)
(RPAQQ FILEBROWSERPATCHCOMS ((FNS FILEBROWSER FBLIST.GETALLFILEINFO FB.STARTUP
FB.UPDATEBROWSERITEMS)))
(DEFINEQ
(FILEBROWSER
[LAMBDA (FILESPEC ATTRIBUTES OPTIONS) (* Feuerman " 8-Aug-86 10:24")
(* * kef 8/8/86: Added possibility of NOTHING for ATTRIBUTES.)
(PROG ((TITLEFONT (DSPFONT NIL WindowTitleDisplayStream))
(BROWSERFONTHEIGHT (FONTPROP FB.BROWSERFONT (QUOTE HEIGHT)))
BROWSER PROMPTWHEIGHT COUNTERHEIGHT COMMANDMENUWINDOW COMMANDMENUWIDTH BROWSERWIDTH
BROWSERWINDOW COMMANDMENU HEADINGW COUNTERW REGION TITLE)
[COND
([AND (LISTP OPTIONS)
(SMALLP (CAR OPTIONS))
(AND (EQLENGTH OPTIONS 4)
(EVERY OPTIONS (FUNCTION NUMBERP]
(* Old style)
(SETQ REGION OPTIONS)
(SETQ OPTIONS))
(T (SETQ REGION (LISTGET OPTIONS (QUOTE REGION]
(PROGN (* Figure out the size of the fixed pieces before
prompting for a region)
(SETQ COMMANDMENU (create MENU
MENUFONT ← FB.MENUFONT
ITEMS ←(OR (LISTGET OPTIONS (QUOTE
MENU.ITEMS))
FB.MENU.ITEMS)
CENTERFLG ← T
MENUCOLUMNS ← 1
WHENSELECTEDFN ←(FUNCTION FB.MENU.WHENSELECTEDFN)
TITLE ←(OR (LISTGET OPTIONS (QUOTE
MENU.TITLE))
"FB Commands")))
(SETQ COMMANDMENUWIDTH (fetch (MENU IMAGEWIDTH) of COMMANDMENU))
[SETQ PROMPTWHEIGHT (HEIGHTIFWINDOW (ITIMES FB.PROMPTLINES
(FONTPROP FB.PROMPTFONT
(QUOTE HEIGHT]
(SETQ COUNTERHEIGHT (HEIGHTIFWINDOW (FONTPROP TITLEFONT (QUOTE HEIGHT))
T)))
[PROGN (* First make the main window, carved out of the space
in REGION leftover after the fixed parts are accounted
for)
[OR REGION (SETQ REGION (GETREGION (PROG1 (IPLUS COMMANDMENUWIDTH
FB.DEFAULT.NAME.WIDTH
TB.LEFT.MARGIN)
(* Min width is menu plus enough space to print a
name)
)
(PROG1 (IPLUS PROMPTWHEIGHT
COUNTERHEIGHT
(ITIMES 6
BROWSERFONTHEIGHT))
(* Min height is prompt window plus counter window
plus heading plus 5 lines of files)
]
[SETQ BROWSERWINDOW (CREATEW (create REGION
using REGION WIDTH ←(SETQ BROWSERWIDTH
(IDIFFERENCE
(fetch (REGION WIDTH)
of REGION)
COMMANDMENUWIDTH))
HEIGHT ←(IDIFFERENCE
(fetch (REGION HEIGHT)
of REGION)
(IPLUS COUNTERHEIGHT
PROMPTWHEIGHT
BROWSERFONTHEIGHT]
(DSPFONT FB.BROWSERFONT BROWSERWINDOW)
[WINDOWPROP BROWSERWINDOW (QUOTE FILEBROWSER)
(SETQ BROWSER
(create FILEBROWSER
BROWSERWINDOW ← BROWSERWINDOW
BROWSERFONT ← FB.BROWSERFONT
OVERFLOWSPACING ←(ITIMES 3 (CHARWIDTH
(CHARCODE a)
FB.BROWSERFONT))
SORTBY ←(FUNCTION FB.NAMES.DECREASING.VERSION)
FIXEDTITLE ←(SETQ TITLE (LISTGET OPTIONS
(QUOTE TITLE]
(replace (FILEBROWSER TABLEBROWSER) of BROWSER
with (TB.MAKE.BROWSER NIL BROWSERWINDOW (LIST (QUOTE PRINTFN)
(FUNCTION FB.PRINTFN)
(QUOTE COPYFN)
(FUNCTION FB.COPYFN)
(QUOTE USERDATA)
BROWSER
(QUOTE CLOSEFN)
(FUNCTION FB.CLOSEFN)
(QUOTE AFTERCLOSEFN)
(FUNCTION
FB.AFTERCLOSEFN]
(PROGN (* Atop this sits the black heading window, with
labels for each column in browser)
(FB.MAKEHEADINGWINDOW BROWSERWINDOW BROWSERWIDTH BROWSERFONTHEIGHT
FB.BROWSERFONT))
(PROGN (* Atop that is the counter window, whose title
contains the file pattern)
(FB.MAKECOUNTERWINDOW BROWSERWINDOW TITLEFONT BROWSERWIDTH COUNTERHEIGHT TITLE)
)
(PROGN (* Main command menu sits on the right side)
(SETQ COMMANDMENUWINDOW (MENUWINDOW COMMANDMENU))
(ATTACHWINDOW COMMANDMENUWINDOW BROWSERWINDOW (QUOTE RIGHT)
(QUOTE TOP)))
[PROGN (* Finally the prompt window atop it all)
(replace (FILEBROWSER PROMPTWINDOW) of BROWSER
with (FB.MAKERIGIDWINDOW (GETPROMPTWINDOW BROWSERWINDOW FB.PROMPTLINES
FB.PROMPTFONT]
(PROGN (* Now make them all open. For some reason, attaching
the menu didn't open it)
(TOTOPW BROWSERWINDOW))
(WINDOWPROP BROWSERWINDOW (QUOTE SCROLLFN)
(FUNCTION FB.SCROLLFN))
(COND
[(LISTP ATTRIBUTES) (* User specifies which attributes to use)
(for X on ATTRIBUTES do (OR (FB.\ItemWithTag (CAR X)
FB.INFOMENUITEMS)
(AND (LISTP DIRCOMMANDS)
(MISSPELLED? (CAR X)
99 DIRCOMMANDS NIL X]
((EQ ATTRIBUTES (QUOTE NOTHING))
(SETQ ATTRIBUTES NIL))
(T (SETQ ATTRIBUTES FB.DEFAULT.INFO)))
(replace (FILEBROWSER INFOMENUCHOICES) of BROWSER with ATTRIBUTES)
(WINDOWPROP BROWSERWINDOW (QUOTE ICONFN)
(FUNCTION FB.ICONFN))
(ADD.PROCESS (LIST (FUNCTION FB.STARTUP)
BROWSER COMMANDMENU (KWOTE FILESPEC))
(QUOTE NAME)
(QUOTE FB-Update)
(QUOTE BEFOREEXIT)
(QUOTE DON'T))
(RETURN BROWSERWINDOW])
(FBLIST.GETALLFILEINFO
[LAMBDA (FILENAME ATTRIBUTES) (* Feuerman " 8-Aug-86 10:01")
(for ATTR in ATTRIBUTES bind INFO RESULT when (SETQ INFO (GETFILEINFO FILENAME ATTR))
do (push RESULT ATTR INFO) finally (RETURN RESULT])
(FB.STARTUP
[LAMBDA (BROWSER COMMANDMENU FILESPEC) (* Feuerman " 8-Aug-86 12:24")
(RESETLST (FB.MAKE.BROWSER.BUSY BROWSER (FASSOC (QUOTE Recompute)
(fetch (MENU ITEMS) of COMMANDMENU))
COMMANDMENU)
(COND
(FILESPEC [replace PATTERN of BROWSER with (COND
((LISTP FILESPEC)
FILESPEC)
(T (SETQ FILESPEC
(DIRECTORY.FILL.PATTERN
FILESPEC]
(FB.UPDATEBROWSERITEMS BROWSER))
(T (FB.NEWPATTERNCOMMAND BROWSER])
(FB.UPDATEBROWSERITEMS
[LAMBDA (BROWSER) (* Feuerman " 8-Aug-86 12:34")
(* * kef 8/8/86: Updated to handle possible list spec of PATTERN.)
(RESETLST (PROG ((WINDOW (fetch (FILEBROWSER BROWSERWINDOW) of BROWSER))
(TBROWSER (fetch (FILEBROWSER TABLEBROWSER) of BROWSER))
(TITLEWINDOW (fetch (FILEBROWSER COUNTERWINDOW) of BROWSER))
PATTERN INFOWANTED FILEGENERATOR FILENAME)
(OR (SETQ PATTERN (fetch PATTERN of BROWSER))
(RETURN))
(RESETSAVE NIL (LIST (FUNCTION FB.CLEANUP.UPDATE)
BROWSER))
(replace (FILEBROWSER UPDATEPROC) of BROWSER with (THIS.PROCESS))
(* So that CLOSE can abort it)
(WINDOWADDPROP WINDOW (QUOTE CLOSEFN)
(FUNCTION FB.ABORT.UPDATE)
T)
(FB.PROMPTWPRINT BROWSER T "Enumerating " (COND
((LISTP PATTERN)
(CONCAT "(" (CAR PATTERN)))
(T PATTERN))
(QUOTE ...))
(replace (FILEBROWSER INFODISPLAYED) of BROWSER
with (SETQ INFOWANTED (fetch (FILEBROWSER INFOMENUCHOICES)
of BROWSER)))
(OR (fetch (FILEBROWSER FIXEDTITLE) of BROWSER)
(WINDOWPROP TITLEWINDOW (QUOTE TITLE)
(CONCAT (COND
((LISTP PATTERN)
(CONCAT "(" (CAR PATTERN)
"..."))
(T PATTERN))
" browser")))
(CLEARW TITLEWINDOW)
(TB.REPLACE.ITEMS TBROWSER NIL)
(FB.SET.DEFAULT.NAME.WIDTH BROWSER)
[replace (FILEBROWSER PAGECOUNT?) of BROWSER
with (CAR (OR (MEMB (QUOTE SIZE)
INFOWANTED)
(MEMB (QUOTE LENGTH)
INFOWANTED]
[replace (FILEBROWSER DELETEDFILES) of BROWSER
with (replace (FILEBROWSER DELETEDPAGES) of BROWSER
with (replace (FILEBROWSER TOTALPAGES) of BROWSER
with (replace (FILEBROWSER TOTALFILES)
of BROWSER with 0]
(replace (FILEBROWSER SORTMENU) of BROWSER with (replace
(FILEBROWSER
PATTERNPARSED?)
of BROWSER
with NIL))
(PROGN (replace (FILEBROWSER NOSUBDIRECTORIES) of BROWSER
with NIL)
(replace (FILEBROWSER SORTATTRIBUTE) of BROWSER with NIL)
(replace (FILEBROWSER SORTBY) of BROWSER
with (FUNCTION FB.NAMES.DECREASING.VERSION)))
(FB.HEADINGW.DISPLAY BROWSER (fetch HEADINGWINDOW of BROWSER))
[COND
[(LISTP PATTERN)
(for FILENAME in PATTERN bind PREVSUBDIR LASTFILE LASTFILENAME
OTHERFILES NEWFILEITEM NEWFILEDATA
do [COND
((LISTP FILENAME)
(SETQ FILENAME (CONCATCODES FILENAME]
[SETQ NEWFILEDATA (fetch TIDATA
of (SETQ NEWFILEITEM
(FB.CREATE.FILEBUCKET
BROWSER FILENAME
(FBLIST.GETALLFILEINFO FILENAME
INFOWANTED]
[COND
((AND LASTFILE (STRING-EQUAL (fetch (FBFILEDATA
VERSIONLESSNAME)
of NEWFILEDATA)
LASTFILENAME))
(* This file same name as previous one, so save it in
case we need to sort versions)
(push OTHERFILES NEWFILEITEM))
(T [COND
(LASTFILE (FB.ADD.FILEGROUP TBROWSER BROWSER LASTFILE
OTHERFILES PREVSUBDIR)
(SETQ PREVSUBDIR (fetch (FBFILEDATA
SUBDIRECTORY)
of (fetch TIDATA
of LASTFILE]
(SETQ OTHERFILES NIL)
(SETQ LASTFILE NEWFILEITEM)
(SETQ LASTFILENAME (fetch (FBFILEDATA VERSIONLESSNAME)
of NEWFILEDATA]
finally (AND LASTFILE (FB.ADD.FILEGROUP TBROWSER BROWSER
LASTFILE OTHERFILES
PREVSUBDIR]
(T [SETQ FILEGENERATOR (\GENERATEFILES PATTERN INFOWANTED
(QUOTE (SORT RESETLST]
(while (SETQ FILENAME (\GENERATENEXTFILE FILEGENERATOR))
bind PREVSUBDIR LASTFILE LASTFILENAME OTHERFILES NEWFILEITEM
NEWFILEDATA
do [COND
((LISTP FILENAME)
(SETQ FILENAME (CONCATCODES FILENAME]
[SETQ NEWFILEDATA (fetch TIDATA
of (SETQ NEWFILEITEM
(FB.CREATE.FILEBUCKET
BROWSER FILENAME
(FB.GETALLFILEINFO FILENAME
FILEGENERATOR
INFOWANTED]
[COND
((AND LASTFILE (STRING-EQUAL (fetch (FBFILEDATA
VERSIONLESSNAME)
of NEWFILEDATA)
LASTFILENAME))
(* This file same name as previous one, so save it in
case we need to sort versions)
(push OTHERFILES NEWFILEITEM))
(T [COND
(LASTFILE (FB.ADD.FILEGROUP TBROWSER BROWSER LASTFILE
OTHERFILES PREVSUBDIR)
(SETQ PREVSUBDIR
(fetch (FBFILEDATA SUBDIRECTORY)
of (fetch TIDATA of LASTFILE]
(SETQ OTHERFILES NIL)
(SETQ LASTFILE NEWFILEITEM)
(SETQ LASTFILENAME (fetch (FBFILEDATA VERSIONLESSNAME)
of NEWFILEDATA]
finally (AND LASTFILE (FB.ADD.FILEGROUP TBROWSER BROWSER
LASTFILE OTHERFILES
PREVSUBDIR]
[COND
((EQ (TB.NUMBER.OF.ITEMS TBROWSER)
0)
(FB.PROMPTWPRINT BROWSER (QUOTE CLEAR)
"No files in group " PATTERN))
(T (FB.PROMPTWPRINT BROWSER (QUOTE done))
(COND
((FB.MAYBE.WIDEN.NAMES BROWSER)
(FB.HEADINGW.DISPLAY BROWSER (fetch HEADINGWINDOW of BROWSER))
(TB.REDISPLAY.ITEMS (fetch (FILEBROWSER TABLEBROWSER)
of BROWSER]
(FB.UPDATE.HEADING.EXTENT BROWSER WINDOW)
(FB.DISPLAY.COUNTERS BROWSER)
(AND (LISTP PATTERN)
(WINDOWPROP TITLEWINDOW (QUOTE TITLE)
(CONCAT "(" (CAR PATTERN)
"... browser"])
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (462 14411 (FILEBROWSER 472 . 6777) (FBLIST.GETALLFILEINFO 6779 . 7090) (FB.STARTUP 7092
. 7690) (FB.UPDATEBROWSERITEMS 7692 . 14409)))))
STOP