(FILECREATED " 5-Oct-84 17:52:06" {ERIS}<LISPCORE>LIBRARY>FILEBROWSER.;26 49092
changes to: (FNS FB.SEECOMMAND FB.PRINTANDGETREGION)
(VARS INFOLISTINGWIDTHS)
previous date: "27-Sep-84 11:46:34" {ERIS}<LISPCORE>LIBRARY>FILEBROWSER.;25)
(* Copyright (c) 1983, 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT FILEBROWSERCOMS)
(RPAQQ FILEBROWSERCOMS [(FILES ATTACHEDWINDOW)
(VARS (FCOMPILEOPS NIL)
(FB.EDITMENU NIL)
(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)
FB.EDITMENU.ITEMS FBCLOSEMENUITEMS FBMENUITEMS FBPROFILE
INFOLISTINGWIDTHS INFOSHADE FBINFOMENUITEMS FBITEMUNSELECTEDSHADE
FBITEMSELECTEDSHADE)
(BITMAPS FILEDRAWER FILEDRAWERMASK)
(CURSORS RIGHTARROWCURSOR)
(* * Main filebrowser fns)
(FNS FB FILEBROWSER)
(COMS (* * commands and major subfunctions)
(FNS FB.EXPUNGECOMMAND FB.HARDCOPYCOMMAND FB.LOADCOMMAND
FB.NEWPATTERNCOMMAND FB.RENAMECOMMAND FB.EDITCOMMAND
FB.DELETECOMMAND FB.SEECOMMAND FB.COMPILECOMMAND FB.COPYCOMMAND
FB.UNDELETECOMMAND FB.UPDATECOMMAND)
(FNS FB.MAKESEEWINDOW FB.COMMANDDISPATCH FB.EDITLISPFILE FB.SELECT
FB.UPDATEBROWSERITEMS))
(* * 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)
(* * window functions)
(FNS FB.HEADINGWREDISPLAYFN FB.ICONFN FB.BUTTONEVENTFN FB.CURSORMOVEDFN
FB.CURSOROUTFN FB.REPAINTFN FB.SCROLLFN FB.RIGHTBUTTONFN
FB.MENU.WHENSELECTEDFN FB.INFOMENU.WHENSELECTEDFN FB.CLOSEFN
FB.SEEW.REPAINTFN FB.SEEW.RESHAPEFN)
(* * odds and ends)
(FNS FB.COPYBUTTONDOWN? 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?)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA FB)
(NLAML)
(LAMA FB.PROMPTWPRINT])
(FILESLOAD ATTACHEDWINDOW)
(RPAQQ FCOMPILEOPS NIL)
(RPAQQ FB.EDITMENU NIL)
(RPAQQ FUPDATEOPS NIL)
(RPAQQ FLOADOPS NIL)
(RPAQQ 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)))
(RPAQQ 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 (AUTHOR NAME LENGTH 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@")
(RPAQ RIGHTARROWCURSOR (CURSORCREATE (READBITMAP) 7 9))
(16 16
"@@@@"
"@@@@"
"@F@@"
"@GH@"
"@GN@"
"@GOH"
"OOON"
"OOOO"
"OOON"
"@GOH"
"@GN@"
"@GH@"
"@F@@"
"@@@@"
"@@@@"
"@@@@") (* * Main filebrowser fns)
(DEFINEQ
(FB
[NLAMBDA PATTERN (* lmm "17-Aug-84 15:39")
(FILEBROWSER (OR (CAR (NLAMBDA.ARGS PATTERN))
(PROMPTFORWORD "File browser pattern?" NIL NIL PROMPTWINDOW])
(FILEBROWSER
[LAMBDA (FILESPEC) (* hdj "16-Sep-84 16:15")
(PROG ((PROMPTWHEIGHT 3)
COMMANDMENUWINDOW COMMANDMENU DIRSTART HEADINGW 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 (GETWINDOWPROP BROWSERWINDOW (QUOTE WIDTH))
DEFAULTBROWSERFONT FBBORDERWIDTH "File Browser Window")
)
(FB.MAKERIGIDWINDOW HEADINGW)
(ATTACHWINDOW HEADINGW BROWSERWINDOW (QUOTE TOP))
(PUTWINDOWPROP BROWSERWINDOW (QUOTE HEADINGWINDOW)
HEADINGW) (* for scroller to scroll heading too)
(SETQ COMMANDMENUWINDOW (ATTACHMENU COMMANDMENU BROWSERWINDOW (QUOTE TOP)))
(PUTWINDOWPROP 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)))
(PUTWINDOWPROP BROWSERWINDOW (QUOTE INFOCHOICES)
FBPROFILE)
(FB.INFOMENU.SHADEINITIALSELECTIONS INFOMENUW FBPROFILE)
(FB.MAKERIGIDWINDOW (GETPROMPTWINDOW BROWSERWINDOW PROMPTWHEIGHT FBPROMPTFONT))
(DSPFONT DEFAULTBROWSERFONT BROWSERWINDOW)
(PUTWINDOWPROP BROWSERWINDOW (QUOTE ICONFN)
(FUNCTION FB.ICONFN))
(PUTWINDOWPROP BROWSERWINDOW (QUOTE ICONTITLE)
FILESPEC)
(PUTWINDOWPROP BROWSERWINDOW (QUOTE NUMDELETED)
0)
(PUTWINDOWPROP BROWSERWINDOW (QUOTE ORIGX)
(DSPXPOSITION NIL BROWSERWINDOW))
(PUTWINDOWPROP BROWSERWINDOW (QUOTE ORIGY)
(DSPYPOSITION NIL BROWSERWINDOW))
(PUTWINDOWPROP BROWSERWINDOW (QUOTE DIRWIDTH)
(GETWINDOWPROP BROWSERWINDOW (QUOTE WIDTH)))
(PUTWINDOWPROP BROWSERWINDOW (QUOTE BUTTONEVENTFN)
(FUNCTION FB.BUTTONEVENTFN))
(PUTWINDOWPROP BROWSERWINDOW (QUOTE RIGHTBUTTONFN)
(FUNCTION FB.RIGHTBUTTONFN))
(PUTWINDOWPROP BROWSERWINDOW (QUOTE REPAINTFN)
(FUNCTION FB.REPAINTFN))
(PUTWINDOWPROP BROWSERWINDOW (QUOTE CURSORMOVEDFN)
(FUNCTION FB.CURSORMOVEDFN))
(PUTWINDOWPROP 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)
(PUTWINDOWPROP 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) (* hdj "17-Sep-84 17:53")
[PROG (FILENAME)
(for FILEENTRY in (GETWINDOWPROP WINDOW (QUOTE BROWSERITEMMAP))
do (if (fetch (FILEBUCKET DELETED?) of FILEENTRY)
then (if [NOT (DELFILE (SETQ FILENAME (FB.FETCHFILENAME FILEENTRY]
then (FB.PROMPTWPRINT WINDOW "Couldn't expunge " FILENAME)
(FB.PROMPTWTERPRI WINDOW]
(PUTWINDOWPROP WINDOW (QUOTE CURRENTFOLDERNUMBERS)
NIL)
(PUTWINDOWPROP WINDOW (QUOTE NUMDELETED)
0)
(FB.UPDATEBROWSERITEMS (GETWINDOWPROP WINDOW (QUOTE ITEMSPEC))
WINDOW])
(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 "25-Sep-84 17:13")
(PROG [(FILE (MKATOM (FB.FETCHFILENAME FILEENTRY)))
(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]
(if (NULL LOADOP)
then (RETURN))
(EVAL.AS.PROCESS (LIST LOADOP (KWOTE FILE])
(FB.NEWPATTERNCOMMAND
[LAMBDA (WINDOW) (* hdj "17-Sep-84 17:03")
(PROG (ITEMSPEC TITLE PROMPTW)
[SETQ PROMPTW (CAR (GETWINDOWPROP WINDOW (QUOTE PROMPTWINDOW]
(FB.CLRPROMPTW WINDOW)
(if (NULL (SETQ ITEMSPEC (FB.PROMPTFORINPUT "New file group description? "
(GETWINDOWPROP WINDOW (QUOTE ITEMSPEC))
WINDOW)))
then (RETURN))
(PUTWINDOWPROP WINDOW (QUOTE ITEMSPEC)
(DIRECTORY.FILL.PATTERN ITEMSPEC))
(RETURN T])
(FB.RENAMECOMMAND
[LAMBDA (PREFIX FILEENTRY WINDOW) (* hdj "17-Sep-84 17:04")
(PROG (TOFILE)
(SETQ FILEENTRY (FB.FETCHFILENAME FILEENTRY))
(SETQ TOFILE (if (NULL PREFIX)
then (FB.PROMPTFORINPUT (CONCAT "Rename file " FILEENTRY " what? ")
NIL WINDOW)
else (PACKFILENAME (QUOTE DIRECTORY)
PREFIX
(QUOTE VERSION)
NIL
(QUOTE BODY)
FILEENTRY)))
(if (NULL TOFILE)
then (FB.PROMPTWPRINT WINDOW " ... nothing")
(FB.PROMPTWTERPRI WINDOW)
(RETURN)
else (FB.PROMPTWTERPRI WINDOW))
(SETQ TOFILE (\ADD.CONNECTED.DIR TOFILE))
(RENAMEFILE FILEENTRY TOFILE)
(SETQ FBUPDATE? T)
(FB.PROMPTWPRINT WINDOW FILEENTRY " renamed " TOFILE)
(RETURN TOFILE])
(FB.EDITCOMMAND
[LAMBDA (FILEENTRY KEY WINDOW) (* hdj "25-Sep-84 17:24")
(PROG [(FILE (MKATOM (FB.FETCHFILENAME FILEENTRY]
(if (EQ KEY (QUOTE MIDDLE))
then (FB.PROMPTWTERPRI WINDOW)
(FB.PROMPTWPRINT WINDOW "Edit " FILE " with which editor?")
(SELECTQ [MENU (OR FB.EDITMENU (SETQ FB.EDITMENU
(create MENU
MENUFONT ← DEFAULTBROWSERFONT
ITEMS ← FB.EDITMENU.ITEMS]
(TEDIT (TEDIT FILE))
(DEDIT (FB.EDITLISPFILE FILE WINDOW))
(RETURN))
else (if (LISPSOURCEFILEP FILE)
then (FB.EDITLISPFILE FILE WINDOW)
else (TEDIT FILE])
(FB.DELETECOMMAND
[LAMBDA (FILEENTRY WINDOW) (* hdj "16-Sep-84 16:06")
(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.SEECOMMAND
[LAMBDA (FILEENTRY KEY BROWSER) (* lmm " 5-Oct-84 17:35")
(PROG ((FILE (FB.FETCHFILENAME FILEENTRY))
WINDOW)
(if (AND (NULL (FILENAMEFIELD FILE (QUOTE NAME)))
(DIRECTORYNAMEP FILE))
then (FILEBROWSER (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE NAME)
(QUOTE *)
(QUOTE EXTENSION)
(QUOTE *)
(QUOTE BODY)
FILE))
else (FB.MAKESEEWINDOW FILE BROWSER])
(FB.COMPILECOMMAND
[LAMBDA (FILEENTRY KEY WINDOW) (* hdj "25-Sep-84 17:15")
(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)))
(EVAL.AS.PROCESS (LIST COMPILEOP (KWOTE FILE])
(FB.COPYCOMMAND
[LAMBDA (PREFIX FILEENTRY WINDOW) (* hdj "17-Sep-84 17:04")
(PROG (TOFILE)
(SETQ FILEENTRY (FB.FETCHFILENAME FILEENTRY))
(SETQ TOFILE (if (NULL PREFIX)
then (FB.PROMPTFORINPUT (CONCAT "Copy file " FILEENTRY " where? ")
NIL WINDOW)
else (PACKFILENAME (QUOTE DIRECTORY)
PREFIX
(QUOTE VERSION)
NIL
(QUOTE BODY)
FILEENTRY)))
(if (NULL TOFILE)
then (FB.PROMPTWPRINT WINDOW " ... nowhere")
(FB.PROMPTWTERPRI WINDOW)
(RETURN))
(SETQ TOFILE (\ADD.CONNECTED.DIR TOFILE))
(COPYFILE FILEENTRY TOFILE)
(SETQ FBUPDATE? T)
(FB.PROMPTWPRINT WINDOW FILEENTRY " copied to " TOFILE)
(FB.PROMPTWTERPRI WINDOW)
(RETURN TOFILE])
(FB.UNDELETECOMMAND
[LAMBDA (FILEENTRY WINDOW) (* hdj "16-Sep-84 16:06")
(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.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.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) (* hdj "17-Sep-84 17:05")
(PROG (WINDOW FBUPDATE? FILELIST PREFIX)
(SETQ WINDOW (WINDOWPROP (WFROMMENU MENU)
(QUOTE MAINWINDOW)))
(COND
((GETWINDOWPROP WINDOW (QUOTE FILEBROWSERBUSY))
(FB.PROMPTWPRINT WINDOW "This filebrowser is busy")
(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 "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)))
(Copy (if (IGREATERP (LENGTH FILELIST)
1)
then (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 (if (IGREATERP (LENGTH FILELIST)
1)
then (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)))
(SHOULDNT))
(COND
(FBUPDATE? (FB.UPDATEBROWSERITEMS (WINDOWPROP WINDOW (QUOTE ITEMSPEC))
WINDOW])
(FB.EDITLISPFILE
[LAMBDA (FILE WINDOW) (* hdj "25-Sep-84 17:21")
(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 (LOADFROM FILE)
else (RETURN)))
(EDITDEF ROOT (QUOTE FILES])
(FB.SELECT
[LAMBDA (WINDOW) (* hdj "16-Sep-84 16:04")
(PROG (BROWSERITEMMAP FOLDER SETSEL ADDSEL EXTEND CURRENT#S FOLDER# FIRST# LAST#)
(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 (if (fetch (FILEBUCKET SELECTED?) of FOLDER)
then (FB.UNSELECTFILE FOLDER WINDOW)
else (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.UPDATEBROWSERITEMS
[LAMBDA (ITEMSPEC WINDOW) (* hdj "18-Sep-84 10:01")
(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")
(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])
)
(* * 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 "16-Sep-84 15:37")
(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))
(RETURN PWINDOW])
(FB.PROMPTWPRINT
[LAMBDA U (* Jellinek " 6-May-84 16:37")
(PROG (WINDOW)
(COND
((ILESSP U 2)
(ERROR "not enough args to PROMPTWPRINT"))) (* CAR is window, CDR is height in lines)
[SETQ WINDOW (CAR (GETWINDOWPROP (ARG U 1)
(QUOTE PROMPTWINDOW]
(for ITEM from 2 to U do (PRIN1 (ARG U ITEM)
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) (* lmm "14-Sep-84 15:59")
(PROG ((FOLDERREGION (fetch ITEMREGION of FOLDER))) (* underline first line of the folder
(which generally gets the file name))
(BITBLT NIL 0 0 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 TEXTURE)
(QUOTE INVERT)
GRAYSHADE])
(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])
)
(* * window functions)
(DEFINEQ
(FB.HEADINGWREDISPLAYFN
[LAMBDA (WINDOW) (* hdj "16-Sep-84 15:38")
(FB.PRINTHEADINGSON WINDOW (GETWINDOWPROP (GETWINDOWPROP WINDOW (QUOTE MAINWINDOW))
(QUOTE INFOGOTTEN])
(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.BUTTONEVENTFN
[LAMBDA (WINDOW) (* hdj "16-Sep-84 16:46")
(PROG (FOLDER)
(if (FB.COPYBUTTONDOWN?)
then (GETMOUSESTATE)
(if (SETQ FOLDER (FB.FINDFILEBUCKET WINDOW))
then (FB.CHANGECOPYSELECTMARK FOLDER WINDOW)
(while (FB.COPYBUTTONDOWN?) do (BLOCK))
(BKSYSBUF (fetch (FILEBUCKET FILENAME) of FOLDER))
(FB.CHANGECOPYSELECTMARK FOLDER WINDOW))
else (FB.SELECT WINDOW])
(FB.CURSORMOVEDFN
[LAMBDA (WINDOW) (* hdj "12-Sep-84 18:21")
(if (IGEQ MarkXPos (fetch XCOORD of (CURSORPOSITION NIL WINDOW)))
then (SETCURSOR RIGHTARROWCURSOR)
else (if (NEQ (CURSOR)
DEFAULTCURSOR)
then (SETCURSOR DEFAULTCURSOR])
(FB.CURSOROUTFN
[LAMBDA (WINDOW) (* rao: "30-JUN-82 15:49")
(SETCURSOR DEFAULTCURSOR])
(FB.REPAINTFN
[LAMBDA (WINDOW R) (* lmm "27-Sep-84 11:44")
(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?) (* hdj "16-Sep-84 15:49")
(* * 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)
(if (GETWINDOWPROP WINDOW (QUOTE FILEBROWSERBUSY))
then (FB.CLRPROMPTW WINDOW)
(FB.PROMPTWPRINT WINDOW "This filebrowser is busy")
else (COND
((NOT (ZEROP HORIZ))
(SCROLLW (GETWINDOWPROP WINDOW (QUOTE HEADINGWINDOW))
HORIZ VERT CONTINUOUS?)))
(SCROLLBYREPAINTFN WINDOW HORIZ VERT CONTINUOUS?])
(FB.RIGHTBUTTONFN
[LAMBDA (WINDOW) (* hdj "16-Sep-84 15:54")
(COND
((IGREATERP (LASTMOUSEX WINDOW)
MarkXPos)
(DOWINDOWCOM WINDOW))
(T (FB.SELECT WINDOW])
(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) (* hdj "16-Sep-84 15:50")
(* did you really want to close up shop?)
(COND
((IGREATERP (GETWINDOWPROP 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 (FB.EXPUNGECOMMAND WINDOW))
(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.COPYBUTTONDOWN?
[LAMBDA NIL (* hdj "13-Sep-84 14:59")
(OR (KEYDOWNP (QUOTE LSHIFT))
(KEYDOWNP (QUOTE RSHIFT))
(KEYDOWNP (QUOTE COPY])
(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 EXPRS WINDOW) (* hdj " 1-Sep-84 15:58")
(PROMPTFORWORD PROMPT EXPRS NIL (CAR (GETWINDOWPROP WINDOW (QUOTE PROMPTWINDOW)))
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)))
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA FB)
(ADDTOVAR NLAML )
(ADDTOVAR LAMA FB.PROMPTWPRINT)
)
(PUTPROPS FILEBROWSER COPYRIGHT ("Xerox Corporation" 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (9379 12930 (FB 9389 . 9610) (FILEBROWSER 9612 . 12928)) (12975 20686 (FB.EXPUNGECOMMAND
12985 . 13721) (FB.HARDCOPYCOMMAND 13723 . 13948) (FB.LOADCOMMAND 13950 . 14698) (
FB.NEWPATTERNCOMMAND 14700 . 15319) (FB.RENAMECOMMAND 15321 . 16269) (FB.EDITCOMMAND 16271 . 17010) (
FB.DELETECOMMAND 17012 . 17406) (FB.SEECOMMAND 17408 . 17990) (FB.COMPILECOMMAND 17992 . 18707) (
FB.COPYCOMMAND 18709 . 19650) (FB.UNDELETECOMMAND 19652 . 20044) (FB.UPDATECOMMAND 20046 . 20684)) (
20687 30456 (FB.MAKESEEWINDOW 20697 . 22069) (FB.COMMANDDISPATCH 22071 . 25243) (FB.EDITLISPFILE 25245
. 25867) (FB.SELECT 25869 . 27526) (FB.UPDATEBROWSERITEMS 27528 . 30454)) (30496 37735 (
FB.MAKERIGIDWINDOW 30506 . 30946) (FB.CLRPROMPTW 30948 . 31127) (FB.PRINTHEADINGSON 31129 . 32268) (
FB.PRINTANDGETREGION 32270 . 33775) (FB.MAKEHEADINGWINDOW 33777 . 34493) (FB.PROMPTWPRINT 34495 .
34934) (FB.PROMPTWTERPRI 34936 . 35232) (FB.SELECTFILE 35234 . 35748) (FB.UNSELECTFILE 35750 . 36187)
(FB.CHANGEDELETEMARK 36189 . 36688) (FB.CHANGECOPYSELECTMARK 36690 . 37292) (
FB.INFOMENU.SHADEINITIALSELECTIONS 37294 . 37733)) (37765 44908 (FB.HEADINGWREDISPLAYFN 37775 . 38016)
(FB.ICONFN 38018 . 38729) (FB.BUTTONEVENTFN 38731 . 39272) (FB.CURSORMOVEDFN 39274 . 39609) (
FB.CURSOROUTFN 39611 . 39753) (FB.REPAINTFN 39755 . 41328) (FB.SCROLLFN 41330 . 41976) (
FB.RIGHTBUTTONFN 41978 . 42208) (FB.MENU.WHENSELECTEDFN 42210 . 42510) (FB.INFOMENU.WHENSELECTEDFN
42512 . 43153) (FB.CLOSEFN 43155 . 43758) (FB.SEEW.REPAINTFN 43760 . 44141) (FB.SEEW.RESHAPEFN 44143
. 44906)) (44935 48498 (FB.COPYBUTTONDOWN? 44945 . 45145) (FB.FETCHFILENAME 45147 . 45311) (
FB.STARTOFNAME 45313 . 46109) (FB.STARTUP 46111 . 46740) (FB.CREATEPRINTSPEC 46742 . 47261) (
FB.FINDFILEBUCKET 47263 . 47645) (FB.PROMPTFORINPUT 47647 . 47897) (FB.GETALLFILEINFO 47899 . 48211) (
FB.\ItemWithTag 48213 . 48496)))))
STOP