* Menu
[[About:self:AboutPage.txt]] | [[Profile:file/southly/]] | [[まとめ:self:1163859357.txt]] | [[オリジナル:http://ninjinix.x0.com/rn/]] | [[xyzzy:lisp/]] | [[あんてな:listall]] | [[■:lisp]] | [[buzz:files/southly#buzz]]
- 2010-01-20
- 2008-11-17 :
- memo : apacheの設定メモ
- Common Lisp : 文字列中のエスケープシーケンスを解釈する
- memo : asdf を使う
- memo : clispをさくらインターネットにインストール
- xyzzy lisp : ミニバッファの入力にエスケープシーケンス
- 2007-02-28
- editorパッケージのbuiltin関数
- Scrapbook : Sylpheed - lightweight and user-friendly e-mail client
- Scrapbook : Common Lisp's Loop Macro Examples for Beginners
- clispインストールのまとめ
- xyzzy : WSHでxyzzy起動
- xyzzy lisp : clone-buffer
- xyzzy : モバイルxyzzyの件
* 2010-01-20
- Scheme コードバトン (CL fork)
- やったことは以下の通り。
- untabify
- format指示子を大文字に揃える
- インデントを調整
- 辞書が存在しない時の動作を修正
- package-nameがprintされないようにして、オリジナルの辞書と似た感じの出力を目指した
- asdfのパッケージ化
- lispの関数は10行越えると、理解が大変になってくる。修行が足りないなぁ
- xyzzy lispでforkしようかと思っていたけれど、ABCLの動作と似た感じになるだろうから、微妙。
diff --git a/package.lisp b/package.lisp new file mode 100644 index 0000000..3667c7a --- /dev/null +++ b/package.lisp @@ -0,0 +1,13 @@ +;; -*- Mode: Lisp; Syntax: Common-Lisp -*- + +;;; Package Management +(in-package :cl-user) + +(defpackage :hige + (:use :cl) + #+ABCL (:shadow :y-or-n-p) + (:export #:pin + #:pon + #:pun + #:pan + #:pen)) diff --git a/scheme_baton.asd b/scheme_baton.asd new file mode 100644 index 0000000..b2d9ce6 --- /dev/null +++ b/scheme_baton.asd @@ -0,0 +1,4 @@ +(defsystem :scheme_baton + :serial t + :components ((:file "package") (:file "scheme_baton")) + ) diff --git a/scheme_baton.lisp b/scheme_baton.lisp index 27713dc..fc50ad7 100644 --- a/scheme_baton.lisp +++ b/scheme_baton.lisp @@ -53,6 +53,7 @@ ;; 8. masatoi (http://d.hatena.ne.jp/masatoi/): n択問題(hige:pen)を実装.英単語から意味を問うのと意味から英単語を問うのと選べる.named-let使いまくり. ;; 9. cranebird (http://d.hatena.ne.jp/cranebird/): CL と言えばマルチパラダイムなので CLOS を。with-系のマクロを追加。 ;; 10. smeghead (http://d.hatena.ne.jp/smeghead/): 単語のスコアを導入した。問題の単語表示時にスコアを表示するようにした。単語の一覧表示(hige:pun)にキーワード引数 score-thresholdを追加。 +;; 11. NANRI (http://raido.sakura.ne.jp/southly/rn/): デバッグとちょっとした整理。あと (asdf:oos 'asdf:load-op :scheme_baton) でロードできるようにした。 ;; ;; ================================================================================================================================================= ;; これより下がコードとその説明 - 変更・削除歓迎 @@ -79,18 +80,6 @@ ;; ■辞書ファイルの例 ;; http://gist.github.com/273424 -;;; Package Management -(in-package :cl-user) - -(defpackage :hige - (:use :cl) - #+ABCL (:shadow :y-or-n-p) - (:export #:pin - #:pon - #:pun - #:pan - #:pen)) - (in-package :hige) ;;quek-san's http://read-eval-print.blogspot.com/2009/04/abcl-java.html without cl-ppcre @@ -177,25 +166,25 @@ (format *debug-io* "done~%")) *dict*)) -(defmacro with-entries ((entry) &rest body) +(defmacro do-entries ((entry) &rest body) `(dolist (,entry (entries-of *dict*)) ,@body)) ;;; Top-Level Functions (defun pin () "Register new entries to the dictionary." - (unless *dict-file* - (ensure-directories-exist *dict-file*)) (with-dict () - (loop (add-entry (prompt-for-entry)) - (if (not (y-or-n-p "Another words to register? [yn]: ")) (return))))) + (loop + (add-entry (prompt-for-entry)) + (unless (y-or-n-p "Another words to register? [yn]: ") + (return))))) (defun pon () "Start self-study english vocabulary quiz." (with-dict () - (with-entries (e) + (do-entries (e) (p "~&~A (score: ~D): " (read-aloud (entry-word e)) (entry-score e)) - (ready?) + #-ABCL (ready?) #-ABCL (p "~&~A [Ynq]: " (entry-meaning e)) :again (case (query #+ABCL (entry-meaning e)) @@ -209,12 +198,12 @@ (defun pan () "Search the word user has input from the dictionary" (with-dict (:read-only t) - (let ((word (intern (prompt-read "Word to search") :hige))) + (let ((word (intern (prompt-read "Word to search") #.*package*))) (format t "~A" (or (search-dict word) "Not found."))))) (defun pun (&key score-threshold) - (if (and score-threshold - (not (numberp score-threshold))) + (when (and score-threshold + (not (numberp score-threshold))) (error "pun: score-threshold must be number.")) (setup-dict) (dump-dict :score-threshold score-threshold)) @@ -226,7 +215,7 @@ (with-dict () (when (> n-choice (length (entries-of *dict*))) ; 辞書の長さチェック (error "Dictionary size is too small .~%")) - (with-entries (e) + (do-entries (e) (p "~&~A (score: ~D): " (if meaning? (entry-meaning e) (read-aloud (entry-word e))) (entry-score e)) @@ -239,13 +228,15 @@ :do (p "~A.~A " i (if meaning? (entry-word item) (entry-meaning item)))) (p " [1-~Aq]: " n-choice) (nlet itr ((query (read *query-io* nil nil))) - (cond ((and (numberp query) (> query 0) (> (1+ n-choice) query)) + (cond ((and (numberp query) (< 0 query (1+ n-choice))) (if (= query correct-answer) (incf (entry-ok-count e)) (incf (entry-ng-count e)))) - ((and (symbolp query) (string= (symbol-name query) "Q")) (return)) - (t (p "~&Please type number of the choice or Q for quit.~%[1-3q]: ") - (itr (read *query-io* nil nil))))))))) + ((and (symbolp query) (string= (symbol-name query) "Q")) + (return)) + (t + (p "~&Please type number of the choice or Q for quit.~%[1-3q]: ") + (itr (read *query-io* nil nil))))))))) ;;; Auxiliary Functions (defun setup-dict (&key (fn #'sort-dict-standard) (file *dict-file*)) @@ -261,36 +252,51 @@ (mapcar #'(lambda (e) (make-entry :word (entry-word e) :meaning (entry-meaning e) - :ok-count (or (entry-ok-count e) 0) - :ng-count (or (entry-ng-count e) 0))) + :ok-count (or (ignore-errors (entry-ok-count e)) 0) + :ng-count (or (ignore-errors (entry-ng-count e)) 0))) entries)) +(defmacro with-dictionary-io-syntax (&body body) + `(with-standard-io-syntax + (let ((*readtable* (copy-readtable nil)) + (*package* #.*package*) ; 単語Symbolのホームは:higeパッケージです。 + (*read-eval* nil)) + (setf (readtable-case *readtable*) :preserve) ; 単語Symbolは大文字小文字を区別して扱います。 + ,@body))) + (defun read-dict (file) "Read dictionary data from a file." - (let ((*readtable* (copy-readtable nil)) - (*package* #.*package*)) ; 単語Symbolのホームは:higeパッケージです。 - (setf (readtable-case *readtable*) :preserve) ; 単語Symbolは大文字小文字を区別して扱います。 - (with-open-file (in file) - (normalize-dict - (loop :for word := (read in nil in) :until (eq word in) - :collect word))))) + (unless (probe-file file) + (return-from read-dict NIL)) + (with-open-file (in file) + (with-dictionary-io-syntax + (normalize-dict + (loop :for word := (read in nil in) :until (eq word in) + :collect word))))) (defun save-dict (&key (file *dict-file*)) "Save the dictionary data into a file." - (with-open-file (out file :direction :output :if-exists :supersede) - (with-standard-io-syntax - (dolist (word (entries-of *dict*)) (print word out))))) + (unless (probe-file file) + (ensure-directories-exist file)) + (with-open-file (out file + :direction :output + :if-exists :supersede + :if-does-not-exist :create) + (with-dictionary-io-syntax + (let ((*package* #.*package*)) + (dolist (word (entries-of *dict*)) (print word out)))))) (defun dump-dict (&key score-threshold) "Print the dictionary in CSV format." (let ((output (format nil "~{~{~A~^,~}~%~}" (if (null score-threshold) - (entries-of *dict*) ;score-thresholdが指定されない場合は全件 - (remove nil ;score-thresholdが指定された場合は絞り込む - (mapcar (lambda (e) - (if (<= (entry-score e) score-threshold) - e)) - (entries-of *dict*))))))) + (entries-of *dict*) ; score-thresholdが指定されない場合は全件 + (delete NIL ; score-thresholdが指定された場合は絞り込む + (mapcar (lambda (e) + (if (<= (entry-score e) score-threshold) + e + NIL)) + (entries-of *dict*))))))) #-ABCL (format t "~A" output) #+ABCL (|showMessageDialog| |javax.swing.JOptionPane| nil output))) @@ -324,7 +330,6 @@ (1 #\N) (2 #\Q))) - (defun prompt-read (prompt) #-ABCL (progn (p "~A: " prompt)
* 2008-11-17 :
- CLOCC の f2cl パッケージに BLAS と LAPACK があるのを見つけたので、試してみた。
- 結果: 動かなかった。
- sbcl の場合、FORTRANのソース内で変数名がTのところの、変数の型が違うとエラーが出る。
- でも、FORTRANのソースからトランスレートされたlispのソース内では「t$」になっていて、変数がTの所は見当たらず。(dlamach.f, dlamach.lisp)
- clisp の場合、ちょっと手を入れてロードまで成功。
- テストを動かしてみると何故か zero division error。
- よく分からないので放置。
* memo : apacheの設定メモ
userdirを使えるようにするために毎回調べているのでメモ。
cgiやら.httacessやらを許可するためにuserdir.confの方を書き換える。
面倒なので両方Allで。
参考: cgi/server-config.html
cd /etc/apache2/mods-enabled/ ln -s ../mods-available/userdir.conf . ln -s ../mods-available/userdir.load .
cgiやら.httacessやらを許可するためにuserdir.confの方を書き換える。
面倒なので両方Allで。
<IfModule mod_userdir.c> UserDir public_html UserDir disabled root <Directory /home/*/public_html> AllowOverride All Options All </Directory> </IfModule>
参考: cgi/server-config.html
* Common Lisp : 文字列中のエスケープシーケンスを解釈する
とりあえずできた。REPL では動作確認できた。
要 cl-interpol。
SANO さんの情報がなかったらどうにか interpol-reader を使えないか、悩んでいたかも。サンクスです。
[[(ReadMore...) index.rb?1204642645.txt]]
要 cl-interpol。
SANO さんの情報がなかったらどうにか interpol-reader を使えないか、悩んでいたかも。サンクスです。
[[(ReadMore...) index.rb?1204642645.txt]]
* memo : asdf を使う
さくらのサーバにインストールした clisp で asdf を使うための一連の作業をメモ。
clisp には asdf が付属していないのでソースを取得する。
ついでにコンパイルしておく。
ここからしばらく clisp での作業。
$HOME/local/lisp/ を lisp ファイル置き場にすることにしたので、ここをロードパスに追加する。
asdf.lisp をロード。
asdf:*central-registry* にパスを追加。$HOME/local/lisp/systems/ にした。
ここに *.asd ファイルへのシンボリックリンクを置くようにする。
この状態で[[GUESS:http://lispuser.net/commonlisp/japanese.html#guess]]を使えるようにする。
ソースをダウンロードして、展開、シンボリックリンクを張る。
clisp でロード。初回はコンパイルした上でロードしてくれる。
clisp での作業は初期化ファイルにでも書いておく。clispの場合は $HOME/.clisprc 辺り。
clisp には asdf が付属していないのでソースを取得する。
$ cd $HOME/local/lisp $ wget "http://cclan.cvs.sourceforge.net/*checkout*/cclan/asdf/asdf.lisp" $ clisp -c asdf.lisp
ついでにコンパイルしておく。
ここからしばらく clisp での作業。
$HOME/local/lisp/ を lisp ファイル置き場にすることにしたので、ここをロードパスに追加する。
[1]> (push (merge-pathnames "local/lisp/" (user-homedir-pathname)) custom:*load-paths*) (#P"/home/raido/local/lisp/" #P"./" "~/lisp/**/")
asdf.lisp をロード。
[2]> (load '#:asdf) ;; Loading file /home/raido/local/lisp/asdf.fas ... ;; Loaded file /home/raido/local/lisp/asdf.fas T
asdf:*central-registry* にパスを追加。$HOME/local/lisp/systems/ にした。
ここに *.asd ファイルへのシンボリックリンクを置くようにする。
[3]> (push (merge-pathnames "local/lisp/systems/" (user-homedir-pathname)) asdf:*central-registry*) (#P"/home/raido/local/lisp/systems/" *DEFAULT-PATHNAME-DEFAULTS*)
この状態で[[GUESS:http://lispuser.net/commonlisp/japanese.html#guess]]を使えるようにする。
ソースをダウンロードして、展開、シンボリックリンクを張る。
$ cd $HOME/local/src/lisp $ wget http://lispuser.net/files/guess.tar.gz $ tar xf guess.tar.gz $ cd ../../lisp/systems/ $ ln -s $HOME/local/src/lisp/guess_0.1.0/guess.asd .
clisp でロード。初回はコンパイルした上でロードしてくれる。
[4]> (asdf:oos 'asdf:load-op :guess) ; loading system definition from /home/raido/local/lisp/systems/guess.asd into #<PACKAGE ASDF0> ;; Loading file /home/raido/local/lisp/systems/guess.asd ... ; registering #<SYSTEM :GUESS #x20538B31> as GUESS ;; Loaded file /home/raido/local/lisp/systems/guess.asd ;; Compiling file /home/raido/local/src/lisp/guess_0.1.0/guess.lisp ... ;; Wrote file /home/raido/local/src/lisp/guess_0.1.0/guess.fas ;; Loading file /home/raido/local/src/lisp/guess_0.1.0/guess.fas ... ;; Loaded file /home/raido/local/src/lisp/guess_0.1.0/guess.fas 0 errors, 0 warnings NIL以上。
clisp での作業は初期化ファイルにでも書いておく。clispの場合は $HOME/.clisprc 辺り。
(push (merge-pathnames "local/lisp/" (user-homedir-pathname)) custom:*load-paths*) (load '#:asdf) (push (merge-pathnames "local/lisp/systems/" (user-homedir-pathname)) asdf:*central-registry*) (asdf:oos 'asdf:load-op :guess)ロードするものが多くなって起動に時間がかかるようになったら、メモリイメージを保存して起動時にこっちを読み込むようにする。
* memo : clispをさくらインターネットにインストール
clispはサーバーのOSバージョンが上がっても動いていたけど、clispの方もバージョンが上がっているので入れなおしてみた。
いまいちうまくいっていないのでもう一回入れなおそう。
必要なライブラリであるlibsigsegvがきっちり認識されない。
libsigsegvはコンパイルはできるがチェックでエラーが出る状態。
ということで --ignore-absence-of-libsigsegv を追加して作成。
本当は --with-module=bindings/glibc も指定する予定だったけれどうまくいかず、結局以下のような感じでインストール。
できあがった物。
いまいちうまくいっていないのでもう一回入れなおそう。
必要なライブラリであるlibsigsegvがきっちり認識されない。
libsigsegvはコンパイルはできるがチェックでエラーが出る状態。
$make check Making check in src Making check in tests make check-TESTS Test passed. PASS: sigsegv1 Test passed. PASS: sigsegv2 FAIL: stackoverflow1 FAIL: stackoverflow2 =================== 2 of 4 tests failed =================== *** Error code 1 Stop in /home/raido/local/src/libsigsegv-2.5/tests. *** Error code 1 Stop in /home/raido/local/src/libsigsegv-2.5/tests. *** Error code 1 Stop in /home/raido/local/src/libsigsegv-2.5.
ということで --ignore-absence-of-libsigsegv を追加して作成。
本当は --with-module=bindings/glibc も指定する予定だったけれどうまくいかず、結局以下のような感じでインストール。
cd local/src/ wget http://ring.sakura.ad.jp/archives/GNU/clisp/release/2.43/clisp-2.43.tar.bz2 tar xf clisp-2.43.tar.bz2 cd clisp-2.43 ./configure --ignore-absence-of-libsigsegv --prefix=$HOME/local --with-module=rawsock --with-module=wildcard cd src/ make make check make install
できあがった物。
$ clisp --version GNU CLISP 2.43 (2007-11-18) (built 3410886803) (memory 3410887057) Software: GNU C 3.4.4 [FreeBSD] 20050518 gcc -g -O2 -Igllib -W -Wswitch -Wcomment -Wpointer-arith -Wimplicit -Wreturn-type -Wmissing-declarations -Wno-sign-compare -O2 -fexpensive-optimizations -falign-functions=4 -DUNICODE -DDYNAMIC_FFI -DNO_GETTEXT -DNO_SIGSEGV -I. -x none libavcall.a libcallback.a -lreadline -lncurses SAFETY=0 HEAPCODES STANDARD_HEAPCODES SPVW_BLOCKS SPVW_MIXED TRIVIALMAP_MEMORY libreadline 5.0 Features: (READLINE REGEXP SYSCALLS I18N LOOP COMPILER CLOS MOP CLISP ANSI-CL COMMON-LISP LISP=CL INTERPRETER SOCKETS GENERIC-STREAMS LOGICAL-PATHNAMES SCREEN FFI UNICODE BASE-CHAR=CHARACTER PC386 UNIX) C Modules: (clisp i18n syscalls regexp readline) Installation directory: /home/raido/local/lib/clisp-2.43/ User language: ENGLISH Machine: I386 (I386) www658.sakura.ne.jp [59.106.19.88]
* xyzzy lisp : ミニバッファの入力にエスケープシーケンス
interactive指定子を作っちゃえば楽に置き換えられるんじゃね?
ってことで、こんな。
ってことで、こんな。
(in-package "editor") (defun interactive-read-string-with-escape-sequence (prompt default history title) (list (decode-escape-sequence (read-string prompt :default default :history history) nil))) (pushnew '(#\w . interactive-read-string-with-escape-sequence) *interactive-specifier-alist* :test #'equal) (defun interactive-read-regexp-with-escape-sequence (prompt default history title) (list (decode-escape-sequence (read-string prompt :default default :history history) t))) (pushnew '(#\W . interactive-read-regexp-with-escape-sequence) *interactive-specifier-alist* :test #'equal) ;; こんな感じで使う ;; 文字列 (defun search-forward-wes (pattern &optional noerror) (interactive "wSearch forward: " :default0 *last-search-string* :history0 'search) (search-command pattern nil nil (interactive-p) noerror)) ;; 正規表現 (defun re-search-forward-wes (regexp &optional noerror) (interactive "WRe-search forward: " :default0 *last-search-regexp* :history0 'search) (search-command regexp nil t (interactive-p) noerror)) (export '(search-forward-wes re-search-forward-wes)) (in-package "user")
* 2007-02-28
- Repositoryの構成については相談しないといけないなと思っていました。
- 他人のパッチの取捨選択はしたいので、ユーザーごとに干渉しない方が都合がいいです。
- なので、以下のようにrootでユーザーごとのディレクトリを作る構成がいいかなと思っています。
root/ ├original/ │ └trunk/ 亀井さんのオリジナルのソース ├nanri/ │ ├trunk/ ユーザーごとのHEAD │ ├tags/ │ └branches/ └user/ ...
- あとはコミットログを記述するときのポリシーとか情報交換の場所とかがいるかなと思います。このへんはまた後でご相談。