Copyright (C) 1994, Digital Equipment Corp.
<* PRAGMA LL *> <* PRAGMA EXPORTED *> MODULE*************************** Creation **************************; IMPORT AnchorSplit, AnyEvent, Atom, Axis, BorderedVBT, Cursor, File, Filter, Font, FS, HVSplit, ISOChar, Lex, ListVBT, MenuSwitchVBT, MultiFilter, MultiSplit, OSError, PaintOp, Pathname, Pixmap, Process, Rd, Rect, RegularFile, Shadow, ShadowedVBT, ShadowedFeedbackVBT, Split, Text, TextList, TextListSort, TextPort, TextRd, TextVBT, Thread, Time, TypeinVBT, VBT, WeakRef; REVEAL T = Public BRANDED "FileBrowserVBT 4.0" OBJECT mu: MUTEX; <* LL = mu *> helper : Helper; dirmenu : DirMenu; suffixes: TextList.T; readOnly: BOOLEAN; dir : Pathname.T; toSelect: TEXT; (* if non-empty/NIL, select this string *) truthInHelper: BOOLEAN; (* where to look for the value *) time : Time.T; (* last time we looked at this directory *) statThread : Thread.T; isDir : REF ARRAY OF BOOLEAN OVERRIDES init := Init; selectItems := SelectItems; (* no-op *) activateFile := ActivateFile; (* no-op *) activateDir := ActivateDir; error := DefaultError; (* no-op *) insertCells := InsertCells; removeCells := RemoveCells; getValue := GetValue; END; Selector = ListVBT.MultiSelector BRANDED OBJECT v: T OVERRIDES insideClick := InsideClick END; Helper = TypeinVBT.T BRANDED OBJECT parent: T; OVERRIDES returnAction := HelperReturn; modified := HelperModified END; DirMenu = PublicDirMenu BRANDED OBJECT font := Font.BuiltIn; shadow : Shadow.T := NIL; (* Shadow.None *) filebrowser: T; top : TextVBT.T; vbox : DirMenuVBox; OVERRIDES init := InitDirMenu; setFont := SetFontDirMenu; END; TYPE (* The feedback on the DirMenu button is a DirMenuTop. Its multi-child is a TextVBT. *) DirMenuTop = ShadowedFeedbackVBT.T OBJECT dm: DirMenu END; (* Each item in the vbox ("pathname component") is a DirMenuButton. *) DirMenuButton = MenuSwitchVBT.T OBJECT dm: DirMenu METHODS init (text: TEXT): DirMenuButton := InitDirMenuButton; put (text: TEXT) := DirMenuButtonPut; get (): TEXT := DirMenuButtonGet; OVERRIDES callback := DirMenuButtonCallback END; (* The vbox of components needs to get its width from the DirMenu button. *) DirMenuVBox = HVSplit.T OBJECT dm: DirMenu OVERRIDES shape := DMVBoxShape END; (* We maintain a list of weak references to all initilialized filebrowsers, and we scan the list once a second, refreshing each one. *) FBList = REF RECORD car: WeakRef.T; cdr: FBList := NIL END; VAR tlock := NEW (MUTEX); <* LL = tlock *> fblist: FBList := NIL; fbcond := NEW (Thread.Condition); FileBrowserVBT
PROCEDURE************************ Client interface **********************Init (v : T; font : Font.T := Font.BuiltIn; colors: PaintOp.ColorQuad := NIL ): T = BEGIN IF colors = NIL THEN colors := Shadow.None END; v.mu := NEW (MUTEX); TRY LOCK v.mu DO TYPECASE v.selector OF | NULL => v.selector := NEW (Selector, v := v).init (v) | Selector (s) => s.v := v ELSE <* ASSERT FALSE *> END; EVAL ListVBT.T.init (v, colors); TYPECASE v.painter OF | ListVBT.TextPainter (tp) => tp.setFont (v, font) ELSE END; v.helper := NIL; v.dirmenu := NIL; v.suffixes := NIL; v.readOnly := FALSE; v.toSelect := ""; v.truthInHelper := FALSE; v.isDir := NEW (REF ARRAY OF BOOLEAN, 100); v.statThread := NIL; LOCK tlock DO fblist := NEW (FBList, car := WeakRef.FromRef (v), cdr := fblist); Thread.Signal (fbcond) END; v.dir := Process.GetWorkingDirectory (); END EXCEPT | OSError.E (code) => CallError (v, code); v.dir := "" END; RETURN v END Init; PROCEDUREInsertCells (v: T; at: ListVBT.Cell; n: CARDINAL) = (* Insert the "isDir" bits, too. *) VAR count := v.count (); first := MAX (0, MIN (at, count)); oldbits := v.isDir; oldsize := NUMBER (oldbits^); BEGIN Public.insertCells (v, at, n); IF n + count > oldsize THEN v.isDir := NEW (REF ARRAY OF BOOLEAN, MAX (n + count, oldsize + oldsize DIV 2)); SUBARRAY (v.isDir^, 0, oldsize) := oldbits^ END; SUBARRAY (v.isDir^, first + n, count - first) := SUBARRAY (v.isDir^, first, count - first); FOR i := first TO first + n - 1 DO v.isDir [i] := FALSE END END InsertCells; PROCEDURERemoveCells (v: T; at: ListVBT.Cell; n: CARDINAL) = (* Delete (shift) the "isDir" bits, too. *) VAR count := v.count (); first := MAX (0, MIN (at, count)); amount := MIN (at + n, count) - first; k := count - (first + amount); BEGIN Public.removeCells (v, at, n); IF amount > 0 THEN SUBARRAY (v.isDir^, first, k) := SUBARRAY (v.isDir^, first + amount, k) END END RemoveCells; PROCEDUREGetValue (v: T; this: ListVBT.Cell): REFANY = (* Strip off the directory marker if this is a directory. *) VAR val: Pathname.T := Public.getValue (v, this); BEGIN IF v.isDir [this] THEN val := Text.Sub (val, 0, Text.Length (val) - DirMarkerLength) END; RETURN val END GetValue; <* EXPORTED *> PROCEDURERefresh (v: T) = <* LL = {} *> BEGIN LOCK v.mu DO IF VBT.Domain (v) = Rect.Empty THEN RETURN END; TRY IF FS.Status (v.dir).modificationTime > v.time THEN DisplayDir (v) END EXCEPT | OSError.E (code) => CallError (v, code); v.dir := ""; v.removeCells (0, LAST (CARDINAL)); END END END Refresh; PROCEDUREWatcher (<* UNUSED *> cl: Thread.Closure): REFANY = <* LL = {} *> (* This loops forever. It waits until there are some filebrowsers, then it refreshes them all and sleeps for a second. *) VAR v : T; list: FBList; BEGIN LOOP LOCK tlock DO WHILE fblist = NIL DO Thread.Wait (tlock, fbcond) END; list := fblist; v := WeakRef.ToRef (list.car); IF v = NIL THEN (* The last one is gone. *) fblist := NIL ELSE Refresh (v); WHILE list.cdr # NIL DO (* Any more? *) v := WeakRef.ToRef (list.cdr.car); IF v = NIL THEN (* It's gone. *) list.cdr := list.cdr.cdr (* (pop (cdr list)) *) ELSE list := list.cdr; (* (pop list) *) Refresh (v) END (* IF *) END (* WHILE *) END (* IF *) END; (* LOCK *) Thread.Pause (1.0D0) END (* LOOP *) END Watcher; <* EXPORTED *> PROCEDURESetHelper (v: T; helper: Helper) = BEGIN LOCK v.mu DO v.helper := helper; IF helper # NIL THEN helper.parent := v END END END SetHelper; PROCEDUREInitDirMenu (dm : DirMenu; font : Font.T := Font.BuiltIn; shadow: Shadow.T := NIL; (* Shadow.None *) n : CARDINAL := 0 ): DirMenu = BEGIN IF shadow = NIL THEN shadow := Shadow.None END; dm.shadow := shadow; dm.font := font; dm.top := NEW (TextVBT.T).init (""); dm.vbox := NEW (DirMenuVBox, dm := dm).init (Axis.T.Ver); WITH feedback = NEW (DirMenuTop, dm := dm).init (NIL, shadow), menuFrame = NEW (ShadowedVBT.T).init ( NIL, shadow, Shadow.Style.Raised) DO EVAL AnchorSplit.T.init (dm, feedback, menuFrame, n); MultiSplit.AddChild (dm, dm.top); MultiSplit.AddChild (dm, dm.vbox); RETURN dm END END InitDirMenu; PROCEDUREDMVBoxShape (vbox: DirMenuVBox; ax: Axis.T; n: CARDINAL): VBT.SizeRange = BEGIN IF ax = Axis.T.Ver THEN RETURN HVSplit.T.shape (vbox, ax, n) ELSE (* Match the width of the top button. *) VAR op : PaintOp.T; (* UNUSED *) txt : Pixmap.T; (* UNUSED *) borderSizeMM: REAL; borderedVBT : BorderedVBT.T := VBT.Parent (vbox); BEGIN BorderedVBT.Get (borderedVBT, borderSizeMM, op, txt); WITH borderSizeRealPixels = VBT.MMToPixels (vbox, borderSizeMM, ax), shadowSizeMM = vbox.dm.shadow.size, shadowSizeRealPixels = VBT.MMToPixels (vbox, shadowSizeMM, ax), buttonWidth = Rect.HorSize (VBT.Domain (vbox.dm)), w = ROUND ( FLOAT (buttonWidth) - 2.0 * (borderSizeRealPixels + shadowSizeRealPixels)), myWidth = HVSplit.T.shape (vbox, ax, n).pref, width = MAX (w, myWidth) DO RETURN VBT.SizeRange {width, width, width + 1} END END END END DMVBoxShape; PROCEDURESetFontDirMenu (dm: DirMenu; font: Font.T) = BEGIN dm.font := font; END SetFontDirMenu; PROCEDURESetDirMenu (v: T; dm: DirMenu) = BEGIN LOCK v.mu DO v.dirmenu := dm; IF dm # NIL THEN dm.filebrowser := v; END END END SetDirMenu;
<* EXPORTED *> PROCEDURE********************* Displaying a directory **********************SetReadOnly (v: T; readOnly: BOOLEAN) = BEGIN LOCK v.mu DO v.readOnly := readOnly END END SetReadOnly; <* EXPORTED *> PROCEDURESetSuffixes (v: T; suffixes: TEXT) = BEGIN WITH list = ParseSuffixes (suffixes) DO LOCK v.mu DO v.suffixes := list; v.time := 0.0D0; (* force true redisplay next chance *) VBT.Mark (v) END END END SetSuffixes; PROCEDUREParseSuffixes (suffixes: TEXT): TextList.T = VAR list : TextList.T := NIL; rd := TextRd.New (suffixes); suffix: TEXT; <* FATAL Thread.Alerted *> BEGIN TRY TRY LOOP Lex.Skip (rd, ISOChar.All - ISOChar.AlphaNumerics); suffix := Lex.Scan (rd, ISOChar.AlphaNumerics); IF Text.Empty (suffix) THEN EXIT END; list := TextList.Cons (suffix, list) END FINALLY Rd.Close (rd) END EXCEPT | Rd.Failure => END; RETURN list END ParseSuffixes; <* EXPORTED *> PROCEDURESet (v: T; path: Pathname.T; time: VBT.TimeStamp := 0) RAISES {Error} = <* LL.sup = VBT.mu *> VAR file, abs: Pathname.T; type: File.Type; BEGIN LOCK v.mu DO TRY IF NOT Pathname.Absolute (path) THEN path := Pathname.Join (v.dir, path, NIL) END; TRY abs := FS.GetAbsolutePathname (path); type := FS.Status (abs).type; IF type = RegularFile.FileType THEN v.dir := Pathname.Prefix (abs); file := Pathname.Last (abs) ELSIF type = FS.DirectoryFileType THEN v.dir := abs; file := "" ELSE <* ASSERT FALSE *> END EXCEPT | OSError.E (c) => (* That name failed, but maybe this isn't a readonly filebrowser, and it's a "new" filename in an existing directory. Check the parent directory (prefix). *) IF v.readOnly THEN RAISE OSError.E (c) END; (* Nope. *) file := Pathname.Last (path); path := Pathname.Prefix (path); abs := FS.GetAbsolutePathname (path); (* If that failed, the parent-directory didn't exist, either, so let the caller handle this exception. *) IF FS.Status (abs).type = FS.DirectoryFileType THEN v.dir := abs ELSE (* The "parent" exists, but it isn't a directory. *) RaiseError (v, "Not a directory", path) END (* IF *) END (* inner TRY *) EXCEPT | OSError.E (c) => RaiseError (v, Atom.ToText (c.head), path) END; (* outer TRY *) v.toSelect := file; v.time := 0.0D0; (* That'll trigger the Watcher. *) ShowFileInHelper (v, file, time); END (* LOCK *) END Set; <* EXPORTED *> PROCEDUREUnselect (v: T) = BEGIN LOCK v.mu DO v.selectNone () END END Unselect; <* EXPORTED *> PROCEDUREGetDir (v: T): Pathname.T = BEGIN LOCK v.mu DO RETURN v.dir END END GetDir; <* EXPORTED *> PROCEDUREGetFile (v: T): Pathname.T RAISES {Error} = BEGIN WITH files = GetFiles (v) DO IF files = NIL THEN RETURN "" ELSE RETURN files.head END END END GetFile; <* EXPORTED *> PROCEDUREGetFiles (v: T): TextList.T RAISES {Error} = BEGIN LOCK v.mu DO IF v.truthInHelper THEN VAR file := TextPort.GetText (v.helper); BEGIN IF NOT Pathname.Valid (file) THEN RaiseError (v, "Invalid pathname", file) ELSIF NOT Pathname.Absolute (file) THEN file := Pathname.Join (v.dir, file, NIL) END; RETURN TextList.List1 (file) END ELSIF Text.Empty (v.dir) THEN RETURN NIL ELSE VAR res: TextList.T := NIL; BEGIN FOR i := v.count () - 1 TO 0 BY -1 DO IF v.isSelected (i) THEN res := TextList.Cons ( Pathname.Join (v.dir, v.getValue (i), NIL), res) END END; RETURN res END END END END GetFiles;
CONST DirMarker = " (dir)"; VAR DirMarkerLength := Text.Length (DirMarker); PROCEDURE************************** User interface *************************DisplayDir (v: T) = (* Display the directory v.dir, which might or might not really be accessible. If it isn't accessible, call v.error. *) <* LL = v.mu *> VAR allfiles: TextList.T := NIL; (* Entire directory, except . and .. *) satfiles: TextList.T := NIL; (* Files that have OK suffixes *) VAR oldCount := v.count (); newCount := 0; this := -1; (* entry to select *) cl := NEW (StatCl, v := v); (* Thread closure *) PROCEDURE satisfies (file: Pathname.T): BOOLEAN = VAR ext := Pathname.LastExt (file); suffixes := v.suffixes; BEGIN IF Text.Empty (ext) THEN ext := "$" END; WHILE suffixes # NIL DO IF Text.Equal (ext, suffixes.head) THEN RETURN TRUE END; suffixes := suffixes.tail END; RETURN FALSE END satisfies; BEGIN IF v.statThread # NIL THEN Thread.Alert (v.statThread) END; VBT.SetCursor (v, Cursor.NotReady); TRY allfiles := TextListSort.SortD (Directory (v.dir)); cl.files := allfiles; IF v.suffixes = NIL THEN satfiles := allfiles ELSE WHILE allfiles # NIL DO IF satisfies (allfiles.head) THEN satfiles := TextList.Cons (allfiles.head, satfiles) END; allfiles := allfiles.tail END; satfiles := TextList.ReverseD (satfiles) END; newCount := TextList.Length (satfiles) + 2; IF oldCount < newCount THEN v.insertCells (oldCount, newCount - oldCount) ELSIF newCount < oldCount THEN v.removeCells (newCount, oldCount - newCount) END; v.isDir [0] := TRUE; (* for Current *) v.isDir [1] := TRUE; (* for Parent *) FOR i := 2 TO newCount - 1 DO v.isDir [i] := FALSE END; v.setValue (0, Pathname.Current & DirMarker); v.setValue (1, Pathname.Parent & DirMarker); FOR i := 2 TO newCount - 1 DO IF NOT Text.Empty (v.toSelect) AND Text.Equal (satfiles.head, v.toSelect) THEN this := i; v.toSelect := ""; END; v.setValue (i, satfiles.head); satfiles := satfiles.tail; END; v.selectOnly (this); v.time := FS.Status (v.dir).modificationTime; ShowDirInMenu (v); v.statThread := Thread.Fork (cl) EXCEPT | OSError.E (e) => CallError (v, e) END END DisplayDir; PROCEDUREDirectory (dir: Pathname.T): TextList.T RAISES {OSError.E} = (* Return a list of all the files in the directory. *) VAR files: TextList.T := NIL; iter := FS.Iterate (dir); name : Pathname.T; BEGIN TRY WHILE iter.next (name) DO files := TextList.Cons (name, files) END; RETURN files FINALLY iter.close () END END Directory; TYPE StatCl = Thread.Closure OBJECT v : T; files: TextList.T; OVERRIDES apply := DoStats END; PROCEDUREDoStats (cl: StatCl): REFANY = VAR file : Pathname.T; i := 2; (* We're skipping over Current and Parent *) v := cl.v; count := v.count (); BEGIN TRY WHILE cl.files # NIL DO file := cl.files.head; cl.files := cl.files.tail; TRY IF FS.Status (Pathname.Join (v.dir, file, NIL)).type = FS.DirectoryFileType THEN LOCK v.mu DO IF Thread.TestAlert () THEN RETURN NIL END; LOOP IF i = count THEN v.insertCells (count, 1); v.setValue (count, file & DirMarker); v.isDir [count] := TRUE; INC (count); INC (i); EXIT ELSE WITH t = Text.Compare (v.getValue (i), file) DO IF t = -1 THEN INC (i) ELSIF t = 0 THEN v.setValue (i, file & DirMarker); v.isDir [i] := TRUE; INC (i); EXIT ELSE v.insertCells (i, 1); v.setValue (i, file & DirMarker); v.isDir [i] := TRUE; INC (count); INC (i); EXIT END (* IF *) END (* WITH *) END (* IF *) END (* LOOP *) END (* LOCK *) END (* IF *) EXCEPT | OSError.E (c) => CallError (v, c) END (* TRY *) END (* WHILE *) FINALLY VBT.SetCursor (v, Cursor.DontCare) END; (* TRY *) RETURN NIL END DoStats; PROCEDUREInitDirMenuButton (dmb: DirMenuButton; text: TEXT): DirMenuButton = VAR textvbt := TextVBT.New (text, fnt := dmb.dm.font, bgFg := dmb.dm.shadow, halign := 0.0, hmargin := 2.0); menubutton := ShadowedFeedbackVBT.NewMenu (textvbt, dmb.dm.shadow); BEGIN EVAL MenuSwitchVBT.T.init (dmb, menubutton); RETURN dmb END InitDirMenuButton; PROCEDUREDirMenuButtonPut (dmb: DirMenuButton; text: TEXT) = VAR menubutton: ShadowedFeedbackVBT.T := Filter.Child (dmb); textvbt : TextVBT.T := MultiFilter.Child (menubutton); BEGIN TextVBT.SetFont (textvbt, dmb.dm.font, dmb.dm.shadow); TextVBT.Put (textvbt, text) END DirMenuButtonPut; PROCEDUREDirMenuButtonGet (dmb: DirMenuButton): TEXT = VAR menubutton: ShadowedFeedbackVBT.T := Filter.Child (dmb); textvbt : TextVBT.T := MultiFilter.Child (menubutton); BEGIN RETURN TextVBT.Get (textvbt) END DirMenuButtonGet; PROCEDUREDirMenuButtonCallback ( dmb: DirMenuButton; READONLY cd : VBT.MouseRec ) = <* LL = VBT.mu *> VAR arcs := NEW(Pathname.Arcs).init(); vbox := dmb.dm.vbox; next := dmb; pn: Pathname.T := "MaryHadALittleLamb"; debugPathname: TEXT := ""; BEGIN arcs.addlo(dmb.get()); debugPathname := dmb.get(); TRY LOOP next := Split.Succ(vbox, next); IF next = NIL THEN EXIT END; arcs.addlo(next.get()); IF next.get() = NIL THEN debugPathname := debugPathname & "/**NIL**" ELSE debugPathname := debugPathname & "/" & next.get(); END END; pn := Pathname.Compose(arcs); Set(dmb.dm.filebrowser, pn, cd.time) EXCEPT | Error (e) => dmb.dm.filebrowser.error(e) | Split.NotAChild => <* ASSERT FALSE *> | Pathname.Invalid => (* what is causing this assertion?? -- mhb 10/5/95 *) <* ASSERT FALSE *> END END DirMenuButtonCallback;
PROCEDUREInsideClick ( s : Selector; READONLY cd : VBT.MouseRec; this: ListVBT.Cell ) = <* LL = VBT.mu *> VAR v := s.v; VAR first: ListVBT.Cell; path : Pathname.T; isDir: BOOLEAN; event := AnyEvent.FromMouse (cd); BEGIN ListVBT.MultiSelector.insideClick (s, cd, this); ShowFileInHelper (v, "", cd.time); IF cd.clickType = VBT.ClickType.FirstDown THEN v.selectItems (event) ELSIF cd.clickType = VBT.ClickType.LastUp AND cd.clickCount = 3 THEN LOCK v.mu DO IF NOT v.getFirstSelected (first) THEN (* error? *) RETURN END; isDir := v.isDir [first]; path := Pathname.Join (v.dir, v.getValue (first), NIL) END; IF isDir THEN v.activateDir (path, event) ELSE v.activateFile (path, event) END END END InsideClick; PROCEDURESelectItems (<* UNUSED *> v: T; <* UNUSED *> event: AnyEvent.T) = BEGIN END SelectItems; PROCEDUREActivateFile (<* UNUSED *> v : T; <* UNUSED *> filename: Pathname.T; <* UNUSED *> event : AnyEvent.T) = BEGIN END ActivateFile; PROCEDUREActivateDir (v: T; dirname: Pathname.T; event: AnyEvent.T) = <* LL.sup = VBT.mu *> VAR time := AnyEvent.TimeStamp (event); BEGIN TRY Set (v, dirname, time) EXCEPT Error (x) => v.error (x) END END ActivateDir; PROCEDUREDefaultError (<* UNUSED *> v: T; <* UNUSED *> err: E) = BEGIN END DefaultError; PROCEDUREShowFileInHelper (v: T; file: Pathname.T; time: VBT.TimeStamp) = <* LL = v.mu *> VAR forHelper: Pathname.T; BEGIN IF v.helper = NIL THEN RETURN END; (* Prevent TextPort from calling "v.helper.modified ()" (which is HelperModified) when we do the following SetText. HelperModified unselects everything and sets v.truthInHelper to TRUE. *) TextPort.SetModified (v.helper, TRUE); IF v.dirmenu = NIL OR Text.Empty (file) THEN forHelper := file ELSE forHelper := Pathname.Last (file) END; TextPort.SetText (v.helper, forHelper); v.truthInHelper := NOT Text.Empty(forHelper); IF time # 0 AND NOT Text.Empty (forHelper) THEN TextPort.Select (v.helper, time := time, replaceMode := TRUE) END; (* Re-enable "v.helper.modified()" *) TextPort.SetModified (v.helper, FALSE); END ShowFileInHelper; PROCEDUREShowDirInMenu (v: T) = <* LL = v.mu *> <* FATAL Split.NotAChild *> <* FATAL Pathname.Invalid *> BEGIN IF v.dirmenu = NIL THEN RETURN END; VAR top := v.dirmenu.top; arcs := Pathname.Decompose(v.dir); BEGIN IF arcs = NIL THEN TextVBT.Put(top, "????"); RETURN END; WITH curr = arcs.remhi() DO TextVBT.SetFont(top, fnt := v.dirmenu.font, bgFg := v.dirmenu.shadow); IF curr = NIL THEN TextVBT.Put(top, "????") ELSE TextVBT.Put(top, curr) END END; VAR vbox : HVSplit.T; arc : TEXT; prevChild: VBT.T; thisChild: DirMenuButton; BEGIN vbox := v.dirmenu.vbox; prevChild := NIL; LOOP thisChild := Split.Succ(vbox, prevChild); IF arcs.size() = 0 THEN arc := NIL ELSE arc := arcs.remhi() END; IF thisChild = NIL AND arc = NIL THEN EXIT END; IF thisChild = NIL THEN (* new path longer than prev; add a child *) thisChild := NEW(DirMenuButton, dm := v.dirmenu).init(arc); Split.Insert(vbox, prevChild, thisChild); prevChild := thisChild ELSIF arc = NIL THEN (* new path shorter than prev; delete a child *) Split.Delete(vbox, thisChild) ELSE (* change an arc *) thisChild.put(arc); prevChild := thisChild END END END END END ShowDirInMenu;
PROCEDURE ShowDirInMenu (v: T) =
<* LL = v.mu *>
<* FATAL Split.NotAChild *>
VAR
dm := v.dirmenu;
vbox : HVSplit.T;
prevChild: VBT.T := NIL;
thisChild: DirMenuButton;
arcs : Pathname.Arcs;
<* FATAL Pathname.Invalid *>
BEGIN
IF dm = NIL THEN RETURN END;
vbox := dm.vbox;
arcs := Pathname.Decompose (v.dir);
WITH curr = arcs.remhi () DO
IF curr = NIL THEN
TextVBT.Put (dm.top, ????
)
ELSE
TextVBT.Put (dm.top, curr)
END
END;
LOOP
thisChild := Split.Succ (vbox, prevChild);
IF thisChild = NIL THEN
IF arcs.size () = 0 THEN
EXIT
ELSE
thisChild :=
NEW (DirMenuButton, dm := dm).init (arcs.remhi ());
Split.Insert (vbox, prevChild, thisChild);
prevChild := thisChild
END
ELSIF arcs.size () = 0 THEN (* delete remaining children
Split.Delete (vbox, Split.Succ (vbox, prevChild)) ELSE thisChild.put (arcs.remhi ()); prevChild := thisChild END END END ShowDirInMenu; *) PROCEDUREHelperModified (hp: Helper) = <* LL = v.mu *> (* That's the locking level because this is the "modified" method of the Helper, which is invoked by TextPort.ReplaceInVText, which is called by TextPort.SetText, which is called by ShowFileInHelper and others. *) BEGIN WITH v = hp.parent DO v.selectNone (); v.truthInHelper := TRUE END END HelperModified; PROCEDUREHelperReturn (hp: Helper; READONLY event: VBT.KeyRec) = <* LL = VBT.mu *> VAR v := hp.parent; text := TextPort.GetText (hp); BEGIN TRY LOCK v.mu DO IF NOT Pathname.Valid (text) THEN RaiseError (v, "Invalid pathname", text) END; IF NOT Pathname.Absolute (text) THEN text := Pathname.Join (v.dir, text, NIL) END END; Set (v, text, event.time); text := TextPort.GetText(hp); IF NOT Text.Empty (text) THEN v.activateFile(text, AnyEvent.FromKey(event)) END EXCEPT | Error (x) => v.error (x) END END HelperReturn; PROCEDURERaiseError (v: T; text, path: TEXT := "") RAISES {Error} = BEGIN RAISE Error (NEW (E, v := v, text := text, path := path)) END RaiseError; PROCEDURECallError (v: T; e: OSError.Code) = VAR text := ""; BEGIN WHILE e # NIL DO text := text & Atom.ToText (e.head) & " "; e := e.tail END; v.error (NEW (E, v := v, text := text, path := v.dir)) END CallError; BEGIN EVAL Thread.Fork (NEW (Thread.Closure, apply := Watcher)) END FileBrowserVBT.