(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE SEDIT (USE LISP XCL))) (IL:FILECREATED "17-May-90 11:10:05" IL:|{DSK}local>lde>lispcore>sources>SEDIT-LISTS.;2| 118946 IL:|changes| IL:|to:| (IL:VARS IL:SEDIT-LISTSCOMS) IL:|previous| IL:|date:| "14-Jun-88 21:42:26" IL:|{DSK}local>lde>lispcore>sources>SEDIT-LISTS.;1|) ; Copyright (c) 1986, 1987, 1988, 1990 by Venue & Xerox Corporation. All rights reserved. (IL:PRETTYCOMPRINT IL:SEDIT-LISTSCOMS) (IL:RPAQQ IL:SEDIT-LISTSCOMS ((IL:PROP IL:FILETYPE IL:SEDIT-LISTS) (IL:PROP IL:MAKEFILE-ENVIRONMENT IL:SEDIT-LISTS) (IL:DECLARE\: IL:DONTCOPY IL:DOEVAL@COMPILE (IL:FILES IL:SEDIT-DECLS) (IL:LOCALVARS . T)) (IL:VARIABLES *FORMAT-ALIAS-DEPTH-LIMIT* *WRAP-PARENS* INTERNAL-WRAPPERS) (IL:VARS (LIST-PARSE-INFO '(QUOTE PARSE--QUOTE IL:BQUOTE PARSE--QUOTE IL:\\\, PARSE--QUOTE IL:\\\,@ PARSE--QUOTE IL:\\\,. PARSE--QUOTE FUNCTION PARSE--QUOTE IL:* PARSE--COMMENT)) (CLISP-INDENT-WORDS '(IL:THEN IL:|then| IL:ELSE IL:|else| IL:OF IL:|of| IL:WITH IL:|with| IL:IN IL:|in| IL:INSTRING IL:|instring| IL:FROM IL:|from| IL:ON IL:|on| IL:TO IL:|to| IL:BY IL:|by| IL:OLD IL:|old| IL:INSIDE IL:|inside| IL:OUTOF IL:|outof|)) (CLISP-PROGRAM-WORDS '(IL:THEN IL:|then| IL:ELSE IL:|else| IL:DO IL:|do| IL:COLLECT IL:|collect| IL:JOIN IL:|join| IL:SUM IL:|sum| IL:COUNT IL:|count| IL:ALWAYS IL:|always| IL:NEVER IL:|never| IL:THEREIS IL:|thereis| IL:LARGEST IL:|largest| IL:SMALLEST IL:|smallest|))) (IL:FNS ASSIGN-FORMAT-CLISP ASSIGN-FORMAT-DOTLIST ASSIGN-FORMAT-LIST ASSIGN-FORMAT-QUOTE BACKSPACE-LIST BACKSPACE-QUOTE CFV-CLISP CFV-DOTLIST CFV-LIST CFV-QUOTE CLOSE-LIST COMPUTE-POINT-POSITION-LIST COPY-STRUCTURE-LIST COPY-STRUCTURE-QUOTE CREATE-NULL-LIST CREATE-QUOTED-GAP DELETE-LIST DELETE-QUOTE DOT-THIS-LIST GET-LIST-FORMAT INITIALIZE-LISTS INSERT-LIST INSERT-NULL-LIST INSERT-QUOTED-GAP LINEARIZE-CLISP LINEARIZE-DOTLIST LINEARIZE-LIST LINEARIZE-QUOTE NEXT-NODE-TYPE OUTPUT-CR-OR-SPACE PARENTHESIZE-CURRENT-SELECTION PARSE--LIST PARSE--LIST-INTERNAL PARSE--QUOTE REPLACE-LIST REPLACE-QUOTE SET-LIST-FORMAT SET-POINT-LIST SET-POINT-QUOTE SET-SELECTION-LIST SET-SELECTION-QUOTE STRINGIFY-LIST STRINGIFY-QUOTE SUBNODE-CHANGED-LIST SUBNODE-CHANGED-QUOTE UNDO-LIST-REPLACE UNDO-REPLACE-QUOTE))) (IL:PUTPROPS IL:SEDIT-LISTS IL:FILETYPE :COMPILE-FILE) (IL:PUTPROPS IL:SEDIT-LISTS IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE (DEFPACKAGE IL:SEDIT (:USE IL:LISP IL:XCL)))) (IL:DECLARE\: IL:DONTCOPY IL:DOEVAL@COMPILE (IL:FILESLOAD IL:SEDIT-DECLS) (IL:DECLARE\: IL:DOEVAL@COMPILE IL:DONTCOPY (IL:LOCALVARS . T) ) ) (DEFGLOBALVAR *FORMAT-ALIAS-DEPTH-LIMIT* 10) (DEFPARAMETER *WRAP-PARENS* NIL "Determines whether closing parens wrap to next line if they don't fit.") (DEFGLOBALVAR INTERNAL-WRAPPERS (IL:* IL:|;;;| "this list pretty-prints badly because of itself. see parse--list-internal.") '(IL:BQUOTE IL:\\\, . ,@IL:\\\,.)) (IL:RPAQQ LIST-PARSE-INFO (QUOTE PARSE--QUOTE IL:BQUOTE PARSE--QUOTE IL:\\\, PARSE--QUOTE IL:\\\,@ PARSE--QUOTE IL:\\\,. PARSE--QUOTE FUNCTION PARSE--QUOTE IL:* PARSE--COMMENT)) (IL:RPAQQ CLISP-INDENT-WORDS (IL:THEN IL:|then| IL:ELSE IL:|else| IL:OF IL:|of| IL:WITH IL:|with| IL:IN IL:|in| IL:INSTRING IL:|instring| IL:FROM IL:|from| IL:ON IL:|on| IL:TO IL:|to| IL:BY IL:|by| IL:OLD IL:|old| IL:INSIDE IL:|inside| IL:OUTOF IL:|outof|)) (IL:RPAQQ CLISP-PROGRAM-WORDS (IL:THEN IL:|then| IL:ELSE IL:|else| IL:DO IL:|do| IL:COLLECT IL:|collect| IL:JOIN IL:|join| IL:SUM IL:|sum| IL:COUNT IL:|count| IL:ALWAYS IL:|always| IL:NEVER IL:|never| IL:THEREIS IL:|thereis| IL:LARGEST IL:|largest| IL:SMALLEST IL:|smallest|)) (IL:DEFINEQ (assign-format-clisp (il:lambda (node context) (il:* il:\; "Edited 16-Jul-87 08:32 by DCB") (il:* il:|;;;| "in a clisp expression, the car is a clispword and determines the type of the clisp expression. for example, for would set the type to be FORWORD. in a clisp expression, each clisp word of the same type as the car should be set as a keyword, and all other subnodes should be set normally. (note that this way, \"if\" won't get set as a keyword if it appears as an atom directly in a for-loop list.) ") (il:* il:|;;;| "note that we must keep the clisp type in the Unassigned field of the clisp list's node, since the clisp linearize method depends on it.") (let* ((subnodes (cdr (il:fetch sub-nodes il:of node))) (clisp-type (car (il:getprop (il:fetch structure il:of (car subnodes)) 'il:clispword)))) (set-format (car subnodes) context :keyword) (il:for subnode il:in (cdr subnodes) il:do (set-format subnode context (if (eq clisp-type (car (il:listp (il:getprop (il:fetch structure il:of subnode) 'il:clispword)))) :keyword nil)))))) (assign-format-dotlist (il:lambda (node context) (il:* il:\; "Edited 7-Jul-87 12:51 by DCB") (il:* il:|;;;| "in a dotted list, all sublists should be set as data lists and other types should not be set specially.") (il:for subnode il:in (cdr (il:fetch sub-nodes il:of node)) il:do (set-format subnode context (get-list-format :data))))) (assign-format-list (il:lambda (node context format) (il:* il:\; "Edited 1-Sep-87 18:41 by drc:") (il:* il:|;;;| "Determine this list's ListFormat, and propagate the appropriate formats to its subnodes") (when (not (il:type? list-format format)) (il:* il:|;;| "if we weren't given one, see if we recognize the CAR -- if not, use the default format") (let ((list-car (car (il:fetch structure il:of node)))) (il:setq format (if (not (il:litatom list-car)) (get-list-format :default) (or (get-list-format list-car) (and (il:listp (il:setq list-car (il:getprop list-car 'il:clispword))) (il:memb (car list-car) '(il:ifword il:forword il:recordtran )) (get-list-format :clisp)) (get-list-format :default)))))) (il:* il:|;;| "Stash the ListFormat for cfv.list and linearize.list") (il:replace unassigned il:of node il:with format) (il:* il:|;;| "Non-standard ListFormats provide their own SetFormat method -- use it.") (cond ((il:fetch non-standard? il:of format) (funcall (il:fetch set-format-list il:of format) node context)) (t (il:* il:|;;| "Otherwise, we do the work") (let* ((formats (il:fetch list-formats il:of format)) (last-format (car formats)) (subnodes (cdr (il:fetch sub-nodes il:of node))) (last-subnode subnodes)) (il:* il:|;;| "Find the last non-comment subnode") (il:for p il:on subnodes il:when (not (eq (il:fetch node-type il:of (car p)) type-comment)) il:do (il:setq last-subnode p)) (il:while subnodes il:do (let* ((subnode (car subnodes)) (subformat-name (and (il:neq (il:fetch node-type il:of subnode) type-comment) (if (and (eq subnodes last-subnode) (null (cddr formats))) last-format (car (il:setq formats (or (cdr formats) formats))))))) (set-format subnode context (case subformat-name ((nil :keyword) subformat-name) (:recursive format) (otherwise (get-list-format subformat-name)))) ) (il:setq subnodes (cdr subnodes)))))))) (assign-format-quote (il:lambda (node context format) (il:* il:\; "Edited 7-Jul-87 12:51 by DCB") (il:* il:|;;;| "assigns the format for a quoted subnode. Normal quotes assume the subnode is data, other types (e.g., backquote) assume the subnode is a form. ") (il:* il:|;;;| "We used to supercede any passed-in format and assign the subnode anyway, now we propagate a passed-in format down to the subnode.") (set-format (cadr (il:fetch sub-nodes il:of node)) context (cond ((il:type? list-format format) format) ((eq 'quote (car (il:fetch structure il:of node))) (get-list-format :data)) (t nil))))) (backspace-list (il:lambda (node context index) (il:* il:\; "Edited 7-Jul-87 12:51 by DCB") (il:* il:\; "the BackSpace method for lists") (cond ((null index) (il:* il:\; "backspace from the right boundary of a list puts the caret inside the right paren") (let ((point (il:fetch caret-point il:of context))) (il:replace point-node il:of point il:with node) (il:replace point-index il:of point il:with (car (il:fetch sub-nodes il:of node))) (il:replace point-type il:of point il:with 'structure)) (set-selection-nowhere (il:fetch selection il:of context))) ((eq 0 index) (il:* il:|;;| "backspacing from before the first element deletes the list if it's empty") (when (null (cdr (il:fetch sub-nodes il:of node))) (delete-nodes (il:fetch super-node il:of node) context node nil (il:fetch caret-point il:of context)))) (t (il:* il:\; "backspacing after an element of the list is handled by that element") (il:setq node (subnode index node)) (funcall (il:fetch back-space il:of (il:fetch node-type il:of node)) node context))))) (backspace-quote (il:lambda (node context index) (il:* il:\; "Edited 7-Jul-87 12:51 by DCB") (il:* il:|;;;| "the BackSpace method for quoted structure. index = NIL means backing up from right edge: let the subnode deal; index = T means backspace from quoted gap: either degrade.quote type or delete the quote. index = 0 means backspace from beginning of atom: either degrade of extract the quoted node.") (cond ((null index) (il:* il:\; "jump into quoted node") (il:setq node (subnode 1 node)) (funcall (il:fetch back-space il:of (il:fetch node-type il:of node)) node context)) ((il:fmemb (car (il:fetch structure il:of node)) (quote-wrapper '(comma-at comma-dot))) (il:* il:\; "degrade a big quote type") (change-quote node context 'il:comma)) ((eq index t) (il:* il:|;;| "this is tricky: there is a selection and i wan't to delete the quote node, which contains the selection. but the deletion may cause something else to be selected, so i must cancel my selection first. the delete method had better know what it's doing!") (set-selection-nowhere (il:fetch selection il:of context)) (delete-nodes node context nil nil (il:fetch caret-point il:of context))) ((eq index 0) (il:* il:\; "unquote the atom") (let ((atom-node (subnode 1 node))) (il:* il:|;;| "grap the node to be extracted, so can set the point later") (set-selection-me (il:fetch selection il:of context) context node) (extract-current-selection context) (set-selection-nowhere (il:fetch selection il:of context)) (set-point (il:fetch caret-point il:of context) context atom-node))) (t (il:shouldnt "this point shouldn't be inside a quote!"))))) (cfv-clisp (il:lambda (x environment) (il:* il:\; "Edited 16-Jul-87 08:31 by DCB") (il:* il:|;;;| "compute the width estimates for a clisp expression") (il:bind (pwidth il:_ 0) (iwidth il:_ 0) (first-subnode il:_ t) (paren-width il:_ (il:fetch width il:of (il:fetch lparen-string il:of environment))) (space-width il:_ (il:fetch space-width il:of environment)) indent il:first (il:setq indent paren-width) il:for subnode il:in (cdr (il:fetch sub-nodes il:of x)) il:do (when iwidth (if (il:fetch inline-width il:of subnode) (il:setq iwidth (il:iplus iwidth (if (eq 0 iwidth) paren-width space-width) (il:fetch inline-width il:of subnode))) (il:setq iwidth nil))) (when (and (not first-subnode) (eq (il:fetch format il:of subnode) :keyword)) (il:* il:|;;| "indentable keywords are indented by the base indentation, except for the first keyword of the expression. other keywords are only indented by the width of the left parenthesis") (cond ((il:memb (cdr (il:getprop (il:fetch structure il:of subnode) 'il:clispword)) clisp-indent-words) (il:setq indent (il:fetch indent-base il:of environment))) (t (il:setq indent paren-width) (il:setq iwidth nil)))) (il:setq pwidth (il:imax pwidth (il:iplus (il:fetch preferred-width il:of subnode) indent))) (when (eq (il:fetch format il:of subnode) :keyword) (il:* il:|;;| "the subnodes following a keyword are indented by the keyword's indentation plus its width plus a blank") (il:setq indent (il:iplus indent (il:fetch inline-width il:of subnode) space-width))) (il:setq first-subnode nil) il:finally (il:replace inline-width il:of x il:with (and iwidth (il:ilessp iwidth (il:fetch max-width il:of environment)) (il:iplus iwidth paren-width))) (il:replace preferred-width il:of x il:with pwidth)))) (cfv-dotlist (il:lambda (x environment) (il:* il:\; "Edited 7-Jul-87 12:52 by DCB") (il:* il:|;;;| "compute the width estimates for a dotted list") (let ((paren-width (il:fetch width il:of (il:fetch lparen-string il:of environment))) (space-width (il:charwidth (il:charcode il:space) (il:fetch default-font il:of environment))) (subnodes (cdr (il:fetch sub-nodes il:of x))) (number-of-subnodes (car (il:fetch sub-nodes il:of x)))) (cond ((eq 0 number-of-subnodes) (il:* il:|;;| "empty lists are boring") (il:setq paren-width (il:itimes paren-width 2)) (il:replace inline-width il:of x il:with paren-width) (il:replace preferred-width il:of x il:with paren-width)) (t (let ((width-of-dot (if (eq (il:fetch node-type il:of x) type-dotlist) (il:iplus (il:fetch width il:of (il:fetch dot-string il:of environment)) space-width) 0))) (il:* il:|;;| "a list can go inline if all of its subnodes can") (il:replace inline-width il:of x il:with (and (il:for subnode il:in subnodes il:always (il:atom (il:fetch structure il:of subnode))) (il:iplus paren-width width-of-dot (il:itimes (il:sub1 number-of-subnodes ) space-width) (il:for subnode il:in subnodes il:sum (il:fetch inline-width il:of subnode)) paren-width))) (il:* il:|;;| "forget the closing paren if it can't go inline, since the last line may be short") (il:replace preferred-width il:of x il:with (il:bind (max il:_ 0) il:for subnode il:in subnodes il:do (il:setq max (il:imax max (il:fetch preferred-width il:of subnode))) il:finally (return (il:iplus max paren-width)))))))))) (cfv-list (il:lambda (node environment) (il:* il:\; "Edited 31-Aug-87 16:06 by drc:") (il:* il:|;;;| "Compute the format values of a list, driven by its ListFormat.") (let ((info (il:fetch unassigned il:of node))) (cond ((il:fetch non-standard? il:of info) (il:* il:|;;| "Non-standard ListFormats specify their own CFV method") (funcall (il:fetch cfvlist il:of info) node environment)) (t(il:* il:|;;| "Otherwise we do the work") (let* ((space-width (il:fetch space-width il:of environment)) (two-parens (il:itimes (il:fetch width il:of (il:fetch lparen-string il:of environment )) 2)) (indent 0 (il:* il:\; "our estimate of the indentation, relative to the start of the list") ) (iwidth nil (il:* il:\; "InlineWidth so far") ) (pwidth 0 (il:* il:\; "PreferredWidth so far") ) last-info (il:first t) (prev-type nil (il:* il:\; "Atom, Comment, or NIL (other)") ) next-type (x 0 (il:* il:\; "our estimate of CurrentX") ) (subnodes (cdr (il:fetch sub-nodes il:of node))) (last-subnode subnodes (il:* il:\; "will point to the tail of subnodes beginning with the last non-comment subnode") )) (il:* il:|;;| "If this node has a chance of going inline, start iwidth with the width of the parens and spaces") (when (il:fetch list-inline? il:of info) (let ((number-subnodes (car (il:fetch sub-nodes il:of node)))) (il:setq iwidth (if (il:igreaterp number-subnodes 1) (il:iplus two-parens (il:itimes (il:sub1 number-subnodes) space-width)) two-parens)))) (il:setq last-info (car (il:setq info (il:fetch list-pformat il:of info)))) (il:* il:|;;| "Find the last non-comment subnode") (il:for p il:on subnodes il:when (not (eq (il:fetch node-type il:of (car p)) type-comment)) il:do (il:setq last-subnode p)) (il:while subnodes il:do (let ((subnode (car subnodes))) (cond ((eq (il:fetch node-type il:of subnode) type-comment) (il:* il:|;;| "Comments can never go inline. Their contribution to the preferred width is pretty approximate, but it works fine") (il:setq iwidth nil) (il:setq pwidth (il:imax pwidth (il:iplus indent (il:fetch preferred-width il:of subnode)))) (il:setq prev-type 'comment)) (t (il:setq next-type (next-node-type subnode)) (cond (il:first (il:setq il:first nil)) (t (il:* il:|;;| "We (rather conservatively) guess what the separation info will be") (let ((sepr-info (if (and (eq subnodes last-subnode) (null (cddr info))) last-info (car (il:setq info (or (cdr info) info))))) (break? (eq prev-type 'comment)) (set-indent? nil) (indent-base 0)) (il:while (il:listp sepr-info) il:do (il:setq sepr-info (il:selectq (car sepr-info) ((prev-inline? next-inline? next-preferred?) (cddr sepr-info)) (prev-atom? (if (il:fmemb prev-type '(atom keyword lambdaword)) (cadr sepr-info) (cddr sepr-info))) (prev-keyword? (if (eq prev-type 'keyword) (cadr sepr-info) (cddr sepr-info))) (prev-lambdaword? (if (eq prev-type 'lambdaword) (cadr sepr-info) (cddr sepr-info))) (next-atom? (if (il:fmemb next-type '(atom keyword lambdaword)) (cadr sepr-info) (cddr sepr-info))) (next-keyword? (if (eq next-type 'keyword) (cadr sepr-info) (cddr sepr-info))) (next-lambdaword? (if (eq next-type 'lambdaword) (cadr sepr-info) (cddr sepr-info))) (set-indent (il:setq set-indent? t) (cdr sepr-info)) (from-indent (il:setq indent-base indent) (cdr sepr-info)) (break (il:setq break? t) (cdr sepr-info)) (il:shouldnt "Bad List Format")))) (il:setq x (if break? (il:imin (il:iplus sepr-info indent-base) (il:iplus x space-width)) (il:iplus x space-width))) (when set-indent? (il:setq indent x))))) (il:* il:|;;| "Now that we think we know where this subnode will start, check its effect on the overall width") (il:setq pwidth (il:imax pwidth (il:iplus x (il:fetch preferred-width il:of subnode)))) (let ((sub-iwidth (il:fetch inline-width il:of subnode)) (sub-pwidth (il:fetch preferred-width il:of subnode))) (cond (sub-iwidth (il:setq x (il:iplus x sub-iwidth)) (when iwidth (il:setq iwidth (il:iplus iwidth sub-iwidth)) )) (t (il:setq iwidth nil)))) (il:setq prev-type next-type)))) (il:setq subnodes (cdr subnodes))) (il:replace inline-width il:of node il:with (and iwidth (il:ilessp iwidth (il:fetch max-width il:of environment )) iwidth)) (il:replace preferred-width il:of node il:with (il:iplus pwidth two-parens)))))))) (cfv-quote (il:lambda (x environment format) (il:* il:\; "Edited 7-Jul-87 12:53 by DCB") (il:* il:|;;;| "compute the width estimates for a quoted structure. very straightforward") (let ((quote-width (il:fetch width il:of (il:fetch unassigned il:of x))) (subnode (cadr (il:fetch sub-nodes il:of x)))) (il:replace inline-width il:of x il:with (and (il:fetch inline-width il:of subnode) (il:iplus quote-width (il:fetch inline-width il:of subnode)))) (il:replace preferred-width il:of x il:with (il:iplus quote-width (il:fetch preferred-width il:of subnode )))))) (close-list (il:lambda (context charcode) (il:* il:\; "Edited 22-Dec-87 09:03 by DCB") (il:* il:|;;;| "implements the close paren command (skips to the end of this list)") (let ((pnode)) (when (il:fmemb (type-of-input context) '(atom structure)) (close-open-node context) (il:bind node il:_ (il:fetch point-node il:of (il:fetch caret-point il:of context)) il:first (when (typep node 'edit-selection) (il:setq node (il:fetch select-node il:of node))) il:while (and node (not (il:memb (il:fetch name il:of (il:fetch node-type il:of node)) '(list dotlist clisp)))) il:do (il:* il:|;;| "climb up looking for the nearest enclosing list-type structure") (il:setq node (il:fetch super-node il:of node)) il:finally (cond (node (il:* il:|;;| "ask the list to put this point after itself") (set-point (il:fetch caret-point il:of context) context node nil t) (select-node context node)) (t (il:* il:|;;| "we're not in a list (pretty unusual) so there's no obvious place to put the point") (set-point-nowhere (il:fetch caret-point il:of context)) (format (get-prompt-window context) "~%No enclosing list.")))) (il:* il:|;;| "must return non-NIL if command executed") t)))) (compute-point-position-list (il:lambda (point) (il:* il:\; "Edited 17-Nov-87 11:29 by DCB") (il:* il:|;;;| "implement the ComputePointPosition method for a list, form, clisp, lambda, etc.") (let ((node (il:fetch point-node il:of point)) subnode item) (cond ((eq 0 (il:fetch point-index il:of point)) (il:* il:|;;| "before the first element -- right after the opening paren, which we assume is the first item in the linear form") (il:replace point-x il:of point il:with (il:iplus (il:fetch start-x il:of node) (il:fetch width il:of (car (il:fetch linear-form il:of node))))) (il:replace point-line il:of point il:with (il:fetch first-line il:of node))) (t (il:* il:|;;| "find the subnode it will follow") (il:setq subnode (subnode (il:fetch point-index il:of point) node)) (cond ((eq (il:fetch node-type il:of subnode) type-comment) (il:replace point-line il:of point il:with (car (il:fetch next-line il:of (il:fetch last-line il:of subnode) ))) (il:replace point-x il:of point il:with (il:imax (il:idifference (il:fetch indent il:of (il:fetch point-line il:of point) ) 6) (il:fetch start-x il:of node)))) (t (il:replace point-line il:of point il:with (il:fetch last-line il:of subnode)) (il:setq item (cadr (il:fetch linear-thread il:of subnode))) (il:replace point-x il:of point il:with (il:iplus (il:fetch start-x il:of subnode) (il:fetch actual-llength il:of subnode) (cond ((il:smallp item) (il:* il:|;;| "it's followed by space -- put the caret in the middle") (il:imin (il:half item) 6)) ((il:type? line-start item) (il:* il:|;;| "it's the last thing on the line -- put the caret a little ways after it") 6) (t (il:* il:|;;| "it's followed by something else -- presumably the close paren -- so put the caret immediately after it") 0))))))))))) (copy-structure-list (il:lambda (node) (il:* il:\; "Edited 17-Nov-87 11:29 by DCB") (il:* il:|;;| "the CopyStructure method for lists, forms, clisp expressions, etc.") (il:replace structure il:of node il:with (il:for subnode il:in (cdr (il:fetch sub-nodes il:of node)) il:collect (il:fetch structure il:of subnode))) (when (eq (il:fetch node-type il:of node) type-dotlist) (let ((tail (il:nth (il:fetch structure il:of node) (il:sub1 (car (il:fetch sub-nodes il:of node)))))) (rplacd tail (cadr tail)))))) (copy-structure-quote (il:lambda (node) (il:* il:\; "Edited 17-Nov-87 11:29 by DCB") (il:* il:|;;| "the CopyStructure method for quoted structures") (il:replace structure il:of node il:with (list (car (il:fetch structure il:of node)) (il:fetch structure il:of (subnode 1 node)))))) (create-null-list (il:lambda (context) (il:* il:\; "Edited 6-Apr-88 16:27 by woz") (il:* il:|;;;| "creates a new node describing an empty list") (let* ((width (il:itimes 2 (il:charwidth (il:charcode il:\() (il:|fetch| default-font il:|of| (il:|fetch| environment il:|of| context ))))) (node (il:|create| edit-node node-type il:_ type-list structure il:_ nil sub-nodes il:_ (list 0) inline-width il:_ width preferred-width il:_ width))) (il:|replace| linear-form il:|of| node il:|with| (create-weak-link node)) node))) (create-quoted-gap (il:lambda (gap context quote-type) (il:* il:\; "Edited 6-Apr-88 16:28 by woz") (il:* il:|;;;| "cons a quoted gap, and the node to represent it") (let* ((gap-node (create-gap-node gap)) (quote-node (il:|create| edit-node node-type il:_ type-quote structure il:_ (list (quote-wrapper quote-type) gap) sub-nodes il:_ (list 1 gap-node) unassigned il:_ (il:listget (il:|fetch| quote-string il:|of| (il:|fetch| environment il:|of| context)) quote-type)))) (il:|replace| super-node il:|of| gap-node il:|with| quote-node) (il:|replace| sub-node-index il:|of| gap-node il:|with| 1) (il:|replace| linear-form il:|of| quote-node il:|with| (create-weak-link quote-node)) (note-change quote-node context) quote-node))) (delete-list (il:lambda (node context start end set-point?) (il:* il:\; "Edited 17-Nov-87 11:29 by DCB") (il:* il:|;;| "the Delete method for lists and related animals") (when (il:type? edit-node start) (il:setq start (il:fetch sub-node-index il:of start))) (replace-list node context start (or end start) nil set-point?) t)) (delete-quote (il:lambda (node context start end set-point?) (il:* il:\; "Edited 7-Jul-87 12:53 by DCB") (il:* il:|;;;| "replace node to be delete with a gap. the backspace method will let a quoted gap be deleted.") (if (or (il:neq (or (il:smallp start) (il:fetch sub-node-index il:of start)) 1) (and end (il:neq end 1))) (il:shouldnt "bad index in delete.quote") (let ((subnode (subnode 1 node)) (gap-node (create-gap-node basic-gap))) (replace-node context subnode gap-node) (when set-point? (set-selection-me (il:fetch selection il:of context) context gap-node) (pending-delete set-point? (il:fetch selection il:of context))) t)))) (dot-this-list (il:lambda (context) (il:* il:\; "Edited 7-Jul-87 12:53 by DCB") (il:* il:|;;;| "implements the dot command: make this a dotted list") (let* ((point (il:fetch caret-point il:of context)) (node (il:fetch point-node il:of point)) (index (il:fetch point-index il:of point)) (num-subnodes (car (il:fetch sub-nodes il:of node))) gap-node) (cond ((and (il:igreaterp index 0) (il:igeq index (il:sub1 num-subnodes))) (when (eq index num-subnodes) (il:* il:\; "at end of list. add dotted gap") (il:setq gap-node (create-gap-node basic-gap)) (insert point context gap-node) (select-segment (il:fetch selection il:of context) context node gap-node gap-node) (pending-delete point (il:fetch selection il:of context))) (il:* il:\; "just dot contents of this list") (let ((tail (il:nth (il:fetch structure il:of node) index))) (rplacd tail (cadr tail))) (il:replace node-type il:of node il:with type-dotlist) (note-change node context) (when (il:neq index num-subnodes) (il:* il:\; "if dotted existing list, set point before dot") (set-selection-nowhere (il:fetch selection il:of context)) (set-point point context node index t (subnode index node) 'structure t))) (t (il:* il:|;;| "waste selection to avoid pending delete inconsistency ") (set-selection-nowhere (il:fetch selection il:of context))))))) (get-list-format (il:lambda (fn) (il:* il:\; "Edited 1-Sep-87 18:45 by drc:") (il:* il:|;;| "return the internal list format for forms whose CAR is FN, or NIL. ") (il:* il:|;;| "we loop down aliases to *FORMAT-ALIAS-DEPTH-LIMIT*.") (do ((format (gethash fn list-formats-table) (gethash format list-formats-table)) (depth 0 (1+ depth))) ((= depth *format-alias-depth-limit*) (cerror "forget ~S's list format" "aliases for ~S too deep (possibly circular)" fn) (set-list-format fn 'nil)) (etypecase format (null (return 'nil)) (list-format (return format)) (symbol))))) (initialize-lists (il:lambda nil (il:* il:\; "Edited 7-Jul-87 12:53 by DCB") (il:setq types (list* (il:setq type-list (il:create edit-node-type name il:_ 'list assign-format il:_ ' assign-format-list compute-format-values il:_ 'cfv-list linearize il:_ ' linearize-list sub-node-changed il:_ 'subnode-changed-list compute-point-position il:_ 'compute-point-position-list compute-selection-position il:_ 'compute-selection-position-default set-point il:_ 'set-point-list set-selection il:_ ' set-selection-list grow-selection il:_ 'grow-selection-default select-segment il:_ ' select-segment-default insert il:_ 'insert-list delete il:_ 'delete-list copy-structure il:_ ' copy-structure-list copy-selection il:_ 'copy-selection-default stringify il:_ 'stringify-list back-space il:_ 'backspace-list)) (il:setq type-dotlist (il:create edit-node-type il:using type-list name il:_ 'dotlist assign-format il:_ 'assign-format-dotlist compute-format-values il:_ 'cfv-dotlist linearize il:_ 'linearize-dotlist)) (il:setq type-quote (il:create edit-node-type il:using type-root name il:_ 'quote assign-format il:_ 'assign-format-quote compute-format-values il:_ 'cfv-quote linearize il:_ 'linearize-quote sub-node-changed il:_ ' subnode-changed-quote set-point il:_ 'set-point-quote set-selection il:_ 'set-selection-quote grow-selection il:_ 'grow-selection-default insert il:_ 'replace-quote delete il:_ 'delete-quote copy-structure il:_ ' copy-structure-quote copy-selection il:_ 'copy-selection-default stringify il:_ 'stringify-quote back-space il:_ 'backspace-quote)) types)) (reset-formats))) (insert-list (il:lambda (node context where subnodes point) (il:* il:\; "Edited 17-Jul-87 10:04 by DCB") (il:* il:|;;;| "the Insert method for lists and related animals") (let (start end) (cond ((il:type? edit-selection where) (il:setq start (il:fetch select-start il:of where)) (il:setq end (or (il:fetch select-end il:of where) start))) ((il:type? edit-point where) (il:setq end (il:fetch point-index il:of where)) (il:setq start (il:add1 end))) (t (il:setq start (il:fetch sub-node-index il:of where)) (il:setq end start))) (replace-list node context start end subnodes point)))) (insert-null-list (il:lambda (context) (il:* il:\; "Edited 17-Nov-87 11:30 by DCB") (il:* il:|;;;| "implements the left paren command: insert an empty list") (when (il:fmemb (type-of-input context) '(atom structure)) (let ((point (il:fetch caret-point il:of context)) new-list) (insert point context (list (il:setq new-list (create-null-list context)))) (when (not (dead-node? new-list)) (il:replace point-node il:of point il:with new-list) (il:replace point-index il:of point il:with 0) (il:replace point-type il:of point il:with 'structure) (set-selection-nowhere (il:fetch selection il:of context)))) (il:* il:|;;| "must return non-NIL if command executed") t))) (insert-quoted-gap (il:lambda (context charcode quote-type) (il:* il:\; "Edited 7-Jul-87 12:53 by DCB") (il:* il:\; "implements the ' command: insert a quoted gap") (when (eq (type-of-input context) 'structure) (let ((selection (il:fetch selection il:of context)) (point (il:fetch caret-point il:of context)) new-quote gap) (il:setq new-quote (create-quoted-gap basic-gap context quote-type)) (il:setq gap (subnode 1 new-quote)) (il:* il:\; "we get our hands on the gap node now, to handle the case where the insert reparses the new.quote") (insert (il:fetch caret-point il:of context) context (list new-quote)) (when (not (dead-node? new-quote)) (set-selection-me selection context gap) (pending-delete point selection)))(il:* il:\; "must return non-NIL if command executed") t))) (linearize-clisp (il:lambda (node context index) (il:* il:\; "Edited 11-Apr-88 15:45 by woz") (il:* il:|;;;| "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)") (il:* il:|;;;| "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") (il:* il:|;;| "at present, if keywords always start new lines. this could be improved with a little more smarts") (il:|bind| indent comment-start-x comment-indent comment? program-word? (keyword? il:_ t) (second-subnode il:_ t) (ok il:_ t) (space-width il:_ (il:|fetch| space-width il:|of| (il:|fetch| environment il:|of| context))) (min-indent il:_ (il:iplus (il:|fetch| start-x il:|of| node) (il:|fetch| indent-base il:|of| (il:|fetch| environment il:|of| context)))) (paren-width il:_ (il:|fetch| width il:|of| (il:|fetch| lparen-string il:|of| (il:|fetch| environment il:|of| context)))) (could-inline? il:_ (and (il:|fetch| inline-width il:|of| node) (il:ileq (il:iplus (il:|fetch| start-x il:|of| node) (il:|fetch| inline-width il:|of| node)) (il:|fetch| right-margin il:|of| node)))) (if? il:_ (il:memb (car (il:|fetch| structure il:|of| node)) (quote (il:if il:|if|)))) il:|first| (cond (index (il:setq index (and (il:neq index 1) (il:sub1 index)))) (t (il:* il:|;;| "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 (il:|fetch| lparen-string il:|of| (il:|fetch| environment il:|of| context))) (linearize (cadr (il:|fetch| sub-nodes il:|of| node)) context))) (il:* il:|;;| "set indentation to one blank after the end of the keyword") (il:setq indent (il:iplus (il:|fetch| start-x il:|of| node) paren-width (il:|fetch| inline-width il:|of| (cadr (il:|fetch| sub-nodes il:|of| node))) space-width)) (set-comment-positions comment-start-x comment-indent indent paren-width node context) il:|for| subnode il:|in| (cddr (il:|fetch| sub-nodes il:|of| node)) il:|do| (cond (index (il:* il:|;;| "we don't actually linearize this subnode, but need to update our state as if we had") (il:setq index (and (il:neq index 1) (il:sub1 index))) (cond ((il:setq comment? (eq (il:|fetch| node-type il:|of| subnode) type-comment)) (il:* il:|;;| "this is a comment, so the next guy must start a new line. if following the first keyword, change indent to min.indent") (il:setq ok nil) (when second-subnode (il:setq indent min-indent))) ((il:setq keyword? (eq (il:|fetch| format il:|of| subnode) :keyword)) (il:* il:|;;| "this is a keyword. is it the first thing on this line?") (cond ((let ((item (cadr (il:memb (il:|fetch| last-line il:|of| subnode) (il:|fetch| linear-form il:|of| node))))) (and (il:|type?| weak-link item) (eq subnode (il:|fetch| destination il:|of| item)))) (il:* il:|;;| "the test for this branch used to be:") (il:* il:|;;| "(eq subnode (cadr (il:|fetch| last-line-linear il:|of| subnode)))") (il:* il:|;;| "yep. set the indentation to be one blank after the end of it") (il:setq indent (il:iplus (il:|fetch| start-x il:|of| subnode) (il:|fetch| inline-width il:|of| subnode) space-width)) (il:* il:|;;| "and the next thing goes on this line") (il:setq ok t)) (t (il:* il:|;;| "the next thing goes on this line if it fits") (il:setq ok (quote check))))) (t (il:* il:|;;| "the next thing can go on this line if i'm atomic, and it's atomic too") (il:setq ok (and (il:atom (il:|fetch| structure il:|of| subnode)) (quote atom)))))) (t (il:* il:|;;| "we really are linearizing this subnode") (cond ((il:setq comment? (eq (il:|fetch| node-type il:|of| subnode) type-comment)) (il:setq comment? (select-comment-indent (il:|fetch| unassigned il:|of| subnode) comment-indent indent (il:|fetch| start-x il:|of| (il:|fetch| root il:|of| context)))) (if (or (not ok) (il:igreaterp (il:|fetch| current-x il:|of| context) (il:selectq (il:|fetch| unassigned il:|of| subnode) (1 comment-start-x) (2 (il:idifference indent space-width)) 0))) (output-cr context comment?) (output-space context (il:idifference comment? (il:|fetch| current-x il:|of| context)))) (il:setq ok nil) (when second-subnode (il:setq indent min-indent))) ((il:setq keyword? (eq (il:|fetch| format il:|of| subnode) :keyword)) (il:* il:|;;| "we've got a keyword") (il:setq program-word? (il:fmemb (cdr (il:getprop (il:|fetch| structure il:|of| subnode) (quote il:clispword))) clisp-program-words)) (cond ((il:fmemb (cdr (il:getprop (il:|fetch| structure il:|of| subnode) (quote il:clispword))) clisp-indent-words) (il:* il:|;;| "perhaps it can go on this line") (cond ((and ok (or could-inline? (not if?)) (il:ileq (il:iplus (il:|fetch| current-x il:|of| context) space-width (il:|fetch| inline-width il:|of| subnode) (if (and (cdr il:$$lst1) (il:neq (il:|fetch| format il:|of| (cadr il:$$lst1)) :keyword)) (il:iplus space-width (or (il:|fetch| inline-width il:|of| (cadr il:$$lst1)) (il:|fetch| right-margin il:|of| node))) 0)) (il:|fetch| right-margin il:|of| node))) (il:* il:|;;| "it'll go on this line") (output-space context space-width) (il:setq ok (quote check))) (t (il:* il:|;;| "new line, indented by minimum indentation") (output-cr context min-indent) (il:setq indent (il:iplus min-indent (il:|fetch| inline-width il:|of| subnode) space-width)) (il:setq ok t)))) (t (il:* il:|;;| "new line, no indentation") (output-cr context (il:iplus (il:|fetch| start-x il:|of| node) paren-width)) (il:setq indent (il:iplus (il:|fetch| start-x il:|of| node) paren-width (il:|fetch| inline-width il:|of| subnode) space-width)) (il:setq ok t)))) (t (if (or (eq ok t) (and ok (il:|fetch| inline-width il:|of| subnode) (il:ileq (il:iplus (il:|fetch| current-x il:|of| context) space-width (il:|fetch| inline-width il:|of| subnode)) (il:|fetch| right-margin il:|of| node)) (or (eq ok (quote check)) (il:atom (il:|fetch| structure il:|of| subnode))))) (output-space context space-width) (output-cr context indent)) (il:setq ok (quote atom)))) (linearize subnode context) (when (and (eq ok (quote atom)) (not (il:|fetch| inline? il:|of| subnode))) (il:setq ok nil)))) (il:setq second-subnode nil) il:|finally| (when comment? (output-cr context (il:iplus (il:|fetch| start-x il:|of| node) paren-width)))) (when index (il:shouldnt "linearize index out of range")) (output-constant-string context (il:|fetch| rparen-string il:|of| (il:|fetch| environment il:|of| context)))) ) (linearize-dotlist (il:lambda (node context index) (il:* il:\; "Edited 7-Jul-87 12:54 by DCB") (il:* il:|;;;| "the Linearize method for 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.") (when (not index) (output-constant-string context (il:fetch lparen-string il:of (il:fetch environment il:of context)))) (when (cdr (il:fetch sub-nodes il:of node)) (il:bind (first-time? il:_ t) (space-width il:_ (il:fetch space-width il:of (il:fetch environment il:of context))) (paren-width il:_ (il:fetch width il:of (il:fetch lparen-string il:of (il:fetch environment il:of context)) )) this-line? needs-dot? comment? comment-start-x comment-indent il:first (set-comment-positions comment-start-x comment-indent paren-width paren-width node context) il:for subnode il:in (cdr (il:fetch sub-nodes il:of node)) il:do (il:setq comment? (eq (il:fetch node-type il:of subnode) type-comment)) (cond (index (il:setq index (and (il:neq index 1) (il:sub1 index))) (when comment? (output-cr context (il:iplus paren-width (il:fetch start-x il:of node) )))) (t (il:setq needs-dot? (and (eq (il:fetch node-type il:of node) type-dotlist) (null (cdr il:$$lst1)) (il:iplus space-width (il:fetch width il:of (il:fetch dot-string il:of (il:fetch environment il:of context)))))) (cond (comment? (il:setq first-time? nil) (if (or (il:neq (il:fetch unassigned il:of subnode) 1) (il:igreaterp (il:fetch current-x il:of context) comment-start-x)) (output-cr context (select-comment-indent (il:fetch unassigned il:of subnode) comment-indent (il:iplus paren-width (il:fetch start-x il:of node)) (il:fetch start-x il:of (il:fetch root il:of context)) )) (output-space context (il:idifference comment-indent (il:fetch current-x il:of context))))) ((and first-time? (not comment?)) (il:* il:\; "first time through, if not a comment, then i'm already in the right place for the first subnode") (il:setq first-time? nil)) ((and this-line? (null (cdr (il:fetch sub-nodes il:of subnode)) ) (il:leq (il:iplus (il:fetch current-x il:of context) space-width (il:fetch inline-width subnode) (or needs-dot? 0)) (il:fetch right-margin il:of node))) (il:* il:\; "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)) (t (il:* il:\; "somebody forced be to the next line") (output-cr context (il:iplus paren-width (il:fetch start-x il:of node))))) (when needs-dot? (output-constant-string context (il:fetch dot-string il:of (il:fetch environment il:of context))) (output-space context space-width)) (linearize subnode context))) (il:setq this-line? (and (not comment?) (null (cdr (il:fetch sub-nodes il:of subnode) )))) il:finally (when comment? (output-cr context (il:iplus paren-width (il:fetch start-x il:of node)))))) (when index (il:shouldnt "linearize index out of range")) (output-constant-string context (il:fetch rparen-string il:of (il:fetch environment il:of context))))) (linearize-list (il:lambda (node context index) (il:* il:\; "Edited 15-Feb-88 13:24 by raf") (il:* il:|;;;| "The list linearizer. Present this list, driven by the previously-determined ListFormat.") (let ((info (il:fetch unassigned il:of node))) (cond ((il:fetch non-standard? il:of info) (il:* il:|;;| "Non-standard ListFormats provide their own Linearize method -- use it.") (funcall (il:fetch linearize-list il:of info) node context index)) (t(il:* il:|;;| "Otherwise, we do the work") (let* ((environment (il:fetch environment il:of context)) (lparen (il:fetch lparen-string il:of environment)) (paren-width (il:fetch width il:of lparen)) (space-width (il:fetch space-width il:of environment)) (startx (il:fetch start-x il:of node)) (indent (il:iplus startx paren-width) (il:* il:\; "this will record the current tab setting") ) (first t (il:* il:\; "true until we've printed the first non-comment subnode") ) (prev-type nil (il:* il:\; "one of Atom, Comment, or NIL (other)") ) next-type (prev-inline nil (il:* il:\; "true if the last subnode printed inline") ) (subnodes (cdr (il:fetch sub-nodes il:of node))) (last-subnode subnodes (il:* il:\; "will point to the tail of subnodes beginning with the last non-comment subnode") ) (right-margin (il:fetch right-margin il:of node)) (comment-separation (il:fetch comment-separation il:of context)) (comment-start (il:iplus (il:idifference right-margin (il:fetch comment-width il:of context)) comment-separation)) (inline? (and (il:fetch inline-width il:of node) (il:ileq (il:iplus (il:fetch inline-width il:of node) startx) right-margin)) (il:* il:\; "true if we could fit this whole node inline") ) last-info already-indented?) (il:* il:\; "'already.indented' is a real pain. part of the comment-indent look-ahead") (il:* il:|;;| "Use either the preferred or minimal spacing information, depending on how much room we have") (when (not index) (output-constant-string context lparen)) (il:for p il:on subnodes il:when (not (eq (il:fetch node-type il:of (car p)) type-comment)) il:do (il:setq last-subnode p)) (cond (inline? (il:* il:|;;| "NODE will fit inline, so we don't run formatting rules, just print it.") (dolist (subnode (if index (nthcdr index subnodes) subnodes)) (linearize subnode context) (unless (eq subnode (car last-subnode)) (output-space context space-width)))) (t (il:setq info (if (il:igreaterp (il:iplus (il:fetch preferred-width il:of node) startx) right-margin) (il:fetch list-mformat il:of info) (il:fetch list-pformat il:of info))) (il:setq last-info (car info)) (il:* il:|;;| "Find the last non-comment subnode") (il:while subnodes il:do (let ((subnode (car subnodes))) (cond ((eq (il:fetch node-type il:of subnode) type-comment) (cond (index (when (eq (il:fetch unassigned il:of subnode) 2) (when (il:neq indent (il:fetch start-x il:of subnode)) (il:setq already-indented? t) (il:setq indent (il:fetch start-x il:of subnode))))) (t (il:* il:|;;| "The rules for spacing before comments are tricky") (il:selectq (il:fetch unassigned il:of subnode) (1 (il:* il:|;;| "Level 1 comments will always start at comment.start. If the current line isn't already past the comment margin, start at the end of it -- otherwise on a new line") (output-cr-or-space context comment-start comment-separation)) (2 (il:* il:|;;| "Level 2 comments start on a new line, unless they're the first thing in the list, and are indented to the tab setting. The trick is that unless we've just printed a comment, or we've already printed the last non-comment node in the list, we want the tab setting for the *next* element of the list (e.g. suppose we just printed a 'then') -- and the next element hasn't been printed yet... so we interpret the next separation info, and give it a chance to reset the tab first") (cond (already-indented? (output-cr context indent)) ((null info) (output-cr-or-space context indent space-width)) ((and first (null prev-type)) (il:* il:|;;| "Level 2 comments at the beginning of a list (and not following other comments) immediately follow the (") ) (t (il:* il:|;;| "Determine the separation info for the next element, and see if it sets the tab") (let ((sepr-info (car (or (cdr info) info))) (break? nil) (set-indent? nil) (indent-base (il:iplus startx paren-width))) (il:while (il:listp sepr-info) il:do (il:setq sepr-info (il:selectq (car sepr-info) (prev-inline? (if prev-inline (cadr sepr-info) (cddr sepr-info))) ((next-inline? next-preferred? next-atom? next-keyword? next-lambdaword?) (cddr sepr-info)) (prev-atom? (if (il:fmemb prev-type '(atom keyword lambdaword)) (cadr sepr-info) (cddr sepr-info))) (prev-keyword? (if (eq prev-type 'keyword) (cadr sepr-info) (cddr sepr-info))) (prev-lambdaword? (if (eq prev-type 'lambdaword) (cadr sepr-info) (cddr sepr-info) )) (set-indent (il:setq set-indent? t) (cdr sepr-info)) (from-indent (il:setq indent-base indent) (cdr sepr-info)) (break (il:setq break? t) (cdr sepr-info)) (il:shouldnt "Bad List Format")))) (cond (set-indent? (if break? (output-cr-or-space context (il:imax 1 (il:iplus sepr-info indent-base)) space-width) (output-space context space-width) ) (il:setq indent (il:fetch current-x il:of context)) (il:setq already-indented? t)) (t (output-cr-or-space context indent space-width))))) )) ((3 4 5) (il:* il:|;;| "Level 3, 4 and 5 comments are aligned with the left edge of the root") (output-cr context (il:fetch start-x il:of (il:fetch root il:of context)))) (il:shouldnt "unexpected comment level")) (linearize subnode context))) (il:setq prev-type 'comment) (il:setq prev-inline nil)) (t (il:* il:|;;| "A non-comment node") (il:setq next-type (next-node-type subnode)) (cond (first (il:setq first nil) (il:* il:|;;| "If it was preceded by a comment, we'll need a new line") (when (and prev-type (not index)) (output-cr context indent))) (already-indented? (il:* il:|;;| "doesn't matter if this was the last subnode, since there won't be any more") (when (cdr info) (il:setq info (cdr info))) (when (not index) (output-cr context indent))) (t (let ((sepr-info (cond ((and (eq subnodes last-subnode) (null (cddr info))) (il:setq info nil) last-info) (t (car (il:setq info (or (cdr info) info)))))) (break? nil) (set-indent? nil) (indent-base (il:iplus startx paren-width))) (il:while (il:listp sepr-info) il:do (il:setq sepr-info (il:selectq (car sepr-info) (prev-inline? (if prev-inline (cadr sepr-info) (cddr sepr-info))) (next-inline? (if (and (il:fetch inline-width il:of subnode) (il:ileq (il:iplus (il:fetch current-x il:of context) space-width (il:fetch inline-width il:of subnode)) right-margin)) (cadr sepr-info) (cddr sepr-info))) (next-preferred? (if (il:ileq (il:iplus (il:fetch current-x il:of context) space-width (il:fetch preferred-width il:of subnode) ) right-margin) (cadr sepr-info) (cddr sepr-info))) (prev-atom? (if (il:fmemb prev-type '(atom keyword lambdaword)) (cadr sepr-info) (cddr sepr-info))) (prev-keyword? (if (eq prev-type 'keyword) (cadr sepr-info) (cddr sepr-info))) (prev-lambdaword? (if (eq prev-type 'lambdaword) (cadr sepr-info) (cddr sepr-info))) (next-atom? (if (il:fmemb next-type '(atom keyword lambdaword)) (cadr sepr-info) (cddr sepr-info))) (next-keyword? (if (eq next-type 'keyword) (cadr sepr-info) (cddr sepr-info))) (next-lambdaword? (if (eq next-type 'lambdaword) (cadr sepr-info) (cddr sepr-info))) (set-indent (il:setq set-indent? t) (cdr sepr-info)) (from-indent (il:setq indent-base indent) (cdr sepr-info)) (break (il:setq break? t) (cdr sepr-info)) (il:shouldnt "Bad List Format")))) (cond (index (when set-indent? (il:setq indent (il:fetch start-x il:of subnode)))) (t (cond ((eq prev-type 'comment) (output-cr context (il:imax 1 (il:iplus sepr-info indent-base)))) (break? (output-cr-or-space context (il:imax 1 (il:iplus sepr-info indent-base)) space-width)) (t (output-space context space-width))) (when set-indent? (il:setq indent (il:fetch current-x il:of context)))))))) (il:* il:|;;| "Now we've got the appropriate spacing, linearize the subnode and set prev.inline and prev.type appropriately") (il:setq prev-inline (if index (il:fetch inline? il:of subnode) (linearize subnode context))) (il:setq prev-type next-type) (il:setq already-indented? nil)))) (when index (il:setq index (and (il:neq index 1) (il:sub1 index)))) (il:setq subnodes (cdr subnodes))) (when index (il:shouldnt "linearize index out of range")) (il:* il:|;;| "The closing paren goes on a new line if it's following a comment or there's no room for it on the previous line") (when (or (eq prev-type 'comment) (and *wrap-parens* (il:igreaterp (il:iplus (il:fetch current-x il:of context) paren-width) right-margin) (il:ilessp indent right-margin))) (output-cr context indent)))) (output-constant-string context (il:fetch rparen-string il:of environment)))))))) (linearize-quote (il:lambda (x context index) (il:* il:\; "Edited 17-Nov-87 11:33 by DCB") (il:* il:|;;;| "the Linearize method for quoted structures. trivial") (cond ((not index) (output-constant-string context (il:fetch unassigned il:of x)) (linearize (cadr (il:fetch sub-nodes il:of x)) context)) ((il:neq index 1) (il:shouldnt "linearize index out of range"))))) (next-node-type (il:lambda (node) (il:* il:\; "Edited 7-Jan-88 13:56 by DCB") (il:* il:|;;;| "Return the \"indentation type\" of a node, one of atom, keyword, lambdaword, or nil. Quote nodes return the type of their quoted structure; NIL nodes return atom or NIL depending on the node type.") (let* ((str (il:|fetch| structure il:|of| node)) (type (il:|ffetch| node-type il:|of| node))) (typecase str (cons (if (eq type type-quote) (next-node-type (subnode 1 node)) 'nil)) (keyword 'keyword) (symbol (cond ((eq type type-list) nil) ((il:fmemb str lambda-list-keywords) 'lambdaword) (t 'atom))) (t 'atom))))) (output-cr-or-space (il:lambda (context indent space-width) (il:* il:\; "Edited 7-Jul-87 12:55 by DCB") (if (il:igreaterp (il:iplus (il:fetch current-x il:of context) space-width) indent) (output-cr context indent) (output-space context (il:idifference indent (il:fetch current-x il:of context)))) )) (parenthesize-current-selection (il:lambda (context charcode point-after?) (il:* il:\; "Edited 22-Dec-87 08:51 by DCB") (let* ((selection (il:fetch selection il:of context)) (node (il:fetch select-node il:of selection)) (start (il:fetch select-start il:of selection)) (end (il:fetch select-end il:of selection)) (point (il:fetch caret-point il:of context)) nodes new-node) (cond ((and node (eq (il:fetch select-type il:of selection) 'structure)) (start-undo-block) (if start (il:setq nodes (il:for i il:from start il:to (or end start) il:as subnodes il:on (cdr (il:nth (il:fetch sub-nodes il:of node) start)) il:collect (car subnodes))) (il:setq nodes (list node))) (il:replace point-node il:of point il:with selection) (il:replace point-type il:of point il:with 'structure) (il:setq new-node (create-null-list context)) (insert point context new-node) (il:setq nodes (il:for n il:in nodes il:when (dead-node? n) il:collect n)) (il:replace point-node il:of point il:with new-node) (il:replace point-type il:of point il:with 'structure) (il:replace point-index il:of point il:with 0) (insert point context nodes) (select-node context new-node) (cond (point-after? (set-point point context new-node nil t)) (t (il:replace point-node il:of point il:with new-node) (il:replace point-type il:of point il:with 'structure) (il:replace point-index il:of point il:with 0))) (end-undo-block)) (t (format (get-prompt-window context) "~%Select structure to parenthesize.")))) (il:* il:|;;| "must return non-NIL if command executed") t)) (parse--list (il:lambda (structure context) (il:* il:\; "Edited 14-Jun-88 20:47 by drc:") (il:* il:|;;;| "parse a list. if we're in default mode and it's undotted, check to see if it starts with a special word and if so parse it appropriately") (let* ((parser (and (il:litatom (car structure)) (il:listget list-parse-info (car structure))))) (when (not (and parser (funcall parser structure context))) (parse--list-internal structure context (and (listp structure) (atom (car structure)) (get-list-format (car structure))))))) ) (parse--list-internal (il:lambda (structure context format) (il:* il:\; "Edited 14-Jun-88 21:26 by drc:") (let ((node (build-node structure context type-list))) (let* (list-positions sub-formats sub-formats-length subnode subformat) (when format (setq list-positions (il:|fetch| list-sublists il:|of| format)) (setq sub-formats (il:|ffetch| list-formats il:|of| format)) (setq sub-formats-length (if sub-formats (length sub-formats) 0))) (do ((sublist? nil) (comment? nil) (node-count 0) (tail structure (cdr tail))) ((or (atom tail) (and (consp (cdr tail)) (null (cddr tail)) (member (car tail) internal-wrappers :test (quote eq)))) (when tail (il:* il:|;;| "whent it's a real dotted-list or it's a dotted-wrapper, [e.g. (a . #'b)] then smash the type to dotted & parse TAIL as the last subnode.") (il:|replace| node-type il:|of| node il:|with| type-dotlist) (parse tail context))) (setq subnode (car tail)) (setq comment? (and (consp subnode) (eq (car subnode) (quote il:*)))) (cond ((not comment?) (incf node-count) (setq sublist? (and list-positions (null subnode) (or (eq list-positions t) (member node-count list-positions :test (quote eq))))) (setq subformat (when (and sub-formats (consp subnode) (not (member (car subnode) internal-wrappers :test (quote eq)))) (get-list-format (if (>= node-count sub-formats-length) (first sub-formats) (nth node-count sub-formats)))))) (t (setq sublist? nil) (setq subformat nil))) (parse subnode context (when (or sublist? subformat) (il:function parse--list-internal)) subformat))))) ) (parse--quote (il:lambda (structure context) (il:* il:\; "Edited 7-Jul-87 12:55 by DCB") (il:* il:|;;;| "try to parse this list as a quoted structure") (when (and (cdr structure) (null (cddr structure))) (build-node structure context type-quote) (il:replace unassigned il:of (il:fetch current-node il:of context) il:with (il:listget (il:fetch quote-string il:of (il:fetch environment il:of context)) (quote-wrapper-name (car structure)))) (parse (cadr structure) context) (il:* il:|;;| "that is, if the object is quoted and not backquoted, then it can be parsed in Data mode, and not as a form") t))) (replace-list (il:lambda (node context start end subnodes point redot?) (il:* il:\; "Edited 22-Dec-87 11:12 by DCB") (il:* il:|;;;| "replaces the subnodes of NODE indexed by START through END with new subnodes SUBNODES. turns the list into a dotted list if REDOT? is true. may also undot a list.") (let ((dot-list? (eq (il:fetch node-type il:of node) type-dotlist)) (insert-after (il:nth (il:fetch sub-nodes il:of node) start)) (trailing-subnodes (il:nth (il:fetch sub-nodes il:of node) (il:iplus end 2))) (delta-length (il:idifference (il:length subnodes) (il:add1 (il:idifference end start)))) trailing-structure structure converted? new-subnode-count undo-bounds undo-structure) (il:* il:|;;| "fix up subnode indices for those to follow the inserted material") (il:for s il:in trailing-subnodes il:do (il:add (il:fetch sub-node-index il:of s) delta-length)) (il:* il:|;;| "fix the subnode count") (il:setq new-subnode-count (il:iplus (car (il:fetch sub-nodes il:of node)) delta-length)) (rplaca (il:fetch sub-nodes il:of node) new-subnode-count) (il:* il:|;;| "mark the deleted subnodes as dead, dead, dead") (il:for (dead-nodes il:_ (cdr insert-after)) il:by (cdr dead-nodes) il:bind dead-node il:while (il:neq dead-nodes trailing-subnodes) il:do (il:replace super-node il:of (il:setq dead-node (car dead-nodes)) il:with 'dead!) (kill-node dead-node) (il:setq undo-structure dead-nodes)) (il:* il:|;;| "fix up the nodes to be inserted, and make a list out of their structures") (cond (subnodes (il:setq undo-bounds (cons start (il:iplus end delta-length))) (il:setq structure (il:for x il:in subnodes il:as i il:from start il:bind (depth il:_ (il:add1 (il:fetch depth il:of node))) il:collect (il:replace sub-node-index il:of x il:with i) (il:replace super-node il:of x il:with node) (set-depth x depth) (il:fetch structure il:of x)))) (t (il:setq undo-bounds start))) (when undo-structure (rplacd undo-structure nil) (il:setq undo-structure (cdr insert-after))) (il:* il:|;;| "then insert those subnodes into the super's list") (rplacd insert-after (nconc subnodes trailing-subnodes)) (il:* il:|;;| "and fix up the structure") (cond ((or (null (il:fetch structure il:of node)) (eq 0 new-subnode-count)) (il:* il:|;;| "changed this list to or from NIL. just replace it") (il:replace structure il:of node il:with structure) (subnode-changed node context)) (t (when trailing-subnodes (il:setq trailing-structure (il:nth (il:fetch structure il:of node) (il:add1 end)))) (cond ((eq start 1) (il:* il:|;;| "replacing at the beginning of a list. play games with pointers") (cond ((eq end 0) (il:* il:|;;| "straight insertion (nothing being replaced)") (il:setq trailing-structure (cons (car trailing-structure) (cdr trailing-structure)))) ((and dot-list? (eq new-subnode-count 1)) (il:* il:|;;| "deleting everything in a dotted list but the element after the dot undots it") (il:setq converted? t) (il:setq trailing-structure (list trailing-structure)))) (il:rplnode2 (il:fetch structure il:of node) (nconc structure trailing-structure))) (t (if (and dot-list? (null trailing-subnodes)) (when (and (eq 0 delta-length) (null (cdr subnodes))) (il:setq structure (car structure))) (il:setq structure (nconc structure trailing-structure))) (rplacd (il:nth (il:fetch structure il:of node) (il:sub1 start)) structure))))) (il:* il:|;;| "fix up selection and insertion point") (when point (il:replace point-node il:of point il:with node) (il:replace point-index il:of point il:with (il:iplus end delta-length)) (il:replace point-type il:of point il:with 'structure)) (let ((caret (il:fetch caret-point il:of context))) (cond ((and (il:neq caret point) (il:type? edit-node (il:fetch point-node il:of caret))) (cond ((dead-node? (il:fetch point-node il:of caret)) (il:* il:|;;| "if the caret was in the deleted material, we'll put it in the space the material was deleted from") (il:replace point-node il:of caret il:with node) (il:replace point-index il:of caret il:with (il:iplus end delta-length) ) (il:replace point-type il:of caret il:with 'structure)) ((and (eq (il:fetch point-node il:of caret) node) (il:igeq (il:fetch point-index il:of caret) start)) (il:* il:|;;| "if it was between deleted items or after them in the list, it will need to be fixed up") (il:replace point-index il:of caret il:with (il:iplus delta-length (il:imax (il:fetch point-index il:of caret) end)))))) ((and (il:neq caret point) (il:type? edit-selection (il:fetch point-node il:of caret))) (let* ((selection (il:fetch point-node il:of caret))) (cond ((dead-node? (il:fetch select-node il:of selection)) (set-selection-nowhere selection)) ((and (eq (il:fetch select-node il:of selection) node) (il:fetch select-start il:of selection) (il:igreaterp (il:fetch select-start il:of selection) end)) (il:* il:|;;| "the selection is after the stuff deleted. fix up the selection. don't need to worry about overlaps, because delete overlaps cancel the selection and move overlaps aren't allowed, so can just do simple index translation.") (il:replace select-start il:of selection il:with (il:iplus delta-length (il:fetch select-start il:of selection))) (il:replace select-end il:of selection il:with (il:iplus delta-length (il:fetch select-end il:of selection))))))))) (il:* il:|;;| "make sure this is a dotted list or not, as appropriate") (cond (redot? (when (or dot-list? (il:ilessp new-subnode-count 2)) (il:shouldnt "shouldn't be redotting this one")) (il:replace node-type il:of node il:with type-dotlist) (il:setq dot-list? t)) ((or converted? (and dot-list? (<= start end) (null trailing-subnodes) (or (il:ilessp start end) (il:neq delta-length 0)))) (il:* il:|;;| "dotted lists stop being dotted if you (a) delete everything but the last element, (b) replace a sequence of more than one subnode including the last element, (c) delete the last element, or (d) replace the last element with more than one element") (il:replace node-type il:of node il:with type-list) (il:setq converted? t))) (il:* il:|;;| "note change so that pretty-printer will fix up presentation") (note-change node context) (il:* il:|;;| "record how to undo this change") (undo-by undo-list-replace node undo-bounds undo-structure converted?) nil))) (replace-quote (il:lambda (node context where subnodes point) (il:* il:\; "Edited 17-Jul-87 10:04 by DCB") (let ((subnode (car subnodes))) (when (not (or (and (il:type? edit-selection where) (eq (il:fetch select-start il:of where) 1) (eq (il:fetch select-end il:of where) 1)) (il:type? edit-node where))) (il:shouldnt "weird bounds for replace.quote")) (undo-by undo-replace-quote node (subnode 1 node)) (kill-node (subnode 1 node)) (rplaca (cdr (il:fetch sub-nodes il:of node)) subnode) (il:replace super-node il:of subnode il:with node) (il:replace sub-node-index il:of subnode il:with 1) (rplaca (cdr (il:fetch structure il:of node)) (il:fetch structure il:of subnode)) (set-depth subnode (il:add1 (il:fetch depth il:of node))) (note-change node context) (when point (punt-set-point point context node t)) (cdr subnodes)))) (set-list-format (il:lambda (fn format) (il:* il:\; "Edited 1-Sep-87 14:54 by drc:") (if format (setf (gethash fn list-formats-table) format) (remhash fn list-formats-table)))) (set-point-list (il:lambda (point context node index offset item type compute-location?) (il:* il:\; "Edited 22-Feb-88 14:33 by woz") (il:* il:|;;;| "the SetPoint method for lists, lambdas, clisps, etc.") (prog ((dotted? (eq (il:|fetch| node-type il:|of| node) type-dotlist)) (number-subnodes (car (il:|fetch| sub-nodes il:|of| node)))) (when (not index) (il:* il:|;;| "we can't set a point at our left or right boundary, but maybe our super can") (return (punt-set-point point context node offset compute-location?))) (cond ((il:|type?| string-item item) (il:* il:|;;| "pointing to the left paren, right paren, or dot. figure out which side they're pointing to") (il:setq offset (il:ilessp offset (il:half (il:fetch width il:of item)))) (cond ((il:strequal (il:fetch string il:of item) ".") (il:* il:\; "it's a dot") (il:setq index (if offset (il:sub1 number-subnodes) number-subnodes))) ((eq offset (eq index 1)) (il:* il:|;;| "left side of the left paren or right side of the right paren puts us outside the list") (return (punt-set-point point context node (not offset) compute-location?))) (offset (il:* il:|;;| "we must be on the right paren") (il:setq index number-subnodes) (il:* il:|;;| "the left paren case is already correct, since index=0")))) ((il:|type?| edit-node item) (il:setq type (quote structure))) (t (il:* il:|;;| "space or cr. figure out which end we're closer to") (when (or (il:smallp (cadr (il:fetch linear-form il:of node))) (il:|type?| line-start (cadr (il:fetch linear-form il:of node)))) (il:* il:|;;| "starts with a comment (single-semi causing space, triple-semi causing line-start), so there's something extra as the second thing in the linear form that we have to skip over") (il:setq index (il:sub1 index))) (il:setq offset (il:ilessp offset (il:half (or (il:smallp item) 0)))) (if offset (il:setq index (il:half index)) (il:setq index (il:half (il:iplus 2 index)))) (when dotted? (cond ((eq index number-subnodes) (when (il:setq offset (not offset)) (il:setq index (il:sub1 index)))) ((eq index (il:add1 number-subnodes)) (il:setq index number-subnodes)))) (when (il:igreaterp index number-subnodes) (il:setq index number-subnodes) (il:setq offset t)))) (cond ((and (eq type (quote atom)) (il:neq index 0) (il:ileq index number-subnodes)) (set-point point context (subnode index node) nil offset nil (quote atom) compute-location?)) ((and dotted? (eq index number-subnodes)) (il:* il:|;;| "can't insert structure after the dot in a dotted list") (set-point-nowhere point)) (t (il:|replace| point-node il:|of| point il:|with| node) (il:|replace| point-index il:|of| point il:|with| (if offset index (il:setq index (il:sub1 index)))) (il:|replace| point-type il:|of| point il:|with| (quote structure)) (when compute-location? (compute-point-position-list point)))))) ) (set-point-quote (il:lambda (point context node index offset item type compute-location?) (il:* il:\; "Edited 17-Nov-87 11:34 by DCB") (il:* il:|;;;| "the SetPoint method for quoted structures. there's no place to insert, so if we can't punt to the super or sub node there'll be no point") (cond ((not index) (if offset (set-point point context (subnode 1 node) nil t nil type compute-location?) (punt-set-point point context node nil compute-location?))) ((il:type? string-item item) (set-point point context (subnode 1 node) nil nil nil type compute-location?)) (offset (punt-set-point point context node offset compute-location?)) (t (set-point-nowhere point))))) (set-selection-list (il:lambda (selection context node index offset item type) (il:* il:\; "Edited 17-Nov-87 11:36 by DCB") (il:* il:|;;;| "the SetSelection method for lists. pointing to the parens gets the whole list, pointing to whitespace gets nothing") (if (or (and (il:type? string-item item) (eq type 'structure)) (il:type? edit-node item)) (set-selection-me selection context node) (set-selection-nowhere selection)))) (set-selection-quote (il:lambda (selection context node index offset item type) (il:* il:\; "Edited 17-Nov-87 11:36 by DCB") (il:* il:|;;;| "the SetSelection method for quoted structures") (if (or (and (eq index 1) (eq type 'structure)) (il:type? edit-node item)) (set-selection-me selection context node) (set-selection-nowhere selection)))) (stringify-list (il:lambda (node environment) (il:* il:\; "Edited 7-Jul-87 12:56 by DCB") (il:bind (strings il:_ '(")")) (dot il:_ (eq (il:fetch node-type il:of node) type-dotlist)) il:for subnode il:in (il:reverse (cdr (il:fetch sub-nodes il:of node))) il:do (il:setq strings (cons (cond (dot (il:setq dot nil) " . ") (t " ")) (cons (stringify subnode environment) strings))) il:finally (return (il:concatlist (cons "(" (cdr strings))))))) (stringify-quote (il:lambda (node environment) (il:* il:\; "Edited 7-Jul-87 12:56 by DCB") (il:concat (il:fetch string il:of (il:fetch unassigned il:of node)) (stringify (subnode 1 node) environment)))) (subnode-changed-list (il:lambda (node subnode context) (il:* il:\; "Edited 7-Jul-87 12:56 by DCB") (il:* il:|;;;| "the SubNodeChanged method for lists of all flavours") (il:* il:|;;| "stick in the new subnode") (if (and (eq (il:fetch node-type il:of node) type-dotlist) (eq (il:fetch sub-node-index il:of subnode) (car (il:fetch sub-nodes il:of node)))) (rplacd (il:nth (il:fetch structure il:of node) (il:sub1 (il:fetch sub-node-index il:of subnode))) (il:fetch structure il:of subnode)) (rplaca (il:nth (il:fetch structure il:of node) (il:fetch sub-node-index il:of subnode)) (il:fetch structure il:of subnode))) (il:* il:|;;| "note the change so that the pretty-printer can fix things up") (note-change node context))) (subnode-changed-quote (il:lambda (node subnode) (il:* il:\; "Edited 17-Nov-87 11:36 by DCB") (il:* il:|;;;| "the SubNodeChanged method for quoted structures. not much interesting to happen here") (rplaca (cdr (il:fetch structure il:of node)) (il:fetch structure il:of subnode)))) (undo-list-replace (il:lambda (context node bounds old-subnodes redot?) (il:* il:\; "Edited 7-Jul-87 12:56 by DCB") (il:* il:|;;;| "undo method for replaces within lists.") (il:* il:|;;| "make sure you revive only dead nodes") (il:for subnode il:in old-subnodes il:unless (dead-node? subnode) il:do (il:shouldnt "undo is confused!")) (let ((last-inserted-subnode (and old-subnodes (car (last old-subnodes))))) (il:* il:|;;| "stick the dead nodes back in the list in place of the ones they were replaced by. replace.list will note the change to the list, which will cause the pretty-printer to fix up the presentation.") (replace-list node context (or (il:fixp bounds) (car bounds)) (or (cdr (il:listp bounds)) (il:sub1 bounds)) old-subnodes (il:fetch caret-point il:of context) redot?) (il:* il:|;;| "patch up selection") (when old-subnodes (select-segment (il:fetch selection il:of context) context node (car old-subnodes) last-inserted-subnode) (il:replace pending-delete? il:of (il:fetch selection il:of context) il:with nil))))) (undo-replace-quote (il:lambda (context node old-value) (il:* il:\; "Edited 7-Jul-87 12:56 by DCB") (when (not (dead-node? old-value)) (il:shouldnt "undo is confused!")) (replace-quote node context (subnode 1 node) (list old-value) nil) (when (eq (il:fetch node-type il:of old-value) type-gap) (select-segment (il:fetch selection il:of context) context node old-value old-value) (pending-delete (il:fetch caret-point il:of context) (il:fetch selection il:of context))))) ) (IL:PUTPROPS IL:SEDIT-LISTS IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990)) (IL:DECLARE\: IL:DONTCOPY (IL:FILEMAP (NIL (4966 118825 (ASSIGN-FORMAT-CLISP 4979 . 6549) (ASSIGN-FORMAT-DOTLIST 6551 . 6962) ( ASSIGN-FORMAT-LIST 6964 . 11336) (ASSIGN-FORMAT-QUOTE 11338 . 12092) (BACKSPACE-LIST 12094 . 13642) ( BACKSPACE-QUOTE 13644 . 15705) (CFV-CLISP 15707 . 18753) (CFV-DOTLIST 18755 . 21902) (CFV-LIST 21904 . 31812) (CFV-QUOTE 31814 . 32793) (CLOSE-LIST 32795 . 34842) (COMPUTE-POINT-POSITION-LIST 34844 . 38766) (COPY-STRUCTURE-LIST 38768 . 39642) (COPY-STRUCTURE-QUOTE 39644 . 40053) (CREATE-NULL-LIST 40055 . 41102) (CREATE-QUOTED-GAP 41104 . 42431) (DELETE-LIST 42433 . 42838) (DELETE-QUOTE 42840 . 43796) (DOT-THIS-LIST 43798 . 45978) (GET-LIST-FORMAT 45980 . 46766) (INITIALIZE-LISTS 46768 . 51182) (INSERT-LIST 51184 . 52009) (INSERT-NULL-LIST 52011 . 53042) (INSERT-QUOTED-GAP 53044 . 54320) ( LINEARIZE-CLISP 54322 . 61476) (LINEARIZE-DOTLIST 61478 . 68130) (LINEARIZE-LIST 68132 . 89717) ( LINEARIZE-QUOTE 89719 . 90204) (NEXT-NODE-TYPE 90206 . 91206) (OUTPUT-CR-OR-SPACE 91208 . 91640) ( PARENTHESIZE-CURRENT-SELECTION 91642 . 94198) (PARSE--LIST 94200 . 94733) (PARSE--LIST-INTERNAL 94735 . 96270) (PARSE--QUOTE 96272 . 97098) (REPLACE-LIST 97100 . 107841) (REPLACE-QUOTE 107843 . 109144) ( SET-LIST-FORMAT 109146 . 109412) (SET-POINT-LIST 109414 . 112222) (SET-POINT-QUOTE 112224 . 113095) ( SET-SELECTION-LIST 113097 . 113683) (SET-SELECTION-QUOTE 113685 . 114191) (STRINGIFY-LIST 114193 . 115040) (STRINGIFY-QUOTE 115042 . 115317) (SUBNODE-CHANGED-LIST 115319 . 116356) ( SUBNODE-CHANGED-QUOTE 116358 . 116699) (UNDO-LIST-REPLACE 116701 . 118182) (UNDO-REPLACE-QUOTE 118184 . 118823))))) IL:STOP