Re: xml literals

[Damien MATTEI <Damien.Mattei@unice.fr>]

[-- Attachment #1: Type: text/plain, Size: 4022 bytes --]

works... yes but , i have find some interesting clues:

-still needing to use the literal to avoid the error:
Exception in thread "main" java.lang.Error: gnu.kawa.xml.MakeElement does not implement Externalizable
if you issue a literal:toString it avoids the compiler trying to "Externalize" an object it does know how to externs but know how to do it for it for String

example:
(set! html-literal
     	   #<td align="center">&[html-literal-table]</>)
     
     (set! html-literal-str (html-literal:toString))

no compile error

the problem is not specific to function call style but also with # literal, but after all perheaps it is the side effect of set! returning a literal which should be avoid in the code... i do not know.

-(simple ) slicing, a Kawa only feature seems to do not work always in literals, here his some test examples:

 ;;(apply html:table literal-rows-list)) ;; OK
	   ;;(html:table literal-rows-list)) ;; OK but non-sense
	   ;;(html:table @literal-rows-list)) ;; KO
	   ;;(html:table option-lst literal-rows-list)) ;; OK but non-sense
	   ;;(html:table @option-lst @literal-rows-list)) ;; KO
	   ;;#<table DIR="LTR" BORDER="1" width="312" id="table_observateurs">&[@literal-rows-list]</>) ;; KO
	   ;;#<table DIR="LTR" BORDER="1" width="312" id="table_observateurs">@&[literal-rows-list]</>) ;; OK
	   ;;#<table DIR="LTR" BORDER="1" width="312" id="table_observateurs">POPUP</>) ;; OK
	   ;;#<table>POP UP</>) ;; OK
	   ;;(html:table "POP UP")) ;; OK

for example this works:

(set! options-and-arguments-lst
	   (append option-lst literal-rows-list))

        (set! html-literal-table
	   (apply html:table options-and-arguments-lst)) ;; OK

but not those:
;;(html:table @literal-rows-list)) ;; KO
	   ;;(html:table option-lst literal-rows-list)) ;; OK but non-sense
	   ;;(html:table @option-lst @literal-rows-list)) ;; KO

the good thing is i finally succeed in making my program (in attachments) compiling and running by melting function call style and literal list but the both are working
 if you take some special cautions with side-effects and slicing too.

the output is not human readable:
<td align="center"><table xmlns="http://www.w3.org/1999/xhtml" DIR="LTR" BORDER="1" width="315" id="table_observateurs"><tr><td DIR="LTR" ALIGN="LEFT">RGY</td><td DIR="LTR" ALIGN="LEFT">NuLL</td></tr><tr><td DIR="LTR" ALIGN="LEFT">LM</td><td DIR="LTR" ALIGN="LEFT">NuLL</td></tr><tr><td DIR="LTR" ALIGN="LEFT">BSL</td><td DIR="LTR" ALIGN="LEFT">NuLL</td></tr><tr><td DIR="LTR" ALIGN="LEFT">KHA</td><td DIR="LTR" ALIGN="LEFT">  ? ? </td></tr><tr><td DIR="LTR" ALIGN="LEFT">TME</td><td DIR="LTR" ALIGN="LEFT">  ? ? </td></tr><tr><td DIR="LTR" ALIGN="LEFT">TM</td><td DIR="LTR" ALIGN="LEFT">?</td></tr><tr><td DIR="LTR" ALIGN="LEFT">ABT</td><td DIR="LTR" ALIGN="LEFT">Abetti G.</td></tr><tr><td DIR="LTR" ALIGN="LEFT">AFR</td><td DIR="LTR" ALIGN="LEFT">Africano</td></tr><tr><td DIR="LTR" ALIGN="LEFT">AHN</td><td DIR="LTR" ALIGN="LEFT">Ahnert P. von</td></tr>.......

i think there is a way to include in Kawa literal some non interpreted character,i see in the doc, to have some  human readable html page,i will try this later.

regards,

Damien

