今年の抱負
mayu for linux を参考に作ったキーボードカスタマイズツールです。 SBCL で動きます。
カーネルモジュール uinput を使います。
uinput まわりは mayu for linux をおおいに参考にさせていただきました。ありがとうございす。
設定ファイル config.lisp は窓使いの憂鬱とは全く別ものです。
ソースは github にあります。 https://github.com/quek/info.read-eval-print.cl-mayu
参考
窓使いの憂鬱 Linux 対応版 を使っているのだけど、少々 Stumpwm と合相が悪い。電源ボタン等を押すと Stumpwm が落ちたりする。
いろいろといい機会なので SBCL で窓使いの憂鬱みたいなのを作ってみることにした。
sb-alien と cffi の両方を使ってしまっているけど、どちらかに統一したい。むしろ IOLib を使うこと検討すべきかも。なるべくライブラリを使わない方向がいいようにも思う。
root 権限が必要なため sudo sbcl したものに M-x slime-connect して開発している。 root 権限の sbcl に接続するのは、Stumpwm を走らせている sbcl に接続する以上に、落ち着かない。 sudo しなくてすむ方法がないものだろうか。
キーのリマップと SandS は実装した。あとは config.lisp に自分用の Dvorak 改の設定を書けば、何とか使えそうだ。
Climacs の find-file で次の対応。
C-i は 2 回連続で押さないと補完してくれない。なぜだろう？
そろそろ Emacs を卒業して、Common Lisp の世界で生活したい。
;;; -*- mode: lisp; indent-tabs: nil -*-
;;; (require :info.read-eval-print.climacs.ext)
(in-package :info.read-eval-print.climacs.ext)
(defun test ()
(format t "Hello World from new project info.read-eval-print.climacs.ext~%"))
(in-package :clim-internals)
(defun ext%normalize-so-far (so-far)
(reduce (lambda (acc x)
(ppcre:regex-replace (car x) acc (cadr x)))
`((".*//" "/") (".*/~/" ,(namestring (user-homedir-pathname))))
:initial-value so-far))
(assert (string= (ext%normalize-so-far "/tmp//a") "/a"))
(assert (string= (ext%normalize-so-far "/tmp/~/a") (q:str (namestring (user-homedir-pathname)) "a")))
(defun filename-completer (so-far mode)
(let* ((so-far (ext%normalize-so-far so-far))
(directory-prefix
(if (eq :absolute (car (pathname-directory (pathname so-far))))
""
(namestring #+sbcl *default-pathname-defaults*
#+cmu (ext:default-directory)
#-(or sbcl cmu) *default-pathname-defaults*)))
(full-so-far (concatenate 'string directory-prefix so-far))
(pathnames
(loop with length = (length full-so-far)
and wildcard = (format nil "~A*.*"
(loop for start = 0 ; Replace * -> \*
for occurence = (position #\* so-far :start start)
until (= start (length so-far))
until (null occurence)
do (replace so-far "\\*" :start1 occurence)
(setf start (+ occurence 2))
finally (return so-far)))
for path in
#+(or sbcl cmu lispworks) (directory wildcard)
#+openmcl (directory wildcard :directories t)
#+allegro (directory wildcard :directories-are-files nil)
#+cormanlisp (nconc (directory wildcard)
(cl::directory-subdirs dirname))
#-(or sbcl cmu lispworks openmcl allegro cormanlisp)
(directory wildcard)
when (let ((mismatch (mismatch (namestring path) full-so-far)))
(q:p path full-so-far mismatch)
(or (null mismatch) (= mismatch length)))
collect path))
(strings (mapcar #'namestring pathnames))
(first-string (car strings))
(length-common-prefix nil)
(completed-string nil)
(full-completed-string nil)
(input-is-directory-p (when (plusp (length so-far))
(char= (aref so-far (1- (length so-far))) #\/))))
(unless (null pathnames)
(setf length-common-prefix
(loop with length = (length first-string)
for string in (cdr strings)
do (setf length (min length (or (mismatch string first-string) length)))
finally (return length))))
(unless (null pathnames)
(setf completed-string
(subseq first-string (length directory-prefix)
(if (null (cdr pathnames)) nil length-common-prefix)))
(setf full-completed-string
(concatenate 'string directory-prefix completed-string)))
(case mode
((:complete-limited :complete-maximal)
(cond ((null pathnames)
(values so-far nil nil 0 nil))
((null (cdr pathnames))
(values completed-string (plusp (length so-far)) (car pathnames) 1 nil))
(input-is-directory-p
(values completed-string t (parse-namestring so-far) (length pathnames) nil))
(t
(values completed-string nil nil (length pathnames) nil))))
(:complete
;; This is reached when input is activated, if we did
;; completion, that would mean that an input of "foo" would
;; be expanded to "foobar" if "foobar" exists, even if the
;; user actually *wants* the "foo" pathname (to create the
;; file, for example).
(values so-far t so-far 1 nil))
(:possibilities
(values nil nil nil (length pathnames)
(loop with length = (length directory-prefix)
for name in pathnames
collect (list (subseq (namestring name) length nil)
name)))))))
(in-package :info.read-eval-print.climacs.ext)
;; C-i でも補完
(progn
(clim:define-gesture-name :complete :keyboard (:tab))
(clim:define-gesture-name :complete :keyboard (#\i :control) :unique nil))
Quicklisp を使う。
まだベータ http://www.quicklisp.org/beta/
http://beta.quicklisp.org/quicklisp.lisp からダウンロードする。
ダウンロードした quicklisp.lisp を Emacs で開く。
C-c C-l で quicklisp.lisp をロードする。
To continue, evaluate: (quicklisp-quickstart:install)
と repl に表示されるので、そのとおり実行する。
続いて (ql:add-to-init-file) を実行すると、~/.sbclrc に次のコードが追加される。
;;; The following lines added by ql:add-to-init-file:
#-quicklisp
(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp"
(user-homedir-pathname))))
(when (probe-file quicklisp-init)
(load quicklisp-init)))
これで Quicklisp にインストールと設定は完了。
次の SLIME 関係。
(ql:quickload "quicklisp-slime-helper") を実行するの次のように表示されるので、追加しておく。
To use, add this to your ~/.emacs:
(load (expand-file-name "~/quicklisp/slime-helper.el"))
以上、全て完了。
アップデートは次のとおり。
;; インストールしたものをアップデートする。
(ql:update-all-dists)
;; Quicklisp のアップデートする。
(ql:update-client)
自前のライブラリは Quicklisp 的にどうするのがいいんでしょう。とりあえず、いままでどおり ~/.sbclrc で asdf:*central-registry* に pushnew することにした。
Quicklisp 導入後の ~/.sbclrc はこんなのになった。
;;;;; -*-lisp-*-
;;デバッグ用セッティング
(declaim (optimize (debug 3) (safety 3) (compilation-speed 3)))
;;(declaim (optimize (debug 0) (safety 0) (speed 3) (space 0) (compilation-speed 0)))
;;; The following lines added by ql:add-to-init-file:
#-quicklisp
(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp"
(user-homedir-pathname))))
(when (probe-file quicklisp-init)
(load quicklisp-init)))
(require :asdf)
;; fasl のバージョンが古い場合リコンパイルする
(defmethod asdf:perform :around ((o asdf:load-op) (c asdf:cl-source-file))
(handler-case (call-next-method o c)
(#+sbcl sb-ext:invalid-fasl
#+allegro excl::file-incompatible-fasl-error
#+lispworks conditions:fasl-error
#+cmu ext:invalid-fasl
#-(or sbcl allegro lispworks cmu) error ()
(asdf:perform (make-instance 'asdf:compile-op) c)
(call-next-method))))
;; ;; clbuild
;; (pushnew (translate-logical-pathname "home:clbuild;systems;")
;; asdf:*central-registry*)
;; ~/letter/lib 以下の asd を登録する。
(flet ((f (path)
(loop for path in (directory path)
do (let ((pd (pathname-directory path)))
(unless (member "_darcs" pd :test #'equal)
(pushnew (make-pathname :directory pd)
asdf:*central-registry*
:test #'equal))))))
(f "~/letter/lisp/lib/**/*.asd")
(f "~/letter/lisp/craft/**/*.asd"))
;; iko-yo
(pushnew "~/job/actindi/ikoyo/iko-yo-tool/" asdf:*central-registry*)
(defun climacs ()
"Climacs を起動する。"
(load (merge-pathnames ".climacs.lisp" (user-homedir-pathname))))
(defun maxima ()
"Maxima を起動する。"
(let ((*default-pathname-defaults*
(translate-logical-pathname "home:clbuild;source;maxima;src;")))
(load "maxima-build.lisp")
(maxima-load)
(cl-user::run)))
(require :swank)
(ql:quickload "series")
(series::install :implicit-map t)
(require :info.read-eval-print.repl-tw)
#+http\://informatimago.com/develop/lisp/index.html
(progn
(defparameter *informatimago-base* "~/letter/lisp/lib/com/informatimago/")
(mapc (lambda (p) (pushnew (make-pathname :name nil :type nil :version nil :defaults p)
asdf:*central-registry* :test #'equal))
(directory (merge-pathnames "**/*.asd" *informatimago-base* nil)))
(asdf:oos 'asdf:load-op :com.informatimago.common-lisp))
ついでに ~/.emacs の SLIM 関係はこう。
;;;;; quicklisp-slime-helper
(load (expand-file-name "~/quicklisp/slime-helper.el"))
;;;;;SLIME
(setq common-lisp-hyperspec-root "file:/usr/share/doc/hyperspec/")
;;(setq slime-communication-style :fd-handler)
;;(setq slime-communication-style :spawn)
;;(setq slime-communication-style :sigio)
(setq slime-net-coding-system 'utf-8-unix)
(setq slime-lisp-implementations
`((sbcl ("sbcl") :coding-system utf-8-unix)
(ccl ("/home/ancient/local/opt/ccl/lx86cl64")
:coding-system utf-8-unix)
;; (ccl ("/home/ancient/letter/lisp/clbuild/clbuild"
;; "--implementation" "ccl" "lisp")
;; :coding-system utf-8-unix)
(deb-sbcl ("/usr/bin/sbcl") :coding-system utf-8-unix)
(clisp ("/home/ancient/letter/lisp/clbuild/clbuild"
"--implementation" "clisp" "lisp")
:coding-system utf-8-unix)
(abcl ("my-abcl")
:coding-system utf-8-unix)
(acl ("/home/ancient/local/opt/acl82express/alisp")
:coding-system utf-8-unix)
(cmucl ("lisp"))))
;;(add-hook 'lisp-mode-hook
;; (lambda ()
;; (cond ((not (featurep 'slime))
;; (require 'slime)
;; (normal-mode)))))
(setq slime-truncate-lines nil)
(setq slime-enable-evaluate-in-emacs t)
(defun my-slime-complete-form ()
(interactive)
(condition-case nil
(slime-complete-form)
(error
(save-excursion
(insert
(multiple-value-bind (ops arg-indices points)
(slime-enclosing-form-specs)
(run-hook-with-args 'slime-autodoc-hook ops arg-indices points)
(multiple-value-bind (cache-key retrieve-form)
(slime-compute-autodoc-rpc-form ops arg-indices points)
(slime-eval retrieve-form))))))))
(add-to-list 'auto-mode-alist '("\\.asd$" . common-lisp-mode))
;;(add-path "~/letter/lisp/clbuild/source/slime")
;;(add-path "~/letter/lisp/clbuild/source/slime/contrib")
(eval-after-load "slime"
'(progn
(slime-setup '(slime-repl
slime-asdf
slime-fancy
slime-indentation
slime-references
slime-tramp
slime-banner))
(setq slime-complete-symbol*-fancy t)
(setq slime-complete-symbol-function 'slime-fuzzy-complete-symbol)
(setq slime-autodoc-use-multiline-p t)
(global-set-key [(control ?\;)] 'slime-selector)
(loop for (key command) in
'(([(control ?c) ?\;] slime-insert-balanced-comments)
([(control ?u) (control ?c) ?\;] slime-remove-balanced-comments)
([(control ?c) ?\;] slime-insert-balanced-comments)
("\C-j" slime-que-print-last-expression)
("\C-m" newline-and-indent)
("\C-u" universal-argument)
("\C-i" slime-indent-and-complete-symbol))
do (define-key slime-mode-map key command))
(setq lisp-indent-function 'cl-indent:function)
;; Series のためのインデント
(define-cl-indent '(mapping ((&whole 4 &rest (&whole 1 1 2)) &body)))
(define-cl-indent '(iterate ((&whole 4 &rest (&whole 1 1 2)) &body)))
(define-cl-indent '(producing ((&whole 4 &rest (&whole 1 1 2)) &body)))
;; defpackage も調整
(define-cl-indent '(defpackage (4 2)))
;; tramp
;;(push (slime-create-filename-translator :machine-instance "li31-15"
;; :remote-host "li31-15.members.linode.com"
;; :username "ancient")
;; slime-filename-translations)
(progn
(defun slime-que-print-last-expression (string)
"Evaluate sexp before point; print value into the current buffer"
(interactive (list (slime-last-expression)))
(slime-eval-async `(swank:eval-and-grab-output ,string)
(lambda (result)
(destructuring-bind (output value) result
(push-mark)
(or (bolp) (insert "\n"))
(let ((output-p (if (string= "" output) "" ";;-> ")))
(insert (concat output-p
(if (<= 5 (length output))
(substring (replace-regexp-in-string "^" ";; " output) 5)
output)))
(and output-p (or (bolp) (insert "\n")))
(insert (concat ";;=> " (if (<= 5 (length value))
(substring (replace-regexp-in-string "^" ";; " value) 5)
value))
"\n")))))))
;; g000001 さん作
(progn
(defun gcode-lookup ()
"カーソル位置のシンボルを Google Code で検索 (lisp 決め打ち)"
(interactive)
(browse-url
(format "http://www.google.com/codesearch?q=%s+lang:%s+file:\\.%s$&hl=ja&num=20"
(thing-at-point 'symbol) "lisp" "lisp")))
(define-key slime-mode-map
[(control ?c) (control ?d) ?g] 'gcode-lookup))))
(require 'slime-autoloads)
Quicklisp すごいな。登録されているプロジェクト数がもう 430 を越えてる。全部 REPL から操作できるのもすばらしい。
ありがとうございます。
~/.tc
;;; -*-emacs-lisp-*- This file is automatically created
(setq tcode-data-directory (expand-file-name "~/.tcode/"))
(setq tcode-site-data-directory tcode-data-directory)
(setq tcode-default-input-method "japanese-T-Code")
;; 前置型交ぜ書き
;; (setq tcode-use-prefix-mazegaki t)
;; ○句読点等の切り替え
;; 標準よりも組み合わせを増やし、かつ「(」や「)」も切り替えるようにする。
(defvar tcode-left-paren "（" "* 開き括弧")
(make-variable-buffer-local 'tcode-left-paren)
(defvar tcode-right-paren "）" "* 閉じ括弧")
(make-variable-buffer-local 'tcode-right-paren)
(setq tcode-switch-table-list
'(;; 全角系 デフォールト
((tcode-touten . "、")
(tcode-kuten . "。")
(tcode-left-paren . "（")
(tcode-right-paren . "）"))
;; 半角系
((tcode-touten . ", ")
(tcode-kuten . ". ")
(tcode-left-paren . "(")
(tcode-right-paren . ")"))
;; 2バイト系
((tcode-touten . "，")
(tcode-kuten . "．")
(tcode-left-paren . "（")
(tcode-right-paren . "）"))))
;;; ○句読点の自動切り替え
;; 切り替えの規準(正規表現)の指定
(setq tcode-kutouten-regexp-alist
(list '("[、。]" . 1)
(if (tcode-nemacs-p)
'("\\z[,.]" . 2)
'("\\cj[,.]" . 2))
'("[，．]" . 3)))
;; 切り替える主モードを指定(text-mode latex-mode)
(setq tcode-auto-identify-kutouten-mode-list
'(text-mode latex-mode hnf-mode))
;; バッファで最初に Tコードモードに入ったときに、
;; 句読点を自動的に切り替える。
(add-hook 'tcode-mode-hook 'tcode-auto-switch-kutouten)
;; EELLL でイメージを使わない。
(setq eelll-use-image nil)
;; ヘルプ用のウィンドウの大きさを自動的に調整する。
(setq tcode-adjust-window-for-help t)
;; isearch-printing-char: Symbol's function definition is void: isearch-last-command-char 対策
;; tc-sysdep.el の L231
(if (string-match "^\\(19\\|2[0123]\\)" emacs-version)
(progn
(defun tcode-redo-command (ch)
"キー CH を現在のキーマップで再実行する"
(setq unread-command-events
(cons (character-to-event ch) unread-command-events)))
(or (fboundp 'character-to-event)
(defun character-to-event (ch)
ch))
;; XEmacs
(or (fboundp 'isearch-last-command-char)
(defun isearch-last-command-char ()
last-command-char))
(or (boundp 'search-upper-case)
(setq search-upper-case 'not-yanks)))
;; NEmacs
(defun tcode-redo-command (ch)
"キー CH を現在のキーマップで再実行する"
(setq unread-command-char ch)))
;; キーボードのカスタマイズ
(setq tcode-key-layout-list
'(("quek" . (?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?0
?' ?( ?) ?p ?y ?f ?g ?c ?r ?l
?a ?o ?e ?u ?i ?d ?h ?t ?n ?s
?\; ?q ?j ?k ?x ?b ?m ?w ?v ?z
?! ?\@ ?# ?$ ?% ?^ ?& ?* ?< ?>
?\" ?, ?. ?P ?Y ?F ?G ?C ?R ?L
?A ?O ?E ?U ?I ?D ?H ?T ?N ?S
?L ?Q ?J ?K ?X ?B ?M ?W ?V ?Z
))))
(add-hook
'tcode-ready-hook
(lambda ()
(set-tcode-mode-key
"/" 'tcode-insert-ya-outset) ; 記号入力
(set-tcode-mode-key ; 片仮名変換
"$" 'tcode-katakana-preceding-chars)
;; モード切り替え時にヘルプ用のバッファを消す。
(setq tcode-auto-remove-help-count 1)
(add-hook 'tcode-toggle-hook
'tcode-auto-remove-help)
;; カーソルに色をつける
(and window-system
(tcode-enable-cursor-to-change-color)
(setq tcode-mode-on-cursor-color "Violet"))
;; org-mode 対応
(push 'org-self-insert-command tcode-input-command-list)
;; 独自キーマップ
(tcode-set-key-layout "quek")
;; 補完機能
(require 'tc-complete)
;; "\" を補完・確定に使う。
;;(tcode-set-key "\" 'tcode-mazegaki-complete-and-convert)
;; 1文字から補完する。
(setq tcode-complete-min-context-length 1)
;; ;; コントロールキーを伴わないモード切り替え
;; (global-set-key " " 'tcode-electric-space)
;; (global-set-key ")" 'tcode-electric-comma)
;; (tcode-set-key " " 'tcode-electric-space)
;; zap-to-char の拡張
(global-set-key "\M-z" 'tcode-zap-to-char)
))
;;; ●文字表を読んだ後に行う設定
;;; ○2ストローク以上のストロークのキー割り当て
(add-hook 'tcode-after-load-table-hook
(lambda ()
(when (eq tcode-input-method 'tcode)
;; Tコード用の設定
;; 表を一部変更する。
;; 0 1 2 3 4 5 6 7 8 9
;; 10 11 12 13 14 15 16 17 18 19
;; 20 21 22 23 24 25 26 27 28 29
;; 30 31 32 33 34 35 36 37 38 39
(tcode-set-action-to-table '(5 5) "です。")
(tcode-set-action-to-table '(5 6) "ます。")
(tcode-set-action-to-table '(5 7) "削")
;; QWERTY での「ke」に変数 tcode-left-paren を割り当てる。
(tcode-set-action-to-table '(27 12)
'tcode-left-paren)
;; QWERTY での「id」に変数 tcode-right-paren を割り当てる。
(tcode-set-action-to-table '(17 22)
'tcode-right-paren))))
(progn ;; フィルターによる拡張入力。
(defun my-t-code-filter (x)
(or (cdr (assoc x '((?で . "です。")
(?ま . "ます。")
(?し . "した。")
(?事 . "こと")
(?〜 . "から")
(?消 . "削")
(?願 . "お願いします。")
(?以 . "以上、")
(?メ . "read.eval.print@gmail.com")
(?住 . "横浜市泉区岡津町110-3 グレーシアパーク山手台 EAST 壱番館 412")
)))
x))
(setq tcode-input-filter-functions
'((tcode-katakana-mode . japanese-katakana)
((and (boundp 'tcode-bushu-prefix-list)
tcode-bushu-prefix-list)
. tcode-bushu-prefix-convert)
(tcode-alnum-2-byte . tcode-1-to-2)
(tcode-shift-state . my-t-code-filter)))
)
(defun quek-dupm-tcode-key-table ()
"(quek-dupm-tcode-key-table)"
(load "tc-tbl")
(remove-if
(lambda (x)
(or (string= " " (caadr x))
(string= "■" (caadr x))
(atom (caar x))))
(mapcar (lambda (x)
(list (list (mapcar (lambda (key)
(char-to-string (tcode-key-to-char key)))
(tcode-encode x)))
(list (char-to-string x))))
(apply 'concat (mapcar 'identity tcode-tbl)))))
