猫熊は燃えつきた？！日記

○ 明けまししておめでとうございます

今年も忙しそうだなぁ ;_;

○ いかん

新年早々 typo っていた ^^;;

○ 異物

SL-C3000 のACアダプタジャックだが、LED ライトで照らしつつ拡大鏡などを駆使してみたところ、やっぱり、奥深くにジャックの先っぽのプラスチック部品が残ったままでであった。

30分程格闘してみたが、まったく取れそうもない。うーーむ。

今考えているのは、そのままの形では♀ジャック内部のばねででないので、なんとか切り分けていくつかの部分にして取り出せないか？である。なので OpenBlockS どころではなくなってしまった。

○ お正月終了

うーーん、明日明後日と二日休むと三連休と合わせて、超大型正月休みになるのだけど、さすがに無理だよな。ははは。

○ 都会犬？ダン

2日に千葉県大原の女房の実家に家族四人 + ダンで行った。別にど田舎というわけじゃないのだけど、ほんのちょっとだけ山の方。

で、夜のダンの散歩のときのことだが、灯の無い所にさしかかると、まったくダンが動かなくなる。そして、じーーと、暗い方を見て、

『ぼく、そんな恐そうなところ絶対行かないもんね』

といった感じ。じゃぁ、というので、一度実家の前まで戻って、逆方向に行こうと思ったら、あっという間に玄関までにまで入って行ってしまった。

単に暗いところがこわかったのか、それとも、物の怪のたぐいでもいたのか？

○ 正月のテレビ

えーーとまじめに見たのは八犬伝と忍者ハットリくんかぐらいか。以下、家庭内の勝手な感想。

• 八房が出てこないのに八犬士は変だ。八房出せ〜〜！犬出せ〜〜〜！！
• 仲間ゆきえさんより菅野美穂さんの方がきれいだ。配役逆がいいぞー(異論もあり)
• 滝沢くんは良いとして、他の人殺陣下手すぎだぁ。特に坊さんだめ
• 忍者ハットリくんってもともと実写なんだぞ。パパはアニメのハットリくんなんて知らないぞ。
• オハー、って何年前だっけ？
• 西遊記、面白そう。(けど、主題歌が違う。。。)

○ 仕事始め

で、会社に行ったら、ジャックの先っぽのプラスチック部品の無い ACアダプタがありましたよ。そいつで試したところショートもせずに充電開始 :-)

また、会社の知合いで同じ境遇に何回もあった奴に、いろいろと技を聞いてきた。その匠の技を試してみてだめだったら、保証期間内だし素直に修理に出しましょ。

○ 続 予測変換な Tamago

POBOX server で予測変換風味を加えた egg-pobox.el を若干手直しをした。興味のある方はこちらからどーぞ。ちなみに、egg-remix 必須です。

○ 予測変換な Tamago の悩み

egg-pobox で悩んでいる話。egg-remix 使っていると、英単語をそのまま打てるのだけど、英単語も日本語の単語をきちんと扱う(正規化したり、かなをローマ字に戻したりする)ために導入してある suikyo を通ってしまう。たとえば、一回 "buffer" って打つおくと、次に "buffer" って打つと、ちゃんと "buffer" が候補に出るのだけど、suikyo を通るために

  (suikyo-convert-romaji-refine "buffer") => "buhhuxer"

こんな謎の読み方で "buffer" が登録されてしまうのだ。"buffer" で "buffer" を登録するのは簡単だ(と思うのだ)けど、今度は、候補リストを出すときの日本語？英語？判定が出来ないしなぁ〜〜。
といったところで、まだまだ続きそう。

○ 続々予測変換な Tamago

とりあえず満足かなぁ。

• 結局、buffer と buhhuxer と両方引いて、マージしたものを候補リストに出すようにした。
• いろんなところに input-pending-p() を入れたり、PBSERVER との通信の終了判定を変えたりして、速く入力したときや PBSERVER が遅いときも待たされないようにした(つもり)

PBSERVER の辞書として "words" 相当を入れておくと、look の代わりになってよいかも。ぼくは、昔 Palm 向けに作った大富豪辞書＋英単語 を staticdic で使うようにしてみた。

○ 失敗

Zaurus の ACコネクタ内の先っぽのプラスチック部品取り出しで、匠の技に挑戦したのだが、あっさり失敗。

保証書/レシート関係を調べたところ保証期間は 5月12日までだから、それまでには修理に出そうっと。とりあえずやることは、SL-C860 の現役復帰かな。って、860 も 3000 もユーザ登録してないじゃんか。(問題ないかな)

○ 予測変換な Tamago Final

"M-数字"、"C-数字" で候補を選択という方法だけだと、結構選択しづらい、ということがわかったので、新たなインターフェースを増やした。これで本当にファイナルか？
というわけで egg-pobox.el をどうぞ。
使用説明をソースからそのまま載せると

;; POBOX server を利用した egg-remix の簡易予測変換拡張。
;;
;; 以下のものが (egg v4 以外に) 必須
;; POBoxサーバ		http://pitecan.com/OpenPOBox/server/index.html
;; suikyo (elisp)	http://taiyaki.org/suikyo/
;; egg-remix		http://www.extipl.jp/~payashi/remix/
;;                      [重要] egg-remix を利用していないときは動作しません
;;
;; 設定
;; ~/.emacs に
;; (require 'egg-remix)
;; (require 'egg-pobox)
;;
;; お好みで
;; (setq egg-pobox-server "localhost") ;; pbserver のホスト名
;; (setq egg-pobox-server-port 1178)   ;; 上記のポート番号
;; (setq egg-pobox-type 'inline)       ;; 表示の選択。 inline か minibuffer。
;;                                     ;; nil だと egg-pobox の機能を使わない
;; (setq egg-pobox-active-list '("japanese-egg-anthy" ;; egg-pobox を有効にする
;;				 "japanese-egg-wnn")  ;; input method を指定する。
;;
;; 使い方 (POBOX の候補の選択方法)
;; (1) 候補リストが出ているときに C-1, C-2, ... , C-0 or M-1, M-2, ..., M-0 を押すと、
;;     その数字の候補で即座に確定する。
;;
;; (2) 候補リストが出ているときに C-i, M-i を押すと、候補リストのポインタが動くので、
;;     その状態で C-m を押すと確定する。TAB, C-u TAB でもオッケー。
;;     C-m 以外のキーだと継続して入力可能。
;;
;; Tips
;; (1) egg-pobox 付きと無しの egg-anthy を使い分けたいときは、
;;
;;   (register-input-method
;;    "japanese-egg-anthy-pobox" "Japanese" 'egg-activate-anthy
;;    "あ.."  "Romaji -> Hiragana -> Kanji&Kana"
;;    'its-select-hiragana)
;;
;;   (setq egg-pobox-active-list '("japanese-egg-anthy-pobox"))
;;
;;   とかしておいて、C-u C-\ で切替えるべし。
;;
;; (2) POBOX の辞書として、etc/words を変換したものを使えば、
;;     look の代わりになって便利かも。

でございます。

○ でへへ

というかめちゃくちゃ弱気なのだが、会社にごろごろしている ACアダプタをひとつジャックの先っぽのプラスチック部品の無い ACアダプタ状態にして、ACアダプタを持ち歩かなくても家と会社とどちらででも充電できるようにしてしまった。

このまま SL-C860 にもプラスチック部品を埋め込めば、個人的には何も問題ないかも ^^;;;

○ dird から gpg.el

今日の小ネタということで、dired から gpg.el を使って、暗号化/平文化するものを作ってみた。

 (defvar gpg-file-cache-time 1 "*Minute of alive time of passphase.")
 
 (add-hook 'dired-mode-hook
 	  (lambda ()
 	    (define-key dired-mode-map "\C-cg" 'dired-do-gpg)))
 
 (defun dired-do-gpg ()
   (interactive)
   (let (files)
     (dired-map-over-marks-check
      (lambda ()
        (setq files (cons (dired-get-filename) files))
        nil)
      nil 'GPG nil)
     (if (not files)
 	(message "No files")
       (while files
 	(gpg-file (car files))
 	(setq files (cdr files)))
       (revert-buffer))))
 
 (defvar gpg-file-buffer-kill-timer nil)
 
 (defun gpg-file (&optional file)
   (interactive)
   (require 'gpg)
   (when gpg-file-buffer-kill-timer
     (cancel-timer gpg-file-buffer-kill-timer)
     (setq gpg-file-buffer-kill-timer nil))
   (setq file (expand-file-name (or file (read-file-name "File: " ))))
   (let ((buf (get-buffer-create " *gpg-tmp*"))
 	dec gfile pro)
     (when (string-match gpg-regex-suffix file)
       (setq file (substring file 0 (match-beginning 0)))
       (setq dec t))
     (setq gfile (concat file ".gpg"))
     (cond
      ((and (not dec)
 	   (not (and (file-exists-p file)
 		     (file-readable-p file)
 		     (file-writable-p gfile))))
       (message "%s can not gpg" file))
      ((and dec
 	   (not (and (file-exists-p gfile)
 		     (file-readable-p gfile)
 		     (file-writable-p file))))
       (message "%s can not gpg" file))
      ((or (file-directory-p file) (file-directory-p gfile))
       (message "%s is directory" file))
      (t
       (when (interactive-p)
 	(message "%s %s..." (if dec "decryption" "encryption") file))
       (if dec
 	  (if (file-exists-p file) (delete-file file))
 	(if (file-exists-p gfile) (delete-file gfile)))
       (save-excursion
 	(set-buffer buf)
 	(setq pro
 	      (if dec
 		  (setq pro (gpg-start-process gpg-process-decryption buf gpg-program
 					       "-d" "--yes" "--output" file gfile))
 		(gpg-start-process gpg-process-encryption buf gpg-program
 				   "-c" "--cipher-algo" gpg-cipher
 				   "--yes" "--output" gfile file)))
 	(set-process-filter   pro 'gpg-filter)
 	(set-process-sentinel pro 'gpg-sentinel)
 	(setq gpg-rendezvous t)
 	(while gpg-rendezvous
 	  (sit-for 0.1)
 	  (discard-input))
 	(when (and (file-exists-p file) (file-exists-p gfile))
 	  (if dec
 	      (delete-file gfile)
 	    (delete-file file)))
 	(setq gpg-file-buffer-kill-timer
 	      (run-at-time (* gpg-file-cache-time 60) nil 'gpg-file-buffer-kill))
 	(when (interactive-p)
 	  (message "%s %s...done" (if dec "decryption" "encryption") file)))))))
       
 (defun gpg-file-buffer-kill ()
   (when gpg-file-buffer-kill-timer
     (cancel-timer gpg-file-buffer-kill-timer)
     (setq gpg-file-buffer-kill-timer nil))
   (let ((buf " *gpg-tmp*"))
     (if (and buf (get-buffer buf)) (kill-buffer buf))))

○ 使い方

M-x gpg-file しても良いし、dired で "C-cg" しても良い。指定したファイル名に ".gpg" という suffix がついていたら平文化するし、なければ暗号化する。

デフォルトだと一分間 passphrase を覚えているが、覚えている間は全部同じ passphrase を使って暗号化/平文化を行なうのがちょっと弱い。

○ egg-pobox Zaurus 向けパッケージ

丸山さんちで、egg-pobox 関連が全部揃うようになっている。素早い。
これから egg-pobox.el を変えるときは、ちゃんと考えてからやらないと ^^;;;

○ tramp な gpg.el

森島さんからつっこみをいただいた。
確かに gpg.el のソースを読むと(実験してもだけど)全然ダメですね。うーーむ、手元では

(defvar gpg-work-directory (expand-file-name "~/.gpg.work")
  "*Work directory of GPG.")
 
(defalias 'gpg-make-temp-file1
  (if (fboundp 'make-temp-file) 'make-temp-file 'make-temp-name))
 
(defun gpg-make-temp-file (file)
  (cond
   ((and (file-exists-p gpg-work-directory)
	 (file-directory-p gpg-work-directory))
    (set-file-modes gpg-work-directory ?\700))
   ((not (file-exists-p gpg-work-directory))
    (make-directory gpg-work-directory)
    (set-file-modes gpg-work-directory ?\700))
   ((and (file-exists-p gpg-work-directory)
	 (file-writable-p gpg-work-directory)
	 (y-or-n-p (format "%s is not directory. Remove it? " gpg-work-directory)))
    (delete-file gpg-work-directory)
    (make-directory gpg-work-directory)
    (set-file-modes gpg-work-directory ?\700))
   (t
    (error (format "%s has something error" gpg-work-directory))))
  (gpg-make-temp-file1 (expand-file-name (file-name-nondirectory file)
					 gpg-work-directory)))

こんなことをやりつつ、他のリモートファイルもケアして、gpg.el の機能や gpg for Dired が tramp 経由でも動くようにしてみたけど、もうちょっといろいろやらないと公開できないなぁ。

○ 西遊記

先週の分を昨日ビデオで見た。いけないことだとは知りながら、ついつい昔の西遊記と比較してしまうのだが、それでもまぁまぁ満足。深津絵里さんを夏目雅子さんと比較してしまうのは可愛そうだから、まぁ、しょうがないが、猪八戒はやっぱり小太りの人がやった方が良いと思うぞ。いまなら、ホンジャマカの石塚あたりかな？あと、白馬がいないといざというときに竜が出てこれないなぁ。

悟空と沙悟浄は良いね。

○ 出張

(これを書いているのは、まだ帰りの飛行機の中だけど)福岡の日帰り出張は疲れるワン。飛行機自体久しぶりだし。

こんなに疲れたのに、たくさ〜〜〜〜〜〜んの宿題が。。。;_;

○ お食事

お昼前に博多に着いた。バスで 10分の本社に入るのは昼すぎでよかったので、お昼ごはんはチェーン店みたいなところで地鶏の塩焼定食。帰りは飛行機の時間まで余裕が 30分と微妙なところだったので、夕飯に博多の地下街の回転寿司。生ビール二杯と高めのお皿ばっかし七皿をぺろ。蛸が美味しかったのよ。ちなみに地鶏の塩焼も 680円という値段を考えるとすさまじくおいしかったのです。

○ モノレール

から C-cC-c。

○ ニコンもコニカもミノルタも。。。

寂しい。。。がんばれペンタックス。

○ Emacs ユーザーの方に質問です。これは便利! と思える elisp プログラムを教えてください。 (人力検索はてな)

前から導入しようとおもっていた color-moccur を入れてみたりした。また、ぼくがいろいろとかかわっていたのも何個かのっていてうれしい限り。

だけど、『人力検索はてな』って初めて知ったりして ^^;;;

○ 匠の技

いつまで経っても ACアダブタのジャックの先っぽが取れないぼくの SL-C3000 だが、昨日、後輩の SL-C3000 にもついに同じことが発生してしまったのだ。
そして、ついに匠が立ち上がった！！。
『白井さん、ちょっと Zaurus 貸してよ』
と言われてから、お昼休みも含むと約二時間後、先っぽのプラスチックチップが取れた！すごい！！ブラボー！！！

○ ファンヒータと犬

うちのダンはファンヒータつけるとこれだもんなぁ。だけど、寒い土手でも元気に走り回っているけどね。明日降るといわれている雪の中で遊ばせるのが楽しみだ。

○ egg-pobox.el

truncate-lines が t のときの候補の一覧表示を失敗していたので、昨日、ちょっとだけ修正しておいた。

が、使ってくださっている人っているのかしら ^^;;;

○ 雪の中のダン

ちょっと遅いネタだけど、東京とは思えませんな。携帯電話のカメラじゃこんなもん。

○ ac-mode

この前のEmacs ユーザーの方に質問です。これは便利!(以下略)で ac-mode を使いはじめてみた。従来からインストールはしてあったのだけど、全然使ったことなかった。さすがに、C-i が取られちゃうと、indent が大変なので、key bind を変えたりしていたら、一個バグを見付けてしまった。

一ヶ所だけある meassage() に "%任意の文字" が渡るとエラーになる。適当に princ() にしてしまったのよ。

もう一点、日本語の後にすぐ ascii がつながっているときの ac-dabbrev-completion() はちょっとだめだな。あとで、考えてみよう。

○ もう一丁 ac-mode

わざわざ ~/urls.txt というファイルを用意するのはいやなので、w3m の history を使うようにしてみた。(以下、都合によりすべて書き換え。

(defun url-complete ()
  (interactive)
  (save-excursion
    (let ((begin (point))
	  (buf (get-buffer url-complete--buffer))
	  (url-regexp (concat "[" ac-mode-url-char "]+"))
	  match-url match-region comp w3m)
      (when (and (< (skip-chars-backward ac-mode-url-char) 0)
		 (or (looking-at "https?:")
		     (looking-at "ftp:"))
		 (file-exists-p ac-mode-url-file))
	(re-search-forward url-regexp begin t)
	(setq match-url (match-string 0))
	(setq match-data
	      (list (match-string 0) (match-beginning 0) (match-end 0)
		    (ac-point-at-eow url-regexp)))
	(set-buffer url-complete--buffer)
	(erase-buffer)
	(call-process "look" nil url-complete--buffer nil match-url
		      (expand-file-name ac-mode-url-file))
	(and (or (featurep 'w3m) (require 'w3m))
	     (boundp 'w3m-input-url-history)
	     (not w3m-input-url-history)
	     (w3m-arrived-setup))
	(setq w3m (boundp 'w3m-input-url-history))
	(let* ((line1 (progn (goto-char (point-min))
			     (when (re-search-forward "^.+$" nil t)
			       (list (match-string 0)))))
	       (line2 (progn (goto-char (point-max))
			     (when (re-search-backward "^.+$" nil t)
			       (list (match-string 0)))))
	       (comp (when (and line1 line2)
		       (try-completion match-url (list line1 line2))))
	       (w3mcomp (when w3m
			  (try-completion match-url w3m-input-url-history)))
	       (w3mall (when w3m
			 (all-completions match-url w3m-input-url-history nil 'nospace))))
	  (cond ((and (stringp comp) (string-lessp match-url comp))
		 (list match-data comp))
		((and (stringp w3mcomp) (string-lessp match-url w3mcomp))
		 (list match-data w3mcomp))
		(t
		 (cons match-data (nconc (split-string (buffer-string))
					 w3mall)))))))))

今までの urls.txt が優先で、その後に w3m の history が出てくる。urls.txt は空でも良いので用意しておかないとだめ。

○ いろんな complete

現在使っている complete 関係の関数と key bind は

• M-C-i => 普通？の complete
• M-/ => dabbrev-expand
• C-x9i => hippie-expand
• M-] => ac-complete
• M-' => migemo-dabbrev-expand

とあいなりました。他にもあるかも。普段は最初の三つぐらいしか使わないような気がするけど、url-complete() 改造版は結構便利かもです。

○ ac-mode じゃなくて hippie-expand 採用

ac-mode を改造したばかりだが、ちょっと限界を感じて hippie-expand の拡張に方向転換してみた。もともと、hippie-expand はファイル名の補完で愛用していたのだ。

• migemo-dabbrev-expand の日本語専用簡易版の try-expand-migemo
• urls.txt または w3m の history arrived-db で補完する try-complete-url
• URL 補完専用のでっちあげ コマンド hippie-expand-url
• ついでに、土屋くんの 光る dabbrev のところに書いてある追加設定の hippie-dabbrev版

といったところ

  (defadvice he-dabbrev-beg
    (around modify-regexp-for-japanese activate compile)
    "Dynamically for Japanese words."
    (if (bobp)
	ad-do-it
      (when hippie-expand-dabbrev-skip-space
	(skip-syntax-backward ". "))
      (let ((char-regexp
	     (let ((c (char-category-set (char-before))))
	       (cond
		((aref c ?a) "[-_A-Za-z0-9]")	; ASCII
		((aref c ?j)			; Japanese
		 (cond
		  ((aref c ?K) "\\cK")	; katakana
		  ((aref c ?A) "\\cA")	; 2byte alphanumeric
		  ((aref c ?H) "\\cH")	; hiragana
		  ((aref c ?C) "\\cC")	; kanji
		  (t "\\cj")))
		((aref c ?k) "\\ck")	; hankaku-kana
		((aref c ?r) "\\cr")	; Japanese roman ?
		(t "[-a-zA-Z0-9_]")))))
	(save-excursion
	  (when (> (point) (minibuffer-prompt-end))
	    (forward-char -1)
	    (while (and (looking-at char-regexp)
			(> (point) (minibuffer-prompt-end))
			(not (= (point) (field-beginning (point) nil
							 (1- (point))))))
	      (forward-char -1))
	    (or (looking-at char-regexp)
		(forward-char 1)))
	  (setq ad-return-value (point))))))
  
  (define-key esc-map "]" 'hippie-expand-url)
  
  (defun hippie-expand-url ()
    "Hipppie の URL 専用補完コマンド"
    (interactive)
    (let ((hippie-expand-try-functions-list '(try-complete-url)))
      (hippie-expand nil)))
  
  (defcustom try-complete-url-file "~/urls.txt"
    "*File name of URLs."
    :type '(choice (file :tag "URLs file")
		   (const :tag "No use" nil))
    :group 'hippie-expand)
  
  (setq hippie-expand-try-functions-list
	'(try-complete-file-name-partially
	  try-complete-file-name
	  try-expand-all-abbrevs
	  try-expand-list
	  try-expand-line
	  try-expand-dabbrev
	  ;; このあたりが良いような気がするが好みの順番で挿入
	  try-expand-migemo ;; これと
	  try-complete-url  ;; これ
	  try-expand-dabbrev-all-buffers
	  try-expand-dabbrev-from-kill
	  try-complete-lisp-symbol-partially
	  try-complete-lisp-symbol))
  
  (defvar try-complete-url-buffer " *url complete*")
  
  (defun he-url-beg ()
    (or (featurep 'ffap) (require 'ffap))
    (save-excursion
      (when hippie-expand-dabbrev-skip-space
	(skip-syntax-backward ". "))
      (ffap-string-at-point 'url)
      (car ffap-string-at-point-region)))
  
  (defun try-complete-url (old)
    "Try to complete word as URL from file and `w3m-input-url-history'.
The argument OLD has to be nil the first call of this function, and t
for subsequent calls (for further possible completions of the same
string).  It returns t if a new completion is found, nil otherwise."
    (unless old
      (he-init-string (he-url-beg) (point))
      (if (not (he-string-member he-search-string he-tried-table))
	  (setq he-tried-table (cons he-search-string he-tried-table)))
      (setq he-expand-list
	    (and (not (equal he-search-string ""))
		 (try-complete-url-1 he-search-string))))
    (while (and he-expand-list
		(he-string-member (car he-expand-list) he-tried-table))
      (setq he-expand-list (cdr he-expand-list)))
    (if (null he-expand-list)
	(progn
	  (if old (he-reset-string))
	  ())
      (progn
	(he-substitute-string (car he-expand-list))
	(setq he-expand-list (cdr he-expand-list))
	t)))
  
  (defun try-complete-url-1 (url)
    (save-excursion
      (let (buf comp w3m w3mbook w3mcomp)
	(when (and try-complete-url-file
		   (file-readable-p try-complete-url-file)
		   (or (executable-find "look")
		       (executable-find "look.exe")))
	  (setq buf (get-buffer-create try-complete-url-buffer))
	  (set-buffer buf)
	  (erase-buffer)
	  (call-process "look" nil buf nil url
			(expand-file-name try-complete-url-file))
	  (sort-lines nil (point-min) (point-max))
	  (setq comp (split-string (buffer-string))))
	(condition-case nil
	    (and (or (featurep 'w3m-bookmark) (require 'w3m-bookmark))
		 (not w3m-arrived-db)
		 (w3m-arrived-setup))
	  (error nil))
	(when (fboundp 'w3m-bookmark-iterator)
	  (setq w3mbook (let ((items (w3m-bookmark-iterator))
			      urls)
			  (while items
			    (setq urls (nconc urls (car items)))
			    (setq items (cdr items)))
			  (all-completions url urls))))
	(when (and (boundp 'w3m-arrived-db)
		   w3m-arrived-db)
	  (setq w3mcomp (all-completions url w3m-arrived-db)))
	(nconc comp w3mbook (sort w3mcomp 'string<)))))
  
  (defun he-migemo-search (pattern &optional reverse limit)
    (let (result beg end)
      (while (and (not result)
		  (if reverse
		      (migemo-backward pattern limit t)
		    (migemo-forward pattern limit t)))
	(setq beg (match-beginning 0))
	(goto-char (match-end 0))
	(unless (re-search-forward ".\\>" (line-end-position) t)
	  (end-of-line))
	(setq end (point))
	(if reverse
	    (goto-char beg)
	  (goto-char end))
	(setq result (buffer-substring-no-properties beg end))
	(when (string-match "\\Cj+$" result)
	  (setq result (substring result 0 (match-beginning 0))))
	(when (or (he-string-member result he-tried-table t)
		  (not (string-match "\\cj" result)))
	  (setq result nil))) ; ignore if bad prefix or already in table
      result))
  
  (defun try-expand-migemo (old)
    "Try to complete word with MIGEMO.
The argument OLD has to be nil the first call of this function, and t
for subsequent calls (for further possible expansions of the same
string).  It returns t if a new expansion is found, nil otherwise."
    (when (fboundp 'migemo-get-pattern)
      (let (expansion)
	(unless old
	  (setq migemo-search-pattern-alist nil)
	  (he-init-string (he-dabbrev-beg) (point))
	  (set-marker he-search-loc he-string-beg)
	  (setq he-search-bw t))
	(unless (equal he-search-string "")
	  (save-excursion
	    (save-restriction
	      (when hippie-expand-no-restriction
		(widen))
	      ;; Try looking backward unless inhibited.
	      (when he-search-bw
		(goto-char he-search-loc)
		(setq expansion
		      (he-migemo-search he-search-string t))
		(set-marker he-search-loc (point))
		(if (not expansion)
		    (progn
		      (set-marker he-search-loc he-string-end)
		      (setq he-search-bw nil))))
	      (unless expansion		; Then look forward.
		(goto-char he-search-loc)
		(setq expansion (he-migemo-search he-search-string nil))
		(set-marker he-search-loc (point))))))
	(if (not expansion)
	    (progn
	      (if old (he-reset-string))
	      ())
	  (progn
	    (he-substitute-string expansion t)
	    t)))))

2006年01月26日(木) 追記: try-complete-url-1() で w3m の bookmark も補完対象にしてみた。

○ いろんな complete その二

現在使っている complete 関係の関数と key bind は

• M-C-i => 普通？の complete
• M-/ => 光る dabbrev-expand
• M-C-/ => hippie-expand (高機能だし。こっちも bind していたりした)
• M-] => (でっちあげ) hippie-expand-url
• M-' => migemo-dabbrev-expand (光る)

とあいなりました。普通の dabbrev-expand は使わないで hippie-expand だけにしても良いけど光らないからね。光るようにしちゃっても良いのだけど。^^;;;

○ 光る hippie-expand

元祖 光る dabbrev 作成者としては、やっぱり光らせたいので、try-expand-dabbrev, try-expand-dabbrev-all-buffers, try-expand-migemo を光るようにしてみた。土屋くんの 光る dabbrevがないとだめ、というかほとんど一緒 :-)

  (defvar he-dabbrev-highlight-function "")
  
  (let (current-load-list)
    (defadvice try-expand-dabbrev
      (after dabbrev-expand-highlight activate)
      "Advised by he-dabbrev-highlight.
Highlight last expanded string."
      (setq he-dabbrev-highlight-function "dabbrev")
      (he-dabbrev-highlight))
    
    (defadvice try-expand-dabbrev-all-buffers
      (after dabbrev-expand-highlight activate)
      "Advised by he-dabbrev-highlight.
Highlight last expanded string."
      (setq he-dabbrev-highlight-function "dabbrev-all-buffers")
      (he-dabbrev-highlight))
    
    (defadvice try-expand-migemo
      (after dabbrev-expand-highlight activate)
      "Advised by he-dabbrev-highlight.
Highlight last expanded string."
      (setq he-dabbrev-highlight-function "migemo")
      (he-dabbrev-highlight)))
  
  (defun he-dabbrev-highlight ()
    (when ad-return-value
      (let ((start (marker-position he-search-loc))
	    (len (length (car he-tried-table)))
	    (buf (marker-buffer he-search-loc))
	    (cbuf (current-buffer))
	    end wait)
	(save-selected-window
	  (save-excursion
	    (if (eq buf cbuf)
		(if (> start (point))
		    (setq end start
			  start (- end len))
		  (setq end (+ start len)))
	      (set-buffer buf)
	      (setq end start
		    start (- end len)))
	    (if (and (get-buffer-window buf)
		     (select-window (get-buffer-window buf))
		     (pos-visible-in-window-p start)
		     (pos-visible-in-window-p end))
		(progn
		  ;; Highlight the string used for the last expansion.
		  (if dabbrev-highlight-overlay
		      (move-overlay dabbrev-highlight-overlay start end)
		    (setq dabbrev-highlight-overlay (make-overlay start end)))
		  (overlay-put dabbrev-highlight-overlay
			       'face dabbrev-highlight-face)
		  (add-hook 'pre-command-hook 'dabbrev-highlight-done))
	      (unless (minibufferp cbuf)
		;; Display one-line summary in minibuffer.
		(save-excursion
		  (save-restriction
		    (widen)
		    (goto-char start)
		    (let ((str (buffer-substring-no-properties start end))
			  (bol (progn (forward-line 0) (point)))
			  (eol (progn (end-of-line) (point))))
		      (if (or (featurep 'xemacs)
			      (<= emacs-major-version 20))
			  (setq str (concat " *" str "* "))
			(put-text-property 0 (length str)
					   'face dabbrev-highlight-face str)
			(put-text-property 0 (length he-dabbrev-highlight-function)
					   'face 'bold he-dabbrev-highlight-function))
		      (message "%s: %s(%d): %s%s%s"
			       (format "Using %s" he-dabbrev-highlight-function)
			       (buffer-name buf)
			       (count-lines (point-min) start)
			       (buffer-substring-no-properties bol start)
			       str
			       (buffer-substring-no-properties end eol))
		      (setq wait t))))))))
	(when wait
	  (let ((inhibit-quit t))
	    (sit-for 10)
	    (when quit-flag
	      (setq quit-flag nil)
	      (setq unread-command-events '(7))))))))

sit-for() で逃げてよわーいけど、C-g 対応した。めんどくさいので、XEmacs ではうごきません。

○ そうです

仕事(書類書き ;_;)に疲れてしまって、げんじつとーひをしてしまったのです。

○ hippie-expand のバグ

hippie-expand で遊んでいたら、try-expand-all-abbrevs にバグを見付けてしまった。。。

見付けた者の責任として emacs-pretest-bug にメールを出したが英語苦手。恥ずかしい英文なんだろうな、きっと。

○ tDiary?

なんか最近やたらと time out したり、error が帰ってきたりするのだけど、なんかある？大丈夫？

○ ふーーん

emacs-pretest-bug も member only になったのね。で、モデレート待ち状態。

○ 車のバッテリ

5年も経つし、今年の冬はなんか弱まっているなぁ、という感じだったのだが、女房が一晩ルームランプを付けっぱなしにしてとどめをさしてしまった。

近所の知り合いにエンジンをかけさせてもらって、その足でオートバックスへ。一番お安いランクのバッテリで良かったのだが、同じ容量、大きさのものがなくて、8,500円のノンメンテなものを購入。取り付け工賃ともで 9,000円。貧乏な白井家にとっては痛いかも。

○ ゼブラーマン

近隣の子供会連合(京葉支部という)の映画会で見た。鈴木京香さんは素敵だし、単純に面白かったですよ。だけど、低学年には辛かった模様。

○ お昼寝

寝不足が溜っていたので、その後 14時から 18時まで完璧に昼寝をしてしまった。リビングのマットの上で寝ていたら寒くて、途中 5分程覚醒したときに息子のベッドへ移動。しあわせ。

○ shell-mode

での C-a とか補完がぼろぼろになっていたのが、今日 cvs up したら直っていた。ラッキー。

だけど、ChangeLog を見てもいつどれで直ったのか、全然わからないのですけど。。。^^;;;

○ 小技 その一

mew-dist で konqueror からの mailto インタフェースを書いた。どうやら動いたらしいが、使ったこともないくせに良く書くわ、おいら ^^;;;

(defun konqueror-compose-mail (&optional to subj cc dcc body attach)
  "Interface function of konqueror for `compose-mail'.
call with `(konqueror-compose-mail \"%t\" \"%s\" \"%c\" \"%b\" \"%B\" \"%A\")."
  (interactive)
  (let ((headers '(cc dcc body))
	others)
    (while headers
      (when (eval (car headers))
	(setq others (cons (cons (capitalize (symbol-name (car headers)))
				 (eval (car headers)))
			   others)))
      (setq headers (cdr headers)))
;;    (mew-user-agent-compose to subj others))) ;; <= お好みでこっちでもよい
    (compose-mail to subj others)))

konqueror って コンケラ って読むのね。知らんかった。Mew 以外で使うときは "dcc" を "bcc" にした方が良いのかな？

○ 小技 その二

朝日新聞とか読売新聞のサイトが変わってから emacs-w3m で読みにくくなったので、M-k とすると本文だけ抽出するもの。前から存在していたのだけど、w3m の build 方法？に依存して動いたり動かなかったりするのを直したつもりなので、公開。普段使わないし、従来 M-k に割り当てられていた cookie の編集は M-K へ。

(add-hook 'w3m-mode-hook
	  (lambda ()
	    (define-key w3m-mode-map "\M-k" 'w3m-shimbun-extract)
	    (define-key w3m-mode-map "\M-K" 'w3m-cookie)))
  
(setq w3m-filter-rules
      `(("\\`http://www\\.geocities\\.co\\.jp/"
	 w3m-filter-delete-regions
	 "<DIV ALIGN=CENTER>\n<!--*/GeoGuide/*-->" "<!--*/GeoGuide/*-->\n</DIV>")
	("\\`http://[a-z]+\\.hp\\.infoseek\\.co\\.jp/"
	 w3m-filter-delete-regions
	 "<!-- start AD -->" "<!-- end AD -->")
	("\\`http://linux\\.ascii24\\.com/linux/"
	 w3m-filter-delete-regions
	 "<!-- DAC CHANNEL AD START -->" "<!-- DAC CHANNEL AD END -->")
	("\\`http://www.?\\.asahi\\.com/" w3m-filter-asahi-kiji) ;; 置き換え
	("\\`http://www.?\\.yomiuri\\.co\\.jp/" w3m-filter-yomiuri-kiji))) ;; 追加
  
(defvar w3m-shimbun-extract nil)
  
(defun w3m-filter-asahi-kiji (url)
  "Convert entity reference of UCS."
  (when w3m-use-mule-ucs
    (goto-char (point-min))
    (let ((case-fold-search t)
	  end ucs)
      (while (re-search-forward "alt=\"\\([^\"]+\\)" nil t)
	(goto-char (match-beginning 1))
	(setq end (set-marker (make-marker) (match-end 1)))
	(while (re-search-forward "&#\\([0-9]+\\);" (max end (point)) t)
	  (setq ucs (string-to-number (match-string 1)))
	  (delete-region (match-beginning 0) (match-end 0))
	  (insert-char (w3m-ucs-to-char ucs) 1)))))
  (when (eq w3m-shimbun-extract t)
    (setq w3m-shimbun-extract 'ok)
    (let (start end)
      (goto-char (point-min))
      (when (search-forward "</head>" nil t)
	(setq start (match-end 0))
	(when (search-forward "<div id=\"kijih\">" nil t)
	  (delete-region start (match-beginning 0))
	  (when (and (search-forward "<div class=\"wrapkiji\">" nil t)
		     (search-forward "alt=\"ここから広告です\"" nil t)
		     (search-backward "<" nil t))
	    (setq start (match-beginning 0))
	    (when (search-forward "</body>" nil t)
	      (delete-region start (match-beginning 0)))
	    (goto-char (point-min))
	    (while (re-search-forward "<table [^>]+>" nil t)
	      (delete-region (match-beginning 0) (match-end 0)))
	    (goto-char (point-min))
	    (while (search-forward "</table>" nil t)
	      (delete-region (match-beginning 0) (match-end 0)))))))))
  
(defun w3m-filter-yomiuri-kiji (url)
  "Convert entity reference of UCS."
  (when (eq w3m-shimbun-extract t)
    (setq w3m-shimbun-extract 'ok)
    (let (start end)
      (goto-char (point-min))
      (when (search-forward "</head>" nil t)
	(setq start (match-end 0))
	(when (search-forward "<!--// headline_start //-->" nil t)
	  (delete-region start (match-beginning 0))
	  (when (search-forward "<!--// article_end //-->" nil t)
	    (setq start (match-end 0))
	    (when (search-forward "</body>" nil t)
	      (delete-region start (match-beginning 0)))))))))
  
(defun w3m-shimbun-extract ()
  (interactive)
  (if (not (and w3m-current-url
		(or
		 (string-match "\\`http://[^.]+\\.asahi\\.com/" w3m-current-url)
		 (string-match "\\`http://[^.]+\\.yomiuri\\.co\\.jp/" w3m-current-url))))
      (message "読売新聞と朝日新聞だけよ")
    (setq w3m-shimbun-extract t)
    (w3m-redisplay-this-page)
    (when (eq w3m-shimbun-extract 'ok)
      (goto-char (point-min))
      (forward-line 1))
    (setq w3m-shimbun-extract nil)))

適当なので、だめなときはだめ。sb-asahi|yomiuri の機能を使うと良いかもしれない。

○ とっさに増えた ^^;; 小技その三

最初、上に張った <pre> がぼろぼろでした。

(defun tdiary-pre-conv ()
  (interactive)
  (let (beg end)
    (save-excursion
      (beginning-of-line)
      (cond
       ((looking-at "^<pre>")
	(setq beg (progn (forward-line 1) (point)))
	(re-search-forward "^</pre>")
	(setq end (progn (forward-line -1) (line-end-position))))
       ((looking-at "^</pre>")
	(setq end (progn (forward-line -1) (line-end-position)))
	(re-search-backward "^<pre>")
	(setq beg (progn (forward-line 1) (point))))
       (t
	(re-search-backward "^<pre>")
	(setq beg (progn (forward-line 1) (point)))
	(re-search-forward "^</pre>")
	(setq end (progn (forward-line -1) (line-end-position)))))
      (save-restriction
	(widen)
	(narrow-to-region beg end)
	(goto-char (point-min))
	(while (re-search-forward "^$" nil t)
	  (replace-match "  "))
	(goto-char (point-min))
	(while (search-forward "<" nil t)
	  (replace-match "<"))
	(goto-char (point-min))
	(while (search-forward ">" nil t)
	  (replace-match ">"))
	(goto-char (point-min))))))