Le Wednesday 07 June 2017 20:16:05 Per Bothner, vous avez écrit :
> On 06/07/2017 09:23 AM, Per Bothner wrote:
> > On 06/07/2017 07:17 AM, Damien MATTEI wrote:
> >> i checked in my Dropbox history at what point did the code begin to compile with error and issued a diif on the files and get this:
> >> [mattei@moita Jkawa]$ diff DBtoWebObserversKawa.scm DBtoWebObserversKawa_first_bug.scm
> >> 287c287
> >> <          (html:td html-literal-table))
> >> ---
> >>>           (html:td align: "center" html-literal-table))
> >>
> >> seems that the simple fact to add an attribute makes the errors.
> > 
> > Indeed, I've reproduced the problem.
> > 
> > I have to think about the best fix.
> 
> Using XML literals works:
> 
>   #<td align="center">&[html-literal-table]</>



[-- Attachment #2: DBtoWebObserversKawa.scm --]
[-- Type: text/plain, Size: 14399 bytes --]

;; Kawa Scheme code for java virtual machine and tomcat web server

;; author: Damien Mattei

;; compilation method:

;; java -cp /usr/local/share/java/kawa-2.1.jar:/home/mattei/NetBeansProjects/Sidonie/build/web/WEB-INF/classes kawa.repl -C DBtoWebObserversKawa.scm
;; 
;; to add more tail-calls optimisations:
;; java -cp /usr/local/share/java/kawa-2.1.jar:/home/mattei/NetBeansProjects/Sidonie/build/web/WEB-INF/classes kawa.repl --full-tailcalls -C DBtoWebObserversKawa.scm 
;; jar cf ~/Dropbox/KawaFunctProg.jar eu

;; java -cp /usr/local/share/java/kawa-2.1.jar:/home/mattei/NetBeansProjects/Sidonie/build/web/WEB-INF/classes kawa.repl --output-format html -C DBtoWebObserversKawa.scm
;;
;; java -cp /home/mattei/kawa-2.4/lib/kawa.jar:/home/mattei/NetBeansProjects/Sidonie/build/web/WEB-INF/classes kawa.repl --output-format html -C DBtoWebObserversKawa.scm

(module-name "eu.oca.kawafunct.DBtoWebObserversKawa")

(require 'regex)
;;(require 'xml)

(include-relative  "../git/LOGIKI/lib/first-and-rest.scm")
(include-relative  "../git/LOGIKI/lib/syntactic-sugar.scm") ;; YES in kawa you can include files from other schemes...
(include-relative  "../git/LOGIKI/lib/display.scm")
(include-relative  "../git/LOGIKI/lib/case.scm") ;; for CASE with STRINGS
(include-relative  "../git/LOGIKI/lib/list.scm") ;; for remove-last used by map.scm
(include-relative  "../git/LOGIKI/lib/set.scm") ;; for map-nil*
(include-relative  "../git/LOGIKI/lib/map.scm") ;; for map-nil*




(define-simple-class DBtoWebObserversKawa ()

 
  (Nom ::java.lang.String init-keyword: Nom:)
  (res ::java.lang.String init-keyword: res:)
  
  ((*init*
	   (nomParam ::java.lang.String)
	   )
   
   (set! Nom nomParam)
   
   #;(work))

  
  ;; Need a default constructor as well.
  ((*init*) #!void)

  
  ((work) ::java.lang.String ;; do the job:

   (eu.oca.DataBase:searchDriverStatic)
   (display "DBtoWebObserversKawa : work : eu.oca.DataBase:searchDriverStatic PASSED")
   (newline)
   
   (eu.oca.DataBase:connectStatic)
   (display "DBtoWebObserversKawa : work : eu.oca.DataBase:connectStatic PASSED")
   (newline)

   (eu.oca.DataBase:createStatementStatic) ;; i put the statement here if it's true it can be reused for multiple SQL queries
   (display "DBtoWebObserversKawa : work : eu.oca.DataBase:createStatementStatic PASSED")
   (newline)

   
   (let* ((marequete "SELECT * FROM Obs ORDER BY Auteur")
	  
	  (rs ::java.sql.ResultSet #!null)
	  (total '())
	  (result '())


	  ;; first we fetch the data "outremer" and parse the file to get the observers code
	  (wds-url "http://ad.usno.navy.mil/wds/Webtextfiles/wdsnewref.txt")
	  ;; (define wds-url "http://ad.usno.navy.mil/wds/Webtextfiles/wdsnewref.txt")
	  (wds-data-str &<{&[wds-url]}) ;; could take a few seconds to GET file
	  ;; (define wds-data-str &<{&[wds-url]})
	  ;;(str1 (substring wds-data-str 0 30))
	  (len-wds-data-str (string-length wds-data-str))
	  
	  ;; get and split using positions of the minus ----- lines
	  (pos-minus  
	   (regex-match-positions
	    "-----------------------------------------------------------------------------------------------------------------------------" 
	    wds-data-str))
	  
	  (pos-minus-end (cdr (car pos-minus)))
	  
	  (wds-data-str-minus-1 (substring
				 wds-data-str
				 pos-minus-end
				 (- (string-length wds-data-str) 1)))
	  
	  (pos-minus2  
	   (regex-match-positions
	    "-----------------------------------------------------------------------------------------------------------------------------" 
	    wds-data-str-minus-1))
	  
	  (pos-minus2-end (cdr (car pos-minus2)))
	  
	  (wds-data-str-minus-2 (substring
				 wds-data-str-minus-1
				 pos-minus2-end
				 (- (string-length wds-data-str-minus-1) 1)))
	  
	  ;; get and split using positions of the equals ====== line
	  (pos-equals
	   (regex-match-positions
	    "========================================================================================================"
	    wds-data-str-minus-2))

	  (pos-equals-begin (car (car pos-equals)))

	  (wds-data-str-equals (substring
				wds-data-str-minus-2
				0
				(- pos-equals-begin 1)))

	  ;;(wds-data-str-split (regex-split (string #\return) wds-data-str)) 
	  (wds-data-str-split (regex-split (string #\linefeed) wds-data-str-equals))
	  ;; (define wds-data-str-split (regex-split (string #\linefeed) wds-data-str))

	  ;; remove null string
	  (rgx (begin 
		 (display-nl  "DBtoWebObserversKawa : work : creating regex.")
		 (regex "^[a-zA-Z]")))

	  (tst-space-string
	   (lambda (s)
	     (if (regex-match rgx s)
		 s
		 '())))

	  (wds-data-str-no-spaces 
	   (begin
	     (display-nl  "DBtoWebObserversKawa : work : running  map-nil-iter-optim-tail-calls-call....")
	     ( map-nil-iter-optim-tail-calls-call tst-space-string wds-data-str-split )))

	  ;; variables used for creating HTML page using html/xml literals

	  (html-literal-table-rows '()) ;; rows list of the table of observers
	  (html-literal-table-data-observer '()) ;; table data : observer
	  (html-literal-table-data-code '()) ;; table data : code
	  (literal-rows-list '()) ;; list of the litterals rows 
	  (html-literal-table '()) ;; table of observers
	  (html-literal '()) ;; the whole set of HTML literals
	  (html-literal-str "") ;; the string of the whole set of HTML literals
	  (option-lst '(DIR: "LTR" BORDER: 1 width: 315 id: "table_observateurs")) ;; various options for various html tags (here TABLE)
	  (options-and-arguments-lst '()) 
	  #;(option-lst-lit '(DIR: "LTR" BORDER: 1 width: 315 id: "table_observateurs"))
	  ) ;; end of LET


     ;; debug display

     (display-nl  "DBtoWebObserversKawa : work : after let* declarations.")
     ;;(display-msg-var-nl  "DBtoWebObserversKawa : work : str1 = " str1)
     (display-msg-var-nl  "DBtoWebObserversKawa : work : length wds-data-str = " len-wds-data-str)
     (display-msg-var-nl  "DBtoWebObserversKawa : work : (car wds-data-str-split) = " (car wds-data-str-split))
     (display-msg-var-nl  "DBtoWebObserversKawa : work : (substring wds-data-str-minus-1 0 50) = " (substring wds-data-str-minus-1 0 50))
     (display-msg-var-nl  "DBtoWebObserversKawa : work : (substring wds-data-str-minus-2 0 50) = " (substring wds-data-str-minus-2 0 50))
     (display-msg-var-nl  "DBtoWebObserversKawa : work : (substring wds-data-str-equals 0 50) = " (substring wds-data-str-equals 0 50))
     (display-msg-var-nl  "DBtoWebObserversKawa : work : (cadr wds-data-str-split) = " (cadr wds-data-str-split))
     (display-msg-var-nl  "DBtoWebObserversKawa : work : (car wds-data-str-no-spaces) = " (car wds-data-str-no-spaces))

     ;;(display-msg-var-nl  "DBtoWebObserversKawa : work : option-lst = " option-lst)
     
     ;; partie HTML
     
    

     (set! res 
	   (gnu.lists.FString:toString
	    (string-append
	     "<HTML DIR=LTR>"
	     "      <HEAD>"
	     "            <META HTTP-EQUIV=\"Content-Type\" CONTENT=\"text/html;\">"
	     
	      #;"<meta http-equiv=\"Content-Type\" content=\"text/html; charset=iso-8859-1\">"
	      ;;"<meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\">"


	     "            <TITLE>Observateurs - Codes</TITLE>"
	     "      </HEAD>"
	     "      <body bgcolor=\"#FFFFC0\">"
	     "            <p align=center><b><font color=\"#000080\"><i>Codes utilisés pour les Observateurs : classement par ordre alphabétique des codes</i></font></b>"
	     "            <p>&nbsp;"
	     "            <TABLE align=center border=\"0\" width=\"80%\">"
	     "                   <TR>"
	     "                       <TD valign=left><a href=\"SidonieDescriptionF.html#codes\"><img src=\"retour_blanc.gif\" width=\"26\" height=\"26\" border=0></a>"
	     "                           <font size=\"2\"><em>Tout savoir...</em></font>"
	     "                       </TD>"
	     "                   </TR>"
	     "                   <TR>"
	     "                       <TD valign=left><a href=\"ObservateursCodes.html\"><img src=\"retour_blanc.gif\" width=\"26\" height=\"26\" border=0></a>"
	     "                           <font size=\"2\"><em>Classement par noms</em></font>"
	     "                       </TD>"
	     "                   </TR>")))
	     ;;"                   <TD align=center>")))
	      
     
     (display-msg-var-nl  "DBtoWebObserversKawa : work : res = " res)

     
     ;; converting from SQL server to MySQL (MariaDB)
     (set! marequete (sql-server->mysql-server-syntax marequete))

     (display-msg-var-nl  "DBtoWebObserversKawa : work : Voila la valeur SQL de la requète : marequete = " marequete)
     
     (eu.oca.DataBase:executeQueryStatic 
	   marequete
	   "Observateurs")

     (set! rs eu.oca.DataBase:resultSetObservateurs)
     
     (rs:first)

     (set! total 0)
     
     (rs:beforeFirst)
     
     (when (rs:next) ;; test SQL empty result set
	   
	   ;; DO WHILE LOOP
		
	   (while (not (rs:isAfterLast))
		       
		  (set! total (+ total 1))
		  
		  ;;(append-string-to-result "<tr>")
		       
		       
		  ;; 0 : code
		  (set! result (rs:getString 1))
		  
		  (if (or (rs:wasNull) (string-null? result))
		      
		      (display-nl  "DBtoWebObserversKawa : work : result (code) : string or result set is null")
		      			   
		      (begin
			;;(append-string-to-result "<td>")
			(set! html-literal-table-data-code
			      #;(html:td DIR: "LTR" ALIGN: "LEFT" result)
			      #<td DIR="LTR" ALIGN="LEFT">&[result]</>)
			
			(display-msg-var-nl  "DBtoWebObserversKawa : work : result (code) = " result)
			;;(append-string-to-result (string-upcase result))
			#;(append-string-to-result "</td>")))
		  
		  
		  ;; 1 : auteur (Observer)
		  (set! result (rs:getString 2))
		  
		  (if (rs:wasNull)
		      (set! result "NuLL"))
		  
		  ;;(append-string-to-result "<td>")
		  
		  (set! html-literal-table-data-observer 
			#;(html:td DIR: "LTR" ALIGN: "LEFT" result)
			#<td DIR="LTR" ALIGN="LEFT">&[result]</>)

		  (display-msg-var-nl  "DBtoWebObserversKawa : work : result (Observer) = " result)
		  ;;(append-string-to-result result)
		  ;;(append-string-to-result "</td>")
		  
		  (set! html-literal-table-rows
		  	(html:tr
		  	  html-literal-table-data-code
		  	  html-literal-table-data-observer))

		  (display-msg-var-nl  "DBtoWebObserversKawa : work : html-literal-table-rows = " html-literal-table-rows)

		  (set! literal-rows-list
			(cons html-literal-table-rows literal-rows-list))

		  (rs:next) 
		  
		  ) ;; end WHILE (Do While ... Loop) 
	   
	   ) ;; end when (test empty SQL result set)


     (display-msg-var-nl  "DBtoWebObserversKawa : work : total = " total)
     
     (display-msg-var-nl  "DBtoWebObserversKawa : work :literal-rows-list  = " literal-rows-list)

     (set! literal-rows-list
	   (reverse literal-rows-list)) ;; revert the list so it's well ordered to display
     
     (display-msg-var-nl  "DBtoWebObserversKawa : work :(reverse literal-rows-list)   = " literal-rows-list)
     
     (set! options-and-arguments-lst
	   (append option-lst literal-rows-list))

     (display-msg-var-nl  "DBtoWebObserversKawa : work : options-and-arguments-lst = " options-and-arguments-lst)

     ;; HTML table with options
     ;; Kawa offers simple slicing: @ not in Scheme R7RS 
     (set! html-literal-table
	   (apply html:table options-and-arguments-lst)) ;; OK
	   ;;(apply html:table literal-rows-list)) ;; OK
	   ;;(html:table literal-rows-list)) ;; OK but non-sense
	   ;;(html:table @literal-rows-list)) ;; KO
	   ;;(html:table option-lst literal-rows-list)) ;; OK but non-sense
	   ;;(html:table @option-lst @literal-rows-list)) ;; KO
	   ;;#<table DIR="LTR" BORDER="1" width="312" id="table_observateurs">&[@literal-rows-list]</>) ;; KO
	   ;;#<table DIR="LTR" BORDER="1" width="312" id="table_observateurs">@&[literal-rows-list]</>) ;; OK
	   ;;#<table DIR="LTR" BORDER="1" width="312" id="table_observateurs">POPUP</>) ;; OK
	   ;;#<table>POP UP</>) ;; OK
	   ;;(html:table "POP UP")) ;; OK

     ;;(set! html-literal-str (html-literal-table:toString))

     ;; HTML
     (set! html-literal
     	   #<td align="center">&[html-literal-table]</>)
     
     (set! html-literal-str (html-literal:toString))
      
     (display-msg-var-nl  "DBtoWebObserversKawa : work : html-literal-str = " html-literal-str)
     
     (display-msg-var-nl  "DBtoWebObserversKawa : work : res = " res)
     
     (append-string-to-result html-literal-str)
     
     ;; we are in jersey/ path of the URL
     (append-string-to-result
      (string-append
       "                  <TD valign=bottom><a href=\"SidonieDescriptionF.html#codes\"><img src=\"retour_blanc.gif\" width=\"26\" height=\"26\" border=0></a>"
       "                          <font size=\"2\"><em>Tout savoir...</em></font></TD>"
       ;; unclosed table (verifier version anglaise)
       ;;"          </TR>"
       "          </TABLE>"
       "      </BODY>"
       "</HTML>"))
     
     (display-msg-var-nl  "DBtoWebObserversKawa : work : res = " res)
     
     ) ;; end let*
   
   (eu.oca.DataBase:closeStatic)
   (display "DBtoWebObserversKawa : work : eu.oca.DataBase:closeStatic PASSED")
   (newline)
   
   ;; (eu.oca.DataBase:deregisterDriverStatic)
   ;; (display "ResultatGeneralFKawa : work : eu.oca.DataBase:deregisterDriverStatic PASSED")
   ;; (newline)
   
   
   (display-msg-var-nl  "DBtoWebObserversKawa : work : res = " res)
   
   res) ;; return a String
  
  





  
  ;; other Class definition functions


  
  ((sql-server->mysql-server-syntax query) ;; replace [ and ] by `
   (regex-replace* (regex "\\]") (regex-replace* (regex "\\[") query "`") "`"))

  
  ((append-string-to-result str) ;; append a string to result
   (set! res
	 (gnu.lists.FString:toString
	  (string-append res str))))

  
  ((string-null? str)
   (string=? str ""))

  
  ((fix x)
   (display-nl "DBtoWebObserversKawa.scm :: entering fix")
   (let ((r (inexact->exact (truncate x))))
     (display "ResultatGeneralFKawa.scm :: fix :: r =")
     (display r)
     (newline)
    r))

  
  ) ;; end of class