Archive for the ‘GUI’ Category
newLISP マニュアル v.10.5.3 日本語訳公開
コメントを残す 今回のバージョンアップには、バグフィックスの他に、新関数として K 平均法分析に使える kmeans-train と kmeans-query が追加されています。このところ、統計関数の拡充が目覚ましいですね。
さて、個人的に一番大きな変更は、guiserver.lsp が version 1.52 になって、gs:run-shell が二変数関数から三変数関数に変更になったこと。おかげで、newLISP スクリプト用ランチャーを変更しなければなりませんでした。gs:run-shell を使われている方はご注意を。
ということで、マニュアル類の日本語訳をアップしました。
newLISP の User Manual and Reference と GUI functions の全訳のリリースです。
newlisp_manual-10503
guiserver_manual-152
こちらからダウンロードしてください。
目次も含め日本語併記にしてあります。
いつものように、間違いやおかしな点が有りましたら、こちらの blog までご一報下さい。
以上、如何でしょうか？
newLISP マニュアル・アップデート v.10.4.5 rev 2013-01-20
今月の10日辺りから始まった newLISP マニュアル の変更、guiserver マニュアル も変更されたようなので、併せて紹介します。
newLISP マニュアル ＆ リファレンス の全訳のリリースで、現在のバージョンは、v.10.4.5 です。
こちらから newlisp_manual-10405 をダウンロードして下さい。
guiserver マニュアル、現在のバージョンは 1.50 です。
こちらから guiserver_manual-150 をダウンロードして下さい。
共に目次も含め日本語併記にしてあります。
いつものように、間違いやおかしな点が有りましたら、こちらの blog までご一報下さい。
以上、如何でしょうか？
gs:get-selected-text を使ってみる．．．または、newlisp-edit.lsp の改良
よく、エディターなどで文字を選択して文字検索をかけると、選択された文字列が文字検索パネルに表示されます。でも、newLISPの統合開発環境 newLISP-GS では、そうなりません。
newLISPの GUI にそういう機能がないのかというと、あります。それが gs:get-selected-text。今回は、これを使って newlisp-edit.lsp を改造します。
gs:get-selected-text は gs:text-pane などで選択された文字列を取得する関数です。書式は、
(gs:get-selected-text sym-id [sym-action])
となり、sym-id には gs:text-pane などのシンボル名が入ります。newlisp-edit.lsp では、こんな感じに記述します。
(gs:get-selected-text currentEdit 'selected-text-handler)
ここで currentEdit は変数で、文字通り編集中の gs:text-pane のシンボル名が入っています。だから、クォート（‘）が付きません。selected-text-handler は選択された文字列を取得するハンドラーで
(define (selected-text-handler id text)
(when text
(gs:set-text 'FindTextField (base64-dec text))))
と定義します。これを newlisp-edit.lsp の適当な所に追加して、後は前述の gs:get-selected-text 文を必要な所に挿入します。挿入する箇所は、関数 findbutton-handler の
(define (findbutton-handler)
(if findDialogOpen
(begin
(gs:request-focus 'FindTextField)
(gs:select-text 'FindTextField 0)
(gs:get-selected-text currentEdit 'selected-text-handler) ; ←ここに追加
)
(openFindDialog)
)
)
と関数 openFindDialog の
(define (openFindDialog)
(gs:dialog 'FindDialog 'TheEditor "Find text" 460 200 nil nil)
：
(set 'findDialogOpen true)
(gs:get-selected-text currentEdit 'selected-text-handler) ; ←ここに追加
)
と二箇所。
この変更した newlisp-edit.lsp を使えば、文字列を選択して検索をかけた時、検索パネルの Find の表示がある gs:text-field に選択した文字列が入ります。
これで newLISP-GS の作業効率が大幅アップ（笑）。
以上、如何でしょうか？
日本語併記 guiserver マニュアルのオンライン化
朗報です。
Lutz 氏のご厚意により guiserver マニュアルの日本語併記版がオンライン化されました。
既にオンライン化されているリファレンス・マニュアルと Code Patterns（コード例の紹介）と合わせて、ご活用ください。
これで、〝newLISP には日本語マニュアルがない〟とは言われない？、、、けど、私の翻訳の質が問われそう（汗）。
以上、如何でしょうか？
newLISP マニュアル・アップデート v.10.3.2 rev 2
newLISP のマニュアルが rev 2 にアップデートされたので、それに合わせて日本語訳もアップデートします。
主な変更箇所は、define-macro、letex、push、reader-event で、内容の変更というより完成度を高めるブラッシュアップといったところです。私の翻訳はブラッシュアップされていないかもしれませんが（汗）。
下記 URL から日本語訳付 newLISP マニュアル ＆ リファレンス がダウンロードできます。現在のバージョンは、v.10.3.2 rev 2 です。
こちらから newlisp_manual-10302 をダウンロードして下さい。
目次も含め日本語併記にしてあります。
また、guiserver のマニュアルも Version 1.44 になっていますので、合わせて、アップデートします。
こちらから guiserver_manual-144 をダウンロードして下さい。
いつものように、間違いやおかしな点が有りましたら、こちらの blog までご一報下さい。
以上、如何でしょうか？
newLISP で GUI する。。。数独入力スクリプト
先日の数独解法スクリプトは、如何だったでしょうか？
さて今回は、予告通り（笑）GUI による数独の入力スクリプトです。
; utility
(define *newlispDir* (env "NEWLISPDIR"))
(load (append *newlispDir* "/guiserver.lsp"))
; initialization
(gs:init)
(define *size* 40)
(define *sudoku* (explode (dup 0 81) 9))
(define *temporary* (explode (dup 0 81) 9))
(setq X-pos 0 Y-pos 0)
(define *fileName* (real-path))
(define *filemask* "sdk SDK")
(define *description* "sudoku file")
; define sub-routine
(define (sudoku1pass nums)
(let (res)
(for (i 0 8)
(let (row)
(for (j 0 8)
(let (n (nums i j))
(if (> n 0) (push (list n) row -1)
(letn (can (difference '(1 2 3 4 5 6 7 8 9) (nums i))
can (difference can (map (curry nth j) nums))
can (difference can (flat (map (curry (* (/ j 3) 3) 3) ((* (/ i 3) 3) 3 nums)))))
(if (= (length can) 1) (setf (nums i j) (can 0)))
(push can row -1)))))
(let (tmp (ref-all 1 (count '(0 1 2 3 4 5 6 7 8 9) (apply append row))))
(if tmp (dolist (k (apply append tmp)) (setf (nums i ((ref k row) 0)) k))))
(push row res -1)))
(for (j 0 8)
(letn (col (map (curry nth j) res)
tmp (ref-all 1 (count '(0 1 2 3 4 5 6 7 8 9) (apply append col))))
(if tmp (dolist (k (apply append tmp)) (setf (nums ((ref k col) 0) j) k)))))
(list nums res)))
; define handler
(define (item-action id)
(set-number X-pos Y-pos (int (id -1))))
(define (mouse-pressed-action x y button modifiers tags)
(when (= button 3)
(let (lst (sudoku1pass *temporary*))
(for (i 1 9) (gs:disable (sym (string i))))
(if (> ((lst 0) Y-pos X-pos) 0) (gs:enable (sym ((lst 0) Y-pos X-pos)))
(dolist (i (map string ((lst -1) Y-pos X-pos)))
(gs:enable (sym i))))
(gs:show-popup 'numlist 'Sudoku x y))))
(define (move-cell x y)
(if x (setq X-pos x))
(if y (setq Y-pos y))
(gs:delete-tag 'R) (gs:set-stroke 3.0)
(gs:draw-rect 'R (+ (* X-pos *size*) 2) (+ (* Y-pos *size*) 2) (- *size* 4) (- *size* 4) gs:lightGray)
(gs:update))
(define (mouse-clicked-action x y button cnt modifiers tags)
(unless (find "S" tags 0)
(move-cell (/ x *size*) (/ y *size*))))
(define (mouse-moved-action x y)
(let (xc (/ x *size*) yc (/ y *size*))
(gs:set-text 'SudokuFrame (string "moved row: " (+ 1 yc) " col:" (+ 1 xc)))))
(define (delete-num x y)
(gs:delete-tag (string "T" x y))
(gs:delete-tag (string "S" x y)))
(define (set-number x y num)
(delete-num x y)
(setf (*temporary* y x) num)
(gs:draw-text (string "T" x y)
(string num)
(+ (* x *size*) (/ *size* 4))
(- (* (+ 1 y) *size*) (/ *size* 8)))
(gs:update))
(define (set-sudoku x y num)
(delete-num x y)
(setf (*sudoku* y x) num)
(gs:draw-text (string "S" x y)
(string num)
(+ (* x *size*) (/ *size* 4))
(- (* (+ 1 y) *size*) (/ *size* 8))
gs:blue)
(gs:update))
(define (move x y)
(do-until (= 0 (*sudoku* Y-pos X-pos))
(if (= x "up") (++ X-pos)
(= y "up") (++ Y-pos)
(= x "down") (-- X-pos)
(= y "down") (-- Y-pos))
(if (< X-pos 0) (setq X-pos 8)
(< 8 X-pos) (setq X-pos 0))
(if (< Y-pos 0) (setq Y-pos 8)
(< 8 Y-pos) (setq Y-pos 0)) )
(move-cell))
(define (key-action id type code modifiers)
(when (= type "released")
(case code
( 8 (move "down" nil)); bs
(37 (move "down" nil)); left
(38 (move nil "down")); up
(39 (move "up" nil)); right
(40 (move nil "up")); downt
(127 (gs:delete-tag (string "T" X-pos Y-pos))
(setf (*temporary* Y-pos X-pos) 0)); del
(true (let (key (& code 0xF))
(when (and (> key 0) (> 10 key)
(find key (((sudoku1pass *temporary*) -1) Y-pos X-pos)))
(set-number X-pos Y-pos key)))))))
(define (draw-sudoku)
(for (r 0 8) (for (c 0 8)
(let (s (*sudoku* r c)
t (*temporary* r c))
(if (> s 0) (set-sudoku c r s)
(> t 0) (set-number c r t))))))
(define (open-action id op file)
(when file
(setq *fileName* (base64-dec file))
(unless (directory? *fileName*)
(load *fileName*)
(for (r 0 8) (for (c 0 8)
(let (s (*sudoku* r c)
t (*temporary* r c))
(if (> s 0) (set-sudoku c r s)
(> t 0) (set-number c r t)
(delete-num c r)))))
(let (it (ref 0 *sudoku*)) (if it (apply move-cell (reverse it)))))))
(define (open-file-dialog)
(gs:open-file-dialog 'SudokuFrame 'open-action *fileName* *filemask* *description*))
(define (save-action id op file)
(when file
(setq *fileName* (base64-dec file))
(unless (directory? *fileName*)
(save *fileName* '*sudoku* '*temporary*))))
(define (save-file-dialog)
(if (directory? *fileName*)
(gs:save-file-dialog 'SudokuFrame 'save-action *fileName* "" *filemask* *description*)
(gs:save-file-dialog 'SudokuFrame 'save-action *fileName* *fileName* *filemask* *description*)))
(define (fix-action id)
(when (ref 0 *temporary*)
(setq *sudoku* *temporary*)
(draw-sudoku)))
(define (release-action id)
(setq *sudoku* (explode (dup 0 81) 9))
(draw-sudoku))
; making frame & canvas
(gs:frame 'SudokuFrame 100 100 400 400 "Sudoku")
(gs:canvas 'Sudoku 'SudokuFrame)
(gs:add-to 'SudokuFrame 'Sudoku)
(gs:set-background 'Sudoku gs:white)
(gs:mouse-pressed 'Sudoku 'mouse-pressed-action true)
(gs:mouse-clicked 'Sudoku 'mouse-clicked-action true)
(gs:mouse-moved 'Sudoku 'mouse-moved-action)
(gs:key-event 'Sudoku 'key-action)
(gs:menu-popup 'numlist "Candidate")
(for (i 1 9)
(let (n (string i))
(gs:menu-item (sym n) 'item-action (string i))
(gs:add-to 'numlist (sym n))))
(gs:menu 'File "Tools")
(gs:menu-item 'Load 'open-file-dialog "load")
(gs:menu-item 'Save 'save-file-dialog "save")
(gs:menu-item 'Fix 'fix-action "fix")
(gs:menu-item 'Release 'release-action "release")
(gs:add-to 'File 'Load 'Save)
(gs:add-separator 'File)
(gs:add-to 'File 'Fix 'Release)
(gs:menu-bar 'SudokuFrame 'File)
(gs:set-anti-aliasing true)
(gs:set-font'Sudoku "Monospaced" (- *size* 1) "bold")
(gs:set-stroke 2.0)
(for (r 1 9)
(if (= 0 (mod r 3)) (gs:set-stroke 3.0) (gs:set-stroke 1.0))
(gs:draw-line 'L (* r *size*) 0 (* r *size*) (* 9 *size*) gs:black)
(gs:draw-line 'L 0 (* r *size*) (* 9 *size*) (* r *size*) gs:black))
(gs:set-visible 'SudokuFrame true)
(let (size (gs:get-bounds 'Sudoku))
(gs:set-size 'SudokuFrame (- 400 (- (size 2) (* 9 *size*))) (- 400 (- (size 3) (* 9 *size*))))
(gs:update))
(move-cell)
; main routine
(while (gs:check-event 10000) (gs:request-focus 'Sudoku))
(exit)
実行すれは、右図のような数独のマスが現れます。後は、数字を入力するだけ、数字を変更するには、del キーで空きマスにしてから再度入力して下さい。空きマスの入力には、右クリックで出てくる入力可能な数字からも可能です。
数独を入力し終わったら、メニュー Tools から、fix を選択すると、数字が青に変わり、変更できなくなります。解除するには、同じ Tools から、release を選択します。数字の青を変えたいときは、スクリプト中の gs:blue を適当な値に変更して下さい。（例えば、gs:cyan gs:darkGray gs:gray gs:green gs:lightGray gs:magenta gs:orange gs:pink gs:red gs:yellow 等）
Tools の残りは、load と save ですから、説明するまでもありませんね（笑）。
下図のように、数独を解いている途中の状態も保存できます。
ここまでできれば、後は数独出題スクリプト？ なんてね（笑）。
以上、如何でしょうか？
newLISP で GUI する。。。または、液晶画面で大きさを見てみる。（解説編）
“液晶画面で大きさを見てみる。”は、如何だったでしょうか？
三面図の描画は、関数draw でやっていて、ここで、テキスト・ボックスに入力された文字列の解析もやっています。
数字の切り出し部分は、
(parse text {[^0-9\.]} 0)
こんな感じです。正規表現で数字とドット以外を取り除いています。
ここままだと、先頭に数字以外があると空文字列がリストにの先頭に残るので、
(map float (remove "" (parse text {[^0-9\.]} 0)))
として、空文字列を削除して、数値に変換しています。remove は、拙作ユーティリティですが、組込replace と置き換えても動作は一緒です。
この方法では、数字が全て残ってしまうので、先頭に数字の入った製品名等をいれると、それも残ってしまいます。
そこで、先頭の [] 内の文字列は削除して、数字切り出しに渡しています。
(replace {^\[[^\]]*\]} text "" 0)
拙作 remove は、文字列にも対応しているのですが、正規表現はサポートしていないので、組込replace を使っています。
３サイズの取り出しは、
(letn (size (map (fn (x) (int (div (mul x (or unit *unit*)) *pitch*))) nums)
height (first size) width (or (second size) 1) tickness (third size))
こんな風に、first, second, third を使っています。 これで、リストに数値が一個しかなくても、エラーが起きません。
３サイズが揃えば、三面図。2つだけなら、正面図。１つだけなら、線になります。
また、前回書きませんでしたが、上のコンボ・ボックスで単位に mm と inch が選べます。
それとは別に、数字の後に、" がある場合のみ、inch として扱っています。この場合、コンボ・ボックスの指定は無視されます。
この inch 自動判定は、
(find {[0-9\.]+"} text 0)
こんな感じ。今回は正規表現のオンパレードです（笑）。
グラフィック部分の解説はいらないでしょう。マニュアル通りだし、日本語マニュアルもあるし、、、
さて、Save ボタンによる保存は、リスト・ボックスのデータをそのままテキストで書き出しているだけです。
改行は、LF だけ付加していますが、Load ボタンによる読み出しでは、CR+LF にも対応しています。
(parse (read-file *fileName*) {\r*\n} 0)
スクリプト内では、リスト変数*size-list* として扱っているので、そのまま、組込の save と load を使っても良かったのですが、括弧の無いテキスト・データの方が、編集しやすいですからね（笑）。
以上、如何でしょうか？
newLISP で GUI する。。。または、液晶画面で大きさを見てみる。
今時の パソコンのディスプレイは LCD なので、CRT の頃と違い、完全にフラット。しかも、画素ピッチは正確です。
購入を検討している電子書籍ビューアの大きさの感じを掴むのに、これは使えると思い立ち、スクリプトを書きました（remove, second, third は、newlisp-utility.lsp に、include は init.lsp に定義してあります）。
; utility
(define *newlispDir* (env "NEWLISPDIR"))
(load (append *newlispDir* "/guiserver.lsp"))
(include "macro.lsp")
(include "newlisp-utility.lsp")
; define global variables
(define *pitch* 0.248)
(define *unit* 1.0)
(define *reverse* nil)
(define *tmpStr* "")
(define *addflag* nil)
(define *fileName* (append (real-path) "/"))
(define *filemask* "lst LST")
(define *description* "list file")
(define *size-list* '({[Kinde 3] 7.5" x 4.8" x 0.335"} {約高さ169.6×幅119.1×奥行10.3mm}))
; define handler
(define (openfile-action id op file)
(when file
(setq *fileName* (base64-dec file))
(if (directory? *fileName*)
(setq *fileName* (append *fileName* "/"))
(begin
(gs:set-text 'Status *fileName*)
(map add-listbox (remove "" (parse (read-file *fileName*) {\r*\n} 0)))))))
(define (savefile-action id op file)
(when file
(setq *fileName* (base64-dec file))
(if (directory? *fileName*)
(setq *fileName* (append *fileName* "/"))
(begin (gs:set-text 'Status *fileName*)
(write-file *fileName* (join *size-list* "\n"))))))
(define (open-file-dialog)
(gs:open-file-dialog 'Frame 'openfile-action *fileName* *filemask* *description*))
(define (save-file-dialog)
(let (paths (parse *fileName* {/|\\} 0))
(gs:save-file-dialog 'Frame 'savefile-action (join (chop paths) "/") (paths -1) *filemask* *description*)))
(define (find-action id pos)
(print id " caret position : ")
(if (= -1 pos) (println "End of text") (println pos)))
(define (check-action id selected)
(setq *reverse* selected)
(gs:get-text 'InputArea 'textCallBack))
(define (combo-action id idx item)
(case (base64-dec item)
("mm" (setq *unit* 1))
("inch" (setq *unit* 25.4))
(true (setq *unit* 1))))
(define (draw text)
(replace {^\[[^\]]*\]} text "" 0)
(let (unit (if (find {[0-9\.]+"} text 0) 25.4)
nums (map float (remove "" (parse text {[^0-9\.]} 0))))
(if nums
(letn (size (map (fn (x) (int (div (mul x (or unit *unit*)) *pitch*))) nums)
height (first size) width (or (second size) 1) tickness (third size))
(if *reverse* (swap width height))
(gs:delete-tag 'OBJ)
(gs:draw-rect 'OBJ 10 10 width height gs:black)
(when tickness
(gs:draw-rect 'OBJ 10 (+ 20 height) width tickness gs:black)
(gs:draw-rect 'OBJ (+ 20 width) 10 tickness height gs:black))
(gs:update)))))
(define (list-action id idx item click-count)
(when item
(let (text (base64-dec item))
(gs:set-text 'InputArea text)
(draw text))))
(define (add-listbox text)
(unless (find text *size-list*)
(push text *size-list* -1)
(gs:add-list-item 'DataList text)))
(define (textCallBack id text)
(when text
(if *addflag*
(add-listbox (base64-dec text))
(draw (base64-dec text))))
(setq *addflag* nil))
(define (text-handler id text)
(when text
(gs:get-text id 'textCallBack)))
(define (button-handler id)
(if (ends-with id "addButton") (setq *addflag* true))
(gs:get-text 'InputArea 'textCallBack))
; initialization
(gs:init)
(define FPosX 10)
(define FPosY 10)
(define FWidth 640)
(define FHeight 480)
(gs:get-fonts)
(gs:frame 'Frame FPosX FPosY FWidth FHeight "Size Viewer")
(gs:panel 'ButtonPanel)
(gs:panel 'StatusPanel)
(gs:label 'Status (real-path))
(gs:button 'Button1 'button-handler "Draw")
(gs:button 'addButton 'button-handler "Add")
(gs:button 'fileButton 'open-file-dialog "Load")
(gs:button 'saveButton 'save-file-dialog "Save")
(gs:check-box 'Rotate 'check-action "Rotate " *reverse*)
(gs:combo-box 'spec 'combo-action '("mm" "inch"))
(gs:list-box 'DataList 'list-action *size-list*)
(gs:text-field 'InputArea 'text-handler 20)
(gs:canvas 'OutputArea)
(gs:set-color 'OutputArea gs:white)
(gs:set-stroke 2.0)
(gs:add-to 'ButtonPanel 'Button1 'InputArea 'Rotate 'spec 'addButton)
; mount all on frame
(gs:set-border-layout 'Frame)
(gs:set-border-layout 'StatusPanel)
(gs:set-flow-layout 'ButtonPanel "center")
;(gs:set-flow-layout 'StatusPanel "left")
(gs:add-to 'StatusPanel 'fileButton "west" 'Status "center" 'saveButton "east")
(gs:add-to 'Frame 'ButtonPanel "north" 'OutputArea "center" 'StatusPanel "south" 'DataList "east")
(gs:set-visible 'Frame true)
; main routine
(gs:listen)
(exit)
実行画面はこんな感じ。
使い方は、真ん中上のテキスト・ボックスに3サイズを入れ、Draw ボタンを押せば、中央のパネルに三面図が表示されます。
Rotate にチェックを入れると、縦横が逆になります。
また、Add ボタンを押せば、テキスト・ボックスの内容が、右側のリスト・ボックスに追加されます。
リスト・ボックス内のリストは、下側の Save ボタンと Load ボタンで、保存・読込ができます。
もちろん、リスト・ボックス内の項目をクリックするれば、その内容がテキスト・ボックスに入り、その三面図が表示されます。
ちなみに、画素ピッチは、
(define *pitch* 0.248)
で指定しています。単位は、mm です。必要に応じて変更して下さい。
長くなってきたので、いつものように（笑）、スクリプトの解説は、次回に。
以上、如何でしょうか？
newLISP で Palm（Clie）のメモ帳を表示してみる。
未だに使っている Clie は、予定表だけではなく、メモ帳も重宝しています。
すでに、予定表は newLISP で見ることができるので、今回は、メモ帳データを表示してみます。
Palm（Clie）のメモ帳データは、”memopad.dat” というファイル名でPalm（Clie）のインストール・フォルダ内にあります。
このファイルも、予定表のデータ同様、バイナリ・ファイルのなので、読み込みには、拙作 “palm-db-read.lsp” と “newlisp-utility.lsp” が必要です。
まずはスクリプトを、（include は、init.lsp に定義してあります。）
; utility
(define *newlispDir* (env "NEWLISPDIR"))
(load (append *newlispDir* "/guiserver.lsp"))
(include "newlisp-utility.lsp")
(include "palm-db-read.lsp")
; define global-variable & sub-routine
(define FPosX 100)
(define FPosY 50)
(define FWidth 800)
(define FHeight 480)
(define *changeFlag*)
(define *createFlag*)
(define *referenceHTML*)
(define *indexLists*)
(define *indexList*)
(define *history*)
(define *REOption*)
(define *style*)
(define *initFile*)
(define *helpFile*)
(with-open-file (in "memopad.dat" "read")
(let (header (header-read in))
(setq category (header 5))
(let (db-cnt (/ (last header) (header 7))
field (header 12)
result '())
(dotimes (cnt db-cnt) (push (read-entry in field) result -1))
(setq data result))))
(new Tree '*reference*)
(setq *indexLists* '(("未分類" ()))) ; '(("Untitled" ()))
(extend *indexLists* (map (fn (x) (list (x 3) '())) category))
(dolist (lst data)
(let (pos (string (lst 2))
text (lst 3)
cate (lst -1))
(*reference* pos text)
(push (list ((parse text "\r\n" 0) 0) pos) (*indexLists* cate 1) -1)))
(set '*style* "")
; GUI-handler
(define (textCallBack id text)
(if text
(let (word (base64-dec text)
res)
(gs:enable 'BackBtn)
(dotree (item *reference* true)
(let (str (eval item))
(when (and str (find word str *REOption*))
(push (list ((parse word "\r\n" 0) 0) (trim (term item) "_")) res -1))))
(if res (begin (push *indexList* *history*)
(set-listIndex res))
(gs:set-text 'OutputArea "missing.")))
(if *history* (category-action)))
)
(define (check-handler id check)
(setq *REOption* (if check 1) *changeFlag* true))
(define (text-handler id text)
(case id
("MAIN:InputArea" (when text (button-handler id)))
(true)))
(define (button-handler id)
(case id
("MAIN:BackBtn" (if *history* (begin (set-listIndex (pop *history*))
(if-not *history* (gs:disable 'BackBtn)))
(category-action)))
(true (gs:get-text 'InputArea 'textCallBack))))
(define (set-helpText func)
(gs:clear-text 'OutputArea)
(gs:set-text 'OutputArea (string *style* (*reference* (lookup func *indexList*))))
)
(define (index-action id idx item click)
(set-helpText (base64-dec item))
)
(define (set-listIndex lst)
(setq *indexList* lst)
(gs:clear-list 'IndexBox )
(map (curry gs:add-list-item 'IndexBox) (map first *indexList*))
(set-helpText (*indexList* 0 0))
)
(define (category-action id idx item)
(case id
("MAIN:CategoryBox"
(let (category (base64-dec item))
(if (= category "All category")
(set-listIndex (sort (unique (explode (flat (map rest *indexLists*)) 2))))
(set-listIndex (lookup category *indexLists*)))))
(true (set-listIndex (*history* -1))))
(gs:request-focus 'IndexBox 0))
; GUI-initialization
(gs:init)
(gs:frame 'Frame FPosX FPosY FWidth FHeight "Palm Memo Viewer")
(gs:panel 'ButtonPanel)
(gs:panel 'StatusPanel)
(gs:button 'SearchBtn 'button-handler "Search")
(gs:button 'BackBtn 'button-handler "Back")
(gs:text-field 'InputArea 'text-handler 10)
(gs:check-box 'REOption 'check-handler "" (true? *REOption*))
(gs:label 'SPACE (dup " " 5))
(gs:label 'RE "with Regular Expression")
(gs:label 'RED "Option number is 1.")
(gs:split-pane 'SplitPanel "vertical")
(gs:panel 'IndexPanel)
(gs:set-border-layout 'IndexPanel)
(gs:combo-box 'CategoryBox 'category-action (append (map first *indexLists*) '("All category")))
(setq *indexList* (*indexLists* 0 1))
(gs:list-box 'IndexBox 'index-action (map first *indexList*))
(gs:set-font 'IndexBox "Monospaced" 14)
(gs:text-pane 'OutputArea 'gs:no-action "text/plain")
(gs:set-editable 'OutputArea nil)
(set-helpText (*indexList* 0 0))
(gs:add-to 'IndexPanel 'CategoryBox "north" 'IndexBox "center")
(gs:add-to 'SplitPanel 'IndexPanel 'OutputArea)
(gs:add-to 'ButtonPanel 'SearchBtn 'InputArea 'BackBtn 'SPACE 'RE 'REOption 'RED)
(gs:disable 'BackBtn)
; 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)
スクリプト中の “memopad.dat” は、フル・パスを指定するか、スクリプトを実行するディレクトリに置いて下さい。
実行すると、
こんな感じで、newLISP関数リファレンス とほとんど同じ構成。まっ、GUI 部分は、newLISP-help.lsp からの流用ですから（笑）。
以上、如何でしょうか？
newLISP で EPUB を表示させる（改良編）
Googleの電子書籍サービス「Google eBooks」が開始されたとのこと。
日本は、まだ対応外なのですが、google アカウントを使って、無料の本を見ることができます。
試しに、Charles Dickens の “Bleak House” を EPUB 形式でダウンロードして、EPUB を zip 解凍すると、
META-INF - container.xml
OEBPS - content
- data
- _toc_ncx_.ncx
- volume.opf
mimetype
こんな感じに展開されます。ブクログにある拙作の書籍の構造とは、少し違うようです。
また、書籍の本体は、content フォルダの下に content-XXXX.xml というファイル名になっていました。
ということで、さっそく、拙作 EPUB-Viewer を対応させました。
; utility
(define *newlispDir* (env "NEWLISPDIR"))
(load (append *newlispDir* "/guiserver.lsp"))
; define macro
(module "macro.lsp")
(macro (parse-path P) (parse P {\\|/} 0))
; define handler
(define *fileDir* (real-path))
(define *fileNames* '())
(define *index* 0)
(define *filemask* "html xhtml xml")
(define *description* "HTML file")
(define (book-display file)
(when (file? file)
(let (ptmp (parse-path file)
book (replace {<\?.+\?>} (read-file file) "" 0))
(gs:set-text 'fileLabel (ptmp -1))
(unless (null? book)
(replace {<meta http-equiv[^>]*>} book "" 4)
(replace {src="../}
book
(string {src="file:///} (join (chop ptmp 2) "/" true)))
(gs:set-text 'OutputArea book)))))
(define (next-action id)
(let (f-max (length *fileNames*))
((if (starts-with ((parse id) -1) "pre") -- ++) *index*)
(if (< *index*) (setq *index* (i- f-max))
(< *index* f-max) nil
(setq *index* 0))
(book-display (append *fileDir* (*fileNames* *index*)))))
(define (openfile-action id op file)
(when file
(setq *fileDir* (base64-dec file))
(if (directory? *fileDir*)
(setq *fileDir* (append *fileDir* "/"))
(let (tmp (parse-path *fileDir*))
(setq *fileDir* (append (join (chop tmp) "/" true)))
(setq *fileName* (tmp -1))))
(gs:set-text 'Status *fileDir*)
(setq *fileNames* (sort (directory *fileDir* "html*$|xml$" 1)))
(setq *index* 0)
(if *fileName* (setq *index* (find *fileName* *fileNames*))
(setq *fileName* (*fileNames* 0)))
(book-display (append *fileDir* (*fileNames* *index*)))))
(define (open-file-dialog)
(gs:open-file-dialog 'Frame 'openfile-action *fileDir* *filemask* *description*))
; initialization
(gs:init)
(define FPosX 100)
(define FPosY 50)
(define FWidth 640)
(define FHeight 480)
(gs:frame 'Frame FPosX FPosY FWidth FHeight "Simple EPUB Viewer")
(gs:panel 'ButtonPanel)
(gs:panel 'StatusPanel)
(gs:label 'Status (real-path))
(gs:label 'fileLabel "")
(gs:button 'preBtn 'next-action "<")
(gs:button 'nextBtn 'next-action ">")
(gs:button 'fileButton 'open-file-dialog "File")
(gs:text-pane 'OutputArea 'gs:no-action "text/html")
(gs:add-to 'ButtonPanel 'preBtn 'fileLabel 'nextBtn)
(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" 'OutputArea "center" 'StatusPanel "south")
(gs:set-visible 'Frame true)
; main routine
(gs:listen)
(exit)
主な変更点は、対応ファイル拡張子（xml）の追加です（笑）。ついでに、画像の表示も。
これを実行し、File ボタンを押して、zip 解凍しておいた先程の content フォルダを指定すれば、
一応、対応している画像ファイルはずが、、、何故か、うまく表示されません。
でも、本文を読むだけなら、
問題なさそうです。
あとは、zip 解凍か、、、（汗）
以上、如何でしょうか？
新リスプな日々 