Archive for the ‘UTF-8’ Tag
pack と unpack
Filed under: Reference, Utility | タグ: bytes2str, pack, str2bytes, unpack, UTF-8
コメントを残す UTF-8 版 newLISP では、explode が文字単位で動作します。だから、マニュアルの例にある
> (explode "¥000¥001¥002¥003")
("¥000" "¥001" "¥002" "¥003")
が使えません。なので、バイナリ・データを扱う時、UTF-8 版は使えないと思っていたのですが、私の理解が足りないだけでした（汗）。元ネタは、こちら。
こういった場合、unpack を使います。
(define (str2bytes str) (unpack (dup "b" (length str)) str))
ここで、"b" は符号なし８ビット数を指定しています。ちなみに、"c" だと符号付き８ビット数です。
これを使えば、
> (str2bytes "¥000¥001¥002¥003") (0 1 2 3)
となります。扱いやすいように数値に変換していますが、文字列のままにしたい時は、unpack で "s" を指定します。
> (unpack (dup "s" 4) "¥000¥001¥002¥003")
("¥000" "¥001" "¥002" "¥003")
さて、バイト数列から、バイナリ・データ（文字列）に変換するには、当然 pack を使います。
(define (bytes2str lst) (pack (dup "b" (length lst)) lst))
UTF-8 版 newLISP でなければ、(mappend は newlisp-utility.lsp に定義してあります。）
(define (bytes2str lst) (mappend char lst))or(define (bytes2str lst) (apply append (map char lst)))
とも書けます。
ということで、UTF-8 版 newLISP でもバイナリ・データを扱えるようになりました。つまり、UTF-8 版 newLISP 上でShift-JIS データを UTF-8 データに変換できるということ。
これで、Windows 環境でも UTF-8 版 newLISP だけでアプリケーションを組めるようになりました（笑）。
以上、如何でしょうか？
newLISP で音楽を楽しむ．．．UTF-8化（解説編）
“newLISP で音楽を楽しむ．．．UTF-8化”は、如何だったでしょうか？
WideChar 対応で使う Windows API は、
(import "winmm.dll" "mciSendStringW")
(import "winmm.dll" "mciGetErrorStringW")
となります。ただし、ファイル名を使わないコマンドには、WideChar は必要ないので、
(import "winmm.dll" "mciSendStringA")
も残してあります。
UTF-8 版 newLISP の文字列は、当然、文字コードがUTF-8 コードですので、それを WideChar に変換するには、組込unicode を使います。
ただし、組込unicode の戻り値は、4バイトの UNICODE文字列。日本語 Windows の WideChar は、2バイトなので、変換しなければなりません。
(define (long2word str)
(let (res "")
(dotimes (i (/ (length str) 4))
(let (c (slice str (* 4 i) 2))
(unless (= c "¥000¥000")
(extend res c))))
res))
組込explode や暗黙のインデックス機能が使えれば良いのですが、どちらも文字単位で動作します。
そこで、バイト単位で動作する組込slice を使って上位2バイトの “/000/000” を削除しています。
WideChar から UTF-8 に変換するには、組込utf8 を使います。しかし、引数は 4バイトの UNICODE文字列です。
そこで、WideChar に上位2バイトの “/000/000” を付加する関数も用意します。
(define (word2long str)
(let (res "")
(dotimes (i (/ (length str) 2))
(let (c (slice str (* 2 i) 2))
(unless (= c "¥000¥000")
(extend res c "¥000¥000"))))
(extend res "¥000¥000¥000¥000")))
これらを、組込unicode と utf8 に組み合わせるだけです。
(define (toWchar str)
(long2word (unicode str)))
(define (toChar str)
(utf8 (word2long str)))
関数toWchar が UTF-8 文字列を WideChar 文字列に変換し、関数toChar がその逆です。
そして、ファイルが必要な関数 music:open と エラー内容を表示する関数 get-err-str に組み込めば終わりです。
残りは、以前の“newLISP で音楽を楽しむ．．．context 化”と一緒です。
以上、如何でしょうか？
newLISP で音楽を楽しむ．．．UTF-8化
以前、Windows API を使った音楽ファイルを再生するスクリプトを紹介しましたが、WideChar には、対応していなかったので、”é” を含むようなファイル名の音楽ファイルには、使えませんでした（汗）。
現在では、WIndows 上でも、UTF-8版 newLISP を使えるので、WideChar 対応にできるはず（guiserver.jar には開発版のV1.43がお薦め）。
ということで、スクリプトを作ってみました。
(context 'MAIN:music)
(import "winmm.dll" "mciSendStringW")
(import "winmm.dll" "mciSendStringA")
(import "winmm.dll" "mciGetErrorStringW")
(define l_rtnStr 128)
(define rtnStr (dup "¥000" (+ 1 l_rtnStr)))
(define (long2word str)
(let (res "")
(dotimes (i (/ (length str) 4))
(let (c (slice str (* 4 i) 2))
(unless (= c "¥000¥000")
(extend res c))))
res))
(define (word2long str)
(let (res "")
(dotimes (i (/ (length str) 2))
(let (c (slice str (* 2 i) 2))
(unless (= c "¥000¥000")
(extend res c "¥000¥000"))))
(extend res "¥000¥000¥000¥000")))
(define (toWchar str)
(long2word (unicode str)))
(define (toChar str)
(utf8 (word2long str)))
(define (get-err-str n)
(mciGetErrorStringW n rtnStr l_rtnStr)
(println (toChar rtnStr)))
(define alias-name " Music")
(define wait-time 500)
(define (music:open m)
(mciSendStringW (toWchar (string "open \"" m "\" alias" alias-name)) 0 0 0))
(define-macro (make-status)
(letex (_cmd (string "status" alias-name " " (args 0))
_func (sym (string (args 0))))
(define (_func) (mciSendStringA _cmd rtnStr l_rtnStr 0) rtnStr)))
(make-status "mode")
(make-status "position")
(make-status "length")
(define-macro (make-music)
(letex (_cmd (string (args 0) alias-name)
_func (sym (string (args 0))))
(define (_func) (mciSendStringA _cmd 0 0 0))))
(make-music "close")
(make-music "play")
(make-music "stop")
(make-music "pause")
(define (volume-off)
(mciSendStringA "set Music audio all off" 0 0 0))
(define (volume-on)
(mciSendStringA "set Music audio all on" 0 0 0))
(context MAIN)
使い方は、“newLISP で音楽を楽しむ．．．context 化”と一緒ですが、動作には、Windows の UTF-8版newLISP が必要です。お間違えなく（笑）。
WideChar対応の解説は、次回に。
以上、如何でしょうか？
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 解凍か、、、（汗）
以上、如何でしょうか？
newLISP で GUI する。。。または、天気予報を表示する。
以下のスクリプトには、UTF-8 版 newLISP が必要です。
今回は、guiserver を使って、天気予報を表示させます。使う天気予報は、日本気象協会の tenki.jp のものです。
具体的には、例えば、仙台市なら
からデータを取り出し、gs:text-pane の “text/html” モードで表示させます。
上記 URL から分かりますように、326 が仙台市の番号です。ちなみに 1 は、札幌市です。
ということで、スクリプトを、
; utility
(define *newlispDir* (env "NEWLISPDIR"))
(load (append *newlispDir* "/guiserver.lsp"))
; define global variable
;(define point 1) ; 札幌市
(define point 326) ; 仙台市
;(define point 744) ; 横浜市
;(define point 1974) ; 与那国町
(define tenki-url (string "http://tenki.jp/forecast/point-" point ".html"))
; define handler
(define (delete-tag html)
(replace "<[^>]+>" html "" 1))
(define (delete-comment html)
(replace "<!--[^>]+-->" html "" 0))
(define (button-handler id)
(let (weather (get-url tenki-url))
(regex {<div class="titleBgLong">(([^v]*)*(v+[^>][^v]*)*)</div>} weather 0)
(gs:set-text 'leftTitle (append (delete-tag $0) (dup " " 4)))
(letn (tmp (regex {(<table(([^e]*)*(e+[^>][^e]*)*)*/table>)} weather (+ 2048 4))
today $1
i (apply + (-2 tmp)))
(gs:set-text 'TodayArea today)
(regex {<div class="titleBgLong">(([^v]*)*(v+[^>][^v]*)*)</div>} (i weather) 0)
(gs:set-text 'rightTitle (append (dup " " 4) (delete-tag $0)))
(regex {(<table.+/table>)+} (i weather) (+ 2048 4))
(gs:set-text 'WeekArea (delete-comment $0))
)))
; initialization
(gs:init)
(define FPosX 50)
(define FPosY 50)
(define FWidth 1000)
(define FHeight 480)
(gs:frame 'Frame FPosX FPosY FWidth FHeight "天気情報 from tenki.jp")
(gs:panel 'ButtonPanel)
(gs:label 'leftTitle "")
(gs:label 'rightTitle "")
(gs:button 'Button1 'button-handler "renew")
(gs:text-pane 'TodayArea 'gs:no-action "text/html")
;(gs:set-editable 'TodayArea 'nil)
(gs:text-pane 'WeekArea 'gs:no-action "text/html")
;(gs:set-editable 'WeekArea 'nil)
(button-handler)
(gs:split-pane 'SplitPanel "vertical" 0.55)
(gs:add-to 'SplitPanel 'TodayArea 'WeekArea)
(gs:add-to 'ButtonPanel 'leftTitle 'Button1 'rightTitle)
; mount all on frame
(gs:set-border-layout 'Frame)
(gs:set-flow-layout 'ButtonPanel "center")
(gs:add-to 'Frame 'ButtonPanel "north" 'SplitPanel "center")
(gs:set-visible 'Frame true)
; main routine
(gs:listen)
(exit)
このスクリプトを UTF-8 版 newLISP で起動すると、
こんな感じで表示されます。
tenki.jp の文字コードは UTF-8 ですから、UTF-8 版 newLISP は必須です。
Windows でも、UTF-8 版 newLISP が使えるようになっているので、この程度のスクリプトで済みました。
UTF-8 コード使っていない Linux では、文字コード変換が必要ですけどね。
私は、puppy Linux なので、問題ないですが。
地域にを変えるには、
(define point 326) ; 仙台市
の 326 を表示させたい地域の番号に変えるだけ。
以上、如何でしょうか？
URL エンコードとデコード
以下のスクリプトには、UTF-8 版 newLISP が必要です。
文字コードが UTF-8 のURLエンコードは、前に紹介していますが、UTF-8版でない newLISP 用です。
今回は、Windows でも使えるようになった UTF-8版 newLISP 用です（笑）。
先ずは、エンコードから、
(define (char2hex ch pre flag , (d 64))
(if (and flag (< ch 128)) (char ch)
(let (u 0 res '())
(while (> ch 127)
(push (string pre (format "%2X" (+ 0x80 (% ch d)))) res)
(setq ch (/ ch d))
(setq u (+ 0x80 (>> u))))
(push (string pre (format "%2X" (if (= u 0) ch (+ 0x80 (>> u) ch)))) res)
(apply string res))))
(define (url-encode-utf8 str (pre "%") flag)
(let (res "")
(dostring (c str)
(extend res (char2hex c pre flag)))))
使い方は、
> (url-encode-utf8 "技術") "%E6%8A%80%E8%A1%93" > (url-encode-utf8 "技術" "") "E68A80E8A193" >
% を外せるようにした訳は、別の機会に（笑）。
newLISP の Code Snippets にある “URL encode and decode” を参考にして、
(define (url-encode str)
(replace {([^a-zA-Z0-9])+} str (url-encode-utf8 $0) 0))
と定義すれば、
> (url-encode "web技術") "web%E6%8A%80%E8%A1%93" > (url-encode "科学 to 技術") "%E7%A7%91%E5%AD%A6%20to%20%E6%8A%80%E8%A1%93" >
こんな感じ。
さて、デコードは、
(module "macro.lsp")
(macro (hex2int H) (int H 0 16))
(define (url-decode-utf8 str (pre "%"))
(let (hexs (1 (parse str pre))
res '())
(while hexs
(let (ch (hex2int (pop hexs)))
(if (< ch 0x80) (push ch res -1)
(< ch 0xE0) (push (+ (* 0x40 (& (hex2int ch) 0x1F))
(& (hex2int (pop hexs)) 0x3F)) res -1)
(< ch 0xF0) (push (+ (* 0x1000 (& (hex2int ch) 0x0F))
(* 0x40 (& (hex2int (pop hexs)) 0x3F))
(& (hex2int (pop hexs)) 0x3F)) res -1)
(< ch 0xF8) (push (+ (* 0x40000 (& (hex2int ch) 0x07))
(* 0x1000 (& (hex2int (pop hexs)) 0x3F))
(* 0x40 (& (hex2int (pop hexs)) 0x3F))
(& (hex2int (pop hexs)) 0x3F)) res -1)
)))
(apply string (map char res))))
使い方は、
> (url-decode-utf8 "%E6%8A%80%E8%A1%93") "技術" > (url-decode-utf8 (append "%" (join (explode "E68A80E8A193" 2) "%"))) "技術" >
何をしたいのか、一目瞭然？（笑）
こちらも、newLISP の Code Snippets にある “URL encode and decode” を参考にして、
(define (url-decode str)
(replace "+" str " ") ; optional
(replace "(%[0-9A-F][0-9A-F])+" str (url-decode-utf8 $0) 0))
と定義すれば、
> (url-decode "web%E6%8A%80%E8%A1%93") "web技術" > (url-decode "%E7%A7%91%E5%AD%A6%20to%20%E6%8A%80%E8%A1%93") "科学 to 技術" > (url-decode "%E7%A7%91%E5%AD%A6+to+%E6%8A%80%E8%A1%93") "科学 to 技術" >
こんな感じで使えます。
以上、如何でしょうか？
newLISP で GUI する。。。または、EPUB を表示させる？（解説編）
newLISP で GUI する。。。または、EPUB を表示させる？（解説編）
前回の EPUB Viewer は、如何だったでしょうか？
EPUB の本体は、XHTML のサブセットですが、そのままでは、gs:text-pane で表示できません。
<head></head> タグが邪魔しているようなのです。
そのためスクリプトでは、
(letn (str (read-file file)
book ((find {} str) str))
(gs:set-text 'OutputArea (0 (+ (find {} book) 7) book)))
こんな感じで、本文が入っている <body></body> を抜き出して表示させています。
本来に立ち戻って、<head></head> タグだけを削除するなら、
(letn (str (replace {} (read-file file) "" 0)
book1 (aif (find {} str) (0 it str) str)
book2 (aif (find {} str) ((+ it 7) str) "")
book (append book1 book2))
(gs:set-text 'OutputArea book))
こうすべきでした。先頭の削除宣言文は、xhtml の宣言文（？）の削除です。gs:text-pane では、そのまま表示されてしまうので。
また、ファイル名を取得するには、組込directory の正規表現オプションを使って、
(directory *fileDir* "[^.+]" 1)
としていました。これは、"." と ".." 以外のファイル名を取り込みます。
HTMLファイルだけを取り込むようにするには、
(directory *fileDir* "html*$" 1)
こんな感じ。ドットを付加しなかったのは、をEPUB の拡張子が .xhtml だから。
私の場合、あんまり、正規表現にこだわると、失敗するので（汗）。
これらを、前回の EPUB Viewer に適用すると、
（include は init.lsp に、aif は newlisp-utility.lsp に定義してあります。）
; utility
(define *newlispDir* (env "NEWLISPDIR"))
(load (append *newlispDir* "/guiserver.lsp"))
(include "macro.lsp")
; define sub-routine
(macro (parse-path P)
(parse P {\\|/} 0))
; define handler
(define *fileDir* (real-path))
(define *fileNames* '())
(define *index* 0)
(define *filemask* "html xhtml")
(define *description* "HTML file")
(define (book-display file)
(when (file? file)
(gs:set-text 'fileLabel ((parse-path file) -1))
(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))
(replace {src="../}
book
(string {src="file:///} (join (chop (parse-path *fileDir*)) "/" 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*$" 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 "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/plain")
(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)
こうなります。
これなら、EPUB Viewer としてだけではなく、簡易 HTML Viewer としても使える？
以上、如何でしょうか？
newLISP で GUI する。。。または、EPUB を表示させる？
手前味噌ですが、前の blog で short short story として書きためたものをブクログで紹介しています。
そこから、ダウンロードできるフォーマットの一つが、EPUB。
調べてみると EPUB は、最近話題（？）の電子書籍の一種で、XHTMLのサブセット的なファイル・フォーマットで ZIP 圧縮されたもの。
これなら、newLISP で表示できそうだと始めてみました。
本来なら、zip 解凍から始めるべきですが、まだ目処が付いていないので、解凍後のファイルの表示用です。
EPUB を zip 解凍すると、
META-INF - container.xml
OEBPS - css
- image
- text
- content.opf
- toc.ncx
mimetype
こんな感じに展開されます。
お目当て（笑）の short short story は、text フォルダの下に XXX.xhtml のファイル名であります。
今回のスクリプトは、この text フォルダを指定して、中のファイルを表示するスクリプトです。
; utility
(define *newlispDir* (env "NEWLISPDIR"))
(load (append *newlispDir* "/guiserver.lsp"))
; define sub-routine
; define handler
(define *fileDir* (real-path))
(define *fileNames* '())
(define *index* 0)
(define *filemask* "html xhtml")
(define *description* "HTML file")
(define (book-display file)
(when (file? file)
(gs:set-text 'Status file)
(letn (str (read-file file)
book ((find {<body>} str) str))
(gs:set-text 'OutputArea (0 (+ (find {</body>} book) 7) 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 *fileDir* {\\|/} 0))
(setq *fileDir* (append (join (chop tmp) "/" true)))
(setq *fileName* (tmp -1))))
(setq *fileNames* (sort (directory *fileDir* "[^.+]" 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 "EPUB Viewer")
(gs:panel 'ButtonPanel)
(gs:panel 'StatusPanel)
(gs:label 'Status (real-path))
(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/plain")
(gs:text-pane 'OutputArea 'gs:no-action "text/html")
(gs:add-to 'ButtonPanel 'preBtn '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)
これを実行し、File ボタンを押して、解凍しておいた先程の text フォルダを指定すれば、
といった具合に表示されます。
ただし、テキスト・コードは、UTF-8です。つまり、UTF-8 版 newLISP で実行する必要があります。
まだ、テキスト内容だけで、イメージ・ファイルまでは、表示できませんが（汗）。
それに、zip 解凍も、、、
以上、如何でしょうか？
UTF-8 版newLISP で日付を扱う。
前回は、日付を抽出する正規表現でしたが、今回は、その後の処理。
といっても、前に紹介した関数change-date の改良版です。
その前に、ちょっとおさらい。
(define dateMatchStr
{([ ]*[0-9０-９]{2,4})?[ ]*[./\-・／－‐年]?([ ]*[0-9０-９]{1,2}[ ]*)[./\-・／－‐月]([ ]*[0-9０-９]{1,2})日?}
)
(define (number-zen2han str)
(replace "[ ]" str "" 2048) ; added 2010/11/ 8
(replace "[０-９]" str (char (+ (- (char $0) 0xFF10) 0x30)) 2048))
(define (convert-2slash str)
(trim
(replace "[.\\-・／－‐年月日]" (number-zen2han str) "/" 2048)
"/"))
(define (divide-with-date str (flag true))
(let (res (regex dateMatchStr str 2048))
(if res (list (0 (res 1) str)
(if flag (convert-2slash (res 0)) (res 0))
((+ (res 1) (res 2)) str)))))
おさらいと言いつつ、さりげなく正規表現文字列を変えています（汗）。区切り文字にスペース（半角と全角）を使えなくしました。なんと前と同じ、進歩のない私です（汗）。
気のとり直して、本題です（defun と hayashi は、 newlisp-utility.lsp に定義してあります）。
(setq Today (0 3 (now (* 9 60))))
(defun strlst2date (lst)
(let (n (length (lst 0)))
(if (zero? n)
(setf (lst 0) (string (Today 0)))
(setf (lst 0) (string (chop "2000" n) $it)))
(map (hayashi int 0 10) (map (fn (x) (replace " " x " ")) lst))))
(defun change-date (str)
(let (slst (divide-with-date str))
(when slst
(let (d (/ (- (apply date-value (strlst2date (map trim (map number-zen2han (list $1 $2 $3)))))
(apply date-value Today))
24 60 60))
(case d
(0 (setf (slst 1) " 本日"))
(1 (setf (slst 1) " 明日"))
(2 (setf (slst 1) " 明後日"))
(true (if (< d ) (setf (slst 1) (string " " (- d) "日前")))))))
(apply string slst)))
(defun extract-date (str)
(let (res (regex dateMatchStr (number-zen2han str) 2048))
(when res
(strlst2date (map trim (list $1 $2 $3))))))
動作は、
> (change-date "9/23 テニスの日") " 本日 テニスの日" > (change-date "行事 9/23 テニスの日") "行事 本日 テニスの日" > (change-date "行事 10/9/23 テニスの日") "行事 本日 テニスの日" > (change-date "行事 2011/9/23 テニスの日") "行事 2011/9/23 テニスの日" > (change-date "祝日 １１年９月２３日 秋分の日") "祝日 11/9/23 秋分の日" > (extract-date "祝日 １１年９月２３日 秋分の日") (2011 9 23) > (extract-date "行事 9/23 テニスの日") (2010 9 23) > (extract-date "９／２３ テニスの日") (2010 9 23) >
こんな感じ。
以上、如何でしょうか？
UTF-8 版 newLISP で日付を抽出する。
前の blog で紹介した “newLISP で日付を抽出する”と“newLISP で日付を抽出する(再び)”の UTF-8 対応です。
先ずは、スクリプトから、
(define dateMatchStr
{([ ]*[0-9０-９]{2,4})?[ ]*[./\-・／－‐年]?([ ]*[0-9０-９]{1,2}[ ]*)[./\-・／－‐月]([ ]*[0-9０-９]{1,2})日?}
)
(define (number-zen2han str)
(replace "[ ]" str "" 2048) ; added 2010/11/ 8
(replace "[０-９]" str (char (+ (- (char $0) 0xFF10) 0x30)) 2048))
(define (convert-2slash str)
(trim
(replace "[.\\-・／－‐年月日]" (number-zen2han str) "/" 2048)
"/"))
(define (divide-with-date str (flag true))
(let (res (regex dateMatchStr str 2048))
(if res (list (0 (res 1) str)
(if flag (convert-2slash (res 0)) (res 0))
((+ (res 1) (res 2)) str)))))
前の時のように、正規表現文字列を複数用意せずに済み、コードもすっきり（笑）。
（2010/ 9/23 区切り文字から全角と半角のスペースを削除。）
ちなみに、全角には、－（マイナス記号）と‐（ハイホン記号）の両方を用意しました。また、半角の -（ハイホン-マイナス記号）の前には、\（エスケープ文字）が必要です。前の時の文字列では付いていませんが、たまたま動作する配置になっています（汗）。
全角->半角変換には前回のスクリプトを使ってもいいのですが、数字だけなので専用にしました。漢数字も対応といきたいところですが、それはまた、別の機会に。
動作は、
> (divide-with-date "出張 ３／１３ 横浜")
("出張" "3/13" " 横浜")
> (divide-with-date "１０月１１日芋煮会")
("" "10/11" "芋煮会")
>
こんな感じ。
関数divide-with-date の追加した第二引数を nil にすると、
> (divide-with-date "１０月１１日芋煮会" nil)
("" "１０月１１日" "芋煮会")
>
日付は、入力のまま出力されます。
以上、如何でしょうか？
新リスプな日々 