Archive for the ‘CSV’ Tag
newLISP で GUI する。。。または、CSV Editor の作成（改造編５）
コメントを残す（以下は、 newLISP v 2.8.16 以上、または、guisever 1.42以上での話です。）
今回は、前回表示させたテーブルのHTML表示をファイルに落とせるようにします。
先ずは、ポップアップ・メニューを用意して、
(gs:menu-popup 'viewMenuPopup "View")
(gs:menu-item 'toolCopy 'clip-action "copy")
(gs:menu-item 'toolHTMLFile 'HTMLfile-action "to .html file")
(gs:add-to 'viewMenuPopup 'toolCopy 'toolHTMLFile)
ついでに、テーブルの list 表示もできるようにしておきます。
(gs:menu-item 'viewHTML 'dialog-action "to html-table")
(gs:menu-item 'viewList 'dialog-action "to lisp-list text")
(gs:add-to 'viewMenu 'viewAdjust 'viewHTML 'viewList)
どちらも、同じイベント・ハンドラdialog-action に飛びます。
(define (dialog-action id)
(gs:dialog 'Dialog 'Frame "HTML or List" FWidth FHeight nil true)
(gs:set-border-layout 'Dialog)
(gs:table-get *currentCSV*)
(cond ((ends-with id "HTML")
(gs:disable 'toolCopy)
(gs:enable 'toolHTMLFile)
(gs:text-pane 'OutputArea 'gs:no-action "text/html")
(gs:set-text 'OutputArea (makeHTMLtable gs:table-full)))
((ends-with id "List")
(gs:disable 'toolHTMLFile)
(gs:enable 'toolCopy)
(gs:text-pane 'OutputArea 'gs:no-action "text/plain")
(dolist (row gs:table-full)
(if (zero? $idx) (gs:set-text 'OutputArea "(")
(gs:append-text 'OutputArea " "))
(gs:append-text 'OutputArea (string (if *Numerics* (map string-convert row) row) "\n")))
(gs:append-text 'OutputArea ")"))
(true ))
(gs:add-to 'Dialog 'OutputArea "center")
(gs:mouse-event 'OutputArea 'dialog-mouse-handler)
(gs:set-visible 'Dialog true))
この中で、マウス・イベントを指定して、
(define (dialog-mouse-handler id type x y button cnt mods)
(if (or (= button 3) (= mods 18))
(gs:show-popup 'viewMenuPopup 'OutputArea x y)
))
右クリックでポップアップ・メニューを表示させます。
テーブル list 表示の場合、こんな感じ。
あとは、ポップアップ・メニューで指定される処理を用意するだけ。
(define (HTML-save id op file)
(when file
(let (fname (base64-dec file))
(write-file fname (gs:get-text 'OutputArea)))))
(define (HTMLfile-action)
(let (tmp (if-not (directory? *tabName*) (parse *tabName* {\\|/} 0)))
(gs:save-file-dialog 'Frame 'HTML-save (join (chop tmp) "/")
(string ((parse (tmp -1) ".") 0) ".html")
"html HTML" "HTML file")))
(define (clip-action)
(gs:select-text 'OutputArea 0)
(gs:copy-text 'OutputArea))
HTMLテーブルはファイルに落とせ、テーブル list はクリップボードにコピーされます。
全スクリプトは、CSV-Editor.lsp からどうぞ。
以上、如何でしょうか？
newLISP で GUI する。。。または、CSV Editor の作成（改造編４）
（以下は、 newLISP v 2.8.16 以上、または、guisever 1.42以上での話です。）
前回で、簡単な編集までできるようになりました。
でも、実のところ、CSV を編集するなら、Excel か OpenOffice を使ったほうが便利です(笑)。
それでも、このスクリプト改造を続けているのは、gs:table の限界を見たいというのもありますが、狙いがあります。
と、言うことで、今回は、View メニューです。
(gs:menu 'viewMenu "View")
(gs:menu-item 'viewAdjust 'adjust-action "adjust current table")
(gs:menu-item 'viewHTML 'html-action "to html-table")
(gs:add-to 'viewMenu 'viewAdjust 'viewHTML)
(gs:menu-bar 'Frame 'fileMenu 'editMenu 'viewMenu)
メニューの viewAdjust は、列の幅調整です。
そして、viewHTML が今回の目玉。狙いの一つです。
; define the function for HTML
(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)
(if *Numerics* (setq row (map string-convert row)))
(extend html (tableROW 0))
(dolist (col row)
(extend html (addHTMLtag col (if (string? col) tableHEADER tableDATA))))
(extend html (tableROW 1) "\n"))
(extend html *footer*)))
; define handler
(define (html-action)
(gs:dialog 'HtmlDisplay 'Frame "HTML" FWidth FHeight nil true)
(gs:set-border-layout 'HtmlDisplay)
(gs:text-pane 'OutputArea 'gs:no-action "text/html")
(gs:table-get *currentCSV*)
(gs:set-text 'OutputArea (makeHTMLtable gs:table-full))
(gs:add-to 'HtmlDisplay 'OutputArea "center")
(gs:set-visible 'HtmlDisplay true))
さて、これらを CSV-Editor スクリプトに追加すれば、以前やったようなテーブル表示ができます。
今回は、表示だけです。ファイルに落とすのは、リストのテキストやファイルに変換するのにあわせ、別の機会に。
これも狙いの一つです。
つまり、まだまだ、改造が続く？(笑)
以上、如何でしょうか？
newLISP で GUI する。。。または、CSV Editor の作成（改造編３）
（以下は、 newLISP v 2.8.16 以上、または、guisever 1.42以上での話です。）
今回は、もちろん、Edit メニューの設定です（笑）。
(gs:menu 'editMenu "Edit")
(gs:menu-item 'editCut 'edit-action "Cell Cut")
(gs:menu-item 'editCopy 'edit-action "Cell Copy")
(gs:menu-item 'editPaste 'edit-action "Cell Paste")
(gs:menu-item 'editCutRow 'cut-action "Row Cut")
(gs:menu-item 'editCopyRow 'copy-action "Row Copy")
(gs:menu-item 'editPasteRow 'paste-action "Row Paste")
(gs:menu-item 'editCutCol 'cut-action "Column Cut")
(gs:menu-item 'editCopyCol 'copy-action "Column Copy")
(gs:menu-item 'editPasteCol 'paste-action "Column Paste")
(gs:disable 'editPaste 'editPasteRow 'editPasteCol)
;(gs:set-accelerator 'editCut "ctrl X")
;(gs:set-accelerator 'editCopy "ctrl C")
;(gs:set-accelerator 'editPaste "ctrl V")
(gs:add-to 'editMenu 'editCut 'editCopy 'editPaste)
(gs:add-separator 'editMenu)
(gs:add-to 'editMenu 'editCutRow 'editCopyRow 'editPasteRow)
(gs:add-separator 'editMenu)
(gs:add-to 'editMenu 'editCutCol 'editCopyCol 'editPasteCol)
(gs:menu-bar 'Frame 'fileMenu 'editMenu)
シンボルに Row の付いているのが行用、Col の付いているのが列用、残りがセル単品用です。
実のところ、セル単品用は要らないのかもしれません。Windows の場合、ダブル・クリックでセルに入れば、通常のシュート・カット・キー（ctrl X、ctrl C、ctrl V）が使えます。ただし、ワン・クリックで選択した場合は使えないので、えそのために用意しました。
では、Edit 動作のスクリプトです。
先ずは、グローバル変数と補助 macro。
(define *rowBuffer*)
(define *colBuffer*)
(define *cellBuffer*)
(macro (cut-row L P) (pop L P))
設営は要らないですね。
そして、セル単品用です。
(define (edit-action id)
(setf (get-flag) nil)
(gs:table-get *currentCSV*)
(when (and (not (apply empty? gs:table-full)) (> *currentRow* -1) (> *currentCol* -1))
(cond ((ends-with id "Cut")
(gs:enable 'editPaste)
(setq *cellBuffer* "")
(swap (gs:table-full *currentRow* *currentCol*) *cellBuffer*)
(set-table gs:table-full *currentCSV*))
((ends-with id "Copy")
(gs:enable 'editPaste)
(setq *cellBuffer* (gs:table-full *currentRow* *currentCol*)))
((ends-with id "Paste")
(setf (gs:table-full *currentRow* *currentCol*) *cellBuffer*)
(set-table gs:table-full *currentCSV*))
(true ))
(set-table gs:table-full *currentCSV*)))
これも、説明するまでもないかもしれません。特徴としては、動作をまとめたので、gs:table-get-cell を使わずに gs:table-get を使っていることくらい？
次は、行と列用のペースト動作、
(define (paste-action id)
(setf (get-flag) nil)
(gs:table-get *currentCSV*)
(clear-table *currentCSV*)
(cond ((and (ends-with id "Row") (> *currentRow* -1))
(setf (gs:table-full *currentRow*) *rowBuffer*)
(set-table gs:table-full *currentCSV*))
((and (ends-with id "Col") (> *currentCol* -1))
(gs:table-get-size *currentCSV*)
(letn (len (- (length *colBuffer*) (gs:table-size 0))
tmp (if (< len 1) gs:table-full
(append gs:table-full (dup (apply append (dup '("") (gs:table-size 1))) len))))
(setq tmp (transpose tmp))
(setf (tmp *currentCol*) (if (< len 1)
(append *colBuffer* (apply append (dup '("") (- len))))
*colBuffer*))
(set-table (transpose tmp) *currentCSV*)))
(true )))
列用のペーストでは、現在のテーブルの列よりバッファの長さが大きい場合、テーブル・サイズを大きくしています。
行用でやっていないのは、関数set-table で行っているから。
(defun set-table (lst table)
;(let (len (length (lst 0)))
(let (len (apply max (map length lst)))
(gs:table-get-size table)
(when (< (gs:table-size 1) len)
(for (i (i+ (gs:table-size 1)) len) (gs:table-add-column table "")))
(dolist (row lst)
(let (r $idx)
(if (< r (gs:table-size 0))
(dolist (c row) (gs:table-set-cell table r $idx (string c)))
(gs:table-add-row table (map string row))))))
(unless (for-all (curry = "") (flat lst)) (adjust-column table)))
先頭行の長さで決めていた列の大きさを一番長い行の大きさで決めるようにしました。
残りのカットとコピーは、
(define (cut-action id)
(setf (get-flag) nil)
(gs:table-get *currentCSV*)
(clear-table *currentCSV*)
(unless (apply empty? gs:table-full)
(cond ((and (ends-with id "Row") (> *currentRow* -1))
(setq *rowBuffer* (cut-row gs:table-full *currentRow*))
(gs:enable 'editPasteRow)
(set-table gs:table-full *currentCSV*))
((and (ends-with id "Col") (> *currentCol* -1))
(let (tmp (transpose gs:table-full))
(setq *colBuffer* (cut-row tmp *currentCol*))
(gs:enable 'editPasteCol)
(set-table (transpose tmp) *currentCSV*)))
(true ))))
(define (copy-action id)
(setf (get-flag) nil)
(gs:table-get *currentCSV*)
(unless (apply empty? gs:table-full)
(cond ((and (ends-with id "Row") (> *currentRow* -1))
(gs:enable 'editPasteRow)
(setq *rowBuffer* (gs:table-full *currentRow*)))
((and (ends-with id "Col") (> *currentCol* -1))
(gs:enable 'editPasteCol)
(setq *colBuffer* ((transpose gs:table-full) *currentCol*)))
(true ))))
これらを追加したスクリプトは、こちらからどうぞ。
これで、ほぼ完成？
以上、如何でしょうか？
newLISP で GUI する。。。または、CSV Editor の作成（改造編２）
（以下は、 newLISP v 2.8.16 以上、または、guisever 1.42以上での話です。）
今回は、遅まきながら、メニューの設定です（汗）。
(gs:menu 'fileMenu "File")
(gs:menu-item 'fileNew 'new-action "New table")
(gs:menu-item 'fileClose 'close-action "Close table")
(gs:menu-item 'fileOpen 'open-file-dialog "Open ...")
(gs:menu-item 'fileSave 'save-action "Save")
(gs:menu-item 'fileSaveAs 'save-file-dialog "Save As ...")
(gs:menu-item 'fileExit 'closed-window "Exit")
(gs:add-to 'fileMenu 'fileNew 'fileClose )
(gs:add-separator 'fileMenu)
(gs:add-to 'fileMenu 'fileOpen 'fileSave 'fileSaveAs)
(gs:add-separator 'fileMenu)
(gs:add-to 'fileMenu 'fileExit)
(gs:set-accelerator 'fileNew "shift ctrl N")
(gs:set-accelerator 'fileClose "ctrl W")
(gs:set-accelerator 'fileOpen "ctrl O")
(gs:set-accelerator 'fileSave "ctrl S")
(gs:set-accelerator 'fileSaveAs "shift ctrl S")
(gs:menu-bar 'Frame 'fileMenu)
メニューの設定は、単純に力技です（笑）。
動作自体は、gs:button や gs:image-button に割り付けてあるイベント・ハンドラをそのまま使います。
これらを スクリプトに追加して、実行すれば、
こんな感じ。ショート・カットも使えます。
File メニュー、とくれば、Edit メニュー？ それには、カット＆ペーストを用意しなければ、、、
ということで、Edit メニューの追加は、次回に。
以上、如何でしょうか？
newLISP で GUI する。。。または、CSV Editor の作成（改造編）
（以下は、 newLISP v 2.8.16 以上、または、guisever 1.42以上での話です。）
早くも、改造に取りかかります（笑）。
先ず、*tabList* からカレント・タブの要素を取り出す macro を用意しておきます。
(macro (get-tableID) (lookup *currentCSV* *tabList* 0))
(macro (get-filename) (lookup *currentCSV* *tabList* 1))
(macro (get-row/col) (lookup *currentCSV* *tabList* -2))
(macro (get-flag) (lookup *currentCSV* *tabList* -1))
(macro (get-index) ((ref *currentCSV* *tabList*) 0))
こうしておけば、後で *tabList* の要素リストを変更しても最少限の変更で済みますからね。
さて、今回は、テーブル表示の再表示ボタンを追加します。
テーブルの行と列の削除でデータを削除できますが、テーブル自体の大きさは変わりません。
つまり、最終行または最終列に空白の行または列が残ります。それらを削除し、ついでに、列の幅調整も行ないます。
(gs:image-button 'adjustButton 'adjust-action "/local/restart32.png" "/local/restart-down32.png")
(define (adjust-action)
(unless (get-flag)
(gs:table-get *currentCSV*)
(letn (idx (get-index)
fname (get-filename)
table (make-table fname))
(pop *tabList* -1)
(setf (get-tableID) table)
(gs:insert-tab 'CSVtab table fname idx)
(set-table (delete-end-null-all gs:table-full) table)
(gs:remove-tab 'CSVtab (i+ idx))
(gs:request-focus 'CSVtab idx)
)
)
)
やっていることは単純で、カレント・タブからデータを取り出し、新しく用意したテーブルにセットし、新しいタブをカレント・タブ位置に挿入してから、古い表示のカレント・タブを削除する、というもの。
用意しておいた前述の macro のおかげで、簡単に書けます。
全スクリプトは、こちらからどうぞ。
以上、如何でしょうか？
newLISP で GUI する。。。または、CSV Editor の作成（解説編）
（以下は、 newLISP v 2.8.16 以上、または、guisever 1.42以上での話です。）
さて、前回紹介した CSV Editor のスクリプトは、如何だったでしょうか？
今のところ、動作は、
- CSV（Comma-Separated Values）ファイルの読み書き
- カレント・テーブルの破棄（閉じる）
- テーブルのセルの編集
- 行と列の挿入と削除
- カレント・テーブルのクリア
だけです。
gs:tabbed-pane に ga:table を割り付けてあるのが、CSV Viewer との大きな違い（笑）。
さて、テーブルを区別するために、タブ毎のプロパティを *tabList* に入れてあります。
*tabList* の要素は、もちろん、リストで、
(table filename (row column) flag)
内訳は、
table : テーブルID filename : ファイル名（フルパス） row : 0 から始まる行番号 column : 0 から始まる列番号 flag : true なら変更なし、nil なら変更したかも。
としています。テーブル番号を含めていないのは、リストの位置をテーブル番号として使っているからです。
テーブルが切り替わると、
(define (tab-changed id tabID title tabPos)
;(println "id=" id " tabID=" tabID " title=" (base64-dec title) " tabPos" tabPos)
(let (fname (base64-dec title))
(if *currentCSV* (setf (lookup *currentCSV* *tabList* -2) (list *currentRow* *currentCol*)))
(aif (ref fname *tabList*) (setq *currentCSV* (*tabList* (it 0) 0)))
(setq *currentRow* ((lookup *currentCSV* *tabList* -2) 0)
*currentCol* ((lookup *currentCSV* *tabList* -2) 1))
(gs:set-text 'Status fname)
(setq *tabName* fname)))
関数tab-changed が動作して、*tabList* に今までのテーブルの状況（選択されている行と列の番号）を保存し、切り替わったテーブル用にグローバル変数 *currentXXX* を再設定しています。
引数の tabID を使っていないのは、guiserver 1.42 では、gs:table を割り付けたタブからは、"null" が返るからです。guiserver 1.43 から テーブルID が返るようになります。
また、前回紹介したスクリプトは、flag を使っていなかったので、使ったバージョンを CSV-Editor.lsp にアップしてあります。
ついでに、1.43用に直してもよかったのですが、多分これから改良していくことになるので、その際に（笑）。
リストから CSV文字列への変換や、行と列の挿入と削除は、もうやったし、、、解説としては、こんなところ？
以上、如何でしょうか？
newLISP で CSV を扱う。
newLISP で CSV（Comma-Separated Values）を扱うなら、ArtfulCode に Module:CSV があります。ArtfulCode の名にふさわしい洗練されたコードです。
と、言いつつ、今回は、自作します。何故か？それは後ほど。
まずは、スクリプトから、
（defun は newlisp-utility.lsp に定義してあります。）
(define CRLF "\r\n")
(define regexCRLF "\r*\n")
(defun stringEx (x)
(if (string? x) (string "\"" x "\"") (string x)))
(defun list2csv (lst)
(let (csv "")
(dolist (row lst)
(extend csv (join (map stringEx row) ",") CRLF))))
(defun string-convert (str)
(if (catch (eval-string str) 'res) (if res res str) str))
(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))))
関数名からわかるように、CSV文字列とリストを相互に変換しますが、これだけです（笑）。
だから、自作。いえいえ。それは動作させてみれば判ります。
次のデータは、 Introduction to newLISP に載っていた太陽系惑星のデータを使わせてもらっています。
(setq sol-sys '(("Planet name" "Equator diameter (earth)" "Mass (earth)"
"Orbital radius (AU)" "Orbital period (years)"
"Orbital Incline Angle" "Orbital Eccentricity"
"Rotation (days)" "Moons")
("Mercury" 0.382 0.06 0.387 0.241 7.00 0.206 58.6 0)
("Venus" 0.949 0.82 0.72 0.615 3.39 0.0068 -243 0)
("Earth" 1.00 1.00 1.00 1.00 0.00 0.0167 1.00 1)
("Mars" 0.53 0.11 1.52 1.88 1.85 0.0934 1.03 2)
("Jupiter" 11.2 318 5.20 11.86 1.31 0.0484 0.414 63)
("Saturn" 9.41 95 9.54 29.46 2.48 0.0542 0.426 49)
("Uranus" 3.98 14.6 19.22 84.01 0.77 0.0472 -0.718 27)
("Neptune" 3.81 17.2 30.06 164.8 1.77 0.0086 0.671 13)
("Pluto" 0.18 0.002 39.5 248.5 17.1 0.249 -6.5 3)))
では動作を、
> (setq csv (list2csv sol-sys))
"\"Planet name\",\"Equator diameter (earth)\",\"Mass (earth)\",\"Orbital radius (AU)\",\"Orbital period (years)\",\"Orbital Incline Angle\",\"Orbital Eccentricity\",\"Rotation (days)\",\"Moons\"\r\n\"Mercury\",0.382,0.06,0.387,0.241,7,0.206,58.6,0\r\n\"Venus\",0.949,0.82,0.72,0.615,3.39,0.0068,-243,0\r\n\"Earth\",1,1,1,1,0,0.0167,1,1\r\n\"Mars\",0.53,0.11,1.52,1.88,1.85,0.0934,1.03,2\r\n\"Jupiter\",11.2,318,5.2,11.86,1.31,0.0484,0.414,63\r\n\"Saturn\",9.41,95,9.54,29.46,2.48,0.0542,0.426,49\r\n\"Uranus\",3.98,14.6,19.22,84.01,0.77,0.0472,-0.718,27\r\n\"Neptune\",3.81,17.2,30.06,164.8,1.77,0.0086,0.671,13\r\n\"Pluto\",0.18,0.002,39.5,248.5,17.1,0.249,-6.5,3\r\n"
> (begin (print csv) nil)
"Planet name","Equator diameter (earth)","Mass (earth)","Orbital radius (AU)","Orbital period (years)","Orbital Incline Angle","Orbital Eccentricity","Rotation (days)","Moons"
"Mercury",0.382,0.06,0.387,0.241,7,0.206,58.6,0
"Venus",0.949,0.82,0.72,0.615,3.39,0.0068,-243,0
"Earth",1,1,1,1,0,0.0167,1,1
"Mars",0.53,0.11,1.52,1.88,1.85,0.0934,1.03,2
"Jupiter",11.2,318,5.2,11.86,1.31,0.0484,0.414,63
"Saturn",9.41,95,9.54,29.46,2.48,0.0542,0.426,49
"Uranus",3.98,14.6,19.22,84.01,0.77,0.0472,-0.718,27
"Neptune",3.81,17.2,30.06,164.8,1.77,0.0086,0.671,13
"Pluto",0.18,0.002,39.5,248.5,17.1,0.249,-6.5,3
nil
> (csv2list csv)
(("Planet name" "Equator diameter (earth)" "Mass (earth)" "Orbital radius (AU)" "Orbital period (years)"
"Orbital Incline Angle" "Orbital Eccentricity" "Rotation (days)" "Moons")
("Mercury" 0.382 0.06 0.387 0.241 7 0.206 58.6 0)
("Venus" 0.949 0.82 0.72 0.615 3.39 0.0068 -243 0)
("Earth" 1 1 1 1 0 0.0167 1 1)
("Mars" 0.53 0.11 1.52 1.88 1.85 0.0934 1.03 2)
("Jupiter" 11.2 318 5.2 11.86 1.31 0.0484 0.414 63)
("Saturn" 9.41 95 9.54 29.46 2.48 0.0542 0.426 49)
("Uranus" 3.98 14.6 19.22 84.01 0.77 0.0472 -0.718 27)
("Neptune" 3.81 17.2 30.06 164.8 1.77 0.0086 0.671 13)
("Pluto" 0.18 0.002 39.5 248.5 17.1 0.249 -6.5 3))
>
CSV文字列からリストへの変換で、文字列は文字列、数値は数値へと変換されているのに、お気付きでしょうか？これが自作したポイントです。
これなら、EXCEL で作った表を CSVで保存すれば、newLISP で簡単に扱え、逆も可能です。
以上、如何でしょうか？
新リスプな日々 