%% $OpenXM: OpenXM/src/kan96xx/Doc/httpd-asir.sm1,v 1.29 2009/02/22 17:30:03 ohara Exp $
%% http server by sm1

[(parse) (httpd.sm1) pushfile] extension pop

/httpd.port 1200 def
/httpd.image.name (kobeuniv2.jpg) def

/httpd.initialization
%% Put initialization codes here.
 [
  (XM_debug=0; ctrl("debug_window",0);)
  ("Asirweb version 0.80. "+
   " Risa/Asir oxasir version "+rtostr(version());)
 ] cat
def

[(parse) (oxasir.sm1) pushfile] extension 
(oxasir.started) boundp { 
} {
  %% Initialize oxasir.
  [(x^2-1) (x)] fctr pop
  oxasir.ccc oxmathcap
  oxasir.ccc oxsetmathcap
} ifelse

/ox-win.start.iconic 1 def
/ox.win.set.start {
  [(stat) (c:\windows\system32\cmd.exe)] extension 0 get
  0 eq {
    /ox.win.start.0 [(c:\windows\system32\cmd.exe) (/c) (start)] def 
    /ox.win.start [ox.win.start.0 aload pop
                   ox-win.start.iconic { (/min) } { } ifelse ] def
  }{
   [(stat) (c:\winnt\system32\cmd.exe)] extension 0 get
   0 eq {
      /ox.win.start.0 [(c:\winnt\system32\cmd.exe) (/c) (start) ] def
      /ox.win.start [ox.win.start.0 aload pop
                     ox-win.start.iconic { (/min) } { } ifelse ] def
   }{
     /ox.win.start.0 [ (start) ] def 
     /ox.win.start [ ox.win.start.0 aload pop
                     ox-win.start.iconic { (/min) } { } ifelse ] def
   } ifelse
  } ifelse
} def

