<< JunoGlobalAlistImpl.mesa (ex OldParseWindowImpl.mesa)>> <<>> <> <> <> << Maintains a text viewer containing the current set of Juno procedures. Exports procedures that search this list and that append new procedures to it. >> << The viewer has two extra menu buttons:>> <> <> <> << TO FIX: Everything.>> DIRECTORY JunoGlobalAlist, JunoProcViewer USING [Viewer, NewViewer, ParseViewer, DestroyViewer, AddBranch, BranchVisitProc], JunoUserEvents USING [Blink], Rope USING [ROPE, Substr, SkipTo, Length, Fetch, Cat, Equal], Atom USING [GetPName], ViewerClasses USING [Viewer], JunoExpressions USING [leftPren, colon, lambda, Definition, Cadr, Caddr], JunoParseSyntax USING [junoParseTable], JunoParseUnparse USING [Se, VerdictAndCulprit, Stream, StreamFromRope, Parse, Contents, Unparse]; JunoGlobalAlistImpl: CEDAR PROGRAM IMPORTS JunoProcViewer, JunoExpressions, JunoParseUnparse, JunoParseSyntax, JunoUserEvents, Rope, Atom EXPORTS JunoGlobalAlist = BEGIN OPEN Rope, JunoGlobalAlist, PView: JunoProcViewer, Expr: JunoExpressions, Evs: JunoUserEvents, Synt: JunoParseSyntax, Parse: JunoParseUnparse; << - - - - IMPORTED TYPES>> ROPE: TYPE = Rope.ROPE; Se: TYPE = Parse.Se; Viewer: TYPE = ViewerClasses.Viewer; << - - - - THE GLOBAL ALIST >> << The global alist consists of a list of viewers, in the search order. This list needs not be protected by the monitor, since it is altered/consulted only by the client process (JunoTop). A viewer are added to the list through AddViewer below, and is removed by ParseAll when the latter notices it has been destroyed by the user. >> Segment: TYPE = RECORD [viewer: Viewer, entries: LIST OF Entry _ NIL, -- entries parsed from this viewer, in reverse order nerrors: INTEGER _ 0 -- Number of errors detected in last parse ]; firstSegment, lastSegment: LIST OF Segment _ NIL; Entry: TYPE = RECORD [text1, text2: ROPE, -- UnParsed contents of header and body nodes for this entry name: ATOM, -- key (procedure name) value: Se -- value (lambda expression) ]; StartUp: PUBLIC PROC = BEGIN IF firstSegment # NIL THEN ERROR; END; AddNewViewer: PUBLIC PROC = <> BEGIN viewer: Viewer = PView.NewViewer[]; new: LIST OF Segment = LIST [[viewer: PView.NewViewer[], entries: NIL]]; IF firstSegment = NIL THEN {firstSegment _ new} ELSE {lastSegment.rest _ new}; lastSegment _ new END; AddDef: PUBLIC PROC [name: ATOM, value: Se] = <> BEGIN text1, text2: ROPE; [text1, text2] _ UnparseDef[ToOldStyleDecl[name, value]]; IF firstSegment = NIL THEN AddNewViewer[]; PView.AddBranch[lastSegment.first.viewer, text1, text2]; lastSegment.first.entries _ CONS [[text1, text2, name, value], lastSegment.first.entries] END; ParseAll: PUBLIC PROC = <> <> BEGIN FOR seg: LIST OF Segment _ firstSegment, seg.rest WHILE seg # NIL DO oldEntries: LIST OF Entry _ seg.first.entries; ParseUnparseEntry: PView.BranchVisitProc = <<-- [text1, text2: ROPE] RETURNS [new1, new2: ROPE, errBeg, errEnd _ -1]>> TRUSTED BEGIN old, ant: LIST OF Entry _ NIL; FOR old _ oldEntries, old.rest WHILE old # NIL DO IF Equal[old.first.text1, text1] AND Equal[old.first.text2, text2] THEN {IF ant = NIL THEN seg.first.entries _ old.rest ELSE ant.rest _ old.rest; EXIT}; ant _ old ENDLOOP; IF old = NIL THEN {def: Se; ldef: LIST OF Se; error, unp: ROPE; vc: Parse.VerdictAndCulprit; openCount: INTEGER; stream: Parse.Stream = Parse.StreamFromRope[Cat[text1, text2]]; [def, error, openCount] _ Parse.Parse[stream, Synt.junoParseTable]; IF error = NIL AND stream.pos < stream.len THEN {error _ "excess input"}; ldef _ LIST [def]; IF error = NIL THEN {vc _ Expr.Definition[ldef]; IF vc.verdict # yes THEN error _ "not a wff"} ELSE {vc _ [yes, NIL]}; unp _ Parse.Unparse[ldef, Synt.junoParseTable, vc.culprit, openCount, 0, 57]; errBeg _ errEnd _ unp.Length; unp _ Cat[unp, Parse.Contents[stream]]; {lenh: INT _ SkipTo[unp, 0, "\n"]; IF lenh >= unp.Length THEN lenh _ SkipTo[unp, 0, ":"]; new1 _ unp.Substr[0, lenh]; new2 _ unp.Substr[lenh]}; IF error # NIL THEN {Evs.Blink["Parse error: ", error]} ELSE {head: Se = Expr.Cadr[def]; name: Se _ IF ISTYPE [head, ATOM] THEN head ELSE Expr.Cadr[head]; formals: Se _ IF ISTYPE [head, ATOM] THEN NIL ELSE Expr.Caddr[head]; body: Se = Expr.Caddr[def]; errBeg _ errEnd _ -1; seg.first.entries _ CONS [[new1, new2, NARROW[name], LIST [Expr.lambda, formals, body]], seg.first.entries]}} ELSE {old.rest _ seg.first.entries; seg.first.entries _ old; new1_ text1; new2 _ text2; errBeg _ errEnd _ -1} END; seg.first.entries _ NIL; seg.first.nerrors _ PView.ParseViewer[seg.first.viewer, ParseUnparseEntry]; IF seg.first.nerrors # 0 THEN {WHILE oldEntries # NIL DO t: LIST OF Entry = oldEntries.rest; oldEntries.rest _ seg.first.entries; seg.first.entries _ oldEntries; oldEntries _ t ENDLOOP} ENDLOOP END; GetDef: PUBLIC PROC [name: ATOM] RETURNS [value: Se] = BEGIN FOR seg: LIST OF Segment _ firstSegment, seg.rest WHILE seg # NIL DO FOR e: LIST OF Entry _ seg.first.entries, e.rest UNTIL e=NIL DO IF e.first.name = name THEN RETURN[e.first.value] ENDLOOP; IF seg.first.nerrors > 0 THEN {Evs.Blink["Can't evaluate ", Atom.GetPName[name], " - syntax errors in viewer"]; ERROR}; ENDLOOP; RETURN [NIL] END; Terminate: PUBLIC PROC = BEGIN FOR seg: LIST OF Segment _ firstSegment, seg.rest WHILE seg # NIL DO PView.DestroyViewer[seg.first.viewer] ENDLOOP; firstSegment _ lastSegment _ NIL END; ToOldStyleDecl: PROC [name: ATOM, value: Se] RETURNS [tree: Se] = < ) ) or (Expr.colon ) pair.>> {expr: LIST OF Se = NARROW [value]; formals: Se = expr.rest.first; body: Se = expr.rest.rest.first; header: Se = IF formals = NIL THEN name ELSE LIST[Expr.leftPren, name, formals]; IF expr.first # Expr.lambda THEN ERROR; RETURN [LIST [Expr.colon, header, body]]}; UnparseDef: PROC [def: Se] RETURNS [text1, text2: ROPE] = < ) ) or (Expr.colon ) pair.>> {unp: ROPE _ Parse.Unparse[LIST[def], Synt.junoParseTable, NIL, 0, 0, 57]; lenh: INT _ unp.SkipTo[0, "\n"]; IF lenh >= unp.Length THEN lenh _ MIN [unp.SkipTo[0, ":"], 57]; text1 _ unp.Substr[0, lenh]; text2 _ unp.Substr[IF lenh < unp.Length AND unp.Fetch[lenh] = ': THEN lenh ELSE lenh + 1]}; END. << - - - - STUFF UNDER DEVELOPMENT>> GetCurrentDef: PUBLIC PROC [name: ATOM] RETURNS [value: Expr.e] = BEGIN toParse: Handle _ NIL; -- DoGetDef needs this to be parsed before retrying DoGetDef: ENTRY PROC = {ENABLE {UNWIND => NULL}; toParse _ NIL; FOR lst: LIST OF Handle _ handleList, lst.rest WHILE lst # NIL DO handle: Handle = lst.first; IF handle.notParsed THEN {toParse _ handle; RETURN}; -- can't call ParseViewer here: deadl(ock)y danger FOR elst: LIST OF Entry _ handle.entryList, elst.rest WHILE elst # NIL DO IF NOT elst.first.valid THEN RETURN WITH ERROR ParseErrors; IF elst.first.name = name THEN {value _ elst.first.value; RETURN} ENDLOOP ENDLOOP}; value _ NIL; DO DoGetDef[]; IF toParse = NIL THEN RETURN; ParseViewer[toParse.viewer] ENDLOOP END; AddDef: PUBLIC PROC [name: ATOM, value: Se] = BEGIN firstLine, remainingLines: ROPE; DoAppendDef: ENTRY PROC = {IF handleList = NIL THEN {RETURN WITH ERROR ParseErrors} ELSE {ENABLE {UNWIND => NULL}; handle: Handle = lastHandle.first; elst: LIST OF Entry = LIST [[name: name, value: value, valid: TRUE]]; IF handle.lastEntry = NIL THEN {handle.lastEntry _ elst} ELSE {handle.entryList _ elst}; handle.lastEntry _ elst}}; [firstLine, remainingLines] _ UnparseDecl[ToOldStyleDecl [name, value]]; AddBranch[handle.viewer, firstLine, remainingLines]; DoAddDef END; ParseNode: PROC [n: TiogaNode] = RETURNS [success: BOOL, tree: REF ANY, firstLine, remainingLines: ROPE] = {r: Rope.ROPE; vc: VerdictAndCulprit; errorMessage: ROPE _ NIL; firstLine _ TiogaOps.GetRope[n]; remainingLines _ TiogaOps.GetRope[TiogaOps.FirstChild[n]]; -- next three lines try to skip parsing if old parsed result is present in pw.contents: {l: LIST OF NodeContent _ pw.content; WHILE l # NIL AND NOT(Rope.Equal[l.first.text1, text1] AND Rope.Equal[l.first.text2, text2]) DO l _ l.rest ENDLOOP ; IF l # NIL THEN { success _ TRUE ; tree _ l.first.tree ; text1 _ l.first.text1; text2 _ l.first.text2 ; RETURN } }; IF ~ pw.contentValid THEN RETURN; pw.ph.in.in _ IO.RIS[Rope.Cat[text1, text2, " "]]; pw.ph.in.eof _ FALSE; pw.ph.in.error _ NIL; pw.ph.in.Lex[]; IF pw.ph.in.eof THEN {success _ TRUE; tree _ text1 _ text2 _ NIL; RETURN}; pw.ph.Parse[]; pw.ph.result _ tree _ CONS[pw.ph.result, NIL]; -- necessary because WellFormed and Unparse work on the CAR of their argument -- and ignore the cdr. IF pw.ph.error = NIL AND pw.ph.eof THEN {vc _ pw.WellFormed[pw.ph.result]; IF vc.verdict # Yes THEN errorMessage _ "Not a WFF" ELSE {vc.culprit _ NIL; errorMessage _ NIL}} ELSE {vc.culprit _ NIL; errorMessage _ IF pw.ph.error # NIL THEN pw.ph.error ELSE "Bad Syntax"}; r _ Unparser.Unparse[pw.ph.result, vc.culprit, 57, pw.ph.table, pw.ph.openCount]; --! change "57" to "width of window" tree _ NARROW[pw.ph.result, LIST OF REF ANY].first; IF pw.ph.error # NIL OR ~pw.ph.eof THEN {r _ Rope.Cat[r, " \000", Rope.FromRefText[pw.ph.in.buf], "\000"]; WHILE ~ IO.EndOf[pw.ph.in.in] DO r _ Rope.Cat[r, Rope.FromChar[IO.GetChar[pw.ph.in.in]]] ENDLOOP}; {i: INT _ r.SkipTo[0, "\000"]; j: INT; endOfHeader: INT = r.SkipTo[0, "\n"]; firstLine: Rope.ROPE = r.Substr[0, endOfHeader]; restOfLines: Rope.ROPE = IF endOfHeader = r.Length THEN NIL ELSE r.Substr[endOfHeader + 1]; Foo: SAFE PROC[root: TiogaOps.Ref] = TRUSTED {m: TiogaNode = IF TiogaOps.FirstChild[n] = NIL THEN n ELSE TiogaOps.FirstChild[n]; TiogaOps.SelectNodes[viewer: pw.viewer, start:n, end:m, pendingDelete: TRUE, level:char]; IF i = r.Length[] THEN {TiogaOps.InsertRope[firstLine]; TiogaOps.Break[]; TiogaOps.Nest[]; TiogaOps.InsertRope[restOfLines]} ELSE {j _ r.SkipTo[i + 1, "\000"]; TiogaOps.InsertRope[Rope.Cat[r.Substr[0, i], r.Substr[i+1, j - i - 1], r.Substr[j+1]]]; TiogaOps.SetSelection[pw.viewer, [n, i], [n, j - 1]]}}; TiogaOps.CallWithLocks[Foo, TiogaOps.ViewerDoc[pw.viewer]]; success _ (errorMessage = NIL); text1 _ firstLine; text2 _ restOfLines}}; ParseViewer: PROC [viewer: Viewer] = BEGIN DoParseViewer: ENTRY PROC [root: REF] = {ENABLE {UNWIND => NULL}; junoA: PWin.Handle = PEtc.junoA; PEtc.Parse[]; IF NOT junoA.contentValid THEN Gr.Blink["Parse error"] ELSE {p: LIST OF PWin.NodeContent _ junoA.content; -- p is a list of pairs [text: rope, tree: REF ANY]; the trees -- are all valid definitions, which we will add to the list of -- definitions. Except that some are NILs that should be skipped. WHILE p # NIL DO IF p.first.tree # NIL THEN {t: REF ANY = p.first.tree; AddDef[Cadr[Cadr[t]], Caddr[Cadr[t]], Caddr[t]]}; p _ p.rest ENDLOOP}}; {newContent: LIST OF NodeContent _ NIL; n: TiogaNode _ TiogaOps.FirstChild[TiogaOps.ViewerDoc[pw.viewer]]; success: BOOL _ TRUE; tree: REF; text1: ROPE; text2: ROPE; pw.contentValid _ TRUE; WHILE success AND n # NIL DO [success, tree, text1, text2] _ PN2[n, pw]; IF success THEN newContent _ CONS[[text1, text2, tree], newContent]; n _ TiogaOps.Next[n]; ENDLOOP; pw.contentValid _ success; IF success THEN pw.content _ newContent ELSE pw.content _ AppendNodeContentList[newContent, pw.content]}; TiogaOps.CallWithLocks[DoParseViewer, TiogaOps.ViewerDoc[viewer]]; END; << - - - - OLD STUFF>> ROPE: TYPE = Rope.ROPE; SyntacticPredicate: TYPE = PROC [f: REF ANY] RETURNS [VerdictAndCulprit]; VerdictAndCulprit: TYPE = RECORD [verdict: Verdict, culprit: REF ANY]; <> Verdict: TYPE = {Yes, No, OfCourseNot}; -- Yes == innocent NewHandle: PUBLIC PROC [v: ViewerClasses.Viewer] RETURNS [handle: Handle] = { handle _ NEW[HandleRep] ; handle.ph _ Parser.NewHandle[] ; handle.ph.in _ Lexer.NewHandle[] ; handle.viewer _ v ; handle.content _ NIL ; handle.contentValid _ FALSE}; << - - - - MENU PROCEDURES>> << Moved here from JunoTop on April 6, 1984 3:52:04 pm PST; need to be fixed!!!>> Parse: PUBLIC PROC = {junoA: PWin.Handle = PEtc.junoA; PEtc.Parse[]; IF NOT junoA.contentValid THEN Gr.Blink["Parse error"] ELSE {p: LIST OF PWin.NodeContent _ junoA.content; -- p is a list of pairs [text: rope, tree: REF ANY]; the trees -- are all valid definitions, which we will add to the list of -- definitions. Except that some are NILs that should be skipped. WHILE p # NIL DO IF p.first.tree # NIL THEN {t: REF ANY = p.first.tree; AddDef[Cadr[Cadr[t]], Caddr[Cadr[t]], Caddr[t]]}; p _ p.rest ENDLOOP}}; NewProc: PUBLIC PROC = {junoA: PWin.Handle = PEtc.junoA; PWin.AddBranch[junoA, " CommandName(Args)", ": Body\n"]}; ProcFile: PUBLIC PROC[fileName: Rope.ROPE] = {PEtc.Algebra[fileName]; Parse[]}; << Moved from JunoStorageImpl on April 6, 1984 3:52:04 pm PST; need to be fixed!!!>> lambdaAlist: LIST OF REF ANY; GetBody: PUBLIC PROC [name: REF ANY] RETURNS [REF ANY] = {deflist : LIST OF REF ANY _ lambdaAlist; WHILE deflist # NIL AND deflist.first # name DO deflist _ deflist.rest.rest.rest ENDLOOP; IF deflist # NIL THEN RETURN [Car[Cddr[deflist]]] ELSE RETURN [NIL]}; GetLocals: PUBLIC PROC [name: REF ANY] RETURNS [REF ANY] = {deflist : LIST OF REF ANY _ lambdaAlist; WHILE deflist # NIL AND deflist.first # name DO deflist _ deflist.rest.rest.rest ENDLOOP; IF deflist = NIL THEN RETURN [NIL] ELSE RETURN [Cadr[deflist]] }; AddDef: PUBLIC PROC [name, locals, body: REF ANY] = {lambdaAlist _ CONS[name, CONS[locals, CONS[body, lambdaAlist]]]}; << - - - - OLD STUFF>> AddOp: PUBLIC PROC [handle: Handle, op: Rope.ROPE, alias: ROPE, bp: INTEGER, f: OperatorType, c: Rope.ROPE, u: INT _ 0] = {p: PT.Properties _ NEW[PT.PRec _ [name: Atom.MakeAtom[op]]]; IF alias # NIL THEN p.alias _ Atom.MakeAtom[alias]; p.bindingPower _ bp; p.closer _ IF c = NIL THEN NIL ELSE handle.ph.table.Search[Atom.MakeAtom[c], NIL]; p.unparserType _ u; SELECT f FROM infix => p.infix _ TRUE; subfixMatchfix => p.subfix _ p.matchfix _ TRUE; matchfix => p.matchfix _ TRUE; prefix => p.prefix _ TRUE; infixPrefix => p.infix _ p.prefix _ TRUE; closefix => p.closefix _ TRUE ENDCASE => ERROR; handle.ph.table.Enter[p]; IF Rope.Length[alias] = 2 AND handle.ph.in.type[Rope.Fetch[alias, 0]] = op THEN handle.ph.in.AddOpPair[alias.Fetch[0], alias.Fetch[1]]; IF Rope.Length[op] = 2 AND handle.ph.in.type[Rope.Fetch[op, 0]] = op THEN handle.ph.in.AddOpPair[op.Fetch[0], op.Fetch[1]]}; TiogaNode: TYPE = TiogaOps.Ref; Next: PROC[n:TiogaNode] RETURNS [TiogaNode] = {RETURN[TiogaOps.Next[n]]}; FirstChild: PROC[n:TiogaNode] RETURNS [TiogaNode] = {RETURN[TiogaOps.FirstChild[n]]}; GetRope: PROC[n:TiogaNode] RETURNS [ROPE] = {RETURN[TiogaOps.GetRope[n]]}; ViewerDoc: PROC[v: ViewerClasses.Viewer] RETURNS [TiogaNode] = {RETURN[TiogaOps.ViewerDoc[v]]}; ParseViewer: PUBLIC PROC [pw: Handle] = {newContent: LIST OF NodeContent _ NIL; n: TiogaNode _ TiogaOps.FirstChild[TiogaOps.ViewerDoc[pw.viewer]]; success: BOOL _ TRUE; tree: REF; text1: ROPE; text2: ROPE; pw.contentValid _ TRUE; WHILE success AND n # NIL DO [success, tree, text1, text2] _ PN2[n, pw]; IF success THEN newContent _ CONS[[text1, text2, tree], newContent]; n _ TiogaOps.Next[n]; ENDLOOP; pw.contentValid _ success; IF success THEN pw.content _ newContent ELSE pw.content _ AppendNodeContentList[newContent, pw.content]}; AppendNodeContentList: PROC[a, b: LIST OF NodeContent] RETURNS [aa: LIST OF NodeContent] = { IF a=NIL THEN RETURN [b] ELSE {aa _ a; WHILE a.rest#NIL DO a _ a.rest ENDLOOP; a.rest _ b}; }; PN2: PROC [n: TiogaNode, pw: Handle] RETURNS [success: BOOL, tree: REF ANY, text1: ROPE, text2: ROPE] = {r: Rope.ROPE; vc: VerdictAndCulprit; errorMessage: ROPE _ NIL; text1 _ TiogaOps.GetRope[n]; text2 _ TiogaOps.GetRope[TiogaOps.FirstChild[n]]; -- next three lines try to skip parsing if old parsed result is present in pw.contents: { l: LIST OF NodeContent _ pw.content ; WHILE l # NIL AND NOT(Rope.Equal[l.first.text1, text1] AND Rope.Equal[l.first.text2, text2]) DO l _ l.rest ENDLOOP ; IF l # NIL THEN { success _ TRUE ; tree _ l.first.tree ; text1 _ l.first.text1; text2 _ l.first.text2 ; RETURN } }; IF ~ pw.contentValid THEN RETURN; pw.ph.in.in _ IO.RIS[Rope.Cat[text1, text2, " "]]; pw.ph.in.eof _ FALSE; pw.ph.in.error _ NIL; pw.ph.in.Lex[]; IF pw.ph.in.eof THEN {success _ TRUE; tree _ text1 _ text2 _ NIL; RETURN}; pw.ph.Parse[]; pw.ph.result _ tree _ CONS[pw.ph.result, NIL]; -- necessary because WellFormed and Unparse work on the CAR of their argument -- and ignore the cdr. IF pw.ph.error = NIL AND pw.ph.eof THEN {vc _ pw.WellFormed[pw.ph.result]; IF vc.verdict # Yes THEN errorMessage _ "Not a WFF" ELSE {vc.culprit _ NIL; errorMessage _ NIL}} ELSE {vc.culprit _ NIL; errorMessage _ IF pw.ph.error # NIL THEN pw.ph.error ELSE "Bad Syntax"}; r _ Unparser.Unparse[pw.ph.result, vc.culprit, 57, pw.ph.table, pw.ph.openCount]; --! change "57" to "width of window" tree _ NARROW[pw.ph.result, LIST OF REF ANY].first; IF pw.ph.error # NIL OR ~pw.ph.eof THEN {r _ Rope.Cat[r, " \000", Rope.FromRefText[pw.ph.in.buf], "\000"]; WHILE ~ IO.EndOf[pw.ph.in.in] DO r _ Rope.Cat[r, Rope.FromChar[IO.GetChar[pw.ph.in.in]]] ENDLOOP}; {i: INT _ r.SkipTo[0, "\000"]; j: INT; endOfHeader: INT = r.SkipTo[0, "\n"]; firstLine: Rope.ROPE = r.Substr[0, endOfHeader]; restOfLines: Rope.ROPE = IF endOfHeader = r.Length THEN NIL ELSE r.Substr[endOfHeader + 1]; Foo: SAFE PROC[root: TiogaOps.Ref] = TRUSTED {m: TiogaNode = IF TiogaOps.FirstChild[n] = NIL THEN n ELSE TiogaOps.FirstChild[n]; TiogaOps.SelectNodes[viewer: pw.viewer, start:n, end:m, pendingDelete: TRUE, level:char]; IF i = r.Length[] THEN {TiogaOps.InsertRope[firstLine]; TiogaOps.Break[]; TiogaOps.Nest[]; TiogaOps.InsertRope[restOfLines]} ELSE {j _ r.SkipTo[i + 1, "\000"]; TiogaOps.InsertRope[Rope.Cat[r.Substr[0, i], r.Substr[i+1, j - i - 1], r.Substr[j+1]]]; TiogaOps.SetSelection[pw.viewer, [n, i], [n, j - 1]]}}; TiogaOps.CallWithLocks[Foo, TiogaOps.ViewerDoc[pw.viewer]]; success _ (errorMessage = NIL); text1 _ firstLine; text2 _ restOfLines}}; AddTree: PUBLIC PROC[pw: Handle, tree: REF]= {r: ROPE _ Unparser.Unparse[LIST[tree], NIL, 57, pw.ph.table, 0]; End: PROC[r: ROPE] RETURNS [e: INT] = { ee: INT _ r.SkipTo[0, ":"]; e _ r.SkipTo[0, "\n"]; IF e = r.Length THEN r _ Rope.Cat[r, "\n"]; IF ee < e THEN e _ ee}; endOfHeader: INT = End[r]; firstLine: Rope.ROPE = r.Substr[0, endOfHeader]; restOfLines: Rope.ROPE = IF r.Fetch[endOfHeader] = ': THEN r.Substr[endOfHeader] ELSE r.Substr[endOfHeader + 1]; nd: TiogaNode _ TiogaOps.LastWithin[TiogaOps.ViewerDoc[pw.viewer]]; Foo: SAFE PROC[root: TiogaOps.Ref] = CHECKED {TiogaOps.SelectNodes[pw.viewer, nd, nd, node, FALSE]; TiogaOps.Break[]; TiogaOps.UnNest[]; TiogaOps.InsertRope[firstLine]; TiogaOps.Break[]; TiogaOps.Nest[]; TiogaOps.InsertRope[restOfLines]}; TiogaOps.CallWithLocks[Foo, TiogaOps.ViewerDoc[pw.viewer]]; pw.content _ CONS[[firstLine, restOfLines, tree], pw.content]}; AddBranch: PUBLIC PROC[pw: Handle, text1, text2: ROPE] = {nd: TiogaNode _ TiogaOps.LastWithin[TiogaOps.ViewerDoc[pw.viewer]]; Foo: SAFE PROC[root: TiogaOps.Ref] = CHECKED {TiogaOps.SelectNodes[pw.viewer, nd, nd, node, FALSE]; TiogaOps.Break[]; TiogaOps.UnNest[]; TiogaOps.InsertRope[text1]; TiogaOps.Break[]; TiogaOps.Nest[]; TiogaOps.InsertRope[text2]}; TiogaOps.CallWithLocks[Foo, TiogaOps.ViewerDoc[pw.viewer]]}; HasForm: PUBLIC PROC[f: REF ANY, op: ATOM, Arg1: SyntacticPredicate, Arg2: SyntacticPredicate _ NIL] RETURNS [VerdictAndCulprit] = {WITH Car[NARROW[f]] SELECT FROM g: LIST OF REF ANY => {IF Car[g] # op THEN RETURN [[OfCourseNot, g]]; IF (Arg2 = NIL) # (Cddr[g] = NIL) THEN RETURN[[OfCourseNot, f]]; {aw: VerdictAndCulprit _ Arg1[Cdr[g]]; IF aw.verdict # Yes THEN RETURN [[No, aw.culprit]]; IF Cddr[g] = NIL THEN RETURN [[Yes, NIL]]; aw _ Arg2[Cddr[g]]; IF aw.verdict # Yes THEN RETURN [[No, aw.culprit]]; RETURN [[Yes, NIL]]}} ENDCASE => RETURN [[OfCourseNot, f]]}; Or: PUBLIC PROC [aw1, aw2: VerdictAndCulprit] RETURNS [r: VerdictAndCulprit] = {SELECT TRUE FROM aw1.verdict = Yes OR aw2.verdict = Yes => r _ [Yes, NIL]; aw1.verdict = No => r _ aw1; aw2.verdict = No => r _ aw2; aw1.verdict = OfCourseNot AND aw2.verdict = OfCourseNot => r _ aw1 ENDCASE => ERROR}; Se: TYPE = REF ANY; Car: PROC [r: Se] RETURNS [Se] = {RETURN[NARROW[r, LIST OF REF ANY].first]}; Cdr: PROC [r: Se] RETURNS [Se] = {RETURN[NARROW[r, LIST OF REF ANY].rest]}; Cadr: PROC [r: Se] RETURNS [Se] = {RETURN[Car[Cdr[r]]]}; Caddr: PROC [r: Se] RETURNS [Se] = {RETURN[Car[Cdr[Cdr[r]]]]}; Cddr: PROC [r: Se] RETURNS [Se] = {RETURN[Cdr[Cdr[r]]]}; Caar: PROC [r: Se] RETURNS [Se] = {RETURN[Car[Car[r]]]}; Cadar: PROC [l: Se] RETURNS [Se] = { RETURN[ Car[ Cdr[ Car[ l ] ] ] ] }; Caddar: PROC [l: Se] RETURNS [Se] = { RETURN[ Car[ Cdr[ Cdr[ Car[ l ] ] ] ] ] }; Cadddar: PROC [l: Se] RETURNS [Se] = { RETURN[ Car[ Cdr[ Cdr[ Cdr[ Car[ l ] ] ] ] ] ] }; Cadddr: PROC [l: Se] RETURNS [Se] = { RETURN[ Car[ Cdr[ Cdr[ Cdr[ l ] ] ] ] ] }; Caddddar: PROC [l: Se] RETURNS [Se] = { RETURN[ Car[ Cdr[ Cdr[ Cdr[ Cdr[ Car[ l ] ] ] ] ] ] ] }; Cddar: PROC [l: Se] RETURNS [Se] = { RETURN[ Cdr[ Cdr[ Car[ l ] ] ] ] }; END.