twitter→ɹəʇʇɪʍʇのように英数字を180度回転して表示する方法 という記事を見かけたのでxyzzyに移植してみました。ネタ被ってないよね？
やってることはROT13などと同じで、連想リストを利用した単純な文字の相互変換です。 ただし、xyzzyではバッファに出力すると化けてしまう文字が幾つかあるので、その辺は適当に作ってます。
おまけとして、Emacsから移植したzone.lと組み合わせたコードも載せてあります。下の実行例を見てみると、なぜか特定の文字が変換されなかったりするようですが…。まあ書き捨てのコードですので勘弁してください。
newLISP版もあります。こっちはUnicode文字列を直接扱えるので若干コードがさっぱりしてます。
\u0040\u006b\u006f\u0073\u0068\u005f\u0062\u006f\u0074上記のようなUnicodeエスケープ文字を元の文字列に戻すためのEmacs Lispです。ついでなので逆のエスケープする関数も書いておきます。
xyzzyの方は単純にElispのコードを書き換えただけ。xyzzyはemacsより書き方に幅があるようだけど、あんまりトリッキーなコードだとelisp<=>xyzzy間のコードの移植が大変になりそう。
emacsでこんな感じの置換操作を行う場合は以下のように書くのが定石らしい。
(while (re-search-forward "検索したい文字列" nil t)
(replace-match "置換後の文字列" nil 'リテラルかどうか))
xyzzyならストリームを扱う関数を作ってed::text-decode-regionから呼び出すのが便利。
Emacsのジョークプログラムzone.elを移植したのでGitHubに置いておきますね。
壁||´･ω･`)っ kosh04/xyzzy-lisp/site-lisp/zone.l
※コード内の説明文はシフトJISなのでブラウザから開くとたぶん文字化けしますん。
xyzzyを初期化ファイルなし(xyzzy.exe -q)で起動するとメニューバーの [表示]->[ツールバー]部分が表示されない問題の原因が分かったのでメモ。
これはどうやらツールバーメニューの初期化を行う関数 (ed::load-command-bar-info) が *load-history-hook* から呼び出されていて、さらにこのフック変数を実行する関数 (load-history-file) が.xyzzyのロードと共に呼び出されている為に -q オプションを 指定して起動するとツールバーメニューが空になる現象が起こるらしい。
;; estartup.l:148:
(unless no-init-file
(trap-errors
(let ((*loading-user-initial-file* t))
(load (namestring (if (file-system-supports-long-file-name-p "~/")
"~/.xyzzy" "~/_xyzzy"))
:if-does-not-exist nil :verbose nil :print nil)))
(unless *inhibit-history-load*
(ignore-errors (load-history-file))))[追記]
根本的な解決策ではないが、以下をsiteinit.lに入れてダンプファイル削除＋再起動で直ったことにしておこう。
(defun load-command-bar-info-if-xyzzy-q ()
(let ((cl (car si:*command-line-args*)))
(when (or (equal cl "-q")
(equal cl "-no-init-file"))
(ed::load-command-bar-info))))
(add-hook '*pre-startup-hook* #'load-command-bar-info-if-xyzzy-q)Emacsのregexp-opt.elをxyzzyに移植してみました。
一応Emacs移植キットは使わずに自前で動くようにしてあります。 あまり実用的な出来ではないですが、よかったらどうぞ。
https://github.com/kosh04/xyzzy-lisp/tree -> site-lisp/ -> regexp-opt.lから入手できます。
-- Function: regexp-opt STRINGS &optional PAREN
この関数は、文字列STRINGSのいずれかに一致する効率よい正規表現を返
す。これは、たとえばフォントロック（font-lock）モードなどで、可能
な限り高速な一致や探索を行う必要がある場合に有用である。regexp-opt.lを$XYZZYHOME/site-lisp/ディレクトリ内に置いてバイトコンパイル。 .xyzzyに(require "regexp-opt")と書いてxyzzyを再起動する。
(regexp-opt '("aa" "ab" "ba" "bb"))
;;=> "a[ab]\\|b[ab]"
(regexp-opt '("defun" "lambda"))
;;=> "defun\\|lambda"
(regexp-opt '("defun" "defsubst" "defmacro" "defalias" "defvar" "defconst") t)
;;=> "\\(def\\(?:alias\\|const\\|macro\\|subst\\|un\\|var\\)\\)"
バグ・問題点:
(regexp-opt '("define" "lambda" "fn" "define-macro" "lambda-macro") 'words)
;;=> "\\<\\(define\\(?:-macro\\|\\)\\|fn\\|lambda\\(?:-macro\\)?\\)\\>" [xyzzy]
(regexp-opt '("define" "lambda" "fn" "define-macro" "lambda-macro") 'words)
;;=> "\\<\\(define\\(?:-macro\\)?\\|fn\\|lambda\\(?:-macro\\)?\\)\\>" [Emacs]#+xyzzy (defsetf macro-function si:*fset)
(progn
(setf (macro-function 'if-progn)
(macro-function 'when))
(list (if-progn t "てー")
(if-progn nil "てー")))
;=> ("てー" NIL)
(progn
(setf (macro-function '&&)
(macro-function 'and))
(list (&& t "てー")
(&& nil "てー")))
;=> ("てー" NIL)
(progn
(setf (macro-function 'mvbind)
(macro-function 'multiple-value-bind))
(mvbind (a b c)
(values 1 2 3)
(list a b c)))
;=> (1 2 3)
; #+xyzzy だと (macro-function 'multiple-value-bind) => nil となりエラー
(progn
(setf (macro-function 'defconst)
(macro-function 'defconstant))
(defconst e (exp 1))
(list e (multiple-value-list
(ignore-errors (let ((e pi)) e)))))
;=> (2.7182817 (NIL #<SYSTEM::SIMPLE-SOURCE-PROGRAM-ERROR #x19EE7919>))
(progn
(setf (macro-function '++)
(macro-function 'incf))
(let ((n 1))
(list n (++ n) (++ n))))
;=> (1 2 3)
(progn
(setf (macro-function 'fn)
(macro-function 'lambda))
(remove-if (fn (x) (zerop (mod x 3)))
'(0 1 2 3 4 5 6 7 8 9)))
;-> *** - FUNCTION: (FN (X) (ZEROP (MOD X 3))) is not a function name; try using a symbol instead
; #+GCL ではエラーにならずに (1 2 4 5 7 8) を返す。…なんでだ？
(defun check-parens ()
"バッファの括弧の釣り合いを調べる."
(interactive)
(handler-case
(let ((home (point)))
(goto-char (point-min))
(while (forward-list))
(goto-char home)
(message "だいたいあってる")
t)
(simple-error (c)
(message "このへん間違ってるかも")
(ding)
nil)))
(compile 'check-parens)
使い方
lisp-mode、lisp-interaction-modeで
M-x: check-parens
これをもうちょっと弄ってbefore-save-buffer-hookとかに引っ掛ければ便利そう。
とか思いつつも最近は括弧の閉じ忘れをすることがなくなったので、ほとんど使って いない状況です。
元ネタ: http://calypso.tux.org/pipermail/xemacs-beta/2009-January/015729.html
もともとこのブログを作った趣旨が「xyzzyでこんな関数作ったよ、見てね」 のつもりだったのに、最近まですっかり忘れていたような気がする今日この頃です。
Xyzzy Wikiに投稿するのもありなんですが、あまりに雑多すぎて分類に困りそうなのでブログの方にしました。（気が小さいなんて言えないです…）普段使っている関数群なので、そこそこ枯れていると思います。
→http://paste.lisp.org/display/75922
以下軽く解説
;; 載せるの忘れてた… (global-set-key #\C-g 'keyboard-quit) ;; [ツール]->[共通設定]->[マーク行の行番号を反転]にチェック (setq *inverse-mark-line* t)
(defun google (str)
(interactive "sGoogle: " :default0 (current-word t))
(long-operation
(shell-execute (concat "http://www.google.com/search?q="
(si:www-url-encode (map-internal-to-utf-8 str)))
t)))今回はここまで。もう少し続きます。
(let ((buffer-read-only nil)) (declare (special buffer-read-only)) (hogehoge))
Emacsのような動的束縛を使うなら上のように書くのがたぶん一般的なんだろうけど、動的束縛といえばprogvなんてものがあることに気づいたので以前自分で書いたものを引っ張ってきてみた。
(defmacro progv (symbols values &body body)
(let ((label (gensym "progv-form"))
(var (eval symbols))
(val (eval values)))
`(labels ((,label () ,@body))
((lambda (,@var)
(declare (special ,@var))
(funcall (function ,label)))
,@val))))
body部を変数束縛の外で実行する点では間違っていないと思う(たぶん)。 で、実行してみたところトップレベルではうまく動いているよう。
(defun hoge ()
(let ((*x* 3))
(progv '(*x*) '(4)
(list *x* (symbol-value '*x*)))))
(hoge)
;=> (3 4)
ただしprogvを含む関数をコンパイルすると駄目になった。中を覗いてみると、
(si:closure-body (compile 'hoge))
=>
;; *制御文字の置き換えあり*
(lambda ()
(system:*byte-code "^B^A^@廚^]^T^A^@^[^@Q^\^A
^A^\^A廛^U^B"
#(*x*
(lambda ()
(system:*byte-code "^@^B^@^E^@^A^@・・"
#(*x*)))
(lambda #1=(*x*)
(declare (special . #1#))
(funcall #'#:progv-form350)))))
labelsの展開がうまくいってないらしく、内部関数名"#:progv-form350"が残っている。 ここまで辿ったけどコンパイルの動作がサッパリなのでここでお手上げ。
labels使わないでprogv実装しろってことかなあ。
xyzzyではロードされたモジュールの一覧はmodulesで参照できるわけですが、 autoload関数で指定された関数は呼び出されるまでロードされません。 そういうモジュール一覧を参照出来ないかと思ってこんなものを作りました。 利用する箇所が見当たらないので、ネタということで。
http://paste.lisp.org/display/75440まあ、autoload-function-pを弄っただけなんですが。 find-all-symbolsを使っているのでコンパイルしないと重いです。
ところで"hh-call"って何なんでしょう？$XYZZY/lispディレクトリ内には見つか らないし、検索してみても答えは出ず。。。HTML-Helpをcallするとか？
勉強不足以上に実践不足が否めないと思う今日この頃。 テストが終わった(笑)のでちまちまとアウトプットをしていこうと思います。
まあ、たいしたものではないですが。
NANRIさん配布のHexlに対するpatchです。今更な気がするのでひっそりと。 →http://xyzzy.s53.xrea.com/wiki/index.php?patch%2Fpatch%2Fhexl.l 先生、"patch/patch/hexl.l"ってなんですか…
;; Hexlにあると便利そうなおまけ
(defun hexl-coloring-hook ()
"hexl-modeの表示に色を付ける."
(make-local-variable 'regexp-keyword-list)
(setq regexp-keyword-list (compile-regexp-keyword-list
'(("^\\w\\{8\\}:" nil 2)
(" .+$" nil :comment)))))
(add-hook 'hexl-mode-hook 'hexl-coloring-hook)
;; バイナリファイルは自動的にhexl-mode
(pushnew '("\\.exe$" . hexl-mode) *auto-mode-alist* :test 'equal)
xyzzylispだけでhexl-modeを再現は一度挑戦して挫折したなあ。
Hexlのように"ADDRESS: BYTE TEXT"の形式でバッファ表示させようとしたけど、関数のコンパイルをしても1Mのファイル読み込みに10秒かかったところでアウト。バイト単位の読み込みはまずかったのかもしれない。でも実践CLにもMP3のID3パーサが紹介されているくらいだからlispでバイナリファイルを扱うのは無茶ではないんだと思う。
もしかしてMP3ファイルのヘッダ部分だけ読み込んでいるのかもしれないが
2009-02-11T18:15:41+09:00追記
NANRIさんからのコメントで、Yamamoto Shinjiさんが移植されたhexl.lがあるこ とを教えてもらいました。ありがとうございます。
ファイルのヘッダ部分を見ると、移植元のhexl.elのコードは1994年らしいです。
;; Copyright (C) 1989, 1994 Free Software Foundation, Inc.
一方、NANRIさん移植のhexl.lは2001年もの。
;; Copyright (C) 1989, 1994, 1998, 2001 Free Software Foundation, Inc.
さすがにこれだけ移植元の年数が違うと、hexl.elのコード自体もそれなりに変 更が加えられているみたいでした。
また、Yamamotoさんのhexl.lを試したのですがhexl-beginning-of-line (Control-a)の挙動がおかしいらしく、テキスト部のカーソル(reverse-region)が 追いつかないバグが残っているようです。
(setq hexl-exec-directory "C:/usr/local/emacs-22.3/bin/") (require "hexl")
そんなわけで、コメントをいただいて恐縮ですがしばらくは使い慣れたHexlを弄ろうかと思います。
新しいネタを提供する気力がないので手元にある既存のものを。
(defun reboot-xyzzy (&optional cleanup)
"xyzzyを再起動する."
(interactive "P")
;; ついでに初期化する
(when cleanup
(delete-file (si:dump-image-path) :if-does-not-exist :skip)
(let ((siteinit (find-load-path "siteinit")))
(and siteinit
(string-match "\\.lc$" siteinit)
(delete-file siteinit))))
(cond ((modified-buffer-exist-p)
(error "保存をしよう、な！"))
((running-process-exist-p)
(error "サブプロセスが走ってるで")))
(and (call-process (merge-pathnames "xyzzy.exe" (si:system-root))
;; 環境変数の設定
:environ `(("XYZZYHOME" . ,(si:system-root))
;; 設定ファイル (xyzzy.ini等) のディレクトリ
("XYZZYCONFIGPATH" . ,(user-config-path)))
:no-std-handles t
:exec-directory (si:system-root)
:show t
:wait nil)
(kill-xyzzy)))
(defun modified-buffer-exist-p ()
"保存する必要のあるバッファがあるか."
(remove-if-not #'need-buffer-save-p (buffer-list)))
(defun running-process-exist-p ()
"動作中のプロセスがあるか."
(some #'(lambda (pid)
(eq (process-status pid) :run))
(process-list)))再起動させる M-x: reboot-xyzzy
再起動のついでに、ダンプファイルと siteinit.lc を削除して再ダンプさせるようにする。 C-u M-x: reboot-xyzzy
保存していないバッファがあったりサブプロセスが走っていたりすると、「いいの？」って質問されて止まっちゃうのでそこはエラーにしてます。保存関係は (save-some-buffers) 使ってもいいかも。
あと、自分は xyzzy.ini ファイルを $XYZZY/usr/ ディレクトリ直下に置いてあるで、普通に使ってる人は ("XYZZYCONFIGPATH" . ,(user-config-path)) の部分を削除して下さい。
紙一重で動いてるスクリプトな気がするのでご使用は各自の責任でお願いします。
※一応 Emacs 版もあります。
newLISP に付属のエディタが使いにくい。
やっぱり使い慣れたエディタがいいよね、ということで xyzzy から newLISP シェル (REPL) を操作する簡単な xyzzylisp を書いてみた。
(defvar *newlisp-exe* (merge-pathnames "newlisp.exe" (si:getenv "NEWLISPDIR"))) (defun run-newlisp () (interactive) (let ((*eshell* (format nil "~A -C -w ~A" *newlisp-exe* (default-directory))) (*shell-mode-hook* (list #'(lambda () (rename-buffer "*newLISP*")))) ;; プロセス間通信は UTF-8 (*default-process-encoding* *encoding-utf8n*) ;; なくても多分動く (*default-fileio-encoding* *encoding-utf8n*)) (shell))) ;;; elisp ならこんな感じか (defun run-newlisp () (interactive) (let ((default-process-coding-system '(utf-8 . utf-8))) (run-lisp (format "C:/PROGRA~1/newlisp/newlisp.exe -C -w %s" (expand-file-name default-directory)))))
ただし複数行の式を書くときは [cmd]~[/cmd] タグを使うことに注意。これは仕様だから仕方ない。
Evaluating newLISP expressions - newLISP v.9.4.5 Users Manual and Reference
書いていて気づいたが、 newLISP では日本語処理に難があるので UTF-8 が使えるバージョンを入手する必要がある。
http://www.newlisp.org/downloads/UTF-8_win32/
;; 比較
;; win32 で標準インストールされる newlisp.exe
> (explode "はろー")
("\227" "\129" "\175" "\227" "\130" "\141" "\227" "\131" "\188")
> (length "はろー")
9
;; UTF-8 の使える newlisp.exe
> (explode "はろー")
("は" "ろ" "ー")
> (length "はろー")
9
> (utf8len "はろー") ; UTF-8 用 length
3
でも reverse 関数には日本語が使えないので泣く泣く次のように書く必要がある。 メンドクサ
> (apply append (reverse (explode "はろー"))) "ーろは"
さーて、何をしようか。
なんとなく xyzzy の辞書ファイルを更新しようとしたらちょっと驚いた。 なんでかというと、その辞書ファイルの元となる EDICT ファイルが現在も更新されていたから。
xyzzy で辞書を使う方法は XyzzyWiki か $XYZZY/etc/README.gendic を参照のこと。 2008-11-02 現在、 Wiki の edict へのリンクは切れてます。 編集したいけどページが凍結されている…
辞書ファイル配布元: The Monash Nihongo ftp Archive http://ftp.monash.edu.au/pub/nihongo/00INDEX.html トップページから "edict.gz" を検索すれば見つかるはず。大分上の辺り。で、少し古くても構わないのならば同じ辞書ファイルは sdic (Emacs 用辞書引きメジャーモード) の作者さんである土屋さんのページからも入手できる。
[利用・配布条件] を見ると 1998 年のものらしい。 http://www.namazu.org/~tsuchiya/sdic/
二つの辞書ファイルを比較すると (比べたのは edict ファイル本体のみ)
更新時間 サイズ 行数 --- --- --- 2008-10-31 9.1M 160,090行 1998 2.5M 64,152行
すごく大きいです。 当然ながら出来上がる辞書ファイル xyzzy{dic,e2j,idi,jrd} も大きくなった。
しかし更新したのは良いけれど、その違いがわかるほど辞書を使いこなしていない自分にがっかりした。
辞書ファイル作成、辞書引きまで全部 LISP で作れないかなあ。
[おまけ] 自分の使っている便利 LISP 紹介
;;; バッファの代わりにポップアップ表示で辞書引き
(defun lookup-current-word ()
(interactive)
(let ((msg (save-window-excursion
(lookup-e2j-dictionary-selection)
(prog2
(set-buffer "*dictionary*")
(buffer-substring (point-min) (point-max))
(delete-buffer "*dictionary*")))))
(popup-string (string-trim (string #\LFD) msg) (point))))
(global-set-key '(#\C-c #\e) 'lookup-current-word)
command-substitutionという関数があります。けっこう便利。
上の関数を、バッファを介せずにCLの標準関数だけで作れないかなーと 思ってこんなものを書いてみた。まだまだ処理系依存。
やっていることは以下の3点
(defun cat (file &optional stream)
"print file contents."
(with-open-file (fp file)
(do ((ch (read-char fp nil nil)
(read-char fp nil nil)))
((null ch))
(princ ch stream))))
(defun shell-command-to-string (command)
"Execute shell command COMMAND and return its output as a string."
(let ((outfile (make-temp-file-name "xyzzycmd-")))
(unwind-protect
(with-output-to-string (stream)
(call-process command :output outfile
:show :minimize :wait t)
(cat outfile stream))
(delete-file outfile))))
(defun command-substitution (command)
(string-right-trim '(#\SPC #\TAB #\LFD)
(shell-command-to-string command)))
結果:
(command-substitution
(format nil "ls -1 ~A"
(merge-pathnames "*.exe" (user-homedir-pathname))))
=>
"C:/home/xyzzy/xyzzy.exe
C:/home/xyzzy/xyzzycli.exe
C:/home/xyzzy/xyzzyenv.exe"
(command-substitution "echo 舌足らずなブログ")
=> "舌足らずなブログ"
意図してなかったが日本語も通るようだ。
ちなみにshell-command-to-stringという関数名はEmacsから。
後は
以前書いたarglist関数の見た目がやっぱりダメダメなことに気づいた。
(filename &key (direction :input) (if-does-not-exist "FIXME") ...) => (filename &key (direction input) (if-does-not-exist FIXME) ...)
ということでまたarglistを書き直した。 キーワード以外のシンボルにフィルターをかけるような関数をつくって解決。
# 何かまだバグがありそうで恐い…
(defun arglist (x)
(labels ((arglist-helper (x)
(cond ((consp x)
(mapcar #'arglist-helper x))
((and (symbolp x) (not (keywordp x)))
(intern (string x)))
(t
x))))
(arglist-helper (arglist-1 x))))もう少し返り値を見やすくする方法に気づいたのでメモ。
こっちのarglistをarglist-1に置き換えて次の関数とマクロを追加
(defun arglist (x)
(let ((args (arglist-1 x)))
(if (consp args)
(nth-value 0 (read-from-string (princ-to-string args)))
args)))
(defmacro nth-value (n form)
`(nth ,n (multiple-value-list ,form)))
(arglist-1 'apply) ; (function lisp::arg &rest lisp::more-args)
(arglist 'apply) ; (function arg &rest more-args)
(arglist 'if) ; "TEST THEN [ELSE]"
ツッコミを入れられたらできるだけ返したくなる性分です。 困ったものです。
ついでなのでpaste.lisp.orgに貼ってみた。変更点は(nth-value ~)あたり。
http://paste.lisp.org/display/67774
これでキーワードシンボルはなるべくそのままにした関数の引数リスト を返してくれる(はず)です。keywordpなんて関数はじめて見た。
ただし、関数引数にキーワードシンボルが入るのは組み込み関数だけのようです。なのでLispで書いたLisp関数の引数はコロンなしのシンボルになります。 この挙動はCLISP,Allegroでも同じみたいなのでこのままで良いかな。(arglist 'make-list) (size &key :initial-element) ; xyzzy (#:ARG0 &KEY :INITIAL-ELEMENT) ; clisp (EXCL::SIZE &KEY EXCL::INITIAL-ELEMENT) ; acl
(arglist (lambda (fn seq &key key1 key2 key3)
(list key1 key2 key3)))
(fn seq &key key1 key2 key3) ; xyzzy
(FN SEQ &KEY KEY1 KEY2 KEY3) ; clisp
(FN SEQ &KEY KEY1 KEY2 KEY3) ; acl
# xyzzyはmodern(大文字と小文字を区別する)だから :test -> :TEST
# に変換する必要はないのかなあ
タイトルはホッテントリメーカーから。日刊とか無理。
非同期って恐いねというお話。
まずは関数を３つ用意
(defun process-list ()
"バッファプロセスのリスト."
(remove-if-not #'processp
(mapcar #'buffer-process (buffer-list))))
(defun running-process-exist-p ()
"動作中のプロセスがあるか."
(some #'(lambda (pid)
(case (process-status pid)
(:run t)
(:exit nil)))
(process-list)))
(defun kill-all-subprocess ()
"バッファプロセスをすべて殺す."
(every #'kill-process (process-list)))次に何かxyzzyからプロセスを走らせる(M-x: shell とか)
で、ここで上の関数を使って動作中のプロセスをすべて消したいわけです。 別にタイミングを気にしなければ (kill-all-subprocess) だけでも良いんだ ろうけど、ちょっと時間差が気になるコードを書いていたのでこんなS式を書 いてみた。
これならloopフォームを抜けたときには動作しているプロセスが完全になくな っているはず。
(loop (if (running-process-exist-p)
(kill-all-subprocess)
(return t)))
意気揚々と実行(C-x C-e)。確かにプロセスは消えた。そこまではいいけど...
何故かxyzzy本体まで落ちた。
...
あるえー(・3・)
とりあえず次ので解決したことにしておく
(loop (if (running-process-exist-p)
(and (kill-all-subprocess)
(sleep-for 0.5))
(return t)))