はてな内自動リンクを入力するelisp（スケッチ）

emacs

とりあえずはてなダイアリーとはてなグループの自動リンク記法には変換してほしいので。
他はやる必要あるのかな。

(require 'cl)
(defun hatena-url-unescape (string)
  (shell-command-to-string
   (format "ruby -rkconv -rcgi -e 'print CGI.unescape(ARGV.first).toeuc' %s"
           (shell-quote-argument string))))

;; (hatena-url-unescape "aa")
;; (hatena-url-unescape "%a4%cf%a4%c6%a4%ca")
(defun hatena-notation (url)
  "Returns URL's hatena notation."
  (block hatena-notation
    (dolist (entry *hatena-notation-table* url)
      (when (string-match (car entry) url)
        (setq url (replace-match (cadr entry) nil nil url))
        (when (memq :unescape entry) (setq url (hatena-url-unescape url)))
        (return-from hatena-notation url)))))

(defvar *hatena-notation-table*)
(defun define-hatena-notations (table)
  (setq *hatena-notation-table*
        (mapcar (lambda (pair)
                  (cons (hatena-url-convert-regexp (car pair)) (cdr pair)))
                table)))
(defun hatena-url-convert-regexp (re)
  (format "^%s/?$" (replace-regexp-in-string "\\." "\\\\." (replace-regexp-in-string "_" "\\\\([^/]+\\\\)" re))))

(define-hatena-notations
  '(("http://d.hatena.ne.jp/keyword/_" "[[\\1]]" :unescape)
    ("http://d.hatena.ne.jp/_/_" "d:id:\\1:\\2")
    ("http://d.hatena.ne.jp/_" "d:id:\\1")
    ("http://_.g.hatena.ne.jp/keyword/_" "g:\\1:keyword:\\2" :unescape)
    ("http://_.g.hatena.ne.jp/_/_" "g:\\1:id:\\2:\\3")
    ("http://_.g.hatena.ne.jp/_" "g:\\1:id:\\2")
    ))

;; (hatena-notation "http://hatena.g.hatena.ne.jp/keyword/%e3%81%af%e3%81%a6%e3%81%aa%e3%83%80%e3%82%a4%e3%82%a2%e3%83%aa%e3%83%bc%e5%88%a9%e7%94%a8%e5%8f%af%e8%83%bd%e3%82%bf%e3%82%b0")
;; (hatena-notation "http://d.hatena.ne.jp/rubikitch/")
;; (hatena-notation "http://d.hatena.ne.jp/rubikitch/archive")
;; (hatena-notation "http://d.hatena.ne.jp/rubikitch/about")
;; (hatena-notation "http://ruby.g.hatena.ne.jp/rubikitch/")
;; (hatena-notation "http://hatena.g.hatena.ne.jp/hatenadiary/20040501")
;; (hatena-notation "http://hatena.g.hatena.ne.jp/hatenadiary/")
;; (hatena-notation "http://d.hatena.ne.jp/keyword/%bc%ab%c6%b0%a5%ea%a5%f3%a5%af")

(defun hatena-notation-insert (url)
  "Insert hatena notation."
  (interactive "sURL: ")
  (insert (hatena-notation url)))

(define-key hatenahelper-mode-map "\C-c\C-u" 'hatena-notation-insert)

追記：hatena-notationじゃなくてhatena-autolinkのほうがいいか。