[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Axiom-developer] 20071013.01.acr.patch
|
From: |
daly |
|
Subject: |
[Axiom-developer] 20071013.01.acr.patch |
|
Date: |
Sun, 14 Oct 2007 01:10:25 -0500 |
This patch allows faster browsing of new hyperdoc web pages
=========================================================================
diff --git a/changelog b/changelog
index 7c61a45..7608e21 100644
--- a/changelog
+++ b/changelog
@@ -1,3 +1,6 @@
+20071013 acr license/license.ralfs license rewrite
+20071013 acr src/interp/http.lisp faster page service
+20071013 acr src/algebra/axserver.spad faster page service
20071005 tpd src/input/Makefile kamke7.input regression test added
20071005 tpd src/input/kamke7.input ODE regression test added
20071005 tpd src/input/Makefile kamke6.input regression test added
diff --git a/license/license.ralfs b/license/license.ralfs
index ae26469..220429c 100644
--- a/license/license.ralfs
+++ b/license/license.ralfs
@@ -13,9 +13,9 @@
-- 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.
+-- - The name of Arthur C. Ralfs may not 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
diff --git a/src/algebra/axserver.spad.pamphlet
b/src/algebra/axserver.spad.pamphlet
index 4262996..791d851 100644
--- a/src/algebra/axserver.spad.pamphlet
+++ b/src/algebra/axserver.spad.pamphlet
@@ -33,181 +33,230 @@ the browser to the URL.
)abbrev package AXSERV AxiomServer
AxiomServer: public == private where
- public == with
+ public == with
- axServer: (Integer, SExpression->Void) -> Void
- multiServ: SExpression -> Void
- fileserver: SExpression -> Void
- axget: SExpression -> Void
- axpost: SExpression -> Void
+ axServer: (Integer, SExpression->Void) -> Void
+ multiServ: SExpression -> Void
+ private == add
- private == add
+ getFile: (SExpression,String) -> Void
+ getCommand: (SExpression,String) -> Void
+ lastStep: () -> String
+ lastType: () -> String
+ formatMessages: String -> String
+ getContentType: String -> String
- 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
- 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 begin")$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]
+ WriteLine(headers)$Lisp
+ StringMatch("([^ ]*)", headers)$Lisp
+ u:UniversalSegment(Integer)
+ u := segment(MatchBeginning(1)$Lisp+1,_
+ MatchEnd(1)$Lisp)$UniversalSegment(Integer)
+ reqtype:String := headers.u
+ WriteLine$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)
+ WriteLine("multiServ end")$Lisp
+ WriteLine("")$Lisp
- 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("")$Lisp
+ WriteLine("getFile begin")$Lisp
+ if not null? PATHNAME_-NAME(PATHNAME(pathvar)$Lisp)$Lisp then
+ contentType:String := "application/xhtml+xml"
+ q := Open(pathvar)$Lisp
+ if null? q then
+ q := MAKE_-STRING_-INPUT_-STREAM("File doesn't exist")$Lisp
+ WriteLine("File does not exist.")$Lisp
+ else
+ q:=MAKE_-STRING_-INPUT_-STREAM("Problem with file path")$Lisp
+ file:String := ""
+ WriteLine("begin reading file")$Lisp
+ r := MAKE_-STRING_-OUTPUT_-STREAM()$Lisp
+ SiCopyStream(q,r)$Lisp
+ filestream:String := GET_-OUTPUT_-STREAM_-STRING(r)$Lisp
+ CLOSE(r)$Lisp
+ CLOSE(q)$Lisp
+ filelength:String := string(#filestream)
+ WriteLine("end reading file")$Lisp
+ file := concat ["Content-Length: ",filelength,_
+ STRING(NewLine$Lisp)$Lisp,STRING(NewLine$Lisp)$Lisp,file]
+ file := concat ["Connection: close",STRING(NewLine$Lisp)$Lisp,file]
+ file := concat ["Content-Type: ",contentType,_
+ STRING(NewLine$Lisp)$Lisp,file]
+ file := concat ["HTTP/1.1 200 OK",STRING(NewLine$Lisp)$Lisp,file]
+ file := concat [file,filestream]
+ f:=MAKE_-STRING_-INPUT_-STREAM(file)$Lisp
+ SiCopyStream(f,s)$Lisp
+ CLOSE(f)$Lisp
+ CLOSE(s)$Lisp
+ WriteLine("getFile end")$Lisp
+ WriteLine("")$Lisp
- 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
+ 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
+-- 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.
+-- 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
+-- CATCH('top__level, parseAndEvalStr$Lisp command)$Lisp)$Lisp
-- v = 'restart => ['"error"]
- ans := string parseAndEvalToStringEqNum$Lisp command
- SETQ(resultmathml$Lisp,_
+ ans := string parseAndEvalToStringEqNum$Lisp command
+ SETQ(resultmathml$Lisp,_
GET_-OUTPUT_-STREAM_-STRING(_$texOutputStream$Lisp)$Lisp)$Lisp
- SETQ(resultalgebra$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
- -- &,<,>.
- -- 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(), _
- ") -> ", 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
+ 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
+ -- &,<,>. At present I only check for ampersands in
+ -- formatMessages. MathML should already be valid xml.
+ 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=_"command_">(",lastStep(),") -> ",_
+ command,"</div><div class=_"algebra_">",_
+ algebra,"</div><div 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 ==
+ lastType():String ==
-- The last history entry is the first item in the
--- $internalHistoryTable list so car(_$internalHistoryTable$Lisp)
--- selects it. Here's an example:
+-- $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
+-- (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 car(car(_$internalHistoryTable$Lisp)$Lisp)$Lisp
+
+
+ formatMessages(str:String):String ==
+ WriteLine("formatMessages")$Lisp
+ -- I need to replace any ampersands with & and may also need to
+ -- replace < and > with < and >
+ strlist:List String
+ WriteLine(str)$Lisp
+ strlist := split(str,char "&")
+ str := ""
+ -- oops, if & is the last character in the string this method
+ -- will eliminate it. Need to redo this.
+ for s in strlist repeat
+ str := concat [str,s,"&"]
+ 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
- lastStep():String ==
- string caar(_$internalHistoryTable$Lisp)$Lisp
+ getContentType(pathvar:String):String ==
+ WriteLine("getContentType begin")$Lisp
+ -- set default content type
+ contentType:String := "text/plain"
+ -- need to test for successful match?
+ StringMatch(".*\.(.*)$", pathvar)$Lisp
+ u:UniversalSegment(Integer)
+ u := segment(MatchBeginning(1)$Lisp+1,_
+ MatchEnd(1)$Lisp)$UniversalSegment(Integer)
+ extension:String := pathvar.u
+ WriteLine$Lisp concat ["file extension: ",extension]
+ -- test for extensions: html, htm, xml, xhtml, js, css, png, jpg, jpeg
+ if extension = "html" then
+ contentType:String := "text/html"
+ else if extension = "htm" then
+ contentType:String := "text/html"
+ else if extension = "xml" then
+ contentType:String := "text/xml"
+ else if extension = "xhtml" then
+ contentType:String := "application/xhtml+xml"
+ else if extension = "js" then
+ contentType:String := "text/javascript"
+ else if extension = "css" then
+ contentType:String := "text/css"
+ else if extension = "png" then
+ contentType:String := "image/png"
+ else if extension = "jpg" then
+ contentType:String := "image/jpeg"
+ else if extension = "jpeg" then
+ contentType:String := "image/jpeg"
+ WriteLine$Lisp concat ["Content-Type: ",contentType]
+ WriteLine("getContentType end")$Lisp
+ contentType
- formatMessages(str:String):String ==
- WriteLine("formatMessages")$Lisp
- -- I need to replace any ampersands with & and may also need to
- -- replace < and > with < and >
- strlist:List String
- WriteLine(str)$Lisp
- strlist := split(str,char "&")
- str := ""
- for s in strlist repeat
- str := concat [str,s,"&"]
- 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
@
@@ -229,9 +278,9 @@ AxiomServer: public == private where
-- 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.
+-- - The name of Arthur C. Ralfs may not 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
diff --git a/src/interp/http.lisp b/src/interp/http.lisp
index 9db87f8..6feb283 100644
--- a/src/interp/http.lisp
+++ b/src/interp/http.lisp
@@ -1,6 +1,9 @@
(in-package "BOOT")
-(defvar |StandardOutput| *standard-output*)
+(defun |Open| (path)
+ (si::open path :direction :input :if-exists nil :if-does-not-exist nil)
+ )
+
(defvar |NewLine| '#\NewLine)
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Axiom-developer] 20071013.01.acr.patch,
daly <=