(FILECREATED "30-Jul-85 18:44:07" {ERIS}<LISPCORE>LIBRARY>FILEBROWSER.;43 59233
changes to: (VARS FBPROFILE)
(FNS FB.GET.NEWPATTERN)
previous date: "21-Jul-85 01:12:38" {ERIS}<LISPCORE>LIBRARY>FILEBROWSER.;42)
(* Copyright (c) 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT FILEBROWSERCOMS)
(RPAQQ FILEBROWSERCOMS [(COMS (FILES ATTACHEDWINDOW ICONW)
(INITVARS (FCOMPILEOPS NIL)
(FB.EDITMENU NIL)
(FB.EXPUNGEOPS)
(FUPDATEOPS NIL)
(FLOADOPS NIL)
(FBCLOSEMENU NIL)
(FBICONFONT (FONTCREATE (QUOTE HELVETICA)
8
(QUOTE MRR)))
(DEFAULTBROWSERFONT (FONTCREATE (QUOTE GACHA)
10
(QUOTE MRR)))
(FBPROMPTFONT (FONTCREATE (QUOTE GACHA)
8
(QUOTE MRR)))
(BROWSERMENUFONT (FONTCREATE (QUOTE HELVETICA)
10
(QUOTE MRR)))
(FBBORDERWIDTH 2))
(VARS FB.EDITMENU.ITEMS FBCLOSEMENUITEMS FBMENUITEMS FBPROFILE
INFOLISTINGWIDTHS INFOSHADE FBINFOMENUITEMS FBITEMUNSELECTEDSHADE
FBITEMSELECTEDSHADE)
(BITMAPS FILEDRAWER FILEDRAWERMASK))
(COMS (* * Main filebrowser fns)
(FNS FB FILEBROWSER))
(COMS (* * commands and major subfunctions)
(FNS FB.EXPUNGECOMMAND FB.HARDCOPYCOMMAND FB.LOADCOMMAND FB.NEWPATTERNCOMMAND
FB.GET.NEWPATTERN FB.RENAMECOMMAND FB.EDITCOMMAND FB.DELETECOMMAND FB.SEECOMMAND
FB.COMPILECOMMAND FB.COPYCOMMAND FB.GET.NEW.FILE.SPEC FB.UNDELETECOMMAND
FB.UPDATECOMMAND)
(FNS FB.MAKECOUNTERWINDOW FB.MAKESEEWINDOW FB.COMMANDDISPATCH FB.EDITLISPFILE FB.SELECT
FB.COPY.HANDLER FB.UPDATEBROWSERITEMS))
(COMS (* * lower-level window mungers)
(FNS FB.MAKERIGIDWINDOW FB.CLRPROMPTW FB.PRINTHEADINGSON FB.PRINTANDGETREGION
FB.MAKEHEADINGWINDOW FB.PROMPTWPRINT FB.PROMPTWTERPRI FB.SELECTFILE
FB.UNSELECTFILE FB.CHANGEDELETEMARK FB.CHANGECOPYSELECTMARK
FB.INFOMENU.SHADEINITIALSELECTIONS FB.SHOW.NUMDELETED FB.SHOW.NUMFILES
FB.SHOW.NUMSELECTED))
(COMS (* * window functions)
(FNS FB.HEADINGWREDISPLAYFN FB.REPAINT.COUNTERW FB.ICONFN FB.REPAINTFN FB.SCROLLFN
FB.MENU.WHENSELECTEDFN FB.INFOMENU.WHENSELECTEDFN FB.CLOSEFN FB.SEEW.REPAINTFN
FB.SEEW.RESHAPEFN))
(COMS (* * odds and ends)
(FNS FB.AFFECT.FILE.SEPARATELY/UNDOABLY FB.FETCHFILENAME FB.STARTOFNAME FB.STARTUP
FB.CREATEPRINTSPEC FB.FINDFILEBUCKET FB.PROMPTFORINPUT FB.GETALLFILEINFO
FB.\ItemWithTag))
(DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS (MarkXPos 16))
(RECORDS INFOWPRINTSPEC FILEBUCKET)
(MACROS ISLISPFILE? .COPYKEYDOWNP.)
(GLOBALVARS FBICONFONT DEFAULTBROWSERFONT FBPROMPTFONT BROWSERMENUFONT
FBBORDERWIDTH FBCLOSEMENU FB.EDITMENU FILEDRAWER FILEDRAWERMASK
FB.EDITMENU.ITEMS FBCLOSEMENUITEMS FBMENUITEMS FBPROFILE
INFOLISTINGWIDTHS INFOSHADE FBINFOMENUITEMS FBITEMUNSELECTEDSHADE
FBITEMSELECTEDSHADE DIRCOMMANDS FB.EXPUNGEOPS))
(DECLARE: DONTEVAL@LOAD DOCOPY (ADDVARS (BackgroundMenuCommands ("FileBrowser" (FB)
"Opens a filebrowser window; prompts for pattern")))
(VARS (BackgroundMenu)))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA FB)
(NLAML)
(LAMA FB.PROMPTWPRINT])
(FILESLOAD ATTACHEDWINDOW ICONW)
(RPAQ? FCOMPILEOPS NIL)
(RPAQ? FB.EDITMENU NIL)
(RPAQ? FB.EXPUNGEOPS )
(RPAQ? FUPDATEOPS NIL)
(RPAQ? FLOADOPS NIL)
(RPAQ? FBCLOSEMENU NIL)
(RPAQ? FBICONFONT (FONTCREATE (QUOTE HELVETICA)
8
(QUOTE MRR)))
(RPAQ? DEFAULTBROWSERFONT (FONTCREATE (QUOTE GACHA)
10
(QUOTE MRR)))
(RPAQ? FBPROMPTFONT (FONTCREATE (QUOTE GACHA)
8
(QUOTE MRR)))
(RPAQ? BROWSERMENUFONT (FONTCREATE (QUOTE HELVETICA)
10
(QUOTE MRR)))
(RPAQ? FBBORDERWIDTH 2)
(RPAQQ FB.EDITMENU.ITEMS ((TEdit (QUOTE TEDIT)
"Calls TEdit (text editor) on selected files")
(DEdit (QUOTE DEDIT)
"Calls DEdit (Lisp editor) on selected files")))
(RPAQQ FBCLOSEMENUITEMS (("Expunge deleted files" (QUOTE EXPUNGE)
"Erases all files still marked 'deleted'")
("Don't expunge" (QUOTE NOEXPUNGE)
"Closes browser without expunging files marked deleted")))
(RPAQQ FBMENUITEMS ((Edit Edit
"Calls an editor on the selected files:
DEDIT for LISP source & TEDIT for other files
(Use MIDDLE mouse button to select options)")
(Delete Delete
"Marks selected files for deletion:
(Use EXPUNGE to remove files from system)")
(Undelete Undelete "Removes deletion mark for selected files")
(Expunge Expunge "Removes files marked for deletion from the system")
(Load Load "LOADs selected files
(Use MIDDLE mouse button to select options)")
(Compile Compile
"Compiles selected LISP source files:
(Use MIDDLE mouse button to select options)")
(Copy Copy "Copies selected files:
(Prompts for new file name)")
(Rename Rename "Renames selected files:
(Prompts for new names)")
(See See "Displays each selected file its own window")
(Update Update
"Updates list of files satisfying selection pattern:
(Use MIDDLE mouse button to select options)")
(Hardcopy Hardcopy "Produces hardcopy of selected files")
("" "" "")))
(RPAQQ FBPROFILE (NAME LENGTH AUTHOR CREATIONDATE))
(RPAQQ INFOLISTINGWIDTHS (NAME (Name . 140)
LENGTH
(Length . 60)
SIZE
(Pages . 45)
BYTESIZE
(Bits . 40)
AUTHOR
(Author . 120)
TYPE
(Type . 55)
CREATIONDATE
(Created . 170)
READDATE
(Read . 170)
WRITEDATE
(Written . 180)))
(RPAQQ INFOSHADE 16920)
(RPAQQ FBINFOMENUITEMS ((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 FBITEMUNSELECTEDSHADE 0)
(RPAQQ FBITEMSELECTEDSHADE 43605)
(RPAQ FILEDRAWER (READBITMAP))
(75 75
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"N@@@@@@@@@@@@@@@@@N@"
"N@@@@@@@@@@@@@@@@@N@"
"NGOOOOOOOOOOOOOOOLN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@AOOOOOOH@@@@DN@"
"ND@@@A@@@@@@H@@@@DN@"
"ND@@@A@@@@@@H@@@@DN@"
"ND@@@A@OOOOHH@@@@DN@"
"ND@@@A@@@@@@H@@@@DN@"
"ND@@@AAOOOOLH@@@@DN@"
"ND@@@A@@@@@@H@@@@DN@"
"ND@@@A@@@@@@H@@@@DN@"
"ND@@@AOOOOOOH@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@OOOOOO@@@@@DN@"
"ND@@@@L@@@@C@@@@@DN@"
"ND@@@@OOOOOO@@@@@DN@"
"ND@@@@GOOOON@@@@@DN@"
"ND@@@@GOOOON@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"NGOOOOOOOOOOOOOOOLN@"
"N@@@@@@@@@@@@@@@@@N@"
"N@@@@@@@@@@@@@@@@@N@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@")
(RPAQ FILEDRAWERMASK (READBITMAP))
(75 75
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@")
(* * Main filebrowser fns)
(DEFINEQ
(FB
[NLAMBDA PATTERN (* bvm: "20-Jul-85 22:26")
(* * FILEBROWSER entry from top-level exec: FB PATTERN ... PROPS ...)
(LET ((PAT&PROPS (NLAMBDA.ARGS PATTERN)))
(FILEBROWSER (OR (CAR PAT&PROPS)
(PROMPTFORWORD "File browser pattern?" NIL NIL PROMPTWINDOW))
(CDR PAT&PROPS)))
NIL])
(FILEBROWSER
[LAMBDA (FILESPEC DESIREDPROPS) (* bvm: "20-Jul-85 22:28")
(PROG ((PROMPTWHEIGHT 3)
COMMANDMENUWINDOW BROWSERWINDOW COMMANDMENU DIRSTART HEADINGW COUNTERW INFOMENUW)
(COND
((NULL FILESPEC)
(RETURN)))
(SETQ FILESPEC (DIRECTORY.FILL.PATTERN FILESPEC))
(SETQ COMMANDMENU
(create MENU
MENUFONT ← BROWSERMENUFONT
ITEMS ← FBMENUITEMS
CENTERFLG ← T
MENUROWS ← 4
WHENSELECTEDFN ←(FUNCTION FB.MENU.WHENSELECTEDFN)))
(SETQ BROWSERWINDOW (CREATEW [GETREGION 230 (ITIMES 6 (FONTPROP DEFAULTBROWSERFONT
(QUOTE HEIGHT]
NIL FBBORDERWIDTH))
(SETQ HEADINGW (FB.MAKEHEADINGWINDOW (WINDOWPROP BROWSERWINDOW (QUOTE WIDTH))
DEFAULTBROWSERFONT FBBORDERWIDTH "File Browser Window")
)
(SETQ COUNTERW (FB.MAKECOUNTERWINDOW (HEIGHTIFWINDOW (FONTPROP DEFAULTBROWSERFONT
(QUOTE HEIGHT)))
(WINDOWPROP HEADINGW (QUOTE WIDTH))
BROWSERWINDOW))
(WINDOWPROP BROWSERWINDOW (QUOTE HEADINGWINDOW)
HEADINGW)
(ATTACHWINDOW HEADINGW BROWSERWINDOW (QUOTE TOP))
(WINDOWPROP BROWSERWINDOW (QUOTE COUNTERWINDOW)
COUNTERW)
(ATTACHWINDOW COUNTERW BROWSERWINDOW (QUOTE TOP))
(SETQ COMMANDMENUWINDOW (ATTACHMENU COMMANDMENU BROWSERWINDOW (QUOTE TOP)))
(WINDOWPROP BROWSERWINDOW (QUOTE SCROLLFN)
(FUNCTION FB.SCROLLFN))
(SETQ INFOMENUW
(ATTACHMENU (create MENU
ITEMS ← FBINFOMENUITEMS
MENUROWS ← 2
TITLE ← "Info Options"
CENTERFLG ← T
MENUFONT ← BROWSERMENUFONT
WHENSELECTEDFN ←(FUNCTION FB.INFOMENU.WHENSELECTEDFN))
BROWSERWINDOW
(QUOTE BOTTOM)))
(COND
(DESIREDPROPS (* User specifies which attributes to use)
[for X on DESIREDPROPS do (OR (FB.\ItemWithTag (CAR X)
FBINFOMENUITEMS)
(AND (LISTP DIRCOMMANDS)
(MISSPELLED? (CAR X)
99 DIRCOMMANDS NIL X]
(pushnew DESIREDPROPS (QUOTE NAME)))
(T (SETQ DESIREDPROPS FBPROFILE)))
(WINDOWPROP BROWSERWINDOW (QUOTE INFOCHOICES)
DESIREDPROPS)
(FB.INFOMENU.SHADEINITIALSELECTIONS INFOMENUW DESIREDPROPS)
(FB.MAKERIGIDWINDOW (GETPROMPTWINDOW BROWSERWINDOW PROMPTWHEIGHT FBPROMPTFONT))
(DSPFONT DEFAULTBROWSERFONT BROWSERWINDOW)
(WINDOWPROP BROWSERWINDOW (QUOTE ICONFN)
(FUNCTION FB.ICONFN))
(WINDOWPROP BROWSERWINDOW (QUOTE ICONTITLE)
FILESPEC)
(WINDOWPROP BROWSERWINDOW (QUOTE NUMDELETED)
0)
(WINDOWPROP BROWSERWINDOW (QUOTE ORIGX)
(DSPXPOSITION NIL BROWSERWINDOW))
(WINDOWPROP BROWSERWINDOW (QUOTE ORIGY)
(DSPYPOSITION NIL BROWSERWINDOW))
(WINDOWPROP BROWSERWINDOW (QUOTE DIRWIDTH)
(WINDOWPROP BROWSERWINDOW (QUOTE WIDTH)))
(WINDOWPROP BROWSERWINDOW (QUOTE BUTTONEVENTFN)
(FUNCTION FB.SELECT))
(WINDOWPROP BROWSERWINDOW (QUOTE RIGHTBUTTONFN)
(FUNCTION FB.SELECT))
(WINDOWPROP BROWSERWINDOW (QUOTE COPYBUTTONEVENTFN)
(FUNCTION FB.COPY.HANDLER))
(WINDOWPROP BROWSERWINDOW (QUOTE REPAINTFN)
(FUNCTION FB.REPAINTFN)) (* (WINDOWPROP BROWSERWINDOW
(QUOTE CURSORMOVEDFN) (FUNCTION FB.CURSORMOVEDFN))
(WINDOWPROP BROWSERWINDOW (QUOTE CURSOROUTFN)
(FUNCTION FB.CURSOROUTFN)))
(WINDOWADDPROP BROWSERWINDOW (QUOTE RESHAPEFN)
(FUNCTION RESHAPEBYREPAINTFN))
(WINDOWADDPROP BROWSERWINDOW (QUOTE SHRINKFN)
(FUNCTION FB.CLOSEFN)
T)
(WINDOWADDPROP BROWSERWINDOW (QUOTE CLOSEFN)
(FUNCTION FB.CLOSEFN)
T)
(WINDOWPROP BROWSERWINDOW (QUOTE ITEMSPEC)
FILESPEC)
(ADD.PROCESS (LIST (FUNCTION FB.STARTUP)
BROWSERWINDOW COMMANDMENU COMMANDMENUWINDOW)
(QUOTE NAME)
(QUOTE FB-Update))
(RETURN BROWSERWINDOW])
)
(* * commands and major subfunctions)
(DEFINEQ
(FB.EXPUNGECOMMAND
[LAMBDA (WINDOW KEY OPTION) (* bvm: "21-Jul-85 01:10")
(PROG (FILENAME PATTERN FAILED)
(COND
((EQ KEY (QUOTE MIDDLE))
(SELECTQ [SETQ OPTION (MENU (OR FB.EXPUNGEOPS (SETQ FB.EXPUNGEOPS
(create MENU
MENUFONT ← DEFAULTBROWSERFONT
ITEMS ←(QUOTE ((Expunge (QUOTE UPDATE)
"Expunges deleted files and performs an Update")
(Expunge&Close (QUOTE CLOSEW)
"Expunges deleted files and closes browser")
(Expunge&NewPattern
(QUOTE NEWPATTERN)
"Browses new file pattern after expunging deleted files"]
(NIL (RETURN))
(NEWPATTERN (OR (SETQ PATTERN (FB.GET.NEWPATTERN WINDOW))
(RETURN)))
NIL)))
[for FILEENTRY in (GETWINDOWPROP WINDOW (QUOTE BROWSERITEMMAP))
do (COND
((fetch (FILEBUCKET DELETED?) of FILEENTRY)
(COND
([NOT (DELFILE (SETQ FILENAME (FB.FETCHFILENAME FILEENTRY]
(FB.PROMPTWPRINT WINDOW T "Couldn't expunge " FILENAME)
(SETQ FAILED T]
(COND
(FAILED (FB.PROMPTWPRINT WINDOW T "(Expunge failed, window not updated)")
(RETURN)))
(PUTWINDOWPROP WINDOW (QUOTE CURRENTFOLDERNUMBERS)
NIL)
(PUTWINDOWPROP WINDOW (QUOTE NUMDELETED)
0)
(SELECTQ OPTION
(CLOSEW (CLOSEW WINDOW)
(RETURN))
(NEWPATTERN (PUTWINDOWPROP WINDOW (QUOTE ITEMSPEC)
PATTERN))
NIL)
(RETURN T])
(FB.HARDCOPYCOMMAND
[LAMBDA (FILEENTRY KEY WINDOW) (* hdj "17-Sep-84 17:37")
(PROG ((FILE (FB.FETCHFILENAME FILEENTRY)))
(APPLY* (QUOTE LISTFILES)
FILE])
(FB.LOADCOMMAND
[LAMBDA (FILEENTRY KEY WINDOW) (* hdj "23-Apr-85 18:16")
(PROG [[LOADOP (COND
[(EQ KEY (QUOTE MIDDLE))
(MENU (OR FLOADOPS (SETQ FLOADOPS (create MENU
MENUFONT ← DEFAULTBROWSERFONT
ITEMS ←(QUOTE ((LOAD (QUOTE LOAD)
"Performs LOAD on selected files")
(LOADFROM
(QUOTE LOADFROM)
"Performs LOADFROM on selected files"]
(T (QUOTE LOAD]
(FILE (MKATOM (FB.FETCHFILENAME FILEENTRY]
(if (NULL LOADOP)
then (RETURN))
(FB.AFFECT.FILE.SEPARATELY/UNDOABLY LOADOP FILE (QUOTE LOAD])
(FB.NEWPATTERNCOMMAND
[LAMBDA (WINDOW) (* bvm: "21-Jul-85 00:18")
(LET ((PATTERN (FB.GET.NEWPATTERN WINDOW)))
(COND
(PATTERN (PUTWINDOWPROP WINDOW (QUOTE ITEMSPEC)
PATTERN)
T])
(FB.GET.NEWPATTERN
[LAMBDA (WINDOW) (* hdj "30-Jul-85 18:43")
(LET (PATTERN)
(FB.CLRPROMPTW WINDOW)
(COND
((SETQ PATTERN (FB.PROMPTFORINPUT "New file group description? " (GETWINDOWPROP
WINDOW
(QUOTE ITEMSPEC))
WINDOW))
(DIRECTORY.FILL.PATTERN PATTERN))
(T (FB.PROMPTWPRINT WINDOW " ... aborted"])
(FB.RENAMECOMMAND
[LAMBDA (PREFIX FILEENTRY WINDOW)
(DECLARE (USEDFREE FBUPDATE?)) (* bvm: "20-Jul-85 23:19")
(LET (TOFILE)
(SETQ FILEENTRY (FB.FETCHFILENAME FILEENTRY))
(COND
((SETQ TOFILE (FB.GET.NEW.FILE.SPEC FILEENTRY PREFIX WINDOW (QUOTE Rename)))
(RENAMEFILE FILEENTRY TOFILE)
(SETQ FBUPDATE? T)
(FB.PROMPTWPRINT WINDOW FILEENTRY " renamed " TOFILE)))
TOFILE])
(FB.EDITCOMMAND
[LAMBDA (FILEENTRY KEY WINDOW READONLY) (* bvm: "21-Jul-85 01:03")
(PROG ((FILE (FB.FETCHFILENAME FILEENTRY)))
(COND
((AND (NOT (FILENAMEFIELD FILE (QUOTE NAME)))
(DIRECTORYNAMEP FILE))
(FILEBROWSER (PACKFILENAME.STRING (QUOTE VERSION)
NIL
(QUOTE NAME)
(QUOTE *)
(QUOTE EXTENSION)
(QUOTE *)
(QUOTE BODY)
FILE)))
[READONLY (RESETLST (LET ((STR (OPENSTREAM FILE (QUOTE INPUT)))
SRC)
[COND
((LISPSOURCEFILEP STR)
(RESETSAVE NIL (LIST (QUOTE CLOSEF)
STR))
(SETQ STR (LET ((NSTR (OPENTEXTSTREAM)))
(COPY.TEXT.TO.IMAGE STR NSTR)
NSTR)))
((NOT (RANDACCESSP STR))
(RESETSAVE NIL (LIST (QUOTE CLOSEF)
STR))
(SETQ STR
(LET [(NSTR (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE NEW)
NIL
(LIST (LIST (QUOTE TYPE)
(GETFILEINFO
STR
(QUOTE TYPE]
(COPYBYTES STR NSTR)
NSTR]
(OPENTEXTSTREAM STR (CREATEW NIL FILE)
NIL NIL (QUOTE (READONLY T]
((EQ KEY (QUOTE MIDDLE))
(FB.PROMPTWPRINT WINDOW T "Edit " FILE " with which editor?")
(SELECTQ [MENU (OR FB.EDITMENU (SETQ FB.EDITMENU
(create MENU
MENUFONT ← DEFAULTBROWSERFONT
ITEMS ← FB.EDITMENU.ITEMS]
(TEDIT (TEDIT (MKATOM FILE)))
(DEDIT (FB.EDITLISPFILE FILE WINDOW))
(RETURN)))
(T (COND
((LISPSOURCEFILEP FILE)
(FB.EDITLISPFILE FILE WINDOW))
(T (TEDIT (MKATOM FILE])
(FB.DELETECOMMAND
[LAMBDA (FILEENTRY WINDOW) (* hdj "26-Oct-84 15:49")
(COND
((NOT (fetch (FILEBUCKET DELETED?) of FILEENTRY))
(FB.CHANGEDELETEMARK FILEENTRY WINDOW)
(replace (FILEBUCKET DELETED?) of FILEENTRY with T)
[PUTWINDOWPROP WINDOW (QUOTE NUMDELETED)
(ADD1 (GETWINDOWPROP WINDOW (QUOTE NUMDELETED]
(FB.SHOW.NUMDELETED WINDOW])
(FB.SEECOMMAND
[LAMBDA (FILEENTRY KEY BROWSER) (* lmm "17-Jan-85 19:29")
(FB.EDITCOMMAND FILEENTRY KEY BROWSER T])
(FB.COMPILECOMMAND
[LAMBDA (FILEENTRY KEY WINDOW) (* hdj "23-Apr-85 18:18")
(PROG [(FILE (FB.FETCHFILENAME FILEENTRY))
(COMPILEOP (COND
[(EQ KEY (QUOTE MIDDLE))
(MENU (OR FCOMPILEOPS (SETQ FCOMPILEOPS
(create MENU
MENUFONT ← DEFAULTBROWSERFONT
ITEMS ←(QUOTE ((TCOMPL (QUOTE TCOMPL)
"Does TCOMPL on selected files")
(BCOMPL (QUOTE BCOMPL)
"Does BCOMPL on selected files"]
(T (QUOTE TCOMPL]
(COND
((NULL COMPILEOP)
(RETURN)))
(FB.AFFECT.FILE.SEPARATELY/UNDOABLY COMPILEOP FILE (QUOTE COMPILE])
(FB.COPYCOMMAND
[LAMBDA (PREFIX FILEENTRY WINDOW) (* bvm: "20-Jul-85 23:19")
(LET (TOFILE)
(SETQ FILEENTRY (FB.FETCHFILENAME FILEENTRY))
(COND
((SETQ TOFILE (FB.GET.NEW.FILE.SPEC FILEENTRY PREFIX WINDOW (QUOTE Copy)))
(SETQ TOFILE (COPYFILE FILEENTRY TOFILE))
(FB.PROMPTWPRINT WINDOW FILEENTRY " copied to " TOFILE)))
TOFILE])
(FB.GET.NEW.FILE.SPEC
[LAMBDA (OLDNAME PREFIX WINDOW CMD) (* bvm: "21-Jul-85 00:48")
(* 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)
[COND
(PREFIX (SETQ NEWNAME (PACKFILENAME.STRING (QUOTE DIRECTORY)
PREFIX
(QUOTE VERSION)
NIL
(QUOTE BODY)
OLDNAME)))
((NULL (SETQ NEWNAME (FB.PROMPTFORINPUT (CONCAT CMD " file " OLDNAME (SELECTQ
CMD
(Rename " what? ")
(Copy " where? ")
(SHOULDNT)))
(PACKFILENAME.STRING (QUOTE DIRECTORY)
(DIRECTORYNAME T)
(QUOTE VERSION)
NIL
(QUOTE BODY)
OLDNAME)
WINDOW)))
(FB.PROMPTWPRINT WINDOW "... aborted" T))
((NULL (FILENAMEFIELD NEWNAME (QUOTE NAME))) (* Assume directory spec)
(SETQ NEWNAME (PACKFILENAME.STRING (QUOTE BODY)
NEWNAME
(QUOTE VERSION)
NIL
(QUOTE BODY)
OLDNAME]
(COND
(NEWNAME (FB.PROMPTWTERPRI WINDOW)
(\ADD.CONNECTED.DIR NEWNAME])
(FB.UNDELETECOMMAND
[LAMBDA (FILEENTRY WINDOW) (* hdj "26-Oct-84 15:55")
(COND
((fetch (FILEBUCKET DELETED?) of FILEENTRY)
(FB.CHANGEDELETEMARK FILEENTRY WINDOW)
(replace (FILEBUCKET DELETED?) of FILEENTRY with NIL)
[PUTWINDOWPROP WINDOW (QUOTE NUMDELETED)
(SUB1 (GETWINDOWPROP WINDOW (QUOTE NUMDELETED]
(FB.SHOW.NUMDELETED WINDOW])
(FB.UPDATECOMMAND
[LAMBDA (KEY WINDOW) (* hdj "16-Sep-84 15:52")
(SELECTQ (if (EQ KEY (QUOTE MIDDLE))
then [MENU (OR FUPDATEOPS (SETQ FUPDATEOPS (create MENU
MENUFONT ← DEFAULTBROWSERFONT
ITEMS ←(QUOTE
((Update (QUOTE UPDATE)
"Updates browser using current selection pattern")
(NewPattern (QUOTE NEWPATTERN)
"Prompts for a new selection pattern and updates browser"]
else (QUOTE UPDATE))
(UPDATE T)
(NEWPATTERN (FB.NEWPATTERNCOMMAND WINDOW))
NIL])
)
(DEFINEQ
(FB.MAKECOUNTERWINDOW
[LAMBDA (HEIGHT WIDTH BROWSERW) (* hdj "23-Apr-85 17:42")
(LET ((COUNTERW (CREATEW (create REGION
LEFT ← 0
BOTTOM ← 0
HEIGHT ←(HEIGHTIFWINDOW (FONTPROP DEFAULTBROWSERFONT
(QUOTE HEIGHT)))
WIDTH ←(WINDOWPROP BROWSERW (QUOTE WIDTH)))
NIL NIL T)))
(FB.MAKERIGIDWINDOW COUNTERW)
(WINDOWPROP COUNTERW (QUOTE REPAINTFN)
(FUNCTION FB.REPAINT.COUNTERW))
COUNTERW])
(FB.MAKESEEWINDOW
[LAMBDA (FILE BROWSER) (* hdj "16-Sep-84 16:12")
(PROG ((SEEWINDOW (GETWINDOWPROP BROWSER (QUOTE SEEWINDOW)))
TEMPFILE)
(* * if the last created see window is in use, or there isn't one, create a new one)
[if [AND (WINDOWP SEEWINDOW)
(NOT (GETWINDOWPROP SEEWINDOW (QUOTE INUSE]
then (PUTWINDOWPROP SEEWINDOW (QUOTE TITLE)
(CONCAT "Contents of " FILE))
else (SETQ SEEWINDOW (CREATEW NIL (CONCAT "Contents of " FILE]
(PUTWINDOWPROP BROWSER (QUOTE SEEWINDOW)
SEEWINDOW)
(PUTWINDOWPROP SEEWINDOW (QUOTE INUSE)
T)
(SETQ TEMPFILE (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)))
(COPYFILE FILE TEMPFILE)
(PUTWINDOWPROP SEEWINDOW (QUOTE TEMPFILE)
TEMPFILE)
(PUTWINDOWPROP SEEWINDOW (QUOTE REPAINTFN)
(FUNCTION FB.SEEW.REPAINTFN))
(PUTWINDOWPROP SEEWINDOW (QUOTE RESHAPEFN)
(FUNCTION FB.SEEW.RESHAPEFN))
(PUTWINDOWPROP SEEWINDOW (QUOTE SCROLLFN)
(FUNCTION SCROLLBYREPAINTFN))
[PUTWINDOWPROP SEEWINDOW (QUOTE CLOSEFN)
(FUNCTION (LAMBDA (W)
(PUTWINDOWPROP W (QUOTE INUSE)
NIL)
(PUTWINDOWPROP W (QUOTE TEMPFILE)
NIL]
(FB.SEEW.RESHAPEFN SEEWINDOW)
(RETURN SEEWINDOW])
(FB.COMMANDDISPATCH
[LAMBDA (ITEM MENU KEY) (* bvm: "21-Jul-85 00:27")
(PROG (WINDOW FBUPDATE? FILELIST PREFIX)
(SETQ WINDOW (WINDOWPROP (WFROMMENU MENU)
(QUOTE MAINWINDOW)))
(COND
((GETWINDOWPROP WINDOW (QUOTE FILEBROWSERBUSY))
(FLASHWINDOW WINDOW) (* Used to be (FB.PROMPTWPRINT WINDOW
"This filebrowser is busy") but that trashes the prompt
window)
(RETURN)))
(COND
((EQUAL (CADR ITEM)
(QUOTE ""))
(RETURN)))
(OR (FMEMB (CADR ITEM)
(QUOTE (Update Expunge)))
[SETQ FILELIST (for INDEX in (WINDOWPROP WINDOW (QUOTE CURRENTFOLDERNUMBERS))
collect (CAR (NTH (WINDOWPROP WINDOW (QUOTE BROWSERITEMMAP))
INDEX]
(PROGN (FB.PROMPTWPRINT WINDOW T "No files are selected")
(RETURN)))
(RESETLST (RESETSAVE NIL (LIST (QUOTE SHADEITEM)
ITEM MENU FBITEMUNSELECTEDSHADE))
(RESETSAVE NIL (LIST (FUNCTION [LAMBDA (W P)
(PUTWINDOWPROP W (QUOTE FILEBROWSERBUSY)
P])
WINDOW NIL))
(PUTWINDOWPROP WINDOW (QUOTE FILEBROWSERBUSY)
T)
(SHADEITEM ITEM MENU FBITEMSELECTEDSHADE)
[SELECTQ (CADR ITEM)
(Edit (for FILEENTRY in FILELIST do (FB.EDITCOMMAND FILEENTRY KEY WINDOW)
))
(See (for FILEENTRY in FILELIST do (FB.SEECOMMAND FILEENTRY KEY WINDOW)))
(Update (SETQ FBUPDATE? (FB.UPDATECOMMAND KEY WINDOW)))
(Delete (for FILEENTRY in FILELIST do (FB.DELETECOMMAND FILEENTRY WINDOW)
))
(Undelete (for FILEENTRY in FILELIST do (FB.UNDELETECOMMAND FILEENTRY
WINDOW)))
(Expunge (SETQ FBUPDATE? (FB.EXPUNGECOMMAND WINDOW KEY)))
(Copy (COND
((CDR FILELIST)
(SETQ PREFIX (FB.PROMPTFORINPUT "Copy to which directory? "
(DIRECTORYNAME T T)
WINDOW))
(FB.PROMPTWTERPRI WINDOW)))
(for FILEENTRY in FILELIST do (FB.COPYCOMMAND PREFIX FILEENTRY
WINDOW)))
(Load (for FILEENTRY in FILELIST do (FB.LOADCOMMAND FILEENTRY KEY WINDOW)
))
(Compile (for FILEENTRY in FILELIST do (FB.COMPILECOMMAND FILEENTRY KEY
WINDOW)))
(Hardcopy (for FILEENTRY in FILELIST do (FB.HARDCOPYCOMMAND FILEENTRY
KEY WINDOW)))
(Rename (COND
((CDR FILELIST)
(SETQ PREFIX (FB.PROMPTFORINPUT "Move to which directory? "
(DIRECTORYNAME T T)
WINDOW))
(FB.PROMPTWTERPRI WINDOW)))
(for FILEENTRY in FILELIST do (FB.RENAMECOMMAND PREFIX FILEENTRY
WINDOW)))
(LET ((FN (CADR ITEM)))
(COND
((EQ (CAR FN)
(QUOTE FUNCTION))
(APPLY* (CADR FN)
FILELIST KEY WINDOW))
(T (SHOULDNT]
(COND
(FBUPDATE? (FB.UPDATEBROWSERITEMS (WINDOWPROP WINDOW (QUOTE ITEMSPEC))
WINDOW])
(FB.EDITLISPFILE
[LAMBDA (FILE WINDOW) (* hdj "23-Apr-85 17:58")
(PROG (ROOT)
(if (NOT (STREQUAL (CDAR (GETPROP (SETQ ROOT (U-CASE (ROOTFILENAME FILE)))
(QUOTE FILEDATES)))
FILE))
then (CLEARW PROMPTWINDOW)
(if (MOUSECONFIRM (CONCAT "The file " FILE
" is not loaded or is not current. (LOADFROM '"
FILE ")?")
NIL PROMPTWINDOW)
then [LISPXEVAL (BQUOTE (LOADFROM , (KWOTE FILE]
else (RETURN)))
(LISPXEVAL (BQUOTE (EDITDEF (QUOTE , ROOT)
(QUOTE FILES])
(FB.SELECT
[LAMBDA (WINDOW) (* bvm: "20-Jul-85 23:50")
(PROG (BROWSERITEMMAP FOLDER SETSEL ADDSEL EXTEND CURRENT#S FOLDER# FIRST# LAST#)
(TOTOPW WINDOW)
(OR (SETQ SETSEL (MOUSESTATE LEFT))
(SETQ ADDSEL (LASTMOUSESTATE MIDDLE))
(SETQ EXTEND (LASTMOUSESTATE RIGHT))
(RETURN))
(SETQ BROWSERITEMMAP (WINDOWPROP WINDOW (QUOTE BROWSERITEMMAP)))
(SETQ FOLDER (FB.FINDFILEBUCKET WINDOW))
(COND
((NULL FOLDER)
(RETURN)))
[COND
(SETSEL (for FOLDER# in (GETWINDOWUSERPROP WINDOW (QUOTE CURRENTFOLDERNUMBERS))
do (FB.UNSELECTFILE (CAR (FNTH BROWSERITEMMAP FOLDER#))
WINDOW))
(FB.SELECTFILE FOLDER WINDOW))
[ADDSEL (COND
((fetch (FILEBUCKET SELECTED?) of FOLDER)
(FB.UNSELECTFILE FOLDER WINDOW))
(T (FB.SELECTFILE FOLDER WINDOW]
(EXTEND (* have to find all the messages between FOLDER and the
one selected *)
(COND
([SETQ CURRENT#S (SORT (WINDOWPROP WINDOW (QUOTE CURRENTFOLDERNUMBERS]
(SETQ FOLDER# (fetch (FILEBUCKET #) of FOLDER))
[COND
[(ILESSP FOLDER# (CAR CURRENT#S))
(* before *)
(SETQ FIRST# FOLDER#)
(SETQ LAST# (SUB1 (CAR CURRENT#S]
(T (SETQ LAST# FOLDER#) (* after *)
(SETQ FIRST# (ADD1 (CAR (LAST CURRENT#S]
(for I from FIRST# to LAST# do (FB.SELECTFILE (CAR (NTH BROWSERITEMMAP I))
WINDOW]
(FB.SHOW.NUMSELECTED WINDOW])
(FB.COPY.HANDLER
[LAMBDA (WINDOW) (* bvm: "20-Jul-85 21:58")
(* * copy select a file name from the window.)
(PROG (CURRENTFILE SMASHPOS NEWFILE)
LP (TOTOPW WINDOW)
(SETQ NEWFILE (FB.FINDFILEBUCKET WINDOW)) (* (SETQ NEWFILE (IN/ITEM? SELECTABLEITEMS
(SETQ SMASHPOS (CURSORPOSITION NIL WINDOW)))))
[COND
((NEQ CURRENTFILE NEWFILE)
(COND
(CURRENTFILE (* turn off old selection.)
(FB.CHANGECOPYSELECTMARK CURRENTFILE WINDOW)))
(COND
((SETQ CURRENTFILE NEWFILE)
(FB.CHANGECOPYSELECTMARK CURRENTFILE WINDOW]
(* wait for a button up or move out of region)
LP2 (BLOCK)
(COND
((NOT (.COPYKEYDOWNP.)) (* Finished, copy selected item)
[COND
(CURRENTFILE (FB.CHANGECOPYSELECTMARK CURRENTFILE WINDOW)
(BKSYSBUF (fetch (FILEBUCKET FILENAME) of CURRENTFILE]
(RETURN))
((MOUSESTATE UP) (* button up, no action)
(GO LP2))
(T (GO LP])
(FB.UPDATEBROWSERITEMS
[LAMBDA (ITEMSPEC WINDOW) (* hdj "26-Oct-84 15:53")
(PROG ((INFOWANTED (GETWINDOWPROP WINDOW (QUOTE INFOCHOICES)))
HEADINGWINDOW FILEGENERATOR INFONEEDED FILENAME FILEINFO MAXWIDTH NEWBROWSERITEM
BROWSERITEMMAP TOP BOTTOM)
[SETQ FILEGENERATOR (\GENERATEFILES ITEMSPEC INFOWANTED (QUOTE (SORT RESETLST]
(SETQ HEADINGWINDOW (GETWINDOWPROP WINDOW (QUOTE HEADINGWINDOW)))
(WINDOWPROP HEADINGWINDOW (QUOTE TITLE)
"File Browser")
(CLEARW (WINDOWPROP WINDOW (QUOTE COUNTERWINDOW)))
(PUTWINDOWPROP WINDOW (QUOTE EXTENT)
NIL) (* set EXTENT to NIL while updating)
(PUTWINDOWPROP WINDOW (QUOTE INFOGOTTEN)
INFOWANTED)
(PUTWINDOWPROP WINDOW (QUOTE DIRWIDTH)
(SETQ MAXWIDTH (FB.PRINTHEADINGSON HEADINGWINDOW INFOWANTED)))
(DSPRIGHTMARGIN 32767 WINDOW)
(CLEARW WINDOW)
(SETQ BROWSERITEMMAP (while (SETQ FILENAME (\GENERATENEXTFILE FILEGENERATOR)) as ITEMCOUNT
from 1 bind ITEM bind STARTOFNAME
collect (if (LISTP FILENAME)
then (SETQ FILENAME (CONCATCODES FILENAME)))
(SETQ FILEINFO (FB.GETALLFILEINFO FILENAME FILEGENERATOR
INFOWANTED))
(create FILEBUCKET
FILENAME ← FILENAME
# ← ITEMCOUNT
ITEM ←[SETQ ITEM (FB.CREATEPRINTSPEC
FILEINFO INFOWANTED (OR STARTOFNAME
(SETQ STARTOFNAME
(FB.STARTOFNAME
FILENAME ITEMSPEC]
ITEMREGION ←(FB.PRINTANDGETREGION ITEM WINDOW
MarkXPos 10)
SELECTED? ← NIL
DELETED? ← NIL
FILEINFO ← FILEINFO)))
(PUTWINDOWPROP WINDOW (QUOTE BROWSERITEMMAP)
BROWSERITEMMAP)
(PUTWINDOWPROP WINDOW (QUOTE EXTENT)
(if BROWSERITEMMAP
then [create REGION
LEFT ← 0
BOTTOM ←[fetch (REGION BOTTOM)
of (fetch (FILEBUCKET ITEMREGION)
of (CAR (LAST BROWSERITEMMAP]
WIDTH ← MAXWIDTH
HEIGHT ←(IDIFFERENCE (fetch (REGION PTOP)
of (fetch (FILEBUCKET ITEMREGION)
of (CAR BROWSERITEMMAP)))
(fetch (REGION BOTTOM)
of (fetch (FILEBUCKET ITEMREGION)
of (CAR (LAST BROWSERITEMMAP]
else (FB.CLRPROMPTW WINDOW)
(FB.PROMPTWPRINT WINDOW "No files in group " ITEMSPEC)
NIL))
(PUTWINDOWPROP HEADINGWINDOW (QUOTE TITLE)
(CONCAT (WINDOWPROP WINDOW (QUOTE ITEMSPEC))
" browser"))
(PUTWINDOWPROP WINDOW (QUOTE CURRENTFOLDERNUMBERS)
NIL)
(PUTWINDOWPROP WINDOW (QUOTE CURRENTITEM)
NIL)
(FB.SHOW.NUMFILES WINDOW)
(FB.SHOW.NUMSELECTED WINDOW)
(FB.SHOW.NUMDELETED WINDOW])
)
(* * lower-level window mungers)
(DEFINEQ
(FB.MAKERIGIDWINDOW
[LAMBDA (WINDOW) (* lmm "14-Sep-84 16:22")
(* * make the argument window immutable w/r/to attachedwindow package)
(PROG [(HEIGHT (fetch (REGION HEIGHT) of (GETWINDOWPROP WINDOW (QUOTE REGION]
(PUTWINDOWPROP WINDOW (QUOTE MINSIZE)
(CONS 0 HEIGHT))
(PUTWINDOWPROP WINDOW (QUOTE MAXSIZE)
(CONS SCREENWIDTH HEIGHT])
(FB.CLRPROMPTW
[LAMBDA (MAINWINDOW) (* Jellinek " 6-May-84 16:48")
(CLEARW (CAR (GETWINDOWPROP MAINWINDOW (QUOTE PROMPTWINDOW])
(FB.PRINTHEADINGSON
[LAMBDA (WINDOW HEADINGS) (* lmm "14-Sep-84 15:49")
(PROG ((totalwidth 0)
BOTTOM)
(DSPRIGHTMARGIN 32000 WINDOW)
(DSPTEXTURE BLACKSHADE WINDOW)
(DSPOPERATION (QUOTE INVERT)
WINDOW)
(DSPFILL NIL BLACKSHADE (QUOTE REPLACE)
WINDOW)
(for HEADING in INFOLISTINGWIDTHS by (CDDR HEADING) bind word width (pos ← MarkXPos)
when (FMEMB HEADING HEADINGS)
do (SETQ word (fetch (INFOWPRINTSPEC LABEL) of (LISTGET INFOLISTINGWIDTHS HEADING)))
(SETQ width (fetch (INFOWPRINTSPEC WIDTH) of (LISTGET INFOLISTINGWIDTHS HEADING)))
(SETQ totalwidth (IPLUS totalwidth width))
(DSPXPOSITION pos WINDOW)
(PRIN3 word WINDOW)
(add pos width))
(PUTWINDOWPROP WINDOW (QUOTE EXTENT)
(create REGION
LEFT ← 0
BOTTOM ←[SETQ BOTTOM (IPLUS (DSPYPOSITION NIL WINDOW)
(FONTPROP WINDOW (QUOTE ASCENT]
WIDTH ← totalwidth
HEIGHT ←(IDIFFERENCE (GETWINDOWPROP WINDOW (QUOTE HEIGHT))
BOTTOM)))
(RETURN totalwidth])
(FB.PRINTANDGETREGION
[LAMBDA (PRINTSPEC STREAM LFTMARGIN MINSPACE) (* lmm " 5-Oct-84 17:49")
(* prints PRINTSPEC on WINDOW and returns the box taken
by the characters.)
(PROG (YSTART YEND HEIGHT)
(DSPXPOSITION LFTMARGIN STREAM)
(SETQ YSTART (DSPYPOSITION NIL STREAM))
(for SPEC in PRINTSPEC bind OLDX PRETTYWIDTH
do (SETQ OLDX (DSPXPOSITION NIL STREAM))
(SETQ PRETTYWIDTH (fetch (INFOWPRINTSPEC WIDTH) of SPEC))
(COND
((fetch (INFOWPRINTSPEC LABEL) of SPEC)
(PRIN3 (fetch (INFOWPRINTSPEC LABEL) of SPEC)
STREAM)
(PRIN3 " " STREAM))) (* If any single item won't fit, skip a line and
continue)
(if (IGEQ (IDIFFERENCE (DSPXPOSITION NIL STREAM)
OLDX)
PRETTYWIDTH)
then (TERPRI STREAM))
(DSPXPOSITION (IPLUS OLDX PRETTYWIDTH)
STREAM))
(SETQ YEND (DSPYPOSITION NIL STREAM))
(RETURN (PROG1 (create REGION
LEFT ← LFTMARGIN
BOTTOM ←(IDIFFERENCE YEND (FONTPROP STREAM (QUOTE DESCENT)))
HEIGHT ←(IPLUS (IDIFFERENCE YSTART YEND)
(FONTPROP STREAM (QUOTE HEIGHT)))
WIDTH ←(IDIFFERENCE (DSPXPOSITION NIL STREAM)
LFTMARGIN))
(TERPRI STREAM])
(FB.MAKEHEADINGWINDOW
[LAMBDA (WIDTH FONT BORDER TITLE) (* hdj "26-Oct-84 17:42")
(PROG (PWINDOW)
(SETQ PWINDOW (CREATEW (create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ← WIDTH
HEIGHT ←(HEIGHTIFWINDOW (FONTPROP FONT (QUOTE HEIGHT))
TITLE BORDER))
TITLE BORDER T))
(DSPFONT FONT PWINDOW)
(PUTWINDOWPROP PWINDOW (QUOTE PAGEFULLFN)
(FUNCTION NILL))
(PUTWINDOWPROP PWINDOW (QUOTE NOSCROLLBARS)
T)
(PUTWINDOWPROP PWINDOW (QUOTE SCROLLFN)
(FUNCTION SCROLLBYREPAINTFN))
(PUTWINDOWPROP PWINDOW (QUOTE REPAINTFN)
(FUNCTION FB.HEADINGWREDISPLAYFN))
(FB.MAKERIGIDWINDOW PWINDOW)
(RETURN PWINDOW])
(FB.PROMPTWPRINT
[LAMBDA U (* bvm: "20-Jul-85 22:57")
(COND
((ILESSP U 2)
(ERROR "not enough args to PROMPTWPRINT"))
(T (LET ([WINDOW (CAR (GETWINDOWPROP (ARG U 1)
(QUOTE PROMPTWINDOW]
THING) (* CAR is window, CDR is height in lines)
(for ITEM from 2 to U do (COND
((EQ (SETQ THING (ARG U ITEM))
T)
(TERPRI WINDOW))
(T (PRIN1 THING WINDOW])
(FB.PROMPTWTERPRI
[LAMBDA (MAINWINDOW) (* Jellinek " 6-May-84 16:37")
(* CAR is prompt window, CDR is height in lines)
(TERPRI (CAR (GETWINDOWPROP MAINWINDOW (QUOTE PROMPTWINDOW])
(FB.SELECTFILE
[LAMBDA (FOLDER WINDOW) (* hdj "16-Sep-84 16:01")
(COND
(FOLDER (replace (FILEBUCKET SELECTED?) of FOLDER with T)
(WINDOWADDPROP WINDOW (QUOTE CURRENTFOLDERNUMBERS)
(fetch (FILEBUCKET #) of FOLDER))
[WINDOWPROP WINDOW (QUOTE CURRENTFOLDERNUMBERS)
(SORT (WINDOWPROP WINDOW (QUOTE CURRENTFOLDERNUMBERS]
(\ITEMW.SELECTITEM (LIST (fetch (FILEBUCKET ITEMREGION) of FOLDER))
WINDOW])
(FB.UNSELECTFILE
[LAMBDA (MSG WINDOW) (* hdj "16-Sep-84 16:10")
(COND
(MSG (replace (FILEBUCKET SELECTED?) of MSG with NIL)
[WINDOWPROP WINDOW (QUOTE CURRENTFOLDERNUMBERS)
(REMOVE (fetch (FILEBUCKET #) of MSG)
(WINDOWPROP WINDOW (QUOTE CURRENTFOLDERNUMBERS]
(\ITEMW.DESELECTITEM (LIST (fetch ITEMREGION of MSG))
WINDOW])
(FB.CHANGEDELETEMARK
[LAMBDA (FOLDER WINDOW) (* lmm "14-Sep-84 15:55")
(PROG ((FOLDERREGION (fetch ITEMREGION of FOLDER)))
(BITBLT NIL 0 0 WINDOW (fetch (REGION LEFT) of FOLDERREGION)
(IDIFFERENCE (fetch (REGION PTOP) of FOLDERREGION)
(IQUOTIENT (FONTPROP WINDOW (QUOTE HEIGHT))
2))
(fetch (REGION WIDTH) of FOLDERREGION)
1
(QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE])
(FB.CHANGECOPYSELECTMARK
[LAMBDA (FOLDER WINDOW) (* bvm: "20-Jul-85 21:51")
(LET ((FOLDERREGION (fetch ITEMREGION of FOLDER))) (* underline first line of the folder
(which generally gets the file name))
(BLTSHADE GRAYSHADE WINDOW (fetch (REGION LEFT) of FOLDERREGION)
(IDIFFERENCE (fetch (REGION TOP) of FOLDERREGION)
(IPLUS (FONTPROP WINDOW (QUOTE ASCENT))
2))
(fetch (REGION WIDTH) of FOLDERREGION)
2
(QUOTE INVERT])
(FB.INFOMENU.SHADEINITIALSELECTIONS
[LAMBDA (MENUWINDOW INITIALSELECTIONS) (* hdj "16-Sep-84 16:17")
(PROG (MENUITEMS MENU)
[SETQ MENU (CAR (GETWINDOWPROP MENUWINDOW (QUOTE MENU]
(SETQ MENUITEMS (fetch (MENU ITEMS) of MENU))
(for SELECTION in INITIALSELECTIONS do (SHADEITEM (FB.\ItemWithTag SELECTION MENUITEMS)
MENU INFOSHADE MENUWINDOW])
(FB.SHOW.NUMDELETED
[LAMBDA (BROWSERW) (* hdj "26-Oct-84 15:44")
(LET [(COUNTERW (WINDOWPROP BROWSERW (QUOTE COUNTERWINDOW)))
(STARTPOSITION (ITIMES (IQUOTIENT (WINDOWPROP BROWSERW (QUOTE WIDTH))
3)
2))
(ENDPOSITION (WINDOWPROP BROWSERW (QUOTE WIDTH]
(LET [(PRINTINGREGION (create REGION
LEFT ← STARTPOSITION
WIDTH ←(IDIFFERENCE ENDPOSITION STARTPOSITION)
BOTTOM ← 0
HEIGHT ←(WINDOWPROP COUNTERW (QUOTE HEIGHT]
(DSPFILL PRINTINGREGION WHITESHADE (QUOTE REPLACE)
COUNTERW)
(DSPXPOSITION STARTPOSITION COUNTERW)
(PRIN3 "D:" COUNTERW)
(CENTERPRINTINREGION (WINDOWPROP BROWSERW (QUOTE NUMDELETED))
PRINTINGREGION COUNTERW])
(FB.SHOW.NUMFILES
[LAMBDA (BROWSERW) (* hdj "26-Oct-84 15:42")
(LET ((COUNTERW (WINDOWPROP BROWSERW (QUOTE COUNTERWINDOW)))
(STARTPOSITION 0)
(ENDPOSITION (IQUOTIENT (WINDOWPROP BROWSERW (QUOTE WIDTH))
3)))
(LET [(PRINTINGREGION (create REGION
LEFT ← STARTPOSITION
WIDTH ←(IDIFFERENCE ENDPOSITION STARTPOSITION)
BOTTOM ← 0
HEIGHT ←(WINDOWPROP COUNTERW (QUOTE HEIGHT]
(DSPFILL PRINTINGREGION WHITESHADE (QUOTE REPLACE)
COUNTERW)
(DSPXPOSITION STARTPOSITION COUNTERW)
(PRIN3 "F:" COUNTERW)
(CENTERPRINTINREGION (LENGTH (WINDOWPROP BROWSERW (QUOTE BROWSERITEMMAP)))
PRINTINGREGION COUNTERW])
(FB.SHOW.NUMSELECTED
[LAMBDA (BROWSERW) (* hdj "26-Oct-84 15:42")
(LET ((COUNTERW (WINDOWPROP BROWSERW (QUOTE COUNTERWINDOW)))
(STARTPOSITION (IQUOTIENT (WINDOWPROP BROWSERW (QUOTE WIDTH))
3))
(ENDPOSITION (ITIMES (IQUOTIENT (WINDOWPROP BROWSERW (QUOTE WIDTH))
3)
2)))
(LET [(PRINTINGREGION (create REGION
LEFT ← STARTPOSITION
WIDTH ←(IDIFFERENCE ENDPOSITION STARTPOSITION)
BOTTOM ← 0
HEIGHT ←(WINDOWPROP COUNTERW (QUOTE HEIGHT]
(DSPFILL PRINTINGREGION WHITESHADE (QUOTE REPLACE)
COUNTERW)
(DSPXPOSITION STARTPOSITION COUNTERW)
(PRIN3 "S:" COUNTERW)
(CENTERPRINTINREGION (LENGTH (WINDOWPROP BROWSERW (QUOTE CURRENTFOLDERNUMBERS)))
PRINTINGREGION COUNTERW])
)
(* * window functions)
(DEFINEQ
(FB.HEADINGWREDISPLAYFN
[LAMBDA (WINDOW) (* hdj "16-Sep-84 15:38")
(FB.PRINTHEADINGSON WINDOW (GETWINDOWPROP (GETWINDOWPROP WINDOW (QUOTE MAINWINDOW))
(QUOTE INFOGOTTEN])
(FB.REPAINT.COUNTERW
[LAMBDA (COUNTERWINDOW) (* hdj "23-Apr-85 17:42")
(LET ((BROWSERW (MAINWINDOW COUNTERWINDOW T)))
(DSPFILL NIL WHITESHADE (QUOTE REPLACE)
COUNTERWINDOW)
(FB.SHOW.NUMFILES BROWSERW)
(FB.SHOW.NUMSELECTED BROWSERW)
(FB.SHOW.NUMDELETED BROWSERW])
(FB.ICONFN
[LAMBDA (W I) (* lmm "14-Sep-84 16:42")
(PROG (OLDICONREGION)
[SETQ OLDICONREGION (AND I (GETWINDOWPROP I (QUOTE REGION]
(RETURN (TITLEDICONW (create TITLEDICON
ICON ← FILEDRAWER
MASK ← FILEDRAWERMASK
TITLEREG ←(create REGION
LEFT ← 5
WIDTH ← 60
BOTTOM ← 10
HEIGHT ← 45))
(GETWINDOWPROP W (QUOTE ITEMSPEC))
FBICONFONT
(AND I (create POSITION
XCOORD ←(fetch (REGION LEFT) of OLDICONREGION)
YCOORD ←(fetch (REGION BOTTOM) of OLDICONREGION)))
NIL
(QUOTE TOP])
(FB.REPAINTFN
[LAMBDA (WINDOW R) (* hdj "26-Oct-84 17:46")
(PROG ((BROWSERITEMMAP (GETWINDOWPROP WINDOW (QUOTE BROWSERITEMMAP)))
(HEADINGWINDOW (GETWINDOWPROP WINDOW (QUOTE HEADINGWINDOW)))
(TOP (fetch (REGION TOP) of R))
[BOTTOM (IDIFFERENCE (fetch (REGION BOTTOM) of R)
(FONTPROP WINDOW (QUOTE ASCENT]
YPOS ITEMSPEC DIRWIDTH STARTOFNAME ATTRS)
(COND
((NULL BROWSERITEMMAP)
(RETURN)))
(for FILE in BROWSERITEMMAP bind REGION
do (if (AND [IGREATERP TOP (SETQ YPOS (fetch (REGION BOTTOM)
of (SETQ REGION (fetch (FILEBUCKET ITEMREGION)
of FILE]
(ILESSP BOTTOM (fetch (REGION TOP) of REGION)))
then (DSPYPOSITION (IDIFFERENCE (IPLUS (fetch (REGION BOTTOM) of REGION)
(fetch (REGION HEIGHT) of REGION))
(FONTPROP WINDOW (QUOTE ASCENT)))
WINDOW)
(OR (EQUAL (FB.PRINTANDGETREGION (fetch (FILEBUCKET ITEM) of FILE)
WINDOW MarkXPos 10)
REGION)
T
(HELP))
(if (fetch (FILEBUCKET SELECTED?) of FILE)
then (\ITEMW.SELECTITEM (LIST (fetch ITEMREGION of FILE))
WINDOW))
(if (fetch (FILEBUCKET DELETED?) of FILE)
then (FB.CHANGEDELETEMARK FILE WINDOW)))
repeatwhile (ILESSP BOTTOM YPOS])
(FB.SCROLLFN
[LAMBDA (WINDOW HORIZ VERT CONTINUOUS?) (* bvm: "20-Jul-85 23:28")
(* * Scroll FB window up/down and right/left. In right/left case, tell heading window to scroll also)
(* * only scroll an integral number of text lines)
(COND
((GETWINDOWPROP WINDOW (QUOTE FILEBROWSERBUSY)) (* Used to be (FB.CLRPROMPTW WINDOW)
(FB.PROMPTWPRINT WINDOW "This filebrowser is busy") but
that trashes the prompt window)
(FLASHWINDOW WINDOW))
(T (COND
((NOT (ZEROP HORIZ))
(SCROLLW (GETWINDOWPROP WINDOW (QUOTE HEADINGWINDOW))
HORIZ VERT CONTINUOUS?)))
(SCROLLBYREPAINTFN WINDOW HORIZ VERT CONTINUOUS?])
(FB.MENU.WHENSELECTEDFN
[LAMBDA (Item Menu Key) (* hdj "16-Sep-84 15:57")
(ADD.PROCESS (LIST (FUNCTION FB.COMMANDDISPATCH)
(KWOTE Item)
(KWOTE Menu)
(KWOTE Key))
(QUOTE NAME)
(PACK (LIST (QUOTE FB-)
(CAR Item])
(FB.INFOMENU.WHENSELECTEDFN
[LAMBDA (ITEM MENU KEY) (* hdj "18-Sep-84 12:00")
(PROG (CHOSEN (WINDOW (GETWINDOWPROP (WFROMMENU MENU)
(QUOTE MAINWINDOW)))
(INFO (CADR ITEM)))
(SETQ CHOSEN (GETWINDOWPROP WINDOW (QUOTE INFOCHOICES)))
(if (FMEMB INFO CHOSEN)
then (SHADEITEM ITEM MENU WHITESHADE)
(SETQ CHOSEN (REMOVE INFO CHOSEN))
else (SHADEITEM ITEM MENU INFOSHADE)
(SETQ CHOSEN (CONS INFO CHOSEN)))
(PUTWINDOWPROP WINDOW (QUOTE INFOCHOICES)
CHOSEN])
(FB.CLOSEFN
[LAMBDA (WINDOW) (* bvm: "21-Jul-85 00:31")
(* did you really want to close up shop?)
(COND
((IGREATERP (WINDOWPROP WINDOW (QUOTE NUMDELETED))
0)
(SELECTQ [MENU (OR FBCLOSEMENU
(SETQ FBCLOSEMENU
(create MENU
ITEMS ← FBCLOSEMENUITEMS
MENUROWS ← 2
CENTERFLG ← T
TITLE ← "FB close options"
MENUFONT ← DEFAULTBROWSERFONT]
(EXPUNGE (* Do expunge in another process, not here in mouse)
[ADD.PROCESS (LIST (FUNCTION FB.EXPUNGECOMMAND)
(KWOTE WINDOW)
NIL
(KWOTE (QUOTE CLOSEW]
(QUOTE DON'T))
(NOEXPUNGE)
(QUOTE DON'T])
(FB.SEEW.REPAINTFN
[LAMBDA (WINDOW REGION) (* hdj "16-Sep-84 15:20")
(PROG [(TEMPFILE (OPENSTREAM (GETWINDOWPROP WINDOW (QUOTE TEMPFILE))
(QUOTE BOTH]
(MOVETO (WINDOWPROP WINDOW (QUOTE XORIG))
(WINDOWPROP WINDOW (QUOTE YORIG))
WINDOW)
(SETFILEPTR TEMPFILE 0)
(PFCOPYBYTES TEMPFILE WINDOW])
(FB.SEEW.RESHAPEFN
[LAMBDA (WINDOW) (* hdj "16-Sep-84 16:11")
(PROG (BTM)
(DSPRESET WINDOW)
(DSPRIGHTMARGIN 32000 WINDOW)
(PUTWINDOWPROP WINDOW (QUOTE XORIG)
(DSPXPOSITION NIL WINDOW))
(PUTWINDOWPROP WINDOW (QUOTE YORIG)
(DSPYPOSITION NIL WINDOW))
(PUTWINDOWPROP WINDOW (QUOTE YORIG)
(DSPYPOSITION NIL WINDOW))
(FB.SEEW.REPAINTFN WINDOW)
[SETQ BTM (IPLUS (DSPYPOSITION NIL WINDOW)
(FONTPROP WINDOW (QUOTE ASCENT]
(PUTWINDOWPROP WINDOW (QUOTE EXTENT)
(create REGION
LEFT ← 0
BOTTOM ← BTM
WIDTH ← 32000
HEIGHT ←(IDIFFERENCE (GETWINDOWPROP WINDOW (QUOTE HEIGHT))
BTM])
)
(* * odds and ends)
(DEFINEQ
(FB.AFFECT.FILE.SEPARATELY/UNDOABLY
[LAMBDA (OP FILE NAME) (* hdj "23-Apr-85 18:20")
(* * do something to a file in a separate process -
do it undoably)
(LET [(PROCESS (EVAL.AS.PROCESS (BQUOTE (PROGN [LISPXEVAL (QUOTE , (LIST OP (KWOTE FILE]
(CLOSEW (TTYDISPLAYSTREAM]
(PROCESSPROP PROCESS (QUOTE NAME)
NAME)
PROCESS])
(FB.FETCHFILENAME
[LAMBDA (ENTRY) (* hdj "16-Sep-84 15:28")
(fetch (FILEBUCKET FILENAME) of ENTRY])
(FB.STARTOFNAME
[LAMBDA (FILENAME SPEC) (* lmm "14-Sep-84 17:59")
(* assume that hosts match)
[SETQ SPEC (SUBSTRING SPEC (ADD1 (OR (LASTCHPOS (CHARCODE })
SPEC)
0]
(bind (DIRSTART ←(ADD1 (OR (LASTCHPOS (CHARCODE })
FILENAME)
0)))
DIREND first (SETQ FILENAME (SUBSTRING FILENAME DIRSTART)) while (SETQ DIREND
(LASTCHPOS (CHARCODE
>)
SPEC))
do (SETQ SPEC (SUBSTRING SPEC 1 DIREND SPEC))
[if (STRPOS SPEC FILENAME 1 NIL T NIL (UPPERCASEARRAY))
then (RETURN (IPLUS DIRSTART (NCHARS SPEC]
(SETQ SPEC (SUBSTRING SPEC 1 -2 SPEC))
finally (RETURN DIRSTART])
(FB.STARTUP
[LAMBDA (WINDOW COMMANDMENU COMMANDMENUWINDOW) (* hdj "16-Sep-84 16:13")
(PROG ((UPDATE (FASSOC (QUOTE Update)
FBMENUITEMS)))
(RESETLST (RESETSAVE NIL (LIST (QUOTE SHADEITEM)
UPDATE COMMANDMENU WHITESHADE))
(RESETSAVE NIL (LIST (FUNCTION [LAMBDA (W P)
(PUTWINDOWPROP W (QUOTE FILEBROWSERBUSY)
P])
WINDOW NIL))
(SHADEITEM UPDATE COMMANDMENU FBITEMSELECTEDSHADE COMMANDMENUWINDOW)
(PUTWINDOWPROP WINDOW (QUOTE FILEBROWSERBUSY)
T)
(FB.UPDATEBROWSERITEMS (GETWINDOWPROP WINDOW (QUOTE ITEMSPEC))
WINDOW])
(FB.CREATEPRINTSPEC
[LAMBDA (FILEINFO WANTTOSEE NAMESTART) (* lmm "14-Sep-84 16:52")
(for HEADING in INFOLISTINGWIDTHS by (CDDR HEADING) when (FMEMB HEADING WANTTOSEE)
collect (create INFOWPRINTSPEC
LABEL ←[COND
((EQ HEADING (QUOTE NAME))
(SUBSTRING (CDR (FASSOC HEADING FILEINFO))
NAMESTART))
(T (CDR (FASSOC HEADING FILEINFO]
WIDTH ←(fetch (INFOWPRINTSPEC WIDTH) of (LISTGET INFOLISTINGWIDTHS HEADING])
(FB.FINDFILEBUCKET
[LAMBDA (WINDOW) (* hdj "16-Sep-84 14:23")
(for FOLDER in (WINDOWPROP WINDOW (QUOTE BROWSERITEMMAP))
bind [YPOS ←(IPLUS (LASTMOUSEY WINDOW)
(FONTPROP WINDOW (QUOTE DESCENT]
thereis (IGREATERP YPOS (fetch BOTTOM of (fetch (FILEBUCKET ITEMREGION) of FOLDER])
(FB.PROMPTFORINPUT
[LAMBDA (PROMPT DEFAULT WINDOW) (* bvm: "20-Jul-85 23:34")
(LET [(PWINDOW (CAR (GETWINDOWPROP WINDOW (QUOTE PROMPTWINDOW]
(FRESHLINE PWINDOW)
(PROMPTFORWORD PROMPT DEFAULT NIL PWINDOW NIL (QUOTE TTY)
(CHARCODE (CR ESC])
(FB.GETALLFILEINFO
[LAMBDA (FILE GENERATOR ATTRIBUTES) (* hdj "23-Aug-84 16:34")
(* *)
(for ATTR in ATTRIBUTES collect (if (EQ ATTR (QUOTE NAME))
then (CONS ATTR FILE)
else (CONS ATTR (\GENERATEFILEINFO GENERATOR ATTR])
(FB.\ItemWithTag
[LAMBDA (TAG ITEMS) (* hdj "16-Sep-84 16:16")
(* * search a menu's items for one with tag TAG)
(for ITEM in ITEMS do (if (EQ (CADR ITEM)
TAG)
then (RETURN ITEM])
)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ MarkXPos 16)
(CONSTANTS (MarkXPos 16))
)
[DECLARE: EVAL@COMPILE
(RECORD INFOWPRINTSPEC (LABEL . WIDTH))
(RECORD FILEBUCKET (FILENAME ITEMREGION # SELECTED? DELETED? FILEINFO ITEM))
]
(DECLARE: EVAL@COMPILE
(PUTPROPS ISLISPFILE? MACRO ((A)
(FILEDATE A)))
[PUTPROPS .COPYKEYDOWNP. MACRO (NIL (OR (KEYDOWNP (QUOTE LSHIFT))
(KEYDOWNP (QUOTE RSHIFT))
(KEYDOWNP (QUOTE COPY]
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS FBICONFONT DEFAULTBROWSERFONT FBPROMPTFONT BROWSERMENUFONT FBBORDERWIDTH FBCLOSEMENU
FB.EDITMENU FILEDRAWER FILEDRAWERMASK FB.EDITMENU.ITEMS FBCLOSEMENUITEMS FBMENUITEMS
FBPROFILE INFOLISTINGWIDTHS INFOSHADE FBINFOMENUITEMS FBITEMUNSELECTEDSHADE
FBITEMSELECTEDSHADE DIRCOMMANDS FB.EXPUNGEOPS)
)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(ADDTOVAR BackgroundMenuCommands ("FileBrowser" (FB)
"Opens a filebrowser window; prompts for pattern"))
(RPAQQ BackgroundMenu NIL)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA FB)
(ADDTOVAR NLAML )
(ADDTOVAR LAMA FB.PROMPTWPRINT)
)
(PUTPROPS FILEBROWSER COPYRIGHT ("Xerox Corporation" 1983 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (9860 14777 (FB 9870 . 10271) (FILEBROWSER 10273 . 14775)) (14822 24955 (
FB.EXPUNGECOMMAND 14832 . 16555) (FB.HARDCOPYCOMMAND 16557 . 16782) (FB.LOADCOMMAND 16784 . 17544) (
FB.NEWPATTERNCOMMAND 17546 . 17820) (FB.GET.NEWPATTERN 17822 . 18273) (FB.RENAMECOMMAND 18275 . 18774)
(FB.EDITCOMMAND 18776 . 20689) (FB.DELETECOMMAND 20691 . 21146) (FB.SEECOMMAND 21148 . 21307) (
FB.COMPILECOMMAND 21309 . 22041) (FB.COPYCOMMAND 22043 . 22483) (FB.GET.NEW.FILE.SPEC 22485 . 23862) (
FB.UNDELETECOMMAND 23864 . 24313) (FB.UPDATECOMMAND 24315 . 24953)) (24956 37319 (FB.MAKECOUNTERWINDOW
24966 . 25510) (FB.MAKESEEWINDOW 25512 . 26884) (FB.COMMANDDISPATCH 26886 . 30298) (FB.EDITLISPFILE
30300 . 31013) (FB.SELECT 31015 . 32892) (FB.COPY.HANDLER 32894 . 34191) (FB.UPDATEBROWSERITEMS 34193
. 37317)) (37359 47359 (FB.MAKERIGIDWINDOW 37369 . 37809) (FB.CLRPROMPTW 37811 . 37990) (
FB.PRINTHEADINGSON 37992 . 39131) (FB.PRINTANDGETREGION 39133 . 40638) (FB.MAKEHEADINGWINDOW 40640 .
41475) (FB.PROMPTWPRINT 41477 . 42058) (FB.PROMPTWTERPRI 42060 . 42356) (FB.SELECTFILE 42358 . 42872)
(FB.UNSELECTFILE 42874 . 43311) (FB.CHANGEDELETEMARK 43313 . 43812) (FB.CHANGECOPYSELECTMARK 43814 .
44408) (FB.INFOMENU.SHADEINITIALSELECTIONS 44410 . 44849) (FB.SHOW.NUMDELETED 44851 . 45682) (
FB.SHOW.NUMFILES 45684 . 46471) (FB.SHOW.NUMSELECTED 46473 . 47357)) (47389 54047 (
FB.HEADINGWREDISPLAYFN 47399 . 47640) (FB.REPAINT.COUNTERW 47642 . 48009) (FB.ICONFN 48011 . 48722) (
FB.REPAINTFN 48724 . 50297) (FB.SCROLLFN 50299 . 51081) (FB.MENU.WHENSELECTEDFN 51083 . 51383) (
FB.INFOMENU.WHENSELECTEDFN 51385 . 52026) (FB.CLOSEFN 52028 . 52897) (FB.SEEW.REPAINTFN 52899 . 53280)
(FB.SEEW.RESHAPEFN 53282 . 54045)) (54074 57977 (FB.AFFECT.FILE.SEPARATELY/UNDOABLY 54084 . 54546) (
FB.FETCHFILENAME 54548 . 54712) (FB.STARTOFNAME 54714 . 55510) (FB.STARTUP 55512 . 56141) (
FB.CREATEPRINTSPEC 56143 . 56662) (FB.FINDFILEBUCKET 56664 . 57046) (FB.PROMPTFORINPUT 57048 . 57376)
(FB.GETALLFILEINFO 57378 . 57690) (FB.\ItemWithTag 57692 . 57975)))))
STOP