2009年11月4日水曜日

cocoa emacs のインストール

leopardに、cocoa emacs (emacs23.1) をインストールした時のメモ。

INSTALL

インストールそのものは、 MacEmacs JP Project の 「IMEパッチの適用」に書いてあるコマンドを、そのまま実行すればうまくいく。
$ tar xvfz inline_patch-20090617.tar.gz
$ tar xvfz emacs-23.1.tar.gz
$ cd emacs-23.1
$ patch -p 0 < ../inline_patch-20090617/emacs-inline.patch
$ ./configure --with-ns --without-x
$ make bootstrap
$ make install
$ open nextstep/Emacs.app
ただし、これらの作業を、emacsのシェルモードで行うと、
 Error: charsets directory does not exist.
 ethiopic.el: Error: Failure in loading charset map: MULE-ethiopic
のエラーが出てコンパイルに失敗する。
たぶん、EMACS関連の環境変数が邪魔になっているのだろうと思い、 configure実行の前に、
$ unset EMACSAPP EMACSDATA EMACSPATH EMACSDOC INSIDE_EMACS EMACSLOADPATH
を実行すれば解決。もっとも、ターミナルで作業する分には問題ない。

フォント設定

フォントは、 ここ とか ここ を参考にして、意味もわからずに見様見真似で設定してみた。
こんな感じだ。
(create-fontset-from-fontset-spec
  "-*-*-medium-r-normal--14-*-*-*-*-*-fontset-hiramaru14" nil t)
(create-fontset-from-fontset-spec
  "-*-*-medium-r-normal--16-*-*-*-*-*-fontset-hiramaru16" nil t)
(create-fontset-from-fontset-spec
  "-*-*-medium-r-normal--20-*-*-*-*-*-fontset-hiramaru20" nil t)
