Archive for the ‘gs:text-pane’ Tag

newLISP で GUI する。。。または、gs:text-pane の “text/html” モード

 EPUB Viewer で書いたように、gs:text-pane の “text/html” モードは、全ての HTML タグに対応しているわけではないようです。
 そこで、それを試すスクリプトを用意しました。

; utility
(define *newlispDir* (env "NEWLISPDIR"))
(load (append *newlispDir* "/guiserver.lsp")) 
; define sub-routine

; define handler
(define *fileName* (real-path))
(define *filemask* "htm HTM html HTML")
(define *description* "html file")
(define (openfile-action id op file)
  (when file
    (setq *fileName* (base64-dec file))
    (cond ((directory? *fileName*)
           (setq *fileName* (append  *fileName* "\\")))
          (true (gs:set-text 'InputArea (read-file *fileName*))))
    (gs:set-text 'Status *fileName*)))
(define (open-file-dialog)
  (gs:open-file-dialog 'Frame 'openfile-action *fileName* *filemask* *description*))
(define (textCallBack id text)
  (when text 
    (let (word (base64-dec text))
      (gs:set-text 'OutputArea word)
)))
(define (button-handler id)
	(gs:get-text 'InputArea 'textCallBack))

; initialization
(gs:init)
(define FPosX 50)
(define FPosY 50)
(define FWidth 800)
(define FHeight 480)
(gs:frame 'Frame FPosX FPosY FWidth FHeight "Simple HTML Tester")
(gs:panel 'ButtonPanel)
(gs:panel 'StatusPanel)
(gs:label 'Status (real-path))
(gs:button 'Button1 'button-handler "->")
(gs:button 'fileButton 'open-file-dialog "File")
(gs:text-pane 'InputArea 'gs:no-action "text/plain") 
(gs:set-syntax 'InputArea "html")
(gs:text-pane 'OutputArea 'gs:no-action "text/html")
;(gs:set-editable 'OutputArea 'nil)
(gs:split-pane 'SplitPanel "vertical" 0.5)
(gs:add-to 'SplitPanel 'InputArea 'OutputArea)
(gs:label 'TextLabel "TEXT/PLAIN mode ")
(gs:label 'HtmlLabel " TEXT/HTML mode")
(gs:add-to 'ButtonPanel 'TextLabel 'Button1 'HtmlLabel)
(gs:add-to 'StatusPanel 'fileButton 'Status)

; mount all on frame
(gs:set-border-layout 'Frame)
(gs:set-flow-layout 'ButtonPanel "center")
(gs:set-flow-layout 'StatusPanel "left")
(gs:add-to 'Frame 'ButtonPanel "north" 'SplitPanel "center" 'StatusPanel "south")
(gs:set-visible 'Frame true)

; main routine
(gs:listen)
(exit)

 これを実行すると、

 こんな感じで、左側のパネルにHTMLコードを入力して、上部真ん中のボタンを押すと右側のパネルに “text/html” モード表示されます。
 左下の File ボタンで HTML ファイルを読み込み表示させることもできます。
 保存ボタンはありません。gs:text-pane の “text/html” モードで表示できるかどうかを試すスクリプトですから(笑)。

 さて、これを使って EPUB 本体の XHTML 調べてみると、表示の邪魔しているのは、文字コードを指定してる

<meta http-equiv="Content-Type" content="application/xhtml+xml; charset=utf-8" />

 でした。<head></head> タグや <style></style> タグは、使えるようです。
 ということで、EPUB Viewer のスクリプトの内、

    (letn (str (replace {<\?.+\?>} (read-file file) "" 0)
           book1 (aif (find {<head>} str) (0 it str) str)
           book2 (aif (find {</head>} str) ((+ it 7) str) "")
           book (append book1 book2))

 の部分は、

    (let (book (replace {<\?.+\?>} (read-file file) "" 0))
       (replace {<meta http-equiv[^>]*>} book "" 4)

 で、十分だったわけです。
 また、ずいぶん、遠回りしてしまいました(汗)。
 
 以上、如何でしょうか?

newLISP で GUI する。。。または、CSV ファイルをテーブル表示する。

 前回までの “newLISP で CSV を扱う。” は、如何だったでしょうか?
 今頃の掲載は、ネタに困ったから? 否定はしません(笑)が、理由があります。
 newLISP Fan Club FORUM で unya氏が TextTableWidget – JTable base を紹介されています。これは、guiserver 上で、EXECLのような表が扱えるようになるというもの。
 それで、EXECL のデータを newLISP でも使えるようにして置こうと、思ったわけです。
 同投稿で、Lutz氏が次期開発バージョンに組み込まれることを表明されています。
 嬉しい限りです。リリースされたら早速、この blog にて報告しましょう(笑)。

 とは言っても、それまで待っているのも何ですから、現在の guiserver でテーブル表示をしてみましょう。表示に使うのは、gs:text-pane の “text/html” モードです。

gs:text-pane

syntax: (gs:text-pane sym-id sym-action str-style [int-width int-height])
parameter: sym-id – The name of the text pane.
parameter: sym-action – The key action handler for the html pane.
parameter: sym-style – The content type of the text pane.
parameter: int-width – The optional width of the pane.
parameter: int-height – The optional height of the pane.

gs:text-pane は gs:text-area のように使えます。次のスタイルが sym-style でサポートされます:
The gs:text-pane is used similar to ‘gs:text-area. The following styles are supported in sym-style:
“text/plain”
“text/html”

(中略)

HTML 形式のテキストでハイパーリンクをクリック可能にするには、 関数 gs:set-editable を使って、編集不可にします。 gs:set-font と gs:append-text は、text/plain スタイルでのみ、動作します。
To make hyperlinks in HTML formatted text clickable, editing must be disabled using the gs:set-editable function. The functions gs:set-font and gs:append-text will work only on the text/plain content style.

 マニュアルにあるように、 “text/html” モードでは gs:set-fontgs:append-text が使えません。つまり、フォントは表示する HTML文字列内に記述し、用意した正しい記述の HTML文字列を gs:set-textgs:text-pane に貼り付けて使うということ。
 と、言うことで、先ずは、リストから テーブル表示用の HTML文字列を作ります。
(defun は newlisp-utility.lsp に定義してあります。)

(define *header* [text]<!-- generated page -->
<html>
<table border="1">
[/text])
(define tableROW '("<tr>" "</tr>"))
(define tableDATA '("<td align=\"right\">" "</td>"))
(define tableHEADER '("<th>" "</th>"))
(define *footer* [text]</table>
</html>
[/text])
(defun addHTMLtag (data tag)
  (string (tag 0) data (tag 1)))
(defun makeHTMLtable (lst)
  (let (html *header*)
    (dolist (row lst)
      (extend html (tableROW 0))
      (dolist (col row) 
        (extend html (addHTMLtag col (if (string? col) tableHEADER tableDATA))))
      (extend html (tableROW 1) "\n"))
    (extend html *footer*)))

 特にフォント指定はしていませんので、必要な方は、*header* にでも追加して下さい。
 先日の太陽系惑星のデータを使って、動作させると、

> (makeHTMLtable sol-sys)
[text]<!-- generated page -->
<table border="1">
<tr><th>Planet name</th><th>Equator diameter (earth)</th><th>Mass (earth)</th><th>Orbital radius (AU)</th><th>Orbital period (years)</th><th>Orbital Incline Angle</th><th>Orbital Eccentricity</th><th>Rotation (days)</th><th>Moons</th></tr>
<tr><th>Mercury</th><td align="right">0.382</td><td align="right">0.06</td><td align="right">0.387</td><td align="right">0.241</td><td align="right">7</td><td align="right">0.206</td><td align="right">58.6</td><td align="right">0</td></tr>
<tr><th>Venus</th><td align="right">0.949</td><td align="right">0.82</td><td align="right">0.72</td><td align="right">0.615</td><td align="right">3.39</td><td align="right">0.0068</td><td align="right">-243</td><td align="right">0</td></tr>
<tr><th>Earth</th><td align="right">1</td><td align="right">1</td><td align="right">1</td><td align="right">1</td><td align="right">0</td><td align="right">0.0167</td><td align="right">1</td><td align="right">1</td></tr>
<tr><th>Mars</th><td align="right">0.53</td><td align="right">0.11</td><td align="right">1.52</td><td align="right">1.88</td><td align="right">1.85</td><td align="right">0.0934</td><td align="right">1.03</td><td align="right">2</td></tr>
<tr><th>Jupiter</th><td align="right">11.2</td><td align="right">318</td><td align="right">5.2</td><td align="right">11.86</td><td align="right">1.31</td><td align="right">0.0484</td><td align="right">0.414</td><td align="right">63</td></tr>
<tr><th>Saturn</th><td align="right">9.41</td><td align="right">95</td><td align="right">9.54</td><td align="right">29.46</td><td align="right">2.48</td><td align="right">0.0542</td><td align="right">0.426</td><td align="right">49</td></tr>
<tr><th>Uranus</th><td align="right">3.98</td><td align="right">14.6</td><td align="right">19.22</td><td align="right">84.01</td><td align="right">0.77</td><td align="right">0.0472</td><td align="right">-0.718</td><td align="right">27</td></tr>
<tr><th>Neptune</th><td align="right">3.81</td><td align="right">17.2</td><td align="right">30.06</td><td align="right">164.8</td><td align="right">1.77</td><td align="right">0.0086</td><td align="right">0.671</td><td align="right">13</td></tr>
<tr><th>Pluto</th><td align="right">0.18</td><td align="right">0.002</td><td align="right">39.5</td><td align="right">248.5</td><td align="right">17.1</td><td align="right">0.249</td><td align="right">-6.5</td><td align="right">3</td></tr>
</table>
[/text]
> 

 と、いった具合。一応、文字列と数値では、HTML タグを変えてあります。
 さて、これを表示する GUI 部分は、
(aif は newlisp-utility.lsp に, include は init.lsp に定義してあります。)

; utility
(define *newlispDir* (env "NEWLISPDIR"))
(load (append *newlispDir* "/guiserver.lsp")) 
(include "macro.lsp")
(include "newlisp-utility.lsp")
; define sub-routine
(define CRLF "\x0d\x0a")
(define regexCRLF "\r*\n")
(defun stringEx (x)
  (if (string? x) (string "\"" x "\"") (string x)))
(defun string-convert (str) 
  (if (catch (eval-string str) 'res) (if res res str) str))
(defun list2csv (lst)
  (let (csv "")
    (dolist (row lst)
      (extend csv (join (map stringEx row) ",") CRLF))))
(defun csv2list (csv)
  (let (lst '())
    (dolist (row (parse (if (ends-with csv regexCRLF 0) (chop csv) csv) regexCRLF 0))
      (push (map string-convert (parse row ",")) lst -1))
    (setf (lst -1 -1) (if (string? $it) (trim $it "\r") $it))
    lst))
(defun csvfile2list (file)
  (cond ((directory? file) nil)
         ((file? file)
          (csv2list (read-file *fileName*)))
         (true nil)))
; define handler
(define *fileName* (real-path))
(define *filemask* "csv CSV")
(define *description* "csv file")
(define (openfile-action id op file)
  (when file
    (setq *fileName* (base64-dec file))
    (gs:set-text 'Status *fileName*)
    (aif (csvfile2list *fileName*)
        (gs:set-text 'OutputArea (makeHTMLtable it))
      (gs:set-text 'Status (string *fileName* " is not csv file.")))))
(define (open-file-dialog)
  (gs:open-file-dialog 'Frame 'openfile-action *fileName* *filemask* *description*))
; initialization
(gs:init)
(define FPosX 100)
(define FPosY 50)
(define FWidth 640)
(define FHeight 480)
(gs:frame 'Frame FPosX FPosY FWidth FHeight "CSV Viewer")
(gs:panel 'StatusPanel)
(gs:label 'Status (real-path))
(gs:button 'fileButton 'open-file-dialog "File")
(gs:text-pane 'OutputArea 'gs:no-action "text/html")
(gs:add-to 'StatusPanel 'fileButton 'Status) 
; mount all on frame
(gs:set-border-layout 'Frame)
(gs:set-flow-layout 'StatusPanel "left")
(gs:add-to 'Frame 'OutputArea "center" 'StatusPanel "south")
(gs:set-visible 'Frame true)
; main routine
(gs:listen)
(exit)

 という感じ。先日の関数csv2list も入っています。
 これを実行すれば、

 と表示されるはず。
 左下の File ボタンを押して、ファイルダイアログを表示させ、<a href="https://johu02.wordpress.com/2010/09/29/"前回のやり方で用意したファイルを選択すれば、

 と、めでたく表示されます。EXCEL 出力の CSVファイルも同様に表示されるはず。
 もちろん、編集はできません(笑)。
 それは、TextTableWidget – JTable baseguiserver に組み込まれるのを待つことにしましょう。

 以上、如何でしょうか?