(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE (LET ((*PACKAGE* *PACKAGE*)) (CL IN-PACKAGE
"INTERLISP") (FILESLOAD TEXTMODULES) *PACKAGE*) BASE 10)
(FILECREATED " 2-Oct-87 18:07:39" {DSK}<LISPFILES>WORK>SEDIT-COMMONLISP.;29 63962
changes to%: (FNS \\unread.read.time.conditional? \\subnode.changed.read.time.conditional \\delete.read.time.conditional \\replace.read.time.conditional \\set.point.read.time.conditional \\initialize.commonlisp \\insert.read.time.conditional \\parse..conditional.read \\cfv.read.time.conditional \\linearize.read.time.conditional \\compute.point.position.read.time.conditional \\undo.replace.read.time.conditional \\backspace.read.time.conditional \\stringify.read.time.conditional \\copy.structure.read.time.conditional \\set.selection.read.time.conditional \\stringify.comment SUPERPRINT/COMMENT \\linearize.comment \\cfv.form \\parse..hash.bar.comment)
(VARS SEDIT-COMMONLISPCOMS) (PROPS (SEDIT-COMMONLISP MAKEFILE-ENVIRONMENT)) (PRESENTATIONS TM::HASH-R)
previous date%: "29-Sep-87 14:05:07" {DSK}<LISPFILES>WORK>SEDIT-COMMONLISP.;17)
(* "
Copyright (c) 1987 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT SEDIT-COMMONLISPCOMS)
(RPAQQ SEDIT-COMMONLISPCOMS ((* ;;; " This file contains patches to the following files: SEDIT-COMMENTS (adds 4 semicolon and balanced comments), SEDIT-LISTS (form CFV and linearize of the new comment types), DSPRINTDEF and NEWPRINTDEF (new comment type printing).") (LOCALVARS . T) (DECLARE%: DONTCOPY DOEVAL@COMPILE (FILES SEDIT-DECLS)) (CONSTANTS (\\level4.comment (QUOTE ;;;;)) (\\level5.comment (QUOTE %|)) (\\level5.comment.close.string (\\create.string.item "|#" (fetch (EditENV CommentFont) of \\lisp.edit.environment))) (\\comment.markers (LIST \\level1.comment \\level2.comment \\level3.comment \\level4.comment \\level5.comment)) (\\comment.level.table (LIST \\level1.comment 1 \\level2.comment 2 \\level3.comment 3 \\level4.comment 4 \\level5.comment 5))) (GLOBALVARS \\type.new.quote \\type.read.time.conditional) (* ;;; "You must also have EXPORTS.ALL loaded to compile this file, but it shouldn't be neccessary to set DFNFLG to PROP.") (MACROS \\select.comment.indent) (FNS PRIN2-LONG-STRING SEMI-COLON-COMMENT-P SUPERPRINT/COMMENT \\backspace.read.time.conditional \\cfv.clisp \\cfv.comment \\cfv.form \\cfv.lambda \\cfv.read.time.conditional \\compute.point.position.read.time.conditional \\copy.structure.new.quote \\copy.structure.read.time.conditional \\create.new.quoted.gap \\degrade.comment \\delete.read.time.conditional \\initialize.commonlisp \\input.bit.vector \\input.conditional.read \\input.new.quote \\insert.new.quoted.gap \\insert.read.time.conditional \\linearize.clisp \\linearize.comment \\linearize.form \\linearize.lambda \\linearize.list \\linearize.read.time.conditional \\parse..bit.vector \\parse..comment \\parse..conditional.read \\parse..new.quote \\replace.new.quote \\replace.read.time.conditional \\set.point.read.time.conditional \\set.selection.read.time.conditional \\split.comment \\stringify.comment \\stringify.new.quote \\stringify.read.time.conditional \\subnode.changed.new.quote \\subnode.changed.read.time.conditional \\undo.replace.read.time.conditional \\unread.read.time.conditional? \\upgrade.comment) (P (\\initialize.commonlisp)) (PROP MAKEFILE-ENVIRONMENT SEDIT-COMMONLISP))
)
(* ;;;
" This file contains patches to the following files: SEDIT-COMMENTS (adds 4 semicolon and balanced comments), SEDIT-LISTS (form CFV and linearize of the new comment types), DSPRINTDEF and NEWPRINTDEF (new comment type printing)."
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(DECLARE%: DONTCOPY DOEVAL@COMPILE
(FILESLOAD SEDIT-DECLS)
)
(DECLARE%: EVAL@COMPILE
(RPAQQ \\level4.comment ;;;;)
(RPAQQ \\level5.comment %|)
(RPAQ \\level5.comment.close.string (\\create.string.item "|#" (fetch (EditENV CommentFont) of \\lisp.edit.environment))
)
(RPAQ \\comment.markers (LIST \\level1.comment \\level2.comment \\level3.comment \\level4.comment \\level5.comment)
)
(RPAQ \\comment.level.table (LIST \\level1.comment 1 \\level2.comment 2 \\level3.comment 3 \\level4.comment 4 \\level5.comment 5)
)
(CONSTANTS (\\level4.comment (QUOTE ;;;;)) (\\level5.comment (QUOTE %|)) (\\level5.comment.close.string (\\create.string.item "|#" (fetch (EditENV CommentFont) of \\lisp.edit.environment))) (\\comment.markers (LIST \\level1.comment \\level2.comment \\level3.comment \\level4.comment \\level5.comment)) (\\comment.level.table (LIST \\level1.comment 1 \\level2.comment 2 \\level3.comment 3 \\level4.comment 4 \\level5.comment 5)))
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \\type.new.quote \\type.read.time.conditional)
)
(* ;;;
"You must also have EXPORTS.ALL loaded to compile this file, but it shouldn't be neccessary to set DFNFLG to PROP."
)
(DECLARE%: EVAL@COMPILE
(PUTPROPS \\select.comment.indent MACRO ((key level1.indent level2.indent level3.indent) (SELECTQ key (1 level1.indent) (2 level2.indent) ((3 4 5) level3.indent) (SHOULDNT "unexpected comment level"))))
)
(DEFINEQ
(PRIN2-LONG-STRING
(LAMBDA (STRING STREAM P2FLG TAIL LMARG RMARG COMMENTP USE-SEMI-COLONS) (* ; "Edited 20-Sep-87 19:20 by raf") (PROG ((ESC (fetch (READTABLEP ESCAPECHAR) of *READTABLE*)) (SA (fetch (READTABLEP READSA) of *READTABLE*)) (HERE (DSPXPOSITION NIL STREAM)) (FONT (DSPFONT NIL STREAM)) ESCWIDTH SPACEWIDTH CLOSEWIDTH SEMIWIDTH LASTSPACE I C NEXTC POS J MAPX1 MAPY1 SINGLELEFT SEMISTRING) (COND ((NOT (type? FONTDESCRIPTOR FONT)) (* ; "Ugh, happens for files") (SETQ FONT STREAM))) (SETQ ESCWIDTH (CHARWIDTH ESC FONT)) (SETQ SPACEWIDTH (CHARWIDTH (CHARCODE SPACE) FONT)) (SETQ CLOSEWIDTH (COND (P2FLG (STRINGWIDTH "%")" FONT)) (T 0))) (SELECTQ USE-SEMI-COLONS ((1 2 3 4) (* ; "Semicolon comment") (SETQ SEMIWIDTH (+ SPACEWIDTH (TIMES USE-SEMI-COLONS (CHARWIDTH (CHARCODE ";") FONT)))) (SETQ SEMISTRING (CONCAT (ALLOCSTRING USE-SEMI-COLONS (CHARCODE ";")) " "))) (5 (* ; "Balanced (hash bar) comment") (SETQ SEMIWIDTH 0) (SETQ SEMISTRING "")) NIL) (COND ((for C instring STRING as I from 1 bind (POS ← (+ HERE (COND (P2FLG (CHARWIDTH (CHARCODE %") FONT)) ((LEQ USE-SEMI-COLONS 4) SEMIWIDTH) ((EQ USE-SEMI-COLONS 5) (STRINGWIDTH "#||#" FONT)) (T 0)) CLOSEWIDTH)) do (COND ((EQ C (CHARCODE CR)) (* ; "Always want to print these strings specially") (SETQ LASTSPACE I) (RETURN NIL)) ((AND P2FLG (OR (EQ C (CHARCODE %")) (EQ C ESC))) (* ; "Need escape") (add POS ESCWIDTH))) (COND ((GREATERP (add POS (CHARWIDTH C FONT)) RMARG) (RETURN NIL))) (COND ((EQ C (CHARCODE SPACE)) (SETQ LASTSPACE I))) finally (RETURN T)) (* ; "It all fits on this line") (RETURN (COND (P2FLG (PRIN2S STRING TAIL STREAM)) (T (if (LEQ USE-SEMI-COLONS 4) then (PRIN1 SEMISTRING STREAM) elseif (EQ USE-SEMI-COLONS 5) then (PRIN1 "#|" STREAM)) (PRIN1S STRING TAIL STREAM) (if (EQ USE-SEMI-COLONS 5) then (PRIN1 "|#" STREAM))))))) (COND ((OR (NULL LASTSPACE) (AND (NULL COMMENTP) (NEQ HERE LMARG))) (* ;; "Can't print anything on this line before the end. Comments are allowed to have different first and subsequent margin.") (PRINENDLINE LMARG STREAM) (SETQ HERE LMARG) (SETQ LASTSPACE 0))) (COND (MAKEMAP (* ; "Note start") (SETQ MAPX1 HERE) (SETQ MAPY1 (DSPYPOSITION NIL STREAM)) (SETQ SINGLELEFT (EQ HERE LMARG)))) (COND (P2FLG (COND ((NOT (IMAGESTREAMP STREAM)) (* ; "Need to be able to read it back") (LET ((HASH (fetch (READTABLEP HASHMACROCHAR) of *READTABLE*))) (\OUTCHAR STREAM HASH) (add HERE (CHARWIDTH HASH FONT))))) (\OUTCHAR STREAM (CHARCODE %")) (add HERE (CHARWIDTH (CHARCODE %") FONT))) ((LEQ USE-SEMI-COLONS 4) (PRIN1 SEMISTRING STREAM) (add HERE SEMIWIDTH)) ((EQ USE-SEMI-COLONS 5) (PRIN1 "#|" STREAM) (add HERE (STRINGWIDTH "#|" FONT)))) (* ;;; "Now loop, printing as much as we can while there's room") (SETQ I 0) LP (COND ((NULL (SETQ C (NTHCHARCODE STRING (add I 1)))) (* ; "Done") (GO DONE)) ((NOT (LESSP I LASTSPACE)) (* ;; "Must find the next safe place to print up to. LASTSPACE is either a space or CR position, or is 0, which is our state when printing from the left margin until we encounter a space.") (SETQ POS HERE) (SETQ J I) (* ; "Ordinarily, J is pointing at a space or CR except when we have just printed an endline") (SELCHARQ C (SPACE (* ; "Would like all spaces before the eol, where they're invisible, not after") (SELCHARQ (NTHCHARCODE STRING (ADD1 J)) ((SPACE CR NIL) (SETQ LASTSPACE (ADD1 J)) (* ; "Go ahead and print this space, and note that it is now okay to break the line") (COND ((AND (IGEQ (+ HERE SPACEWIDTH) RMARG) (IMAGESTREAMP STREAM)) (* ; "Extra spaces have no effect, so don't print them at all, lest the dsprightmargin bite") (GO LP)) (T (GO PRINTIT)))) NIL) (add POS SPACEWIDTH)) (CR (* ; "If two cr's in a row, print them all; if only one, must escape it") (COND ((EQ (SETQ C (NTHCHARCODE STRING (add I 1))) (CHARCODE CR)) (PRINENDLINE LMARG STREAM) (while (EQ (SETQ C (NTHCHARCODE STRING (add I 1))) (CHARCODE CR)) do (PRINENDLINE LMARG STREAM))) (T (\OUTCHAR STREAM ESC))) (SETQ LASTSPACE 0) (GO ENDLINE)) (PROGN (* ;; "Gets set this way at left edge. Must print something on this line, even if there are no spaces before the right edge") (GO CHECKESCAPE))) (SETQ LASTSPACE 0) (while (LESSP POS RMARG) do (SELCHARQ (SETQ NEXTC (NTHCHARCODE STRING (add J 1))) ((CR SPACE) (* ; "Can safely go this far") (SETQ LASTSPACE J) (RETURN)) (NIL (* ; "End of string -- ok if there is space for closing quote and paren as well") (COND ((LESSP (PLUS POS CLOSEWIDTH) RMARG) (SETQ LASTSPACE J) (RETURN)) (T (GO $$OUT)))) NIL) (COND ((OR (EQ NEXTC (CHARCODE %")) (EQ NEXTC ESC)) (add POS ESCWIDTH))) (add POS (CHARWIDTH NEXTC FONT)) finally (COND ((EQ LASTSPACE 0) (* ; "Need break") (COND ((EQ C (CHARCODE SPACE)) (* ; "Will turn this space into CR") (SETQ C (NTHCHARCODE STRING (add I 1)))) (T (SHOULDNT))) (GO ENDLINE)))))) CHECKESCAPE (COND ((AND P2FLG (OR (EQ C (CHARCODE %")) (EQ C ESC))) (\OUTCHAR STREAM ESC) (add HERE ESCWIDTH))) PRINTIT (\OUTCHAR STREAM C) (add HERE (CHARWIDTH C FONT)) (GO LP) ENDLINE (PRINENDLINE LMARG STREAM) (SETQ HERE LMARG) (COND ((NULL C) (* ; "Done") (GO DONE)) ((AND P2FLG (EQ (\SYNCODE SA C) SEPRCHAR.RC)) (* ; "Have to quote sepr immediately following CR") (\OUTCHAR STREAM ESC) (add HERE ESCWIDTH) (GO PRINTIT)) (T (COND (USE-SEMI-COLONS (PRIN1 SEMISTRING STREAM) (add HERE SEMIWIDTH))) (GO CHECKESCAPE))) DONE (COND (P2FLG (\OUTCHAR STREAM (CHARCODE %")))) (COND (MAKEMAP (LET ((ENTRY (MAKEMAPENTRY TAIL (AND (NEQ MAKEMAP T) MAKEMAP) MAPX1 MAPY1 (DSPXPOSITION NIL STREAM) (DSPYPOSITION NIL STREAM) (\DEDITFONT# STREAM)))) (replace LONGSTRINGP of ENTRY with T) (COND (SINGLELEFT (replace LONGSTRING1MARGINP of ENTRY with T))) (COND ((EQ (- (DSPRIGHTMARGIN NIL STREAM) LMARG) RMARG) (* ;; "Assume that RMARG not equal to stream's right margin only happens for centered comments. In reality, it happens as well inside REPP, where RESETCLIP hides the true right margin.") (replace LONGSTRINGSYMMETRICP of ENTRY with T))))) ((EQ USE-SEMI-COLONS 5) (PRIN1 "|#" STREAM))) (RETURN)))
)
(SEMI-COLON-COMMENT-P
(LAMBDA (E) (* ; "Edited 20-Sep-87 18:30 by raf") (* ;; "If E is a comment, returns a number giving number of semis (or type).") (SELECTQ (CADR E) (; (* ; "SEdit-style right-margin comment") 1) (;; (* ; "SEdit-style current-indent comment") 2) (;;; (* ; "SEdit-style flush left comment") 3) (;;;; (* ; "Page boundary type comment") 4) (%| (* ; "Balanced (hash vertical bar) comment") 5) NIL))
)
(SUPERPRINT/COMMENT
(LAMBDA (L FILE) (* ; "Edited 21-Sep-87 12:35 by raf") (COND ((AND **COMMENT**FLG (NOT FILEFLG) (NOT MAKEMAP)) (* ; "If:") (* ; "There's a shorthand for comments, and") (* ; "We're not printing to a file, and") (* ; "Ww're not making the file map, then") (* ;; "Print out the shorthand version of the comment, watching out for overflowing the current line.") (COND ((> (+ (DSPXPOSITION NIL FILE) (STRINGWIDTH **COMMENT**FLG FILE)) (DSPRIGHTMARGIN NIL FILE)) (PRINENDLINE 0 FILE))) (PRIN1S **COMMENT**FLG NIL FILE)) (T (PROG (COMMENT-LMARGIN COMMENT-RMARGIN RIGHTFLG FLUSH-LEFTP SEMIP BODY) (COND ((SETQ RIGHTFLG (NOT (OR (SUPERPRINTEQ (CADR L) COMMENTFLG) (COND ((SETQ SEMIP (SEMI-COLON-COMMENT-P L)) (* ; "Only 1-semi comments go in right margin") (NEQ SEMIP 1)) (T (* ; "use size heuristic") (> (LENGTH L) 10)))))) (* ; "Print comment in the righthand margin") (SETQ COMMENT-LMARGIN (OR COMMENTCOL (SUPERPRINT/COMMENT1 L RMARGIN FILE))) (SETQ COMMENT-RMARGIN RMARGIN)) ((AND (GEQ SEMIP 3) (NOT MAKEMAP)) (* ; "Comment should be printed flush left. Don't do this with DEdit lest we confuse it") (SETQ COMMENT-LMARGIN 0) (SETQ COMMENT-RMARGIN RMARGIN)) (T (* ; "Print comment centered and wide") (SETQ COMMENT-LMARGIN (FIXR (TIMES 0.1 RMARGIN))) (SETQ COMMENT-RMARGIN (- RMARGIN COMMENT-LMARGIN)) (COND ((EQ COMMENT-LMARGIN (DSPXPOSITION NIL FILE)) (* ;; "HACK: Almost certainly called from REPP, so we must supress the normal leading and trailing blank lines as they have already been done") (SETQ RIGHTFLG T))))) (COND ((< COMMENT-LMARGIN (DSPXPOSITION NIL FILE)) (PRINENDLINE COMMENT-LMARGIN FILE)) (T (DSPXPOSITION COMMENT-LMARGIN FILE))) (SETFONT (PROG1 (SETFONT COMMENTFONT FILE) (COND ((AND SEMIP (NOT MAKEMAP) (STRINGP (SETQ BODY (CAR (LISTP (CDR (LISTP (CDR L))))))) (NULL (CDDDR L)) (OR (IMAGESTREAMP FILE) *PRINT-SEMICOLON-COMMENTS*)) (* ; "do nice semi-colon stuff") (PRIN2-LONG-STRING BODY FILE NIL NIL COMMENT-LMARGIN COMMENT-RMARGIN T SEMIP)) (T (SUPERPRINT/COMMENT2 L COMMENT-LMARGIN (IQUOTIENT (+ COMMENT-LMARGIN COMMENT-RMARGIN) 2) COMMENT-RMARGIN FILE)))) FILE) (COND ((AND SEMIP (NEQ SEMIP 5) (NOT MAKEMAP)) (* ;; "AR 8475 JDS 4/16/87: If there's a semi-colon comment on this line, and we're not making the file map (??), and RIGHTFLG is NIL (whatever that means) then force a new line.") (OR RIGHTFLG (PRINENDLINE 0 FILE)))) (RETURN L)))))
)
(\\backspace.read.time.conditional
(LAMBDA (node context index) (* ; "Edited 30-Sep-87 14:01 by raf") (if (NULL index) then (* ; "backspace from right boundary puts caret into the read.time.conditional's FORM.") (LET ((point (fetch CaretPoint of context))) (replace PointNode of point with node) (replace PointIndex of point with (CAR (fetch SubNodes of node))) (replace PointType of point with (QUOTE Structure))) (\\set.selection.nowhere (fetch Selection of context)) elseif (ZEROP index) then (* ; "backspace from before first element deletes the read.time.conditional if its empty.") (if (NULL (CDR (fetch SubNodes of node))) then (\\delete (fetch SuperNode of node) context node NIL (fetch CaretPoint of context))) else (* ; "backspacing after an element of the read.time.conditional is handled by that subnode.") (SETQ node (\\subnode index node)) (APPLY* (fetch BackSpace of (fetch NodeType of node)) node context)))
)
(\\cfv.clisp
(LAMBDA (x environment) (* ; "Edited 21-Sep-87 11:40 by raf") (* compute the width estimates for a clisp expression) (bind (pwidth ← 0) (mwidth ← 0) (iwidth ← 0) (first.subnode ← T) (paren.width ← (fetch Width of (fetch LParenString of environment))) (space.width ← (fetch SpaceWidth of environment)) plll mlll indent pcomment.indent mcomment.indent first (SETQ indent paren.width) (SETQ pcomment.indent paren.width) (SETQ mcomment.indent paren.width) for subnode in (CDR (fetch SubNodes of x)) do (if (EQ (fetch NodeType of subnode) \\type.comment) then (SELECTQ (fetch Unassigned of subnode) (1 (SETQ pwidth (IMAX pwidth (IPLUS pcomment.indent (fetch PreferredWidth of subnode)))) (SETQ mwidth (IMAX mwidth (IPLUS mcomment.indent (fetch MinWidth of subnode))))) ((2 3 4 5) (SETQ pwidth (IMAX pwidth (IPLUS indent (fetch PreferredWidth of subnode)))) (SETQ mwidth (IMAX mwidth (IPLUS indent (fetch MinWidth of subnode))))) (SHOULDNT "unexpected value for comment level")) (SETQ plll (SETQ mlll paren.width)) (SETQ iwidth NIL) else (if iwidth then (if (fetch InlineWidth of subnode) then (SETQ iwidth (IPLUS iwidth (if (ZEROP iwidth) then paren.width else space.width) (fetch InlineWidth of subnode))) else (SETQ iwidth NIL))) (if (AND (NOT first.subnode) (EQ (fetch ParseMode of subnode) (QUOTE KeyWord))) then (* indentable keywords are indented by the minimum indentation, except for the first keyword of the expression. other keywords are only indented by the width of the left parenthesis) (if (AND (MEMB (CDR (GETPROP (fetch Structure of subnode) (QUOTE CLISPWORD))) \\clisp.indent.words) (NOT first.subnode)) then (SETQ indent (fetch MinIndent of environment)) else (SETQ indent paren.width) (SETQ iwidth NIL))) (SETQ plll (IPLUS indent (fetch PreferredLLength of subnode))) (SETQ mlll (IPLUS indent (fetch MinLLength of subnode))) (SETQ pcomment.indent plll) (SETQ mcomment.indent mlll) (SETQ pwidth (IMAX pwidth (IPLUS (fetch PreferredWidth of subnode) indent))) (SETQ mwidth (IMAX mwidth (IPLUS (fetch MinWidth of subnode) indent))) (if (EQ (fetch ParseMode of subnode) (QUOTE KeyWord)) then (* the subnodes following a keyword are indented by the keyword's indentation plus its width plus a blank) (SETQ indent (IPLUS indent (fetch InlineWidth of subnode) space.width))) (SETQ first.subnode NIL)) finally (replace InlineWidth of x with (AND iwidth (ILESSP iwidth (fetch MaxWidth of environment)) (IPLUS iwidth paren.width))) (replace PreferredWidth of x with (IMAX pwidth (replace PreferredLLength of x with (IPLUS plll paren.width)))) (replace MinWidth of x with (IMAX mwidth (replace MinLLength of x with (IPLUS mlll paren.width))))))
)
(\\cfv.comment
(LAMBDA (node environment context) (* ; "Edited 18-Sep-87 17:58 by raf") (* ; "compute the width estimates for a comment node") (replace InlineWidth of node with NIL) (* ; "dispatch on the comment level") (LET ((width (fetch CommentWidth of context))) (SELECTQ (fetch Unassigned of node) (1 (* ; "here we know the comment width") (replace PreferredWidth of node with width) (replace MinWidth of node with width) (replace PreferredLLength of node with width) (replace MinLLength of node with width)) (2 (* ; "here just guess twice single semi comment width") (replace PreferredWidth of node with (ITIMES 2 width)) (replace MinWidth of node with width) (replace PreferredLLength of node with (ITIMES 2 width)) (replace MinLLength of node with width)) ((3 4 5) (* ; "since these won't affect supernode's formattng, just guess small") (replace PreferredWidth of node with 30) (replace MinWidth of node with 30) (replace PreferredLLength of node with 30) (replace MinLLength of node with 30)) (SHOULDNT "unexpected value for comment level"))))
)
(\\cfv.form
(LAMBDA (x environment) (* ; "Edited 20-Sep-87 18:00 by raf") (* compute the width estimates for a lisp function call) (bind (pwidth ← 0) (mwidth ← 0) (iwidth ← 0) (first.subnode ← T) (paren.width ← (fetch Width of (fetch LParenString of environment))) (space.width ← (fetch SpaceWidth of environment)) plll mlll indent pcomment.indent mcomment.indent first (if (NULL (CDR (fetch SubNodes of x))) then (SETQ pwidth (ITIMES paren.width 2)) (replace InlineWidth of x with pwidth) (replace PreferredLLength of x with pwidth) (replace PreferredWidth of x with pwidth) (replace MinLLength of x with pwidth) (replace MinWidth of x with pwidth) (RETURN)) (SETQ indent paren.width) (SETQ pcomment.indent paren.width) (SETQ mcomment.indent paren.width) for subnode in (CDR (fetch SubNodes of x)) do (if (EQ (fetch NodeType of subnode) \\type.comment) then (SELECTQ (fetch Unassigned of subnode) (1 (SETQ pwidth (IMAX pwidth (IPLUS pcomment.indent (fetch PreferredWidth of subnode)))) (SETQ mwidth (IMAX mwidth (IPLUS mcomment.indent (fetch MinWidth of subnode))))) ((2 3 4 5) (SETQ pwidth (IMAX pwidth (IPLUS indent (fetch PreferredWidth of subnode)))) (SETQ mwidth (IMAX mwidth (IPLUS indent (fetch MinWidth of subnode))))) (SHOULDNT "unexpected value for comment level")) (SETQ plll (SETQ mlll paren.width)) (SETQ iwidth NIL) else (if iwidth then (if (fetch InlineWidth of subnode) then (SETQ iwidth (IPLUS iwidth (if (ZEROP iwidth) then paren.width else space.width) (fetch InlineWidth of subnode))) else (SETQ iwidth NIL))) (SETQ plll (IPLUS indent (fetch PreferredLLength of subnode))) (SETQ mlll (IPLUS indent (fetch MinLLength of subnode))) (SETQ pcomment.indent plll) (SETQ mcomment.indent mlll) (SETQ pwidth (IMAX pwidth (IPLUS (fetch PreferredWidth of subnode) indent))) (SETQ mwidth (IMAX mwidth (IPLUS (fetch MinWidth of subnode) indent))) (if first.subnode then (* the remaining subnodes are indented by the width of the CAR, unless it's too wide or won't go inline) (SETQ indent (if (AND iwidth (OR (ATOM (fetch Structure of subnode)) (ILESSP iwidth (fetch DefaultIndent of environment))) (ILESSP iwidth (fetch MaxIndent of environment))) then (IPLUS iwidth space.width) else (fetch DefaultIndent of environment))) (SETQ first.subnode NIL))) finally (replace InlineWidth of x with (AND iwidth (ILESSP iwidth (fetch MaxWidth of environment)) (IPLUS iwidth paren.width))) (replace PreferredWidth of x with (IMAX pwidth (replace PreferredLLength of x with (IPLUS plll paren.width)))) (replace MinWidth of x with (IMAX mwidth (replace MinLLength of x with (IPLUS mlll paren.width)))) (replace Unassigned of x with indent)))
)
(\\cfv.lambda
(LAMBDA (x environment) (* ; "Edited 21-Sep-87 11:37 by raf") (* ;; "compute the width estimates for a lambda expression or similar structure. PROGs and PROG*s also go through here, but are treated specially (because of the labels)") (bind (pwidth ← 0) (mwidth ← 0) (first.subnode ← T) (prog? ← (MEMB (fetch Structure of (CADR (fetch SubNodes of x))) (QUOTE (PROG PROG* NIL)))) (paren.width ← (fetch Width of (fetch LParenString of environment))) plll mlll indent pcomment.indent mcomment.indent first (SETQ indent paren.width) (SETQ pcomment.indent paren.width) (SETQ mcomment.indent paren.width) for subnode in (CDR (fetch SubNodes of x)) do (if (EQ (fetch NodeType of subnode) \\type.comment) then (SELECTQ (fetch Unassigned of subnode) (1 (SETQ pwidth (IMAX pwidth (IPLUS pcomment.indent (fetch PreferredWidth of subnode)))) (SETQ mwidth (IMAX mwidth (IPLUS mcomment.indent (fetch MinWidth of subnode))))) ((2 3 4 5) (SETQ pwidth (IMAX pwidth (IPLUS indent (fetch PreferredWidth of subnode)))) (SETQ mwidth (IMAX mwidth (IPLUS indent (fetch MinWidth of subnode))))) (SHOULDNT "unexpected value for comment level")) (SETQ plll (SETQ mlll paren.width)) else (if (AND prog? (ATOM (fetch Structure of subnode)) (NULL (fetch ParseMode of subnode))) then (* ; "it's a label -- only indentation is the width of a paren") (SETQ indent paren.width)) (SETQ plll (IPLUS indent (fetch PreferredLLength of subnode))) (SETQ mlll (IPLUS indent (fetch MinLLength of subnode))) (SETQ pcomment.indent plll) (SETQ mcomment.indent mlll) (SETQ pwidth (IMAX pwidth (IPLUS (fetch PreferredWidth of subnode) indent))) (SETQ mwidth (IMAX mwidth (IPLUS (fetch MinWidth of subnode) indent))) (if first.subnode then (* ; "the second (noncomment) subnode (i.e. the arg list) is indented by the width of the keyword") (SETQ indent (IPLUS paren.width (fetch PreferredWidth of subnode) (fetch SpaceWidth of environment))) (SETQ first.subnode NIL) else (SETQ indent (fetch MinIndent of environment)))) finally (* ; "these things deserve a line to themselves") (replace InlineWidth of x with NIL) (replace PreferredWidth of x with (IMAX pwidth (replace PreferredLLength of x with (IPLUS plll paren.width)))) (replace MinWidth of x with (IMAX mwidth (replace MinLLength of x with (IPLUS mlll paren.width))))))
)
(\\cfv.read.time.conditional
(LAMBDA (node environment context) (* ; "Edited 30-Sep-87 16:24 by raf") (LET ((hash.width (fetch Width of (LISTGET (fetch QuoteString of environment) :HASH))) (sign (CADR (fetch SubNodes of node))) (feature (CADDR (fetch SubNodes of node))) (form (CADDDR (fetch SubNodes of node)))) (LET ((total.width (IPLUS hash.width (fetch InlineWidth of sign) (fetch InlineWidth of feature) (fetch InlineWidth of form)))) (replace InlineWidth of node with total.width) (replace PreferredWidth of node with total.width) (replace MinWidth of node with total.width) (replace PreferredLLength of node with (fetch MinLLength of sign)) (replace MinLLength of node with (fetch MinLLength of sign)))))
)
(\\compute.point.position.read.time.conditional
(LAMBDA (point context) (* ; "Edited 30-Sep-87 17:09 by raf") (LET ((node (fetch PointNode of point)) subnode item) (if (ZEROP (fetch PointIndex of point)) then (* ;; "Before the first element -- right after the hash, which we assume is the first item in the linear form.") (replace PointX of point with (IPLUS (fetch StartX of node) (fetch Width of (CAR (fetch LinearForm of node))))) (replace PointLine of point with (fetch FirstLine of node)) else (* ; "Find the subnode the point will follow.") (SETQ subnode (\\subnode (fetch PointIndex of point) node)) (replace PointLine of point with (fetch LastLine of subnode)) (SETQ item (CADR (fetch LinearThread of subnode))) (replace PointX of point with (IPLUS (fetch StartX of subnode) (fetch ActualLLength of subnode) (if (SMALLP item) then (* ; "it's followed by space -- put the caret in the middle") (IMIN (HALF item) 6) else (* ; "it's followed by something else -- presumably the close paren -- so put the caret immediately after it") 0))))))
)
(\\copy.structure.new.quote
[LAMBDA (node) (* ; "Edited 27-Jul-87 16:15 by raf")
(replace Structure of node with (LET [(struc (TM::COPY-PREFIX-QUOTE (fetch Structure of node]
(CL:SETF (TM::PREFIX-QUOTE-CONTENTS struc)
(fetch Structure of (\\subnode 1 node)))
struc])
(\\copy.structure.read.time.conditional
(LAMBDA (node) (* ; "Edited 30-Sep-87 13:56 by raf") (replace Structure of node with (CL:FUNCALL (CL:ETYPECASE (fetch Structure of node) (TM::HASH-PLUS (QUOTE TM::COPY-HASH-PLUS)) (TM::HASH-MINUS (QUOTE TM::COPY-HASH-MINUS))) (fetch Structure of node))))
)
(\\create.new.quoted.gap
[LAMBDA (gap context quote.type) (* ; "Edited 27-Jul-87 16:15 by raf")
(* ;;; "Create a new quote structure with a gap in it, and the node to represent it.")
(LET* [(gap.node (\\create.gap.node gap))
(quote.node (create EditNode NodeType ← \\type.new.quote Structure ←
(TM::MAKE-PREFIX-QUOTE :TYPE quote.type :PREFIX
(fetch (StringItem String)
of
(LISTGET (fetch QuoteString of (fetch Environment of
context))
quote.type))
:CONTENTS gap)
SubNodes ← (LIST 1 gap.node)
Unassigned ← (LISTGET (fetch QuoteString of (fetch Environment of
context))
quote.type]
(replace SuperNode of gap.node with quote.node)
(replace SubNodeIndex of gap.node with 1)
(replace SelfLink of quote.node with (create WeakLink Destination ← quote.node))
(replace LinearForm of quote.node with (fetch SelfLink of quote.node))
(\\note.change quote.node context)
quote.node])
(\\degrade.comment
(LAMBDA (context node) (* ; "Edited 18-Sep-87 19:09 by raf") (RPLACA (CDR (fetch Structure of node)) (CAR (NTH \\comment.markers (add (fetch Unassigned of node) -1)))) (\\note.change node context) (if (fetch SuperNode of (fetch SuperNode of node)) then (* ; "this node has a supernode that is not the root") (\\note.change (fetch SuperNode of node) context)) (\\undo.by \\upgrade.comment node))
)
(\\delete.read.time.conditional
(LAMBDA (node context start end set.point?) (* ; "Edited 1-Oct-87 16:33 by raf") (* ;; "Replace any deleted subnodes with gaps, since this is a fixed length object.") (if (NOT (SMALLP start)) then (SETQ start (fetch SubNodeIndex of start)) (SETQ end start)) (\\replace.read.time.conditional node context start end (for i from start to end collect (\\create.gap.node \\basic.gap))) (if set.point? then (\\set.selection.me (fetch Selection of context) context (\\subnode end node)) (\\pending.delete set.point? (fetch Selection of context))) T)
)
(\\initialize.commonlisp
(LAMBDA NIL (* ; "Edited 1-Oct-87 11:04 by raf") "Creates SEdit nodes for Common Lisp presentation types. Fully re-entrant." (* ;; "Hash o, x, b, comma, and dot are handled with a variant of the existing quote node. Hash vertical bar, plus, minus, and star are more or less new types.") (LET ((PLIST (fetch (EditENV ParseInfo) of \\lisp.edit.environment))) (MAPC (QUOTE ((TM::HASH-B . \\parse..new.quote) (TM::HASH-COMMA . \\parse..new.quote) (TM::HASH-DOT . \\parse..new.quote) (TM::HASH-O . \\parse..new.quote) (TM::HASH-X . \\parse..new.quote) (TM::HASH-MINUS . \\parse..conditional.read) (TM::HASH-PLUS . \\parse..conditional.read))) (FUNCTION (LAMBDA (CELL) (LISTPUT PLIST (CAR CELL) (CDR CELL)))))) (LET ((PLIST (fetch (EditENV QuoteString) of \\lisp.edit.environment)) (FONT (fetch (EditENV DefaultFont) of \\lisp.edit.environment))) (MAPC (LIST (CONS :HASH-DOT (\\create.string.item "#." FONT)) (CONS :HASH-COMMA (\\create.string.item "#," FONT)) (CONS :HASH-O (\\create.string.item "#o" FONT)) (CONS :HASH-X (\\create.string.item "#x" FONT)) (CONS :HASH-B (\\create.string.item "#b" FONT)) (CONS :HASH (\\create.string.item "#" FONT))) (FUNCTION (LAMBDA (CELL) (LISTPUT PLIST (CAR CELL) (CDR CELL)))))) (* ;;; "Fix comments to allow 4 semicolon and balanced (hash bar) comments.") (if (NOT (FMEMB (QUOTE %|) (fetch (EditENV CommentString) of \\lisp.edit.environment))) then (LET ((FONT (fetch (EditENV CommentFont) of \\lisp.edit.environment))) (replace (EditENV CommentString) of \\lisp.edit.environment with (LIST 1 (\\create.string.item ";" FONT) 2 (\\create.string.item ";;" FONT) 3 (\\create.string.item ";;;" FONT) 4 (\\create.string.item ";;;;" FONT) 5 (\\create.string.item "#|" FONT))))) (SETQ \\type.new.quote (create EditNodeType using \\type.root Name ← (QUOTE new.quote) ComputeFormatValues ← (QUOTE \\cfv.quote) Linearize ← (QUOTE \\linearize.quote) SubNodeChanged ← (QUOTE \\subnode.changed.new.quote) SetPoint ← (QUOTE \\set.point.quote) SetSelection ← (QUOTE \\set.selection.quote) GrowSelection ← (QUOTE \\grow.selection.default) Insert ← (QUOTE \\replace.new.quote) Delete ← (QUOTE \\delete.quote) CopyStructure ← (QUOTE \\copy.structure.new.quote) CopySelection ← (QUOTE \\copy.selection.default) Stringify ← (QUOTE \\stringify.quote) BackSpace ← (QUOTE \\backspace.quote))) (SETQ \\type.read.time.conditional (create EditNodeType using \\type.root Name ← (QUOTE read.time.conditional) ComputeFormatValues ← (QUOTE \\cfv.read.time.conditional) ReParse ← (QUOTE HELP) Linearize ← (QUOTE \\linearize.read.time.conditional) SubNodeChanged ← (QUOTE \\subnode.changed.read.time.conditional) ComputePointPosition ← (QUOTE \\compute.point.position.read.time.conditional) ComputeSelectionPosition ← (QUOTE \\compute.selection.position.default) SetPoint ← (QUOTE \\set.point.read.time.conditional) SetSelection ← (QUOTE \\set.selection.read.time.conditional) GrowSelection ← (QUOTE \\grow.selection.default) Insert ← (QUOTE \\insert.read.time.conditional) Delete ← (QUOTE \\delete.read.time.conditional) CopyStructure ← (QUOTE \\copy.structure.read.time.conditional) CopySelection ← (QUOTE \\copy.selection.default) Stringify ← (QUOTE \\stringify.read.time.conditional) BackSpace ← (QUOTE \\backspace.read.time.conditional))) (LET ((inserted.nq NIL) (inserted.rtc NIL)) (for typetail on \\types do (if (EQ (fetch Name of \\type.new.quote) (fetch Name of (CAR typetail))) then (SETQ inserted.nq T) (RPLACA typetail \\type.new.quote) elseif (EQ (fetch Name of \\type.read.time.conditional) (fetch Name of (CAR typetail))) then (SETQ inserted.rtc T) (RPLACA typetail \\type.read.time.conditional))) (if (NOT inserted.nq) then (SETQ \\types (LIST* \\type.new.quote \\types))) (if (NOT inserted.rtc) then (SETQ \\types (LIST* \\type.read.time.conditional \\types)))) (* ;; "Commands which enter the hash objects (very hard to do this right).") (LET ((commands (\\create.command.table (APPEND (QUOTE (((\\input.new.quote :HASH-DOT) NIL 3) ((\\input.new.quote :HASH-COMMA) NIL 6) ((\\input.new.quote :HASH-O) NIL 9) ((\\input.new.quote :HASH-X) NIL 10) ((\\input.new.quote :HASH-B) NIL 11) ((\\input.conditional.read :HASH-PLUS) NIL 18) ((\\input.conditional.read :HASH-MINUS) NIL 14) (\\input.bit.vector NIL 17))) \\command.table.spec)))) (replace (EditENV CommandTable) of \\lisp.edit.environment with (CAR commands)) (replace (EditENV HelpMenu) of \\lisp.edit.environment with (CADR commands))) T)
)
(\\input.bit.vector
[LAMBDA (context charcode type) (* ; "Edited 15-Jul-87 16:32 by raf")
(HELP "Unimplemented"])
(\\input.conditional.read
[LAMBDA (context charcode type) (* ; "Edited 15-Jul-87 16:32 by raf")
(HELP "Unimplemented"])
(\\input.new.quote
[LAMBDA (context charcode quote.type) (* ; "Edited 15-Jul-87 17:53 by raf")
(* ;;; "Control character command to insert a new quote type with gap.")
(SELECTQ (\\type.of.input context)
(Structure (* ; "If we're structure pointing (between the hairs of the universe) a new quote object is made and inserted.")
(\\close.open.node context)
(\\insert.new.quoted.gap context charcode quote.type))
(Atom (* ; "If we're pointing somewhere random inside of a structure we'll just call the default character handler. Not great, but a fine failsafe.")
(APPLY* (fetch DefaultCharHandler of (fetch Environment of context))
context charcode))
NIL])
(\\insert.new.quoted.gap
[LAMBDA (context charcode quote.type) (* ; "Edited 15-Jul-87 18:01 by raf")
(* ;
"implements the ' command: insert a quoted gap")
(if (EQ (\\type.of.input context)
'Structure)
then
(LET ((selection (fetch Selection of context))
(point (fetch CaretPoint of context))
new.quote gap)
(SETQ new.quote (\\create.new.quoted.gap \\basic.gap context quote.type))
(SETQ gap (\\subnode 1 new.quote)) (* ;
"we get our hands on the gap node now, to handle the case where the insert reparses the new.quote")
(\\insert (fetch CaretPoint of context)
context
(LIST new.quote))
(if (NOT (\\dead.node? new.quote))
then
(\\set.selection.me selection context gap)
(\\pending.delete point selection))) (* ;
"must return non-NIL if command executed")
T])
(\\insert.read.time.conditional
(LAMBDA (node context where subnodes point) (* ; "Edited 1-Oct-87 11:05 by raf") (LET (start end) (if (type? EditSelection where) then (SETQ start (fetch SelectStart of where)) (SETQ end (OR (fetch SelectEnd of where) start)) elseif (type? EditPoint where) then (SETQ end (fetch PointIndex of where)) (SETQ start (ADD1 end)) else (SETQ start (fetch SubNodeIndex of where)) (SETQ end start)) (\\replace.read.time.conditional node context start end subnodes point)))
)
(\\linearize.clisp
(LAMBDA (node context index) (* ; "Edited 21-Sep-87 11:45 by raf") (* ;; "the Linearize method for clisp expressions. the variable ok keeps track of our state: (NIL: next item starts a new line) (T: next item stays on this line) (check: next item goes on this line if it fits) (atom: next item goes on this line if it fits and is an atom)") (* ;; "the formatting rules are that (1) keywords not on \\clisp.indent.words always start new lines (2) always start a new line after anything non-atomic (3) non-atomic things can only follow keywords on the same line (4) \\clisp.indent.words can go on the same line as the preceding material if they're the last thing in the expression or followed by another keyword or by something that will fit inline on the same line (5) if \\clisp.indent.words start a new line they are indented by the minimum indentation (6) if anything else starts a new line it is indented by the width of the most recent keyword to start a line, plus one blank") (* ;; "at present, if keywords always start new lines. this could be improved with a little more smarts") (bind indent comment.start.x comment.indent comment? program.word? (keyword? ← T) (second.subnode ← T) (ok ← T) (space.width ← (fetch SpaceWidth of (fetch Environment of context))) (min.indent ← (IPLUS (fetch StartX of node) (fetch MinIndent of (fetch Environment of context)))) (paren.width ← (fetch Width of (fetch LParenString of (fetch Environment of context)))) first (if index then (SETQ index (AND (NEQ index 1) (SUB1 index))) else (* ;; "start with an open paren and the first subnode (which should be a keyword) since system won't recognize clisp if first subnode is comment, don't have to handle that case here. it will be formatted as a form.") (\\output.constant.string context (fetch LParenString of (fetch Environment of context))) (\\linearize (CADR (fetch SubNodes of node)) context)) (* ;; "set indentation to one blank after the end of the keyword") (SETQ indent (IPLUS (fetch StartX of node) paren.width (fetch InlineWidth of (CADR (fetch SubNodes of node))) space.width)) (\\set.comment.positions comment.start.x comment.indent indent paren.width node context) for subnode in (CDDR (fetch SubNodes of node)) do (if index then (* ;; "we don't actually linearize this subnode, but need to update our state as if we had") (SETQ index (AND (NEQ index 1) (SUB1 index))) (if (SETQ comment? (EQ (fetch NodeType of subnode) \\type.comment)) then (* ;; "this is a comment, so the next guy must start a new line. if following the first keyword, change indent to min.indent") (SETQ ok NIL) (if second.subnode then (SETQ indent min.indent)) elseif (SETQ keyword? (EQ (fetch ParseMode of subnode) (QUOTE KeyWord))) then (* ; "this is a keyword. is it the first thing on this line?") (if (EQ subnode (CADR (MEMB (fetch LastLine of subnode) (fetch LinearForm of node)))) then (* test used to be EQ subnode (CADR (fetch LastLineLinear of subnode))) (* ; "yep. set the indentation to be one blank after the end of it") (SETQ indent (IPLUS (fetch StartX of subnode) (fetch InlineWidth of subnode) space.width)) (* ; "and the next thing goes on this line") (SETQ ok T) else (* ; "the next thing goes on this line if it fits") (SETQ ok (QUOTE check))) else (* ; "the next thing can go on this line if i'm atomic, and it's atomic too") (SETQ ok (AND (ATOM (fetch Structure of subnode)) (QUOTE atom)))) else (* ; "we really are linearizing this subnode") (if (SETQ comment? (EQ (fetch NodeType of subnode) \\type.comment)) then (if (OR (NEQ (fetch Unassigned of subnode) 1) (IGREATERP (fetch CurrentX of context) comment.start.x)) then (\\output.cr context (\\select.comment.indent (fetch Unassigned of subnode) comment.indent indent (fetch StartX of (fetch Root of context)))) else (\\output.space context (IDIFFERENCE comment.indent (fetch CurrentX of context)))) (SETQ ok NIL) (if second.subnode then (SETQ indent min.indent)) elseif (SETQ keyword? (EQ (fetch ParseMode of subnode) (QUOTE KeyWord))) then (* ; "we've got a keyword") (SETQ program.word? (FMEMB (CDR (GETPROP (fetch Structure of subnode) (QUOTE CLISPWORD))) \\clisp.program.words)) (if (FMEMB (CDR (GETPROP (fetch Structure of subnode) (QUOTE CLISPWORD))) \\clisp.indent.words) then (* ; "perhaps it can go on this line") (if (AND ok (NEQ (fetch Unassigned of node) (QUOTE IFWORD)) (ILEQ (IPLUS (fetch CurrentX of context) space.width (fetch InlineWidth of subnode) (if (AND (CDR $$LST1) (NEQ (fetch ParseMode of (CADR $$LST1)) (QUOTE KeyWord))) then (IPLUS space.width (OR (fetch InlineWidth of (CADR $$LST1)) (fetch RightMargin of node))) else 0)) (fetch RightMargin of node))) then (* ; "it'll go on this line") (\\output.space context space.width) (SETQ ok (QUOTE check)) else (* ; "new line, indented by minimum indentation") (\\output.cr context min.indent) (SETQ indent (IPLUS min.indent (fetch InlineWidth of subnode) space.width)) (SETQ ok T)) else (* ; "new line, no indentation") (\\output.cr context (IPLUS (fetch StartX of node) paren.width)) (SETQ indent (IPLUS (fetch StartX of node) paren.width (fetch InlineWidth of subnode) space.width)) (SETQ ok T)) else (if (OR (EQ ok T) (AND ok (fetch InlineWidth of subnode) (ILEQ (IPLUS (fetch CurrentX of context) space.width (fetch InlineWidth of subnode)) (fetch RightMargin of node)) (OR (EQ ok (QUOTE check)) (ATOM (fetch Structure of subnode))))) then (\\output.space context space.width) else (\\output.cr context indent)) (SETQ ok (QUOTE atom))) (\\linearize subnode context) (if (AND (EQ ok (QUOTE atom)) (NOT (fetch Inline? of subnode))) then (SETQ ok NIL))) (SETQ second.subnode NIL) finally (if comment? then (\\output.cr context (IPLUS (fetch StartX of node) paren.width)))) (if index then (SHOULDNT "linearize index out of range")) (\\output.constant.string context (fetch RParenString of (fetch Environment of context))))
)
(\\linearize.comment
(LAMBDA (node context index) (* ; "Edited 20-Sep-87 18:18 by raf") (LET* ((level (fetch Unassigned of node)) (prefix (LISTGET (fetch CommentString of (fetch Environment of context)) level))) (bind (first ← T) for subnode in (if index then (CDDR (NTH (fetch SubNodes of node) index)) else (* we're at the beginning, so display the prefix) (\\output.constant.string context prefix) (CDR (fetch SubNodes of node))) do (if (OR first (ILEQ (IPLUS (fetch CurrentX of context) (fetch InlineWidth of subnode)) (fetch RightMargin of node))) then (\\linearize subnode context) else (\\output.cr context (fetch StartX of node)) (if (NOT (EQ 5 level)) then (\\output.constant.string context prefix)) (\\linearize subnode context)) (SETQ first NIL)) (if (EQ 5 level) then (\\output.constant.string context \\level5.comment.close.string))))
)
(\\linearize.form
(LAMBDA (node context index) (* ; "Edited 20-Sep-87 18:11 by raf") (* ; "the linearize method for forms") (if (NOT index) then (\\output.constant.string context (fetch LParenString of (fetch Environment of context)))) (if (CDR (fetch SubNodes of node)) then (bind (same.line? ← T) (space.width ← (fetch SpaceWidth of (fetch Environment of context))) (paren.width ← (fetch Width of (fetch LParenString of (fetch Environment of context)))) (first.subnode ← T) indent last.comment.level comment.start.x comment.indent line.skip first (SETQ indent (IPLUS (fetch StartX of node) (if (NOT (ATOM (fetch Structure of (CADR (fetch SubNodes of node))))) then (* ;; "this will handle the case of comment first, too, like in COMS. it will be ugly for comment at beginning of function call, but who cares.") paren.width elseif (ILEQ (IPLUS (fetch StartX of node) (fetch PreferredWidth of node)) (fetch RightMargin of node)) then (OR (fetch Unassigned of node) 0) else (fetch MinIndent of (fetch Environment of context))))) (\\set.comment.positions comment.start.x comment.indent (IPLUS paren.width (fetch StartX of node)) paren.width node context) for subnode in (CDR (fetch SubNodes of node)) do (if (EQ (fetch NodeType of subnode) \\type.comment) then (if index then (SETQ index (AND (NEQ index 1) (SUB1 index))) else (if (EQ last.comment.level (fetch Unassigned of subnode)) then (* ;; "we're following a comment of the same level. force a cr and extra line space") (\\output.cr context (\\select.comment.indent (fetch Unassigned of subnode) comment.indent indent (fetch StartX of (fetch Root of context))) 8) elseif (AND first.subnode (NEQ (fetch Unassigned of subnode) 1)) then (* ;; "dont' have to move at all") elseif (OR first.subnode (AND (EQ (fetch Unassigned of subnode) 1) same.line? (ILEQ (fetch CurrentX of context) comment.start.x))) then (* ;; "just space if first subnode or its a single semi comment that will fit") (\\output.space context (IDIFFERENCE comment.indent (fetch CurrentX of context))) else (\\output.cr context (\\select.comment.indent (fetch Unassigned of subnode) comment.indent indent (fetch StartX of (fetch Root of context))))) (\\linearize subnode context)) (SETQ same.line? NIL) (SETQ last.comment.level (fetch Unassigned of subnode)) else (if index then NIL elseif first.subnode then (if (NOT same.line?) then (\\output.cr context (IPLUS paren.width (fetch StartX of node)))) else (if (AND same.line? (NEQ same.line? (QUOTE paren)) (LEQ (IPLUS (fetch CurrentX of context) space.width) indent)) then (* ; "we're to the left of the indentation tab, so just space enough to get there") (\\output.space context (IDIFFERENCE indent (fetch CurrentX of context))) elseif (AND same.line? (NEQ same.line? (QUOTE paren)) (fetch InlineWidth subnode) (LEQ (IPLUS (fetch CurrentX of context) space.width (fetch InlineWidth subnode) (if (AND (CDR $$LST1) (EQ (fetch NodeType of (CADR $$LST1)) \\type.comment) (EQ (fetch Unassigned of (CADR $$LST1)) 1)) then (fetch PreferredWidth of (CADR $$LST1)) else 0)) (fetch RightMargin of node)) (OR (EQ same.line? T) (ILESSP (CAR (fetch SubNodes of subnode)) 2))) then (* ; "it will fit on this line") (\\output.space context space.width) else (\\output.cr context indent))) (SETQ same.line? (OR (AND (if index then (SETQ index (AND (NEQ index 1) (SUB1 index))) (fetch Inline? of subnode) else (\\linearize subnode context)) (OR (ILESSP (CAR (fetch SubNodes of subnode)) 2) (QUOTE no.lists))) (QUOTE paren))) (SETQ last.comment.level NIL)) (SETQ first.subnode NIL) finally (if (NULL same.line?) then (\\output.cr context (IPLUS paren.width (fetch StartX of node)))))) (if index then (SHOULDNT "linearize index out of range")) (\\output.constant.string context (fetch RParenString of (fetch Environment of context))))
)
(\\linearize.lambda
(LAMBDA (node context index) (* ; "Edited 21-Sep-87 11:52 by raf") (* ;;; "the Linearize method for lambda expressions. the opening keyword and second subnode (the argument list) go on the same line, and everything else is on a separate line indented by the minimum indentation, except for PROG labels which aren't indented. the variable before keeps track of this: it's NIL for the first subnode, space for the second, and cr for all of the remaining subnodes") (if (NOT index) then (\\output.constant.string context (fetch LParenString of (fetch Environment of context)))) (bind (prog? ← (MEMB (fetch Structure of (CADR (fetch SubNodes of node))) (QUOTE (PROG PROG* NIL)))) (indent ← (IPLUS (fetch StartX of node) (fetch MinIndent of (fetch Environment of context)))) (paren.width ← (fetch Width of (fetch LParenString of (fetch Environment of context)))) comment? comment.start.x comment.indent first (\\set.comment.positions comment.start.x comment.indent indent paren.width node context) for subnode in (CDR (fetch SubNodes of node)) as subnode.count from 1 do (SETQ comment? (EQ (fetch NodeType of subnode) \\type.comment)) (if index then (SETQ index (AND (NEQ index 1) (SUB1 index))) else (if comment? then (if (OR (NEQ (fetch Unassigned of subnode) 1) (IGREATERP (fetch CurrentX of context) comment.start.x)) then (\\output.cr context (\\select.comment.indent (fetch Unassigned of subnode) comment.indent indent (fetch StartX of (fetch Root of context)))) else (\\output.space context (IDIFFERENCE comment.indent (fetch CurrentX of context)))) elseif (IGREATERP subnode.count 2) then (* ; "we're past the special cases of lambda keyword and arglist") (\\output.cr context (if (AND prog? (EQ (fetch NodeType of subnode) \\type.litatom)) then (IPLUS (fetch StartX of node) paren.width) else indent)) elseif (EQ subnode.count 2) then (* ; "at the second subnode which is not a comment, so it is the arglist in the proper position") (\\output.space context (fetch SpaceWidth of (fetch Environment of context)))) (* ; "otherwise, we're at first non comment, which must be the lambda keyword, so just linearize it here") (\\linearize subnode context)) finally (if comment? then (\\output.cr context (IPLUS (fetch StartX of node) paren.width)))) (if index then (SHOULDNT "linearize index out of range")) (\\output.constant.string context (fetch RParenString of (fetch Environment of context))))
)
(\\linearize.list
(LAMBDA (node context index) (* ; "Edited 21-Sep-87 11:54 by raf") (* ;; "the Linearize method for vanilla and dotted lists. nothing is indented, non-atomic things go on separate lines, and we put as many atoms on a line as we can fit. the last element of a dotted list is preceded by a dot.") (if (NOT index) then (\\output.constant.string context (fetch LParenString of (fetch Environment of context)))) (if (CDR (fetch SubNodes of node)) then (bind (first.time? ← T) (space.width ← (fetch SpaceWidth of (fetch Environment of context))) (paren.width ← (fetch Width of (fetch LParenString of (fetch Environment of context)))) this.line? needs.dot? comment? comment.start.x comment.indent first (\\set.comment.positions comment.start.x comment.indent paren.width paren.width node context) for subnode in (CDR (fetch SubNodes of node)) do (SETQ comment? (EQ (fetch NodeType of subnode) \\type.comment)) (if index then (SETQ index (AND (NEQ index 1) (SUB1 index))) (if comment? then (\\output.cr context (IPLUS paren.width (fetch StartX of node)))) else (SETQ needs.dot? (AND (EQ (fetch NodeType of node) \\type.dotlist) (NULL (CDR $$LST1)) (IPLUS space.width (fetch Width of (fetch DotString of (fetch Environment of context)))))) (if comment? then (SETQ first.time? NIL) (if (OR (NEQ (fetch Unassigned of subnode) 1) (IGREATERP (fetch CurrentX of context) comment.start.x)) then (\\output.cr context (\\select.comment.indent (fetch Unassigned of subnode) comment.indent (IPLUS paren.width (fetch StartX of node)) (fetch StartX of (fetch Root of context)))) else (\\output.space context (IDIFFERENCE comment.indent (fetch CurrentX of context)))) elseif (AND first.time? (NOT comment?)) then (* ; "first time through, if not a comment, then i'm already in the right place for the first subnode") (SETQ first.time? NIL) elseif (AND this.line? (NULL (CDR (fetch SubNodes of subnode))) (LEQ (IPLUS (fetch CurrentX of context) space.width (fetch InlineWidth subnode) (OR needs.dot? 0)) (fetch RightMargin of node))) then (* ; "the last node said i could go on this line, i'm atomic so i can go on this line, and i will fit") (\\output.space context space.width) else (* ; "somebody forced be to the next line") (\\output.cr context (IPLUS paren.width (fetch StartX of node)))) (if needs.dot? then (\\output.constant.string context (fetch DotString of (fetch Environment of context))) (\\output.space context space.width)) (\\linearize subnode context)) (SETQ this.line? (AND (NOT comment?) (NULL (CDR (fetch SubNodes of subnode))))) finally (if comment? then (\\output.cr context (IPLUS paren.width (fetch StartX of node)))))) (if index then (SHOULDNT "linearize index out of range")) (\\output.constant.string context (fetch RParenString of (fetch Environment of context))))
)
(\\linearize.read.time.conditional
(LAMBDA (node context right.margin) (* ; "Edited 30-Sep-87 16:26 by raf") (LET ((hash (LISTGET (fetch QuoteString of (fetch Environment of context)) :HASH)) (sign (CADR (fetch SubNodes of node))) (feature (CADDR (fetch SubNodes of node))) (form (CADDDR (fetch SubNodes of node)))) (\\output.constant.string context hash) (\\linearize sign context right.margin) (\\linearize feature context right.margin) (\\linearize form context right.margin)))
)
(\\parse..bit.vector
[LAMBDA (structure context mode) (* ; "Edited 15-Jul-87 16:29 by raf")
(HELP "Unimplemented"])
(\\parse..comment
(LAMBDA (structure context) (* ; "Edited 18-Sep-87 18:59 by raf") (* ;; "try to parse this list as a common lisp comment. the second element should be one or more semicolons, and the rest of the list should be a string") (LET (comment.words (level (AND (CDR structure) (LISTGET \\comment.level.table (CADR structure))))) (if (AND level (CDDR structure) (NULL (CDDDR structure)) (STRINGP (CADDR structure)) (OR (NULL (fetch CurrentNode of context)) (FMEMB (fetch Name of (fetch NodeType of (fetch CurrentNode of context))) (QUOTE (form clisp lambda list))))) then (\\build.node structure context \\type.comment NIL T) (if (NOT (fetch \X of context)) then (* ;; "we're here for the first time (not a reparse) so go ahead. otherwize lie and say that everything matched. we do this because comment words are kept in lists in the comment subnodes. parsing conses these lists anew each time, so reparsing a comment that hadn't changed would think that it *had* changed because of the new lists. so hack this to avoid lots of relinearizing comments.") (SETQ comment.words (\\parse.string.into.words (CADDR structure))) (for word in comment.words do (\\parse word context (QUOTE CommentWord))) (for subnode in (CDR (fetch SubNodes of (fetch CurrentNode of context))) as wordptr on comment.words do (replace Structure of subnode with wordptr)) (replace Unassigned of (fetch CurrentNode of context) with level) else (* ;; "flag that everything matched.") (replace \X of context with NIL)) T)))
)
(\\parse..conditional.read
(LAMBDA (structure context mode) (* ; "Edited 30-Sep-87 16:21 by raf") (if (TM::READ-TIME-CONDITIONAL-P structure) then (\\build.node structure context \\type.read.time.conditional) (replace Unassigned of (fetch CurrentNode of context) with (TM::READ-TIME-CONDITIONAL-UNREAD-P structure)) (\\parse (CL:ETYPECASE structure (TM::HASH-PLUS (QUOTE +)) (TM::HASH-MINUS (QUOTE -))) context NIL) (\\parse (TM::READ-TIME-CONDITIONAL-FEATURE structure) context NIL) (\\parse (TM::READ-TIME-CONDITIONAL-FORM structure) context NIL) T))
)
(\\parse..new.quote
[LAMBDA (structure context mode) (* ; "Edited 27-Jul-87 16:19 by raf")
(if (AND (OR (NULL mode)
(EQ mode 'Data))
(TM::PREFIX-QUOTE-CONTENTS structure))
then
(\\build.node structure context \\type.new.quote)
(replace Unassigned of (fetch CurrentNode of context)
with
(LISTGET (fetch QuoteString of (fetch Environment of context))
(TM::PREFIX-QUOTE-TYPE structure)))
(\\parse (TM::PREFIX-QUOTE-CONTENTS structure)
context NIL)
T])
(\\replace.new.quote
[LAMBDA (node context where subnodes point) (* ; "Edited 27-Jul-87 16:20 by raf")
(LET ((subnode (CAR subnodes)))
(if (NOT (OR (AND (type? EditSelection where)
(EQ (fetch SelectStart of where)
1)
(EQ (fetch SelectEnd of where)
1))
(type? EditNode where)))
then
(SHOULDNT "weird bounds for replace.quote"))
(\\undo.by \\undo.replace.quote node (\\subnode 1 node))
(\\kill.node (\\subnode 1 node))
(RPLACA (CDR (fetch SubNodes of node))
subnode)
(replace SuperNode of subnode with node)
(replace SubNodeIndex of subnode with 1)
(CL:SETF (TM::PREFIX-QUOTE-CONTENTS (fetch Structure of node))
(fetch Structure of subnode))
(\\set.depth subnode (ADD1 (fetch Depth of node)))
(\\note.change node context)
(if point then (\\punt.set.point point context node T))
(CDR subnodes])
(\\replace.read.time.conditional
(LAMBDA (node context start end subnodes point) (* ; "Edited 1-Oct-87 17:05 by raf") (\\undo.by \\undo.replace.read.time.conditional node (for i from start to end collect (\\subnode i node))) (for i from start to end as subnode in subnodes as smashnode on (NTH (CDR (fetch SubNodes of node)) start) do (* ;; "Update the EditNode itself.") (\\kill.node (\\subnode i node)) (RPLACA smashnode subnode) (replace SuperNode of subnode with node) (replace SubNodeIndex of subnode with i) (\\set.depth subnode (ADD1 (fetch Depth of node))) (\\subnode.changed subnode context) (* ; "Updates the data underlying this EditNode.")) (\\note.change node context) (if point then (\\punt.set.point point context node T)) NIL)
)
(\\set.point.read.time.conditional
(LAMBDA (point context node index offset item type compute.location?) (* ; "Edited 1-Oct-87 17:33 by raf") (if (type? StringItem item) then (* ; "pointing to the HASH.") (SETQ offset (ILESSP offset (HALF (fetch Width of item)))) elseif (type? EditNode item) then (SETQ type (QUOTE Structure))) (if (NULL index) then (\\punt.set.point point context node offset compute.location?) else (if (AND (EQ type (QUOTE Atom)) (NEQ index 0) (ILEQ index 3)) then (\\set.point point context (\\subnode index node) NIL offset NIL (QUOTE Atom) compute.location?) elseif (EQ index 3) then (* ; "can't insert structure after the last item") (\\set.point.nowhere point) else (replace PointNode of point with node) (replace PointIndex of point with (if offset then index else (SETQ index (SUB1 index)))) (replace PointType of point with (QUOTE Structure)) (if compute.location? then (\\compute.point.position.read.time.conditional point context)))))
)
(\\set.selection.read.time.conditional
(LAMBDA (selection context node index offset item type) (* ; "Edited 30-Sep-87 13:37 by raf") (* ;; "Pointing to the hash selects the whole read.time.conditional.") (\\set.selection.me selection context node))
)
(\\split.comment
(LAMBDA (node point context start) (* ; "Edited 18-Sep-87 19:10 by raf") (\\close.open.node context) (LET* ((comment (CADDR (fetch Structure of node))) (length (NCHARS comment)) (split.string (SUBSTRING comment (ADD1 start) length))) (\\set.point point context (fetch SuperNode of node) (fetch SubNodeIndex of node) T node (QUOTE Structure)) (if (NEQ start length) then (* ; "split in middle of comment.") (\\delete node context (ADD1 start) length NIL comment) (\\insert point context (\\parse.new (LIST (QUOTE *) (CAR (NTH \\comment.markers (fetch Unassigned of node))) split.string) context)) (\\set.point point context (fetch SuperNode of node) (fetch SubNodeIndex of node) T node (QUOTE Structure)))))
)
(\\stringify.comment
(LAMBDA (node environment) (* ; "Edited 29-Sep-87 13:48 by raf") (LET ((level (fetch Unassigned of node))) (if (ILESSP level 4) then (CONCAT (CADR (fetch Structure of node)) " " (CADDR (fetch Structure of node))) elseif (EQ level 4) then (CONCAT \\level4.comment " " (CADDR (fetch Structure of node))) else (CONCAT "#|" (CADDR (fetch Structure of node)) "|#"))))
)
(\\stringify.new.quote
[LAMBDA NIL (* ; "Edited 27-Jul-87 16:20 by raf")
NIL])
(\\stringify.read.time.conditional
(LAMBDA (node environment) (* ; "Edited 30-Sep-87 13:55 by raf") (LET ((structure (fetch Structure of node))) (CONCAT (LET ((*PACKAGE* *KEYWORD-PACKAGE*)) (CL:FORMAT NIL "#~a~s" (CL:ETYPECASE structure (TM::HASH-PLUS "+") (TM::HASH-MINUS "-")) (TM::READ-TIME-CONDITIONAL-FEATURE structure))) (if (TM::READ-TIME-CONDITIONAL-UNREAD-P structure) then (TM::READ-TIME-CONDITIONAL-FORM structure) else (CL:FORMAT NIL "~S" (TM::READ-TIME-CONDITIONAL-FORM structure))))))
)
(\\subnode.changed.new.quote
[LAMBDA (node subnode) (* ; "Edited 27-Jul-87 16:20 by raf")
(CL:SETF (TM::PREFIX-QUOTE-CONTENTS (fetch Structure of node))
(fetch Structure of subnode])
(\\subnode.changed.read.time.conditional
(LAMBDA (node subnode context) (* ; "Edited 2-Oct-87 15:25 by raf") (LET ((subnode.structure (fetch Structure of subnode)) (node.structure (fetch Structure of node))) (SELECTQ (fetch SubNodeIndex of subnode) (1 (if (SELECTQ subnode.structure (+ (TM::HASH-MINUS-P node.structure)) (- (TM::HASH-PLUS-P node.structure)) (HELP "Bad read time conditional polarity")) then (* ; "We've changed the polarity of this conditional read, need to make new structure and copy the old fields into it.") (replace Structure of node with (CL:FUNCALL (SELECTQ subnode.structure (+ (QUOTE TM::MAKE-HASH-PLUS)) (- (QUOTE TM::MAKE-HASH-MINUS)) NIL) :UNREAD-P (TM::READ-TIME-CONDITIONAL-UNREAD-P node.structure) :FEATURE (TM::READ-TIME-CONDITIONAL-FEATURE node.structure) :FORM (TM::READ-TIME-CONDITIONAL-FORM node.structure))) (\\unread.read.time.conditional? node context) (* ; "Check whether the %"read-ness%" of the conditional read has changed (according to the features list and the polarity of the conditional read).") (\\subnode.changed node context))) (2 (CL:SETF (TM::READ-TIME-CONDITIONAL-FEATURE node.structure) subnode.structure) (\\unread.read.time.conditional? node context)) (3 (CL:SETF (TM::READ-TIME-CONDITIONAL-FORM node.structure) subnode.structure)) (SHOULDNT "Bad subnode index"))))
)
(\\undo.replace.read.time.conditional
(LAMBDA (context node old.subnodes) (* ; "Edited 30-Sep-87 14:44 by raf") (\\replace.read.time.conditional node context (fetch SubNodeIndex of (CAR old.subnodes)) (fetch SubNodeIndex of (CAR (LAST old.subnodes))) old.subnodes NIL))
)
(\\unread.read.time.conditional?
(LAMBDA (node context) (* ; "Edited 2-Oct-87 18:07 by raf") (* ;;; "If the conditional.read doesn't match the %"unread-ness%" of the features (as indicated by its UNREAD-P flag), then return the converted form.") (LET* ((conditional.read (fetch Structure of node)) (unread (TM::READ-TIME-CONDITIONAL-UNREAD-P conditional.read)) (read-p (CMLREAD.FEATURE.PARSER (TM::READ-TIME-CONDITIONAL-FEATURE conditional.read)))) (if (TM::HASH-MINUS-P conditional.read) then (SETQ read-p (NOT read-p))) (if (AND unread read-p) then (* ; "Flag says currently UNREAD, features say now READ, try to read string into structure.") (CL:WITH-INPUT-FROM-STRING (s (TM::READ-TIME-CONDITIONAL-FORM conditional.read)) (LET ((form (NLSETQ (CL:READ s)))) (if form then (\\replace.read.time.conditional node context 3 3 (LIST (\\parse.new form context))) (CL:SETF (TM::READ-TIME-CONDITIONAL-UNREAD-P conditional.read) NIL) else (printout (\\get.prompt.window context) T "Error during read. Not unread.")))) elseif (AND (NOT unread) (NOT read-p)) then (* ; "Flag says currently READ, features say now UNREAD, print structure into string.") (\\replace.read.time.conditional node context 3 3 (LIST (\\parse.new (CL:FORMAT NIL "~s" (TM::READ-TIME-CONDITIONAL-FORM conditional.read)) context))) (CL:SETF (TM::READ-TIME-CONDITIONAL-UNREAD-P conditional.read) T))))
)
(\\upgrade.comment
(LAMBDA (context node) (* ; "Edited 18-Sep-87 18:48 by raf") (if (ILESSP (fetch Unassigned of node) (LENGTH \\comment.markers)) then (RPLACA (CDR (fetch Structure of node)) (CAR (NTH \\comment.markers (add (fetch Unassigned of node) 1)))) (\\note.change node context) (if (fetch SuperNode of (fetch SuperNode of node)) then (* ; "this node has a supernode that is not the root") (\\note.change (fetch SuperNode of node) context)) (\\undo.by \\degrade.comment node)))
)
)
(\\initialize.commonlisp)
(PUTPROPS SEDIT-COMMONLISP MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE (LET ((*PACKAGE* *PACKAGE*)) (CL:IN-PACKAGE "INTERLISP") (FILESLOAD TEXTMODULES) *PACKAGE*) :BASE 10)
)
(PUTPROPS SEDIT-COMMONLISP COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (5096 63658 (PRIN2-LONG-STRING 5106 . 11058) (SEMI-COLON-COMMENT-P 11060 . 11480) (
SUPERPRINT/COMMENT 11482 . 13870) (\\backspace.read.time.conditional 13872 . 14801) (\\cfv.clisp 14803
. 17469) (\\cfv.comment 17471 . 18530) (\\cfv.form 18532 . 21174) (\\cfv.lambda 21176 . 23476) (
\\cfv.read.time.conditional 23478 . 24195) (\\compute.point.position.read.time.conditional 24197 .
25248) (\\copy.structure.new.quote 25250 . 25709) (\\copy.structure.read.time.conditional 25711 .
26011) (\\create.new.quoted.gap 26013 . 27521) (\\degrade.comment 27523 . 27942) (
\\delete.read.time.conditional 27944 . 28525) (\\initialize.commonlisp 28527 . 32974) (
\\input.bit.vector 32976 . 33135) (\\input.conditional.read 33137 . 33302) (\\input.new.quote 33304 .
34203) (\\insert.new.quoted.gap 34205 . 35440) (\\insert.read.time.conditional 35442 . 35945) (
\\linearize.clisp 35947 . 41825) (\\linearize.comment 41827 . 42680) (\\linearize.form 42682 . 46477)
(\\linearize.lambda 46479 . 48902) (\\linearize.list 48904 . 51699) (\\linearize.read.time.conditional
51701 . 52187) (\\parse..bit.vector 52189 . 52349) (\\parse..comment 52351 . 53863) (
\\parse..conditional.read 53865 . 54423) (\\parse..new.quote 54425 . 55055) (\\replace.new.quote 55057
. 56177) (\\replace.read.time.conditional 56179 . 56928) (\\set.point.read.time.conditional 56930 .
57902) (\\set.selection.read.time.conditional 57904 . 58158) (\\split.comment 58160 . 58889) (
\\stringify.comment 58891 . 59280) (\\stringify.new.quote 59282 . 59426) (
\\stringify.read.time.conditional 59428 . 59932) (\\subnode.changed.new.quote 59934 . 60182) (
\\subnode.changed.read.time.conditional 60184 . 61513) (\\undo.replace.read.time.conditional 61515 .
61790) (\\unread.read.time.conditional? 61792 . 63163) (\\upgrade.comment 63165 . 63656)))))
STOP