(* Copyright (C) 1992, Digital Equipment Corporation                         *)
(* All rights reserved.                                                      *)
(* See the file COPYRIGHT for a full description.                            *)
(*                                                                           *)
(* Last modified on Mon Jan  4 14:15:29 PST 1993 by mhb                      *)
(*      modified on Sat Jan  2 21:43:11 PST 1993 by meehan                   *)
(*      modified on Tue Jun 16 13:08:52 PDT 1992 by muller                   *)
(*      modified on Fri Mar 20 22:42:45 1992 by steveg                       *)
(*      modified on Thu Apr 4 18:16:18 PST 1991 by brooks                    *)
(*      modified on Mon Sep 24 12:10:58 PDT 1990 by mcjones                  *)
<* PRAGMA LL *>

MODULE FileBrowserVBT;

IMPORT AnchorSplit, AnyEvent, Axis, BorderedVBT, Char, Cursor, Filename,
       Filter, Font, HVSplit, Key, Lex, ListVBT, MenuSwitchVBT, Multi,
       PaintOp, Pixmap, Pts, Rd, Rect, Shadow, ShadowedVBT,
       ShadowedFeedbackVBT, Split, Text, TextList, TextPort, TextRd, TextVBT,
       TextWr, Thread, Time, UnixUtils, VBT, WeakRef, Wr;

REVEAL
  T = Public BRANDED "FileBrowserVBT 3.0" OBJECT
        mu: MUTEX;
        <* LL = mu *>
        helper  : Helper;
        dirmenu : DirMenu;
        suffixes: TextList.T;
        readOnly: BOOLEAN;
        dir     : TEXT;          (* Current directory, without final '/' *)
        inError : BOOLEAN;       (* helper contains incorrect pathname *)
        truthInHelper: BOOLEAN;   (* where to look for the value *)
        time         : CARDINAL;  (* last time we looked at this directory *)
      OVERRIDES
        init         := Init;
        selectItems  := IgnoreItemSelection;
        activateFile := IgnoreFileActivation;
        activateDir  := DefaultActivateDir;
        error        := IgnoreError;
        redisplay    := Redisplay
      END;
  Selector = ListVBT.MultiSelector BRANDED OBJECT
               v: T
             OVERRIDES
               insideClick := InsideClick
             END;
  Helper = PublicHelper BRANDED OBJECT
             parent: T;
           OVERRIDES
             init     := InitHelper;
             filter   := HelperFilter;
             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
            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);


(****************************  Creation  ***************************)

PROCEDURE 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);
    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.dir := "";
      v.truthInHelper := FALSE;
      LOCK tlock DO
        fblist := NEW (FBList, car := WeakRef.FromRef (v), cdr := fblist);
        Thread.Signal (fbcond)
      END;
      RETURN v
    END
  END Init;

PROCEDURE Watcher (<* 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
          TRY Refresh (v) EXCEPT Error (e) => v.error (e) END;
          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) *)
              TRY Refresh (v) EXCEPT Error (e) => v.error (e) END (* TRY *)
            END                  (* IF *)
          END                    (* WHILE *)
        END                      (* IF *)
      END;                       (* LOCK *)
      Time.LongPause (1)
    END                          (* LOOP *)
  END Watcher;

PROCEDURE InitHelper (helper : Helper;
                      hMargin: REAL     := 1.5;
                      vMargin: REAL     := 1.5;
                      font   : Font.T   := Font.BuiltIn;
                      shadow : Shadow.T := NIL           ): Helper =
  BEGIN
    EVAL TextPort.T.init (helper, TRUE, hMargin, vMargin, font, shadow);
    RETURN helper
  END InitHelper;

PROCEDURE SetHelper (v: T; helper: Helper) RAISES {Error} =
  BEGIN
    LOCK v.mu DO
      v.helper := helper;
      IF helper # NIL THEN
        helper.parent := v;
        EVAL Normalize (v, path := "", time := 0, mayChangeDir := FALSE,
                        force := FALSE)
      END
    END
  END SetHelper;

