Emacsからはてなグループを編集するメジャーモードをちょっと改良してみた

去年の7月くらいに作ってたんだけど。

• はてなグループのキーワードをEmacsから編集するやつ、ちょっと進化したよ - Seeking for my unique color.
• いくつか変更&改良 - Seeking for my unique color.

\C-c\C-pでポストした後、safariが開いているのに、フォーカス(?)がEmacsにある、という奇妙なことが起きていたんだけど、面倒なのでながらく放置していた。

が、やっちろ.Rの資料を作っているとき、これだとストレスたまりまくりんぐ、というわけで改良してみた。これでストレスなくはてなグループの編集ができるので、やっちろ.Rの発表資料を作ってしまわないと。。。

(defun hatena-group-keyword-post ()
  "function to post hatena keyword"
  (interactive)
  (hatena-group-keyword-post-internal))

(defun hatena-group-keyword-post-and-open-in-browser ()
  "function to post hatena keyword"
  (interactive)
  (hatena-group-keyword-post-internal)
  (hatena-group-keyword-view-keyword-in-browser-internal))

(defun hatena-group-keyword-view-keyword-in-browser ()
  "function to open the keyword in safari."
  (interactive)
  (hatena-group-keyword-view-keyword-in-browser-internal))

(defun hatena-group-keyword-open-keyword-in-dired ()
  "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 dired."))

(defun hatena-group-keyword-delete ()
  "function to delete hatena keyword"
  (interactive)
  (if (y-or-n-p "Really delete this keyword? ")
      (progn
	(start-process-shell-command "delete-hatena-group-keyword"
				     "*delete-hatena-group-keyword*"
				     hatena-group-keyword-bin "-d" (expand-file-name (buffer-name (window-buffer))))
	(delete-file (expand-file-name (buffer-name (window-buffer))))
	(kill-buffer (buffer-name (window-buffer)))
	(message "finished deleting hatena group keyword."))
    (message "did not delete hatena group keyword.")))

;; 内部関数

(defun hatena-group-keyword-post-internal ()
  "function to post hatena keyword"
  (let* ((max-mini-window-height 10)
	 (buffer (get-buffer-create hatena-group-keyword-process-buffer-name))
	 (proc (get-buffer-process buffer))
	 (thisdir (file-name-directory (buffer-file-name))))
    (when (buffer-modified-p) ;; 保存されていなかったら、保存する
      (save-buffer))
    (message "%s" "Now posting...")
    (with-current-buffer buffer ;; bufferの内容を一旦消す
      (progn
	(erase-buffer)
	(buffer-disable-undo (current-buffer))
	(setq default-directory thisdir)))
    (make-comint-in-buffer ;; postするところ
     "*HatenaGroupKeyword*" (get-buffer "*HatenaGroupKeyword*")
     shell-file-name nil
     shell-command-switch (concat hatena-group-keyword-bin " -e " (expand-file-name (buffer-name (window-buffer)))))
  (set-process-sentinel ;; 終わったらメッセージを表示する
   (get-buffer-process buffer)
   '(lambda (process signal)
      (if (string= signal "finished\n")
	  (display-message-or-buffer (process-buffer process)))))))

(defun hatena-group-keyword-view-keyword-in-browser-internal ()
  "function to open the keyword in safari."
  (sit-for 1) ;; 1秒待つにしないとキーが取られてしまう
  (browse-url (concat "http://" hatena-group-keyword-default-group ".g.hatena.ne.jp/keyword/" (car (split-string (buffer-name (window-buffer)) "\.txt")))))