/webasir { asirweb } def
/asirweb {
 [/rrr /cmd] pushVariables
 [
  %% This procedure to generate port number might fail.
  [(oxGenPass)] extension . (integer) dc  /rrr set
  rrr << rrr 20000 idiv 20000 mul >> sub /rrr set
  /httpd.port 1200 rrr add def
  httpd.port message 

  %%[(sleep 3; netscape -geometry 800x500 http://localhost:)
  %%  httpd.port toString
  %% ( &)] cat system
   [(ostype)] extension 0 get
   (windows) eq {
     %% On windows.
      ox.win.set.start
      [(forkExec)
       [
         %%(c:\windows\command\start)
         ox.win.start.0 aload pop
         (iexplore)   %% Starting internet explorer (TM).
         [(http://localhost:) httpd.port toString] cat
       ]
       [  ]
      3] extension
   }{
      %% On unix.
      httpd.port httpd.startBrowserUnix
   } ifelse

   httpd ;
  ] pop
  popVariables
} def


/httpd_action {
  [/in-httpd /ff /httpd.com /httpd.result /sss
   /sss.engine /sss.web /err
   /oxserver.vname
  ] pushVariables
  [
  {
       [(sm1.socket) (select) [httpd.server.fd 0 get -1]] extension 
       %%     wait for ever
        [(sm1.socket) (readHTTP) [httpd.server.fd 0 get ]] extension /ff set
        ff tag 0 eq {
           (connection is closed.) message exit
        }
        {
          (------------  start ----------------------) message
             ff message
          (-----------------------------------------) message
             ff 1 copy askToSendFile /httpd.sendFile set
             httpd.sendFile tag 0 eq {
               ff removeGET webstringToAscii /httpd.com set 
             } {
               /httpd.com (NONE) def
             } ifelse
             [(httpd.com=) httpd.com] cat message
             (httpd.sendFile=) messagen httpd.sendFile message
          (------------  end ----------------------) message
          (   ) message
          httpd.serial 0 eq {
            /httpd.com  httpd.initialization def 
            /httpd.textarea.valid 1 def
          } { } ifelse
          httpd.sendFile tag 0 eq { }
          {
            httpd.sendFile httpd.image.type send-image
            exit  %% exit the loop LOOP-A
          } ifelse
          httpd.com metaCommand {
            httpd.textarea.valid {
              /oxserver.vname 
                 [Oxserver_history_variable httpd.serial toString] cat
              def
              oxasir.ccc 
              [(if (1) {)  httpd.com  (; };)] cat
              oxexecutestring ;
            }{
              send-page-warning  exit
            } ifelse
            [(oxReq) oxasir.ccc SM_dupErrors ] extension pop

            [(oxReq) oxasir.ccc SM_popCMO ] extension pop

            [(oxReq) oxasir.ccc SM_setName oxserver.vname] extension pop
            oxasir.ccc [oxserver.vname (;)] cat oxexecutestring

            [(oxReq) oxasir.ccc SM_popString ] extension pop
            [(flush)] extension pop
            %% Select inputs for interruption.
            %% Wait by the spin lock.
            {
              [(oxMultiSelect) [oxasir.ccc] 1] extension 1 get 0 get
              /sss.engine set
              [(sm1.socket) (mselect)
                [[httpd.server.fd 0 get] 1]
              ] extension 0 get /sss.web set
              /sss [sss.engine sss.web] def
              sss.engine { exit } { } ifelse
              sss.web    { exit } { } ifelse
            } loop
            sss message

            sss 0 get {
                [(oxGet) oxasir.ccc] extension  /err          set
                [(oxGet) oxasir.ccc] extension  /httpd.result set
                %% oxasir.ccc oxpopstring /httpd.result set
            } {
                oxasir.ccc oxreset
                oxasir.ccc ("computation is interrupted.";) oxexecutestring ;
                oxasir.ccc oxpopstring
                /httpd.result set 
                exit
            } ifelse
            (------------- result -------------) message
            httpd.result message
            (----------------------------------) message
            (  ) message

            err message
            err [ ] eq  { 
              /httpd.history 
                httpd.history 
                [10 (string) dc 
                 (/**** ) httpd.serial toString ( ****/) 
                 10 (string) dc
                  httpd.com 
                 (;)  %% add extra ;
                 ] cat
                append 
              def
            } {
              oxasir.ccc cleanErrors
              [httpd.result 10 (string) dc err toString] cat
              /httpd.result set
            } ifelse

            [httpd.serial 0 eq { } {
                (<title> asirweb </title> )
                (<font color="blue"> Input-) httpd.serial toString
                 (: </font> )  
                 httpd.com preformatHTML (<br>)
              } ifelse
             (<font color="green"> Output-) httpd.serial toString
             (: </font> ) 
             (<a href="http://localhost:)  httpd.port toString
             (/?msg=httpdAsirMeta+Pretty+) httpd.serial toString 
             ("> (in pretty format) </a>) 
             %%(<a href=") httpd.image.name ("> (in pretty format) </a>) %%test
              httpd.result preformatHTML
              httpd.result.history httpd.result append /httpd.result.history set
            ] cat
            send-page-3  exit  %% exit the loop LOOP-A
          } { exit } ifelse  %% metaCommand
        } ifelse
  } loop  %% LOOP-A
  ] pop
  popVariables
} def



/httpd.asirman
 ("http://www.math.sci.kobe-u.ac.jp/OpenXM/Current/doc/asir2000/html-ja/man_toc.html")
def
/httpd.asirman.contrib
  ("http://www.math.sci.kobe-u.ac.jp/OpenXM/Current/doc/asir-contrib/ja/cman-html/cman-ja_toc.html")
def
/httpd.asir.intro
   ("http://www.math.sci.kobe-u.ac.jp/~taka/asir-book-html/main")
def
/send-menu-1 {
  
  (FILE:) sendln
  [$<a href="http://localhost:$ httpd.port toString
   $/?msg=httpdAsirMeta+quit"> Shutdown the asir server. </a>, $
  ] cat sendln
%%  [$<a href="http://localhost:$ httpd.port toString
%%   $/?msg=httpdAsirMeta+interrupt"> interrupt </a>, $
%%  ] cat sendln
  [$<a href="http://localhost:$ httpd.port toString
   $/?msg=httpdAsirMeta+save"> save. </a>, $
  ] cat sendln
  ( <spacer type=horizontal size=80> ) sendln

  (HELP:) sendln
  [(<font color="red"> 
    <a href=) httpd.asirman ( > AsirManual (Ja) </a> </font>, )] cat sendln
  [(<font color="purple"> 
    <a href=) httpd.asirman.contrib ( > AsirContrib (Ja) </a> </font>, )] cat sendln
  [(<font color="blue"> 
    <a href=) httpd.asir.intro ( > Intro (Ja) </a> </font>, )] cat sendln
} def

/send-page-save {
 [/in-send-page-save /i] pushVariables
 [
   (HTTP/0.9 200 OK) sendln
   (Connection: close) sendln
   (Content-Type: text/plain) sendln
   0 sendln
   (/* Saved the following to sm1out.txt */) sendln
   (/* Save the following by your browser as a text file. */) sendln
   
   0 1 httpd.history length 1 sub {
     /i set
     httpd.history i get sendln
   } for
   ( end$) sendln
   0 sendln
   [(flush)] extension
   [(PrintDollar) 1] system_variable
   httpd.history output
   [(PrintDollar) 0] system_variable
 ] pop
 popVariables
} def


/metaCommand {
  /arg1 set
  [/in-metaCommand /msg /result /msg2 /nn
   /err /fn
  ] pushVariables
  [
    /msg arg1 def
    /result 1 def
    msg 1 copy toTokensBySpace /msg2 set
    msg2 length 3 eq {
      msg2 0 get (httpdAsirMeta) eq 
      msg2 1 get (Pretty) eq and
      {
        httpd.image.type tag 0 eq {
          send-page-warning-image
          /skip-image goto
        } {  } ifelse


        msg2 2 get . (integer) dc /nn set 

        %% Reformat the "nn"-th result by tex and send it.
        %% BUG: index is out of bound. httpd.result.history nn get message

        oxasir.ccc
        [$print_$ httpd.image.type $_form(Oxserver_history_variable_$
         nn toString
         $);$
        ] cat
        (cmo)
        executeStringAndSelectInputFromBrowserAndOxserver
        dup 0 get /err set
            1 get /fn set
        err [ ] eq {
           fn 0 get httpd.image.type send-image          
        } {
           [err preformatHTML] cat
           send-page-3
        } ifelse
        %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

        /skip-image 
        /result 0 def
      } { } ifelse    
    }{ } ifelse
    msg (httpdAsirMeta quit) eq {
       oxasir.ccc oxshutdown
       send-page-bye
       quit
       /result 0 def
    } { } ifelse
    msg (httpdAsirMeta save) eq {
       send-page-save
       /result 0 def
    } { } ifelse
    msg (httpdAsirMeta interrupt) eq {
       oxasir.ccc oxreset
       (Interrupted! <br>) send-page-3
       /result 0 def
    } { } ifelse
    /arg1 result def
  ] pop
  popVariables
  arg1
} def