diff options
Diffstat (limited to 'src/interp/ht-util.boot.pamphlet')
| -rw-r--r-- | src/interp/ht-util.boot.pamphlet | 753 |
1 files changed, 753 insertions, 0 deletions
diff --git a/src/interp/ht-util.boot.pamphlet b/src/interp/ht-util.boot.pamphlet new file mode 100644 index 00000000..f875959f --- /dev/null +++ b/src/interp/ht-util.boot.pamphlet @@ -0,0 +1,753 @@ +\documentclass{article} +\usepackage{axiom} +\begin{document} +\title{\$SPAD/src/interp ht-util.boot} +\author{The Axiom Team} +\maketitle +\begin{abstract} +\end{abstract} +\eject +\tableofcontents +\eject +\section{License} +<<license>>= +-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. +-- All rights reserved. +-- +-- Redistribution and use in source and binary forms, with or without +-- modification, are permitted provided that the following conditions are +-- met: +-- +-- - Redistributions of source code must retain the above copyright +-- notice, this list of conditions and the following disclaimer. +-- +-- - Redistributions in binary form must reproduce the above copyright +-- notice, this list of conditions and the following disclaimer in +-- the documentation and/or other materials provided with the +-- distribution. +-- +-- - Neither the name of The Numerical ALgorithms Group Ltd. nor the +-- names of its contributors may be used to endorse or promote products +-- derived from this software without specific prior written permission. +-- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS +-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A +-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER +-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, +-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +@ +<<*>>= +<<license>> + +-- HyperTeX Utilities for generating basic Command pages +--)package "BOOT" + +$bcParseOnly := true + +-- List of issued hypertex lines +$htLineList := nil + +-- pointer to the page we are currently defining +$curPage := nil + +-- List of currently active window named +$activePageList := nil + +htpDestroyPage(pageName) == + pageName in $activePageList => + SET(pageName, nil) + $activePageList := NREMOVE($activePageList, pageName) + +htpName htPage == +-- GENSYM whose value is the page + ELT(htPage, 0) + +htpSetName(htPage, val) == + SETELT(htPage, 0, val) + +htpDomainConditions htPage == +-- List of Domain conditions + ELT(htPage, 1) + +htpSetDomainConditions(htPage, val) == + SETELT(htPage, 1, val) + +htpDomainVariableAlist htPage == +-- alist of pattern variables and conditions + ELT(htPage, 2) + +htpSetDomainVariableAlist(htPage, val) == + SETELT(htPage, 2, val) + +htpDomainPvarSubstList htPage == +-- alist of user pattern variables to system vars + ELT(htPage, 3) + +htpSetDomainPvarSubstList(htPage, val) == + SETELT(htPage, 3, val) + +htpRadioButtonAlist htPage == +-- alist of radio button group names and labels + ELT(htPage, 4) + +htpButtonValue(htPage, groupName) == + for buttonName in LASSOC(groupName, htpRadioButtonAlist htPage) repeat + (stripSpaces htpLabelInputString(htPage, buttonName)) = '"t" => + return buttonName + +htpSetRadioButtonAlist(htPage, val) == + SETELT(htPage, 4, val) + +htpInputAreaAlist htPage == +-- Alist of input-area labels, and default values + ELT(htPage, 5) + +htpSetInputAreaAlist(htPage, val) == + SETELT(htPage, 5, val) + +htpAddInputAreaProp(htPage, label, prop) == + SETELT(htPage, 5, [[label, nil, nil, nil, :prop], :ELT(htPage, 5)]) + +htpPropertyList htPage == +-- Association list of user-defined properties + ELT(htPage, 6) + +htpProperty(htPage, propName) == + LASSOC(propName, ELT(htPage, 6)) + +htpSetProperty(htPage, propName, val) == + pair := ASSOC(propName, ELT(htPage, 6)) + pair => RPLACD(pair, val) + SETELT(htPage, 6, [[propName, :val], :ELT(htPage, 6)]) + +htpLabelInputString(htPage, label) == +-- value user typed as input string on page + props := LASSOC(label, htpInputAreaAlist htPage) + props and STRINGP (s := ELT(props,0)) => + s = '"" => s + trimString s + nil + +htpLabelFilteredInputString(htPage, label) == +-- value user typed as input string on page + props := LASSOC(label, htpInputAreaAlist htPage) + props => + #props > 5 and ELT(props, 6) => + FUNCALL(SYMBOL_-FUNCTION ELT(props, 6), ELT(props, 0)) + replacePercentByDollar ELT(props, 0) + nil + +replacePercentByDollar s == fn(s,0,MAXINDEX s) where + fn(s,i,n) == + i > n => '"" + (m := charPosition(char "%",s,i)) > n => SUBSTRING(s,i,nil) + STRCONC(SUBSTRING(s,i,m - i),'"$",fn(s,m + 1,n)) + +htpSetLabelInputString(htPage, label, val) == +------------------> OBSELETE +-- value user typed as input string on page + props := LASSOC(label, htpInputAreaAlist htPage) + props => SETELT(props, 0, STRINGIMAGE val) + nil + +htpLabelSpadValue(htPage, label) == +-- Scratchpad value of parsed and evaled inputString, as (type . value) + props := LASSOC(label, htpInputAreaAlist htPage) + props => ELT(props, 1) + nil + +htpSetLabelSpadValue(htPage, label, val) == +-- value user typed as input string on page + props := LASSOC(label, htpInputAreaAlist htPage) + props => SETELT(props, 1, val) + nil + +htpLabelErrorMsg(htPage, label) == +-- error message associated with input area + props := LASSOC(label, htpInputAreaAlist htPage) + props => ELT(props, 2) + nil + +htpSetLabelErrorMsg(htPage, label, val) == +-- error message associated with input area + props := LASSOC(label, htpInputAreaAlist htPage) + props => SETELT(props, 2, val) + nil + +htpLabelType(htPage, label) == +-- either 'string or 'button + props := LASSOC(label, htpInputAreaAlist htPage) + props => ELT(props, 3) + nil + +htpLabelDefault(htPage, label) == +-- default value for the input area + msg := htpLabelInputString(htPage, label) => + msg = '"t" => 1 + msg = '"nil" => 0 + msg + props := LASSOC(label, htpInputAreaAlist htPage) + props => + ELT(props, 4) + nil + + +htpLabelSpadType(htPage, label) == +-- pattern variable for target domain for input area + props := LASSOC(label, htpInputAreaAlist htPage) + props => ELT(props, 5) + nil + +htpLabelFilter(htPage, label) == +-- string to string mapping applied to input area strings before parsing + props := LASSOC(label, htpInputAreaAlist htPage) + props => ELT(props, 6) + nil + +htpPageDescription htPage == +-- a list of all the commands issued to create the basic-command page + ELT(htPage, 7) + +htpSetPageDescription(htPage, pageDescription) == + SETELT(htPage, 7, pageDescription) + +htpAddToPageDescription(htPage, pageDescrip) == +-------------> OBSELETE <----------- + SETELT(htPage, 7, nconc(nreverse COPY_-LIST pageDescrip, ELT(htPage, 7))) + +iht line == +-- issue a single hyperteTeX line, or a group of lines + $newPage => nil + PAIRP line => + $htLineList := NCONC(nreverse mapStringize COPY_-LIST line, $htLineList) + $htLineList := [basicStringize line, :$htLineList] + +bcHt line == +--line = '"\##1" => harharhar() + iht line + PAIRP line => + if $newPage then htpAddToPageDescription($curPage, [['text, :line]]) + if $newPage then htpAddToPageDescription($curPage, [['text, line]]) + +bcIssueHt line == + PAIRP line => htMakePage1 line + iht line + +mapStringize l == + ATOM l => l + RPLACA(l, basicStringize CAR l) + RPLACD(l, mapStringize CDR l) + l + +basicStringize s == + STRINGP s => + s = '"\$" => '"\%" + s = '"{\em $}" => '"{\em \%}" + s + s = '_$ => '"\%" + PRINC_-TO_-STRING s + +stringize s == + STRINGP s => s + PRINC_-TO_-STRING s + +htInitPage(title, propList) == +----------------------------> OBSELETE---cannot return $curPage +-- start defining a hyperTeX page + htInitPageNoScroll(propList, title) + htSayStandard '"\beginscroll " + $curPage + + +--htInitPageNoHeading(propList) == +-----------------------> replaced by htInitPageNoScroll +-- start defining a hyperTeX page +-- $curPage := htpMakeEmptyPage(propList) +-- if $saturn then $saturnPage := htpMakeEmptyPage(propList) +-- $newPage := true +-- $htLineList := nil +-- $curPage + +htAddHeading(title) == +------------------------> OBSELETE + htNewPage title + $curPage + +htShowPage() == +-- show the page which has been computed + htSayStandard '"\endscroll" + htShowPageNoScroll() + +htShowPageNoScroll() == +------------------------> OBSELETE +-- show the page which has been computed + htSayStandard '"\autobuttons" + htpSetPageDescription($curPage, nreverse htpPageDescription $curPage) + $newPage := false + $htLineList := nil + htMakePage htpPageDescription $curPage + line := APPLY(function CONCAT, nreverse $htLineList) + issueHT line + endHTPage() + +htMakePage itemList == +------------------------> OBSELETE +-- make a page given the description in itemList + if $newPage then htpAddToPageDescription($curPage, itemList) + htMakePage1 itemList + +htMakePage1 itemList == +-- make a page given the description in itemList + for [itemType, :items] in itemList repeat + itemType = 'text => iht items + itemType = 'lispLinks => htLispLinks items + itemType = 'lispmemoLinks => htLispMemoLinks items + itemType = 'bcLinks => htBcLinks items ---> + itemType = 'bcLinksNS => htBcLinks(items,true) + itemType = 'bcLispLinks => htBcLispLinks items ---> + itemType = 'radioButtons => htRadioButtons items + itemType = 'bcRadioButtons => htBcRadioButtons items + itemType = 'inputStrings => htInputStrings items + itemType = 'domainConditions => htProcessDomainConditions items + itemType = 'bcStrings => htProcessBcStrings items + itemType = 'toggleButtons => htProcessToggleButtons items + itemType = 'bcButtons => htProcessBcButtons items + itemType = 'doneButton => htProcessDoneButton items + itemType = 'doitButton => htProcessDoitButton items + systemError ['"unknown itemType", itemType] + +htMakeErrorPage htPage == +------------------> OBSELETE + $newPage := false + $htLineList := nil + $curPage := htPage + htMakePage htpPageDescription htPage + line := APPLY(function CONCAT, nreverse $htLineList) + issueHT line + endHTPage() + +htQuote s == +-- wrap quotes around a piece of hyperTeX + iht '"_"" + iht s + iht '"_"" + +htProcessToggleButtons buttons == + iht '"\newline\indent{5}\beginitems " + for [message, info, defaultValue, buttonName] in buttons repeat + if NULL LASSOC(buttonName, htpInputAreaAlist $curPage) then + setUpDefault(buttonName, ['button, defaultValue]) + iht ['"\item{\em\inputbox[", htpLabelDefault($curPage, buttonName), '"]{", + buttonName, '"}{\htbmfile{pick}}{\htbmfile{unpick}}\space{}"] + bcIssueHt message + iht '"\space{}}" + bcIssueHt info + iht '"\enditems\indent{0} " + +htProcessBcButtons buttons == + for [defaultValue, buttonName] in buttons repeat + if NULL LASSOC(buttonName, htpInputAreaAlist $curPage) then + setUpDefault(buttonName, ['button, defaultValue]) + k := htpLabelDefault($curPage,buttonName) + k = 0 => iht ['"\off{",buttonName,'"}"] + k = 1 => iht ['"\on{", buttonName,'"}"] + iht ['"\inputbox[", htpLabelDefault($curPage, buttonName), '"]{", + buttonName, '"}{\htbmfile{pick}}{\htbmfile{unpick}}"] + +htProcessBcStrings strings == +---------------------> OBSELETE <------------------------ + for [numChars, default, stringName, spadType, :filter] in strings repeat + mess2 := '"" + if NULL LASSOC(stringName, htpInputAreaAlist $curPage) then + setUpDefault(stringName, ['string, default, spadType, filter]) + if htpLabelErrorMsg($curPage, stringName) then + iht ['"\centerline{{\em ", htpLabelErrorMsg($curPage, stringName), '"}}"] + mess2 := CONCAT(mess2, bcSadFaces()) + htpSetLabelErrorMsg($curPage, stringName, nil) + iht ['"\inputstring{", stringName, '"}{", + numChars, '"}{", htpLabelDefault($curPage,stringName), '"} ", mess2] + +bcSadFaces() == + '"\space{1}{\em\htbitmap{error}\htbitmap{error}\htbitmap{error}}" + +htLispLinks(links,:option) == + [links,options] := beforeAfter('options,links) + indent := LASSOC('indent,options) or 5 + iht '"\newline\indent{" + iht stringize indent + iht '"}\beginitems" + for [message, info, func, :value] in links repeat + iht '"\item[" + call := (IFCAR option => '"\lispmemolink"; '"\lispdownlink") + htMakeButton(call,message, mkCurryFun(func, value)) + iht ['"]\space{}"] + bcIssueHt info + iht '"\enditems\indent{0} " + +htLispMemoLinks(links) == htLispLinks(links,true) + +htBcLinks(links,:options) == +-------------------------> OBSELETE + skipStateInfo? := IFCAR options + [links,options] := beforeAfter('options,links) + for [message, info, func, :value] in links repeat + htMakeButton('"\lispdownlink",message, + mkCurryFun(func, value),skipStateInfo?) + bcIssueHt info + +htBcLispLinks links == +-------------------------> OBSELETE + [links,options] := beforeAfter('options,links) + for [message, info, func, :value] in links repeat + htMakeButton('"\lisplink",message, mkCurryFun(func, value)) + bcIssueHt info + +beforeAfter(x,u) == [[y for [y,:r] in tails u while x ^= y],r] + +mkCurryFun(fun, val) == + name := GENTEMP() + code := + ['DEFUN, name, '(arg), ['APPLY, MKQ fun, ['CONS, 'arg, MKQ val]]] + EVAL code + name + +htRadioButtons [groupName, :buttons] == + htpSetRadioButtonAlist($curPage, [[groupName, :buttonNames buttons], + : htpRadioButtonAlist $curPage]) + boxesName := GENTEMP() + iht ['"\newline\indent{5}\radioboxes{", boxesName, + '"}{\htbmfile{pick}}{\htbmfile{unpick}}\beginitems "] + defaultValue := '"1" + for [message, info, buttonName] in buttons repeat + if NULL LASSOC(buttonName, htpInputAreaAlist $curPage) then + setUpDefault(buttonName, ['button, defaultValue]) + defaultValue := '"0" + iht ['"\item{\em\radiobox[", htpLabelDefault($curPage, buttonName), '"]{", + buttonName, '"}{",boxesName, '"}\space{}"] + bcIssueHt message + iht '"\space{}}" + bcIssueHt info + iht '"\enditems\indent{0} " + +htBcRadioButtons [groupName, :buttons] == + htpSetRadioButtonAlist($curPage, [[groupName, :buttonNames buttons], + : htpRadioButtonAlist $curPage]) + boxesName := GENTEMP() + iht ['"\radioboxes{", boxesName, + '"}{\htbmfile{pick}}{\htbmfile{unpick}} "] + defaultValue := '"1" + for [message, info, buttonName] in buttons repeat + if NULL LASSOC(buttonName, htpInputAreaAlist $curPage) then + setUpDefault(buttonName, ['button, defaultValue]) + defaultValue := '"0" + iht ['"{\em\radiobox[", htpLabelDefault($curPage, buttonName), '"]{", + buttonName, '"}{",boxesName, '"}"] + bcIssueHt message + iht '"\space{}}" + bcIssueHt info + +setUpDefault(name, props) == +---------------> OBSELETE <---------------- + htpAddInputAreaProp($curPage, name, props) + +buttonNames buttons == + [buttonName for [.,., buttonName] in buttons] + +htInputStrings strings == + iht '"\newline\indent{5}\beginitems " + for [mess1, mess2, numChars, default, stringName, spadType, :filter] + in strings repeat + if NULL LASSOC(stringName, htpInputAreaAlist $curPage) then + setUpDefault(stringName, ['string, default, spadType, filter]) + if htpLabelErrorMsg($curPage, stringName) then + iht ['"\centerline{{\em ", htpLabelErrorMsg($curPage, stringName), '"}}"] + + mess2 := CONCAT(mess2, bcSadFaces()) + htpSetLabelErrorMsg($curPage, stringName, nil) + iht '"\item " + bcIssueHt mess1 + iht ['"\inputstring{", stringName, '"}{", + numChars, '"}{", htpLabelDefault($curPage,stringName), '"} "] + bcIssueHt mess2 + iht '"\enditems\indent{0}\newline " + +htProcessDomainConditions condList == + htpSetDomainConditions($curPage, renamePatternVariables condList) + htpSetDomainVariableAlist($curPage, computeDomainVariableAlist()) + +renamePatternVariables condList == + htpSetDomainPvarSubstList($curPage, + renamePatternVariables1(condList, nil, $PatternVariableList)) + substFromAlist(condList, htpDomainPvarSubstList $curPage) + +renamePatternVariables1(condList, substList, patVars) == + null condList => substList + [cond, :restConds] := condList + cond is ['isDomain, pv, pattern] or cond is ['ofCategory, pv, pattern] + or cond is ['Satisfies, pv, cond] => + if pv = $EmptyMode then nsubst := substList + else nsubst := [[pv, :car patVars], :substList] + renamePatternVariables1(restConds, nsubst, rest patVars) + substList + +substFromAlist(l, substAlist) == + for [pvar, :replace] in substAlist repeat + l := SUBST(replace, pvar, l) + l + +computeDomainVariableAlist() == + [[pvar, :pvarCondList pvar] for [., :pvar] in + htpDomainPvarSubstList $curPage] + +pvarCondList pvar == + nreverse pvarCondList1([pvar], nil, htpDomainConditions $curPage) + +pvarCondList1(pvarList, activeConds, condList) == + null condList => activeConds + [cond, : restConds] := condList + cond is [., pv, pattern] and pv in pvarList => + pvarCondList1(nconc(pvarList, pvarsOfPattern pattern), + [cond, :activeConds], restConds) + pvarCondList1(pvarList, activeConds, restConds) + +pvarsOfPattern pattern == + NULL LISTP pattern => nil + [pvar for pvar in rest pattern | pvar in $PatternVariableList] + +htMakeTemplates(templateList, numLabels) == + templateList := [templateParts template for template in templateList] + [[substLabel(i, template) for template in templateList] + for i in 1..numLabels] where substLabel(i, template) == + PAIRP template => + INTERN CONCAT(first template, PRINC_-TO_-STRING i, rest template) + template + +templateParts template == + NULL STRINGP template => template + i := SEARCH('"%l", template) + null i => template + [SUBSEQ(template, 0, i), : SUBSEQ(template, i+2)] + +htMakeDoneButton(message, func) == + bcHt '"\newline\vspace{1}\centerline{" + if message = '"Continue" then + bchtMakeButton('"\lispdownlink", "\ContinueBitmap", func) + else + bchtMakeButton('"\lispdownlink",CONCAT('"\box{", message, '"}"), func) + bcHt '"} " + +htProcessDoneButton [label , func] == + iht '"\newline\vspace{1}\centerline{" + + if label = '"Continue" then + htMakeButton('"\lispdownlink", "\ContinueBitmap", func) + else if label = '"Push to enter names" then + htMakeButton('"\lispdownlink",'"\ControlBitmap{ClickToSet}", func) + else + htMakeButton('"\lispdownlink", CONCAT('"\box{", label, '"}"), func) + + iht '"} " + +htMakeButton(htCommand, message, func,:options) == +----------> OBSELETE <---------------------------------- + skipStateInfo? := IFCAR options + iht [htCommand, '"{"] + bcIssueHt message + skipStateInfo? => + iht ['"}{(|htDoneButton| '|", func, '"| ",htpName $curPage, '")}"] + iht ['"}{(|htDoneButton| '|", func, '"| (PROGN "] + for [id, ., ., ., type, :.] in htpInputAreaAlist $curPage repeat + iht ['"(|htpSetLabelInputString| ", htpName $curPage, '"'|", id, '"| "] + if type = 'string then + iht ['"_"\stringvalue{", id, '"}_""] + else + iht ['"_"\boxvalue{", id, '"}_""] + iht '") " + iht [htpName $curPage, '"))}"] + +bchtMakeButton(htCommand, message, func) == + bcHt [htCommand, '"{", message, + '"}{(|htDoneButton| '|", func, '"| (PROGN "] + for [id, ., ., ., type, :.] in htpInputAreaAlist $curPage repeat + bcHt ['"(|htpSetLabelInputString| ", htpName $curPage, '"'|", id, '"| "] + if type = 'string then + bcHt ['"_"\stringvalue{", id, '"}_""] + else + bcHt ['"_"\boxvalue{", id, '"}_""] + bcHt '") " + bcHt [htpName $curPage, '"))} "] + +htProcessDoitButton [label, command, func] == + fun := mkCurryFun(func, [command]) + iht '"\newline\vspace{1}\centerline{" + htMakeButton('"\lispcommand", CONCAT('"\box{", label, '"}"), fun) + iht '"} " + iht '"\vspace{2}{Select \ \UpButton{} \ to go back one page.}" + iht '"\newline{Select \ \ExitButton{QuitPage} \ to remove this window.}" + +htMakeDoitButton(label, command) == + -- use bitmap button if just plain old "Do It" + if label = '"Do It" then + bcHt '"\newline\vspace{1}\centerline{\lispcommand{\DoItBitmap}{(|doDoitButton| " + else + bcHt ['"\newline\vspace{1}\centerline{\lispcommand{\box{", label, + '"}}{(|doDoitButton| "] + bcHt htpName $curPage + bcHt ['" _"", htEscapeString command, '"_""] + bcHt '")}}" + + bcHt '"\vspace{2}{Select \ \UpButton{} \ to go back one page.}" + bcHt '"\newline{Select \ \ExitButton{QuitPage} \ to remove this window.}" + +doDoitButton(htPage, command) == + executeInterpreterCommand command + +executeInterpreterCommand command == + PRINC command + TERPRI() + ncSetCurrentLine(command) + CATCH('SPAD__READER, parseAndInterpret command) + PRINC MKPROMPT() + FINISH_-OUTPUT() + +htDoneButton(func, htPage) == + typeCheckInputAreas htPage => + htMakeErrorPage htPage + NULL FBOUNDP func => + systemError ['"unknown function", func] + FUNCALL(SYMBOL_-FUNCTION func, htPage) + +typeCheckInputAreas htPage == + -- This needs to be severly beefed up + inputAlist := nil + errorCondition := false + for entry in htpInputAreaAlist htPage + | entry is [stringName, ., ., ., 'string, ., spadType, filter] repeat + condList := + LASSOC(LASSOC(spadType,htpDomainPvarSubstList htPage), + htpDomainVariableAlist htPage) + string := htpLabelFilteredInputString(htPage, stringName) + $bcParseOnly => + null ncParseFromString string => + htpSetLabelErrorMsg(htPage, '"Syntax Error", '"Syntax Error") + nil + val := checkCondition(htpLabelInputString(htPage, stringName), + string, condList) + STRINGP val => + errorCondition := true + htpSetLabelErrorMsg(htPage, stringName, val) + htpSetLabelSpadValue(htPage, stringName, val) + errorCondition + +checkCondition(s1, string, condList) == + condList is [['Satisfies, pvar, pred]] => + val := FUNCALL(pred, string) + STRINGP val => val + ['(String), :wrap s1] + condList isnt [['isDomain, pvar, pattern]] => + systemError '"currently invalid domain condition" + pattern is '(String) => ['(String), :wrap s1] + val := parseAndEval string + STRINGP val => + val = '"Syntax Error " => '"Error: Syntax Error " + condErrorMsg pattern + [type, : data] := val + newType := CATCH('SPAD__READER, resolveTM(type, pattern)) + null newType => + condErrorMsg pattern + coerceInt(val, newType) + +condErrorMsg type == + typeString := form2String type + if PAIRP typeString then typeString := APPLY(function CONCAT, typeString) + CONCAT('"Error: Could not make your input into a ", typeString) + +parseAndEval string == + $InteractiveMode :fluid := true + $BOOT: fluid := NIL + $SPAD: fluid := true + $e:fluid := $InteractiveFrame + $QuietCommand:local := true + parseAndEval1 string + +parseAndEval1 string == + syntaxError := false + pform := + $useNewParser => + v := applyWithOutputToString('ncParseFromString, [string]) + CAR v => CAR v + syntaxError := true + CDR v + oldParseString string + syntaxError => + '"Syntax Error " + pform => + val := applyWithOutputToString('processInteractive, [pform, nil]) + CAR val => CAR val + '"Type Analysis Error" + nil + +oldParseString string == + tree := applyWithOutputToString('string2SpadTree, [string]) + CAR tree => parseTransform postTransform CAR tree + CDR tree + +makeSpadCommand(:l) == + opForm := CONCAT(first l, '"(") + lastArg := last l + l := rest l + argList := nil + for arg in l while arg ^= lastArg repeat + argList := [CONCAT(arg, '", "), :argList] + argList := nreverse [lastArg, :argList] + CONCAT(opForm, APPLY(function CONCAT, argList), '")") + +htMakeInputList stringList == +-- makes an input form for constructing a list + lastArg := last stringList + argList := nil + for arg in stringList while arg ^= lastArg repeat + argList := [CONCAT(arg, '", "), :argList] + argList := nreverse [lastArg, :argList] + bracketString APPLY(function CONCAT, argList) + + +-- predefined filter strings +bracketString string == CONCAT('"[",string,'"]") + +quoteString string == CONCAT('"_"", string, '"_"") + +$funnyQuote := char 127 +$funnyBacks := char 128 + +htEscapeString str == + str := SUBSTITUTE($funnyQuote, char '_", str) + SUBSTITUTE($funnyBacks, char '_\, str) + +unescapeStringsInForm form == + STRINGP form => + str := NSUBSTITUTE(char '_", $funnyQuote, form) + NSUBSTITUTE(char '_\, $funnyBacks, str) + CONSP form => + unescapeStringsInForm CAR form + unescapeStringsInForm CDR form + form + form + + + + + +@ +\eject +\begin{thebibliography}{99} +\bibitem{1} nothing +\end{thebibliography} +\end{document} |