aboutsummaryrefslogtreecommitdiff
path: root/src/interp/htsetvar.boot.pamphlet
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2007-08-14 05:14:52 +0000
committerdos-reis <gdr@axiomatics.org>2007-08-14 05:14:52 +0000
commitab8cc85adde879fb963c94d15675783f2cf4b183 (patch)
treec202482327f474583b750b2c45dedfc4e4312b1d /src/interp/htsetvar.boot.pamphlet
downloadopen-axiom-ab8cc85adde879fb963c94d15675783f2cf4b183.tar.gz
Initial population.
Diffstat (limited to 'src/interp/htsetvar.boot.pamphlet')
-rw-r--r--src/interp/htsetvar.boot.pamphlet500
1 files changed, 500 insertions, 0 deletions
diff --git a/src/interp/htsetvar.boot.pamphlet b/src/interp/htsetvar.boot.pamphlet
new file mode 100644
index 00000000..0d664ff9
--- /dev/null
+++ b/src/interp/htsetvar.boot.pamphlet
@@ -0,0 +1,500 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp htsetvar.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>>
+
+htsv() ==
+ startHTPage(50)
+ htSetVars()
+
+htSetVars() ==
+ $path := nil
+ $lastTree := nil
+ if 0 ^= LASTATOM $setOptions then htMarkTree($setOptions,0)
+ htShowSetTree($setOptions)
+
+htShowSetTree(setTree) ==
+ $path := TAKE(- LASTATOM setTree,$path)
+ page := htInitPage(mkSetTitle(),nil)
+ htpSetProperty(page, 'setTree, setTree)
+ links := nil
+ maxWidth1 := maxWidth2 := 0
+ for setData in setTree repeat
+ satisfiesUserLevel setData.setLevel =>
+ okList := [setData,:okList]
+ maxWidth1 := MAX(# PNAME setData.setName,maxWidth1)
+ maxWidth2 := MAX(htShowCount STRINGIMAGE setData.setLabel,maxWidth2)
+ maxWidth1 := MAX(9,maxWidth1)
+ maxWidth2 := MAX(41,maxWidth2)
+ tabset1 := STRINGIMAGE (maxWidth1)
+ tabset2 := STRINGIMAGE (maxWidth2 + maxWidth1 - 1)
+ htSay('"\tab{2}\newline Variable\tab{",STRINGIMAGE (maxWidth1 + (maxWidth2/3)),'"}Description\tab{",STRINGIMAGE(maxWidth2 + maxWidth1 + 2),'"}Value\newline\beginitems ")
+ for setData in REVERSE okList repeat
+ htSay '"\item"
+ label := STRCONC('"\menuitemstyle{",setData.setName,'"}")
+ links := [label,[['text,'"\tab{",tabset1,'"}",setData.setLabel,'"\tab{",tabset2,'"}{\em ",htShowSetTreeValue setData,'"}"]],
+ 'htShowSetPage, setData.setName]
+ htMakePage [['bcLispLinks, links,'options,'(indent . 0)]]
+ htSay '"\enditems"
+ htShowPage()
+
+htShowCount s == --# discounting {\em .. }
+ m := #s
+ m < 8 => m - 1
+ i := 0
+ count := 0
+ while i < m - 7 repeat
+ s.i = char '_{ and s.(i+1) = char '_\ and s.(i+2) = char 'e
+ and s.(i+3) = char 'm => i := i + 6 --discount {\em }
+ i := i + 1
+ count := count + 1
+ count + (m - i)
+
+htShowSetTreeValue(setData) ==
+ st := setData.setType
+ st = 'FUNCTION => object2String FUNCALL(setData.setVar,"%display%")
+ st = 'INTEGER => object2String eval setData.setVar
+ st = 'STRING => object2String eval setData.setVar
+ st = 'LITERALS =>
+ object2String translateTrueFalse2YesNo eval setData.setVar
+ st = 'TREE => '"..."
+ systemError()
+
+mkSetTitle() == STRCONC('"Command {\em )set ",listOfStrings2String $path,'"}")
+
+listOfStrings2String u ==
+ null u => '""
+ STRCONC(listOfStrings2String rest u,'" ",stringize first u)
+
+htShowSetPage(htPage, branch) ==
+ setTree := htpProperty(htPage, 'setTree)
+ $path := [branch,:TAKE(- LASTATOM setTree,$path)]
+ setData := ASSOC(branch, setTree)
+ null setData =>
+ systemError('"No Set Data")
+ st := setData.setType
+ st = 'FUNCTION => htShowFunctionPage(htPage, setData)
+ st = 'INTEGER => htShowIntegerPage(htPage,setData)
+ st = 'LITERALS => htShowLiteralsPage(htPage, setData)
+ st = 'TREE => htShowSetTree(setData.setLeaf)
+
+ st = 'STRING => -- have to add this
+ htSetNotAvailable(htPage,'")set compiler")
+
+ systemError '"Unknown data type"
+
+htShowLiteralsPage(htPage, setData) ==
+ htSetLiterals(htPage,setData.setName,setData.setLabel,
+ setData.setVar,setData.setLeaf,'htSetLiteral)
+
+htSetLiterals(htPage,name,message,variable,values,functionToCall) ==
+ page := htInitPage('"Set Command", htpPropertyList htPage)
+ htpSetProperty(page, 'variable, variable)
+ bcHt ['"\centerline{Set {\em ", name, '"}}\newline"]
+ bcHt ['"{\em Description: } ", message, '"\newline\vspace{1} "]
+ bcHt '"Select one of the following: \newline\tab{3} "
+ links := [[STRCONC('"",STRINGIMAGE opt), '"\newline\tab{3}", functionToCall, opt] for opt in values]
+ htMakePage [['bcLispLinks, :links]]
+ bcHt ["\indent{0}\newline\vspace{1} The current setting is: {\em ",
+ translateTrueFalse2YesNo EVAL variable, '"} "]
+ htShowPage()
+
+htSetLiteral(htPage, val) ==
+ htInitPage('"Set Command", nil)
+ SET(htpProperty(htPage, 'variable), translateYesNo2TrueFalse val)
+ htKill(htPage,val)
+
+htShowIntegerPage(htPage, setData) ==
+ page := htInitPage(mkSetTitle(), htpPropertyList htPage)
+ htpSetProperty(page, 'variable, setData.setVar)
+ bcHt ['"\centerline{Set {\em ", setData.setName, '"}}\newline"]
+-- message := isKeyedMsgInDb($path,'(setvar text A)) or setData.setLabel
+ message := setData.setLabel
+ bcHt ['"{\em Description: } ", message, '"\newline\vspace{1} "]
+ [$htInitial,$htFinal] := setData.setLeaf
+ if $htFinal = $htInitial + 1
+ then
+ bcHt '"Enter the integer {\em "
+ bcHt stringize $htInitial
+ bcHt '"} or {\em "
+ bcHt stringize $htFinal
+ bcHt '"}:"
+ else if null $htFinal then
+ bcHt '"Enter an integer greater than {\em "
+ bcHt stringize ($htInitial - 1)
+ bcHt '"}:"
+ else
+ bcHt '"Enter an integer between {\em "
+ bcHt stringize $htInitial
+ bcHt '"} and {\em "
+ bcHt stringize $htFinal
+ bcHt '"}:"
+ htMakePage [
+ '(domainConditions (Satisfies S chkRange)),
+ ['bcStrings,[5,eval setData.setVar,'value,'S]]]
+ htSetvarDoneButton('"Select to Set Value",'htSetInteger)
+ htShowPage()
+
+htSetInteger(htPage) ==
+ htInitPage(mkSetTitle(), nil)
+ val := chkRange htpLabelInputString(htPage,'value)
+ not INTEGERP val =>
+ errorPage(htPage,['"Value Error",nil,'"\vspace{3}\centerline{{\em ",val,'"}}\vspace{2}\newline\centerline{Click on \UpBitmap{} to re-enter value}"])
+ SET(htpProperty(htPage, 'variable), val)
+ htKill(htPage,val)
+
+htShowFunctionPage(htPage,setData) ==
+ fn := setData.setDef => FUNCALL(fn,htPage)
+ htpSetProperty(htPage,'setData,setData)
+ htpSetProperty(htPage,'parts, setData.setLeaf)
+ htShowFunctionPageContinued(htPage)
+
+htShowFunctionPageContinued(htPage) ==
+ parts := htpProperty(htPage,'parts)
+ setData := htpProperty(htPage,'setData)
+ [[phrase,kind,variable,checker,initValue,:.],:restParts] := parts
+ htpSetProperty(htPage, 'variable, variable)
+ htpSetProperty(htPage, 'checker, checker)
+ htpSetProperty(htPage, 'parts, restParts)
+ kind = 'LITERALS => htSetLiterals(htPage,setData.setName,
+ phrase,variable,checker,'htFunctionSetLiteral)
+ page := htInitPage(mkSetTitle(), htpPropertyList htPage)
+ bcHt ['"\centerline{Set {\em ", setData.setName, '"}}\newline"]
+ bcHt ['"{\em Description: } ", setData.setLabel, '"\newline\vspace{1} "]
+ currentValue := EVAL variable
+ htMakePage
+ [ ['domainConditions, ['Satisfies,'S,checker]],
+ ['text,:phrase],
+ ['inputStrings,
+ [ '"", '"", 60, currentValue, 'value, 'S]]]
+ htSetvarDoneButton('"Select To Set Value",'htSetFunCommand)
+ htShowPage()
+
+htSetvarDoneButton(message, func) ==
+ bcHt '"\newline\vspace{1}\centerline{"
+
+ if message = '"Select to Set Value" or message = '"Select to Set Values" then
+ bchtMakeButton('"\lisplink",'"\ControlBitmap{ClickToSet}", func)
+ else
+ bchtMakeButton('"\lisplink",CONCAT('"\fbox{", message, '"}"), func)
+
+ bcHt '"} "
+
+
+htFunctionSetLiteral(htPage, val) ==
+ htInitPage('"Set Command", nil)
+ SET(htpProperty(htPage, 'variable), translateYesNo2TrueFalse val)
+ htSetFunCommandContinue(htPage,val)
+
+htSetFunCommand(htPage) ==
+ variable := htpProperty(htPage,'variable)
+ checker := htpProperty(htPage,'checker)
+ value := htCheck(checker,htpLabelInputString(htPage,'value))
+ SET(variable,value) --kill this later
+ htSetFunCommandContinue(htPage,value)
+
+htSetFunCommandContinue(htPage,value) ==
+ parts := htpProperty(htPage,'parts)
+ continue :=
+ null parts => false
+ parts is [['break,predicate],:restParts] => eval predicate
+ true
+ continue =>
+ htpSetProperty(htPage,'parts,restParts)
+ htShowFunctionPageContinued(htPage)
+ htKill(htPage,value)
+
+htKill(htPage,value) ==
+ htInitPage('"System Command", nil)
+ string := STRCONC('"{\em )set ",listOfStrings2String [value,:$path],'"}")
+ htMakePage [
+ '(text
+ "{Here is the AXIOM system command you could have issued:}"
+ "\vspace{2}\newline\centerline{\tt"),
+ ['text,:string]]
+ htMakePage '((text . "}\vspace{1}\newline\rm"))
+ htSay '"\vspace{2}{Select \ \UpButton{} \ to go back.}"
+ htSay '"\newline{Select \ \ExitButton{QuitPage} \ to remove this window.}"
+ htProcessDoitButton ['"Press to Remove Page",'"",'htDoNothing]
+ htShowPage()
+
+htSetNotAvailable(htPage,whatToType) ==
+ page := htInitPage('"Unavailable Set Command", htpPropertyList htPage)
+ htInitPage('"Unavailable System Command", nil)
+ string := STRCONC('"{\em ",whatToType,'"}")
+ htMakePage [
+ '(text "\vspace{1}\newline"
+ "{Sorry, but this system command is not available through HyperDoc. Please directly issue this command in an AXIOM window for more information:}"
+ "\vspace{2}\newline\centerline{\tt"),
+ ['text,:string]]
+ htMakePage '((text . "}\vspace{1}\newline"))
+ htProcessDoitButton ['"Press to Remove Page",'"",'htDoNothing]
+ htShowPage()
+
+htDoNothing(htPage,command) == nil
+
+htCheck(checker,value) ==
+ PAIRP checker => htCheckList(checker,parseWord value)
+ FUNCALL(checker,value)
+
+parseWord x ==
+ STRINGP x =>
+ and/[DIGITP x.i for i in 0..MAXINDEX x] => PARSE_-INTEGER x
+ INTERN x
+ x
+
+htCheckList(checker,value) ==
+ if value in '(y ye yes Y YE YES) then value := 'yes
+ if value in '(n no N NO) then value := 'no
+ checker is [n,m] and INTEGERP n =>
+ m = n + 1 =>
+ value in checker => value
+ n
+ null m =>
+ INTEGERP value and value >= n => value
+ n
+ INTEGERP m =>
+ INTEGERP value and value >= n and value <= m => value
+ n
+ value in checker => value
+ first checker
+-- emlist := "STRCONC"/[STRCONC('" {\em ",PNAME x,'"} ") for x in checker]
+-- STRCONC('"Please enter one of: ",emlist)
+
+translateYesNoToTrueFalse x ==
+ x = 'yes => true
+ x = 'no => false
+ x
+
+chkNameList x ==
+ u := bcString2ListWords x
+ parsedNames := [ncParseFromString x for x in u]
+ and/[IDENTP x for x in parsedNames] => parsedNames
+ '"Please enter a list of identifiers separated by blanks"
+
+chkPosInteger s ==
+ (u := parseOnly s) and INTEGERP u and u > 0 => u
+ '"Please enter a positive integer"
+
+chkOutputFileName s ==
+ bcString2WordList s in '(CONSOLE console) => 'console
+ chkDirectory s
+
+chkDirectory s == s
+
+chkNonNegativeInteger s ==
+ (u := ncParseFromString s) and INTEGERP u and u >= 0 => u
+ '"Please enter a non-negative integer"
+
+chkRange s ==
+ (u := ncParseFromString s) and INTEGERP u
+ and u >= $htInitial and (NULL $htFinal or u <= $htFinal)
+ => u
+ null $htFinal =>
+ STRCONC('"Please enter an integer greater than ",stringize ($htInitial - 1))
+ STRCONC('"Please enter an integer between ",stringize $htInitial,'" and ",
+ stringize $htFinal)
+
+chkAllNonNegativeInteger s ==
+ (u := ncParseFromString s) and u in '(a al all A AL ALL) and 'ALL
+ or chkNonNegativeInteger s
+ or '"Please enter {\em all} or a non-negative integer"
+
+htMakePathKey path ==
+ null path => systemError '"path is not set"
+ INTERN fn(PNAME first path,rest path) where
+ fn(a,b) ==
+ null b => a
+ fn(STRCONC(a,'".",PNAME first b),rest b)
+
+htMarkTree(tree,n) ==
+ RPLACD(LASTTAIL tree,n)
+ for branch in tree repeat
+ branch.3 = 'TREE => htMarkTree(branch.5,n + 1)
+
+htSetHistory htPage ==
+ msg := "when the history facility is on (yes), results of computations are saved in memory"
+ data := ['history,msg,'history,'LITERALS,'$HiFiAccess,'(on off yes no)]
+ htShowLiteralsPage(htPage,data)
+
+htSetOutputLibrary htPage ==
+ htSetNotAvailable(htPage,'")set compiler output")
+
+htSetInputLibrary htPage ==
+ htSetNotAvailable(htPage,'")set compiler input")
+
+htSetExpose htPage ==
+ htSetNotAvailable(htPage,'")set expose")
+
+htSetKernelProtect htPage ==
+ htSetNotAvailable(htPage,'")set kernel protect")
+
+htSetKernelWarn htPage ==
+ htSetNotAvailable(htPage,'")set kernel warn")
+
+htSetOutputCharacters htPage ==
+ htSetNotAvailable(htPage,'")set output characters")
+
+htSetLinkerArgs htPage ==
+ htSetNotAvailable(htPage,'")set fortran calling linker")
+
+htSetCache(htPage,:options) ==
+ $path := '(functions cache)
+ htPage := htInitPage(mkSetTitle(),nil)
+ $valueList := nil
+ htMakePage '(
+ (text
+ "Use this system command to cause the AXIOM interpreter to `remember' "
+ "past values of interpreter functions. "
+ "To remember a past value of a function, the interpreter "
+ "sets up a {\em cache} for that function based on argument values. "
+ "When a value is cached for a given argument value, its value is gotten "
+ "from the cache and not recomputed. Caching can often save much "
+ "computing time, particularly with recursive functions or functions that "
+ "are expensive to compute and that are called repeatedly "
+ "with the same argument."
+ "\vspace{1}\newline ")
+ (domainConditions (Satisfies S chkNameList))
+ (text
+ "Enter below a list of interpreter functions you would like specially cached. "
+ "Use the name {\em all} to give a default setting for all "
+ "interpreter functions. "
+ "\vspace{1}\newline "
+ "Enter {\em all} or a list of names (separate names by blanks):")
+ (inputStrings ("" "" 60 "all" names S))
+ (doneButton "Push to enter names" htCacheAddChoice))
+ htShowPage()
+
+htCacheAddChoice htPage ==
+ names := bcString2WordList htpLabelInputString(htPage,'names)
+ $valueList := [listOfStrings2String names,:$valueList]
+ null names => htCacheAddQuery()
+ null rest names => htCacheOne names
+ page := htInitPage(mkSetTitle(),nil)
+ htpSetProperty(page,'names,names)
+ htMakePage '(
+ (domainConditions (Satisfies ALLPI chkAllPositiveInteger))
+ (text
+ "For each function, enter below a {\em cache length}, a positive integer. "
+ "This number tells how many past values will "
+ "be cached. "
+ "A cache length of {\em 0} means the function won't be cached. "
+ "To cache all past values, "
+ "enter {\em all}."
+ "\vspace{1}\newline "
+ "For each function name, enter {\em all} or a positive integer:"))
+ for i in 1.. for name in names repeat htMakePage [
+ ['inputStrings,
+ [STRCONC('"Function {\em ",name,'"} will cache"),
+ '"values",5,10,htMakeLabel('"c",i),'ALLPI]]]
+ htSetvarDoneButton('"Select to Set Values",'htCacheSet)
+ htShowPage()
+
+htMakeLabel(prefix,i) == INTERN STRCONC(prefix,stringize i)
+
+htCacheSet htPage ==
+ names := htpProperty(htPage,'names)
+ for i in 1.. for name in names repeat
+ num := chkAllNonNegativeInteger
+ htpLabelInputString(htPage,htMakeLabel('"c",i))
+ $cacheAlist := ADDASSOC(INTERN name,num,$cacheAlist)
+ if (n := LASSOC('all,$cacheAlist)) then
+ $cacheCount := n
+ $cacheAlist := deleteAssoc('all,$cacheAlist)
+ htInitPage('"Cache Summary",nil)
+ bcHt '"In general, interpreter functions "
+ bcHt
+ $cacheCount = 0 => "will {\em not} be cached."
+ bcHt '"cache "
+ htAllOrNum $cacheCount
+ '"} values."
+ bcHt '"\vspace{1}\newline "
+ if $cacheAlist then
+-- bcHt '" However, \indent{3}"
+ for [name,:val] in $cacheAlist | val ^= $cacheCount repeat
+ bcHt '"\newline function {\em "
+ bcHt stringize name
+ bcHt '"} will cache "
+ htAllOrNum val
+ bcHt '"} values"
+ htProcessDoitButton ['"Press to Remove Page",'"",'htDoNothing]
+ htShowPage()
+
+htAllOrNum val == bcHt
+ val = 'all => '"{\em all"
+ val = 0 => '"{\em no"
+ STRCONC('"the last {\em ",stringize val)
+
+htCacheOne names ==
+ page := htInitPage(mkSetTitle(),nil)
+ htpSetProperty(page,'names,names)
+ htMakePage '(
+ (domainConditions (Satisfies ALLPI chkAllPositiveInteger))
+ (text
+ "Enter below a {\em cache length}, a positive integer. "
+ "This number tells how many past values will "
+ "be cached. To cache all past values, "
+ "enter {\em all}."
+ "\vspace{1}\newline ")
+ (inputStrings
+ ("Enter {\em all} or a positive integer:"
+ "" 5 10 c1 ALLPI)))
+ htSetvarDoneButton('"Select to Set Value",'htCacheSet)
+ htShowPage()
+
+
+
+
+
+
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}