[Axiom-developer] 20071003.01.tpd.patch

[daly]

This patch adds lisp code and spad code to support a browser-based
replacement for hyperdoc. Arthur Ralfs and Alfredo Portes have been
working on the various issues involved in the MathML and socket
connections. As of this change it is no longer necessary to load
http.lisp or compile the axserver.spad code.



===========================================================================
diff --git a/changelog b/changelog
index 6c10a71..21958ab 100644
--- a/changelog
+++ b/changelog
@@ -1,3 +1,10 @@
+20071001 tpd src/algebra/exposed.lisp add (|AxiomServer| . AXSERV) to basic
+20071001 tpd src/algebra/Makefile add axserver.spad
+20071001 acr src/algebra/axserver.spad axserver socket connection code
+20071001 tpd src/interp/Makefile add http.lisp
+20071001 acr src/interp/http.lisp axserver socket connection code
+20071001 acr license/license.ralfs added
+20071001 acr Arthur C. Ralfs <address@hidden>
 20070929 tpd src/input/Makefile pfaffian regression test removed
 20070929 tpd src/input/pfaffian.input regression test removed
 20070927 tpd src/input/Makefile pfaffian regression test added 
diff --git a/license/license.ralfs b/license/license.ralfs
new file mode 100644
index 0000000..ae26469
--- /dev/null
+++ b/license/license.ralfs
@@ -0,0 +1,31 @@
+--Copyright (c) 2007 Arthur C. Ralfs
+--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 Arthur C. Ralfs 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.
+
diff --git a/src/algebra/Makefile.pamphlet b/src/algebra/Makefile.pamphlet
index 1e47325..939e6e5 100644
--- a/src/algebra/Makefile.pamphlet
+++ b/src/algebra/Makefile.pamphlet
@@ -625,7 +625,8 @@ wtpol.spad.pamphlet (WP OWP)
 
 LAYER14=\
   ${OUT}/ASP1.o     ${OUT}/ASP10.o    ${OUT}/ASP24.o    ${OUT}/ASP4.o     \
-  ${OUT}/ASP50.o    ${OUT}/ASP6.o     ${OUT}/ASP73.o    ${OUT}/BALFACT.o  \
+  ${OUT}/ASP50.o    ${OUT}/ASP6.o     ${OUT}/ASP73.o    ${OUT}/AXSERV.o   \
+  ${OUT}/BALFACT.o  \
   ${OUT}/BEZOUT.o   ${OUT}/BINARY.o   ${OUT}/BINFILE.o  ${OUT}/BOUNDZRO.o \
   ${OUT}/BPADICRT.o ${OUT}/BRILL.o    ${OUT}/CDEN.o     ${OUT}/CHVAR.o    \
   ${OUT}/COMMUPC.o  ${OUT}/CONTFRAC.o ${OUT}/CVMP.o     ${OUT}/CYCLOTOM.o \
@@ -1192,6 +1193,7 @@ SPADFILES= \
  ${OUTSRC}/algfunc.spad ${OUTSRC}/allfact.spad ${OUTSRC}/alql.spad \
  ${OUTSRC}/annacat.spad ${OUTSRC}/any.spad ${OUTSRC}/array1.spad \
  ${OUTSRC}/array2.spad ${OUTSRC}/asp.spad ${OUTSRC}/attreg.spad \
+ ${OUTSRC}/axserver.spad \
  ${OUTSRC}/bags.spad ${OUTSRC}/bezout.spad ${OUTSRC}/boolean.spad \
  ${OUTSRC}/brill.spad \
  ${OUTSRC}/c02.spad ${OUTSRC}/c05.spad ${OUTSRC}/c06.spad \
@@ -1351,7 +1353,7 @@ DOCFILES= \
  ${DOC}/algfunc.spad.dvi ${DOC}/allfact.spad.dvi ${DOC}/alql.spad.dvi \
  ${DOC}/annacat.spad.dvi ${DOC}/any.spad.dvi ${DOC}/array1.spad.dvi \
  ${DOC}/array2.spad.dvi ${DOC}/asp.spad.dvi ${DOC}/attreg.spad.dvi \
