<* PRAGMA LL *> <* PRAGMA EXPORTED *> MODULE*************************** Creation **************************; IMPORT AnchorSplit, AnyEvent, ASCII, 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 *) display_time : Time.T; (* last time we looked at this directory *) statThread : Thread.T; isDir : REF ARRAY OF BOOLEAN; topCell : ListVBT.Cell; OVERRIDES init := Init; selectItems := SelectItems; (* no-op *) activateFile := ActivateFile; (* no-op *) activateDir := ActivateDir; error := DefaultError; (* no-op *) insertCells := InsertCells; removeCells := RemoveCells; reportVisible:= ReportVisible; 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); VAR (*CONST*) on_unix := Text.Equal (JoinPath ("a", "b"), "a/b"); CONST WindowsDelay = 300.0d0; (* # seconds between directory updates on Windows *) 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.topCell := 0; 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; PROCEDUREReportVisible (v: T; firstCell: ListVBT.Cell; <*UNUSED*> num: CARDINAL) = (* LL.sup = v *) BEGIN v.topCell := firstCell; END ReportVisible; 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 DirChanged (v) THEN DisplayDir (v) END EXCEPT | OSError.E (code) => CallError (v, code); v.dir := ""; v.removeCells (0, LAST (CARDINAL)); END END END Refresh; PROCEDUREDirChanged (v: T): BOOLEAN RAISES {OSError.E} = BEGIN IF on_unix THEN RETURN FS.Status (v.dir).modificationTime > v.display_time; ELSE (* Windows doesn't maintain time stamps for its directories. No surprise! *) RETURN Time.Now () > v.display_time + WindowsDelay; END; END DirChanged; 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.display_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 := JoinPath (v.dir, path); 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.display_time := 0.0D0; (* trigger the Watcher to redisplay "v". *) ShowFileInHelper (v, file, time); END (* LOCK *) END Set; <* EXPORTED *> PROCEDUREUnselect (v: T) = BEGIN LOCK v.mu DO v.toSelect := ""; 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 := JoinPath (v.dir, file) 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 (JoinPath (v.dir, v.getValue (i)), 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; cl := NEW (StatCl, v := v); (* Thread closure *) BEGIN IF v.statThread # NIL THEN Thread.Alert (v.statThread) END; v.display_time := Time.Now (); (* set it now in case we raise an error later *) VBT.SetCursor (v, Cursor.NotReady); TRY (* find the files that match the current suffix set *) allfiles := TextListSort.SortD (Directory (v.dir)); cl.files := allfiles; IF v.suffixes = NIL THEN satfiles := allfiles ELSE WHILE allfiles # NIL DO IF SuffixMatch (allfiles.head, v.suffixes) THEN satfiles := TextList.Cons (allfiles.head, satfiles) END; allfiles := allfiles.tail END; satfiles := TextList.ReverseD (satfiles) END; (* make sure we have the right number of slots *) newCount := TextList.Length (satfiles) + 2; IF oldCount < newCount THEN v.insertCells (oldCount, newCount - oldCount) ELSIF newCount < oldCount THEN v.removeCells (newCount, oldCount - newCount) END; (* rebuild the list *) v.selectNone (); SetValue (v, 0, Pathname.Current, TRUE); SetValue (v, 1, Pathname.Parent, TRUE); FOR i := 2 TO newCount - 1 DO SetValue (v, i, satfiles.head, FALSE); (* assume isDir=FALSE for now... *) satfiles := satfiles.tail; END; v.scrollTo (v.topCell); ShowDirInMenu (v); v.statThread := Thread.Fork (cl); (* add directories to the list lazily *) 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; PROCEDURESuffixMatch (file: Pathname.T; suffixes: TextList.T): BOOLEAN = VAR ext := Pathname.LastExt (file); BEGIN IF Text.Empty (ext) THEN ext := "$" END; WHILE suffixes # NIL DO IF FileNameEq (ext, suffixes.head) THEN RETURN TRUE END; suffixes := suffixes.tail END; RETURN FALSE END SuffixMatch; PROCEDURESetValue (v: T; index: INTEGER; name: TEXT; isDir: BOOLEAN) = CONST Tail = ARRAY BOOLEAN OF TEXT { "", DirMarker }; BEGIN v.isDir [index] := isDir; v.setValue (index, name & Tail [isDir]); IF NOT Text.Empty (v.toSelect) AND FileNameEq (name, v.toSelect) THEN v.selectOnly (index); END; END SetValue; TYPE StatCl = Thread.Closure OBJECT v : T; files: TextList.T; OVERRIDES apply := DoStats END; PROCEDUREDoStats (cl: StatCl): REFANY = (* Update the displayed file list to include any directories and fix any missing "DirMarker" tags. *) VAR file : Pathname.T; cmp : INTEGER; 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 (JoinPath (v.dir, file)).type = FS.DirectoryFileType THEN LOCK v.mu DO IF Thread.TestAlert () THEN RETURN NIL END; LOOP IF (i = count) THEN (* end-of-list *) cmp := +1; EXIT; END; cmp := Text.Compare (v.getValue (i), file); IF (cmp >= 0) THEN EXIT; END; INC (i); END; IF (cmp # 0) THEN v.insertCells (i, 1); INC (count); END; SetValue (v, i, file, TRUE); INC (i); 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 *> <* FATAL Split.NotAChild, Pathname.Invalid *> VAR arcs := NEW(Pathname.Arcs).init(); vbox := dmb.dm.vbox; next := dmb; pn: Pathname.T := "MaryHadALittleLamb"; BEGIN arcs.addlo(dmb.get()); LOOP next := Split.Succ(vbox, next); IF next = NIL THEN EXIT END; arcs.addlo(next.get()); END; pn := Pathname.Compose(arcs); TRY Set(dmb.dm.filebrowser, pn, cd.time) EXCEPT Error (e) => dmb.dm.filebrowser.error(e) 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 LOCK v.mu DO (* let the Watcher know about the new selection *) IF v.getFirstSelected (first) THEN v.toSelect := v.getValue (first); END; END; 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 := JoinPath (v.dir, v.getValue (first)) 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; TextVBT.SetFont(top, fnt := v.dirmenu.font, bgFg := v.dirmenu.shadow); (* remove trailing arcs that are empty or NIL *) VAR arc: TEXT; BEGIN LOOP IF (arcs.size() = 0) THEN TextVBT.Put(top, "????"); EXIT; END; arc := arcs.remhi(); IF (arc # NIL) AND NOT Text.Empty (arc) THEN TextVBT.Put(top, arc); EXIT; END; END; END; (* update the menu buttons *) 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 := JoinPath (v.dir, text) 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; PROCEDUREJoinPath (dir, file: TEXT): TEXT = BEGIN IF (dir = NIL) THEN RETURN file; END; IF (file = NIL) OR Text.Empty (file) THEN RETURN dir; END; RETURN Pathname.Join (dir, file, NIL); END JoinPath; PROCEDUREFileNameEq (a, b: TEXT): BOOLEAN = BEGIN IF on_unix THEN RETURN Text.Equal (a, b); ELSE RETURN CIEqual (a, b); END; END FileNameEq; PROCEDURECIEqual (a, b: TEXT): BOOLEAN = (* Case-insensitive TEXT comparisons *) VAR len1 := Text.Length (a); len2 := Text.Length (b); c1, c2: CHAR; b1, b2: ARRAY [0..63] OF CHAR; BEGIN IF (len1 # len2) THEN RETURN FALSE; END; len2 := 0; WHILE (len2 < len1) DO Text.SetChars (b1, Text.Sub (a, len2, LAST (CARDINAL))); Text.SetChars (b2, Text.Sub (b, len2, LAST (CARDINAL))); FOR i := 0 TO MIN (len1 - len2, NUMBER (b1))-1 DO c1 := ASCII.Upper [b1[i]]; c2 := ASCII.Upper [b2[i]]; IF (c1 # c2) THEN RETURN FALSE; END END; INC (len2, NUMBER (b1)); END; RETURN TRUE; END CIEqual; 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.