hatedara-mode 暫定版 - おもてなしの空間

2007年08月28日（火）

■[hatena][hatedara][hatena-mode][elisp] hatedara-mode 暫定版

7/4 から、はてなダイアリー側の仕様変更によって、hatena-modeからの投稿が出来なくなってしまいましたので、hatena-mode の派生モードで、投稿に、はてなダイアリーライターを使用した hatedara-mode というのを暫定的に作ってみました。
;; -*- coding: iso-2022-7bit-unix; mode:emacs-lisp -*-
;; $Id$
;;; hatedara.el --- Frontend of hatena diary writer

;; Copyright (C) 2007  Free Software Foundation, Inc.

;; Author: ITSUMI ken-ichi <itsumi@gmail.com>
;; Keywords: emacs lisp はてな はてなダイアリー はてなダイアリーライター

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; ■ これは何か

;; 簡単にいうと、hyukiさんの作られた、はてなダイアリー投稿スクリプト 
;; 「はてなダイアリーライター」(はてダラ)
;; http://www.hyuki.com/techinfo/hatena_diary_writer.html の emacs フ
;; ロントエンドです。
;; 
;; もともと rubikitch さんが作られたもの
;; (http://d.hatena.ne.jp/rubikitch/20070617#1186047998)を、いつみの趣味
;; で多少変更したダケのものです。
;; 
;; hatena-mode(http://d.hatena.ne.jp/hikigaeru/20040617) の派生モード
;; として実装していますので、単体では動作しません
;; 別途 hateda-mode のインストールが必要です。
;; また、投稿には「はてなダイアリーライター」を使用しますので、
;; 「はてなダイアリーライター」のインストールも必要です。
;; 小生の「はてなダイアリーライター」のインストールメモが以下にあります。
;; 	http://d.hatena.ne.jp/amt/20070819/HatenaDiaryWriterViaEmacs

;; ■インストール方法
;; 0) 「はてなダイアリーライター」及び、hatena-mode をインストールする
;;    「はてなダイアリーライター」は、hatedara-work-dir に config.txt hw.pl が置かれ
;;    かつ config.txt に、id,パスワード、プロキシ等の設定がされていて "perl hw.pl" とする
;     だけで、「はてなダイアリー」への投稿が可能であることが必要である。

;;
;; 1) 適当なディレクトリにこのファイルをおく.
;;    (以下、~/elisp/hatedara-mode/hatedara.el においたと仮定して話を進める). 
;;
;; 2) 環境に応じて hatedara-work-dir 等カスタマイズ変数を変更する。
;;
;; 3) .emacs に以下の行を追加する
;;
;;	 ;;; 20070828 for hatedara-mode
;;	 (add-to-list 'load-path "~/elisp/hatedara-el/")
;;	 (require 'hatedara)

;; ■使い方
;; M-x hatedara-mode で本日の日記バッファをオープン
;; C-c C-p(hatedara-find-previous) で前の日の日記
;; C-c C-f(hatedara-find-following) で次の日の日記
;; C-c C-c(hatedara-submit) でカレントバッファを送信
;; C-c C-S-c(hatedara-submit-trivial-change) でカレントバッファをちょっとした変更として送信
;; C-c C-S-p(hatedara-get-todays-photo) で今日の朝6時の天気図を取得(取得できる時間制限有)

;; ■hook
;;    フック変数 hatedara-mode-hook に関数名を add-hook してやれば、そ
;;    れらは hatedara-mode 実行の最後に実行される。

;; ■Bugs
;;   次/前の日記に移動 
;;   hatedara-find-following()/hatedara-find-previous() を連続して行な
;;   うと出発したバッファに戻ってしまう。

;; ■今後の予定
;; 臨時の応急的なものなので、これを発展させる気は基本的にない。
;; 別途 hatenaplus-mode の構想はある。



;; インストール方法や使い方など詳しくは、下記 URL に示す予定
;;  http://amt.ty.land.to/MySoft/hatedara-el.html(TBD)

;; ■ 改訂記録
;;      20070828 Ver.0.01 暫定版公開
 

;;; Code:

;; ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
;; ●必要な外部ファイルの require
(require 'hatena-mode)
(require 'derived)

;; ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
;; ●バージョン管理
(defconst hatedara-version "0.01" "Version number of hatedara.el")

(defun hatedara-version (&optional insert)
  "Display the version of Hatedara.el that is currently loaded.
If INSERT is non-nil, insert the text instead of displaying it."
  (interactive "P")
  (if insert
      (insert hatedara-version)
    (message hatedara-version)))

;; ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
;; ●カスタマイズ用変数
(defgroup hatedara nil
  "hatedara for emacs"
  :group 'local
  :group 'tools
  :link '(url-link "http://amt.ty.land.to/MySoft/hatedara-el.html"))

(defcustom hatedara-work-dir (expand-file-name "~/memo/hatena/")
;(defcustom hatedara-work-dir "/tmp/hatedara_test/"
  "はてなダイアリーライターの作業ディレクトリ(フルパスで最後にスラッシュをつける)"
  :type 'directory
  :group 'hatedara)

(defcustom hatedara-wget-cmd "/usr/bin/wget"
  "天気図獲得につかう wget コマンドへのパス"
  :type '(file :must-match t)
  :group 'hatedara)

(defcustom hatedara-perl-path "/usr/bin/perl"
  "はてなダイアリーライターを実行する perl のパス"
  :type '(file :must-match t)
  :group 'hatedara)

(defcustom hatedara-script-path (concat hatedara-work-dir "hw.pl")
;(defcustom hatedara-script-path "/home/amt/memo/hatena/hw.pl"
  "はてなダイアリーライタースクリプト(hw.pl) のパス"
  :type '(file :must-match t)
  :group 'hatedara)


;; ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
;; ●大域変数(ユーザに開放しない)

(defconst hatedara-fname-regexp
  "\\([0-9][0-9][0-9][0-9]\\)-\\([01][0-9]\\)-\\([0-3][0-9]\\)\.txt$" ;先頭文字 '^' は入れない
  "はてダラ日記ファイルの正規表現パターン YYYY-MM-DD.txt")

(defconst hatedara-base
  (expt 2 16)
  "2**16=65536 16bit ワード長にして、ロング型の基数")

;; 気象庁の配布する天気図についての覚書
;;   朝6時の天気図は、当日朝8時には掲載されている
;;   掲載後 2週間程度で expire される
;;   ファイル名の書式は YYMMDDHH.png
;; http://www.jma.go.jp/jp/g3/images/observe/07082406.png
(defconst hatedara-weather-map-url-stem
  "http://www.jma.go.jp/jp/g3/images/observe/"
  "天気図画像URL基幹部")

(defconst hatedara-weather-map-time
  "06"
  "天気図時刻")

(defconst hatedara-weather-map-extention
  ".png"
  "天気図拡張子")

(defconst hatedara-wget-out
  "*hatedara-wget-out*"
  "wget cmd output buffer")

(defconst hatedara-perl-out
  "*hatedara-perl-out*"
  "hatedra perl output buffer")

;; ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
;; ●モード定義
(define-derived-mode hatedara-mode hatena-mode "Hatedara"
  "Yet another emacs frontend of Hatena Diary Writer(hatedara)
Special command:
\\{hatedara-mode-map}"
  ;; hatedara-mode() で実行するコマンドを以下に列挙
  (find-file
   (concatenate 'string hatedara-work-dir 
                (format-time-string "%Y-%m-%d.txt" (current-time)))))

;; キーバインドは、ここに列挙
(define-key hatedara-mode-map [(control ?c) (control ?c)] 'hatedara-submit)
(define-key hatedara-mode-map [(control ?c) (control ?C)] 'hatedara-submit-trivial-change)
(define-key hatedara-mode-map [(control ?c) (control ?f)] 'hatedara-find-following)
(define-key hatedara-mode-map [(control ?c) (control ?p)] 'hatedara-find-previous)
(define-key hatedara-mode-map [(control ?c) (control ?P)] 'hatedara-get-todays-photo)
;; (define-key hatedara-mode-map [(control ?c) (control ?c)] 'hatedara-)


;; ハテダラ日記原稿を開いたら hatedara-mode にする
(add-to-list 'auto-mode-alist 
	     (cons (concat hatedara-work-dir hatedara-fname-regexp) 'hatedara-mode))

;; ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
;; ●hatedara-find-following()/hatedara-find-previous() 次/前の日の日記バッファに移動
(defun hatedara-find-following (n) 
  "次の日の日記バッファに移動"
  ;; カレント日記バッファ
  (interactive "p")
  (save-buffer)
  (find-file
   (concatenate 'string hatedara-work-dir (hatedara-move-buffer n))))
 
(defun hatedara-find-previous (n) 
  "前の日の日記バッファに移動"
  (interactive "p")
  (hatedara-find-following (- 0 n))) 

(defun hatedara-move-buffer (n)
  "カレントバッファ bname から n日( n < 0 の場合、負許す)後のバッファ "
  (let ((time (hatedara-bname-to-time (buffer-name))))
    (hatedara-time-to-bname (hatedara-day-shift time n))))


;; ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
;; ●hatedara-submit() 日記の送信

(defun hatedara-submit (&optional trivial-p debug-p)
  "カレントバッファを ハテナダイアリーに送信する"
  (interactive)
  (let* ((bname (buffer-name))
	 (full-path (buffer-file-name))	 
	 (dir (file-name-directory full-path)))	; file-name-directory() は末尾に "/" を付けた dir を返す
    ;; カレントバッファ名が「はてなダイアリーライター」の日記ファイルとして正しいかチェック
    (unless (hatedara-buffer-name-p bname)
      (error "hatedara-get-todays-photo():: %s is not hatedara diary buffer" bname))
    (unless (string= dir hatedara-work-dir)
      (message "Warning:: submitting file does not locate haredara work area!" full-path))
    
    (save-buffer)
    (let* ((trivial-flag (if trivial-p "-t" ""))
	   (debug-flag (if debug-p "-d" ""))
	   (result (call-process hatedara-perl-path
				 nil			; 入力 (nil の時は /dev/null)
				 hatedara-perl-out	; エラー出力を分離する時は (list std-out err-out)
							; err-out はファイルのみ、(std-out) はバッファでよい
				 nil			; non-nil だと、出力を挿入したバッファを再表示
				 ;; 以下 perl の引数
				 hatedara-script-path "-f" full-path trivial-flag debug-flag)))
      (if (= 0 result)
	  ;; 正常終了のケース
	  (message "hatedara-submit() successfully send today's log %s. " bname)
	(error "hatedara-submit() failed to post diary %s . Consult %s!"
	       bname  hatedara-perl-out)))))

(defun hatedara-submit-trivial-change (&optional debug-p)
  "ちょっとした変更(-t)の送信"
  (interactive)
  (hatedara-submit t debug-p))



;; ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
;; ● hatedara-get-todays-photo()
;;    引数バッファ base に対応する朝6時の天気図画像をゲット
;;    天気図画像は、0700 すぎにアプロードされ、二週間程度で expire される
;;    朝6時の天気図のurl http://www.jma.go.jp/jp/g3/images/observe/07082406.png

;; テストケース
;;   (hatedara-get-todays-photo)
;;   (hatedara-get-todays-photo "2007-08-27.txt")
;;   (hatedara-get-todays-photo "2001-08-27.txt")
(defun hatedara-get-todays-photo (&optional bname)
  "引数バッファ base に対応する朝6時の天気図画像を獲得"
  (interactive)

  (unless bname
    (setq bname (hatedara-todays-buffer-name)))
  (unless (hatedara-buffer-name-p bname)
    (error "hatedara-get-todays-photo():: %s is not ") bname)

;;   ;; コマンド出力バッファのクリア
;;   (when (get-buffer hatedara-wget-out) ; get-buffer(bname) はバッファ bname が存在しなければ nil
;;     (save-current-buffer
;;       (set-buffer hatedara-wget-out)
;;       (erase-buffer)))
	      
  (let* ((url (hatedara-bname-to-image-url bname))
	 (outfile (concat hatedara-work-dir (hatedara-bname-to-image-file-name bname)))
	 (result (call-process hatedara-wget-cmd
			       nil			; 入力 (nil の時は /dev/null)
			       hatedara-wget-out	; エラー出力を分離する時は (list std-out err-out)
							; err-out はファイルのみ、(std-out) はバッファでよい
			       nil			; non-nil だと、出力を挿入したバッファを再表示
			       ;; 以下 hatedara-wget-cmd の引数
			       url "-O" outfile)))
    (if (= 0 result)
	;; 正常終了のケース
	(message "hatedara-get-todays-photo() successfully got today's image %s. " outfile)
      (error "hatedara-get-todays-photo() failed to get today's image. Consult %s!"
	     hatedara-wget-out))))

(defun hatedara-bname-to-image-url (&optional bname)
  "引数バッファ名 bname から、当該日の天気図 url を返す"
  (unless bname
    (setq bname (hatedara-todays-buffer-name)))
  (unless (hatedara-buffer-name-p bname)
    (error "hatedara-bname-to-image-url():: %s is not ") bname)

  (let* ((datelist (hatedara-bname-to-datelist bname))
	 (yyyy (nth 0 datelist))
	 (mm  (nth 1 datelist))
	 (dd  (nth 2  datelist)))
    (concat hatedara-weather-map-url-stem
	    (format "%02d" (% yyyy 100)) ; 2007 -> "07"
	    (format "%02d%02d" mm dd)
	    hatedara-weather-map-time
	    hatedara-weather-map-extention)))

;; テストケース
;; (hatedara-bname-to-image-file-name)
;; (hatedara-bname-to-image-file-name '0001-12-01.txt')
;; (hatedara-bname-to-image-file-name '0001-12-01.foobar')
(defun hatedara-bname-to-image-file-name  (&optional bname)
  "引数日記バッファ名 bname(YYYY-MM-DD.txt) から、当該画像ファイル名(YYYY-MM-DD.png)を生成する"

  (unless bname
    (setq bname (hatedara-todays-buffer-name)))
  (unless (hatedara-buffer-name-p bname)
    (error "hatedara-bname-to-image-file-name():: %s is not ") bname)

  (let* ((datelist (hatedara-bname-to-datelist bname))
	 (yyyy (nth 0 datelist))
	 (mm  (nth 1 datelist))
	 (dd  (nth 2  datelist)))
    (concat (format "%04d-%02d-%02d" yyyy mm dd) 
	    hatedara-weather-map-extention)))

;; ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
;; ● ファイル名生成

(defun hatedara-buffer-name (&optional base index)
  "日記ファイル名 base に対して index 日後(負の場合は前)に対応する日記ファイル名を返す"
;; テストケース
;; (mapcar '(lambda (n) 
;; 	   (insert (format "%s\n" (prin1-to-string 
;; 				   (decode-time (hatedara-buffer-name "2007-08-24.txt" n))))))
;; 	'(-100 -10 -3 -1 0 1 2 3 4 10 100)) 
  (if base
      (hatedara-buffer-name-aux base index)
    ;; base の指定がなければ、現在日付のバッファ名を返す
    (hatedara-todays-buffer-name)))

(defun hatedara-todays-buffer-name ()
  "現在日付のはてダラバッファ名 YYYY-MM-DD.txt を返す"
  (format-time-string "%Y-%m-%d.txt" (current-time)))

(defun hatedara-buffer-name-aux (base &optional index)
  "日記ファイル名 base に対して index 日後(負の場合は前)に対応する日記ファイル名を返す"
  (unless (hatedara-buffer-name-p base)
    (error "Bad hadedara buffer name %s" base))
  (if index
      (hatedara-day-shift (hatedara-bname-to-time base) index)
    ;; index が省略されていれば base を返す
    base))


;; ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
;; ● 時刻の算術演算
(defun hatedara-buffer-name-p (bname)
  "引数 bname が、はてダラバッファ名(YYYY-MM-DD.txt) として正しいかを判定"
  (let ((bname-pattern (concat "^" hatedara-fname-regexp)))
    (string-match bname-pattern bname)))

(defun hatedara-bname-to-time (bname)
  "引数日記バッファ名 bname から elisp の時刻内部表現(c.f decode-time()) を返す ex.(18130 40614)"
  (if (string-match hatedara-fname-regexp bname)
      ;; encode-time の引数は、ちょっと変則的なので注意
      ;; 最初の 6つが SECONDS MINUTES HOUR DAY MONTH YEAR 
      ;; 最後の変数は ZONE
      ;; (ex. 18 23 11 24 8 2007 32400)
      (let ((s 0)(m 0)(h 0)
	    (dd (string-to-int (match-string 3 bname)))
	    (mm (string-to-int (match-string 2 bname)))
	    (yyyy (string-to-int (match-string 1 bname)))
	    ;; current-time-zone() の返り値は 例えば (32400 "JST")
	    (zone (nth 0 (current-time-zone))))
	(apply 'encode-time (list s m h dd mm yyyy zone)))
    (error "%s is not hatedara buffer." bname)))

(defun hatedara-time-to-bname (time)
  "引数 emacs 時刻内部表現(HIGH LOW ...) から対応するはてダラバッファ名(YYYY-MM-DD.txt) を生成"
  ;; (hatedara-time-to-bname (apply 'encode-time '(7 47 9 24 8 2007 5 nil 32400)))
  ;;   -> "2007-08-24.txt"
  ;; decode-time() の返り値は (SECONDS MINUTES HOUR DAY MONTH YEAR DOW DST ZONE)
  (let* ((tlist (decode-time time))
	 (yyyy (nth 5 tlist))
	 (mm (nth 4 tlist))
	 (dd (nth 3 tlist)))
    (format "%04d-%02d-%02d.txt" yyyy mm dd)))

;; ;; これは多分 28bit の壁のために、3 mod 1 以外で正しく動作しない
;; (defun hatedara-day-shift (time dday)
;;   "引数時刻 time に対して、引数 dday(負を許す)日分シフトした時刻内部表現を返す"
;;   (let* ((power_2_16  (expt 2 16)) 	; 2**16
;; 	 (sec_in_day (* 60 60 24))	; 86400 > 2**16=65536 16bit越え注意
;; 	 (sec_in_dday (* sec_in_day dday))
;; 	 (dday_h (/ sec_in_dday power_2_16))
;; 	 (dday_l (% sec_in_dday power_2_16))
;; 	 (base_h (nth 0 time))
;; 	 (base_l (nth 1 time)))
;;     (list (+ base_h dday_h) (+ base_l dday_l)))))

(defun hatedara-day-shift (time dday)
  "引数時刻 time に対して、引数 dday(負を許す)日分シフトした時刻内部表現を返す"
  ;; 28bit の壁対応として 1970-01-01-00-00-00 からの経過秒は (16bit 16bit) で計算する  
  (let ((delta (hatedara-long-product (hatedara-int-to-long (* 60 60 24))
				      (hatedara-int-to-long dday))))
    (hatedara-long-add time delta)))

;; ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
;; ● 32bit の積と和
;;    elisp の整数は 28ビットだから、システム時刻 32bit の計算に使えない
;;    32bit の積と和を用意する必要がある
;;    そこで、(16bit 16bit) で、32bit な数値を表現することにした。
;;    以下で、この為の演算を準備

(defun hatedara-int-to-long (n)
  "引数整数 n を 32bit 表現 (high low)に変更する"
  (let* ((high (/ n hatedara-base)) ;上位ワード分
	 (low (% n hatedara-base))) ;下位ワード分
    (list high low)))

(defun hatedara-long-product (m n)
  "32bit表現の積"
  ;;(hatedara-long-product (hatedara-int-to-long (* 60 60 24)) (hatedara-int-to-long 3))
  ;;(3 62592)
  ;;
  ;; m = mh*base + ml, n = nh*base + nl と書くと
  ;; low = (% (+ (* mh nl) (* nh ml) (* ml nl)) base)
  ;; high = (+ (* mh nh) (/ (+ (* mh nl) (* ml nh) (* ml nl)) base)
  ;;
  (let* ((mh (nth 0 m))
	 (ml (nth 1 m))
	 (nh (nth 0 n))
	 (nl (nth 1 n))
	 (high (+ (* mh nh) (/ (+ (* mh nl hatedara-base) (* ml nh hatedara-base) (* ml nl)) 
			       hatedara-base)))
	 (low (% (+ (* mh nl hatedara-base) (* nh ml hatedara-base) (* ml nl)) 
		 hatedara-base)))
    (list high low)))

(defun hatedara-long-add (m n)
  "32bit 表現の和"
  (let* ((mh (nth 0 m))
	 (ml (nth 1 m))
	 (nh (nth 0 n))
	 (nl (nth 1 n)))
    (list (+ mh nh (/ (+ ml nl) hatedara-base)) (% (+ ml nl) hatedara-base))))
	 

;; ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
;; ● 日記バッファ名 <-> 時刻 変換

(defun hatedara-bname-to-datelist (bname)
  "引数日記バッファ名 bname から 年月日リスト '(YYYY MM DD) を返す ex.(2007 8 1)"
  (let ((bname-pattern (concat "^" hatedara-fname-regexp)))
    (if (string-match bname-pattern bname)
	(let ((dd (string-to-int (match-string 3 bname)))
	      (mm (string-to-int (match-string 2 bname)))
	      (yyyy (string-to-int (match-string 1 bname))))
	  (list yyyy mm dd))
      (error "hatedara-bname-to-datelist():: %s is not hatedara diary buffer name" bname))))

(provide 'hatedara)
;;; hatedara.el ends here