前回のサービス毎の関数を一つにまとめています。

;; サービスを使用して短縮URLをkill-ringに入れる関数
;; 引数 url     ... URL
;; 引数 service ... 使用するサービス -> 'TinyURL or 'is.gd or 'bit.ly
(defun shorten-url-to-kill-ring (url &optional service)
  (let (service-uri
        key
        get-regexp
        method)
    ;; default service to shorten
    (unless service (setq service 'TinyURL))
    ;; switch parameter by each url-shorten service
    (cond ((eq service 'TinyURL)
           ;; via http://tinyurl.com/  use API
           (setq service-uri "http://tinyurl.com/api-create.php")
           (setq key "url")
           (setq method "POST")
           (setq get-regexp "\\(http://tinyurl.com/.+\\)"))
          ((eq service 'is.gd)
           ;; via http://is.gd/  use API
           (setq service-uri "http://is.gd/api.php")
           (setq key "longurl")
           (setq method "GET")
           (setq get-regexp "\\(http://is.gd/.+\\)"))
          ((eq service 'bit.ly)
           ;; via http://bit.ly/  NOT USE API, get from web page
           (setq service-uri "http://bit.ly")
           (setq method "POST")
           (setq key "url")
           (setq get-regexp "id *= *\"shortened-url\" +value *= *\"\\(http://bit.ly/.+\\)\" +/>")))
    ;; use url package ...
    (setq url-request-method method)
    (if (equal method "POST")
        (setq url-request-data (concat key "=" (url-hexify-string url)))
      (setq url-request-data nil)
      (setq service-uri (concat service-uri "?" key "=" (url-hexify-string url))))
    ;; Now, try to fetch short URL
    (url-retrieve service-uri
                  '(lambda (status cbargs)
                     (point-min)
                     (if (re-search-forward (car (cdr cbargs)) nil t)
                         (progn
                           (setq result-url (match-string-no-properties 1))
                           (kill-new result-url nil)
                           (message "Copy '%s' to ring, shorten %s" result-url (car cbargs))))
                     (kill-buffer (current-buffer)))
                  (list (list url get-regexp)))))




;; 上をw3m上から使用するための関数 (この例ではis.gdを使用する)
(defun my-w3m-shorten-url ()
  (interactive)
  (shorten-url-to-kill-ring
     (or (w3m-url-valid (w3m-anchor))
         (w3m-url-valid w3m-current-url))
     'is.gd))

キーバインドとかは必要だったら適当にしてください。

(eval-after-load "w3m"
  '(progn
     ;; w3m-mode-map key binds
     (define-key w3m-mode-map "\C-cs" 'my-w3m-shorten-url)))

この投稿については内容が更新されています。「emacs-w3m上で短縮URLを取得する – その2」の方を利用してください。

以下の関数を.emacsとかに書き込みます。

;; URLを短縮してkill-ringの中に入れる関数(TinyURLを使用バージョン ... API使用)
(defun shorten-url-tinyurl(url)
  (let ((shorten-uri "http://tinyurl.com/api-create.php")
        (url-request-method "POST")
        (url-request-extra-headers
             '(("Content-Type" . "application/x-www-form-urlencoded")))
        (url-request-data (concat "url=" (url-hexify-string url))))
    (url-retrieve shorten-uri
                  '(lambda (status cbargs)
                     (point-min)
                     (if (re-search-forward  "\\(http://tinyurl.com/.+\\)" nil t)
                         (progn
                           (setq result-url (match-string-no-properties 1))
                           (kill-new result-url nil)
                           (message "Copy '%s' to ring, shorten %s" result-url cbargs)))
                     (kill-buffer (current-buffer)))
                  (list url))))

;; URLを短縮してkill-ringの中に入れる関数(bit.lyを使用バージョン ... API不使用)
(defun shorten-url-bitly (url)
  (let ((shorten-uri "http://bit.ly")
        (shorten-uri-get-regexp "id *= *\"shortened-url\" +value *= *\"\\(http://bit.ly/.+\\)\" +/>")
        (url-request-method "POST")
        (url-request-extra-headers
             '(("Content-Type" . "application/x-www-form-urlencoded")))
        (url-request-data (concat "url=" (url-hexify-string url))))
    (url-retrieve shorten-uri
                  '(lambda (status cbargs)
                     (point-min)
                     (if (re-search-forward (car (cdr cbargs)) nil t)
                         (progn
                           (setq result-url (match-string-no-properties 1))
                           (kill-new result-url nil)
                           (message "Copy '%s' to ring, shorten %s" result-url (car cbargs))))
                     (kill-buffer (current-buffer)))
                  (list (list url shorten-uri-get-regexp)))))



;; 上をw3m上から使用するための関数
(defun my-w3m-shorten-url ()
  (interactive)
  (shorten-url-tinyurl ;; もしくは shorten-url-bitly
   (or (w3m-url-valid (w3m-anchor))
       (w3m-url-valid w3m-current-url))))

キーバインドとかは必要だったら適当にしてください。

(eval-after-load "w3m"
  '(progn
     ;; w3m-mode-map key binds
     (define-key w3m-mode-map "\C-cs" 'my-w3m-shorten-url)))

ちなみにTinyURLとbit.lyバージョンを用意しています。好きな方を選択してください。ただしbit.lyバージョンはAPIではなく通常のWebページから取得しているためWebページの改装等で使用できなくなる可能性があります。

コードの中で

(call-process-region from
                     to
                     "markdown"
                     nil
                     buffer-output
                     nil)

の”markdown”とある部分については”C:\Program Files\markdown\markdown.pl”とか 実行できる形式に直してやってください。以下スクリプト。

(defun markdown (from to)
  (interactive "r")
  (if (> from to)
      (rotatef from to))
  (let ((buffer-output (get-buffer-create "*markdown*")))
        (with-current-buffer buffer-output
          (erase-buffer))
        (call-process-region from
                             to
                             "markdown"
                             nil
                             buffer-output
                             nil)
        (switch-to-buffer-other-window buffer-output)))

ところが最近、「英辞郎」を本家サイトから購入し MeadowMemoの記事やsdic本家のページを 参考にsdicから使用できるようにしたのですが検索がえらく遅くなってしまいました。

何とかならないかと調べてみると、saryというアプリケーションがあってこれを利用したとこ ろ検索スピードがかなり改善されました。その導入方法のまとめをメモ。ついでにWindows用のバイナリも置きました。

なお英辞郎ファイルをsdicファイルに変換する方法についてはmakeコマンドを 使用する例が紹介しているサイトが多いですが私はsdicに含まれるeijirou.perlから 直接変換しました。Linux上で日本語コードはEUC-JPです。

$nkf  -SXe eijiro97.txt | perl eijirou.perl > eijiro97.sdic

-- 和英の場合 --
$nkf  -SXe waeiji97.txt | perl eijirou.perl --waei > waeiji97.sdic

sdicでsaryコマンドを使用するためのメモ

基本的にLinux/Unixから使用すること想定していますが、 Windows用もがんばれば何とかなるかもしれません。

いつもの文言です。以下の記述については一切責任を持ちませんので御自分の責任でご利用ください。

saryコマンドをインストールする

私の場合Gentoo Linuxを使用していましたので、

#emerge sary

だけで終わってしまいました(というよりは、このためにMY COMジャーナルに紹介されているsufaryではなく saryを導入しています。sufaryはemerge保守されていないようです。)

apt-getでもあるようですので使用できる人はそれとか。ダメな人はソースからconfigure&make&installです。

なお、saryのREADMEやconfigure.inにはコンパイルのためにglibの2.0.0以上 が必要なことが書いてあります。ここらへん はgimp(2.0以上)やgnomeを使用し ていれば心配はないのかもしれません。

Windows用はよく分かりませんが、例えばmingw32環境を整え てGimp館の記事などを参考にGTKのサイトから glibのソースをダウンロードして作成すればsary作成の方も何とかなるかもしれません(gimp(2.0以上)を インストールしてglibの必要なファイルを直接手に入れることもできる？)。

Windows用のコマンドを試しにコンパイルしてみました。このページの一番下です。

sdicファイルからaryファイルを生成する

saryのコマンドを使用します。私はLinux上で日本語コードをEUC-JPとしていますので実行はこんな感じでした。

$mksary -c EUC-JP eijiro97.sdic
$mksary -c EUC-JP waeiji97.sdic

長い時間の後、同じディレクトリ内にeijiro97.sdic.aryやwaeiji97.sdic.aryができます。 辞書を引くためにはできあがったaryファイルと元のファイルの両方がディレクトリに 入っていなければなりません。

あとaryファイルはとても巨大です。元のsdicの2〜3倍に膨れ上がりますのでディスクの容量など注意が必要です。

Emacsに設定する

saryをemacsから使用するように調整します。 sdicの基本的なインストール方法はMeadow Memoなどを 参考にしてください。Gentoo Linuxであれば”emerge sdic”を実行します。

しかし、このままだとsdicからsaryを使用できません。COZMIXNGさんでrubyを使用する方法が紹介されていますが、 私はsaryをsdicから直接使用する方法をとりました。fsetで関数を強制置換してしまいます。以下、.emacs用のコードです。

;; ----- sdicを呼び出すための設定(F9で実行)
(global-set-key [f9] 'sdic-describe-word)
(autoload 'sdic-describe-word "sdic" "search word" t nil)
;; ----- sdicが呼ばれたときの設定
(eval-after-load "sdic"
  '(progn
     ;; saryのコマンドをセットする
     (setq sdicf-array-command "/usr/bin/sary")
     ;; sdicファイルのある位置を設定し、arrayコマンドを使用するよう設定(現在のところ英和のみ)
     (setq sdic-eiwa-dictionary-list
           '((sdicf-client "/path/to/eijiro97.sdic" (strategy array))))
     ;; saryを直接使用できるように sdicf.el 内に定義されているarrayコマンド用関数を強制的に置換
     (fset 'sdicf-array-init 'sdicf-common-init)
     (fset 'sdicf-array-quit 'sdicf-common-quit)
     (fset 'sdicf-array-search
           (lambda (sdic pattern &optional case regexp)
             (sdicf-array-init sdic)
             (if regexp
                 (signal 'sdicf-invalid-method '(regexp))
               (save-excursion
                 (set-buffer (sdicf-get-buffer sdic))
                 (delete-region (point-min) (point-max))
                 (apply 'sdicf-call-process
                        sdicf-array-command
                        (sdicf-get-coding-system sdic)
                        nil t nil
                        (if case
                            (list "-i" pattern (sdicf-get-filename sdic))
                          (list pattern (sdicf-get-filename sdic))))
                 (goto-char (point-min))
                 (let (entries)
                   (while (not (eobp)) (sdicf-search-internal))
                   (nreverse entries))))))
     ;; おまけ--辞書バッファ内で移動した時、常にバッファの一行目になるようにする
     (defadvice sdic-forward-item (after sdic-forward-item-always-top activate)
       (recenter 0))
     (defadvice sdic-backward-item (after sdic-backward-item-always-top activate)
       (recenter 0))))

Windows版のおまけ

…とりあえずWindows版でも何とかなるかな、とやってみました。できあがったバイナリをzipで固めて仮置きしておきます。ソースコード等は全て公表されているものを使用しています。

• array-win-20061009.zip

mingw32でコンパイル。作成したコマンドはmkary.exeとsary.exeですがmkary.exeはsaryの ではなくsufaryのものをコンパイルしました。saryのmksary.exeは コンパイルはできたものの実行するとメモリエラーとなりうまくいかなかったです。 というわけでaryファイルを生成する場合にはdos窓で

mksary.exe  eijiro97.sdic

とすれば良いと思います。euc-jpのもので環境もWin2k 256MBでしか試してい ません。Meadowな人はもし良ければダウンロードして試してみてください。と りあえず上の環境で英辞郎ファイル(バージョン97)を使用して、sdicファイル からaryファイルの生成、sary.exeコマンドの直接実行による検索はうまくい きました。

ところがhowmで直近に編集したメモを編集するためには、一回最近編集し たファイルを一覧表示させた上で一番トップのファイルを選択する必要があり ます。そこで一発で直近のファイルを編集可能とする関数を作成しました。

概要

howmで直近に編集したファイルを開きます。直接使用するのは関数’howm-open-most-recent-file’です。 他の三つの関数は、あるディレクトリから最終更新時刻が最も新しいファイルを見つけるための関数です。

howmで使用するディレクトリをいちいち全部検査しているのでそれなりに時間がかかります。 年月別にディレクトリを分けているような人は対象ディレクトリを狭めるなど工夫の余地があると思います。 改造のネタにでもしてください。

使い方

以下を.emacs等に追加してください。

;; キーバインドを追加する
(global-set-key "\C-c,r" 'howm-open-most-recent-file)

;; ======================================================================
;; howm-open-most-recent-file
;; 一番新しいメモファイルを呼び出す関数
;; (require 'howm-mode)の記述の後に書くか、hookとかで引っかけてください。

(defun howm-open-most-recent-file ()
  (interactive)
  (let ((recent-file (my-get-most-recent-file howm-directory)))
    (if recent-file
        (progn
          (find-file recent-file)
          (message "howm's most recent file"))
      (message "can't find file"))))

;; ======================================================================
;; my-get-most-recent-file
;; あるディレクトリから更新時刻が最も新しいファイルを見つける(無い場合はnil)

(defun my-get-most-recent-file (dir)
  (if (not (file-directory-p dir))
      (error "can't find dir %s !" dir)
    (let ((files (mapcar '(lambda (file)
                            (cond ((and
                                    (file-regular-p file))
                                   file)
                                  ((and (file-directory-p file)
                                        (not (string-match "/\\.$" file))
                                        (not (string-match "/\\.\\.$" file)))
                                   (my-get-most-recent-file file))
                                  (t nil)))
                         (directory-files dir t))))
      (my-get-most-recent-file-from-list files))))

(defun my-get-most-recent-file-from-list (files)
  (let ((most-recent-file nil)
        (reserved-times '(0 0))
        (compare-results nil))
    (while files
      (setq file (car files))
      (if file
          (if most-recent-file
              (progn
                (setq compare-results (my-get-most-recent-file-compare reserved-times file))
                (if compare-results
                    (progn
                      (setq reserved-times compare-results)
                      (setq most-recent-file file))))
            (progn
              (setq most-recent-file file)
              (setq reserved-times (my-get-most-recent-file-compare reserved-times file)))))
      (setq files (cdr files)))
    most-recent-file))

(defun my-get-most-recent-file-compare (reserved-times file)
  (let ((file-times (car (cddddr (cdr (file-attributes file))))))
    (cond ((> (car file-times) (car reserved-times))
           file-times)
          ((equal (car reserved-times) (car file-times))
           (cond ((> (car (cdr file-times)) (car (cdr reserved-times)))
                  file-times)
                 (t nil)))
          (t nil))))

マニュアルとかで探したものの該当する関数ないしは変数がいつまでたっても見 つかりませんでした。仕方が無いので丁度コンパイル用に準備していたMeadowのソースコードを直接探しました。

ビルトイン(built-in)されている関数はC言語ソースコードでDEFUNマクロが用 いられ、変数の場合はDEFVAR〜というマクロが用いられているようだ、という ことが分かりました。

ソースコード全体をDEFUNとかDEFVARとかをキーワードにgrepした結果、lread.cファイル内で用いら れている’load-file-name’がそれに該当するらしいです。上のマニュアルには 記載されていなそうです。

-- /home/hoge/hoge.elに記載
  (setq this-file-name load-file-name)
  --> this-file-nameには'/home/hoge/hoge.el'が代入される

このようにして自分自身のファイル名を返します。 ‘ file-name-directory’とかでLispを実行しているディレクトリを取得することができそうです。

こんなかんじです。

(load "twit")
(twit-mode t)
(eval-after-load "twit"
  '(progn
     (setq twit-mode-map (easy-mmode-define-keymap
                          '(("C-cC-tw" . twit-post)
                            ("C-cC-tf" . twit-list-friends)
                            ("C-cC-tF" . twit-list-followers)
                            ("C-cC-ts" . twit-show-recent-tweets))))))

間違えて押してしまいそうで不安だったのでtwit-post-regionとtwit-post-bufferをできないようにしたキーマップを再設定しています。