2011-04-03

Spotlight の検索結果や、スマートフォルダを Dired で表示する mdfind-dired.el

GNU Emacs に含まれる find-dired.el は指定ディレクトリ以下を find コマンドで検索し、結果を Dired で表示してくれます。
それを Spotlight のコマンドライン版である mdifnd で動くように修正を加えたものが mdfind-dired.el です。

できることは

  • Spotlight 検索を Emacs から実行し、その結果を Dired で表示する
  • スマートフォルダ (.savedSearch) を Dired で開く

動作環境

GNU Emacs 22 と 23。 Mac OS X 10.4 以上ですが、一部使えないコマンドがあるので 10.5 以上が推奨です。
GNU Emacs 23 と Mac OS X 10.6 でテストしています。

インストール

mdfind-dired.el
https://gist.github.com/900452

gist から raw をクリックし、 mdfind-dired.el を保存する。
load-path の通った場所にファイルを置き、以下のコードを ~/.emacs.el または ~/.emacs.d/init.el に加える。
(バイトコンパイルは任意です。)

(require 'mdfind-dired)
(add-to-list 'auto-mode-alist
             '("\\.savedSearch\\'" . mdfind-dired-change-to-dired))

キーバインドの設定は hook でします。

(add-hook 'mdfind-dired-hook
          (lambda ()
            (local-set-key "," 'mdfind-dired-toggle-visibility)))

使い方

mdfind の使い方は man ページ man mdfind に載っています。

M-x mdfind-dired
mdfind に生の検索語を入力し、結果を Dired で表示。
検索語は mdfind に渡す前にシェルに渡されるので、" * () & | $ 等の文字はエスケープする必要がある。(他のコマンドではエスケープする必要はない。)
C-u 付きで一つ、または複数のディレクトリを指定し、検索範囲を絞ることができる。
その際、ミニバッファを空欄にして RET を打鍵することで入力を終了する。この挙動は他のコマンドでも同じ。
M-x mdfind-dired-name (または mdfind-name-dired)
Mac OS X 10.5 以上が必要。 mdfind -name と同じ。ファイル名で検索する。
M-x mdfind-dired-interpret
Mac OS X 10.5 以上が必要。 mdfind -interpret と同じ。Spotlight メニューに入力する書式がそのまま使える。
例えば kind:image date:"this week" と入力すると、今週(作成、更新、開いた)の画像を検索。
M-x mdfind-dired-smartfolder
スマートフォルダを開く。
M-x mdfind-dired-toggle-visibility
ファイルのディレクトリ部分を「表示 / 隠す」。
mdfind の検索結果はトップディレクトリからのパスであることが多いので、例えば長いパスを
Users/foo/bar/baz/qux/quux/corge/grault/garply/waldo/fred/plugh/xyzzy/thud.txt
このように短縮表示する。
.../thud.txt
デフォルトの「表示 / 隠す」の状態は変数 mdfind-dired-default-visible で設定する。



Spotlight の使い方についてはこれらのページを参照してください。

他に Spotlight FS でも似たようなことができます。

2011-03-26

Dired で Spotlight コメントの表示、編集、タグ付け

Mac OS X では Spotlight コメント (Finder コメント) にタグを付けてスマートフォルダでファイルの管理ができます。

Spotlight コメントは Finder の「情報を見る」から編集できますが、Emacs 使いなら Dired でマークして一括タグ追加、削除、等と楽がしたいものです。

そんな Elisp パッケージをグーグル検索しても見つからなかったので、自分で書いてみました。

spotlight-comment.el
https://gist.github.com/888153

動作条件

GNU Emacs 22 と 23。 Mac OS X 10.4 以上。

インストール

上の gist から raw をクリックして spotlight-comment.el をダウンロードする。
load-path の通った場所へ置き、以下を ~/.emacs.el~/.emacs.d/init.el に追加。

(require 'spotlight-comment)
(define-key dired-mode-map "\M-c" spotlight-comment-dired-prefix-map)

使い方

キーバインドは何でもいいのですが M-c を例に使えるコマンドを説明すると、

M-c y
Spotlight コメントを表示。 C-u 付きでキルリングにコピー。
M-c e
Spotlight コメントを編集。
M-c D
マークしたファイルの Spotlight コメントを削除。
M-c s
マークしたファイルの Spotlight コメントを上書き。
M-c a
マークしたファイルの Spotlight コメントにタグを追加。
M-c d
マークしたファイルの Spotlight コメントからタグを削除。
M-c m
Spotlight コメントにタグが含まれるファイルにマークを付ける。

その他

  • タグ入力する際には、 TAB での補完が効きます。
    補完候補はミニバッファの履歴と変数 spotlight-comment-user-tags に設定してあるタグです。
    空欄のまま RET でタグ入力が終了します。
  • タグの区切り文字は変数 spotlight-comment-separator で設定し、デフォルトでは ", " (カンマとスペース)。
  • Spotlight コメントは全て Finder によって AppleScript 経由で書き換えられます。
    関数 do-applescript を使っていないので X11版 Emacs や Cocoa Emacs の -nw 起動でも使えるはずです。
  • 設定したタグは Spotlight の検索欄から comment:MyTag で MyTag を持つファイルを表示できます。


動作確認: GNU Emacs 23 (Mac port), Mac OS X 10.6

2011-03-22

Emacs Mac port に追加されている機能

Emacs Mac port についてはこちら Emacs Mac port を使う

Emacs Mac port に追加されている機能ですが、パッチに含まれる README-mac に詳細が書いてあります。
ここではその一部をまとめてみました。

パッチのバージョン emacs-23.3-mac-1.9992 を元に書いています。

  • 変数 window-system の値は mac
  • Command-Control-D でカーソル位置の単語の意味を辞書で表示
  • AppleEvent に対応
    Emacs に設定してあるメーラーが開く。 QuickCursor も使えるらしい
    osascript -e 'tell application "Emacs" to open location "mailto:foo@example.com"'
    
  • Emacs がビジーな時は、タイトルバー右側のインジケータがグルグル回る
  • fullscreen フレイムパラメータが認識される
    (set-frame-parameter nil 'fullscreen 'fullboth) でメニューバーと Dock が消えてフルスクリーンに!
    こんなコマンドを作って手軽に切り替えられるようにしてます
    (defun my-toggle-fullscreen ()
      "Toggle fullscreen."
      (interactive)
      (if (eq (frame-parameter nil 'fullscreen) 'fullboth)
          (progn
            (set-frame-parameter nil 'fullscreen nil)
            (display-time-mode 0))
        (set-frame-parameter nil 'fullscreen 'fullboth)
        (display-time-mode 1)))
    
    (global-set-key "\C-cf" 'my-toggle-fullscreen)
    
  • sticky フレイムパラメータが認識される
    (set-frame-parameter nil 'sticky t) で Spaces で全てのスクリーンに表示されるようになる
  • 関数 system-move-file-to-trash が定義されている
    変数 delete-by-moving-to-trash に設定することで、 Emacs からファイルを消去する際にゴミ箱に移動するようになる
    (setq delete-by-moving-to-trash 'system-move-file-to-trash) としてしまうと一時ファイル等でゴミ箱が溢れるので、 Dired 等特定のコマンドでのみ有効にするのが良いかもしれない
    ;; Dired の x や D でゴミ箱に捨てる。Finder での「取り消し」「戻す」は不可。
    (when (fboundp 'system-move-file-to-trash)
      (defadvice dired-do-flagged-delete
        (around move-to-trash activate)
        "Use `system-move-file-to-trash'."
        (let ((delete-by-moving-to-trash 'system-move-file-to-trash))
          ad-do-it))
    
      (defadvice dired-do-delete
        (around move-to-trash activate)
        "Use `system-move-file-to-trash'."
        (let ((delete-by-moving-to-trash 'system-move-file-to-trash))
          ad-do-it)))
    
  • M-x menu-bar-open でメニューバーが開く (menu-bar-mode が non-nil の場合)
    (global-set-key "\M-`" 'menu-bar-open) ; tmm-menubar
    
  • mac-mouse-wheel-mode. 行単位のカクついたスクロールではなく、ピクセル単位の滑らかなスクロール
  • トラックパッドのジェスチャーを認識する。 magnify-up, magnify-down, rotate-left, rotate-right
    デフォルトではテキストスケールの変更と、フルスクリーンの切り替えに割り当てられている
  • システム環境設定 → アピアランス の「クリックされた場所にジャンプ」が Emacs でも有効
  • システム環境設定 → キーボード の「キーボードショートカット (キーボードと文字入力)」が Emacs でも有効。
    例えば ^F2 でメニューバーが開く。 ^F4 でウィンドウ切り替え等
  • 他のアプリで画像をコピーした場合、 yank-pop でその画像を挿入できる。(変数 yank-excluded-properties で display を除外してない場合に限る)
  • Mac OS X 10.6 以上で、メニューバーのヘルプの検索語入力欄から info ノードを検索可能
  • Mac OS X 10.6 以上で、他のアプリにて選択したテキストがファイルのパスならば、 Emacs で開くためのコンテキストメニューとサービスが追加される
  • ことえりで、かなキー2回連打でカーソル位置の単語を再変換する機能が Emacs でも有効
  • 関数 mac-convert-property-list の追加
    Mac OS X の plist を lisp 等に変換できる。 plutil や xml.el とかでも似たようなものは実装できそうですが
    使用例としてはこんな感じで
    (mac-convert-property-list
     (let ((coding-system-for-read 'no-conversion))
       (with-temp-buffer
         (insert-file-contents "~/Library/Preferences/.GlobalPreferences.plist")
         (buffer-string))))
    

他に、 SVG やマルチページ TIFF の表示、 関数 mac-file-alias-p の追加、 Option-Command-T で「文字ビューアを表示」、 Resolution independence, 等々。

あと、私の環境では lookup.el で辞書を引くスピードが Cocoa Emacs では異様に遅かったのですが、 Emacs Mac port では軽快に動きました。

その他の注意点

  • mac-allow-anti-aliasing は削除された
    システム環境設定 -> アピアランス で設定するか、Terminal から以下を実行
    defaults write "org.gnu.Emacs" AppleAntiAliasingThreshold 12
  • ことえりの半角英字モードで C-S-a (Shift を押しながらの C-a) が効かなくなることがある。再現性はいまいち

do-applescript 関数について

  • Emacs Mac port の do-applescript は Carbon Emacs のそれと挙動は同じで、数点注意が必要です
    • do-applescript へ渡す文字列、返す文字列は変数 mac-system-coding-system でエンコード、デコードする必要がある
    • 変数 mac-system-coding-system は端末から Emacs を -nw 起動した時には初期化されていない
    • バックスラッシュは全て \200 (0x80) に置き換えられるので変換が必要
    • do-applescript が返す文字列はダブルクオートで囲まれているので、除去する必要がある
  • Cocoa Emacs の do-applescript (ns-do-applescript) は上記の面倒は無いのですが、端末で起動した時には do-applescript 関数は使えません
  • X11 用にビルドした Emacs では do-applescript は恐らく使えません
  • 外部コマンドの osascript を使う場合次の利点があります
    • Emacs Mac port, Carbon Emacs に特有の面倒が無い
    • 端末からの -nw 起動でも X11 版でも AppleScript を使える
    • on run argv で引数渡しができる
    • スクリプトの実行が失敗したかどうかが call-process の返り値でわかる

上記の理由から当ブログで紹介している Dired 関連の tips では do-applescript は使わず osascript を使っています

Emacs Mac port を使う

Emacs Mac port とは

Carbon Emacs (GNU Emacs 22) をベースとして、 GUI 部分に Cocoa API を取り入れ GNU Emacs 23 に対応させたものです。64bit 版もビルドできます。

Carbon Emacs のメインテナーをされていた YAMAMOTO Mitsuharu 氏によってパッチという形で提供されています。
パッチはここで入手できます。
ftp://ftp.math.s.chiba-u.ac.jp/emacs/

Cocoa Emacs (GNU Emacs 23 を –with-ns でビルドしたもの) と比べ、色々と機能が追加されています。
詳しくはパッチに同梱されている README-mac に書いてあります。
Emacs Mac port に追加されている機能 にもまとめてみました。

Emacs Mac port という呼称が適切なのか自信はないですが、 README-mac やソースでは "Mac port", "GNU Emacs Mac port" という名前が使われているので、当ブログでは Emacs Mac port で統一しました。

それにしても、 Mac port と MacPorts が似ていてウェブ検索での情報収集がしにくいです。

Emacs Mac port のインストール

詳しい手順はパッチに含まれる README-mac に載っています。
以下は 2011年3月現在の Emacs 23.3 をビルドする手順です。(Xcode が必要です)

  1. http://www.gnu.org/prep/ftp.html の最寄りのサーバから emacs-23.3.tar.bz2 を落とす。
  2. ftp://ftp.math.s.chiba-u.ac.jp/emacs/ から emacs-23.3-mac-1.9992.tar.gz を落とす。 1.9992 の部分は最新のバージョンで。
  3. ターミナルで
    tar jxf emacs-23.3.tar.bz2
    tar zxf emacs-23.3-mac-1.9992.tar.gz
    cd emacs-23.3
    patch -p0 < ../emacs-23.3-mac-1.9992/patch-mac
    cp -r ../emacs-23.3-mac-1.9992/mac .
    cp ../emacs-23.3-mac-1.9992/src/* ./src/
    cp ../emacs-23.3-mac-1.9992/lisp/term/mac-win.el ./lisp/term/
    ./configure --with-mac --without-x
    make
    sudo make install
    mv ./mac/Emacs.app /Applications/
    

    configure の --prefix オプションによっては sudo make install の部分は make install でも可。
    Cocoa Emacs とは違い、 self-contained ではないので、 --prefix を指定しないかぎり /usr/local 以下にインストールされます。

Emacs Mac port の設定

文字コードの設定

(set-language-environment 'Japanese)
(prefer-coding-system 'utf-8)
;; クリップボードの文字コード
(set-selection-coding-system 'utf-8)
;; 端末の文字コード
(set-terminal-coding-system 'utf-8)
(set-keyboard-coding-system 'utf-8)
;; ファイル名の文字コード
(require 'ucs-normalize)
(set-file-name-coding-system 'utf-8-hfs)

Emacs Mac port の場合、クリップボード用の文字コード selection-coding-system がシステムのデフォルト言語で初期化されます。
日本語ならば japanese-shift-jis 。上の例では utf-8 にしてますが、 japanese-shift-jis でも問題は無いです。
ただ、これを japanese-shift-jis 以外の Shift_JIS (例えば sjis, sjis-mac 等) にすると、バックスラッシュが半角の円記号に化けたりと不具合が出ます。関数 mac-string-to-pasteboard-string でその辺りの処理をしています。

フォントの設定

基本的には Cocoa Emacs の設定の仕方と同じです。
Emacs Mac port は Carbon Emacs がベースですが、 carbon-font.el は使えません。

http://macemacsjp.sourceforge.jp/index.php?MacFontSetting より引用

(create-fontset-from-ascii-font "Menlo-14:weight=normal:slant=normal" nil "menlokakugo")
(set-fontset-font "fontset-menlokakugo" 'unicode (font-spec :family "Hiragino Kaku Gothic ProN" ) nil 'append)
(add-to-list 'default-frame-alist '(font . "fontset-menlokakugo"))
(setq face-font-rescale-alist '((".*Hiragino.*" . 1.2) (".*Menlo.*" . 1.0)))
  • アンチエイリアスに関して
    Carbon Emacs にあった変数 mac-allow-anti-aliasing は削除されています。
    システム環境設定のアピアランスで設定するか、Terminal から defaults で設定します。
    defaults write "org.gnu.Emacs" AppleAntiAliasingThreshold 12
    また、関数 font-spec の :antialias プロパティに nil か t をセットすることで、フォント毎の指定もできます。

  • フォント設定に関するバグ
    http://d.hatena.ne.jp/setoryohei/20110113
    3つの条件が重なると、バグが出るらしい。
    当方でも inhibit-startup-screen (inhibit-startup-message, inhibit-splash-screen) を t にしていると、□○△の記号類が半角サイズで表示される等、フォントが正しく設定されないのを確認しました。 Emacs Mac port でも再現性があります。

使えるフォントは *scratch*

(insert (prin1-to-string (x-list-fonts "*")))

これを評価すれば全て表示されます。
Cocoa Emacs よりも太字が使えるフォントが増えていたりと、選択肢が多くなっているはずです。

  • Monaco 10
    Emacs Mac port で Monaco 10 に設定すると、斜体字は太字よりも太くなり、太字はぼやけてしまいます。
    アンチエイリアス無しで Carbon Emacs と同じようなフォント設定にするのは難しいようです。
    ちなみに Cocoa Emacs では Monaco の太字は使えません。
  • M+とIPAの合成フォント
    無料で使えます。 MigMix 1M, MigMix 2M, Migu 1M が等幅フォントで太字も含む。
    http://mix-mplus-ipa.sourceforge.jp/

その他の設定

Emacs Mac port のマウススクロールは非常に滑らかです。が、何らかの事情でマウススクロールを無効にしたい場合はこのようにします。

(add-hook 'window-setup-hook
          (lambda ()
            (when (fboundp 'mac-mouse-wheel-mode)
              (mac-mouse-wheel-mode 0))))

単に ~/.emacs.d/init.el(mac-mouse-wheel-mode 0) と書き込んでも無効にはなりません。
詳しくは mac-win.el の after-init-hook に追加している個所を参照。

2011-03-20

Emacs 22 から Emacs 23 への変更点

GNU Emacs 23.1 は 2009年7月にリリースされましたが、2011年3月 GNU Emacs 23.3 がリリースされたのを機に、重い腰を上げ 22 から移行することにしました。

今さら感がありますが、 22.3 から 23.3 への移行の個人的なメモです。
追加・変更されたメジャーモードについては量が多いので省略しました。

詳しくは C-h n で表示される NEWS に全て書いてあります。


リージョン (選択範囲) 関連

transient-mark-mode
マイナーモード。デフォルトで t になった。
shift-select-mode
マイナーモード。デフォルトで t 。シフト押しながらカーソル移動で範囲選択。
set-mark-default-inactive
変数。デフォルトで nil。 t ならば C-@ 2回で範囲をハイライト。 Emacs 22 では t の挙動がデフォルトだったが、 23 ではその挙動を変える変数として用意された。
select-active-regions
変数。デフォルトで nil 。 t ならば範囲選択するだけでキルリングにコピー。
use-empty-active-region
変数。デフォルトで nil 。 t ならば範囲に対して実行するコマンドが、空の範囲に対しても実行されるようになる。
use-region-p
関数。範囲指定済みなら t を返す。空の範囲の場合は use-empty-active-region の値に依存。
region-active-p
関数。範囲指定済みなら t を返す。
(interactive "^")
interactive で ^ を指定できるようになった。 shift-select-mode が non-nil の場合、関数 handle-shift-selection を呼ぶ。
^ が使われている C-M-f (forward-sexp) を例にすると、以下の4パターンで範囲の変化の仕方に違いが出る。
  • 範囲を選択してから C-M-f (範囲を拡大する)
  • 範囲を選択してから shift + C-M-f (範囲の開始位置を変更)
  • shift + カーソルで範囲を選択してから C-M-f (範囲を無効にする)
  • shift + カーソルで範囲を選択してから shift + C-M-f (範囲を拡大する)
C-@ C-@
2回で、 Mark, Deactivate mark の繰り返し
範囲選択してからTAB
indent-region

ヘルプ関連

help-window-select
変数。デフォルトで 'other。 'always (t) ならば *Help* 表示時に常にウィンドウを選択する。
help-downcase-arguments
変数。デフォルトで nil。 t ならば *Help* の引数を以前と同じ小文字表記にする。
help-go-forward
コマンド。 [back] で戻った時に [forward] で進む。
This variable is potentially risky when used as a file local variable.
ファイルローカル変数として危険かどうかを表示するようになった。
ファイルローカル変数とはファイルの1行目の -*- 変数: 値 -*- や、最後の Local Variables: 等のこと。
This variable was introduced, or its default value was changed, in version 23.1 of Emacs.
変数が追加・変更された Emacs のバージョンを表示するようになった。
これは defcustom で :version プロパティを追加した変数のみ有効。
例:
(defcustom select-active-regions nil
  "If non-nil, an active region automatically sets the primary selection."
  :type 'boolean
  :group 'killing
  :version "23.1")
;; 現在読み込み済の (intern された) シンボルで、 defcustom が :version
;; プロパティを付加したものを列挙する。下の例では 23 から始まるものだけを抽出。
(let (symbols version)
  (mapatoms
   (lambda (x)
     (setq version (get x 'custom-version))
     (when (and version
                (string-match "^23" version))
       (setq symbols (cons x symbols)))))
  (insert (mapconcat 'symbol-name (sort symbols 'string<) "\n")))

Dired 関連

M-s f C-s
dired-isearch-filenames
M-s f C-M-s
dired-isearch-filenames-regexp
M-s a C-s
dired-do-isearch. buffer-menu や ibuffer でも似た挙動。
M-s a C-M-s
dired-do-isearch-regexp. buffer-menu や ibuffer でも似た挙動。
C-x C-q
wdired
その他
Dired からシェルコマンドを実行 (!, &) する時に、候補 (guess) を M-n で選ぶようになった。

追加されたマイナーモード

goto-address-mode
デフォルトでオフ。バッファの URL をボタン化する。
minibuffer-depth-indicate-mode
デフォルトでオフ。 minibuffer の深度を表示する。 enable-recursive-minibuffers が non-nil の場合のみ有効。
visual-line-mode, global-visual-line-mode
デフォルトでオフ。 C-a, C-e が見た目の行で実行される。オンにした時、フリンジの矢印を消さずに元のままにする場合は、変数 visual-line-fringe-indicators の値を '(left-curly-arrow right-curly-arrow) にする。
whitespace-mode, global-whitespace-mode
デフォルトでオフ。タブやスペースの視覚化等。以前のものを一新したらしい。

コマンド

M-s o
occur
M-s w
isearch-forward-word
M-s h f
hi-lock-find-patterns
M-s h l
highlight-lines-matching-regexp
M-s h p
highlight-phrase
M-s h r
highlight-regexp
M-s h u
unhighlight-regexp
M-s h w
hi-lock-write-interactive-patterns
isearch 中に M-s o
occur に切り替える。
minibuffer で isearch
履歴を検索する (minibuf-isearch.el みたいなもの)。
completion-at-point (M-TAB)
カーソル位置の単語を補完。
C-l, M-r
連打で middle, top, bottom と変化するようになった。 変数 recenter-positions で順番を指定。
async-shell-command (M-&)
非同期(バックグラウンド)でシェルコマンドを実行。 M-! で末尾に & を付加したものと同じ。
zrgrep
再帰的に gzip ファイルの中身を grep。
emacs-uptime
Emacsの稼働時間を返す。
emacs-init-time
Emacsの起動にかかった時間を返す。
display-time-world
世界の時刻を表示。
butterfly
バタフライ効果でHDDにビットを立てる。 http://xkcd.com/378/

変数 (ユーザーオプション)

line-move-visual
デフォルトで t。C-n, C-p が見た目の行で実行される。
word-wrap
デフォルトで nil。t ならば単語単位で折り返しをする。スペース区切りなので日本語ではあまり効果がない。
initial-buffer-choice
デフォルトで nil。Emacs 起動時のバッファを指定。
user-emacs-directory
デフォルトは ~/.emacs.d/
yank-pop-change-selection
デフォルトで nil。 t ならば yank-pop した時に他アプリのコピーバッファを同期させる。
save-interprogram-paste-before-kill
デフォルトで nil。 t ならば yank だけでなく kill した時にも他アプリのコピーバッファを kill-ring に保存する。
kill-do-not-save-duplicates
デフォルトで nil。 t ならば同じ文字列を連続でコピーした場合、重複を保存しない。
tab-always-indent
デフォルトで t。 complete を指定できるようになった。
completions-format
デフォルトで nil。 vertical ならば *Completions* の並び方が縦に。

Elisp 関連

内部コード
utf-8-emacs に変更。
display-buffer
コマンド。 split-window-preferred-function を使うようになった。
split-window-preferred-function
変数。デフォルトで split-window-sensibly 。
split-height-threshold
変数。デフォルトで 80。nil またはフレームの高さがこの値より小さい場合、 split-window-sensibly は上下分割しない。
split-width-threshold
変数。デフォルトで 160。nil またはフレームの幅がこの値より小さい場合、 split-window-sensibly は左右分割しない。
read-shell-command
関数。ミニバッファで外部プログラムを読み取る。補完が効く。 M-!, M-&, M-| や、Dired の !, & 等で補完が効くようになったのも、この関数のおかげ。
process-lines
関数。外部プログラムを実行し、出力の一行ずつをリストにして返す。
initial-environment
変数。環境変数の初期値。
check-coding-systems-region
関数。文字列または範囲の文字コードをチェック。

2011-03-03

Mac OS X 上の Emacs で M-x doctor に音声でしゃべらせる

Mac OS X には say というテキストを読み上げるコマンドがあります。
それを M-x doctor で利用すれば実際に声でしゃべってくれます。

;; M-x doctor
(defadvice doctor-read-print
  (after say activate)
  "Let the psychotherapist speak with audio voice."
  (start-process "say" nil "say" "-v" "Agnes"
                 (save-excursion
                   (buffer-substring-no-properties
                    (progn
                      (re-search-backward "\n\n" nil t 2)
                      (forward-char 2)
                      (point))
                    (progn
                      (re-search-forward "\n\n" nil t)
                      (forward-char -2)
                      (point))))))

doctor-mode のヘルプによると doctor の名前が Eliza (女性)なので、声は女性の Agnes を選んでみました。
声は他に Alex, Trinoids, Zarvox, Hysterical, Bad News, Good News 等があり、システム環境設定のスピーチで確認できます。

声を Hysterical にするとどちらが医者なのかわからなくなります。
リターン連打で何人もの医者から詰問を受けている気分になります。

いずれにせよ鬱陶しさ3割増といったところでしょうか。

2011-03-02

replace-regexp に入力する手間を省く replace-multi-pairs

Emacs で M-x replace-string や M-x replace-regexp はテキスト編集では日常的に使います。
しかし、複雑な正規表現や、同一の検索置換を何度か実行していると一つ不満が出てきました。

検索文字列と置換文字列を毎回入力せねばならない。

ミニバッファの履歴を辿ることもできますが、検索文字列と置換文字列で履歴を共有していたりと微妙な面倒くささがあります。

よく使う検索文字列と置換文字列の組み合わせを保存しておいて、一発で呼び出したい。できれば複数の検索置換を一回で済ませたい。

そこで書いたものが
replace-multi-pairs
(defgroup replace-multi-pairs nil
  "Replace multiple pairs of strings."
  :group 'editing)

(defcustom replace-multi-pairs-alist
  '( ;; default pairs
    ("default"
     ("[ \t]+$" "" t))
    ;; Text to XML, HTML.
    ;; Similar to M-x sgml-quote
    ("html-quote"
     ("&"   "&amp;")
     ("<"   "&lt;")
     (">"   "&gt;")
     ("'"   "&apos;")
     ("\""  "&quot;"))
    ;; XML, HTML to Text.
    ;; Similar to C-u M-x sgml-quote
    ("html-unquote"
     ("&lt;"        "<")
     ("&gt;"        ">")
     ("&apos;"      "'")
     ("&quot;"      "\"")
     ("&nbsp;"      " ")
     ("&amp;"       "&"))
    ;; <br />
    ("br"
     ("\n" "<br />\n"))
    ;; Flush blank lines.
    ;; Similar to M-x delete-blank-lines (C-x C-o)
    ("no-blank"
     ("^[ \t]*\n" "" t))
    ;; Delete spaces and tabs at the end of line.
    ;; Similar to M-x delete-trailing-whitespace
    ("no-trailing"
     ("[ \t]+$" "" t))
    ;; Delete indentations.
    ;; Same as C-u 0 M-x indent-region (C-M-\)
    ("no-indent"
     ("^[ \t]+" "" t))
    ;; Delete line breaks. Like M-x join-line
    ;;     )
    ;;   )
    ;; )
    ;; -->
    ;;     )))
    ("no-break"
     ("[ \t]*\n[ \t]*" "" t))
    ;; Replace consecutive spaces and tabs with just one space.
    ;; Similar to M-x just-one-space (M-SPC)
    ("one-space"
     ("[ \t]+" " " t))
    ;; Extract URLs and delete other lines. For HTML source, etc.
    ("url"
     ("^" " " t)
     ("\\([^h]\\)ttp\\(s?\\)://" "\\1http\\2://" t)
     ("\\([^ft]\\)tp\\(s?\\)://" "\\1http\\2://" t)
     ("h?[ft]tps?://[-_.!~*'()a-zA-Z0-9;/?:@&=+$,%#]+" "\n\\&\n " t)
     ("^hftp" " " t)
     ("^ .*$" "" t)
     ("^\n" "" t)
     ("'$" "" t))                       ; not correct. for HTML source
    ;; \ -> \\ and " -> \"
    ("quote-string"
     ("\\\\\\|\"" "\\\\\\&" t))
    ;; \" -> " and \\ -> \
    ("unquote-string"
     ("\\\"" "\"")
     ("\\\\" "\\"))
    ;; a "b" \c -> "a \"b\" \\c\n"
    ("quote-lines"
     ("\\\\\\|\"" "\\\\\\&" t)
     (".*" "\"\\&\\\\n\"" t))
    ;; "0001: "
    ;; "0002: "
    ;; "0003: "
    ("number-lines"
     ("^" "\\,(format \"%04d: \" (1+ \\#))" t))
    ;; M-: (regexp-quote "")
    ("regexp-quote"
     (".+" "\\,(regexp-quote \\&)" t))
    ;; 全角英数のみ半角に
    ;; C-u C-x japanese-hankaku-region では ー が - に変換される
    ("hankaku"
     ("\\cA" "\\,(japanese-hankaku \\& t)" t)))

  "Alist of pairs of search string and replacement.
Each element looks like:

\(KEY (SEARCH-STRING REPLACEMENT REGEXP-FLAG DELIMITED-FLAG) ...)

KEY is a string which is a name of pairs.

SEARCH-STRING and REPLACEMENT are strings as described in
`replace-string' and `replace-regexp'. REPLACEMENT may contain
`\\,' followed by a Lisp expression and some other letters
that `replace-regexp' accepts in interactive calls.

When REGEXP-FLAG is non-nil, SEARCH-STRING and REPLACEMENT
are treated as regexp.
DELIMITED-FLAG is as in `replace-string' and `replace-regexp'."
  :type '(alist :key-type (string :tag "Key")
                :value-type
                (repeat :tag "Pairs of search string and replacement"
                        (group
                         (string  :tag "Search string")
                         (string  :tag "Replacement")
                         (boolean :tag "Regexp flag")
                         (boolean :tag "Delimited flag"))))
  :group 'replace-multi-pairs)

(defcustom replace-multi-pairs-require-prefix nil
  "Non-nil means prompt for key with \\[universal-argument].
If nil, always prompt unless \\[universal-argument] is given.

Without prompt, the first element of `replace-multi-pairs-alist'
is used as key."
  :type 'boolean
  :group 'replace-multi-pairs)

(defvar replace-multi-pairs-history nil
  "History list for `replace-multi-pairs'.")

(defun replace-multi-pairs-count ()
  (let ((message (current-message)))
    (if (and message
             (string-match "^Replaced \\([0-9]+\\) " message))
        (string-to-number (match-string 1 message))
      0)))

(defun replace-multi-pairs-1 (beg end key)
  "Perform replacement starting from BEG to END using KEY.
Return the total number of replaced occurrences."
  (let ((limit (copy-marker (max beg end)))
        (count 0)
        (orig-push-mark (symbol-function 'push-mark))
        (orig-undo-boundary (symbol-function 'undo-boundary))
        (orig-deactivate-mark (symbol-function 'deactivate-mark)))
    (fset 'push-mark (symbol-function 'ignore))
    (fset 'undo-boundary (symbol-function 'ignore))
    (fset 'deactivate-mark (symbol-function 'ignore))
    (unwind-protect
        (dolist (args (cdr (assoc key replace-multi-pairs-alist)) count)
          (unless args
            (error "Bad key: %s" key))
          (perform-replace (nth 0 args)
                           (query-replace-compile-replacement
                            (nth 1 args) (nth 2 args))
                           nil (nth 2 args) (nth 3 args)
                           nil nil (min beg end) limit)
          (setq count (+ count (replace-multi-pairs-count))))
      (fset 'push-mark orig-push-mark)
      (fset 'undo-boundary orig-undo-boundary)
      (fset 'deactivate-mark orig-deactivate-mark))))

(defun replace-multi-pairs-read ()
  (let ((completion-ignore-case t)
        (default (or (car replace-multi-pairs-history)
                     (caar replace-multi-pairs-alist))))
    (completing-read
     (format "Which regexp? (default %s): " default)
     replace-multi-pairs-alist nil t nil
     'replace-multi-pairs-history default)))

(defun replace-multi-pairs (beg end &optional key)
  "Replace text between BEG and END using KEY.
KEY is one of keys of `replace-multi-pairs-alist', which defines
multiple pairs of search string and replacement.

In interactive calls, when the region is active, operate on the region;
otherwise operate from the current point to the end of the buffer.

Prompt for KEY depending on the prefix argument and the value of
`replace-multi-pairs-require-prefix'.
If KEY is not specified, the first element of
`replace-multi-pairs-alist' is used."
  (interactive
   (let (beg end key)
     (barf-if-buffer-read-only)
     (when (or (and replace-multi-pairs-require-prefix
                    current-prefix-arg)
               (and (null replace-multi-pairs-require-prefix)
                    (null current-prefix-arg)))
       (setq key (replace-multi-pairs-read)))
     (if (and transient-mark-mode mark-active)
         (setq beg (region-beginning)
               end (region-end))
       (setq beg (point)
             end (point-max)))
     (list beg end key)))
  (let (count)
    (setq key (or key (caar replace-multi-pairs-alist)))
    (push-mark)
    (when (and transient-mark-mode mark-active)
      (deactivate-mark))
    (setq count (replace-multi-pairs-1 beg end key))
    (message "Replaced %d occurrence%s in total (%s)"
             count (if (= 1 count) "" "s") key)))

;; (global-set-key "\C-cr" 'replace-multi-pairs)


動作確認:GNU Emacs 22

<使い方>
キーに設定した文字列で置換を行うには、範囲選択して
M-x replace-multi-pairs RET キー RET

キーはタブで補完が効き、変数 replace-multi-pairs-alist で設定します。
replace-multi-pairs-alist は M-x customize の Editing からでも編集できます。
replace-multi-pairs-alist を直接編集する場合、各要素は以下のような構成になります。

("キー"
 ("検索文字列1" "置換文字列1" 正規表現フラグ ワード区切りフラグ)
 ("検索文字列2" "置換文字列2" 正規表現フラグ ワード区切りフラグ)
 ...)

・キーは任意の文字列です。
・検索文字列と置換文字列は replace-regexp, replace-string で使う書式がそのまま使えます。
・正規表現フラグは non-nil ならば、 replace-regexp と同じ動作。nil または省略されたならば、 replace-string。
・ワード区切りフラグは non-nil ならば C-u 付きで replace-regexp, replace-string を実行した時と同じ挙動に。

default と html-quote を設定した例。
(setq replace-multi-pairs-alist
      '(("default"
         ("[ \t]+$" "" t))
        ("html-quote"
         ("&"   "&amp;")
         ("<"   "&lt;")
         (">"   "&gt;")
         ("'"   "&apos;")
         ("\""  "&quot;"))))
default は正規表現で行末のスペースとタブを削除。
M-x replace-multi-pairs RET default RET
html-quote は & 等をHTMLタグに一括置換。
M-x replace-multi-pairs RET html-quote RET

replace-multi-pairs-alist の初期値として色々設定してあるので、参考程度にはなるかと思います。






以下余談。

replace-multi-pairs では検索置換する関数として perform-replace を使っています。
perform-replace は query-replace, query-replace-regex, replace-string, replace-regexp の下請け関数です。
ヘルプにはこう書いてあります。
Subroutine of `query-replace'.  Its complexity handles interactive queries.
Don't use this in your own program unless you want to query and set the mark
just as `query-replace' does.  Instead, write a simple loop like this:

  (while (re-search-forward "foo[ \t]+bar" nil t)
    (replace-match "foobar" nil nil))

which will run faster and probably do exactly what you want.  Please
see the documentation of `replace-match' to find out how to simulate
`case-replace'.

要約すると、自作のプログラムからはこの関数を使わずに、 re-search-forward のループを書きなさい、ということ。
しかし、それを承知した上で replace-multi-pairs では perform-replace を使ってます。
理由は replace-regexp の検索文字列と置換文字列の書式がそのまま使えるからです。

例えば行末に foobar と付け加えるためこのようなコマンドを使います。
M-x replace-regexp RET $ RET foobar RET

それと同じことをしようとして、以下のようなコードを書くと無限ループになります。

(while (re-search-forward "$" nil t)
  (replace-match "foobar" nil nil))

同様に、全角英数を半角英数に変換する場合、 \, を使った Lisp の式を書けますが、
M-x replace-regexp RET \cA RET \,(japanese-hankaku \& t) RET

それと同じことをしようとしても、意図した通りには動きません。

(while (re-search-forward "\\cA" nil t)
  (replace-match "\\,(japanese-hankaku \\& t)" nil nil))

ただ perform-replace を使う注意点として、その関数から呼ばれる push-mark, undo-boundary, deactivate-mark の3つの関数は、実行されると不自然な挙動になるので、一時的に ignore に置き換えています。

2011-02-27

日本語混じりの文章で hippie-expand を使う

Emacs にはデフォルトで M-/ に dabbrev-expand が割り当てられていますが、 hippie-expand の方がファイルのパスや Elisp のシンボルも補完してくれる等、機能が豊富です。

hippie-expand の問題点

日本語Nihongo日本語。にほんごNiho-!-

上の例文でカーソル位置は -!- にあります。 M-x hippie-expand としても Nihongo とは補完されません。
理由として2点あります。

(1) Nihongo という単語の両端にスペースがない。
(2) Niho という単語の頭にスペースがない。

半角文字は常にスペースで囲う癖をつければいいのですが、やや面倒です。

(1) の問題を解決するには関数 he-dabbrev-search の再定義をします。

(2) の問題を解決する方法はここの he-dabbrev-beg の定義で示されています。
http://ko.meadowy.net/~shirai/diary/?date=20060125

(1) と (2) の問題を解決したものが以下で、
半角英数、全角英数、漢字、ひらがな、カタカナ、等、同一カテゴリの文字のみを補完するようになります。

(defun my-char-category-regexp (char)
  (let ((c (char-category-set char)))
    (cond
     ((aref c ?a) "\\ca")               ; ASCII
     ((aref c ?j)                       ; Japanese
      (cond
       ((aref c ?K) "\\cK")             ; katakana
       ((aref c ?H) "\\cH")             ; hiragana
       ((aref c ?k) "\\ck")             ; hankaku-kana
       ((aref c ?C) "\\cC")             ; kanji
       ((aref c ?A) "\\cA")             ; 2byte alphanumeric
       ((aref c ?r) "\\cr")             ; Japanese roman ?
       (t "\\cj")))
     ((aref c ?l) "\\cl")               ; Latin
     (t "."))))

;; このコードから借用
;; http://ko.meadowy.net/~shirai/diary/?date=20060125
;; syntax と hippie-expand-dabbrev-as-symbol を使うよう変更。
(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 ((category-regexp (my-char-category-regexp (char-before)))
          (syntax-regexp (if hippie-expand-dabbrev-as-symbol
                             "\\sw\\|\\s_" "\\sw")))
      (save-excursion
        (when (> (point) (minibuffer-prompt-end))
          (forward-char -1)
          (while (and (looking-at syntax-regexp)
                      (looking-at category-regexp)
                      (> (point) (minibuffer-prompt-end))
                      (not (= (point) (field-beginning (point) nil
                                                       (1- (point))))))
            (forward-char -1))
          (or (and (looking-at category-regexp)
                   (looking-at syntax-regexp))
              (forward-char 1)))
        (setq ad-return-value (point))))))

;; syntax と category 両方合致するものを検索する
(defun my-he-dabbrev-search-1 (pattern regpat reverse limit)
  (let ((category-regexp (concat (my-char-category-regexp (aref pattern 0))
                                 "+")))
    (when (if reverse
              (re-search-backward regpat limit t)
            (re-search-forward regpat limit t))
      (if reverse
          (save-excursion
            (goto-char (match-beginning 0))
            (re-search-forward category-regexp (match-end 0) t))
        (goto-char (match-beginning 0))
        (re-search-forward category-regexp (match-end 0) t)))))

;; he-dabbrev-search の再定義。変更個所は [1] [2] [3]
;; 以下の3つの関数から呼ばれる
;; try-expand-dabbrev-visible
;; try-expand-dabbrev
;; try-expand-dabbrev-all-buffers
(defun my-he-dabbrev-search (pattern &optional reverse limit)
  (let ((result ())
        (regpat (cond ((not hippie-expand-dabbrev-as-symbol)
                       (concat "\\<" (regexp-quote pattern) "\\sw+"))
                      ((eq (char-syntax (aref pattern 0)) ?_)
                       (concat (regexp-quote pattern) "\\(\\sw\\|\\s_\\)+"))
                      (t
                       (concat "\\<" (regexp-quote pattern)
                               "\\(\\sw\\|\\s_\\)+")))))
    (while (and (not result)
                ;; [1]
                (my-he-dabbrev-search-1 pattern regpat reverse limit))
      (setq result (buffer-substring-no-properties (match-beginning 0)
                                                   (match-end 0)))
      (if (or (and hippie-expand-dabbrev-as-symbol
                   (> (match-beginning 0) (point-min))
                   (memq (char-syntax (char-after (1- (match-beginning 0))))
                         '(?_ ?w))
                   ;; [2]
                   (eq (char-charset (char-after (1- (match-beginning 0))))
                       'ascii))
              ;; [3]
              (<= (length result) (length pattern))
              (he-string-member result he-tried-table t))
          (setq result nil))) ; ignore if bad prefix or already in table
    result))
(fset 'he-dabbrev-search 'my-he-dabbrev-search)

動作確認:GNU Emacs 22

2011-03-28 追記
関数 my-he-dabbrev-search-1 の引数 reverse が non-nil の時うまく動作していなかったのを修正。

2011-02-23

Lisp mode のカーソル移動 forward-list

Elisp を書くようになると、括弧関連のカーソル移動のコマンドも多用するようになります。

C-M-f, C-M-b S式単位で前後に移動
C-M-a, C-M-e 関数単位で移動
C-M-d, C-M-u 括弧の内側外側へ移動
C-M-p, C-M-n 括弧単位で前後に移動

この中で、唯一 C-M-n (M-x forward-list) だけ、挙動に納得がいかなかった。

(-0- list (list)-1-
          (list)-2-)

-0- がスタート地点で、 -1- が C-M-n の1回目の実行後。-2- が2回目の地点。
カーソルが括弧の後ろに移動します。この動きなら C-M-f で代用可能です。

期待したのは以下のように、括弧の先頭へのカーソル移動。

(-0- list -1-(list)
          -2-(list))

ということで、自分でコマンドを作るとこんな感じに。

(defun my-forward-list (&optional arg)
  "Do `forward-list' and `backward-sexp'."
  (interactive "p")
  (or arg (setq arg 1))
  (let ((start (point))
        end)
    (if (and (= arg 1)
             (= start (scan-sexps (scan-lists start 1 0) -1)))
        (setq end (scan-lists start 2 0))
      (setq end (scan-lists start arg 0)))
    (goto-char (or (and end (scan-sexps end -1))
                   (buffer-end arg)))))

(eval-after-load "lisp-mode"
  '(define-key lisp-mode-shared-map "\C-\M-n" 'my-forward-list)) ; forward-list

動作確認: GNU Emacs 22

2011-02-21

Mac OS X の拡張属性を消す removexattr

Mac OS X の拡張属性 (EA, Extended Attributes) はリソースフォーク、クリエータタイプ、不可視属性、等の HFS+ 固有のレガシーなものから、 com.apple.quarantine のような最近追加されたものまで色々あります。

拡張属性を確認する場合。
ls -l@ file
xattr file


普通は拡張属性を消す必要はないんですが、Windows の FAT32 のボリュームに Mac から拡張属性の付いたファイルをコピーすると、 file と ._file のように2つのファイルとしてコピーされます。できれば ._file のようなファイルは作りたくない。

消す場合は xattr コマンドで -d オプション。 com.apple.quarantine のような名前を指定する必要あり。
xattr -d com.apple.quarantine file

一つのファイルから全ての拡張属性を消すにはシェルスクリプトを書く必要があります。
しかしながら、 xattr (中身は python スクリプト) が妙に遅かったので、 C で書いたものが以下。

removexattr.c
/*
 * Require Mac OS X 10.4 or above.
 * man 2 listxattr
 * man 2 removexattr
 * gcc -O2 -o removexattr removexattr.c
 */

#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <stdint.h>

#include <sys/xattr.h>

#define BUFSIZE 0x8000

int main(int argc, const char *argv[])
{
    int i, len;
    uint8_t *namebuf, *p;
    ssize_t size;

    if (argc <= 1) {
        fprintf(stderr,
                "Remove all extended attributes from given files or directories.\n"
                "Usage: %s [file ...]\n", argv[0]);
        exit(1);
    }

    namebuf = (uint8_t *)malloc(BUFSIZE);
    if (namebuf == NULL) {
        fprintf(stderr, "malloc() failed\n");
        exit(1);
    }

    for (i = 1; i < argc; i++) {
        size = listxattr(argv[i], namebuf, BUFSIZE, XATTR_NOFOLLOW);
        if (size <= 0)
            continue;

        p = namebuf;
        len = 0;
        while (len < size) {
            removexattr(argv[i], p, XATTR_NOFOLLOW);
            len = len + strlen(p) + 1;
            p = namebuf + len;
        }
    }

    free(namebuf);

    return 0;
}

コンパイルは (要Xcode)
gcc -O2 -o removexattr removexattr.c
使い方は
./removexattr file

find の -exec で指定ディレクトリ以下全てのファイル、フォルダの拡張属性を消すこともできますが、それはさすがに勇気がいります。

動作確認: Mac OS X 10.6

2011-02-20

Emacs で HTTP レスポンスヘッダを表示

emacs-w3m で = 打鍵してもヘッダは確認できますが、 URL をウェブブラウザで開く前に HEAD メソッドで手軽に確認したい、というのが今回の話。

以下のような時に使います。

  • Twitter 等でよく使われる短縮 URL の転送先の確認
  • ウェブページの最終更新日の確認
  • ウェブにアップロードされたファイルのサイズの確認

コマンドラインで
curl -I http://www.example.com/
でもいいのですが、 Emacs 使いならもっと手軽にやりたい。

Show HTTP response header

(defvar my-show-http-header-history nil
  "History list.")
(defvar my-show-http-header-config nil
  "Window configuration.")
(make-variable-buffer-local 'my-show-http-header-config)
(defvar my-show-http-header-name "*HTTP response header*"
  "Buffer name.")

(defun my-show-http-header-read ()
  (let ((default (progn
                   (unless (fboundp 'ffap-url-at-point)
                     (require 'ffap))
                   (ffap-url-at-point))))
    (read-string (if default
                     (format "URL (default %s): " default)
                   "URL: ")
                 nil 'my-show-http-header-history default)))

(defun my-show-http-header-colorize ()
  (save-excursion
    (goto-char (point-min))
    (while (re-search-forward
            "\\(^[Ll]ocation: \\|^[Ll]ast-[Mm]odified: \\)" nil t)
      (add-text-properties (point)
                           (line-end-position)
                           '(face font-lock-keyword-face)))))

(defun my-show-http-header (url &optional use-url)
  "Show HTTP response header of URL.
With prefix arg USE-URL, use `url-retrieve-synchronously'
instead of curl."
  (interactive
   (list (my-show-http-header-read) current-prefix-arg))
  (when (or (not (stringp url))
            (not (string-match "^https?://" url)))
    (error "No URL"))
  (let (window-config)
    ;; Save the window state before pop-to-buffer.
    (when (and (null (get-buffer-window my-show-http-header-name))
               (not (window-minibuffer-p (selected-window))))
      (setq window-config (current-window-configuration)))
    (pop-to-buffer (get-buffer-create my-show-http-header-name))
    (let (buffer-read-only)
      (unwind-protect
          (progn
            (erase-buffer)
            (insert (concat "URL: " url "\n\n"))
            (if use-url  ; or (null use-url) to inverse the prefix arg
                (insert-buffer (let ((url-max-redirections 0)
                                     (url-privacy-level 'paranoid)
                                     (url-request-method "HEAD"))
                                 (url-retrieve-synchronously url))))
            (call-process "curl" nil t nil
                          "-I" "-s" "-k"
                          "-A" "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)"
                          url))
        (goto-char (point-min))
        (save-excursion
          (while (re-search-forward "\r\n" nil t)
            (replace-match "\n")))
        (my-show-http-header-colorize)))
      (when window-config
        (setq my-show-http-header-config window-config))
      (setq view-exit-action (lambda (buffer)
                               (when my-show-http-header-config
                                 (set-window-configuration
                                  my-show-http-header-config))
                               (kill-buffer buffer)))
      (view-mode-enter)))

;; (global-set-key "\C-cH" 'my-show-http-header)

特徴

  • カーソル位置の URL を読み取ってくれるので、手入力する手間が省けます。
  • q 打鍵一発で元のウィンドウの状態に戻ります。
  • Location ヘッダと Last-Modified ヘッダは色付けされます。
  • デフォルトでは外部プログラムの curl を使いますが、 C-u 付きで実行すれば Emacs に含まれる url.el ライブラリを使います。

サーバーによっては User-Agent や Referer 等のリクエストヘッダを見てレスポンスヘッダを変えてきたりしますが、その辺は curl のオプション等を適当にいじってみてください。

使い方
M-x my-show-http-header RET http://tinyurl.com/1awl RET

結果

URL: http://tinyurl.com/1awl

HTTP/1.1 301 Moved Permanently
X-Powered-By: PHP/5.3.5
Location: http://www.google.co.jp/
X-tiny: cache 0.00046396255493164
Content-type: text/html
Connection: close
Date: Wed, 18 Feb 2011 15:03:09 GMT
Server: TinyURL/1.6




動作確認: GNU Emacs 22, Mac OS X 10.6

2011-02-19

Finder で最前面に表示されているフォルダを Emacs (Dired) で開く

Finder に切り替えて、フォルダを Dock の Emacs アイコンにドラッグ&ドロップすればいいのですが、もっと手軽にやりたい。

do-applescript 関数は互換性に関して面倒が多いので、 osascript を使います。

(defun my-dired-finder-window ()
  "Open the front most window of Finder in dired."
  (interactive)
  (let (file
        (script (concat
                 "tell application \"Finder\"\n"
                 "    if ((count Finder windows) >= 1) then\n"
                 "        get POSIX path of (target of window 1 as alias)\n"
                 "    else\n"
                 "        get POSIX path of (desktop as alias)\n"
                 "    end if\n"
                 "end tell\n")))
    (setq file (with-temp-buffer
                 (call-process "osascript" nil t nil "-e" script)
                 (buffer-substring-no-properties (point-min) (1- (point-max)))))
    (if (file-directory-p file)
        (dired file)
      (error "Not a directory: %s" file))))

(global-set-key "\C-cf" 'my-dired-finder-window)

動作確認: GNU Emacs 22, Mac OS X 10.6

2011-02-18

Dired からゴミ箱に捨てる、情報を見る、 Finder で表示

AppleScript でやるわけですが、 Emacs の do-applescript 関数は以下の3つの環境でのみ使用できるのを確認しています。X11 版は未確認です。

・ Cocoa Emacs の GUI 起動
・ Carbon Emacs の GUI 起動
・ Carbon Emacs の -nw 起動

3つそれぞれ微妙に違ったコードを書かなければならず面倒なので、 do-applescript は使わず外部コマンドの osascript を呼ぶ方法を紹介します。

キーバインドの例では、
M-DEL で Finder の「ゴミ箱に入れる」
M-i で Finder の「情報を見る」
M-r で Finder の「オリジナルを表示」
に割り当ててますが、適当に変えてください。 (特に M-r)

Dired で Finder の「ゴミ箱に入れる」
(defun my-dired-do-trash-1 (async &rest files)
  (let ((script
         (concat
          "on run argv\n"
          "    set itemArray to {}\n"
          "    repeat with i in argv\n"
          "        set itemArray to itemArray & (i as POSIX file as Unicode text)\n"
          "    end repeat\n"
          "    tell application \"Finder\"\n"
          "        delete itemArray\n"
          "    end tell\n"
          "end run\n")))
    (if async
        (apply 'start-process "osascript-trash" nil "osascript" "-e" script files)
      (apply 'call-process  "osascript" nil nil nil "-e" script files))))

;; Trash files
(defun my-dired-do-trash (&optional arg)
  "Trash the marked files.
If no files are marked or a specific numeric prefix arg is given,
the next ARG files are used.  Just \\[universal-argument] means the current file."
  (interactive "P")
  (let ((files (dired-get-marked-files nil arg))
        point)
    (message "Trashing...")
    ;; Position of the first mark
    (save-excursion
      (goto-char (point-min))
      (setq point (re-search-forward dired-re-mark nil t)))
    (unless point
      (setq point (point)))
    (apply 'my-dired-do-trash-1 nil files)
    (revert-buffer)
    ;; Restore the position
    (goto-char (point-min))
    (forward-line (line-number-at-pos point))
    (forward-line -1)
    (dired-move-to-filename)
    (message "Trashing...done")
    ;; Display the result
    (if (null (cdr files))
        (message "Trashed 1 item: %s" (file-name-nondirectory (car files)))
      (display-message-or-buffer
       (format "Trashed %d items:\n%s"
               (length files)
               (mapconcat 'file-name-nondirectory files "\n"))))))

(eval-after-load "dired"
  '(define-key dired-mode-map "\M-\C-?" 'my-dired-do-trash)) ; M-DEL, dired-unmark-all-files, use U or * ? RET

Dired で Finder の「情報を見る」
;; Get info
(defun my-dired-do-getinfo (&optional arg)
  "Show Finder's information window of the marked files.
If no files are marked or a specific numeric prefix arg is given,
the next ARG files are used.  Just \\[universal-argument] means the current file."
  (interactive "P")
  (let ((files (dired-get-marked-files nil arg))
        (script
         (concat
          "on run argv\n"
          "    tell application \"Finder\"\n"
          "        activate\n"
          "    end tell\n"
          "    repeat with i in argv\n"
          "        set i to (i as POSIX file as Unicode text)\n"
          "        tell application \"Finder\"\n"
          "            open information window of item i\n"
          "        end tell\n"
          "    end repeat\n"
          "end run\n")))
    (apply 'start-process "osascript-getinfo" nil "osascript" "-e" script files)))

(eval-after-load "dired"
  '(define-key dired-mode-map "\M-i" 'my-dired-do-getinfo)) ; tab-to-tab-stop

Dired で Finder の「オリジナルを表示」
;; Reveal in Finder
(defun my-dired-do-reveal (&optional arg)
  "Reveal the marked files in Finder.
If no files are marked or a specific numeric prefix arg is given,
the next ARG files are used.  Just \\[universal-argument] means the current file."
  (interactive "P")
  (let ((files (dired-get-marked-files nil arg))
        (script
         (concat
          "on run argv\n"
          "    set itemArray to {}\n"
          "    repeat with i in argv\n"
          "        set itemArray to itemArray & (i as POSIX file as Unicode text)\n"
          "    end repeat\n"
          "    tell application \"Finder\"\n"
          "        activate\n"
          "        reveal itemArray\n"
          "    end tell\n"
          "end run\n")))
    (apply 'start-process "osascript-reveal" nil "osascript" "-e" script files)))

(eval-after-load "dired"
  '(define-key dired-mode-map "\M-r" 'my-dired-do-reveal)) ; move-to-window-line

動作確認: GNU Emacs 22, Mac OS X 10.6

日本語や濁点の付いたファイル名に対しても動作しています。
手元の GNU Emacs 22 (Carbon) では「名\称\\未\\\設"定""フ"""ォルダ」のような悪魔的フォルダ名に対しては Dired がファイル名の取得に失敗します。これは Dired の問題です。
osascript の引数処理の関係で Mac OS X 10.4 以上が必要と思われます。


Terminal からゴミ箱に捨てる方法はこちら。 コマンドラインからゴミ箱に捨てるシェルスクリプト

2011-02-17

コマンドラインからゴミ箱に捨てるシェルスクリプト

Mac OS X 用のゴミ箱スクリプトは検索すれば結構出てくるものの、どれもファイルを直接 ~/.Trash 等に移動するものが多いような気がする。
外付け HDD の場合はゴミ箱のパスが違うし、移動先に同じファイル名がある場合の処理とか、結構面倒くさい。

面倒くさいので全部 Finder に丸投げ、ということで AppleScript 経由でゴミ箱に捨てるスクリプトがこちら。

Finder で「ゴミ箱に入れる」
trash
#!/bin/sh

# Trash items.
# Usage: trash [files]

# Backslashes and doublequotes must be escaped.
# replace  \  -->  \\
# replace  "  -->  \"
CWD=`pwd | sed -E -e 's/\\\\/\\\\\\\\/g' -e 's/"/\\\\"/g'`

osascript - "$@" <<EOF
on run argv
    set itemArray to {}

    repeat with i in argv
        if first character of i is not "/" then
            set i to "$CWD" & "/" & i
        end if
        set itemArray to itemArray & (i as POSIX file as Unicode text)
    end repeat

    tell application "Finder"
        delete itemArray
    end tell
end run
EOF

動作確認:Mac OS X 10.6 (osascript の引数処理の関係で Mac OS X 10.4 以上が必要と思われます。)

使う場合、実行権限を付けて PATH の通った所へファイルを置いてください。
使い方の例: hoge.txt fuga.txt を捨てる
trash hoge.txt fuga.txt

AppleScript を使う利点としては、このスクリプトでゴミ箱に捨てた直後ならば、 Finder で「取り消す Cmd-Z」ができる。 Mac OS X 10.6 からはゴミ箱内の項目を「戻す」ことができるので、それにも対応している。欠点としては動作が遅い。


以下はおまけの Finder で「オリジナルを表示」と「情報を見る」のスクリプト。

Finder で「オリジナルを表示」
reveal
#!/bin/sh

# Reveal in Finder.
# Usage: reveal [files]

CWD=`pwd | sed -E -e 's/\\\\/\\\\\\\\/g' -e 's/"/\\\\"/g'`

osascript - "$@" <<EOF
on run argv
    set itemArray to {}

    repeat with i in argv
        if first character of i is not "/" then
            set i to "$CWD" & "/" & i
        end if
        set itemArray to itemArray & (i as POSIX file as Unicode text)
    end repeat

    tell application "Finder"
        activate
        reveal itemArray
    end tell
end run
EOF

Finder で「情報を見る」
getinfo
#!/bin/sh

# Show information window in Finder.
# Usage: getinfo [files]

CWD=`pwd | sed -E -e 's/\\\\/\\\\\\\\/g' -e 's/"/\\\\"/g'`

osascript - "$@" <<EOF
on run argv
    repeat with i in argv
        if first character of i is not "/" then
            set i to "$CWD" & "/" & i
        end if
        set i to (i as POSIX file as Unicode text)

        tell application "Finder"
            open information window of item i
        end tell
    end repeat

    tell application "Finder"
        activate
    end tell
end run
EOF

Emacs の Dired からゴミ箱に捨てる方法はこちら。 Dired からゴミ箱に捨てる、情報を見る、 Finder で表示

2011-02-16

EmacsのバッファやDiredでカーソル位置のファイルを Quick Look

Mac OS X には qlmanage という便利なコマンドがあるのでそれを使う。

C-c y で Quick Look。もう一度 C-c y で、Quick Look を閉じる。
call-process を使って C-g で閉じるのもいいですが、やや反応が鈍いので下の例では start-process を使っています。

(defun my-quicklook-at-point ()
  "Preview a file at point with Quick Look."
  (interactive)
  (require 'ffap)
  (let ((url (ffap-url-at-point))
        (file (ffap-file-at-point))
        (process (get-process "qlmanage_ps")))
    (when url
      (if (string-match "\\`file://\\(.*\\)\\'" url)
          (setq file (match-string 1 url))
        (setq file nil)))
    (when (or (not (stringp file))
              (not (file-exists-p (setq file (expand-file-name file)))))
      (when process
        (kill-process process))
      (error "No file found"))
    (if process
        (kill-process process)
      (message "Quick Look: %s" file)
      (start-process "qlmanage_ps" nil "qlmanage" "-p" file))))

(global-set-key "\C-cy" 'my-quicklook-at-point)

Dired の設定。

(defun my-dired-do-quicklook ()
  "In dired, preview with Quick Look."
  (interactive)
  (let ((file (dired-get-filename))
        (process (get-process "qlmanage_ps")))
    (if process
        (kill-process process)
      (start-process "qlmanage_ps" nil "qlmanage" "-p" file))))

(eval-after-load "dired"
  '(define-key dired-mode-map "\C-cy" 'my-dired-do-quicklook))

キーバインドは適当に変えてください。

動作確認:GNU Emacs 22, Mac OS X 10.6

EmacsのバッファやDiredでカーソル位置のファイル(URL)をFinder(ウェブブラウザ)で開く

Finder でダブルクリックした時と同じ動作をさせたい場合、 Mac OS X には open という便利なコマンドがあるのでそれを使う。

;; カーソル位置のファイルや URL を open で開く
(defun my-open-at-point ()
  "Ask /usr/bin/open to open the thing at or before point."
  (interactive)
  (require 'ffap)
  (let ((file (or (ffap-url-at-point)
                  (ffap-file-at-point))))
    (unless (stringp file)
      (error "No file or URL found"))
    (when (file-exists-p (expand-file-name file))
      (setq file (expand-file-name file)))
    (message "Open: %s" file)
    (start-process "open_ps" nil "open" file)))

(global-set-key "\C-co" 'my-open-at-point)
;; double click
(global-set-key [double-mouse-1] 'my-open-at-point)
(global-set-key [double-down-mouse-1] 'ignore) ; mouse-drag-region

キーバインドは一例ですが、ダブルクリックにも割り当ててます。
以下のようなURLやファイルに対応します。

http://www.google.co.jp/
~/Library
/usr/include/stdio.h
#include <stdio.h>

注意点として、 (require 'hoge) のような文字列に対して実行すると、 hoge.el.gz というファイルが開き、 .gz が解凍されてしまう場合があります。この辺の挙動は y-or-n-p とか使って確認してから開く、という風に変えてもいいかもしれない。

以下 Dired の設定。

;; カーソル位置のファイルを open で開く
(defun my-dired-do-open (&optional arg)
  "In dired, invoke /usr/bin/open on the marked files.
If no files are marked or a specific numeric prefix arg is given,
the next ARG files are used.  Just \\[universal-argument] means the current file."
  (interactive "P")
  (let ((files (dired-get-marked-files nil arg)))
    (apply 'start-process "open_ps" nil "open" files)))

(eval-after-load "dired"
  '(define-key dired-mode-map "\C-co" 'my-dired-do-open))

動作確認: Mac OS X 10.6, GNU Emacs 22

2011-02-15

highlight-parentheses.el を使ってみる

対応する括弧に色を付けてくれる
HighlightParentheses
http://nschum.de/src/emacs/highlight-parentheses/

設定はこんな感じに
(require 'highlight-parentheses)
(setq hl-paren-colors '("red" "blue" "yellow" "green" "magenta" "peru" "cyan"))
(set-face-attribute 'hl-paren-face nil :weight 'bold)
(add-hook 'emacs-lisp-mode-hook 'highlight-parentheses-mode)

結果はこんな風
(defun hl-paren-highlight ()
  "Highlight the parentheses around point."
  (unless (= (point) hl-paren-last-point)
    (setq hl-paren-last-point (point))
    (let ((overlays hl-paren-overlays)
          pos1 pos2
          (pos (point)))
      (save-excursion
        (condition-case err
            (while (and (setq pos1 (cadr (syntax-ppss pos1)))
                        (car overlays))
              (move-overlay (pop overlays) pos1 (1+ pos1))
              (when (setq pos2 (scan-sexps pos1 1))
                (move-overlay (pop overlays) (1- pos2) pos2)))
          (error nil)))
      (dolist (ov overlays)
        (move-overlay ov 1 1)))))


バージョン 2009-03-19 (1.0.1) の時点では、 hl-paren-colors に設定した最後の色が有効にならないので関数 hl-paren-highlight に以下のパッチを当てる。
--- highlight-parentheses.el.old
+++ highlight-parentheses.el
@@ -100,7 +100,7 @@
       (save-excursion
         (condition-case err
             (while (and (setq pos1 (cadr (syntax-ppss pos1)))
-                        (cddr overlays))
+                        (car overlays))
               (move-overlay (pop overlays) pos1 (1+ pos1))
               (when (setq pos2 (scan-sexps pos1 1))
                 (move-overlay (pop overlays) (1- pos2) pos2)

2011-02-14

矩形範囲に連番を挿入する my-number-rectangle

使い方は、範囲選択して、

3桁で1から開始、1増加
M-x my-number-rectangle RET %03d RET 1 RET
001
002
003
004

3桁で1から開始、10増加
C-u 10 M-x my-number-rectangle RET %03d RET 1 RET
001
011
021
031

16進数の8桁で 128開始、16増加
C-u C-u M-x my-number-rectangle RET %08x RET 128 RET
00000080
00000090
000000a0
000000b0

%03d や %08x 等の書式については format を参照してください。
M-x describe-function RET format RET

my-number-rectangle
(defvar my-number-rectangle-format-history nil
  "History list for `my-number-rectangle'.")
(defvar my-number-rectangle-number nil
  "For internal use.")
(defvar my-number-rectangle-initial-number 1
  "*Default initial number for `my-number-rectangle'.")

(defun my-number-rectangle-read-format ()
  (let (default)
    (if (car my-number-rectangle-format-history)
        (setq default (car my-number-rectangle-format-history))
      (setq default "%03d"))
    (read-string (format "Format of number (default %s): " default)
                 nil 'my-number-rectangle-format-history default)))

(defun my-number-rectangle-line (startcol endcol fmt inc)
  (delete-rectangle-line startcol endcol t)
  (insert (format fmt my-number-rectangle-number))
  (setq my-number-rectangle-number (+ my-number-rectangle-number (or inc 1))))

(defun my-number-rectangle (start end fmt initial-number &optional inc)
  "Replace rectangle contents with numbers on each line.
Number is formatted with a string FMT and starts from INITIAL-NUMBER.
The increment value is 1 unless specified by prefix arg INC.

Example of FMT with number 0 and 31.
%d              \"0\"             \"31\"
% 5d            \"    0\"         \"   31\"
%-5d            \"0    \"         \"31   \"
%+5d            \"   +0\"         \"  +31\"
%05d            \"00000\"         \"00031\"
%x              \"0\"             \"1f\"
%X              \"0\"             \"1F\"
%05x            \"00000\"         \"0001f\"
%#05x           \"00000\"         \"0x01f\"

See `format' for details."
  (interactive
   (progn
     (barf-if-buffer-read-only)
     (unless (and transient-mark-mode mark-active)
       (signal 'mark-inactive nil))
     (let ((fmt (my-number-rectangle-read-format))
           (initial-number (read-number "Initial number: "
                                        my-number-rectangle-initial-number)))
       (list (region-beginning)
             (region-end)
             fmt
             initial-number
             (prefix-numeric-value current-prefix-arg)))))
  (require 'rect)
  (setq my-number-rectangle-number initial-number)
  (apply-on-rectangle 'my-number-rectangle-line start end fmt inc))

;; (global-set-key "\C-xrN" 'my-number-rectangle)

動作確認は GNU Emacs 22 。

wdired でファイル名に連番付ける時に、と思って書いてみたもののあまり使わないですね。
多分他にも似たようなコードは探せば見つかるでしょう。 車輪の再発明をすることで Elisp の経験値は上がっていきます。

余談ですが、GNU Emacs 22 以降の M-x replace-regex はかなり強力です。
行頭に連番挿入する程度ならば
M-x replace-regex RET ^ RET \,(format "%03d" (+ \# 1)) RET
等で十分でしょう。

2011-02-13

Mac OS X で Dired の日本語ファイル名の並び順がおかしい場合

Emacs の環境変数 LANG が UTF-8 の場合、 Dired の日本語ファイル名の並び順がおかしくなります。
これは Mac OS X の ls が LANG の値を見てランダムな並び順を出力するために起こります。
Emacs の設定ファイルに (setenv "LANG") や (setenv "LANG" "C") などと書けば正常な並び順になります。

普段は LANG=ja_JP.UTF-8 で、 Dired から ls を呼ぶ時だけ LANG=C にするには、以下のように設定します。

(setenv "LANG" "ja_JP.UTF-8")

(defadvice insert-directory
  (around setenv-LANG activate compile)
  "Set environment variable LANG to C."
  (let ((process-environment (copy-sequence process-environment)))
    (setenv "LANG" "C")
    ad-do-it))

動作確認は Mac OS X 10.6 と GNU Emacs 22 でしています。

2011-02-12

delete-selection-mode が効かない場合

delete-selection-mode は選択範囲がある時に文字を入力すれば、その範囲を消すというマイナーモード。
(delete-selection-mode 1)
と ~/.emacs.el や ~/.emacs.d/init.el に書けば有効になる。

ただし、文字列を入力する自作のコマンドを定義した場合、プロパティを追加しないと選択範囲を消してくれません。
プロパティについてはこちら プロパティリストを調べる describe-plist

例えば insert-lambda という文字列入力コマンドを定義した場合、このように設定します。
(defun insert-lambda ()
  (interactive "*")
  (insert "lambda"))

(put 'insert-lambda 'delete-selection t)

t 以外に 'yank, 'supersede, 'kill 等を設定できる。
詳しくはソースを参照。
M-x find-function RET delete-selection-mode RET