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

○ w3m-goto-unseen-buffer

emacs-w3m でまだ読んでいない buffer に一発で飛ぶのが出来なかったような気がするので、quick hack してみた。後半の w3m-goto-buffer() は昔書いたものをちょっとだけ変更。

(unless (featurep 'xemacs)
  (add-hook 'w3m-mode-hook
	    (lambda ()
	      (let ((key1 ?\C-0)
		    (key2 ?\M-0)
		    (ch 0))
		(while (< ch 10)
		  (define-key w3m-mode-map (vector (+ key1 ch)) 'w3m-goto-buffer)
		  (define-key w3m-mode-map (vector (+ key2 ch)) 'w3m-goto-buffer)
		  (setq ch (1+ ch))))
	      (define-key w3m-mode-map "\M-u" 'w3m-goto-unseen-buffer))))
 
(defun w3m-goto-unseen-buffer ()
  "Goto next unseen w3m buffer."
  (interactive)
  (let* ((bufs (w3m-list-buffers))
	 (nowbuf (current-buffer))
	 current unseens0 unseens1 buf)
    (dolist (buf bufs)
      (when (w3m-unseen-buffer-p buf)
	(if current
	    (setq unseens1 (cons buf unseens1))
	  (setq unseens0  (cons buf unseens0))))
      (when (eq nowbuf buf)
	(setq current t)))
    (if unseens1
	(setq buf (car (nreverse unseens1)))
      (setq buf (car (nreverse unseens0))))
    (if buf
	(progn
	  (w3m-history-store-position)
	  (set-window-buffer (selected-window) buf)
	  (run-hooks 'w3m-select-buffer-hook)
	  (w3m-select-buffer-update))
      (message "No unseen buffer."))))
 
(defun w3m-goto-buffer (&optional arg)
  "Goto w3m buffer to accompany inputed numbers like the following,
C-2 => *w3m*<2>
M-0 => *w3m*
12M-3 => *w3m*<123>"
  (interactive "p")
  (let* ((num (+ (- (logand last-command-event ?\177) ?0)
		 (if (not current-prefix-arg)
		     0
		   (* arg 10))))
	 (bufs (w3m-list-buffers))
	 (max (length bufs))
	 buf bufname win)
    (when (>= num 0)
      (setq buf (if (or (= num 0) (> num max))
		    (nth (1- max) bufs)
		  (nth (1- num) bufs)))
      (setq bufname (when (and buf (buffer-live-p buf))
		      (buffer-name buf)))
      (if (not bufname)
	  (message "No exist w3m buffer")
	(cond
	 ((eq major-mode 'w3m-mode)
	  (w3m-history-store-position)
	  (set-window-buffer (selected-window) buf))
	 ((setq win (catch 'win
		      (walk-windows
		       (lambda (w)
			 (save-excursion
			   (set-buffer (window-buffer w))
			   (when (eq major-mode 'w3m-mode)
			     (throw 'win w)))))))
	  (select-window win)
	  (set-window-buffer win buf))
	 (t
	  (pop-to-buffer buf)))
	(w3m-history-restore-position)
	(run-hooks 'w3m-select-buffer-hook)
	(w3m-select-buffer-update)
	(message "Goto w3m buffer \"%s\"" bufname)))))

○ うーむ

ブランクが4年近くあるので、なんだか気に入らないコードだ。。。

○ Twitter

今流行りの Twitter で初めてツィートしてみた。だって、スマートフォン買ったんだもんね。調べたところ、アカウント(ID?)は三年以上前から moepanda でなぜか持っていた。

○ index.rdf

がおかしいよ、という指摘を受けたので 8月の日記を充填してみて挙動を見てみる。

○ 営業職

営業生活一ヶ月。英語全然出来ないのに海外営業一ヶ月。何とか生き延びないとな。

社内のオンラインのアンケートで間違って「技術職」を選択してしまったのは内緒

○ 7月の日記を

一日遅れで。。。

○ 激動！！

まったくもって予想もしていなかった人事移動を今月の前半に言われた。断る正当な理由も無いのでどうしよもなくただひたすら二週間ほど悶々としていただけなのだが、何とかラスト一週間で気持ちを持ち直すことが出来たような感じ。

移動はあるかもなぁ〜とは思っていたのだけど、移動先の部署が想定の範囲を遥かに越えて、ぼくにとっては成層圏まで来たような感じなのよね。

まぁ、何とかするしか無いのだけど、詳細は8月の日記に書くことにしよう。

どっちにしろ、プロの技術者？としての生活は本日を持って終了！！幸せでした！！

○ 車買った

激動！！の前に車を買って、悶々としているときに届いた。買ったといっても、初回登録から六年もたった中古のシエンタ。とはいえ、ボコボコのまま10年乗った車からの乗り換えだと新車のように感じる。

最初から中古車って決めていたのだけど、当たり外れが怖かったので、安心のためにトヨタのディーラーから買った。町の中古車屋さんと比べると、ちょっと高く付くのだけど、綺麗だし、DVDカーナビ付いているし、タイヤ二本の値段で四本買えたし、納車後内装関係でちょっと壊れていたところを発見したら無償で部品変えてくれたし。まぁ満足。前のオーナさんも丁寧に乗っていたようなので、とりあえず、四年は乗ろうっと。けど、各種スポイラーとかは必要なかったかもな。

というわけで、福岡ナンバーでいろいろとスポイラーとかついている白の古めのシエンタ見かけたらよろしく。

○ 最近やったこと

など書いてみる。

○ mew-nmz.el

"kj" とかでオリジナルのメッセージに飛ぶときに、リモートフォルダのファイルでもローカルフォルダ形式のままだったので、ちゃんと "%[Gmail]/すべてのメール" に飛ぶようにした。1年と6ヶ月ぶりのアップデート。

○ egg-anthy

Anthy-dev の MLでちゃんとした typetab ファイルを作っていただいたので対応。
ちなみに、このファイルに登録してあるものしか anthy-dic-tool で扱えず、なおかつ、egg-anthy の単語登録は anthy-dic-tool を使っているのだよ。使用上の注意があるので、以下に README の内容を示しておきます。

5.3 辞書登録機能アップデート
 2010年 6月24日版以降の egg-anthy の辞書登録機能は、Anthy-dev ML で大泉さ
 んが更新した typetab に対応しています。
  
    Subject: [Anthy-dev 3787] Re: anthy-dic-tool
    From: Jun Oizumi <vagus.xyz@xxxxx.xxxx>
    To: Anthyの開発 <anthy-dev@xxxx.xxxx.xxxx>
  
    大泉です。
  
    2010/6/21 Hideyuki SHIRAI :
    > From: NIIBE Yutaka さん曰く
    [...]
    >> となります。typetab には #JN がありません。
    >
    > 新部さんの言われているように typetab が古いのかな？ typetab だと
    > JNM ですものね。
  
    typetab を直すだけでいいのなら…という訳で、ざっくり直してみました。
  
(1) Anthy 本体の typetab がアップデートされるまでは、上記のメールに付属し
 ている typetab、または、同梱している "typetab-20100524" を (例えば)
 /usr/local/share/anthy/typetab としてインストールしてください。
  
(2) 固有名詞:人名を表現する品詞コードが変わりました。従来の egg-anthy で人
 名を登録した方は、~/.anthy/private_words_default 中の " #JNM*" を " #JN*"
 に置換しておかないと、"anthy-dic-tool --dump" 等が正常に動作しません。

こっちは、なんと三年ぶりのアップデート。

○ Anthy の郵便番号辞書

詳細は Anthy の ML 参照。とりあえず、個人的にはすっかり満足してしまったので、これ以上首を突っ込むかどうかは不明。

○ いつまでも Mew を使おう！！

最近、世知辛い世の中になってきて、会社で MUA は Becky! をこういう設定で使うように、というお触れが出ている。ちなみに「こういう設定」というのは

• 送信前の送付先アドレス確認チェック
• 送信時の添付ファイルチェック
• グループアドレス使用禁止

だ。Becky! のグループアドレスというのは、hoge で送信したら、hoge に登録してある fooさんも barさんもみんな同時に送信するというものらしいが、それと同等のものは現在の Mew はそもそも対応していないと思うので前者二つに対応してみた

○ mew-draft-check-whom

もともとは、送付先アドレスチェックのために作って、後から添付ファイルの機能も入れたのでこんな名前。

(defvar mew-draft-check-whom-always-ask nil
  "宛先に関係なくいつでも質問するときは non-nil")
 
(defvar mew-draft-check-whom-attaches t
  "添付ファイルのチェックをしない時は nil")
 
(defvar mew-buffer-whom "*Mew whom*")
 
(add-hook 'mew-make-message-hook 'mew-draft-check-whom)
 
(defadvice mew-header-make-message (around ask-address activate)
  (mew-draft-check-whom)
  ad-do-it)
 
(defadvice mew-header-send-message (around ask-address activate)
  (mew-draft-check-whom)
  ad-do-it)
 
(defun mew-draft-check-whom-ask (addr case)
  (or mew-draft-check-whom-always-ask
      (progn
	(setq addr (downcase (or (mew-addrstr-parse-address addr) addr)))
	(let ((domain (and (string-match "@\\(.+\\)$" addr)
			   (downcase (mew-match-string 1 addr)))))
	  (not (or (not domain)
		   (member addr (mew-safe-addresses case))
		   (member domain (member domain (mew-safe-domains case)))))))))
 
(defun mew-draft-check-whom ()
  "Display expanded short names and attaches in other window."
  (interactive)
  (let ((buf (current-buffer))
	(case (mew-tinfo-get-case))
        (destination-list
         (mew-uniq-list (append '("From:") mew-destination:-list
                                '("Reply-to:" "Newsgroups:" "Fcc:"
                                  "Resent-To:" "Resent-Cc:"
				  "Resent-Dcc:" "Resent-Bcc:"))))
	(wincfg (current-window-configuration))
	(ask nil)
        to-cc field head pos attaches)
    (mapc (lambda (list)
	    (setq to-cc (cons (cons list (mew-header-get-value list)) to-cc)))
	  destination-list)
    (setq to-cc (nreverse to-cc))
    (when (and mew-draft-check-whom-attaches
	       (setq pos (next-single-property-change (point-min) 'mew-attach-begin)))
      (goto-char pos)
      (forward-line 1)
      (setq pos (point))
      (mew-attach-next)
      (while (not (= (point) pos))
	(setq pos (point))
	(when (mew-attach-not-line012-1-dot)
	  (let* ((nums (mew-syntax-nums))
		 (syntax (mew-syntax-get-entry mew-encode-syntax nums))
		 (name (mew-syntax-get-file syntax))
		 (cdpl (mew-syntax-get-cdp syntax))
		 (ctl (mew-syntax-get-ct syntax))
		 (cdpname (mew-syntax-get-filename cdpl ctl)))
	    (unless (string-match "/$" name)
	      (if (or (not cdpname) (string= name cdpname))
		  (setq attaches (cons (cons nums name) attaches))
		(setq attaches (cons (cons nums (format "%s (%s)" cdpname name)) attaches))))))
	(mew-attach-next))
      (setq attaches (nreverse attaches)))
    (message "Checking recipients ... ")
    (get-buffer-create mew-buffer-whom)
    (switch-to-buffer-other-window mew-buffer-whom)
    (mew-erase-buffer)
    (while to-cc
      (setq field (car (car to-cc)))
      (setq head (cdr (car to-cc)))
      (setq to-cc (cdr to-cc))
      (when head
        (setq head (mew-replace-white-space head))
        (setq head (mew-split head ?,))
        (insert (format "%s %s\n" field (car head)))
	(setq ask (or ask (mew-draft-check-whom-ask (car head) case)))
        (setq head (cdr head))
        (while (setq field (car head))
	  (setq ask (or ask (mew-draft-check-whom-ask (car head) case)))
          (when (string-match "^ +" field)
            (setq field (substring field (match-end 0))))
          (insert (format "\t%s\n" field))
          (setq head (cdr head)))))
    (goto-char (point-min))
    (while (re-search-forward ",\\([ \t]*[^\n]\\)" nil t)
      (goto-char (match-beginning 1))
      (insert "\n")
      (when (looking-at "^[ \t]+")
        (delete-region (match-beginning 0) (match-end 0)))
      (insert "\t"))
    (goto-char (point-min))
    (insert (propertize "ヘッダーチェック" 'face 'mew-face-header-warning))
    (insert "\n")
    (mew-highlight-header-region (point) (point-max))
    (when attaches
      (goto-char (point-max))
      (insert "\n")
      (insert (propertize "添付ファイル" 'face 'mew-face-header-warning))
      (insert "\n")
      (dolist (alist attaches)
	(let ((nums (car alist))
	      (file (cdr alist)))
	  (insert (format "%s\t%s\n"
			  (propertize (concat (mapconcat 'number-to-string nums ".") ".")
				      'face 'mew-face-header-marginal)
			  (propertize file 'face 'mew-face-header-from))))))
    (goto-char (point-min))
    (pop-to-buffer buf)
    (mew-buffers-setup (buffer-name))
    ;;
    (when (or ask attaches)
      (pop-to-buffer mew-buffer-whom)
      (unless (pos-visible-in-window-p (point-max) (selected-window))
	(delete-other-windows))
      (unwind-protect
	  (unless (y-or-n-p "Sure? ")
	    (cond
	     ((and ask attaches)
	      (error "Edit address or attaches"))
	     (ask
	      (error "Edit address"))
	     (attaches
	      (error "Edit attaches"))
	     (t
	      (error "Edit something"))))
	(set-window-configuration wincfg)))))
 
;; 必要ないかも
(add-hook 'mew-send-hook
	  (lambda ()
	    (when (get-buffer mew-buffer-whom)
	      (kill-buffer mew-buffer-whom))))

○ arc-mode でパスワード付き ZIP を扱う

mew-dist で話が出ていたので作ってみた。が、mew-dist に出せるほどの自信はない。ぼく自身も arc-mode は view ぐらいしか使わないし、以下すべての arc-mode に関して日本語ファイルの対応は適当。view できるファイルは出来るし、view 出来ないファイルは出来ない(が差がわかんないの)。

(defvar archive-extract-passwd nil)
(make-variable-buffer-local 'archive-extract-passwd)
 
(defadvice archive-zip-extract (around zip-passwd activate compile)
  (if (equal (car archive-zip-extract) "unzip")
      (let ((args (append (cdr archive-zip-extract) (list archive name)))
	    (passwd (with-current-buffer (get-buffer archive-superior-buffer)
		      archive-extract-passwd))
	    enc)
	(if passwd
	    (setq enc t)
	  (with-temp-buffer
	    (let ((case-fold-search nil)
		  (coding-system-for-write
		   (or (and (boundp 'archive-file-name-coding-system)
			    archive-file-name-coding-system)
		       file-name-coding-system))
		  (coding-system-for-read
		   (or (and (boundp 'archive-file-name-coding-system)
			    archive-file-name-coding-system)
		       file-name-coding-system)))
	      ;; zipinfo mode
	      (apply 'call-process "unzip" nil (current-buffer) nil
		     (list "-Z" archive name))
	      (goto-char (point-min))
	      (when (and (re-search-forward "[0-9] \\([tTbB]\\)[^ ] " nil t)
			 (string= (upcase (match-string 1)) (match-string 1)))
		(setq enc t)))))
	(when enc
	  (unless passwd
	    (setq passwd (setq passwd (read-passwd "ZIP passwd: "))))
	  (setq args (append (list "-P" passwd) args)))
	(let ((coding-system-for-write
	       (or (and (boundp 'archive-file-name-coding-system)
			archive-file-name-coding-system)
		   file-name-coding-system))
	      (coding-system-for-read
	       (or (and (boundp 'archive-file-name-coding-system)
			archive-file-name-coding-system)
		   file-name-coding-system)))
	  (apply 'call-process "unzip" nil
		 t  ;; emacs-24 (if stderr-file (list t stderr-file) t)
		 nil args))
	(if (zerop (buffer-size))
	    (with-current-buffer (get-buffer archive-superior-buffer)
	      (when enc
		(message "may be password wrong"))
	      (setq archive-extract-passwd nil)
	      (setq ad-return-value nil))
	  (with-current-buffer (get-buffer archive-superior-buffer)
	    (setq archive-extract-passwd passwd)
	    (setq ad-return-value t))))
    ad-do-it))

○ LHA の directory セパレータ '\' 対応

ついでなので、Windows のアーカイバ で作った lzh を unix とか cygwin の lha で view するもの

(defadvice archive-extract-by-stdout (before fix-lha activate)
  (when (string= "lha" (car command))
    (let ((tmp name))
      (setq name "")
      (while (string-match "\\\\" tmp)
	(setq name (concat name (substring tmp 0 (match-beginning 0)) "/"))
	(setq tmp (substring tmp (match-end 0))))
      (setq name (concat name tmp))
      (setq name (encode-coding-string name default-file-name-coding-system)))))

○ 日本語のファイルが含まれる zip/lha にちょっとだけ対応

(add-hook 'archive-zip-mode-hook 'my-archive-set-cs)
(add-hook 'archive-lzh-mode-hook 'my-archive-set-cs)
 
(defun my-archive-set-cs ()
  (make-local-variable 'file-name-coding-system)
  (setq file-name-coding-system 'shift_jis))
 
(when (< emacs-major-version 23)
  (defadvice archive-summarize-files (before set-multibyte activate compile)
    (set-buffer-multibyte t)))

○ 怪物くん

大野くんとチェ・ホンマン、鹿賀丈史に笑った。しかし、鹿賀丈史ってこういうの似合うなぁ〜。また、チェ・ホンマンは台詞が『フンガー』だけで良かったね :-)

個人的には、怪物くんの声はぜひぜひチャコちゃんにアテレコをして貰いたいな。見た目は問題無いのだけど、声のイメージが違いすぎるのよ。ちなみに、私は、『ユカイツーカイ怪物くん』ではなくて『おれは怪物くんだ』の世代。

○ w3m-open-all-links-in-new-session & sense-region

taiyaki（小松くん）のsense-regionで矩形選択をしているときにemacs-w3mでw3m-goto-url-new-session（w3m-open-all-links-in-new-session）したときに、矩形内のURLだけ開くのを作ってみた。最近elisp全然書いていないから結構手間取るな。

(defadvice w3m-open-all-links-in-new-session (around for-sense-region activate)
  "sense-region で rectangle 選択のときに矩形範囲の URL のみ開く"
  (if (and (boundp 'sense-region-status)
	   (eq sense-region-status 'rectangle))
      (let ((buffer (current-buffer))
	    (prev start)
	    (url (w3m-url-valid (w3m-anchor start)))
	    urls all
	    startend startcol startpt endcol endpt lbeg lend)
	(when (w3m-region-active-p)
	  (w3m-deactivate-region))
	(when url
	  (setq urls (list url)))
	(save-excursion
	  (goto-char start)
	  (setq startcol (current-column))
	  (beginning-of-line)
	  (setq startpt (point))
	  (goto-char end)
	  (setq endcol (current-column))
	  (forward-line 1)
	  (setq endpt (point-marker))
	  ;; ensure the start column is the left one.
	  (if (< endcol startcol)
	      (let ((col startcol))
		(setq startcol endcol endcol col)))
	  ;; start looping over lines
	  (goto-char startpt)
	  (while (< (point) endpt)
	    (save-excursion
	      (move-to-column startcol)
	      (setq lbeg (point))
	      (move-to-column endcol)
	      (setq lend (point)))
	    (setq startend (cons (cons lbeg lend) startend))
	    (forward-line 1))
	  (setq startend (nreverse startend))
	  (goto-char start)
	  (setq all (not (and (bolp)
			      w3m-current-url
			      (string-match "\\`http://\\(?:[^/]+\\.\\)*google\\."
					    w3m-current-url))))
	  (while (progn (w3m-next-anchor)
			(and (> (point) prev)
			     (< (point) end)))
	    (setq prev (point))
	    (setq endpt (max start
			     (1- (next-single-property-change
				  prev 'w3m-anchor-sequence nil end))))
	    (when (and (setq url (w3m-url-valid (w3m-anchor)))
		       (string-match "\\`https?:" url)
		       (catch 'inrectangel
			 (dolist (begend startend)
			   (when (or (and (>= prev (car begend))
					  (<= prev (cdr begend)))
				     (and (>= endpt (car begend))
					  (<= endpt (cdr begend)))
				     (and (< prev (car begend))
					  (> endpt (cdr begend))))
			     (throw 'inrectangel t)))
			 nil)
		       (or all (bolp)))
	      (push url urls)))
	  (setq urls (nreverse urls))
	  (while urls
	    (setq url (car urls)
		  urls (cdr urls))
	    (set-buffer buffer)
	    (w3m-view-this-url-1 url arg t))))
    ad-do-it))

なお、sense-region.elとか全然メンテされていないので、手を加えないで最近のEmacsで動くのかどうかは知らない。手元のは手をいれてあると思うのだけど、なにをやったのかよく覚えていない。