windows xp を再インストールした後、無線LANが「アドレスの取得中」のままになって接続できなくなった。
無線LAN で接続するには、xp を起動するたびに WPA2 のネットワークキーを入れてやればいいけど、めんどすぎ。なんでこんなことになってしまったのか。
http://ameblo.jp/buddato/entry-10866917943.html
ここによると、「Microsoft ネットワーク用クライアント」を切ればいいらしい。
「そんなバカな」と思ったけど、やってみた。
うまくいった。ありがとう。こんなの一生かかっても分からんです。
起動時の「ようこそ」画面って無駄にしか思えん。
そう思ってたら、標準でそれを消せる機能があった。
コンパネ / ユーザーアカウント / ユーザーのログオンやログオフの方法を変更する
の「ようこそ画面を使用する」のチェックをはずす。
こんなのがあったとは。
mini9 に xp を再インストールした。
まあいろいろやったけど、キーボードの設定について、忘れていたことがあったのでメモっておく。
ほかの PC では英語キーボードなんだけど、レジストリを変更して AXキーボードにして使ってる。こうすると 右ALT で IME を ON/OFF できていい*1。
この mini9 も英語キーボードなんだけど、右ALT がない。なので、IME 切り替えをスペースバー右にある「目キー」*2でやってる。それには xkeymacs のちからを借りた。
それと、A の左は CTRL にする。これも xkeymacs ならすぐできる。
手順的には、
xkeymacs は本格的にキーバインドを変更するなら常駐しなければならないけど、今回のケースの様にキーマップを変更するだけならレジストリを変更するだけなので、常駐させる必要はない。
だから、xkeymacs.exe を起動してアイコントレイで右クリックして キーボードレイアウトを選んでキーマップを変更したら、xkeymacs を終了すればいい。レジストリを変更してるから、xkeymacs が起動していなくても設定は生きる。
もし xkeymacs が変更したキーボードレイアウトを元に戻したくなったら、下記のレジストリのエントリを消せばいい。
久しぶりに仕事の話でも書こうかな。
仕事で仕様書を書くことになった。Microsoft Word で。
正確にいうと、既に word で書かれた仕様書を大幅に直すタスクだ。
word を使うのは何年ぶりになるだろうか。たしか NT4.0 の頃に使ったのが最後だった。ということは 約10年ぶりだ。
当時はハードウェアの設計の仕事をしていたんだけど、ある時、製品のマニュアルを word で書き直すことになった。
それまでは、その手のドキュメントは Macintosh LC475 のクラリスワークスで書いていた。
これからは Windows の時代だということで(笑)、クラリスワークスで書かれた製品マニュアルを設計者が分担して入力していくことになった。
みんな「え～っ！」て言ってた。営業の人に言わせると、製品を詳しく知らない人にやらせるとタイポが多くなるから、僕らがやるほうがいいらしい。
仕方ないので、毎日ちょっとづつワープロ(死語か?)していった。でも1日目にみんなが気づく。それまでクラリスワークスで簡単にできてたことが、word ではできなかったり、できたとしても恐ろしく奇妙で複雑な操作を要求してくることに。
段落を設定しても思った通りにならない、番号つきリストがおかしくなる、改行するとインデントが変になる、表がうまく書けない、図を拡大縮小するとドロー要素の配置がずれる、文章に少し手を入れるだけで全体の配置が狂う、おまけによく落ちる。
昼休みに、仲の良かった Mac 使いの同僚にこんなことを聞いた。
「なあ、なんで word はあんなに難しいんだろ。2 ページ書くのに 5 時間もかかるよ。」
彼は笑いながら、こう言った。
「そりゃあ Microsoft のワープロだからな。あそこは C コンパイラや BASIC インタプリタを作ってる会社だ。そんな会社が作ったワープロがクラリスワークスと同じように使えるって考えがそもそもおかしいよ。」
それを聞いて、そりゃそうだと納得できた。
ただ、word を卑怯だと感じたのは、実は使えない機能なのに、いかにも簡単に使えそうなアイコンにして並べてたことだった。アイコンを押しても、大抵の場合は希望は叶わずに、細かなパラメータを調整するハメになる。まあ調整してもできないことのほうが多いんだけどね。
定食屋に行って、なにを頼んでも「ごめんなさい、材料がないので作れません。お客さんが取ってきてくれるなら別ですが？」ってニヤリと笑う。そんなやつだ。
じゃあ最初からメニューに書くなよ、と思った。中身が未実装の空関数をメニューに出すなよと。
最終的に僕らがとった戦法は、極端にいうとテキストエディタとして使うことだった。段落は使わない、リスト表記も使わない、インデントは全角スペース、図や表はクラリスワークスの図をビットマップでコピペした。
あれから10年*1。word がどれだけ進化したのか、すごく興味が沸いてきた。あれだけあった空関数をどのくらい実装してくれたのかってね。
で、起動してワープロしてみたら･･･。まぁ、結論だけ言うと、何も変わってなかった(w
キラキラしたステッカーやバッジがてんこ盛りになったけど、10年前未実装だった機能はやっぱり相変わらず未実装だった。
今回は、既に word で書かれた仕様書を直さなければならないから、10年前にやった戦法は使えない。
「あーあ」と思いながらしばらく段落のパラメータを調整してると、世界中の人たちが朝から晩まで word の出したダイアログのパラメータをいじって疲れている様子が思い浮かんできた。呆れたのを通り越して笑いがこみ上げてきた。
「すごいぜ、コイツが世界のデファクトスタンダードだ！」って。
必死に笑いをこらえていたら、なにやら語りかけてくるヤツがいる。話しを聞いてみる。
「その段落は、そんなにキレイに整えなきゃならないのか？へー、その文書がそんなに値打ちがあるようには思えないな。本当に価値がある文書にしたいときはね、TeX を使うんだよ。」
「でもな、word で書かれたこの仕様書をベースにしたいんだ。そうするように言われたんだ。TeX で書いた仕様書なんて、先方に送れないよ(w」
「じゃあ、きっとキミが真剣にやりすぎてるんだ。word で書く程度にしか価値のないドキュメントを、そんなに時間をかけて緻密に作れって言うほうがおかしいと思わないか？」
「なるほどな。この仕事自体、やらなくていい仕事なのかもな。話してみるよ。ありがとう、よく教えてくれた。で、キミは誰？」
「礼にはおよばない。オレか？オレは word だよ。Microsoft Word 2003 だよ。」
昼休みに相談してみると、やらなくてもよくなった(w
今まで、word が Office に入ってる理由が分からなかった。MS Office の中で 使っているのは Excel、パワポ と IME だけって人は以外に多いんじゃないかな。
Access はまだ理由は分からないけど、word は分かったぞ。word はワープロとして使うソフトじゃない。これは emacs でいう doctor に近いソフトだ*2。
Microsoft、さすがだ。
仕事を真剣にやりすぎてしまう人のために、これ以上無理して仕事をさせないように NFB をかけるソフトを混ぜて売っていたとは。すごいハックだ。
これを他の人に話したら、「そんな馬鹿な！」って笑われた。
でもね、製品っていうのは、作った人が「こう使って欲しい」と思っているのとは別の使い方をされることも結構あると思うんだ。
使う人にとってそのほうが楽だったり、納得できたり、スタイリッシュだったりすれば、作った人はそれを拒絶するんじゃなくて、受け入れるべきだと思う。工業界はそれが足りない。受け入れたら、またそこから新しいものを作れるのに。
昔、体育館の上履きのかかとを踏んづけて、スリッパにして使ってた人も多いと思うんだけどなぁ。
*1：まあ、10年といってもこの word のバージョン は 2003 だから 実質は 6年くらいの開発期間だけど。
*2：emacs で M-x doctor ってすると、精神科医が現れていろんな相談に乗ってくれる(w 英語だけどな。
メニューはほとんど使わないので消す。
まったく消してしまうと不安なので、右クリックしたときのコンテキストメニューでメインメニューを出せるようにしとく。
;;; toggle-menu でメインメニュー表示を切り替え
(defvar *main-menu* *app-menu*)
(defun toggle-main-menu ()
(interactive)
(set-menu (setq *main-menu* (if *main-menu* nil *app-menu*))))
;;; デフォでメニューを消しておく
(add-hook '*post-startup-hook*
#'(lambda ()
(set-menu (setq *main-menu* nil))))
;;; コンテキストメニューをすげ替える
(setq *my-menu*
(define-popup-menu
(:item nil "メインメニューを表示(&M)" 'toggle-main-menu)))
(add-hook '*init-app-menus-hook*
#'(lambda ()
(setq *app-popup-menu* *my-menu*)))
上のを .xyzzy に書いておく。
なんか変なのができた。
ふつう scratch バッファは need-not-save が nil なので、xyzzy を終了するときに保存するかどうか、聞かれない。
これは emacs ゆずりのふつうの動作。
ただ、最近はちょこっと lisp のテストコードを書いては終了したりするので、「書き捨て」として扱うには忍びない。
そこでしばらく need-not-save を t にして使っていたんだけど、これはこれで、いちいち保存しますか？と聞いていくるのでうっとおしい。
じゃあ、xyzzy が終了するときに hook して、あらかじめ決めたファイル名で自動的に上書き保存してくれたらいい。
というのを書いてみた。
2011.4.19 変更 xyzzy を終了できなかったのを直した。
;;; scratch-util.l
;;;
;;; scratch buffer utility
;;;
(provide "scratch-util")
(in-package "editor")
;;
(let ((buf (find-buffer "*scratch*")))
(when buf
(with-set-buffer
(set-buffer buf)
(make-local-variable 'need-not-save)
(setq need-not-save nil))))
(export '(scratch-util-save scratch-util-read
*scratch-util-dir* *scratch-util-name*))
(defvar *scratch-util-dir* "~"
"保存ファイルをつくる場所")
(defvar *scratch-util-name* "scratch-bak"
"保存ファイルの名前")
(defvar *scratch-util-buf* "*scratch*")
;; (defun scratch-util-save ()
;; (interactive)
;; (let ((buf *scratch-util-buf*)
;; (path (concat (append-trail-slash *scratch-util-dir*)
;; *scratch-util-name*)))
;; (when (and (buffer-modified-p buf)
;; (< 0 (buffer-size buf)))
;; (with-set-buffer
;; (set-buffer buf)
;; (write-file path t)
;; (set-buffer-modified-p nil))
;; (message "saved."))))
(defun scratch-util-save ()
(let ((buf *scratch-util-buf*)
(path (concat (append-trail-slash *scratch-util-dir*)
*scratch-util-name*)))
(when (and (buffer-modified-p buf)
(< 0 (buffer-size buf)))
(with-set-buffer
(set-buffer buf)
(write-file path t)
(set-buffer-modified-p nil))))
t)
(defun scratch-util-read ()
(interactive)
(let ((buf *scratch-util-buf*)
(path (concat (append-trail-slash *scratch-util-dir*)
*scratch-util-name*)))
(cond ((not (file-exist-p path)) (message "not exist ~A" path))
((> (buffer-size buf) 0) (switch-to-buffer (find-file-internal path))
(lisp-interaction-mode))
(t (switch-to-buffer buf)
(insert-file path)))))
;(define-key ed::*lisp-interaction-mode-map* '(#\C-x #\C-s) 'scratch-util-save)
(add-hook '*query-kill-xyzzy-hook* 'scratch-util-save)
;;; scratch-util ends here
ちなみに scratch-util-read すれば、前回のscratchの内容を読み込む。
まあ、置換とかは replace-buffer とかで一発なんだが、もちょっと凝ったことをしたいときがある。
今まではバッファを1行づつ処理するときは、
(while (null (eobp))
(let* ((beg (save-excursion (goto-bol) (point)))
(end (save-excursion (goto-eol) (point)))
(s (buffer-substring beg end)))
(dbg-msgbox s) ; やりたい処理
(forward-line)))
とかやっていた。
すごく冗長に感じていたし、カーソルを動かしたりするのがやるせなかった。行頭と行末のポイントが欲しいだけなのに、save-excursion するのとか、不必要に let* 使うのもちょっと変だと思っていた。まあ、いろいろキモかった。
もうちょっと読みやすいのを考えてみた。今回はマクロで。
;;; バッファを1行ずつ処理する
;;; e.g. (loop-at-buffer (line)
;;; (dbg-msgbox line))
(defmacro loop-at-buffer ((var &optional buffer) &body body)
(let ((gbuf (gensym))
(gstream (gensym)))
`(let* ((,gbuf (cond ((null ,buffer) (selected-buffer))
((bufferp ,buffer) ,buffer)
(t (find-buffer ,buffer))))
(,gstream (if ,gbuf (make-buffer-stream ,gbuf)
(error "\"~A\"という名前のバッファが見つかりません" ,buffer))))
(loop
(let ((,var (read-line ,gstream nil)))
(unless ,var (return nil))
,@body)))))
これを使うと、上の例は↓こう書けるようになる。
(loop-at-buffer (line)
(dbg-msgbox line))
わりといい感じになった。
パラメータは下記の2つ。
ちなみに、マクロ内で使ってる make-buffer-stream は xyzzy の関数なんだが、引数に nil を渡すと適当になんかのバッファ(selected-buffer か?)に紐づいたストリームを返すみたいで、具合が悪い。その対策を入れてある。
･･･とここまでやっておいて、実は with-input-from-buffer があったことに気づく。
また車輪やってしまった。
文字列中の 1文字がアルファベットかどうか知りたいことがたまにある。
たとえば、こう書ける。
(defun char-alphabet-p (ch)
(if (char-not-greaterp #\a ch #\z) t
nil))
char-not-greaterp は char<= の大文字/小文字区別なし版で、2つの引数の大小比較だけでなくて、3個以上の引数を取れるってとこがミソかな。
関係ないけど、Wikipedia によると A～Z, a～z を「アルファベット」という呼ぶのは日本だけっぽい。
とすると、上の関数名はすごく変に感じるけど、まあいいや。
ちなみに数字かどうかは、これで一発。
(defun char-number-p (ch)
(if (char<= #\0 ch #\9) t
nil))
たらたら書く必要なし。すばらしい。
xyzzy の recentf は これがわりと有名だとおもう。
でもなぜかそれは使ってなくて、むかし適当に自分で書いたのをちょこちょこ直しながら現在に至っている。
変り種としては、
こんなところか。
そうそう、lib.l が要る
;;;
;;; recentf.l
;;;
(require "lib")
(provide "recentf")
(export '(*recentf-mode-hook* *recentf-mode-map* *recentf-mode*))
(defvar *recentf-mode-hook* nil)
(defvar *recentf-buf-name* "*recentf*")
;;
;; keymap
;;
(defvar *recentf-mode-map* nil)
(unless *recentf-mode-map*
(setq *recentf-mode-map* (make-sparse-keymap))
(define-key *recentf-mode-map* #\RET 'recentf-action-key-enter)
(define-key *recentf-mode-map* '(#\C-x #\C-s) 'recentf-save)
(define-key *recentf-mode-map* '(#\C-x #\k) 'recentf-kill-buffer)
(define-key *recentf-mode-map* #\q 'recentf-kill-buffer))
;;
;; util
;;
(defun recentf-enumulate-file-nume ()
(dolist (e *minibuffer-file-name-history*)
(insert e "\n")))
(defun recentf-get-current-line ()
(save-excursion
(let ((beg (progn (goto-bol) (point)))
(end (progn (goto-eol) (point))))
(buffer-substring beg end))))
(defun recentf-find-file ()
(let ((fn (recentf-get-current-line)))
(if (file-exist-p fn)
(progn
(recentf-update-list fn)
(delete-buffer *recentf-buf-name*)
(find-file fn))
(message (concat "not found: " fn)))))
(defun recentf-update-list (e)
(let ((l (reverse (set-exclusive-or *minibuffer-file-name-history* (list e) :test #'string=))))
(setq *minibuffer-file-name-history* (push e l))))
(defun recentf-create-list ()
(split-string (buffer-substring (point-min) (point-max)) "\n" nil " \t"))
(defun recentf-delete-empty-line ()
(save-excursion
(goto-char (point-min))
(replace-buffer "^[ \t]*\n" "" :regexp t))) ; 空白行を削除
(defun recentf-delete-not-exist ()
(flet ((not-exist-p (x) (if (and (windows-local-path-p x) (not (file-exist-p x)))
t nil)))
(let ((out (delete-if #'not-exist-p (recentf-create-list))))
(delete-region (point-min) (point-max))
(dolist (e out)
(insert e "\n")))))
(defun recentf-upcase-drive-letter ()
(let ((out (mapcar #'upcase-drive-letter (recentf-create-list))))
(delete-region (point-min) (point-max))
(dolist (e out)
(insert e "\n"))))
(defun recentf-cleanup-buffer ()
(save-excursion
(recentf-delete-empty-line)
(recentf-delete-not-exist)
(recentf-upcase-drive-letter)))
;;
;; command
;;
(defun recentf-action-key-enter ()
(interactive)
(if buffer-read-only
(recentf-find-file)
(newline)))
(defun recentf-save ()
(interactive)
(if (buffer-modified-p)
(let ((ro buffer-read-only))
(setq buffer-read-only nil)
(recentf-cleanup-buffer)
(setq *minibuffer-file-name-history* (recentf-create-list))
(set-buffer-modified-p nil)
(setq buffer-read-only ro)
(message "saved."))
(message "no need to save.")))
(defun recentf-kill-buffer ()
(interactive)
(delete-buffer *recentf-buf-name*))
(defun recentf ()
(interactive)
(when (find-buffer *recentf-buf-name*)
(delete-buffer *recentf-buf-name*))
(set-buffer (get-buffer-create *recentf-buf-name*))
(recentf-enumulate-file-nume)
(goto-char (point-min))
(set-buffer-modified-p nil)
(setq buffer-read-only t)
(recentf-mode))
(defun recentf-mode ()
;(kill-all-local-variables)
(setq buffer-mode 'recentf-mode)
(setq mode-name "recentf")
(use-keymap *recentf-mode-map*)
(setq need-not-save t)
(setq auto-save nil)
(setq kept-undo-information t)
;(make-local-variable 'highlight-keyword)
;(setq highlight-keyword nil)
(run-hooks '*recentf-mode-hook*))
(global-set-key '(#\C-x #\r #\r) 'recentf)
これも、バックアップとして置いておく。
discrete.l - 小さなコマンド群
;;;
;;; discrete.l
;;;
(require "lib")
(provide "discrete")
;;;
;;; binding to test lisp code
;;;
(defun test-call ()
(interactive)
(test))
(defun test ()
(dbg-msgbox 'dummy-test))
(global-set-key #\M-\2 'test-call)
;;; pt
(defun pt ()
(interactive)
(message "~D" (point)))
;;;
;;; main menu
;;;
(defun popup-app-menu ()
(interactive)
(let ((menu (copy-menu-items *app-menu* (create-popup-menu))))
(track-popup-menu menu)))
(global-set-key #\RBtnUp 'popup-app-menu)
;;;
;;; next-page, previous-page
;;;
(defun next-page-gnrr ()
(interactive)
(let ((end-line (+ (get-window-start-line) (window-lines))))
(next-page)
(when (> end-line (buffer-lines))
(goto-char (point-max)))))
(global-set-key #\M-n 'next-page-gnrr)
(defun previous-page-gnrr ()
(interactive)
(let ((start-line (get-window-start-line)))
(previous-page)
(when (= start-line 1)
(goto-char (point-min)))))
(global-set-key #\M-p 'previous-page-gnrr)
;;;
;;; comment-region
;;;
(defun comment-region ()
(interactive)
(comment-out-region))
;;;
;;; toggle-truncate-lines
;;;
(defun toggle-truncate-lines (&optional dir)
(interactive "p")
(let* ((table `((nil . "折り返し: なし")
(t . "折り返し: ウィンドウ幅")
;(,buffer-fold-widhth . "指定位置で折り返し"))))
))
(current (nth (mod (+ (position (buffer-fold-width) table :test (lambda (x y) (eql x (car y)))) (if dir 1 -1))
(length table))
table)))
(set-buffer-fold-width (car current))
(message (cdr current))))
(global-set-key '(#\C-x #\t) 'toggle-truncate-lines) ; C-x t
;;;
;;; toggle-narrowing-region
;;;
(defvar-local *narrowing-region-state* nil)
(defun toggle-narrowing-region ()
(interactive)
(flet ((mark-beg ()
(let ((mk (mark t)))
(if mk mk 0))))
(if *narrowing-region-state*
(widen)
(narrow-to-region (mark-beg) (point))))
(setq *narrowing-region-state* (not *narrowing-region-state*)))
(global-set-key '(#\C-x #\n #\n) 'toggle-narrowing-region)
(global-unset-key '(#\C-x #\n #\w))
;;領域外の色は Windows のシステムカラーの使用不可の項目
;;;
;;; count-line
;;;
(defun count-line (from to)
(interactive "*r")
(let (beg end cnt)
(save-excursion
(setq beg (progn (goto-char from) (current-line-number)))
(setq end (progn (goto-char to) (current-line-number))))
(setq cnt (abs (- beg end)))
(if (interactive-p)
(message "count line: ~D" cnt)
cnt)))
;;;
;;; todo
;;;
(defvar todo-file "~/todo.txt")
(defun todo ()
(interactive)
(find-file todo-file))
;;;
;;; find-file-gnrr
;;;
(defun find-file-gnrr (fn)
(interactive "FFind file: ")
(cond ((file-exist-p fn) (find-file fn))
((y-or-n-p "new file? ") (find-file fn))))
(define-key ctl-x-map #\C-\f 'find-file-gnrr)
;;;
;;; cmd.exe
;;;
(defun c ()
(interactive)
(let* ((fn (get-buffer-file-name))
(ed::*launch-app-directory* (if fn (directory-namestring fn)
(si:system-root))))
(run-console)))
;;;
;;; explorer.exe
;;;
(defun open-explorer (fn)
(flet ((get-arg ()
(if fn (concat "/e,/select," (map-slash-to-backslash fn))
(concat "/e," (map-slash-to-backslash (si:system-root))))))
(call-process
(concat (get-windows-directory) "explorer " (get-arg)))))
(defun e ()
(interactive)
(let ((fn (get-buffer-file-name)))
(cond ((null fn) (open-explorer nil))
((file-exist-p fn) (open-explorer fn))
(t (message "not exist ~A" fn)))))
;;;
;;; hatena-insert
;;;
(defvar *hatena-insert-alist* '((">|lisp|\n||<" . "スーパー pre lisp")
;(">||\n||<" . "スーパー pre")
("[:title=ココ]" . "リンク")
("<br>" . "改行")
("(())" . "脚注")
(">>\n<<" . "引用")
;("-" . "リスト")
;("+" . "リスト 番号つき")
("**" . "小見出し")
("><hr><" . "区切り線")))
(defvar *hatena-insert-last-num* 0)
(defun hatena-insert ()
(interactive)
(let ((lst *hatena-insert-alist*))
(setq *hatena-insert-last-num*
(if (eq *last-command* 'hatena-insert)
(progn
(delete-char (1+ (length (car (nth *hatena-insert-last-num* lst)))))
;(delete-char (length (car (nth *hatena-insert-last-num* lst))))
(mod (incf *hatena-insert-last-num*) (length *hatena-insert-alist*)))
0))
(let ((e (nth *hatena-insert-last-num* lst)))
(save-excursion (insert (car e) "\n"))
;(save-excursion (car e))
(message "~D/~D ~A" (1+ *hatena-insert-last-num*) (length *hatena-insert-alist*)
(cdr e)))))
(global-set-key #\M-3 'hatena-insert)
;;;
;;; trace
;;; http://www.geocities.jp/kiaswebsite/xyzzy/encap.html
; (trace function1 function2 ...) makes the functions `traced'.
; (trace) returns `traced' functions.
; (untrace function1 function2 ...) makes the functions `untraced'.
; (untrace) makes all `traced' functions `untraced'.
(require "encap")
(defvar *trace-function-list* nil)
(defvar *trace-depth* 0)
(defun trace-encap (func)
(unless (encapsulated-p func 'traced-function)
(encapsulate func 'traced-function
`(
;(ed::setup-trace-output-buffer)
(setq *trace-depth* (1+ *trace-depth*))
;(format *error-output* "~ACalling ~S~%" (make-sequence 'string *trace-depth* :initial-element #\SPC) (cons ',func argument-list))
(format t "~ACalling ~S~%" (make-sequence 'string *trace-depth* :initial-element #\SPC) (cons ',func argument-list))
(let ((#1=#:result (multiple-value-list (apply basic-definition argument-list))))
;(format *error-output* "~A~S returned~{ ~A~}~%" (make-sequence 'string *trace-depth* :initial-element #\SPC) ',func #1#)
(format t "~A~S returned~{ ~A~}~%" (make-sequence 'string *trace-depth* :initial-element #\SPC) ',func #1#)
(setq *trace-depth* (1- *trace-depth*))
(values-list #1#))))
(push func *trace-function-list*)
func))
(defun trace-unencap (func)
(when (encapsulated-p func 'traced-function)
(unencapsulate func 'traced-function)
(setq *trace-function-list* (remove func *trace-function-list* :test #'eq))
func))
(defmacro trace (&rest args)
(setq *trace-depth* 0) ; add
(if (null args)
'*trace-function-list*
`(let (lst)
(dolist (func ',args (reverse lst))
(when (trace-encap func)
(setq lst (cons func lst)))))))
(defmacro untrace (&rest args)
(if (null args)
'(let (lst)
(dolist (func *trace-function-list* lst)
(when (trace-unencap func)
(setq lst (cons func lst)))))
`(let (lst)
(dolist (func ',args (reverse lst))
(when (trace-unencap func)
(setq lst (cons func lst)))))))
;;;
;;; 行を複製(二重化)する
;;;
(defun replica-line ()
(interactive "*")
(save-excursion
(insert (buffer-substring (progn (goto-eol) (point))
(progn (goto-bol) (point))))
(newline)))
(global-set-key #\M-\= 'replica-line)
;;;
;;; windows のクリップボードと kill-ring を同期させる
;;;
;;synclonize clipboad and kill-ring
(defun copy-selection-region-to-clipboard ()
(interactive)
(setq is-selected nil)
(if (and *shodat-copy-mode*
(pre-selection-p))
(let ((type (get-selection-type)))
(selection-start-end (start end)
(copy-region-as-kill start end)
(copy-region-to-clipboard start end)
(setq is-selected t)
(start-selection type t end)))
(selection-start-end (start end)
(copy-region-as-kill start end)
(copy-region-to-clipboard start end)
(setq is-selected t)))
(if (eq is-selected nil)
(progn
(copy-region-as-kill (mark) (point))
(copy-region-to-clipboard (mark) (point))))
t)
(defun kill-selection-region-to-clipboard ()
(interactive "*")
(setq is-selected nil)
(selection-start-end (start end)
(copy-region-as-kill start end)
(kill-region-to-clipboard start end)
(setq is-selected t))
(if (eq is-selected nil)
(progn
(copy-region-as-kill (mark) (point))
(kill-region-to-clipboard (mark) (point))))
t)
(defun kill-line-to-clipboard ()
"kill line to clipboard"
(interactive)
(setq kill-line-to-clipboard-start (point))
(end-of-line)
(if (eq kill-line-to-clipboard-start (point))
(delete-char)
(progn
(copy-region-as-kill kill-line-to-clipboard-start (point))
(kill-region-to-clipboard kill-line-to-clipboard-start (point)))))
(define-key *global-keymap* #\C-w 'kill-selection-region-to-clipboard )
(define-key *global-keymap* #\M-w 'copy-selection-region-to-clipboard )
(define-key *global-keymap* #\C-y 'paste-from-clipboard )
(define-key *global-keymap* #\C-k 'kill-line-to-clipboard )
;;;
;;; M-x help でリファレンスを開く
;;;
(defun help ()
(interactive)
(let ((chm "reference.chm"))
(shell-execute (concat (si::system-root) "etc/" chm))))
;;;
;;; execute-extended-command
;;; http://d.hatena.ne.jp/x68kace/20080317/p2
; M-x で入力したコマンドにショートカットキーがあれば教える
(defun execute-extended-command (command &optional raw arg)
(interactive "0CM-x: \nP\np")
(let ((*prefix-args* raw)
(*prefix-value* arg))
(setq *last-complex-command* nil)
(setq *this-command* command)
(command-execute command (and (interactive-p)
(not *executing-macro*)
#'ed::record-complex-command))
;ここから上書き
(let ((global (command-keys command *global-keymap* nil))
(local (command-keys command *global-keymap* (local-keymap)))
(minor (command-keys command *global-keymap* (local-keymap) (minor-mode-map))))
(when minor
(message "You can run the command '~A' with ~S (~A)"
command
(key-to-string (car minor))
(cond (global "global")
(local "local")
(t "minor")))
(sit-for 3)))))
;;;
;;; comment-line-and-next-line
;;;
(require "comment")
;; http://hie.s64.xrea.com/xyzzy/note/edit.html#toggle-one-line-comment
(defvar *one-line-comment-alist*
'((awk-mode . ("#"))
(css-mode . ("/* " " */"))
(c-mode . ("/* " " */")) ; mod
(html+-mode . (""))
(lisp-mode . (";"))
(lisp-interaction-mode . (";"))
(perl-mode . ("#"))
(php-mode . ("//"))
(sql-mode . ("--"))))
(defun toggle-one-line-comment ()
; (interactive) ; mod
(let ((li (cdr (assoc buffer-mode *one-line-comment-alist*)))
bol eol str keyreg)
(when li
(save-excursion
(goto-eol)
(setq eol (point))
(back-to-indentation)
(setq bol (point))
(setq str (buffer-substring bol eol))
(if (= (length li) 1)
(let ((key (car li)))
(setq keyreg (format nil "^~A+[ \t]*" (regexp-quote key)))
(if (string-match keyreg str)
(delete-region (+ bol (match-beginning 0))
(+ bol (match-end 0)))
(progn
(back-to-indentation) (insert key))))
(let ((key1 (car li))
(key2 (cadr li)))
(setq keyreg (format nil
"^\\(~A\\)+[ \t]*\\(.*\\)[ \t]*\\(~A\\)+$"
(regexp-quote key1)
(regexp-quote key2)))
(if (string-match keyreg str)
(progn
(setq str (string-replace-match str "\\2"))
(delete-region (+ bol (match-beginning 0))
(+ bol (match-end 0)))
(insert str))
(progn
(back-to-indentation) (insert key1)
(goto-eol) (insert key2)))))))))
;; add
(defun comment-line-and-next-line ()
(interactive)
(toggle-one-line-comment)
(next-line))
(global-set-key #\M-\; 'comment-line-and-next-line)
;;;
;;; indent-for-comment-gnrr
;;;
(defun indent-for-comment-gnrr (&optional arg)
(interactive "p")
(if arg
;; set-comment-column
(let ((col (current-column)))
(setq comment-column col)
(message "set comment-column to ~D." col))
(indent-for-comment)))
(global-set-key #\C-\; 'indent-for-comment-gnrr)
;;;
;;; isearch-forward-gnrr
;;; use regexp or fixed string in isearch
;;;
(defun isearch-forward-gnrr (&optional re)
(interactive "p")
(setq *isearch-scanner-hook* #'(lambda (p) (setq ed::*isearch-regexp* (if re t nil)) p))
(call-interactively 'isearch-forward))
(defun isearch-backward-gnrr (&optional re)
(interactive "p")
(setq *isearch-scanner-hook* #'(lambda (p) (setq ed::*isearch-regexp* (if re t nil)) p))
(call-interactively 'isearch-backward))
(global-set-key #\C-s 'isearch-forward-gnrr)
(global-set-key #\C-r 'isearch-backward-gnrr)
;;; use regexp or fixed string in query-replace
(defun query-replace-gnrr (&optional re)
(interactive "p")
(if re
(call-interactively 'query-replace-regexp)
(call-interactively 'query-replace)))
(global-set-key #\M-% 'query-replace-gnrr)
;;;
;;; ミニバッファに入ったとき IME を OFF にする
;;;
(export '(*ime-mode-into-minibuffer*))
(defvar *ime-mode-into-minibuffer* nil)
(defun ime-state-get-and-setoff (bef-buffer file-name)
(interactive)
(setq *ime-mode-into-minibuffer* (get-ime-mode))
(toggle-ime nil))
(defun ime-state-set (bef-buffer file-name)
(interactive)
(toggle-ime *ime-mode-into-minibuffer*))
(add-hook '*enter-minibuffer-hook* 'ime-state-get-and-setoff)
(add-hook '*exit-minibuffer-hook* 'ime-state-set)
;;;
;;; find-file-frequently
;;;
(defvar *find-file-frequently-list* '((merge-pathnames ".xyzzy" (user-homedir-pathname))
(append-trail-slash (path-delim-to-slash (get-special-folder-location :desktop)))
(default-directory)))
(defvar *find-file-frequently-count* 0)
(add-hook '*enter-minibuffer-hook*
#'(lambda (buf his)
(setq *find-file-frequently-count* 0)))
(defun find-file-frequently-sort-function (x y)
(cond ((and (not (file-directory-p x)) (file-directory-p y)) t)
((and (file-directory-p x) (not (file-directory-p y))) nil)
(t (string-length-lessp x y))))
(defun find-file-frequently ()
(interactive)
(let ((old (buffer-substring (point-min) (point-max)))
(lst (mapcar #'truename-mod (mapcar #'eval *find-file-frequently-list*))))
(let ((s (nth (mod *find-file-frequently-count* (length lst))
(sort lst #'find-file-frequently-sort-function))))
(if (or (string= s old)
(find s (mapcar #'get-buffer-file-name (buffer-list)) :test 'string=))
(progn
(incf *find-file-frequently-count*)
(find-file-frequently))
(progn
(delete-region (point-min) (point-max))
(insert s)
(incf *find-file-frequently-count*))))))
(define-key ed::minibuffer-local-completion-map #\C-\f #'(lambda () (interactive)
(if (= (point) (point-max))
(find-file-frequently)
(forward-char 1))))
(setq *find-file-frequently-list* (append *find-file-frequently-list*
'("~/lisp/")))
;;;
;;; my-just-one-space
;;;
(defvar my-just-one-space-state t)
(make-local-variable 'my-just-one-space-state)
(defun my-just-one-space ()
(interactive)
(if (and (eq *last-command* 'my-just-one-space)
(eq my-just-one-space-state nil))
(delete-backward-char 1)
(just-one-space))
(setq my-just-one-space-state (not my-just-one-space-state)))
(global-set-key #\M-SPC 'my-just-one-space)
;;;
;;; kill-buffer-gnrr
;;;
(defun kill-buffer-gnrr ()
(interactive)
(kill-buffer (selected-buffer)))
(global-set-key '(#\C-x #\k) 'kill-buffer-gnrr)
;;;
;;; eval-buffer mod
;;;
(defvar eval-buffer-orig nil)
(unless (functionp eval-buffer-orig)
(setq eval-buffer-orig (function eval-buffer)))
(defun eval-buffer (&optional buf)
(interactive)
(if (interactive-p)
(funcall eval-buffer-orig (selected-buffer))
(funcall eval-buffer-orig buf)))
;(eval-buffer (selected-buffer)) と書かれてるバッファで C-j すると無限ループになる
; そんなときは C-g すべし(コメントにしとけば問題なし)
;;;
;;; insert ()
;;;
(defun insert-paired-paren ()
(interactive)
(insert "()")
(forward-char -1))
(global-set-key #\M-9 'insert-paired-paren)
;;;
;;; insert [] or {}
;;;
(defvar *insert-paired-bracket-state* nil)
(defun insert-paired-bracket ()
(interactive)
(let ((br "[]")
(cbr "{}"))
(when (eq *last-command* 'insert-paired-bracket)
(forward-char -1)
(delete-char 2))
(if *insert-paired-bracket-state*
(insert cbr)
(insert br))
(forward-char -1))
(setq *insert-paired-bracket-state* (not *insert-paired-bracket-state*)))
(global-set-key #\M-\[ 'insert-paired-bracket)
;;;
;;; insert '' or ""
;;;
(defvar *insert-paired-quote-state* nil)
(defun insert-paired-quote ()
(interactive)
(let ((sq "\'\'")
(dq"\"\""))
(when (eq *last-command* 'insert-paired-quote)
(forward-char -1)
(delete-char 2))
(if *insert-paired-quote-state*
(insert dq)
(insert sq))
(forward-char -1))
(setq *insert-paired-quote-state* (not *insert-paired-quote-state*)))
(global-set-key #\M-\' 'insert-paired-quote)
;;;
;;; jump-to-paren
;;;
(defun jump-to-paren ()
"jump to the matching parenthesis if on parenthesis."
(interactive)
(cond ((looking-at "[([{]") (forward-sexp 1))
((save-excursion
(forward-char -1)
(looking-at "[])}]")) (backward-sexp 1))
((looking-at "[])}]") (forward-char) (backward-sexp 1))
(t nil)))
(global-set-key #\M-\] 'jump-to-paren)
;;;
;;; undo-redo
;;;
(defun undo-redo-gnrr (&optional arg)
(interactive "p")
(if arg
(redo)
(undo)))
(global-set-key #\C-z 'undo-redo-gnrr)
;;;
;;; save-buffer-gnrr
;;;
(defun write-file-tmp (fn)
(interactive "FWrite: "
(substitute-string (buffer-name (selected-buffer)) "[* ]" "") "_"))
(write-file fn))
(defun save-buffer-gnrr ()
(interactive)
(if (get-buffer-file-name)
(call-interactively 'save-buffer)
(call-interactively 'write-file-tmp)))
(global-set-key '(#\C-x #\C-\s) 'save-buffer-gnrr)
;;; discrete.l ends here
