m3tohtml/src/HTMLDir.m3


 Copyright (C) 1992, Digital Equipment Corporation                         
 All rights reserved.                                                      
 See the file COPYRIGHT for a full description.                            
                                                                           
 Last modified on Thu Jun  1 10:21:26 PDT 1995 by kalsow                   

MODULE HTMLDir;

IMPORT Pathname, Fmt, Text, Wr, FileWr, FilePath, OSError, FSUtils;
FROM Msg IMPORT M, D, F;

TYPE
  Node = RECORD
    key    : TEXT    := NIL;
    name   : TEXT    := NIL;
    count  : INTEGER := 0;
    start  : INTEGER := 0;
  END;

TYPE
  State = RECORD
    base_wr : Wr.T;
    file    : TEXT;
    title   : TEXT;
    limit   : INTEGER;
    next_id : INTEGER;
    max_len : INTEGER;
    n_elts  : INTEGER;
    elts    : REF ARRAY OF Node;
  END;

PROCEDURE GenDir (READONLY names: ARRAY OF TEXT;
                  wr: Wr.T;
                  file, title: TEXT;
                  limit: INTEGER) =
  VAR s: State;
  BEGIN
    s.base_wr := wr;
    s.file    := file;
    s.title   := title;
    s.limit   := limit;
    s.next_id := 1;

    D("GenDir ", file);
    (* build the initial sorted list of nodes *)
    s.elts := NEW (REF ARRAY OF Node, NUMBER (names));
    FOR i := 0 TO LAST (names) DO
      WITH x = s.elts[i] DO
        x.name  := names[i];
        x.key   := Pathname.LastBase (names[i]);
        x.count := 0;
        x.start := 0;
        D("  ", x.name, ", ", x.key);
      END;
    END;
    Sort (s.elts^);

    (* Find and remove entries with duplicate keys *)
    s.n_elts := 0;
    VAR i := 0; BEGIN
      WHILE (i < NUMBER (s.elts^)) DO
        VAR j := i+1; BEGIN
          WHILE (j < NUMBER (s.elts^))
            AND Text.Equal (s.elts[i].key, s.elts[j].key) DO
            INC (j);
          END;
          IF (j - i > 1) THEN RemoveDuplicates (s, i, j-i); END;
          IF (i # s.n_elts) THEN s.elts[s.n_elts] := s.elts[i]; END;
          INC (s.n_elts);
          i := j;
        END;
      END;
    END;

    (* find the length of the longest key *)
    s.max_len := 0;
    FOR i := 0 TO s.n_elts-1 DO
      s.max_len := MAX (s.max_len, Text.Length (s.elts[i].key));
    END;

    EVAL Generate (s, 0, 0, s.n_elts, 0);

    s.elts := NIL;
  END GenDir;

PROCEDURE RemoveDuplicates (VAR s: State;  start, len: INTEGER) =
  <*FATAL ANY*>
  VAR
    file  := FName (s, s.next_id);
    wr    :  FileWr.T;
    key   := s.elts[start].key;
  BEGIN
    WITH dir = Pathname.Prefix(file) DO
      IF dir # NIL THEN
        IF NOT FSUtils.IsDir(dir) THEN
          FSUtils.MakeDir(dir);
        END;
      END;
    END;
    TRY
      wr := FileWr.Open (file & ".html");
    EXCEPT ELSE
      F("cannot open ", file & ".html");
    END;
    INC (s.next_id);
    Out (wr, "<HTML>\n<HEAD>\n<TITLE>", key, " locations</TITLE>\n</HEAD>\n");
    Out (wr, "<BODY bgcolor=\"#ffffff\">\n<H2>", key,
         " is located in:<H2>\n<UL>\n");
    FOR i := start TO start + len - 1 DO
      VAR nm := s.elts[i].name; BEGIN
        Out (wr, "<LI><A HREF=\"", FilePath.Normalize (nm, file), ".html\">");
        Out (wr, nm, "</A>\n");
      END;
    END;
    Out (wr, "</UL>\n</BODY>\n</HTML>\n");
    Wr.Close (wr);
    s.elts[start].name := file;
  END RemoveDuplicates;

PROCEDURE Generate (VAR s: State;  id, start, cnt, prefix: INTEGER): TEXT =
  VAR cnt0, cnt1, len: INTEGER;  file := FName (s, id);
  BEGIN
    D("Generate ", file, ",  " & Fmt.Int(id), ", " & Fmt.Int(start),
      ", " & Fmt.Int(cnt), ", " & Fmt.Int(prefix));
    (* count the elements with the specified prefix length *)
    len  := prefix;
    cnt1 := CntPrefixes (s, start, cnt, len);

    (* find a prefix that generates a non-trivial choice *)
    WHILE (len <= s.max_len) AND (cnt1 < 2) DO
      INC (len);
      cnt1 := CntPrefixes (s, start, cnt, len);
    END;

    (* find the largest prefix that's got fewer than limit classes *)
    REPEAT
      INC (len);
      cnt0 := cnt1;
      cnt1 := CntPrefixes (s, start, cnt, len);
    UNTIL (len >= s.max_len) OR (cnt1 > s.limit);

    (* pick the best size *)
    IF (s.limit - cnt0 <= cnt1 - s.limit) THEN
      (* use the shorter prefix *)
      DEC (len);
      cnt1 := CntPrefixes (s, start, cnt, len);
    END;

    (* generate the smaller, non-trivial partitions *)
    FOR i := start TO start+cnt-1 DO
      IF s.elts[i].count > 1 THEN
        VAR
          id    := s.next_id;
          start := s.elts[i].start;
          count := s.elts[i].count;
          name  : TEXT;
        BEGIN
          INC (s.next_id);
          name := Generate (s, id, start, count, len+1);
          ResetElts (s, start, count, i, name);
        END;
      END;
    END;

    (* generate my elements *)
    WriteDir (s, file, start, cnt, len);

    RETURN file;
  END Generate;

PROCEDURE CntPrefixes (VAR s: State;  start, cnt, len: INTEGER): INTEGER =
  VAR
    n_classes := 1;
    class     := start;
    c_len     := Text.Length (s.elts[start].key);
  BEGIN
    s.elts[start].count := 1;
    s.elts[start].start := start;
    FOR i := start + 1 TO start + cnt - 1 DO
      IF PrefixMatch (s.elts[class].key, s.elts[i].key, len) THEN
        INC (s.elts[class].count);
        IF (c_len < len) AND (c_len < Text.Length (s.elts[i].key)) THEN
          (* move the class rep *)
          s.elts[i].count := s.elts[class].count;
          s.elts[i].start := s.elts[class].start;
          s.elts[class].count := 0;
          class := i;
        END;
      ELSE
        INC (n_classes);
        class := i;
        c_len := Text.Length (s.elts[i].key);
        s.elts[i].count := 1;
        s.elts[i].start := i;
      END;
    END;
    RETURN n_classes;
  END CntPrefixes;

PROCEDURE ResetElts (VAR s: State;  start, count, base: INTEGER;  file: TEXT) =
  BEGIN
    FOR i := start TO start + count -1 DO
      s.elts[i].count := 0;
    END;
    s.elts[base].count := count;
    s.elts[base].start := start;
    s.elts[base].name  := file;
  END ResetElts;

PROCEDURE WriteDir (VAR s: State;  file: TEXT;  start, cnt, len: INTEGER) =
  <*FATAL ANY*>
  CONST Dir_width = 78; (* max # characters per line *)
  CONST Max_cols  = 6;  (* max # columns per line *)
  CONST Gap       = 2;  (* inter-column gap *)
  CONST Gap_text  = "  ";
  VAR
    max_len    := 0;
    n_cols     := 1;
    width      : CARDINAL;
    n_rows     : CARDINAL;
    j          : CARDINAL;
    nm         : TEXT;
    nm_len     : INTEGER;
    elts       := NEW (REF ARRAY OF INTEGER, cnt);
    n_elts     := 0;
    wr         : Wr.T;
    base_file  : TEXT;
  BEGIN
    D("WriteDir ", file);
    (* find the longest name and pack the elements *)
    FOR i := start TO start+cnt-1 DO
      VAR n := s.elts[i].count; BEGIN
        IF n > 0 THEN
          elts[n_elts] := i;  INC (n_elts);
          IF n = 1
            THEN max_len := MAX (max_len, Text.Length (s.elts[i].key));
            ELSE max_len := MAX (max_len, len+3);
          END;
        END;
      END;
    END;

    (* compute an approriate layout *)
    max_len := MAX (5, max_len);
    INC (max_len, Gap);
    n_cols := MAX (1, MIN (Dir_width DIV max_len, Max_cols));
    n_rows := (n_elts + n_cols - 1) DIV n_cols;
    width  := Dir_width DIV n_cols - Gap;

    IF (file = NIL) THEN
      base_file := "";
      wr := s.base_wr;
    ELSE
      base_file := file;
      WITH dir = Pathname.Prefix(file) DO
        IF dir # NIL THEN
          IF NOT FSUtils.IsDir(dir) THEN
            FSUtils.MakeDir(dir);
          END;
        END;
      END;
      TRY
        wr := FileWr.Open (file & ".html");
      EXCEPT
        OSError.E => M("cannot open file ", file & ".html"); RETURN;
      END;
      Out (wr, "<HTML>\n<HEAD>\n<TITLE>", s.title,
               "</TITLE>\n</HEAD>\n<BODY bgcolor=\"#ffffff\">\n");
    END;
    Out (wr, "<PRE>\n");
    FOR row := 0 TO n_rows-1 DO
      FOR col := 0 TO n_cols-1 DO
        j := col * n_rows + row;
        IF (j < n_elts) THEN
          WITH x = s.elts[elts[j]] DO
            Out (wr, "<A HREF=\"", FilePath.Normalize (x.name, base_file),
                 ".html\">");
            nm := x.key;
            nm_len := Text.Length (nm);
            IF (x.count > 1) THEN
              VAR xxx := MIN (FindMaxLen (s, elts[j], len), width-4); BEGIN
                IF (nm_len > xxx) THEN
                  nm := Text.Sub (nm, 0, xxx);
                  nm_len := xxx;
                END;
              END;
              Out (wr, nm, "...");
              INC (nm_len, 3);
            ELSE
              Out (wr, nm);
            END;
          END;

          Out (wr, "</A>");
          IF (col # n_cols-1) THEN
            (* pad to the next column *)
            FOR x := 1 TO width - nm_len DO Out (wr, " "); END;
          END;
          Out (wr, Gap_text);
        END;
      END;
      Out (wr, "\n");
    END;
    Out (wr, "</PRE>\n");
    IF (file # NIL) THEN
      Out (wr, "</BODY>\n</HTML>\n");
      Wr.Close (wr);
    END;
  END WriteDir;

PROCEDURE FindMaxLen (VAR s: State;  base, len: INTEGER): INTEGER =
  VAR
    start := s.elts[base].start;
    cnt   := s.elts[base].count;
    key   := s.elts[base].key;
    max   := Text.Length (key);
  BEGIN
    WHILE (len < max) DO
      INC (len);
      FOR i := start TO start + cnt - 1 DO
        IF NOT PrefixMatch (s.elts[i].key, key, len) THEN RETURN len-1 END;
      END;
    END;
    RETURN len;
  END FindMaxLen;

PROCEDURE PrefixMatch (a, b: TEXT;  len: INTEGER): BOOLEAN =
  VAR min := MIN (MIN (Text.Length (a), Text.Length (b)), len);
  BEGIN
    FOR i := 0 TO min-1 DO
      IF Text.GetChar (a, i) # Text.GetChar (b, i) THEN RETURN FALSE END;
    END;
    RETURN (min = len);
  END PrefixMatch;

PROCEDURE Out (wr: Wr.T;  a, b, c, d: TEXT := NIL) =
  <*FATAL ANY*>
  BEGIN
    IF (a # NIL) THEN Wr.PutText (wr, a); END;
    IF (b # NIL) THEN Wr.PutText (wr, b); END;
    IF (c # NIL) THEN Wr.PutText (wr, c); END;
    IF (d # NIL) THEN Wr.PutText (wr, d); END;
  END Out;
--------------------------------------------------------------- sorting ---

TYPE  Elem_T = Node;

PROCEDURE Elem_Compare (a, b: Node): [-1..1] =
  BEGIN
    RETURN Text.Compare (a.key, b.key);
  END Elem_Compare;

PROCEDURE Sort (VAR a: ARRAY OF Elem_T;  cmp := Elem_Compare) =
  BEGIN
    QuickSort (a, 0, NUMBER (a), cmp);
    InsertionSort (a, 0, NUMBER (a), cmp);
  END Sort;

PROCEDURE QuickSort (VAR a: ARRAY OF Elem_T;  lo, hi: INTEGER;
                     cmp := Elem_Compare) =
  CONST CutOff = 9;
  VAR i, j: INTEGER;  key, tmp: Elem_T;
  BEGIN
    WHILE (hi - lo > CutOff) DO (* sort a[lo..hi) *)

      (* use median-of-3 to select a key *)
      i := (hi + lo) DIV 2;
      IF cmp (a[lo], a[i]) < 0 THEN
        IF cmp (a[i], a[hi-1]) < 0 THEN
          key := a[i];
        ELSIF cmp (a[lo], a[hi-1]) < 0 THEN
          key := a[hi-1];  a[hi-1] := a[i];  a[i] := key;
        ELSE
          key := a[lo];  a[lo] := a[hi-1];  a[hi-1] := a[i];  a[i] := key;
        END;
      ELSE (* a[lo] >= a[i] *)
        IF cmp (a[hi-1], a[i]) < 0 THEN
          key := a[i];  tmp := a[hi-1];  a[hi-1] := a[lo];  a[lo] := tmp;
        ELSIF cmp (a[lo], a[hi-1]) < 0 THEN
          key := a[lo];  a[lo] := a[i];  a[i] := key;
        ELSE
          key := a[hi-1];  a[hi-1] := a[lo];  a[lo] := a[i];  a[i] := key;
        END;
      END;

      (* partition the array *)
      i := lo+1;  j := hi-2;

      (* find the first hole *)
      WHILE cmp (a[j], key) > 0 DO DEC (j) END;
      tmp := a[j];
      DEC (j);

      LOOP
        IF (i > j) THEN EXIT END;

        WHILE cmp (a[i], key) < 0 DO INC (i) END;
        IF (i > j) THEN EXIT END;
        a[j+1] := a[i];
        INC (i);

        WHILE cmp (a[j], key) > 0 DO DEC (j) END;
        IF (i > j) THEN  IF (j = i-1) THEN  DEC (j)  END;  EXIT  END;
        a[i-1] := a[j];
        DEC (j);
      END;

      (* fill in the last hole *)
      a[j+1] := tmp;
      i := j+2;

      (* then, recursively sort the smaller subfile *)
      IF (i - lo < hi - i)
        THEN  QuickSort (a, lo, i-1);   lo := i;
        ELSE  QuickSort (a, i, hi);     hi := i-1;
      END;

    END; (* WHILE (hi-lo > CutOff) *)
  END QuickSort;

PROCEDURE InsertionSort (VAR a: ARRAY OF Elem_T;  lo, hi: INTEGER;
                         cmp := Elem_Compare) =
  VAR j: INTEGER;  key: Elem_T;
  BEGIN
    FOR i := lo+1 TO hi-1 DO
      key := a[i];
      j := i-1;
      WHILE (j >= lo) AND cmp (key, a[j]) < 0 DO
        a[j+1] := a[j];
        DEC (j);
      END;
      a[j+1] := key;
    END;
  END InsertionSort;

PROCEDURE FName (VAR s: State;  id: INTEGER): TEXT =
  BEGIN
    IF (id = 0) THEN RETURN NIL; END;
    RETURN Fmt.F ("%s_%s", s.file, Fmt.Int (id));
  END FName;

BEGIN
END HTMLDir.

interface Msg is in: