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

○ ねたー

午前中の子ども会の映画鑑賞会も午後の野球の練習もやらないとまずい仕事もすべてすっぽかして、ただひたすら寝た。こんなに寝たのすごい久しぶりなんだけど、すでにもう眠いので寝る。やっぱ、そうとう疲れがたまっているのだろう (21:30)。

○ 水鏡

小松君が教えてくれた。よく見たら更新履歴に『空白による入力区切りの追加』と書いてあったよ。

(suikyo-convert-romaji-kana "shin")  => "しn"
(suikyo-convert-romaji-kana "shin ") => "しん"
(suikyo-convert-kana-romaji "しんいち")  => "sin'iち"
(suikyo-convert-kana-romaji "しんいち ") => "sin'iti"
(suikyo-convert-romaji-kana "shin ichi") => "しんいち"

○ ローマ字入力

POBOX を使い出したときも思ったのだけど、訓令式でもヘボン式でもない昔からの変な癖を直して素直な入力にしたいな、とまた思った。おそらく訓令式にするのがいいと思うのだけど、「shi」だけは譲れないなぁ。

○ 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 ではうごきません。

○ そうです

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