PROCEDURE InitDirMenu (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 ("", fnt := font, bgFg := shadow);
    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);
      Multi.AddChild (dm, dm.top);
      Multi.AddChild (
        dm, BorderedVBT.New (dm.vbox, Pts.ToMM (1.0), shadow.fg));
      RETURN dm
    END
  END InitDirMenu;

PROCEDURE DMVBoxShape (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 borderSizePts        = Pts.FromMM (borderSizeMM),
             borderSizeRealPixels = Pts.ToPixels (vbox, borderSizePts, ax),
             shadowSizePts        = vbox.dm.shadow.size,
             shadowSizeRealPixels = Pts.ToPixels (vbox, shadowSizePts, 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;

PROCEDURE InitDirMenuButton (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;

PROCEDURE SetDirMenu (v: T; dm: DirMenu) =
  BEGIN
    LOCK v.mu DO
      v.dirmenu := dm;
      IF dm # NIL THEN
        dm.filebrowser := v;
        TRY
          EVAL Normalize (v, path := "", time := 0, mayChangeDir := FALSE,
                          force := TRUE)
        EXCEPT
        | Error =>               (* ignore *)
        END
      END
    END
  END SetDirMenu;

(*************************  Client interface  ***********************)

PROCEDURE SetReadOnly (v: T; readOnly: BOOLEAN) =
  BEGIN
    LOCK v.mu DO v.readOnly := readOnly END
  END SetReadOnly;

PROCEDURE SetSuffixes (v: T; suffixes: TEXT) =
  BEGIN
    WITH list = ParseSuffixes (suffixes) DO
      LOCK v.mu DO
        v.suffixes := list;
        v.time := 0;             (* force true redisplay next chance *)
        VBT.Mark (v)
      END
    END
  END SetSuffixes;

PROCEDURE ParseSuffixes (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, Char.All - Char.AlphaNumerics);
          suffix := Lex.Scan (rd, Char.AlphaNumerics);
          IF Text.Empty (suffix) THEN EXIT END;
          TextList.Push (list, suffix)
        END
      FINALLY
        Rd.Close (rd)
      END
    EXCEPT
    | Rd.Failure =>
    END;
    RETURN list
  END ParseSuffixes;


PROCEDURE Set (v: T; path: TEXT; time: VBT.TimeStamp := 0) RAISES {Error} =
  BEGIN
    LOCK v.mu DO
      EVAL Normalize (v, path, time, mayChangeDir := TRUE, force := TRUE)
    END
  END Set;

PROCEDURE Normalize (v           : T;
                     path        : TEXT;
                     time        : VBT.TimeStamp;
                     mayChangeDir: BOOLEAN         := TRUE;
                     force       : BOOLEAN         := FALSE ):
  BOOLEAN (* whether selected item is a directory *) RAISES {Error} =
  <* LL = v.mu *>
  (* Main internal routine to take a pathname and get it displayed in normal
     form: absolute pathname, tildes expanded, file selected in browser if it
     exists.  Errors are detected here. *)
  VAR
    dir, file                              : TEXT;
    dirExists, fileExists, fileIsDir, empty: BOOLEAN;
  BEGIN
    TRY
      IF Text.Empty (path) THEN
        path := "./"
      ELSE
        path := Filename.ExpandTilde (path)
      END;
      IF Text.GetChar (path, 0) = '/' (* absolute *) THEN (* skip *)
      ELSIF Text.Empty (v.dir) THEN
        path := UnixUtils.GetWD () & "/" & path
      ELSE
        path := v.dir & "/" & path
      END;
      dir := Filename.Head (path);
      IF Text.Empty (dir) THEN
        dir := "/";
        dirExists := TRUE
      ELSE
        dirExists := UnixUtils.ProbeFile (dir, error := TRUE)
      END;
      file := Filename.Tail (path);
      empty := Text.Empty (file);
      fileExists :=
        NOT empty AND UnixUtils.ProbeFile (path, error := v.readOnly);
      fileIsDir := fileExists AND UnixUtils.IsDirectory (path);
      IF fileIsDir THEN dir := path; file := ""; empty := TRUE END;
      DisplayDir (
        v, CompressPath (dir), force := force OR mayChangeDir AND fileIsDir);
      IF NOT empty THEN v.select (Position (v, file), TRUE) END;
      IF v.helper # NIL THEN
        TextPort.SetModified (v.helper, FALSE);
        IF NOT empty AND (fileExists OR NOT v.readOnly) THEN
          ShowFileInHelper (v, file);
          v.truthInHelper := TRUE (* Redundant.  See HelperModified. *)
        ELSE
          ShowFileInHelper (v, "");
          v.truthInHelper := FALSE;
          TextPort.SetModified (v.helper, FALSE)
        END;
        IF time # 0 THEN
          TextPort.Select (
            v.helper, time := time, begin := 0, end := LAST (CARDINAL),
            sel := TextPort.SelectionType.Primary, replaceMode := TRUE)
        END
      END
    EXCEPT
    | UnixUtils.Error (text) => RaiseError (v, text, dir)
    | Filename.Error =>
        RaiseError (v, text := "Couldn't expand tilde", path := path)
    END;
    RETURN fileIsDir
  END Normalize;

PROCEDURE CompressPath (path: Text.T): Text.T =
  PROCEDURE chop (path: Text.T): Text.T =
    VAR k := Text.FindCharR (path, '/');
    BEGIN
      IF k < 1 THEN RETURN path & "/.." END;
      WITH field = Text.Sub (path, k + 1, LAST (CARDINAL)) DO
        IF Text.Equal (field, "..") THEN RETURN path & "/.." END;
      END;
      RETURN Text.Sub (path, 0, k)
    END chop;
  VAR
    prev, pos     : INTEGER;
    newpath, field: Text.T;
  BEGIN
    IF Text.Empty (path) THEN RETURN path END;
    IF Text.GetChar (path, 0) = '/' THEN
      pos := Text.FindChar (path, '/', 1)
    ELSE
      pos := Text.FindChar (path, '/', 0)
    END;
    IF pos = -1 THEN RETURN path END;
    newpath := Text.Sub (path, 0, pos);
    WHILE pos # LAST (CARDINAL) DO
      prev := pos + 1;
      pos := Text.FindChar (path, '/', prev);
      IF pos = -1 THEN pos := LAST (CARDINAL) END;
      field := Text.Sub (path, prev, pos - prev);
      IF Text.Empty (field) OR Text.Equal (field, ".") THEN
        (* ignore *)
      ELSIF Text.Equal (field, "..") THEN
        newpath := chop (newpath);
      ELSE
        newpath := newpath & "/" & field
      END;
    END;
    RETURN newpath;
  END CompressPath;

PROCEDURE Unselect (v: T) =
  BEGIN
    v.selectNone ()
  END Unselect;

PROCEDURE Redisplay (v: T) =
  <* LL.sup = VBT.mu *>
  BEGIN
    EVAL Thread.Fork (NEW (RedisplayClosure, v := v))
  END Redisplay;

TYPE
  RedisplayClosure =
    Thread.Closure OBJECT v: T OVERRIDES apply := DoRedisplay END;

PROCEDURE DoRedisplay (cl: RedisplayClosure): REFANY =
  <* LL = {} *>
  VAR
    v                    := cl.v;
    oldSels : TextList.T := NIL;
    i, count: CARDINAL;
  BEGIN
    LOCK v.mu DO
      IF Text.Empty (v.dir) THEN RETURN NIL END;
      count := v.count ();
      FOR j := count - 1 TO 0 BY -1 DO
        IF v.isSelected (j) THEN TextList.Push (oldSels, v.getValue (j)) END
      END;
      TRY
        DisplayDir (v, v.dir, force := TRUE);
        (* Re-select the previously selected files. *)
        i := 0;
        WHILE oldSels # NIL AND i < count DO
          CASE Text.Compare (oldSels.first, v.getValue (i)) OF
          | -1 => oldSels := oldSels.tail
          | 0 => v.select (i, TRUE); INC (i); oldSels := oldSels.tail
          | +1 => INC (i)
          END                    (* CASE *)
        END                      (* WHILE *)
      EXCEPT
      | Error (x) => v.error (x)
      END                        (* TRY *)
    END;                         (* LOCK *)
    RETURN NIL
  END DoRedisplay;

PROCEDURE Refresh (v: T) RAISES {Error} =
  BEGIN
    LOCK v.mu DO
      IF Text.Empty (v.dir) OR VBT.Domain (v) = Rect.Empty THEN RETURN END;
      TRY
        EVAL UnixUtils.ProbeFile (v.dir, error := TRUE)
      EXCEPT
      | UnixUtils.Error (text) =>
          v.removeCells (0, LAST (CARDINAL));
          RaiseError (v, text, v.dir)
      END;
      IF UnixUtils.FileModifyTime (v.dir) > v.time THEN VBT.Mark (v) END
    END
  END Refresh;

PROCEDURE GetDir (v: T): TEXT =
  BEGIN
    LOCK v.mu DO RETURN v.dir END
  END GetDir;

PROCEDURE GetFile (v        : T;
                   shortName: BOOLEAN := FALSE;
                   normalize: BOOLEAN := TRUE   ): Text.T RAISES {Error} =
  BEGIN
    WITH files = GetFiles (v, shortName, normalize) DO
      IF files = NIL THEN RETURN "" ELSE RETURN files.first END
    END
  END GetFile;

PROCEDURE GetFiles (v        : T;
                    shortName: BOOLEAN := FALSE;
                    normalize: BOOLEAN := TRUE   ): TextList.T
  RAISES {Error} =
  PROCEDURE full (file: TEXT): TEXT =
    BEGIN
      RETURN v.dir & "/" & file
    END full;
  VAR
    file: TEXT;
    res : TextList.T := NIL;
  BEGIN
    LOCK v.mu DO
      IF v.truthInHelper THEN
        file := TextPort.GetText (v.helper);
        IF NOT normalize THEN    (* can't shorten, don't know enough *)
          RETURN TextList.List1 (file)
        ELSE
          EVAL Normalize (v, path := file, time := 0, mayChangeDir := FALSE,
                          force := FALSE);
          IF v.truthInHelper (* This may have changed. *) THEN
            file := TextPort.GetText (v.helper);
            IF v.dirmenu # NIL THEN file := full (file) END;
            IF shortName THEN file := Filename.Tail (file) END;
            RETURN TextList.List1 (file)
          END
        END
      END;
      (* truth in browser, perhaps after normalizing above *)
      IF Text.Empty (v.dir) THEN
        RETURN NIL
      ELSE
        FOR i := v.count () - 1 TO 0 BY -1 DO
          IF NOT v.isSelected (i) THEN (* skip *)
          ELSIF shortName THEN
            TextList.Push (res, v.getValue (i))
          ELSE
            TextList.Push (res, full (v.getValue (i)))
          END
        END
      END
    END;
    RETURN res
  END GetFiles;

PROCEDURE IsDir (filename: TEXT): BOOLEAN =
  BEGIN
    WITH length = Text.Length (filename) DO
      RETURN length > 0 AND Text.GetChar (filename, length - 1) = '/'
    END
  END IsDir;

(**********************  Displaying a directory  ***********************)

PROCEDURE DisplayDir (v: T; dirname: TEXT; force := FALSE) RAISES {Error} =
  (* DisplayDir: display a directory.  Set may call DisplayDir with a
     directory which might or might not really be accessible.  If it isn't
     accessible, Error will be raised. *)
  <* LL = v.mu *>
  VAR
    satFiles                    := TextList.List2 ("./", "../");
    allfiles       : TextList.T := NIL;
    oldCount                    := v.count ();
    newCount, delta             := 0;
    prefix                      := dirname & "/";
    file, fullname : TEXT;
  PROCEDURE satisfies (file: TEXT): BOOLEAN =
    VAR ext := Filename.Extension (file);
    BEGIN
      IF Text.Equal (ext, "") THEN ext := "$" END;
      RETURN TextList.Find (v.suffixes, ext, Text.Equal) # NIL
    END satisfies;
  BEGIN
    IF NOT force AND Text.Equal (dirname, v.dir) THEN RETURN END;
    VBT.SetCursor (v, Cursor.NotReady);
    TRY
      TRY
        allfiles := UnixUtils.Directory (dirname);
        WHILE allfiles # NIL DO
          file := TextList.Pop (allfiles);
          IF Text.Equal (file, ".") OR Text.Equal (file, "..") THEN (* omit *)
          ELSE
            fullname := prefix & file;
            IF UnixUtils.IsDirectory (fullname) THEN
              TextList.Push (satFiles, file & "/")
            ELSIF v.suffixes = NIL OR satisfies (file) THEN
              TextList.Push (satFiles, file)
            END
          END
        END;
        satFiles := TextList.SortD (satFiles, Text.Compare);
        newCount := TextList.Length (satFiles);
        delta := oldCount - newCount;
        IF delta < 0 THEN
          v.insertCells (oldCount, -delta)
        ELSIF delta > 0 THEN
          v.removeCells (newCount, delta)
        END;
        FOR i := 0 TO newCount - 1 DO
          v.setValue (i, TextList.Pop (satFiles))
        END;
        v.dir := dirname;
        v.time := UnixUtils.FileModifyTime (dirname);
        ShowDirInMenu (v)
      EXCEPT
      | UnixUtils.Error (text) => RaiseError (v, text, dirname)
      | Thread.Alerted =>
      END
    FINALLY
      VBT.SetCursor (v, Cursor.DontCare)
    END
  END DisplayDir;

(*
PROCEDURE DisplayDir (v: T; dirname: TEXT; force := FALSE) RAISES {Error} =
  (* DisplayDir: display a directory.  Set may call DisplayDir with a
     directory which might or might not really be accessible.  If it isn't
     accessible, Error will be raised. *)
  <* LL = v.mu *>
  VAR
    satFiles                          := TextList.List2 ("./", "../");
    allfiles, files, dirs: TextList.T := NIL;
    oldCount                          := v.count ();
    newCount, delta                   := 0;
    prefix                            := dirname & "/";
    subdircount          : CARDINAL;
    file, fullname       : TEXT;
  PROCEDURE satisfies (file: TEXT; suffixes: TextList.T): BOOLEAN =
    VAR ext := Filename.Extension (file);
    BEGIN
      IF Text.Equal (ext, "") THEN ext := "$" END;
      WHILE suffixes # NIL DO
        IF Text.Equal (ext, TextList.Pop (suffixes)) THEN RETURN TRUE END
      END;
      RETURN FALSE
    END satisfies;
  BEGIN
    IF NOT force AND Text.Equal (dirname, v.dir) THEN RETURN END;
    VBT.SetCursor (v, Cursor.NotReady);
    TRY
      TRY
        allfiles := UnixUtils.Directory (dirname)
      EXCEPT
      | UnixUtils.Error (text) => RaiseError (v, text, dirname)
      END;
      (* Try to avoid having to call IsDirectory (stat) on every file.
         Partition the files into likely files and likely (sub)directories. *)
      subdircount := UnixUtils.SubdirectoryCount (dirname);
      WHILE allfiles # NIL DO
        file := TextList.Pop (allfiles);
        IF Text.Equal (file, ".") OR Text.Equal (file, "..") THEN (* omit *)
        ELSIF Text.Equal (file, "core") OR Text.FindChar (file, '.') >= 0 THEN
          TextList.Push (files, file)
        ELSE
          TextList.Push (dirs, file)
        END
      END;
      (* Now test the likely directories. *)
      WHILE dirs # NIL AND subdircount > 0 DO
        file := TextList.Pop (dirs);
        fullname := prefix & file;
        IF UnixUtils.IsDirectory (fullname) THEN
          TextList.Push (satFiles, file & "/");
          DEC (subdircount)
        ELSIF v.suffixes = NIL OR satisfies (file, v.suffixes) THEN
          TextList.Push (satFiles, file)
        END
      END;
      (* If needed, test the files. *)
      WHILE files # NIL AND subdircount > 0 DO
        file := TextList.Pop (files);
        fullname := prefix & file;
        IF UnixUtils.IsDirectory (fullname) THEN
          TextList.Push (satFiles, file & "/");
          DEC (subdircount)
        ELSIF v.suffixes = NIL OR satisfies (file, v.suffixes) THEN
          TextList.Push (satFiles, file)
        END
      END;
      (* Deal with the leftovers. *)
      IF v.suffixes = NIL THEN   (* No restrictions. *)
        satFiles :=
          TextList.AppendD (satFiles, TextList.AppendD (dirs, files))
      ELSE
        WHILE dirs # NIL DO
          file := TextList.Pop (dirs);
          IF satisfies (file, v.suffixes) THEN
            TextList.Push (satFiles, file)
          END
        END;
        WHILE files # NIL DO
          file := TextList.Pop (files);
          IF satisfies (file, v.suffixes) THEN
            TextList.Push (satFiles, file)
          END
        END
      END;
      (*
        WHILE allfiles # NIL DO
         VAR
           file     := TextList.Pop (allfiles);
           fullname := prefix & file;
         BEGIN
           IF UnixUtils.IsDirectory (fullname) THEN
             TextList.Push (satFiles, file & "/")
           ELSIF v.suffixes = NIL OR satisfies (file, v.suffixes) THEN
             TextList.Push (satFiles, file)
           END
         END
       END;
       *)
      TRY
        satFiles := TextList.SortD (satFiles, Text.Compare)
      EXCEPT
      | Thread.Alerted => RETURN
      END;
      newCount := TextList.Length (satFiles);
      delta := oldCount - newCount;
      IF delta < 0 THEN
        v.insertCells (oldCount, -delta)
      ELSIF delta > 0 THEN
        v.removeCells (newCount, delta)
      END;
      FOR i := 0 TO newCount - 1 DO
        v.setValue (i, TextList.Pop (satFiles))
      END;
      v.dir := dirname;
      v.time := UnixUtils.FileModifyTime (dirname);
      ShowDirInMenu (v)
    FINALLY
      VBT.SetCursor (v, Cursor.DontCare)
    END
  END DisplayDir;
*)

PROCEDURE DirMenuButtonPut (dmb: DirMenuButton; text: TEXT) =
  VAR
    menubutton: ShadowedFeedbackVBT.T := Filter.Child (dmb);
    textvbt   : TextVBT.T             := Filter.Child (menubutton);
  BEGIN
    TextVBT.Put (textvbt, text)
  END DirMenuButtonPut;

PROCEDURE DirMenuButtonGet (dmb: DirMenuButton): TEXT =
  VAR
    menubutton: ShadowedFeedbackVBT.T := Filter.Child (dmb);
    textvbt   : TextVBT.T             := Filter.Child (menubutton);
  BEGIN
    RETURN TextVBT.Get (textvbt)
  END DirMenuButtonGet;

PROCEDURE DirMenuButtonCallback (dmb: DirMenuButton; READONLY cd: VBT.MouseRec) =
  <* LL = VBT.mu *>
  VAR
    path := dmb.get () & "/";
    vbox := dmb.dm.vbox;
    next := dmb;
  BEGIN
    TRY
      LOOP
        next := Split.Succ (vbox, next);
        IF next = NIL THEN EXIT END;
        path := next.get () & "/" & path
      END;
      Set (dmb.dm.filebrowser, "/" & path, cd.time)
    EXCEPT
    | Split.NotAChild =>
        dmb.dm.filebrowser.error (
          NEW (E, v := dmb.dm.filebrowser, path := path,
               text := "Split.NotAChild (internal error)"))
    | Error (e) => dmb.dm.filebrowser.error (e)
    END
  END DirMenuButtonCallback;

PROCEDURE Position (v: T; name: TEXT): [-1 .. LAST (CARDINAL)] =
  BEGIN
    FOR i := 0 TO v.count () - 1 DO
      IF Text.Equal (name, v.getValue (i)) THEN RETURN i END
    END;
    RETURN -1
  END Position;

(***************************  User interface  **************************)

PROCEDURE InsideClick (s: Selector; cd: VBT.MouseRec; this: ListVBT.Cell) =
  <* LL = VBT.mu *>
  BEGIN
    ListVBT.MultiSelector.insideClick (s, cd, this);
    IF cd.clickType = VBT.ClickType.FirstDown THEN
      BrowserSelect (s.v, cd)
    ELSIF cd.clickType = VBT.ClickType.LastUp AND cd.clickCount = 3 THEN
      BrowserActivate (s.v, cd)
    END
  END InsideClick;

PROCEDURE BrowserSelect (v: T; READONLY event: VBT.MouseRec) =
  <* LL = VBT.mu *>
  BEGIN
    v.truthInHelper := FALSE;
    IF v.helper # NIL THEN
      TextPort.SetModified (v.helper, TRUE);
      (* That prevents TextPort from calling the "modified" method, which is
         HelperModified, which unselects everything and sets v.truthInHelper
         to TRUE. *)
      TextPort.SetText (v.helper, "");
      TextPort.SetModified (v.helper, FALSE)
    END;
    v.selectItems (AnyEvent.FromMouse (event))
  END BrowserSelect;

PROCEDURE BrowserActivate (v: T; READONLY cd: VBT.MouseRec) =
  (* the upclick *)
  <* LL = VBT.mu *>
  VAR
    first: ListVBT.Cell;
    item : TEXT;
    event               := AnyEvent.FromMouse (cd);
  BEGIN
    (* bug?  -- if clicking on an directory item that the background thread
       hasn't modified with a trailing slash, IsDir thinks of the item as a
       file, not a directory *)
    IF NOT v.getFirstSelected (first) THEN (* inconsistent! *) RETURN END;
    item := v.getValue (first);
    IF IsDir (item) THEN
      v.activateDir (item, event)
    ELSE
      IF v.helper # NIL THEN
        TextPort.SetModified (v.helper, FALSE);
        ShowFileInHelper (v, item);
        v.truthInHelper := TRUE; (* Redundant. *)
        TextPort.Select (
          v.helper, time := cd.time, begin := 0, end := LAST (CARDINAL),
          sel := TextPort.SelectionType.Primary, replaceMode := TRUE)
      END;
      v.activateFile (item, event)
    END
  END BrowserActivate;

PROCEDURE IgnoreItemSelection (<* UNUSED *> v    : T;
                               <* UNUSED *> event: AnyEvent.T) =
  BEGIN
  END IgnoreItemSelection;

PROCEDURE IgnoreFileActivation (<* UNUSED *> v       : T;
                                <* UNUSED *> filename: TEXT;
                                <* UNUSED *> event   : AnyEvent.T) =
  BEGIN
  END IgnoreFileActivation;

PROCEDURE DefaultActivateDir (v: T; dirname: TEXT; event: AnyEvent.T) =
  BEGIN
    WITH time = AnyEvent.TimeStamp (event) DO
      TRY Set (v, dirname, time) EXCEPT Error (x) => v.error (x) END
    END
  END DefaultActivateDir;

PROCEDURE IgnoreError (<* UNUSED *> v: T; <* UNUSED *> err: E) =
  BEGIN
  END IgnoreError;


PROCEDURE ShowFileInHelper (v: T; file: TEXT) =
  <* LL = v.mu *>
  BEGIN
    IF v.helper = NIL THEN       (* skip *)
    ELSIF v.dirmenu = NIL THEN   (* Show the whole name. *)
      TextPort.SetText (v.helper, v.dir & "/" & file)
    ELSE                         (* Show just the file name. *)
      TextPort.SetText (v.helper, file)
    END
  END ShowFileInHelper;

PROCEDURE ShowDirInMenu (v: T) =
  <* LL = v.mu > VBT.mu *>
  <* FATAL Split.NotAChild *>
  VAR
    dm                       := v.dirmenu;
    top      : TextVBT.T;
    vbox     : HVSplit.T;
    prevChild: VBT.T         := NIL;
    thisChild: DirMenuButton;
    dlist    : TextList.T;
  BEGIN
    IF dm = NIL THEN RETURN END;
    top := dm.top;
    vbox := dm.vbox;
    dlist := Decompose (dm.filebrowser.dir);
    TextVBT.Put (top, TextList.Pop (dlist));
    LOOP
      thisChild := Split.Succ (vbox, prevChild);
      IF thisChild = NIL THEN
        IF dlist = NIL THEN
          EXIT
        ELSE
          thisChild :=
            NEW (DirMenuButton, dm := dm).init (TextList.Pop (dlist));
          Split.Insert (vbox, prevChild, thisChild);
          prevChild := thisChild
        END
      ELSIF dlist = NIL THEN     (* delete remaining children *)
        Split.Delete (vbox, Split.Succ (vbox, prevChild))
      ELSE
        thisChild.put (TextList.Pop (dlist));
        prevChild := thisChild
      END
    END
  END ShowDirInMenu;

PROCEDURE Decompose (dir: TEXT): TextList.T =
  <* FATAL Rd.Failure, Thread.Alerted, Wr.Failure *>(* Can't happen *)
  VAR
    res: TextList.T := NIL;
    rd              := TextRd.New (dir);
    wr              := TextWr.New ();
    s  : TEXT;
    c  : CHAR;
  PROCEDURE addComponent () =
    BEGIN
      s := TextWr.ToText (wr);
      IF NOT Text.Empty (s) THEN TextList.Push (res, s) END
    END addComponent;
  BEGIN
    TRY
      LOOP
        c := Rd.GetChar (rd);
        IF c = '/' THEN addComponent () ELSE Wr.PutChar (wr, c) END
      END
    EXCEPT
      Rd.EndOfFile =>
    END;
    addComponent ();
    Rd.Close (rd);
    Wr.Close (wr);
    IF res = NIL THEN RETURN TextList.New (".", NIL) ELSE RETURN res END
  END Decompose;

PROCEDURE HelperModified (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 Unselect (v); v.truthInHelper := TRUE END
  END HelperModified;

PROCEDURE HelperFilter (hp: Helper; VAR (* inOut*) event: VBT.KeyRec) =
  BEGIN
    IF event.wentDown AND event.whatChanged = Key.Return THEN
      event.whatChanged := VBT.NoKey;
      HelperReturn (hp, event)
    END
  END HelperFilter;

PROCEDURE HelperReturn (hp: Helper; READONLY event: VBT.KeyRec) =
  <* LL = VBT.mu *>
  VAR
    isDir: BOOLEAN;
    tail : TEXT;
    code           := AnyEvent.FromKey (event);
    v              := hp.parent;
  BEGIN
    TRY
      LOCK v.mu DO
        isDir := Normalize (v, TextPort.GetText (hp), time := event.time,
                            mayChangeDir := TRUE, force := FALSE);
      END;
      IF isDir THEN
        v.activateDir ("./", code)
      ELSE
        tail := Filename.Tail (TextPort.GetText (hp));
        IF NOT Text.Empty (tail) THEN v.activateFile (tail, code) END
      END
    EXCEPT
    | Error (x) => v.error (x)
    END
  END HelperReturn;

PROCEDURE RaiseError (v: T; text, path: TEXT := "") RAISES {Error} =
  BEGIN
    RAISE Error (NEW (E, v := v, text := text, path := path))
  END RaiseError;

BEGIN
  EVAL Thread.Fork (NEW (Thread.Closure, apply := Watcher))
END FileBrowserVBT.