はてなグループのキーワードをEmacsから編集するやつ、ちょっと進化したよ

自分で書いていたものの、「keymap」と「font-lock」の両立がどうしてもできなかったので、id:antipopさんのsimple-hatena-modeを(かなり)パクらせてもらいました><。そんな中自分で書いてみたのはこの付近。

  • C-cC-pで、はてなグループのキーワード更新
  • C-cC-fで、ローカルのはてなグループキーワード用のファイルが入っているところをdiredで開く
  • C-cC-oで、現在編集中のキーワードをopenする
(defun post-hatena-group-keyword ()
  "function to post hatena keyword"
  (interactive)
  (start-process "post-hatena-group-keyword"
         "*post-hatena-group-keyword*"
         "hgk.rb" (expand-file-name (buffer-name (window-buffer))))
  (message "finished posting to hatena group keyword."))

(defun open-keyword-in-browser ()
  "function to open the keyword in safari."
  (interactive)
  (start-process "open-keyword"
         "*open-keyword*"
         "open" (concat "http://" hatena-group-keyword-default-group ".g.hatena.ne.jp/keyword/" (car (split-string (buffer-name (window-buffer)) "\.txt"))) )
  (message "opened the buffer in safari."))

(defun open-keyword ()
  "function to open the keyword in emacs."
  (interactive)
  (start-process "open-keyword"
         "*open-keyword*"
	 (switch-to-buffer (find-file-noselect (concat hatena-group-keyword-root "/" hatena-group-keyword-default-group))))
  (message "opened the buffer in safari."))

(setq auto-mode-alist
      (append '(((expand-file-name (concat hatena-group-keyword-root "/" hatena-group-keyword-default-group)) . hatena-group-keyword-mode))
	      auto-mode-alist))

simple-hatena-modeで一箇所気になったんだけど、kill-all-local-variablesがしてないんだよね。elispのメジャーモードのやつとかには書くほうがいいっぽいらしいんだけど*1、どうなんだろ。。。

あとなんとなく全部コード載せておく。

(defvar hatena-group-keyword-bin "hgk.rb" nil)

(defvar hatena-group-keyword-root "~/hatena_keyword" nil)

(defvar hatena-group-keyword-default-group nil nil)

(setq auto-mode-alist
      (append '(("/Users/yasuhisa/ruby/hatena_keyword/" . hatena-group-keyword-mode))
	      auto-mode-alist))

