aboutsummaryrefslogtreecommitdiff
path: root/src/interp/ht-util.boot.pamphlet
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2007-09-20 04:13:24 +0000
committerdos-reis <gdr@axiomatics.org>2007-09-20 04:13:24 +0000
commit7bacc11540fe33bf3530c361a59772ecd4d529d9 (patch)
tree29c8c1a5f16c1d1b9bc4c8e31970f1b636dfbf95 /src/interp/ht-util.boot.pamphlet
parent32d516cbb18276e5060749f85368c5a90346a0f4 (diff)
downloadopen-axiom-7bacc11540fe33bf3530c361a59772ecd4d529d9.tar.gz
remove pamphlets - part 5
Diffstat (limited to 'src/interp/ht-util.boot.pamphlet')
-rw-r--r--src/interp/ht-util.boot.pamphlet753
1 files changed, 0 insertions, 753 deletions
diff --git a/src/interp/ht-util.boot.pamphlet b/src/interp/ht-util.boot.pamphlet
deleted file mode 100644
index f875959f..00000000
--- a/src/interp/ht-util.boot.pamphlet
+++ /dev/null
@@ -1,753 +0,0 @@
-\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}