Source of Nothingness - user

* Menu

About | Profile | まとめ | オリジナル | xyzzy | あんてな | | buzz

* 2010-01-20


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 :

(ReadMore...)

* memo : apacheの設定メモ

userdirを使えるようにするために毎回調べているのでメモ。
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>

参考: http://x68000.q-e-d.net/~68user/webcgi/server-config.html

* Common Lisp : 文字列中のエスケープシーケンスを解釈する

とりあえずできた。REPL では動作確認できた。
要 cl-interpol。
SANO さんの情報がなかったらどうにか interpol-reader を使えないか、悩んでいたかも。サンクスです。
(ReadMore...)

* memo : asdf を使う

さくらのサーバにインストールした clispasdf を使うための一連の作業をメモ。

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を使えるようにする。
ソースをダウンロードして、展開、シンボリックリンクを張る。
$ 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はコンパイルはできるがチェックでエラーが出る状態。
$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

root/
 ├original/
 │ └trunk/      亀井さんのオリジナルのソース
 ├nanri/
 │ ├trunk/      ユーザーごとのHEAD
 │ ├tags/
 │ └branches/
 └user/
  ...

* editorパッケージのbuiltin関数

以下で調べて652個
(let ((count 0))
  (do-symbols (sym (find-package "editor") (format t "~%count: ~d~%" count))
    (when (and (not (find-symbol (symbol-name sym) "lisp"))
               (fboundp sym)
               (si:*builtin-function-p (symbol-function sym)))
      (format t "~a~%" sym)
      (incf count))))
(ReadMore...)

* Scrapbook : Sylpheed - lightweight and user-friendly e-mail client

http://sylpheed.sraoss.jp/ja/

GnuPGも使えるし、迷惑メールフィルタも使えるということでメモ。
(ReadMore...)

* Scrapbook : Common Lisp's Loop Macro Examples for Beginners

http://www.unixuser.org/~euske/doc/cl/loop.html

* clispインストールのまとめ


(ReadMore...)

* xyzzy : WSHでxyzzy起動

の情報をまとめてみる。

まず起動用のスクリプト。起動時にやることは
// xyzzy.js
var shell  = WScript.CreateObject("Wscript.Shell");
var fs     = WScript.CreateObject("Scripting.FileSystemObject");
var env = shell.Environment("PROCESS");
var dir = env("TMP") + "\\xyzzy";
var path = fs.GetParentFolderName(WScript.ScriptFullName);

if (! fs.FolderExists(dir)) {
  fs.CreateFolder(dir);
}

env("XYZZYHOME") = path;
env("XYZZYCONFIGPATH") = dir;
if (fs.FileExists(path + "\\usr\\xyzzy.ini")) {
  fs.CopyFile(path + "\\usr\\xyzzy.ini", dir + "\\xyzzy.ini");
}
if (fs.FileExists(path + "\\usr\\.xyzzy.history")) {
  fs.CopyFile(path + "\\usr\\.xyzzy.history", dir + "\\.xyzzy.history");
}

shell.Exec("xyzzy -image " + dir + "\\xyzzy.dump");

一度起動した後のことは考えていませんので注意。

さらに、
をやっておくべきでしょう。
(setq lisp::*documentation-path*
      (merge-pathnames "XYZZYDOC"
                       (directory-namestring (si:dump-image-path))))
(delete-hook '*kill-xyzzy-hook* 'ed::save-history-file)
(add-hook '*kill-xyzzy-hook*
          #'(lambda ()
              (ed::save-history-file)
              (let ((ini (merge-pathnames "xyzzy.ini" (user-config-path)))
                    (his (merge-pathnames ".xyzzy.history" (user-config-path))))
                (copy-file ini (merge-pathnames "usr/xyzzy.ini" (si:system-root)) :if-exists :overwrite :if-access-denied :skip)
                (copy-file his (merge-pathnames "usr/.xyzzy.history" (si:system-root)) :if-exists :overwrite :if-access-denied :skip)
                (delete-file ini :if-does-not-exist :skip :if-access-denied :skip)
                (delete-file his :if-does-not-exist :skip :if-access-denied :skip)
                (delete-file (si:dump-image-path) :if-does-not-exist :skip :if-access-denied :skip)
                (delete-file (merge-pathnames "XYZZYDOC" (user-config-path)) :if-does-not-exist :skip :if-access-denied :skip)))
          t)
ただ、*kill-xyzzy-hook*の実行よりも後にxyzzy.iniへ書き込まれる設定があるため、xyzzy.iniの削除は完全ではありません。

煮るなり焼くなりご自由に。
(ReadMore...)

* xyzzy lisp : clone-buffer

とりあえずこんなところか。
主だったところはsession.lから。
outline-tree2をバッファバーの代わりにしつつ、rename-bufferを良く使う人向け。
もしくは*compilation*バッファとかでうっかりそのまま編集して、undoができず残念な思いをする人向け。
(defun clone-buffer (buffer-name &optional (buffer (selected-buffer)))
  (interactive "sClone Buffer: ")
  (let ((major buffer-mode)
        (minor (mapcan #'(lambda (mode)
                           (let ((var (and (consp mode) (car mode))))
                             (and (symbolp var)
                                  (boundp var)
                                  (symbol-value var)
                                  (list var))))
                       *minor-mode-alist*))
        (locals (mapcar #'(lambda (var)
                            (and (symbolp var)
                                 (local-variable-p var)
                                 (cons var (symbol-value var))))
                        *buffer-info-variable-list*))
        (point (point)))
    (set-buffer (create-new-buffer buffer-name))
    (insert-buffer buffer)
    (funcall major)
    (mapc #'(lambda (f) (and (fboundp f) (funcall f))) minor)
    (mapc #'(lambda (x)
              (when (and (car x) (symbolp (car x)))
                (make-local-variable (car x))
                (set (car x) (cdr x))))
          locals)
    (goto-char point)))

メモ:
undo情報をそっくり写せるとうれしいかも。
(ReadMore...)

* xyzzy : モバイルxyzzyの件

ヒストリ変数でパスを指定する場合でのみ問題ということであれば.xyzzy.historyの出力をどうにかすればいいのでは?と思い、書いてみる。
未テストなので注意。
帰ってからテストします。
(ReadMore...)