- ${DOC}/axtimer.as.dvi \
+ ${DOC}/axserver.spad.dvi ${DOC}/axtimer.as.dvi \
  ${DOC}/bags.spad.dvi ${DOC}/bezout.spad.dvi ${DOC}/boolean.spad.dvi \
  ${DOC}/brill.spad.dvi \
  ${DOC}/c02.spad.dvi ${DOC}/c05.spad.dvi ${DOC}/c06.spad.dvi \
diff --git a/src/algebra/axserver.spad.pamphlet 
b/src/algebra/axserver.spad.pamphlet
new file mode 100644
index 0000000..4262996
--- /dev/null
+++ b/src/algebra/axserver.spad.pamphlet
@@ -0,0 +1,258 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/algebra axserver.spad}
+\author{Arthur C. Ralfs}
+\maketitle
+\begin{abstract}
+The AxiomServer package is designed to provide a web interface
+to axiom.
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{Running Axiom Server}
+
+Put the extracted files in a suitable directory, like the one you
+started Axiom from, and issue the commands:
+
+\begin{verbatim}
+)set message autoload off
+)set output mathml on
+axServer(8085,multiServ$AXSERV)
+\end{verbatim}
+
+Of course you need a mathml enabled build of axiom to do this.
+
+Once you've done this Axiom will be in a wait loop on a socket
+listening on port 8085. You can connect to this port by sending 
+the browser to the URL.
+\section{Axiom Server}
+<<package AXSERV AxiomServer>>=
+
+)abbrev package AXSERV AxiomServer
+AxiomServer: public == private where
+
+  public == with
+
+    axServer: (Integer, SExpression->Void) -> Void
+    multiServ: SExpression -> Void
+    fileserver: SExpression -> Void
+    axget: SExpression -> Void
+    axpost: SExpression -> Void
+
+
+  private == add
+
+    getFile: (SExpression,String) -> Void
+    getCommand: (SExpression,String) -> Void
+    lastStep: () -> String
+    lastType: () -> String
+    formatMessages: String -> String
+    formatMessages1: String -> String
+
+
+    axServer(port:Integer,serverfunc:SExpression->Void):Void ==
+      WriteLine("socketServer")$Lisp
+      s := SiSock(port,serverfunc)$Lisp
+      -- To listen for just one connection and then close the socket
+      -- uncomment i := 0.
+      i:Integer := 1
+      while (i > 0) repeat
+        if not null?(SiListen(s)$Lisp)$SExpression then
+          w := SiAccept(s)$Lisp
+          serverfunc(w)
+--        i := 0
+
+    multiServ(s:SExpression):Void ==
+          WriteLine("multiServ")$Lisp
+          headers:String := ""
+          char:String
+          -- read in the http headers
+          while (char := _
+            STRING(READ_-CHAR_-NO_-HANG(s,NIL$Lisp,'EOF)$Lisp)$Lisp) ^= "EOF"_
+             repeat
+              headers := concat [headers,char]
+          sayTeX$Lisp headers
+          StringMatch("([^ ]*)", headers)$Lisp
+          u:UniversalSegment(Integer)
+          u := segment(MatchBeginning(1)$Lisp+1,_
+                              MatchEnd(1)$Lisp)$UniversalSegment(Integer)
+          reqtype:String := headers.u
+          sayTeX$Lisp  concat ["request type: ",reqtype]
+          if  reqtype = "GET" then
+              StringMatch("GET ([^ ]*)",headers)$Lisp
+              u:UniversalSegment(Integer)
+              u := segment(MatchBeginning(1)$Lisp+1,_
+                              MatchEnd(1)$Lisp)$UniversalSegment(Integer)
+              getFile(s,headers.u)
+          if reqtype = "POST" then
+              StringMatch("command=(.*)$",headers)$Lisp
+              u:UniversalSegment(Integer)
+              u := segment(MatchBeginning(1)$Lisp+1,_
+                               MatchEnd(1)$Lisp)$UniversalSegment(Integer)
+              getCommand(s,headers.u)
+
+    getFile(s:SExpression,pathvar:String):Void ==
+        WriteLine("getFile")$Lisp
+        if not null? PATHNAME_-NAME(PATHNAME(pathvar)$Lisp)$Lisp then
+        -- display contents of file
+            q:=OPEN(pathvar)$Lisp
+        else
+            q:=MAKE_-STRING_-INPUT_-STREAM("Problem with file path")$Lisp
+        file:String := ""
+        while (line :=STRING(READ_-LINE(q,NIL$Lisp,'EOF)$Lisp)$Lisp) ^= "EOF" _
+          repeat
+            file := concat [file,line,STRING(NewLine$Lisp)$Lisp]
+        CLOSE(q)$Lisp
+        file := concat _
+          ["Content-Length: ",string(#file),STRING(NewLine$Lisp)$Lisp,_
+            STRING(NewLine$Lisp)$Lisp,file]
+        file := concat ["Connection: close",STRING(NewLine$Lisp)$Lisp,file]
+        file := concat _
+         ["Content-Type: application/xhtml+xml",STRING(NewLine$Lisp)$Lisp,file]
+        file := concat ["HTTP/1.1 200 OK",STRING(NewLine$Lisp)$Lisp,file]
+        f:=MAKE_-STRING_-INPUT_-STREAM(file)$Lisp
+        SiCopyStream(f,s)$Lisp
+        CLOSE(f)$Lisp
+        CLOSE(s)$Lisp
+
+    getCommand(s:SExpression,command:String):Void ==
+        WriteLine$Lisp concat ["getCommand: ",command]
+        SETQ(tmpmathml$Lisp, MAKE_-STRING_-OUTPUT_-STREAM()$Lisp)$Lisp
+        SETQ(tmpalgebra$Lisp, MAKE_-STRING_-OUTPUT_-STREAM()$Lisp)$Lisp
+        SETQ(savemathml$Lisp, _$texOutputStream$Lisp)$Lisp
+        SETQ(savealgebra$Lisp, _$algebraOutputStream$Lisp)$Lisp
+        SETQ(_$texOutputStream$Lisp,tmpmathml$Lisp)$Lisp
+        SETQ(_$algebraOutputStream$Lisp,tmpalgebra$Lisp)$Lisp
+--      parseAndInterpret$Lisp command
+--      parseAndEvalStr$Lisp command
+-- The previous two commands don't exit nicely when a syntactically 
+-- incorrect command is given to them. They somehow need to be wrapped 
+-- in CATCH statements but I haven't figured out how to do this.  
+-- parseAndEvalToStringEqNum  uses the following CATCH statements to 
+-- call parseAndEvalStr but when I try these they don't work.  I get a
+-- "NIL is not a valid identifier to use in AXIOM" message. 
+-- Using parseAndEvalToStringEqNum works and doesn't crash on a syntax error.
+--        v := CATCH('SPAD__READER, _
+           CATCH('top__level, parseAndEvalStr$Lisp command)$Lisp)$Lisp
+--        v = 'restart => ['"error"]
+        ans := string parseAndEvalToStringEqNum$Lisp command
+        SETQ(resultmathml$Lisp,_
+         GET_-OUTPUT_-STREAM_-STRING(_$texOutputStream$Lisp)$Lisp)$Lisp
+        SETQ(resultalgebra$Lisp,_
+         GET_-OUTPUT_-STREAM_-STRING(_$algebraOutputStream$Lisp)$Lisp)$Lisp
+        SETQ(_$texOutputStream$Lisp,savemathml$Lisp)$Lisp
+        SETQ(_$algebraOutputStream$Lisp,savealgebra$Lisp)$Lisp
+        CLOSE(tmpmathml$Lisp)$Lisp
+        CLOSE(tmpalgebra$Lisp)$Lisp
+        -- Since strings returned from axiom are going to be displayed in html
+        -- I should really check for the characters &,<,> and replace them with
+        -- &amp;,&lt;,&gt;.  
+        -- At present I only check for ampersands in formatMessages.
+        mathml:String := string(resultmathml$Lisp)
+        algebra:String := string(resultalgebra$Lisp)
+        algebra := formatMessages(algebra)
+        -- At this point mathml contains the mathml for the output but does 
+        -- not include step number or type information.  We should also save 
+        -- the command. I get the type and step number from the 
+        -- $internalHistoryTable
+        axans:String := concat 
+         ["<div>"_
+           "<div class=_"stepnum_"> (", lastStep(), _
+              ") -&gt; ", command, "</div>" _
+           "<div class=_"algebra_">", algebra, "</div>" _
+           "<div id=_"answer_" class=_"mathml_">", mathml , "</div>" _
+           "<div class=_"type_">Type: ",lastType(),"</div>"_
+          "</div>"]
+        WriteLine$Lisp concat ["mathml answer: ",mathml]
+        WriteLine$Lisp concat ["algebra answer: ",algebra]
+        q:=MAKE_-STRING_-INPUT_-STREAM(axans)$Lisp
+        SiCopyStream(q,s)$Lisp
+        CLOSE(q)$Lisp
+        CLOSE(s)$Lisp
+
+    lastType():String ==
+--  The last history entry is the first item in the 
+--  $internalHistoryTable list so car(_$internalHistoryTable$Lisp) 
+--  selects it.  Here's an example:
+--  (3 (x+y)**3 (% (value (Polynomial (Integer)) WRAPPED 1 y 
+--   (3 0 . 1) (2 1 x (1 0 . 3)) (1 1 x (2 0 . 3)) (0 1 x (3 0 . 1)))))
+--  This corresponds to the input "(x+y)**3" being issued as the third 
+--  command after starting axiom. 
+--  The following line selects the type information.
+        string cadr(cadar(cddar(_$internalHistoryTable$Lisp)$Lisp)$Lisp)$Lisp
+
+    lastStep():String == 
+        string caar(_$internalHistoryTable$Lisp)$Lisp
+
+    formatMessages(str:String):String ==
+        WriteLine("formatMessages")$Lisp
+        -- I need to replace any ampersands with &amp; and may also need to
+        -- replace < and > with &lt; and &gt;
+        strlist:List String
+        WriteLine(str)$Lisp
+        strlist := split(str,char "&")
+        str := ""
+        for s in strlist repeat
+            str := concat [str,s,"&amp;"]
+        strlen:Integer := #str
+        str := str.(1..(#str - 5))
+        WriteLine(str)$Lisp
+        -- Here I split the string into lines and put each line in a "div".
+        strlist := split(str, char string NewlineChar$Lisp)
+        str := ""
+        WriteLine("formatMessages1")$Lisp
+        WriteLine(concat strlist)$Lisp
+        for s in strlist repeat
+            WriteLine(s)$Lisp
+            str := concat [str,"<div>",s,"</div>"]
+        str
+
+
+@
+        
+\section{License}
+<<license>>=
+--Copyright (c) 2007 Arthur C. Ralfs
+--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 Arthur C. Ralfs 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.
+
+
+@
+
+<<*>>=
+<<package AXSERV AxiomServer>>
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
diff --git a/src/algebra/exposed.lsp.pamphlet b/src/algebra/exposed.lsp.pamphlet
index c893d91..ed6155a 100644
--- a/src/algebra/exposed.lsp.pamphlet
+++ b/src/algebra/exposed.lsp.pamphlet
@@ -62,6 +62,7 @@
   (|AssociatedJordanAlgebra| . JORDAN)
   (|AssociatedLieAlgebra| . LIE)
   (|AttachPredicates| . PMPRED)
+  (|AxiomServer| . AXSERV)
   (|BalancedBinaryTree| . BBTREE)
   (|BasicOperator| . BOP)
   (|BasicOperatorFunctions1| . BOP1)
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet
index 3fa2d97..5404c64 100644
--- a/src/interp/Makefile.pamphlet
+++ b/src/interp/Makefile.pamphlet
@@ -156,6 +156,9 @@ by being compiled.
 
 Another exception is gclweb.lisp. This file contains lisp to extract
 code from literate documents. It is not a literate document.
+
+The file http.lisp contains code to enable browser-based hyperdoc
+and graphics.
 <<environment>>=
 OBJS= ${OUT}/vmlisp.${O}      ${OUT}/hash.${O} \
       ${OUT}/bootfuns.${LISP} ${OUT}/macros.${O} \
@@ -175,6 +178,7 @@ OBJS= ${OUT}/vmlisp.${O}      ${OUT}/hash.${O} \
       ${OUT}/g-error.${O}     ${OUT}/g-opt.${O} \
       ${OUT}/g-timer.${O}     ${OUT}/g-util.${O} \
       ${OUT}/gclweb.${O}      ${OUT}/ggreater.${O}    \
+      ${OUT}/http.${O} \
       ${OUT}/hypertex.${O}    ${OUT}/i-analy.${O} \
       ${OUT}/i-code.${O}      ${OUT}/i-coerce.${O} \
       ${OUT}/i-coerfn.${O}    ${OUT}/i-eval.${O} \
@@ -4013,6 +4017,29 @@ ${MID}/gclweb.lisp: ${IN}/gclweb.lisp
        @( cp ${IN}/gclweb.lisp ${MID}/gclweb.lisp )
 
 @
+
+\subsection{http.lisp}
+<<http.o (OUT from MID)>>=
+${OUT}/http.${O}: ${MID}/http.lisp
+       @ echo 367 making ${OUT}/http.${O} from ${MID}/http.lisp
+       @ ( cd ${MID} ; \
+         if [ -z "${NOISE}" ] ; then \
+          echo '(progn  (compile-file "${MID}/http.lisp"' \
+             ':output-file "${OUT}/http.${O}") (${BYE}))' | ${DEPSYS} ; \
+         else \
+          echo '(progn  (compile-file "${MID}/http.lisp"' \
+             ':output-file "${OUT}/http.${O}") (${BYE}))' | ${DEPSYS} \
+             >${TMP}/trace ; \
+         fi )
+
+@
+<<http.lisp (MID from IN)>>=
+${MID}/http.lisp: ${IN}/http.lisp
+       @ echo 368 making ${MID}/http.lisp from ${IN}/http.lisp
+       @( cp ${IN}/http.lisp ${MID}/http.lisp )
+
+@
+
 \subsection{hypertex.boot}
 <<hypertex.o (OUT from MID)>>=
 ${OUT}/hypertex.${O}: ${MID}/hypertex.clisp 
@@ -8809,6 +8836,9 @@ clean:
 <<gclweb.o (OUT from MID)>>
 <<gclweb.lisp (MID from IN)>>
 
+<<http.o (OUT from MID)>>
+<<http.lisp (MID from IN)>>
+
 <<hash.o (OUT from MID)>>
 <<hash.lisp (MID from IN)>>
 <<hash.lisp.dvi (DOC from IN)>>
diff --git a/src/interp/http.lisp b/src/interp/http.lisp
new file mode 100644
index 0000000..9db87f8
--- /dev/null
+++ b/src/interp/http.lisp
@@ -0,0 +1,23 @@
+(in-package "BOOT")
+
+(defvar |StandardOutput| *standard-output*)
+
+(defvar  |NewLine| '#\NewLine)
+
+;; some regexp stuff
+
+(defun |StringMatch| (s1 s2) (si::string-match s1 s2))
+(defun |ListMatches| (&rest args) (si::list-matches args))
+(defun |MatchBeginning| (i) (si::match-beginning i))
+(defun |MatchEnd| (i) (si::match-end i))
+
+;; the socket stuff
+
+(defun |SiSock| (p spadfn)
+  (si::socket p :server
+   (function (lambda (w) (SPADCALL w spadfn) )) :daemon nil))
+
+(defun |SiListen| (s) (si::listen s))
+(defun |SiAccept| (s) (si::accept s))
+(defun |SiCopyStream| (q s) (si::copy-stream q s))
+