(mapc
 #'(lambda (fontset)
     (set-fontset-font fontset 'japanese-jisx0208
                       '("Hiragino Maru Gothic Pro" . "iso10646-1"))
     (set-fontset-font fontset 'katakana-jisx0201
                       '("Hiragino Maru Gothic Pro" . "iso10646-1"))
     (set-fontset-font fontset 'japanese-jisx0212
                       '("Hiragino Maru Gothic Pro" . "iso10646-1"))
     ) (list "fontset-hiramaru20" "fontset-hiramaru16" "fontset-hiramaru14"))
(let (
      ;; (my-fontset "fontset-hiramaru14") ;; ちっちゃいフォント
      (my-fontset "fontset-hiramaru20") ;; でっかいフォント
     )
  (set-default-font my-fontset)
  (add-to-list 'default-frame-alist `(font . ,my-fontset)))
いちおう、これで、英数文字と日本語文字の幅が1対2になり、 carbon の時と同等にきれいに表示されるようになった。

IMの設定

.emacs.el に以下を追加すると、 かなキーでモードラインに「あU:」とかが表示されるようになる。
(set-language-environment "Japanese")
(setq default-input-method "MacOSX")
ただ、「ことえり」の場合は、 C-x o などでバッファーを切り替えた時に、 モードラインの表示が現在の変換モードと一致しなくなる。
そこで、コマンドループのフック( post-command-hook )に、 IMの更新をするコードを追加してみた。
(load "cl")
(add-hook
 'post-command-hook
 (lexical-let ((previous-buffer nil))
   #'(lambda ()
       (unless (eq (current-buffer) previous-buffer)
         ;; (message "Change IM %S -> %S" previous-buffer (current-buffer))
         (if (bufferp previous-buffer) (mac-handle-input-method-change))
         (setq previous-buffer (current-buffer))))))
無理矢理っぽいコードだが、とりあえずこれで、 バッファー切り替えでも違和感なく使えるようになった。

DocView

emacs の中でPDFがみられるという、 doc-view を試してみた。 でも、ディスク内のあらゆるPDFを試してもうまく表示されない。
emacs-23.1/lisp/doc-view.el をみてみると、Ghostscript と、 xpdf または teTeX が必要と書いてある。
さっそく port でインストール。
$sudo port install ghostscript
$sudo port install ghostscript-fonts-hiragino
$sudo port install xpdf
これでdoc-viewが動き、PDFが表示できるようになる。
でも、macでは、全てのpdfをdocviewで表示できるわけではないらしい。 見れるファイルもあるし見れないのもある。

.emacs.el

cocoa emacs用に、僕が使っている .emacs.el の抜粋。
いろいろなサイトに載っていた設定例の寄せ集めだが、 これでも、試行錯誤の連続で、落ち着くまでには結構苦労した。
(if (>= emacs-major-version 23)
    ;; cocoa emacsの設定
    (progn
      ;; Command キーをMetaキーにする
      (setq ns-command-modifier (quote meta))
      ;; (setq ns-alternate-modifier (quote super))
      (setq ns-alternate-modifier nil)

      ;; IM 設定
      (set-language-environment "Japanese")
      (setq default-input-method "MacOSX")
      (prefer-coding-system  'utf-8-unix)
      ;; minibufferは英数モードで始める
      (add-hook 'minibuffer-setup-hook 'mac-change-language-to-us)
      ;; buffer切り替えの時にも、IM状態をアップデート
      (load "cl")
      (add-hook
       'post-command-hook
       (lexical-let ((previous-buffer nil))
         #'(lambda ()
             (unless (eq (current-buffer) previous-buffer)
               ;; (message "Change IM %S -> %S" previous-buffer (current-buffer))
               (if (bufferp previous-buffer) (mac-handle-input-method-change))
               (setq previous-buffer (current-buffer))))))

      (define-key global-map [ns-drag-file] 'ns-find-file) ;; find-file

      ;; Set text scale key 
      (global-set-key "\C-c+" #'(lambda () (interactive) (text-scale-increase 1)))
      (global-set-key "\C-c-" #'(lambda () (interactive) (text-scale-decrease 1)))
      (global-set-key "\C-c0" #'(lambda () (interactive) (text-scale-increase 0)))

      ;; font 設定
      ;; (setq fixed-width-use-QuickDraw-for-ascii t)
      (setq mac-allow-anti-aliasing t)

      (create-fontset-from-fontset-spec
       "-*-*-medium-r-normal--14-*-*-*-*-*-fontset-hiramaru14" nil t)
      (create-fontset-from-fontset-spec
       "-*-*-medium-r-normal--16-*-*-*-*-*-fontset-hiramaru16" nil t)
      (create-fontset-from-fontset-spec
       "-*-*-medium-r-normal--20-*-*-*-*-*-fontset-hiramaru20" nil t)
      (mapc
       #'(lambda (fontset)
           (set-fontset-font fontset 'japanese-jisx0208
                             '("Hiragino Maru Gothic Pro" . "iso10646-1"))
           (set-fontset-font fontset 'katakana-jisx0201
                             '("Hiragino Maru Gothic Pro" . "iso10646-1"))
           (set-fontset-font fontset 'japanese-jisx0212
                             '("Hiragino Maru Gothic Pro" . "iso10646-1"))
           ) (list "fontset-hiramaru20" "fontset-hiramaru16" "fontset-hiramaru14"))
      
      (create-fontset-from-fontset-spec
       "-*-*-medium-r-normal--14-*-*-*-*-*-fontset-hirakaku14" nil t)
      (create-fontset-from-fontset-spec
       "-*-*-medium-r-normal--16-*-*-*-*-*-fontset-hirakaku16" nil t)
      (create-fontset-from-fontset-spec
       "-*-*-medium-r-normal--20-*-*-*-*-*-fontset-hirakaku20" nil t)
      (mapc
       #'(lambda (fontset)
           (set-fontset-font fontset 'japanese-jisx0208
                             '("Hiragino Kaku Gothic Pro" . "iso10646-1"))
           (set-fontset-font fontset 'katakana-jisx0201
                             '("Hiragino Kaku Gothic Pro" . "iso10646-1"))
           (set-fontset-font fontset 'japanese-jisx0212
                             '("Hiragino Kaku Gothic Pro" . "iso10646-1"))
           ) (list "fontset-hirakaku20" "fontset-hirakaku16" "fontset-hirakaku14"))

      (setq face-font-rescale-alist
            '(("^-apple-hiragino.*" . 1.2)
              (".*osaka-bold.*" . 1.2)
              (".*osaka-medium.*" . 1.2)
              (".*courier-bold-.*-mac-roman" . 1.0)
              (".*monaco cy-bold-.*-mac-cyrillic" . 0.9)
              (".*monaco-bold-.*-mac-roman" . 0.9)
              ("-cdac$" . 1.3)))

      (let ((my-fontset "fontset-hirakaku20")
            ;; (my-fontset "fontset-hiramaru20")
            )
        (set-default-font my-fontset)
        (add-to-list 'default-frame-alist `(font . ,my-fontset)))
      )
  
  ;; carbon emacs (emacs 22) の設定
  (progn
    (require 'carbon-font)
    ;; ...................................................
    ;; ...................................................
    ))

2009年10月19日月曜日

emacsから翻訳サイトをアクセス

emacsからSafariを起動し、 googleやexciteの翻訳ページをアクセスするコマンド。 たぶん、leopardでしか動作しないと思う。

browse-translate-site.el
(defun my-escape-url (str &optional encoding)
  "URL-encode a string. ENCODING default is 'utf-8"
  (mapconcat
   (lambda (ch)
     (if (or (and (<= ?A ch) (<= ch ?Z)) (and (<= ?a ch) (<= ch ?z))
             (memq ch (list ?_ ?. ?-))) (char-to-string ch)
       (format "%%%02X" ch)))
   (encode-coding-string str (if encoding encoding 'utf-8)) ""))
(defun escape-js-string (str)
  "Escape string to javascript string literal"
  (apply #'concat
         (mapcar
          #'(lambda (c)
              (cond
               ((= c ?\\ ) "\\\\") ((= c ?\" ) "\\\"") 
               ((= c ?\' ) "\\'")  ((= c ?\t ) "\\t")
               ((= c ?\012) "\\n") ((= c ?\015) "\\r")
               ((= c ?\010) "\\b") ((= c ?\014) "\\f")
               ((< c 32) (format "\\u%0.4x" c))
               (t (char-to-string c)))) str)))
(cond
 ((and (<= emacs-major-version 22)
       (string-match
        ".*:1:14" (format "%s" (getenv "__CF_USER_TEXT_ENCODING"))))
  ;; emacs22 and CFUserTextEncodingが MacJapanese の場合
  (defun applescript-string-literal (str)
    "do-applescriptに渡す文字列リテラルを作成"
    (let ((reslst '()))
      (mapc
       '(lambda (ch)
          (cond ((= ch ?\\) (setq reslst (cons 128 reslst)))
                ((= ch ?\") (setq reslst (cons 34 reslst)))
                ((consp (car reslst))
                 (setcar reslst (cons ch (car reslst))))
                (t (setq reslst (cons (list ch) reslst)))))
       str ;; (append str nil)
       )
      (if (null reslst) "\"\""
        (mapconcat
         '(lambda (x)
            (if (consp x)
                (concat "\"" (reverse x) "\"")
              (format "ascii character %d" x))
            ) (reverse reslst) " & ")) 
      )))
 (t ;; emacs23 or CFUserTextEncodingがMacJapanese以外の場合(暫定)
  (defun applescript-string-literal (str)
    "do-applescriptに渡す文字列リテラルを作成"
    (concat "\""
            (replace-regexp-in-string ;; convert " => \"
             "\\\"" "\\\\\""         
             (replace-regexp-in-string ;; convert \ => \\
              "\\\\" "\\\\\\\\"
              str)) "\""))))

(defun safari-script-open ()
  "on openWithWait(theUrl, timeoutSec) \n\
     tell application \"Safari\" \n\
       open location \"about:blank\" \n\
       activate \n\
       delay 0.5 \n\
       do JavaScript \"location.href='\" & theUrl & \"';\" in document 1 \n\
       repeat timeoutSec times \n\
         delay 1 \n\
         if ((URL of document 1 as text) does not start with \"about:\") then \n\
           set state to do JavaScript \"document.readyState\" in document 1 \n\
           if (state = \"complete\") then return true \n\
         end if \n\
       end repeat \n\
       return false \n\
     end tell \n\
   end openWithWait \n\
\n\
   on waitForLoad(timeoutSec) \n\
     tell application \"Safari\" \n\
       delay 0.5 \n\
       repeat timeoutSec times \n\
         delay 1 \n\
         if not my isMarkDoc() then \n\
           set state to do JavaScript \"document.readyState\" in document 1 \n\
           if (state = \"complete\") then return true \n\
         else \n\
           -- log (\"markd\") \n\
         end if \n\
       end repeat \n\
       return false \n\
     end tell \n\
   end waitForLoad \n\
   on markDoc() \n\
     tell application \"Safari\" \n\
       do JavaScript \"document['(@_@)'] = '@_@';\" in document 1 \n\
     end tell \n\
   end markDoc \n\
   on isMarkDoc() \n\
     tell application \"Safari\" \n\
       set scp to do JavaScript \"document['(@_@)'];\" in document 1 \n\
       -- log (\"scp=\" & scp) \n\
       return scp = \"@_@\" \n\
     end tell \n\
   end isMarkDoc ")

(defun translate-with-excite (text is-waei)
  "TEXTをexciteで翻訳する。IS-WAEIが t ならば和英、nilならば英和"
  (do-applescript
   (concat
    (safari-script-open) "\n"
    (encode-coding-string
     (format "\
   tell application \"Safari\" \n\
     set theUrl to \"http://www.excite.co.jp/world/\" \n\
     if (my openWithWait(theUrl, 40)) then \n\
       tell document 1 \n\
         set orgsent to %s as unicode text \n\
         do javascript \"document.forms.world.before.value = '\" & orgsent & \"';\" \n\
         do javascript \"document.forms.world.wb_lp.selectedIndex = %s;\" \n\
         my markDoc() \n\
         do javascript \"document.forms.world.submit();\" \n\
         if (my waitForLoad(30)) then \n\
           set aftval to do javaScript \"document.getElementById('after').value\" \n\
           set the clipboard to aftval \n\
         else \n\
           display dialog \"Cannot submit\" \n\
         end if \n\
       end tell \n\
     else \n\
       display dialog \"Cannot open \" & theUrl \n\
     end if \n\
   end tell \n"
             (applescript-string-literal (escape-js-string text))
             (if is-waei 1 0))
     (if (>= emacs-major-version 23) 'utf-8 'sjis-mac) )))
  )

(defun translate-with-google (text from-lang to-lang)
  "Translate TEXT FROM-LANG into TO-LANG with google\n\
   from-lang, to-lang:    en,ja ...\n\
   The translation result is copied into the clipboard. "
  (let ((url
         (format
          "http://translate.google.co.jp/translate_t?prev=hp&hl=ja&js=y&text=%s&sl=%s&tl=%s"
          (my-escape-url text 'utf-8)
          from-lang to-lang)))
    (do-applescript
     (concat
      (safari-script-open) "\n"
      (format "\
   tell application \"Safari\" \n\
     set theUrl to \"%s\" \n\
     if (my openWithWait(theUrl, 30)) then \n\
       tell document 1 \n\
         set rval to do javaScript \"document.getElementById('result_box').innerText\" \n\
         set the clipboard to rval \n\
       end tell \n\
     else \n\
       display dialog \"Cannot open \" & theUrl \n\
     end if \n\
   end tell \n" url)))))

(defvar browse-translate-japanese-hist nil)
(defun browse-translate-japanese (s e)
  "Translate region text into japanese or english\n\
   If 8-bit character is included in the region then translates into English,\n\
  otherwise translates into Japanese. \n\
   The translation result is copied into the clipboard. \n\
   Translate engine is google or excite, default is excite"
  (interactive "r")
  (save-excursion
    (let ((text (buffer-substring-no-properties s e)))
      ;; (let ((waei-p (multibyte-string-p text)))
      (let ((waei-p (string-match "[^\000-\177]"
                                  (encode-coding-string text 'utf-8))))
        (let ((engine
               (read-from-minibuffer
                (format "%s using x(excite) or g(google) > "
                        (if waei-p "To ENGLISH" "To JAPANESE" ))
                (if (consp browse-translate-japanese-hist)
                    (car browse-translate-japanese-hist) "x")
                nil nil 'browse-translate-japanese-hist)))
          (cond ((member engine '("g" "G" "google")) ;; use google
                 (translate-with-google
                  text (if waei-p "ja" "en") (if waei-p "en" "ja")))
                ((member engine '("x" "X" "e" "excite")) ;; use excite.co.jp
                 (translate-with-excite text waei-p))
                (t (message "Unknown translate engine"))))))))

インストール

  1. 上のソースを、browse-translate-site.el というファイルにセーブ
  2. browse-translate-site.el をどこか、load-pathが切ってあるフォルダーに移動。
  3. (ex. $ sudo mv browse-translate-site.el /Applications/Emacs.app/Contents/Resources/site-lisp/ )
  4. .emacs.el に以下を追加
  5. (autoload 'browse-translate-japanese "browse-translate-site"
              "Translate region text into japanese or english" t nil)
    (global-set-key "\C-ch" 'browse-translate-japanese)
    
  6. emacs再起動

使い方

  • emacsのバッファーでリージョンを指定し、Control-C と h を叩く。
  • ミニバッファーに何か聞いてくるので、 excite翻訳なら x を、google翻訳なら g を指定。
  • Safariが開き、exciteなりgoogleの翻訳結果が表示されるはず。 (exciteの時はちょっと時間がかかる)

翻訳結果はクリップボードにコピーされるので、必要なら、 emacsに戻って結果をペーストすることもできる。また、英訳するか和訳するかは、 リージョンに8bit文字があれば英訳、なければ和訳するように判断させている。

elispの中で使っているapplescriptは、 Safariでページロードを待つ処理 を参照。
__CF_USER_TEXT_ENCODING を、 標準の ユーザID:1:14 以外に設定していると、日本語が変になって動かないかもしれない。

追記  (2009年 11月4日 水曜日)
cocoa emacs (emacs23.1) 用に修正

2009年10月5日月曜日

applescript:  Safariでページロードを待つ処理

applescriptの、`open location` 命令を使ってSafariを起動し、 開いたページのDOMを `do javascript` 命令でいじくる、 このやり方で、applescriptからSafariを自動制御することが可能だ。
でも、`open location` をした後で、 すぐに `do javascript` 命令を発行しても、 ページの内容が完全にロードされていなかったりして、うまくいかない場合がある。
そこで、それら一連のロード待ち処理を行う、 applescriptのハンドラを書いてみた。

以下がそのサンプルソース。
-- open `theUrl` and check to complete page loading
--   timeoutSec: timeout(sec)
--   Return true if success
on openWithWait(theUrl, timeoutSec)
  tell application "Safari"
    open location "about:blank"
    -- display dialog URL of document 1 as text
    activate
    delay 0.5
    do JavaScript "location.href=\"" & theUrl & "\";" in document 1
    repeat timeoutSec times
      delay 1
      if ((URL of document 1 as text) does not start with "about:") then
        set state to do JavaScript "document.readyState" in document 1
        if (state = "complete") then return true
      end if
    end repeat
    return false
  end tell
end openWithWait

-- Handler that waits for page to be loaded
--   timeoutSec:  timeout(sec)
-- ex. my markDoc() 
--     do JavaScript "document.forms[0].submit();" in document 1
--     if my waitForLoad(30) then ... else ... endif
on waitForLoad(timeoutSec)
  tell application "Safari"
    delay 0.5
    repeat timeoutSec times
      delay 1
      if not my isMarkDoc() then
        set state to do JavaScript "document.readyState" in document 1
        if (state = "complete") then return true
      else
        -- log ("markd")
      end if
    end repeat
    return false
  end tell
end waitForLoad

on markDoc()
  tell application "Safari"
    do JavaScript "document['(@_@)'] = '@_@';" in document 1
  end tell
end markDoc

on isMarkDoc()
  tell application "Safari"
    set scp to do JavaScript "document['(@_@)'];" in document 1
    -- log ("scp=" & scp)
    return scp = "@_@"
  end tell
end isMarkDoc

-- A Sample for openWithWait() and waitForLoad()
-- ( Open wikipedia, and set `applescript` to the textfield, 
--   and then submit form)
tell application "Safari"
  -- set theUrl to "http://en.wikipedia.org/wiki/Main_Page"
  set theUrl to "http://ja.wikipedia.org/wiki/"
  if (my openWithWait(theUrl, 10)) then
    tell document 1
      set title to (do JavaScript "document.title")
      do JavaScript "document.forms[0].search.value = 'applescript';"
      my markDoc() -- Mark current document
      do JavaScript "document.forms[0].submit();"
      if (my waitForLoad(10)) then
        display dialog "Success to open " & title & " and submit"
      else
        display dialog "Cannot submit"
      end if
    end tell
  else
    display dialog "Cannot open " & theUrl
  end if
end tell
サンプルの内容は、Safariでwikipediaを開き、 検索フォームに`applescript`を指定、最後にサブミット、という至って単純なもの。

ここで、openWithWait は、引数で指定したURLをsafariで開き、 新しいウィンドウでのページロード終了を待つハンドラ。うまくいけばtrueを返す。
ページロードの終了を待つのに、 ダミーでブランクページを開いているのがミソ。
document.readyState == "complete"だけで判断すると、 safariが前に表示していた documentをみていたりしてうまく動作しない時がある。 そこで一旦、about:blankを開き、documentのURLがabout: から http: になるのを待ってから、 document.readyStateをチェックするようにしている。

一方 waitForLoad は、ページ遷移後のロード終了を待つハンドラ。 submit()やlocation.href = xxx などの発行後に使う。 これもうまくいけばtrueを返し、失敗すればfalseでリターンする。
一般的な使い方はこんな感じだ。
  tell application "Safari"
    ......................
    -- ページ遷移をさせる前に、 現在のdocumentにダミーの
    -- javascriptプロパティーをマークする
    my markDoc()

    -- ページを遷移させる
    do JavaScript "document.forms[0].submit();" in document 1 

    -- ページロードを待つ (timeoutは10秒)
    if my waitForLoad(10) then
      ..........................
    end if
    ......................
  end tell
ページの遷移を起こす前に、 今見ているdocumentに適当なダミーの属性を与え、 遷移後はその属性が消えている事を確認してから、document.readyState をチェックするという、かなり怪しい方法なのだが.... いちおう動いている。

ところで、Safariでブランクページを表示するURLは、 about:blank というので本当に正しいのだろうか?
about:hoge でも about:qweqwe でも、 about: が付けばなんでもブランクページになるようだが...

2009年10月2日金曜日

elisp: 関数渡しの憂鬱

emacs lispにおいて、関数渡しを行う際の落とし穴。

例えば、
次のような関数my-findを定義したとする。
(defun my-find (pred lst)
  (if lst (if (funcall pred (car lst))
              (car lst) (my-find pred (cdr lst)))
    nil))
my-findは、リストの中からある条件に一致した要素をみつける関数で、 次のように使える。
例1: 奇数を探す
 (my-find (function oddp) '(0 2 -2 3 4)) ; ==> 3 
例2: 負の数を探す場合
 (my-find #'(lambda (x) (< x 0)) '(0 2 -2 3 4)) ; ==> -2 
例3: datasの最初の要素より大きな数を探す場合
  (let ((datas '(3 4 5)))
     (my-find #'(lambda (x) (< (car datas) x)) '(0 2 -2 3 4))) 
  ; ==> 4

しかし、最後の例3において、 dataslstに書き換えると、
  (let ((lst '(3 4 5)))
     (my-find #'(lambda (x) (< (car lst) x)) '(0 2 -2 3 4))) 
  ; ==> nil
となり、これは期待した結果ではない!

何故?
emacs lispの変数束縛は、動的バインディングという方式なので、
(lambda (x) (< (car lst) x))
lstは、定義された場所ではなく使われる場所で評価される。すなわち、 定義された場所の '(3 4 5) ではなく、使われる場所、この場合は関数 my-find
(defun my-find (pred lst) ... )
の第2引数として渡されるlstの値に束縛されるからだ。

ということは、my-findのような関数を引数とする関数を使う場合、 変数の名前がぶつかってしまうと、 意図しない結果を引き起こしてしまう恐れがあるということだ。

さて困った!
この問題を解決するにはどうすればいいのだろう? 僕にはわからない。
とりあえずは、次の二つを心がけるしかないのか。
  • (function (lambda (x) ... ) で関数を渡す時には、なるべく、lambda外部の変数 をlambda内部で使わないようにする。
  • 引数に関数を受け取る関数の定義においては、 なるべく変数を特殊な名前で書くようにする。
  • ex.  (defun my-find (@pred __lst) ... )

ちなみに、静的バインディングで変数を束縛する、 common lisp や scheme では、定義された場所の環境で変数を評価するから、 このような問題は起こらない。
  $ clisp
  [1]> (defun my-find (pred lst)
        (if lst (if (funcall pred (car lst))
              (car lst) (my-find pred (cdr lst)))
           nil))
  [2]> (let ((lst '(3 4 5)))
            (my-find #'(lambda (x) (< (car lst) x))
              '(0 2 -2 3 4)))
  ==> 4

追記  (2009年 10月14日 水曜日)
lexical-let というのを使えば解決できることがわかった。
  (lexical-let ((lst '(3)))
    (my-find #'(lambda (x) (> x (car lst))) '(1 2 3 4 5)))
  ==> 4
lexical-letは名前のとおり、 レキシカルなletバインディングをエミュレートしてくれるマクロだ。 今まで僕が知らなかっただけで、結構有名な機能らしい。 wikipedia にも記述がある。
これを使えばemacs lispでクロージャーを書くことも出来る。
(defun counter-new (n)
  (lexical-let ((n n))
    #'(lambda (cmd)
        (cond ((eq cmd :get) (setq n (+ n 1)) n)
              ((eq cmd :peek) n)
              (t (error (format "%s: illegal command" cmd)))))))
(setq c (counter-new 0))
(setq c2 (counter-new 100))
(funcall c :get) ;==> 1
(funcall c2 :get) ;==> 101
(funcall c :get) ;==> 2
(funcall c :peek) ;==> 2 
もう何十年もemacsと付き合っているが、まだまだ知らない事だらけだ.....

2009年9月21日月曜日

emacsからスクリプトエディターを開く

emacsで開いているapplescriptソースコードを、 ScriptEditor上で開くemacs lisp コマンド。

applescript-browse

(defun applescript-browse-url (script &optional action)
  "Convert script to applescript URL\n\
   action --- \"new\"(default) or \"insert\" or \"append\"\n\
   ex. (applescript-browse-url \"say time string of(current date)\")"
  (format "applescript://com.apple.scripteditor?action=%s&script=%s"
          (if action action "new") (url-hexify-string script)))

(defun applescript-browse (pfx)
  "バッファーの内容をApplescript URL protocolを使って、スクリプトエディター上に開く。\n\
  生成されたURLはキルリングに追加される。\n\
  リージョンを対象とする場合は、C-u で実行する。"
  (interactive "P")
  (save-excursion
    (let ((url
           (applescript-browse-url 
            (encode-coding-string
             (my-trim-string
              (apply (function buffer-substring-no-properties)
                     (if (equal pfx '(4))
                         (list (region-beginning) (region-end))
                       (list (point-min) (point-max)))))
             'utf-8))))
      (kill-new url)
      (browse-url url)
    )))

(defun my-trim-string (str)
  "stringの両端の空白を取り除く"
  (replace-regexp-in-string
   "^[ \\\t\\\r\\\n]+" ""
   (replace-regexp-in-string "[ \\\t\\\r\\\n]+$" "" str)))

使い方

M-x applescript-browseで、カレントバッファーの全内容が、 スクリプトエディターで開かれる。
リージョンを対象とする場合は、 C-u M-x applescript-browse で実行する。
また、applescript:// で始まるURLをキルリングに追加しているので、 applescript-browseを実行後、C-yでそれを貼付ける事ができる。

仕組みは、Applescript URL protocol supportというのを使って、 単にbrowse-urlしているだけだ。
URL protocol supportについては、 Script NoteさんAppleScript/URL PROTOCOL SUPPORT に、とてもわかりやすい説明がある。

2009年9月12日土曜日

do-applescript 専用の文字列リテラル関数

Carbon emacsには、emacsから applescriptを実行する関数として do-applescript というのがある。とても便利なのだが、applescript に文字列リテラルを渡す時のエスケープ処理が面倒なので、 専用の関数 applescript-string-literal を作ってみることにした。
つまり、
(do-applescript "display dialog \"any-string\"")
の赤色の部分を作成する関数だ。
(do-applescript (format "display dialog %s" 
                    (applescript-string-literal "any-string")))
のように使う。

最初は、単にバックスラッシュ使って、 ダブルクォートとバックスラッシュ自身をエスケープするだけでいいと思っていたのだが、 leopardの文字列処理はそう甘くはなかった。

どこが甘くなかったのか.....
例えば、
(do-applescript "display dialog \"Hello\"")
はちゃんと、Helloというメッセージダイアログを表示するのだが、 Helloを、"Hello" にかえて、
(do-applescript "display dialog \"\\\"Hello\\\"\"")
を実行すると、何故かエラーになってしまう。 バックスラッシュ(\)によるダブルクォート(") のエスケープ処理が効いていないみたいだ。

これは、バックスラッシュと円記号 にまつわるややこしい問題なのかと思い、試しに
(do-applescript "display dialog \"Hello\\\"")
を実行。すると、 Hello\ ではなく、 Hello と表示された。
スクリプトエディターで、\のコードを確認すると、
ASCII NUMBER "\\" は 128
ASCII NUMBER "¥" は 92
と評価される。(実際には¥はoption-\で入力)
ということは、 do-applescriptで送るバックスラッシュコード(asciiの92) が、applescript では半角の¥記号と認識され、 それで文字列リテラルのエスケープが効かないのか?
確かに、applescriptの ascii character 128 を使って、
(do-applescript "display dialog \"Hello\" & ascii character 128")
を実行すれば、正しく Hello\ と表示される。
めんどくさいけど、 バックスラッシュを ascii character 128 に、 ダブルクォートを ascii character 34 にして、それらと文字列リテラルを & でくっつければいいらしい。

でも、以前は確かこんな症状は起きなかったような気がする。 僕自身が何か変な環境設定でも行ったのだろうか....
調べてみると、環境変数 __CF_USER_TEXT_ENCODING が関係していることがわかった。この環境変数を UTFエンコードを表す 0x08000100 に設定して、
(例 : export __CF_USER_TEXT_ENCODING=`printf 0x%X $UID`":0x08000100:14")
emacsを再起動すると、
(do-applescript "display dialog \"\\\"Hello\\\"\"")
も正常に動作し、これまでの問題は全て解決する。しかし今度は日本語が化けてしまう。 デフォルトの $UID:1:14では shift_jisでエンコードすれば問題なかったのに......

結局、 __CF_USER_TEXT_ENCODING が ShiftJisの場合は、文字列リテラルと ascii character 文の結合で処理し、 それ以外の場合は単純なエスケープ処理を施すように applescript-string-literal 関数を実装することにした。

applescript-string-literalソースコード
(cond
 ((and (<= emacs-major-version 22)
       (string-match
        ".*:1:14" (format "%s" (getenv "__CF_USER_TEXT_ENCODING"))))

  ;; emacs22 and CFUserTextEncodingが MacJapanese の場合
  (defun applescript-string-literal (str)
    "do-applescriptに渡す文字列リテラルを作成\n\
        バックスラッシュとダブルクォーテーションをそれぞれ\n\
        ascii character 128 と ascii character 34に変換\n\
        ex. (applescript-string-literal \"\\\"abc\\\"\")\n\
        => \"ascii character 34 & \\\"abc\\\" & ascii character 34\""
    (let ((reslst '()))
      (mapc
       '(lambda (ch)
          (cond ((= ch ?\\) (setq reslst (cons 128 reslst)))
                ((= ch ?\") (setq reslst (cons 34 reslst)))
                ((consp (car reslst))
                 (setcar reslst (cons ch (car reslst))))
                (t (setq reslst (cons (list ch) reslst)))))
       str ;; (append str nil)
       )
      (if (null reslst) "\"\""
        (mapconcat
         '(lambda (x)
            (if (consp x)
                (concat "\"" (reverse x) "\"")
              (format "ascii character %d" x))
            ) (reverse reslst) " & ")) 
      )))
 (t ;; emacs23 or CFUserTextEncodingが MacJapanese 以外 の場合
  (defun applescript-string-literal (str)
    "do-applescriptに渡す文字列リテラルを作成"
    (concat "\""
            (replace-regexp-in-string ;; convert " => \"
             "\\\"" "\\\\\""
             (replace-regexp-in-string ;; convert \ => \\
              "\\\\" "\\\\\\\\"
              str)) "\""))))

この applescript-string-literal を使って、
(do-applescript
  (format "display dialog %s"
     (applescript-string-literal "Hello \"backslash\"-\\")))
を実行すると、めでたく Hello "backslash"-\ が表示される。

__CF_USER_TEXT_ENCODINGがデフォルトのShiftJisの状態なら、 日本語だって、
(do-applescript
  (format "display dialog %s"
    (encode-coding-string
      (applescript-string-literal "バックスラッシュ \"\\\"を表示")
      'shift_jis)))
ちゃんと バックスラッシュ"\"を表示 のダイアログが表示される。

.... でも、本当は何かもっとスマートな方法があるんだろなあ....

追記  (2009年 11月4日 水曜日)
cocoa emacs (emacs23.1) の場合は、ascii characterへの変換は必要なく、 日本語もエンコードせずにそのまま送ればいいようだ。

2009年9月3日木曜日

schemeメモ - quoteで作ったリスト

単純に次ぎのコード、
(define (foo) '(a b c))
(foo) 
  ==> (a b c)
fooはどってことのない関数だが、実は、この書き方はとても危ない。

プログラムのどこかで、fooの出力を破壊的に変更してしまうと、
(reverse! (foo)) 
  ==> (c b a)
(foo) 
  ==> (a)
もはや、関数fooは (a b c)を返さなくなる。

vectorも同じだ。
(define (foo) '#(a b c))
(vector-set! (foo) 0 'aa)
(foo)
  ==> #(aa b c)

準クォートを使ったこれもだめだ
(define (foo x) `(,x a b c))
(foo 1)
  ==> (1 a b c)
(reverse! (foo 2))
  ==> (c b a 2)
(foo 1)
  ==> (1 a 2) 

しかしこれは大丈夫 (少なくともgoshでは)
(define (foo x) `(a b c ,x))
(foo 1)
  ==> (a b c 1)
(reverse! (foo 2))
  ==> (2 c b a)
(foo 1)
  ==> (a b c 1) 

無難な書き方はこうかな?
(define (foo x) (append `(,x a b c) '()))
(foo 1)
  ==> (1 a b c )
(reverse! (foo 2))
  ==> (c b a 2)
(foo 1)
  ==> (1 a b c )

まとめ
  • クォートで作ったリストやベクターは、静的にアロケートされている可能性がある
  • クォートで作ったリストやベクターに対し、直接に破壊操作を行わない。
  • 知らない関数の出力を破壊する時は、 前もってコピーしたものを破壊するのが無難。

しかしこれに慣れると、他の言語で同様なことを書くのに躊躇してしまいそうだ。
例えば、rubyだと
def foo ; return [1,2,3] ; end
foo.reverse!
  => [3, 2, 1]
foo
  => [1, 2, 3]
で全然問題ないのに、
def foo ; return [1,2,3].clone ; end 
と書いてしまうとか......

schemeメモ - appendの最後の引数

append の最後の引数はコピーされない!

R5RS の append の説明には、
The resulting list is always newly allocated, except that it shares structure with the last list argument.
と書いてある。荒っぽく訳すと、
appendは、いつも新規にアロケートしたリストを結果として返す。 ただし例外があり、最後の引数は構造を共有する。
ということは、(append list ... listN) の listN はコピーされないということか。 今までこんなことも知らずにコードを書いていたとは..... (^^;

実験してみた

> (define lst '(a b c))
> (eq? lst (cdr (append '(a) lst)))
  ==> #t  
確かに、最後の引数(a b c) は共有され、新規のアロケートはされていない。

もちろんこれもアロケートされない
> (eq? lst (append lst))
  ==> #t

とにかく最後の引数に () を置けば、みんなアロケートされる
> (eq? lst (cdr (append '(a) lst ())))
  ==> #f

単なるリストのコピーをしたければ
> (eq? lst (append lst ()))
  ==> #f
> (equal? lst (append lst ()))
  ==> #t

2009年9月1日火曜日

include マクロ

includeというマクロを書いてみた。 別ファイルに書かれてあるS式を、ソースの中に埋め込むマクロだ。 loadと似ているが、呼び出した場所の環境で評価される点が違う。

include.scm

;; ファイルに書かれているS式を埋め込むマクロ。
;; 使い方:  (include ファイル名)
;; ただし、ファイル名には文字列かトップレベルの変数しか指定できない
(defmacro include (fname)
  (let ((read-all
         (lambda (port)
           (let lp ((e (read port)) (result (list)))
             (if (eof-object? e) (reverse! result)
                 (lp (read port) (cons e result)))))))
    `(begin ,@(call-with-input-file 
                (eval fname (interaction-environment))
                (lambda (p) (read-all p))))))

適当なサンプルで動作確認

$ cat tmp2.scm    # 埋め込むファイル
  (display 
     (format "a=~A b=~A (foo a b) = ~A\n" a b (foo a b)))
  (foo a b)

$ gosh
  gosh> (load "./include.scm")
  gosh> (define file "tmp2.scm")
  gosh> (define foo +) (define a 10) (define b 20) ;; toplevel設定
  gosh> (let ((foo *) (a 11)) (load file))    ;; loadの実行結果
     =>  a=10 b=20 (foo a b) = 30
         #t
  gosh> (let ((foo *) (a 11)) (include file)) ;; includeの実行結果
     => a=11 b=20 (foo a b) = 220
        220
  gosh> ^D

変数 foo,a,bについて、 loadの場合はトップレベルの定義で評価されているが、 includeでは、(let ...) バインドの値で評価されているのが確認できる。

gosh,chezでの defmacro

僕は、scheme処理系として、gosh , kawa, petite-chez-scheme の三つを使っているのだが、 このうち、goshと petite にはデフォルトでdefmacroがない。
マクロ定義のソースファイルを処理系で同じにしたいので、goshとpetiteでの defmacroの定義方法を調べてみた。

goshでは define-macroを使って簡単にdefmacroらしきものが定義できた。
  (define-macro (defmacro name arglst . bodies)
    `(define-macro ,(cons name arglst) ,@bodies))

petiteには、define-syntax系の健全なマクロしかない。 syntax-caseというのを使えば何でも定義できそうだが、 syntax-case構文はなんだかとっても難しそうで僕の理解範疇を超えている。
幸いにも、petiteのダウンロードパッケージの中に、 examples/compat.ss というファイルがあり、この中に、 syntax-caseで定義したdefine-macroとdefmacroのソースをみつけた。 これをそのまま使えばなんとかなりそうだ。

2009年8月31日月曜日

macbookの起動音を小さくする

深夜、何気なくmacbookの電源を入れると、いきなり「ジャーン」という大き な音が鳴り近所迷惑をかけてしまう時がある。
この起動音をなんとか小さくすることはできないのか?
いろいろ試してみると、どうやらmacbookは、前に電源を切った時の音量を覚 えていて、次に電源を入れた時もその音量で起動音を鳴らすようだ。

ならば、電源を切る時に音量を自動で下げてやればいい、ということで、
/etc/rc.shutdown.local
というファイルに以下を記述することで解決した。

/usr/bin/osascript -e "set volume output volume 25"
/bin/sleep 1

volumeの数字は 0から100まで指定できる。
起動音を消すには "set volume output volume 0"
理由はわからないが、僕の環境では、 sleep 1 がないと動作しない時がある。

2009年8月29日土曜日

emacs-w3mでjavadocのアンカーにうまく飛ばない

症状

emacs-w3m-1.4.4で、 javadocをブラウズしていると、一部のnameアンカーにうまく飛ばない時がある。
例えば、
http://java.sun.com/j2se/1.5.0/ja/docs/ja/api/java/lang/String.html
にある、
http://java.sun.com/j2se/1.5.0/ja/docs/ja/api/java/lang/String.html#String(byte[], int)
をアクセスすると、No such anchor: String(byte[],%20int) でエラーになる。
javadoc がURLに空白を使っているのが良くないのだとは思うが不便なので調べてみた。

問題のエラーは、w3m.el というファイルに定義されている、関数 w3m-search-name-anchorの内部で起きている。
上記の javadoc URLの場合、この w3m-search-name-anchor のname引数には、 URLエンコードされた%20付きの文字列 `String(byte[],%20int)` が渡される。 しかし、あらかじめページ内のアンカーをキャッシュしている、 w3m-name-anchor プロパティには、エンコード前の空白含みの `String(byte[],     int)` しかないので、アンカーが見つからないとなるのが原因ではないか。

解決

w3m-search-name-anchorを次のように変更したら、 いちおう動作するようになった。
(defun w3m-search-name-anchor (name &optional quiet)
  "My w3m-search-name-anchor (for Java doc anchor)"
  (interactive "sName: ")
  (let ((pos (point-min))
        ;; add for javadoc anchor
        (name-sp (w3m-url-decode-string name)) ;; better??
        ;; (name-sp (replace-regexp-in-string "%20" " " name))
        )
    (if (string= name name-sp) (setq name-sp nil))
    (catch 'found
      (while (setq pos (next-single-property-change pos 'w3m-name-anchor))
        (when (or (member name (get-text-property pos 'w3m-name-anchor))
                  ;; add for javadoc anchor
                  (and name-sp
                       (member name-sp (get-text-property pos 'w3m-name-anchor))))
          (goto-char pos)
          (when (eolp) (forward-line))
          (w3m-horizontal-on-screen)
          (throw 'found t)))
      (setq pos (point-min))
      (while (setq pos (next-single-property-change pos 'w3m-name-anchor2))
        (when (or (member name (get-text-property pos 'w3m-name-anchor2))
                  ;; Add for javadoc anchor
                  (and name-sp
                       (member name-sp (get-text-property pos 'w3m-name-anchor2))))
          (goto-char pos)
          (when (eolp) (forward-line))
          (w3m-horizontal-on-screen)
          (throw 'found t)))
      (unless quiet
        (message "No such anchor: %s !!" name))
      nil)))

とりあえずの野良インストール方法は、
  1. 上のソースを、my-w3m.elというファイルにセーブ
  2. my-w3m.elをload-pathが切ってあるディレクトリーに置く。
  3. .emacs.el に以下を追加
  4. (add-hook 'w3m-load-hook
       '(lambda () (load "my-w3m") 
          (message "*** Loaded my-w3m ****")))
        
もちろん、この方法は emacs-w3mのバージョン1.4.4 限定だ。
CVS版は試した事がないので、もしかしたら既に解決済みかもしれない。