Last modified on Fri Apr 12 09:36:41 PDT 1996 by heydon
<* PRAGMA LL *>
MODULE JunoConfig;
IMPORT JunoRsrc;
IMPORT MultiSplit, MultiClass, TextEditVBT, FileBrowserVBT;
IMPORT VBT, Split, Font, TextVBT, TextPort, ListVBT, Region, Rect, Point;
IMPORT OSError, Pathname, Process, Fmt, Rd, FileRd, Env, Thread, Lex;
IMPORT Sx, RefSeq, RefList, Atom, TextRd, TextSeq, Text, Wr, Rsrc;
FROM Stdio IMPORT stderr;
TYPE
FontWeight = { Any, Medium, Bold };
CONST
DefaultConfigName = "DefaultConfig.sx";
(* Name of default configuration file looked up on "JunoRsrc.Path" *)
PROCEDURE SetDefaults() =
<* FATAL Wr.Failure, Thread.Alerted *>
VAR rd: Rd.T; BEGIN
TRY
rd := Rsrc.Open(DefaultConfigName, JunoRsrc.Path);
ParseConfigFile(rd)
EXCEPT
Rsrc.NotFound =>
Wr.PutText(stderr, "Error: unable to open default "
& "configuration file \"" & DefaultConfigName & "\"\n");
Process.Exit(1);
| Error (msg) =>
Wr.PutText(stderr, "Error reading default configuration file:\n");
Wr.PutText(stderr, " " & msg & "\n");
Process.Exit(1);
END
END SetDefaults;
PROCEDURE TryOpening(nm: Pathname.T; VAR (*INOUT*) rd: Rd.T): BOOLEAN =
Try opening the file named nm as a regular file. If it exists and is a
regular file, then set rd to be a reader on the file and return TRUE.
Otherwise, leave rd unchanged and return FALSE.
BEGIN
TRY rd := FileRd.Open(nm) EXCEPT
OSError.E => RETURN FALSE
END;
RETURN TRUE
END TryOpening;
PROCEDURE Init(filename: Pathname.T := NIL): Pathname.T
RAISES {OSError.E, Error} =
CONST DefaultName = ".juno-config.sx";
VAR rd: Rd.T := NIL; res: Pathname.T := NIL; BEGIN
SetDefaults();
IF filename = NIL THEN
IF TryOpening(DefaultName, (*OUT*) rd) THEN
res := DefaultName
ELSE
(* try looking in the home directory *)
VAR homeDir := Env.Get("HOME"); BEGIN
IF homeDir # NIL THEN
VAR fname := homeDir & "/" & DefaultName; BEGIN
IF TryOpening(fname, (*OUT*) rd) THEN res := fname END
END
END
END
END
ELSE
rd := FileRd.Open(filename);
res := filename;
END;
IF rd # NIL THEN ParseConfigFile(rd) END;
RETURN res
END Init;
PROCEDURE ParseConfigFile(rd: Rd.T) RAISES {Error} =
BEGIN
TRY ParseSx(ReadLists(rd)) EXCEPT
Sx.ReadError (msg) => RAISE Error(msg)
| Rd.EndOfFile => RAISE Error("encountered premature end-of-file")
| Rd.Failure => RAISE Error("failure reading file")
END
END ParseConfigFile;
PROCEDURE ReadLists(rd: Rd.T): RefSeq.T
RAISES {Sx.ReadError, Rd.EndOfFile, Rd.Failure} =
The file rd should contain a sequence of symbolic expressions. This
returns a sequence of Sx.T values in read from rd.
<* FATAL Thread.Alerted *>
VAR res := NEW(RefSeq.T).init(); BEGIN
LOOP
Lex.Skip(rd);
IF Rd.EOF(rd) THEN EXIT END;
res.addhi(Sx.Read(rd))
END;
RETURN res
END ReadLists;
PROCEDURE ParseSx(refs: RefSeq.T) RAISES {Error} =
BEGIN
WHILE refs.size() > 0 DO
TYPECASE refs.remlo() OF RefList.T (l) => ParseList(l)
ELSE RAISE Error("top-level element is not a list")
END
END
END ParseSx;
VAR (*CONST*)
CodeFontSym := Atom.FromText("CodeFont");
TextFontSym := Atom.FromText("TextFont");
LabelFontSym := Atom.FromText("LabelFont");
DotSizeSym := Atom.FromText("DotSize");
CrossSizeSym := Atom.FromText("CrossSize");
ChkptIntvSym := Atom.FromText("ChkptIntv");
RealPrecSym := Atom.FromText("RealPrec");
PreviewCmdSym := Atom.FromText("PreviewCmd");
PrintCmdSym := Atom.FromText("PrintCmd");
OriginSym := Atom.FromText("Origin");
OrientSym := Atom.FromText("Orientation");
PROCEDURE ParseList(l: RefList.T) RAISES {Error} =
BEGIN
IF l = NIL THEN RAISE Error("top-level list is empty") END;
TYPECASE l.head OF Atom.T (cmd) =>
IF cmd = CodeFontSym THEN codeFont := ParseFont(l.tail, cmd)
ELSIF cmd = TextFontSym THEN textFont := ParseFont(l.tail, cmd)
ELSIF cmd = LabelFontSym THEN labelFont := ParseFont(l.tail, cmd)
ELSIF cmd = DotSizeSym THEN SetDot(ParseReal(l.tail, cmd))
ELSIF cmd = CrossSizeSym THEN SetCross(ParseCard(l.tail, cmd))
ELSIF cmd = ChkptIntvSym THEN chkptIntv := ParseCard(l.tail, cmd)
ELSIF cmd = RealPrecSym THEN realPrec := ParseCard(l.tail, cmd) - 1
ELSIF cmd = PreviewCmdSym THEN previewCmd := ParseText(l.tail, cmd)
ELSIF cmd = PrintCmdSym THEN printCmd := ParseText(l.tail, cmd)
ELSIF cmd = OriginSym THEN origin := ParseOrig(l.tail, cmd)
ELSIF cmd = OrientSym THEN orientation := ParseOrient(l.tail, cmd)
END
ELSE
RAISE Error("first element of list is not an identifier")
END
END ParseList;
PROCEDURE Circle(r: REAL): Region.T =
VAR res := Region.Empty; lo := FLOOR(-r); hi := CEILING(r); BEGIN
FOR h := lo TO hi DO
FOR v := lo TO hi DO
IF h * h + v * v <= FLOOR(r * r) THEN
WITH rect = Rect.FromPoint(Point.T{h, v}) DO
res := Region.JoinRect(rect, res)
END
END
END
END;
RETURN res
END Circle;
PROCEDURE SetDot(sz: REAL) =
BEGIN dot := Circle(sz) END SetDot;
PROCEDURE Cross(rad: CARDINAL): Region.T =
VAR
width := MAX(1, ROUND(FLOAT(rad) / 4.0));
lower := - FLOOR(FLOAT(width) / 2.0);
upper := CEILING(FLOAT(width) / 2.0);
extra := width MOD 2; (* make cross symmetric for odd widths *)
BEGIN
RETURN Region.Join(
Region.FromRect(
Rect.T{west := -rad, east := rad + extra,
north := lower, south := upper}),
Region.FromRect(
Rect.T{west := lower, east := upper,
north := -rad, south := rad + extra}))
END Cross;
PROCEDURE SetCross(sz: CARDINAL) =
BEGIN
cross := Cross(sz);
crossBdry := Region.Inset(cross, -1)
END SetCross;
PROCEDURE CheckLen(l: RefList.T; nm: Atom.T; cnt: CARDINAL) RAISES {Error} =
Check that the list l has length cnt; if not, raise Error with an
error message that refers to nm
BEGIN
IF RefList.Length(l) # cnt THEN
RAISE Error("\"" & Atom.ToText(nm) &
"\" decl has wrong number of args")
END
END CheckLen;
PROCEDURE ParseText(l: RefList.T; nm: Atom.T): TEXT RAISES {Error} =
BEGIN
CheckLen(l, nm, 1);
TYPECASE l.head OF
TEXT (t) => RETURN t
| Atom.T (a) => RETURN Atom.ToText(a)
ELSE
RAISE Error("expected arg to \"" & Atom.ToText(nm)
& "\" to be a text or identifier")
END
END ParseText;
PROCEDURE ParseCard(l: RefList.T; nm: Atom.T): CARDINAL RAISES {Error} =
BEGIN
CheckLen(l, nm, 1);
TYPECASE l.head OF REF INTEGER (ri) =>
IF ri^ >= 0 THEN RETURN ri^ END
ELSE (* SKIP *)
END;
RAISE Error("expected arg to \"" & Atom.ToText(nm)
& "\" to be a cardinal")
END ParseCard;
PROCEDURE ParseReal(l: RefList.T; nm: Atom.T): REAL RAISES {Error} =
BEGIN
CheckLen(l, nm, 1);
TYPECASE l.head OF REF REAL (rr) => RETURN rr^
ELSE
RAISE Error("expected arg to \"" & Atom.ToText(nm)
& "\" to be a real")
END
END ParseReal;
PROCEDURE ParseAtom(l: RefList.T; nm: Atom.T): Atom.T RAISES {Error} =
BEGIN
CheckLen(l, nm, 1);
TYPECASE l.head OF
Atom.T (a) => RETURN a
ELSE
RAISE Error("expected arg to \"" & Atom.ToText(nm)
& "\" to be an identifier")
END
END ParseAtom;
VAR (*CONST*)
CenterSym := Atom.FromText("center");
SouthWestSym := Atom.FromText("southwest");
PROCEDURE ParseOrig(l: RefList.T; nm: Atom.T): Origin RAISES {Error} =
VAR val := ParseAtom(l, nm); BEGIN
IF val = CenterSym THEN RETURN Origin.Center
ELSIF val = SouthWestSym THEN RETURN Origin.SW
ELSE
RAISE Error("\"" & Atom.ToText(val) & "\" is not a legal value for \""
& Atom.ToText(nm) & "\"")
END
END ParseOrig;
VAR (*CONST*)
PortraitSym := Atom.FromText("portrait");
LandscapeSym := Atom.FromText("landscape");
PROCEDURE ParseOrient(l: RefList.T; nm: Atom.T): Orientation RAISES {Error} =
VAR val := ParseAtom(l, nm); BEGIN
IF val = PortraitSym THEN RETURN Orientation.Portrait
ELSIF val = LandscapeSym THEN RETURN Orientation.Landscape
ELSE
RAISE Error("\"" & Atom.ToText(val) & "\" is not a legal value for \""
& Atom.ToText(nm) & "\"")
END
END ParseOrient;
VAR (*CONST*)
MediumSym := Atom.FromText("medium");
BoldSym := Atom.FromText("bold");
PROCEDURE ParseFont(l: RefList.T; nm: Atom.T): Font.T RAISES {Error} =
VAR fonts := NEW(REF ARRAY OF TEXT, RefList.Length(l)); i := 0; BEGIN
WHILE l # NIL DO
TYPECASE l.head OF
TEXT (xfont) => fonts[i] := xfont
| RefList.T (f) => fonts[i] := ParseLFontSpec(f, nm);
ELSE RAISE Error("invalid font specification for " & Atom.ToText(nm))
END;
l := l.tail;
INC(i)
END;
RETURN Font.FromName(fonts^)
END ParseFont;
PROCEDURE XFontName(family: TEXT; weight: FontWeight; sz: CARDINAL): TEXT =
CONST Pre = "-*-"; Mid = "-r-*--*-"; Post = "0-*-*-*-*-*-*";
CONST Wt = ARRAY FontWeight OF TEXT{"*", "medium", "bold"};
BEGIN
RETURN Pre & family & "-" & Wt[weight] & Mid & Fmt.Int(sz) & Post
END XFontName;
PROCEDURE ParseLFontSpec(l: RefList.T; nm: Atom.T): TEXT RAISES {Error} =
Lookup the font specified by l, which should be a list of the form
( FontName FontWeight FontSize ). Return the X font name corresponding to
the font.
VAR fontNm: TEXT; fontWt: FontWeight; sz: CARDINAL; BEGIN
CheckLen(l, nm, 3);
TYPECASE l.head OF
Atom.T (a) => fontNm := Atom.ToText(a)
| TEXT (t) => fontNm := t
ELSE
RAISE Error("font name for \"" & Atom.ToText(nm)
& "\" not a text or identifier");
END;
l := l.tail;
TYPECASE l.head OF Atom.T (a) =>
IF a = MediumSym THEN fontWt := FontWeight.Medium
ELSIF a = BoldSym THEN fontWt := FontWeight.Bold
ELSE RAISE Error("font weight \"" & Atom.ToText(a) & "\" for \""
& Atom.ToText(nm) & "\" is not a legal value")
END
ELSE
RAISE Error("font weight for \"" & Atom.ToText(nm)
& "\" not an identifier");
END;
sz := ParseCard(l.tail, nm);
RETURN XFontName(fontNm, fontWt, sz)
END ParseLFontSpec;
PROCEDURE FindString(t, s: TEXT): INTEGER =
Return the index of the first occurrence in t of s, or -1 if s does
not occur within t.
VAR startChar := Text.GetChar(s, 0); sLen := Text.Length(s); i := 0; BEGIN
LOOP
i := Text.FindChar(t, startChar, i);
IF i < 0 OR Text.Equal(s, Text.Sub(t, i, sLen)) THEN EXIT END;
INC(i); (* otherwise increment for next time 'round *)
END;
RETURN i
END FindString;
PROCEDURE SubstForVar(VAR (*INOUT*) arg: TEXT; varName, val: TEXT): TEXT
RAISES {Error} =
Return the result of replacing the (first) occurence (if any) of varName
in arg by val. If such an occurrence is found but val is NIL, raise
Error.
VAR i := FindString(arg, varName); res := arg; BEGIN
IF i >= 0 THEN
IF val # NIL THEN
res := Text.Sub(arg, 0, i) & val &
Text.Sub(arg, i + Text.Length(varName))
ELSE
RAISE Error("variable \"" & varName
& "\" not allowed in this command")
END
END;
RETURN res
END SubstForVar;
PROCEDURE ParseCmd(cmdLine: TEXT; VAR (*OUT*) cmd: TEXT;
VAR (*OUT*) args: REF ARRAY OF TEXT;
titleVal, displayVal, filenameVal: TEXT := NIL)
RAISES {Error} =
<* FATAL Rd.Failure, Thread.Alerted *> (* TextRd.T's cannot fail *)
VAR rd := TextRd.New(cmdLine); seq := NEW(TextSeq.T).init(); BEGIN
IF Rd.EOF(rd) THEN RAISE Error("no command specified") END;
cmd := Lex.Scan(rd); Lex.Skip(rd);
WHILE NOT Rd.EOF(rd) DO
VAR arg := Lex.Scan(rd); BEGIN
arg := SubstForVar(arg, "$Title", titleVal);
arg := SubstForVar(arg, "$Display", displayVal);
arg := SubstForVar(arg, "$Filename", filenameVal);
seq.addhi(arg);
END;
Lex.Skip(rd)
END;
args := NEW(REF ARRAY OF TEXT, seq.size());
FOR i := 0 TO LAST(args^) DO
args[i] := seq.remlo()
END
END ParseCmd;
PROCEDURE SetFonts(v: VBT.T) =
<* LL.sup = VBT.mu *>
BEGIN
TYPECASE v OF
TextEditVBT.T (t) =>
t.tp.setFont(codeFont)
| TextVBT.T (t) =>
TextVBT.SetFont(t, textFont, TextVBT.GetQuad(t))
| TextPort.T (t) =>
t.setFont(textFont)
| FileBrowserVBT.DirMenu (t) =>
t.setFont(textFont)
| ListVBT.T (t) =>
SetSplitFonts(t);
TYPECASE t.painter OF
NULL => (* SKIP *)
| ListVBT.TextPainter (p) => p.setFont(t, textFont)
ELSE (* SKIP *)
END
| Split.T (t) =>
SetSplitFonts(t)
ELSE
IF MultiClass.Resolve(v) # NIL THEN
SetSplitFonts(v)
END
END
END SetFonts;
PROCEDURE SetSplitFonts(v: VBT.T) =
<* LL.sup = VBT.mu *>
<* FATAL MultiSplit.NotAChild *>
VAR curr := MultiSplit.Succ(v, NIL); BEGIN
WHILE curr # NIL DO
SetFonts(curr);
curr := MultiSplit.Succ(v, curr)
END
END SetSplitFonts;
BEGIN
END JunoConfig.