Archive for 2010年12月|Monthly archive page
quote or unquote 。。。または、map と apply への関数の与え方？
コメントを残すquote or unquote 。。。または、map と apply への関数の与え方。
newLISP では、map や apply の引数に関数を与える場合、クォート付き（quote）でも、クォート無し（unquote）でも使えます。
> (map ++ '(1 2 3))
(2 3 4)
> (map '++ '(1 2 3))
(2 3 4)
> (apply + '(1 2 3))
6
> (apply '+ '(1 2 3))
6
>
しかし、その違いは何か、ご存知でしょうか？
私は、正直なところ、「どっちも使えて便利だ」くらいにしか、考えていませんでした(汗)。
その答えは、“newLISP Fan Club Forum” の記事にあります。
どう違うかというと、
> (define (sum x) (++ 0 x))
(lambda (x) (++ 0 x))
> (map sum '(1 2 3))
(1 2 3)
> sum
(lambda (x) (++ 0 x))
> (map 'sum '(1 2 3))
(1 3 6)
> sum
(lambda (x) (++ 6 x))
>
sum の動作原理は、こちらでどうぞ。それを元に書いた私の blog もあります。
map だけでなく、apply でも同様です。
> (define (sum x) (++ 0 x))
(lambda (x) (++ 0 x))
> (apply sum '(1))
1
> sum
(lambda (x) (++ 0 x))
> (apply 'sum '(1))
1
> sum
(lambda (x) (++ 1 x))
>
さて、何故このような違いが出るのか？ その解説も、上記 “newLISP Fan Club Forum” 記事にありますが、一応、説明しましょう。
関数sum は、引数の値を関数内の ++ の第一引数に加算して保持します（++ が破壊的関数なので関数sum が書き換わる）。
クォート無しで map（または apply）に渡された関数は、ラムダ式の状態（つまり、無名関数）でリストの要素に適用されます。
そのため、無名関数が書き換わるだけなので、残りません。
一方、クォート付きで map（または apply）に渡された関数（つまり、sum というシンボル）は、sum というシンボルに束縛された関数でリストに適用されることになります。
つまり、書き換わる関数が sum というシンボルに束縛されているので、書き換えた内容が関数 sum 内に残り、加算されて行った訳です。
まっ、早い話、自己書換関数でない限り、クォートの有無を気にする必要が無いということですが、、、
さて、話はここで終わりですが、もう一つ例題を
> (delete 'sum)
true
> (define (sum:sum x) (++ 0 x))
(lambda (x) (++ 0 x))
>
この場合、デフォルト・ファンクタ sum の動作は、クォートの有無でどう変わるでしょうか？
答えは、こうなります。
> (map sum '(1 2 3))
(1 3 6)
> (map 'sum '(1 2 3))
(7 9 12)
>
クォートの有無に関わらず、同じ動作。何故かは、newLISP ユーザーなら自明ってことで(笑)。
以上、如何でしょうか？
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 です。必要に応じて変更して下さい。
長くなってきたので、いつものように（笑）、スクリプトの解説は、次回に。
以上、如何でしょうか？
first, second, third 、、、
newLISP には、first は有りますが、second, third 等はありません。
別に無くても、インデックス機能があるので、要らないのですが、困ったこともあります。
> ('(0 1 2) 2)
2
> ('(0 1) 2)
ERR: list index out of bounds
>
こんな風に、範囲外を指定するとエラーになります。最初に length でリストの大きさを調べるか、catch と throw の組み合わせれば良いのですが、結構手間なので、私は“newlisp-utility.lsp”で次のように登録して、使っています。
(define cdr (fn (lst) (or (rest lst) nil)))
(define car (fn (lst) (if (empty? lst) nil (first lst))))
(define second (fn (lst) (first (or (rest lst) '(nil)))))
(define third (fn (lst) (first (or (rest (rest lst)) '(nil)))))
(define fourth (fn (lst) (first (or (rest (rest (rest lst))) '(nil)))))
これなら、
> (third '(1 2 3)) 3 > (third '(1 2)) nil >
こんな感じで、範囲外は nil になってくれます。
また、car や cdr は、引数が空リスト () の時、nil が返ります。私のスクリプトで、時々、car や cdr を使っているのは、そういう効果を期待していたりします。
さて今回、car と cdr 共に、second 以下を一新しました。
(define cdr (fn (lst) (if-not (nil? lst) (or (rest lst) nil))))
(define car (fn (lst) (first (or lst '(nil)))))
(define second (fn (lst) (car (cdr lst))))
(define third (fn (lst) (car (cdr (cdr lst)))))
(define fourth (fn (lst) (car (cdr (cdr (cdr lst))))))
変更点は、上記関数の引数が nil の時でも、nil を返すようにしたこと。
と言うことで、またまた、ですが、“newlisp-utility.lsp”のアップデートです（笑）。
以上、如何でしょうか？
newLISP の curry を拡張してみる。。。または、newlisp-utility.lsp のアップデート
newLISP の組込curry は、とても重宝する関数です。私は、この関数で、“カリー化”なる技を知りました。
マニュアルには、
curry
syntax: (curry func exp)
func を二つの引数をとる関数f(x, y) を一つの引数をとる関数fx(y) に変換します。curry は、引数を評価しないマクロのように作用します。その代わり、func の適用時に評価されます。
Transforms func from a function f(x, y) that takes two arguments into a function fx(y) that takes a single argument. curry works like a macro in that it does not evaluate its arguments. Instead, they are evaluated during the application of func.
とあります。使い勝手のある関数ですが、マニュアルからわかるように作られる関数は、引数を一つしか取れません。
そこで、次のように改良してみました。
(macro (curryEx F A)
(lambda () (apply F (cons A $args))))
macro ですので、macro.lsp が必要です。実は、この curryEx は、既に、“On newLISP” でマクロ（lambda-macro）として紹介しています。今回、$args が macro でも使えることが分かったので、再掲しました。
動作はこんな感じ、
> curryEx (lambda-macro (F A) (expand '(lambda () (apply F (cons A $args))))) > (apply (curryEx map +) '((1 2 3))) (1 2 3) > (apply (curryEx map +) '((1 2 3)(10 20 30))) (11 22 33) > (apply (curryEx map +) '((1 2 3)(10 20 30)(100 200 300))) (111 222 333) > (apply (curry map +) '((1 2 3)(10 20 30))) (1 2 3) >
このように、多変数関数を map して apply できます（笑）。
いまさらですが、“newlisp-utility.lsp”に追加することにしました。
以上、如何でしょうか？
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 解凍か、、、（汗）
以上、如何でしょうか？
Palm（Clie）用の祝祭日データ設定ファイルを作ってみる。
年の瀬となり、そろそろ来年の予定を考え始めたころでしょうか？
予定表管理に使っている Clie の祝祭日データは、以前は、sony サイトで入手できましたが、現在は clie 自体がサポートされていません。したがって、自分で用意するしかありません。
とは言っても、祝祭日データ作成スクリプトは既に作ってありますので、後は、clie 用のデータに変換するだけです。
まずは、スクリプトを、（include は、init.lsp に定義してあります。）
(include "anniversary.lsp")
(define (make-DT y (M 1) (d 1) (h 0) (m 0) (s 0))
(format "%4d%02d%02dT%02d%02d%02d" y M d h m s))
(define preStr [text]BEGIN:VCALENDAR
VERSION:1.0
PRODID:PalmDesktop Generated
[/text])
(define calendarStr
[text]
BEGIN:VEVENT
SUMMARY:summayStr
DESCRIPTION:descStr
DTSTART:startStr
DTEND:endStr
END:VEVENT
[/text])
(define postStr [text]
END:VCALENDAR
[/text])
(define (make-event y m d desc)
(let (res calendarStr)
(replace "summayStr" res (string desc))
(replace "descStr" res "newLISP と vcal.lsp で作成")
(replace "startStr" res (make-DT y m d))
(replace "endStr" res (make-DT y m (++ d)))
res))
(define (make-vcal y)
(let (anni (mappend (curry anniversary y) (sequence 1 12))
res preStr)
(extend res (mappend (curry apply make-event) anni))
(extend res postStr)))
"anniversary.lsp"のソースは、“newLISP で祝祭日を計算する。”にありますが、ついでに掲載しておきましょう。
(define *WeekDays* '("Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat"))
(define (vernal year)
(if (and (<= 2000 year) (< year 2100))
(- (add 20.69115 (mul 0.242194 (- year 2000))) (/ (- year 2000) 4))))
(define (autumnal year)
(if (and (<= 2000 year) (< year 2100))
(- (add 23.09 (mul 0.242194 (- year 2000))) (/ (- year 2000) 4))))
(define (anniversary year month)
(let (i (find (0 3 (date (date-value year month 1))) *WeekDays*)
res '())
(case month
( 1 (push (list year 1 1 '元日) res -1) ; 元日
(if (= i 0) (push (list year 1 2 '振替休日) res -1))
(push (if (< i 2) ; 成人の日 : 1月第2月曜日
(list year 1 (- 9 i) '成人の日) ; 2 + 1 * 7
(list year 1 (- 16 i) '成人の日)) ; 2 + 2 * 7
res -1) )
( 2 (push (list year 2 11 '建国記念の日) res -1) ; 建国記念の日
(if (= i 4) (push (list year 2 12 '振替休日) res -1)) )
( 3 (push (list year 3 (vernal year) '春分の日) res -1) ; 春分の日
(if (= i (- 22 ((res -1) 2))) (push (list year 3 (+ 1 ((res -1) 2)) '振替休日) res -1)) )
( 4 (push (list year 4 29 '昭和の日) res -1) ; 昭和の日
(if (= i 0) (push (list year 4 30 '振替休日) res -1)))
( 5 (push (list year 5 3 '憲法記念日) res -1) ; 憲法記念日
(push (list year 5 4 'みどりの日) res -1) ; みどりの日
(push (list year 5 5 'こどもの日) res -1) ; こどもの日
(if (and (< 2 i) (< i 6)) (push (list year 5 6 '振替休日) res -1)) )
( 6 )
( 7 (push (if (< i 2) ; 海の日 : 7月第3月曜日
(list year 7 (- 16 i) '海の日) ; 2 + 2 * 7
(list year 7 (- 23 i) '海の日)) ; 2 + 3 * 7
res -1) )
( 8 (when (> year 2015)
(push (list year 8 11 '山の日) res -1) ; 山の日
(if (= i 4) (push (list year 8 12 '振替休日) res -1))))
( 9 (push (if (< i 2) ; 敬老の日 : 9月第3月曜日
(list year 9 (- 16 i) '敬老の日) ; 2 + 2 * 7
(list year 9 (- 23 i) '敬老の日)) ; 2 + 3 * 7
res -1)
(push (list year 9 (autumnal year) '秋分の日) res -1) ; 秋分の日
(if (= i (- 29 ((res -1) 2)) (push (list year 9 (+ 1 ((res -1) 2)) '振替休日) res -1)) )
(if (= 2 (- ((res 1) 2) ((res 0) 2)))
(push (list year 9 (- ((res -1) 2) 1) '国民の休日) res 1)) )
(10 (push (if (< i 2) ; 体育の日 : 10月第2月曜日
(list year 10 (- 9 i) '体育の日) ; 2 + 1 * 7
(list year 10 (- 16 i) '体育の日)) ; 2 + 2 * 7
res -1) )
(11 (push (list year 11 3 '文化の日) res -1) ; 文化の日
(if (= i 5) (push (list year 11 4 '振替休日) res -1))
(push (list year 11 23 '勤労感謝の日) res -1) ; 勤労感謝の日
(if (= i 6) (push (list year 11 24 '振替休日) res -1)))
(12 (push (list year 12 23 '天皇誕生日) res -1) ; 天皇誕生日
(if (= i 6) (push (list year 12 24 '振替休日) res -1)) )
(true ))
res))
と言いつつ、さりげなく、修正してあったりします。以前の関数anniversary では、祝祭日がない時、nil を返しましたが、今回のスクリプトでは、空リスト () が返ります。
さて、使い方は、newLISP 上で、上記スクリプトを読み込み、
(write-file "holidays2011.vcs" (make-vcal 2011))
という風に実行すれば、2011年の祝祭日用vCalendarファイル "holidays2011.vcs" が作成されます。ちなみ、Clie の日本語コードは、Shift-JIS です。間違って、UTF-8 版 newLISP で動作させてはいけません。お間違えなく。
"holidays2011.vcs" の中身は、
BEGIN:VCALENDAR
VERSION:1.0
PRODID:PalmDesktop Generated
BEGIN:VEVENT
SUMMARY:元日
DESCRIPTION:newLISP と vcal.lsp で作成
DTSTART:20110101T000000
DTEND:20110102T000000
END:VEVENT
BEGIN:VEVENT
SUMMARY:成人の日
DESCRIPTION:newLISP と vcal.lsp で作成
DTSTART:20110110T000000
DTEND:20110111T000000
END:VEVENT
BEGIN:VEVENT
SUMMARY:建国記念の日
DESCRIPTION:newLISP と vcal.lsp で作成
DTSTART:20110211T000000
DTEND:20110212T000000
END:VEVENT
BEGIN:VEVENT
SUMMARY:春分の日
DESCRIPTION:newLISP と vcal.lsp で作成
DTSTART:20110321T000000
DTEND:20110322T000000
END:VEVENT
BEGIN:VEVENT
SUMMARY:昭和の日
DESCRIPTION:newLISP と vcal.lsp で作成
DTSTART:20110429T000000
DTEND:20110430T000000
END:VEVENT
BEGIN:VEVENT
SUMMARY:憲法記念日
DESCRIPTION:newLISP と vcal.lsp で作成
DTSTART:20110503T000000
DTEND:20110504T000000
END:VEVENT
BEGIN:VEVENT
SUMMARY:みどりの日
DESCRIPTION:newLISP と vcal.lsp で作成
DTSTART:20110504T000000
DTEND:20110505T000000
END:VEVENT
BEGIN:VEVENT
SUMMARY:こどもの日
DESCRIPTION:newLISP と vcal.lsp で作成
DTSTART:20110505T000000
DTEND:20110506T000000
END:VEVENT
BEGIN:VEVENT
SUMMARY:海の日
DESCRIPTION:newLISP と vcal.lsp で作成
DTSTART:20110718T000000
DTEND:20110719T000000
END:VEVENT
BEGIN:VEVENT
SUMMARY:敬老の日
DESCRIPTION:newLISP と vcal.lsp で作成
DTSTART:20110919T000000
DTEND:20110920T000000
END:VEVENT
BEGIN:VEVENT
SUMMARY:秋分の日
DESCRIPTION:newLISP と vcal.lsp で作成
DTSTART:20110923T000000
DTEND:20110924T000000
END:VEVENT
BEGIN:VEVENT
SUMMARY:体育の日
DESCRIPTION:newLISP と vcal.lsp で作成
DTSTART:20111010T000000
DTEND:20111011T000000
END:VEVENT
BEGIN:VEVENT
SUMMARY:文化の日
DESCRIPTION:newLISP と vcal.lsp で作成
DTSTART:20111103T000000
DTEND:20111104T000000
END:VEVENT
BEGIN:VEVENT
SUMMARY:勤労感謝の日
DESCRIPTION:newLISP と vcal.lsp で作成
DTSTART:20111123T000000
DTEND:20111124T000000
END:VEVENT
BEGIN:VEVENT
SUMMARY:天皇誕生日
DESCRIPTION:newLISP と vcal.lsp で作成
DTSTART:20111223T000000
DTEND:20111224T000000
END:VEVENT
END:VCALENDAR
こんな感じ。Clie（Palm）では、予定表の設定用にvCalendarファイルが読み込めますので、上記スクリプトは、それに合わせてあります。データ構造は、見れば、大体想像がつくと思いますので、解説しません。祝祭日は、時間指定のないデータとして、登録されるようにしてあります。まっ、開始時間を当日の 0時に、終了時間を次の日の 0時にしてあるだけですけどね。他に必要なデータ（例えば、誕生日とか）は、適当に追加して下さい（笑）。
後は、Palm Desktop でインポートを開き、拡張子を vcs にして、作成したファイルを読み込めば、来年の祝祭日データが設定されます。これで、来年の準備は万全(笑)。
以上、如何でしょうか？
（2011/12/09 昭和の日に振替休日が抜けていたので、"anniversary.lsp" を変更）
（2016/01/09 "anniversary.lsp" に山の日を追加）
（2016/10/08 元日の振替休日追加）
newLISP で GUI する。。。または、天気予報を表示する。（解説編）
“newLISP で GUI する。。。または、天気予報を表示する。”を出してからだいぶ経ちますが（汗）、如何だったでしょうか？
“short short story または 晴耕雨読な日々”の WordPress.com の移動に伴う LISP と On newLISP の不具合の修正が終わったので、ようやく、こちらを更新できるようになりました（言い訳ですけどね、汗）。
さて、解説ですが、今回は、鬼門（笑）の正規表現です。
スクリプト中の関数button-handler に
(regex {<div class="titleBgLong">(([^v]*)*(v+[^>][^v]*)*)</div>} weather 0)
という部分があります。変数weather には、tenki.jp のソースが入っていて、天気予報の場所と更新時間を取り出しています。
"<div class="titleBgLong">～</div>" という部分を切り出そうとして、
{<div class="titleBgLong">.*</div>}
とすると、複数の "</div>" がある場合、うまくいきません。
そこで、ここを
{<div class="titleBgLong">(([^v]*)*(v+[^>][^v]*)*)</div>}
としているのが、今回の肝です。
この正規表現の中で、
(([^v]*)*(v+[^>][^v]*)*)
の部分が、"v>" という文字列を含まない文字列にマッチします。
なぜそうなるのか？ 正直に言いましょう、私には判りません（笑）。
“ある文字列を含まない正規表現”で、自動生成してもらった正規表現です。
同様に
(letn (tmp (regex {(<table(([^e]*)*(e+[^>][^e]*)*)*/table>)} weather (+ 2048 4))
の部分では、"e>" という文字列を含まない、を使って、"<table～/table>" 部分を切り出し天気予報情報自体を取り出しています。
このように、～という文字列を含まない、という表現を使ったことで格段に文字列の切り出しが楽になりました（笑）。
以上、如何でしょうか？
新リスプな日々 