* 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
- memo : xyzzy lisp FFI
- Common Lisp : 文字列中のエスケープシーケンスを解釈する
- xyzzy : *do-completion の動作がおかしいという話 2
- xyzzy : *do-completion の動作がおかしいという話
- xyzzy lisp : ミニバッファの入力にエスケープシーケンス
- xyzzy lisp : clone-buffer
- xyzzy lisp : 位置とサイズの操作
- xyzzy lisp : defpackage の OPTIONS に指定できるもの
- xyzzy lisp : global-mark を popup の続き
- xyzzy lisp : global-mark を popup
page 0 - << : 0 : >>
* 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)
* memo : xyzzy lisp FFI
いつかちゃんとまとめたい。
- 基本
- データ型関連
- int -> c:int, double -> c:double, ...
- ポインタ型は「(c:char *)」というようなリストの形で表現
- C の構造体は c:define-c-struct で定義
- C の関数を呼ぶ関連
- c:define-dll-entry で C 関数のインターフェースを作る
- c:define-dll-entry RETURN-TYPE NAME (&rest ARGS) DLL-NAME &optional EXPORT-NAME
- RETURN-TYPE 関数の戻り値
- NAME 関数名
- ARGS 関数の引数
- DLL-NAME DLLのパス
- EXPORT-NAME Cの関数名 (DLLでexportされているもの)
- データのやり取りは chunk を介する
- C から呼べる関数(callback関数)を作る関連
- c:defun-c-callable で作る
- c:defun-c-callable RETURN-TYPE NAME (&rest ARGS) &body BODY
- RETURN-TYPE 関数の戻り値の型
- NAME 関数名
- ARGS 関数の引数
- BODY 関数の定義
- データのやり取りは chunk を介する、ということで同上
- 注意点
- 下手をすると簡単に xyzzy が落ちることを頭に入れておく
- gc に注意する
- gc で回収されないオブジェクトを作らない
- C の関数が動いているときに chunk が gc されないように気をつける
- ポインタ型は全部「void *」とみなしても問題ない
- 「void *」は「unsigned long (32bit unsigned integer)」と等価として扱うこともできる
- xyzzy の未実装やバグにも注意
- その他、外部とのやり取り
- dde
- ole
* Common Lisp : 文字列中のエスケープシーケンスを解釈する
とりあえずできた。REPL では動作確認できた。
要 cl-interpol。
SANO さんの情報がなかったらどうにか interpol-reader を使えないか、悩んでいたかも。サンクスです。
[[(ReadMore...) index.rb?1204642645.txt]]
要 cl-interpol。
SANO さんの情報がなかったらどうにか interpol-reader を使えないか、悩んでいたかも。サンクスです。
[[(ReadMore...) index.rb?1204642645.txt]]
* xyzzy : *do-completion の動作がおかしいという話 2
なるほど。
そして、めも。
(*do-completion "quit" :list nil '("quit-recursive-edit" "quit-and-back" "quit-char" "quit" "quit")) =>:not-unique =>("quit" "quit" "quit-char" "quit-and-back" "quit-recursive-edit") =>nilこうなることを考えると do-completion-internal で対応するのがよさそう。
そして、めも。
If it is accessible as an internal symbol via use-package, it is first imported into package, then exported. (The symbol is then present in the package whether or not package continues to use the package through which the symbol was originally inherited.)CLHS: Function EXPORT: export.html
* xyzzy : *do-completion の動作がおかしいという話
[[*do-completionで重複が現れる:mode%2Fcomment]]という件に今頃気づいたのですが、lispパッケージとeditorパッケージの両方でexportされているからこのような結果になる模様。
どの段階で対処するのがいいのかな。
どの段階で対処するのがいいのかな。
* 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")
* xyzzy lisp : clone-buffer
とりあえずこんなところか。
主だったところはsession.lから。
outline-tree2をバッファバーの代わりにしつつ、rename-bufferを良く使う人向け。
もしくは*compilation*バッファとかでうっかりそのまま編集して、undoができず残念な思いをする人向け。
メモ:
undo情報をそっくり写せるとうれしいかも。
主だったところは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情報をそっくり写せるとうれしいかも。