(setq hatena-group-keyword-mode-map (make-sparse-keymap))
(define-key hatena-group-keyword-mode-map "\C-c\C-p" 'post-hatena-group-keyword)
(define-key hatena-group-keyword-mode-map "\C-c\C-f" 'open-keyword)
(define-key hatena-group-keyword-mode-map "\C-c\C-o" 'open-keyword-in-browser)

(defvar hatena-group-keyword-mode-hook nil)

(defvar hatena-group-keyword-font-lock-keywords nil)
(defvar hatena-group-keyword-slag-face 'hatena-group-keyword-slag-face)
(defvar hatena-group-keyword-subtitle-face 'hatena-group-keyword-subtitle-face)
(defvar hatena-group-keyword-inline-face 'hatena-group-keyword-inline-face)
(defvar hatena-group-keyword-markup-face 'hatena-group-keyword-markup-face)
(defvar hatena-group-keyword-link-face 'hatena-group-keyword-link-face)

(defface hatena-group-keyword-slag-face
  '((((class color) (background light)) (:foreground "IndianRed"))
    (((class color) (background dark)) (:foreground "wheat")))
  "小見出しの*タイムスタンプorスラッグ*部分のフェイス。")

(defface hatena-group-keyword-subtitle-face
  '((((class color) (background light)) (:foreground "DarkOliveGreen"))
    (((class color) (background dark)) (:foreground "wheat")))
  "小見出しのフェイス。")

(defface hatena-group-keyword-inline-face
  '((((class color) (background light)) (:foreground "MediumBlue" :bold t))
    (((class color) (background dark)) (:foreground "wheat" :bold t)))
  "id記法や[keyword:Emacs]等のface")

(defface hatena-group-keyword-markup-face
  '((((class color) (background light)) (:foreground "DarkOrange" :bold t))
    (((class color) (background dark)) (:foreground "IndianRed3" :bold t)))
  "はてなのマークアップのフェイス。")

(defface hatena-group-keyword-link-face
  '((((class color) (background light)) (:foreground "DeepPink"))
    (((class color) (background dark)) (:foreground "wheat")))
  "リンクのフェイス。")

(eval-when-compile
  (require 'cl)
  (require 'derived)
  (require 'font-lock)
  (require 'html-helper-mode))

(define-derived-mode hatena-group-keyword-mode html-helper-mode "Hatena Group Keyword"
  "はてなグループのキーワードへ投稿するためのメジャーモード"
  ;; フォントロック
  (font-lock-add-keywords 'hatena-group-keyword-mode
    (list
     (list  "^\\(\\*[*a-zA-Z0-9_-]*\\)\\(.*\\)$"
            '(1 hatena-group-keyword-slag-face t)
            '(2 hatena-group-keyword-subtitle-face t))
     ;; 必ず[]で囲まれていなければならないもの
     (list "\\[[*a-zA-Z0-9_-]+\\(:[^\n]+\\)+\\]"
           '(0 hatena-group-keyword-inline-face t))
     ;; 必ずしも[]で囲まれていなくてもよいもの
     (list "\\[?\\(id\\|a\\|b\\|d\\|f\\|g\\|graph\\|i\\|idea\\|map\\|question\\|r\\|isbn\\|asin\\)\\(:[a-zA-Z0-9_+:-]+\\)+\\]?"
           '(0 hatena-group-keyword-inline-face t))
     (list  "^\\(:\\)[^:\n]+\\(:\\)"
            '(1 hatena-group-keyword-markup-face t)
            '(2 hatena-group-keyword-markup-face t))
     (list  "^\\([-+]+\\)"
            '(1 hatena-group-keyword-markup-face t))
     (list  "\\(((\\).*\\())\\)"
            '(1 hatena-group-keyword-markup-face t)
            '(2 hatena-group-keyword-markup-face t))
     (list  "^\\(>>\\|<<\\|><!--\\|--><\\|>|?[^|]*|\\||?|<\\|=====?\\)"
            '(1 hatena-group-keyword-markup-face t))
     (list  "\\(s?https?://\[-_.!~*'()a-zA-Z0-9;/?:@&=+$,%#\]+\\)"
            '(1 hatena-group-keyword-link-face t))))
  (font-lock-mode 1)
  (use-local-map hatena-group-keyword-mode-map)
  (run-hooks 'hatena-group-keyword-mode-hook))

(defun post-hatena-group-keyword ()
  "function to post hatena keyword"
  (interactive)
  (start-process "post-hatena-group-keyword"
         "*post-hatena-group-keyword*"
         "hgk.rb" (expand-file-name (buffer-name (window-buffer))))
  (message "finished posting to hatena group keyword."))

(defun open-keyword-in-browser ()
  "function to open the keyword in safari."
  (interactive)
  (start-process "open-keyword"
         "*open-keyword*"
         "open" (concat "http://" hatena-group-keyword-default-group ".g.hatena.ne.jp/keyword/" (car (split-string (buffer-name (window-buffer)) "\.txt"))) )
  (message "opened the buffer in safari."))

(defun open-keyword ()
  "function to open the keyword in emacs."
  (interactive)
  (start-process "open-keyword"
         "*open-keyword*"
	 (switch-to-buffer (find-file-noselect (concat hatena-group-keyword-root "/" hatena-group-keyword-default-group))))
  (message "opened the buffer in safari."))

(setq auto-mode-alist
      (append '(((expand-file-name (concat hatena-group-keyword-root "/" hatena-group-keyword-default-group)) . hatena-group-keyword-mode))
	      auto-mode-alist))

(provide 'hatena-group-keyword-mode)

*1:Webとか本とか調べた感じだと