root/lang/elisp/simple-hatena-mode/simple-hatena-mode.el @ 558

Revision 558, 21.1 kB (checked in by kentaro, 6 years ago)
  • lang/elisp/simple-hatena-mode: defcustomとしていた箇所を、defvarに改めた。
  • lang/elisp/simple-hatena-mode: simple-hatena-change-default-groupに、C-c C-gを割りあてた。
  • lang/elisp/simple-hatena-mode: simple-hatena-electric-asteriskが、ユーザがsimple-hatena-use- timestamp-permalink-flagをnilに設定しているにも関わらず、実行されてしまうバグを改めた(id:odzさんにいただいたコードを、kentaroが改悪したためにエンバグしたもの)。
  • Property svn:mime-type set to text/plain; charset=utf-8
Line 
1;;; simple-hatena-mode.el --- Emacs interface to Hatena::Diary Writer
2;; -*- coding: utf-8; mode:emacs-lisp -*-
3
4;; Copyright (C) 2007 Kentaro Kuribayashi
5;; Author: Kentaro Kuribayashi <kentarok@gmail.com>
6;; Keywords: blog, hatena, はてな
7
8;; This file is free software; you can redistribute it and/or modify
9;; it under the terms of the GNU General Public License as published
10;; by the Free Software Foundation; either version 2, or (at your
11;; option) any later version.
12
13;; This file is distributed in the hope that it will be useful, but
14;; WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
16;; General Public License for more details.
17
18;; You should have received a copy of the GNU General Public License
19;; along with GNU Emacs; see the file COPYING.  If not, write to the
20;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21;; Boston, MA 02111-1307, USA.
22
23;;; Commentary:
24
25;; * simple-hatena-mode.elについて
26
27;; このパッケージは、「はてなダイアリーライター」をEmacsから使えるよう
28;; にし、はてなダイアリー/グループ日記を簡単に更新するためのメジャーモー
29;; ド、simple-hatena-modeを提供します。simple-hatena-modeは、
30;; html-helper-modeの派生モードとして定義されていますので、
31;; html-helper-modeが提供する各種機能も利用できます。
32;;
33;; インストール、設定方法等については、以下のページをご覧ください。
34;; http://coderepos.org/share/wiki/SimpleHatenaMode
35
36;;; Code:
37
38;;;; * ヴァージョン
39
40(defconst simple-hatena-version "0.10"
41  "simple-hatena-mode.elのヴァージョン。")
42
43(defun simple-hatena-version ()
44  "simple-hatena-mode.elのヴァージョンを表示する。"
45  (interactive)
46  (let ((version-string
47         (format "simple-hatena-mode-v%s" simple-hatena-version)))
48    (if (interactive-p)
49        (message "%s" version-string)
50      version-string)))
51
52;;;; * ユーザによるカスタマイズが可能な設定
53
54;; カスタマイズ変数
55(defvar simple-hatena-bin "hw.pl"
56  "*はてなダイアリーライターのパスを指定する。")
57
58(defvar simple-hatena-root "~/.hatena"
59  "*はてなダイアリーライターのデータを置くディレクトリのルートを指
60定する。")
61
62(defvar simple-hatena-default-id nil
63  "*はてダラで使うデフォルトのはてなidを指定する。
64
65この変数が設定されている場合、simple-hatenaあるいは
66simple-hatena-group実行時に、設定されたidが使われるため、idを選択
67する必要がない。
68
69このidを変更するには、simple-hatena-change-default-idを実行する。")
70
71(defvar simple-hatena-default-group nil
72  "*デフォルトグループ名を指定する。")
73
74(defvar simple-hatena-use-timestamp-permalink-flag t
75  "*はてなダイアリーライターのパーマリンクに、タイムスタンプを使う
76かどうかを指定するフラグ。")
77
78(defvar simple-hatena-time-offset nil
79  "*日付を計算する際に用いるオフセット。
806 に設定すると午前6時まで前日の日付として扱われる")
81
82;; はてダラにわたすオプション
83(defvar simple-hatena-option-useragent (simple-hatena-version)
84  "*はてなダイアリーライターのユーザエージェントオプションを指定す
85る。
86
87実行時に、-aオプションとして使われる。")
88
89(defvar simple-hatena-option-debug-flag nil
90  "*はてなダイアリーライターを、デバッグモードで実行するか否かを指
91定するフラグ。
92
93はてなダイアリーライター実行時に、-dオプションとしてわたされ、また、
94その場合、実行結果をバッファに表示する。
95
96デバッグモードをオン/オフするには、
97simple-hatena-toggle-debug-modeを実行する。")
98
99(defvar simple-hatena-option-timeout "30"
100  "*はてなダイアリーライターのタイムアウトを指定する。
101
102実行時に、-Tオプションとして使われる。")
103
104(defvar simple-hatena-option-cookie-flag t
105  "*はてなダイアリーライターのログインに、cookieを利用するかどうか
106を指定するフラグ。
107
108実行時に、-cオプションとして使われる。")
109
110(defvar simple-hatena-process-buffer-name "*SimpleHatena*"
111  "*はてダラを実行するプロセスのバッファ名。")
112
113;; キーバインド
114(setq simple-hatena-mode-map (make-keymap))
115
116(define-key simple-hatena-mode-map (kbd "C-c C-v") 'simple-hatena-version)
117(define-key simple-hatena-mode-map (kbd "C-c C-p") 'simple-hatena-submit)
118(define-key simple-hatena-mode-map (kbd "C-c C-c") 'simple-hatena-trivial-submit)
119(define-key simple-hatena-mode-map (kbd "C-c   *") 'simple-hatena-timestamp)
120(define-key simple-hatena-mode-map (kbd "C-c C-i") 'simple-hatena-change-default-id)
121(define-key simple-hatena-mode-map (kbd "C-c C-g") 'simple-hatena-change-default-group)
122(define-key simple-hatena-mode-map (kbd "C-c C-n") 'simple-hatena-find-diary-for)
123(define-key simple-hatena-mode-map (kbd "C-c C-b") 'simple-hatena-go-back)
124(define-key simple-hatena-mode-map (kbd "C-c C-f") 'simple-hatena-go-forward)
125(define-key simple-hatena-mode-map (kbd "C-c C-d") 'simple-hatena-toggle-debug-mode)
126(define-key simple-hatena-mode-map (kbd "C-c C-e") 'simple-hatena-exit)
127(define-key simple-hatena-mode-map (kbd       "*") 'simple-hatena-electric-asterisk)
128
129;; フック
130(defvar simple-hatena-mode-hook nil
131  "simple-hatena-mode開始時のフック。")
132(defvar simple-hatena-before-submit-hook nil
133  "日記を投稿する直前のフック")
134(defvar simple-hatena-after-submit-hook nil
135  "日記を投稿した直後のフック")
136
137;; フォントロック
138
139(defvar simple-hatena-font-lock-keywords nil)
140(defvar simple-hatena-slag-face 'simple-hatena-slag-face)
141(defvar simple-hatena-subtitle-face 'simple-hatena-subtitle-face)
142(defvar simple-hatena-inline-face 'simple-hatena-inline-face)
143(defvar simple-hatena-markup-face 'simple-hatena-markup-face)
144(defvar simple-hatena-link-face 'simple-hatena-link-face)
145
146(defface simple-hatena-slag-face
147  '((((class color) (background light)) (:foreground "IndianRed"))
148    (((class color) (background dark)) (:foreground "wheat")))
149  "小見出しの*タイムスタンプorスラッグ*部分のフェイス。")
150
151(defface simple-hatena-subtitle-face
152  '((((class color) (background light)) (:foreground "DarkOliveGreen"))
153    (((class color) (background dark)) (:foreground "wheat")))
154  "小見出しのフェイス。")
155
156(defface simple-hatena-inline-face
157  '((((class color) (background light)) (:foreground "MediumBlue" :bold t))
158    (((class color) (background dark)) (:foreground "wheat" :bold t)))
159  "id記法や[keyword:Emacs]等のface")
160
161(defface simple-hatena-markup-face
162  '((((class color) (background light)) (:foreground "DarkOrange" :bold t))
163    (((class color) (background dark)) (:foreground "IndianRed3" :bold t)))
164  "はてなのマークアップのフェイス。")
165
166(defface simple-hatena-link-face
167  '((((class color) (background light)) (:foreground "DeepPink"))
168    (((class color) (background dark)) (:foreground "wheat")))
169  "リンクのフェイス。")
170
171;;;; * 実装
172
173(eval-when-compile
174  (require 'cl)
175  (require 'derived)
176  (require 'font-lock)
177  (require 'html-helper-mode))
178
179(defconst simple-hatena-filename-regex
180   "/\\([^/]+\\)/\\(diary\\|group\\)/\\([^/]+\\)?/?\\([0-9][0-9][0-9][0-9]\\)-\\([01][0-9]\\)-\\([0-3][0-9]\\)\.txt"
181  "日記ファイルの正規表現。マッチした場合、以下のインデックスによ
182りファイル情報を取得できる。
183
184  0. マッチした全体
185  1. はてなid
186  2. diary/group
187  3. 2がgroupの場合は、グループ名。そうでない場合はnil
188  4. 年(YYYY)
189  5. 月(MM)
190  6. 日(DD)")
191
192;; simple-hatena-modeを、html-helper-modeの派生モードとして定義する。
193(define-derived-mode simple-hatena-mode html-helper-mode "Simple Hatena"
194  "はてなダイアリーライターを、Emacsから利用するためのインタフェイ
195スを提供するモード。
196
197設定方法や使い方については、以下を参照のこと。
198http://coderepos.org/share/wiki/SimpleHatenaMode"
199
200  ;; 現在開いているバッファの情報
201  (make-local-variable 'simple-hatena-local-current-buffer-info)
202  (make-local-variable 'simple-hatena-local-current-buffer-id)
203  (make-local-variable 'simple-hatena-local-current-buffer-type)
204  (make-local-variable 'simple-hatena-local-current-buffer-group-name)
205  (make-local-variable 'simple-hatena-local-current-buffer-year)
206  (make-local-variable 'simple-hatena-local-current-buffer-month)
207  (make-local-variable 'simple-hatena-local-current-buffer-day)
208
209  (if (string-match simple-hatena-filename-regex (buffer-file-name))
210      (progn
211        (setq simple-hatena-local-current-buffer-info
212              (match-string 0 (buffer-file-name)))
213        (setq simple-hatena-local-current-buffer-id
214              (match-string 1 (buffer-file-name)))
215        (setq simple-hatena-local-current-buffer-type
216              (match-string 2 (buffer-file-name)))
217        (setq simple-hatena-local-current-buffer-group-name
218              (match-string 3 (buffer-file-name)))
219        (setq simple-hatena-local-current-buffer-year
220              (match-string 4 (buffer-file-name)))
221        (setq simple-hatena-local-current-buffer-month
222              (match-string 5 (buffer-file-name)))
223        (setq simple-hatena-local-current-buffer-day
224              (match-string 6 (buffer-file-name))))
225    (error "Current buffer isn't related to Hatena::Diary Writer data file"))
226
227  ;; フォントロック
228  (font-lock-add-keywords 'simple-hatena-mode
229    (list
230     (list  "^\\(\\*[*a-zA-Z0-9_-]*\\)\\(.*\\)$"
231            '(1 simple-hatena-slag-face t)
232            '(2 simple-hatena-subtitle-face t))
233     ;; 必ず[]で囲まれていなければならないもの
234     (list "\\[[*a-zA-Z0-9_-]+\\(:[^\n]+\\)+\\]"
235           '(0 simple-hatena-inline-face t))
236     ;; 必ずしも[]で囲まれていなくてもよいもの
237     (list "\\[?\\(id\\|a\\|b\\|d\\|f\\|g\\|graph\\|i\\|idea\\|map\\|question\\|r\\|isbn\\|asin\\)\\(:[a-zA-Z0-9_+:-]+\\)+\\]?"
238           '(0 simple-hatena-inline-face t))
239     (list  "^\\(:\\)[^:\n]+\\(:\\)"
240            '(1 simple-hatena-markup-face t)
241            '(2 simple-hatena-markup-face t))
242     (list  "^\\([-+]+\\)"
243            '(1 simple-hatena-markup-face t))
244     (list  "\\(((\\).*\\())\\)"
245            '(1 simple-hatena-markup-face t)
246            '(2 simple-hatena-markup-face t))
247     (list  "^\\(>>\\|<<\\|><!--\\|--><\\|>|?[^|]*|\\||?|<\\|=====?\\)"
248            '(1 simple-hatena-markup-face t))
249     (list  "\\(s?https?://\[-_.!~*'()a-zA-Z0-9;/?:@&=+$,%#\]+\\)"
250            '(1 simple-hatena-link-face t))))
251  (font-lock-mode 1)
252
253  (use-local-map simple-hatena-mode-map)
254  (run-hooks 'simple-hatena-mode-hook))
255
256;; はてダラデータにsimple-hatena-modeを適用する
257;;
258;; - ~/.hatena/hatena-id/diary/YYYY-MM-DD.txt
259;; - ~/.hatena/hatena-id/group/group-name/YYYY-MM-DD.txt
260;;
261;; というファイルを開いたら、simple-hatena-modeにする
262(add-to-list 'auto-mode-alist
263             (cons simple-hatena-filename-regex 'simple-hatena-mode))
264
265;;;; * コマンド
266
267(defun simple-hatena-setup ()
268  "ディレクトリ配置をセットアップする。")
269
270(defun simple-hatena (id)
271  "実行日現在の日付のファイルを開く。"
272  (interactive
273   (list
274    (if simple-hatena-default-id
275        simple-hatena-default-id
276      (simple-hatena-internal-completing-read-id simple-hatena-root))))
277  (simple-hatena-internal-safe-find-file (concat
278               simple-hatena-root
279               "/"
280               id
281               "/diary/"
282               (simple-hatena-internal-make-diary-file-string 0))))
283
284(defun simple-hatena-group (id group)
285  "実行日現在の日付の、指定されたグループに投稿するためのファイル
286を開く。"
287  (interactive
288   (if simple-hatena-default-id
289       (list
290        simple-hatena-default-id
291        (if simple-hatena-default-group
292            simple-hatena-default-group
293          (simple-hatena-internal-completing-read-group simple-hatena-default-id)))
294     (let ((id (simple-hatena-internal-completing-read-id simple-hatena-root)))
295       (list
296        id
297        (if simple-hatena-default-group
298            simple-hatena-default-group
299          (simple-hatena-internal-completing-read-group id))))))
300  (simple-hatena-internal-safe-find-file (concat
301              simple-hatena-root
302              "/"
303              id
304              "/group/"
305              group
306              "/"
307              (simple-hatena-internal-make-diary-file-string 0))))
308
309(defun simple-hatena-change-default-id ()
310  "現在のデフォルトidを変更する。"
311  (interactive)
312  (setq simple-hatena-default-id
313        (simple-hatena-internal-completing-read-id simple-hatena-root))
314  (message "Changed current default id to %s" simple-hatena-default-id))
315
316(defun simple-hatena-change-default-group ()
317  "現在のデフォルトグループを変更する。"
318  (interactive)
319  (if simple-hatena-default-id
320      (setq simple-hatena-default-group
321            (simple-hatena-internal-completing-read-group simple-hatena-default-id))
322    (list (simple-hatena-change-default-id)
323          (setq simple-hatena-default-group
324                (simple-hatena-internal-completing-read-group simple-hatena-default-id))))
325  (message "Change current default group to %s" simple-hatena-default-group))
326
327(defun simple-hatena-submit ()
328  "はてなダイアリー/グループに投稿する。"
329  (interactive)
330  (simple-hatena-internal-do-submit))
331
332(defun simple-hatena-trivial-submit ()
333  "はてなダイアリー/グループに「ちょっとした更新」で投稿する。"
334  (interactive)
335  (simple-hatena-internal-do-submit "-t"))
336
337(defun simple-hatena-timestamp ()
338  "実行位置に、「*タイムスタンプ*」を挿入する。"
339  (interactive)
340  (insert (format-time-string "*%s*" (current-time))))
341
342(defun simple-hatena-find-diary-for (date)
343  "指定された日付の日記バッファを表示する。"
344  (interactive "sDate(YYYY-MM-DD): ")
345  (if (equal major-mode 'simple-hatena-mode)
346      (if (string-match "^[0-9][0-9][0-9][0-9]-[01][0-9]-[0-3][0-9]$" date)
347          (simple-hatena-internal-safe-find-file
348           (concat (file-name-directory (buffer-file-name))
349                   (concat date ".txt")))
350        (error "Invalid date"))
351    (error "Current major mode isn't simple-hatena-mode")))
352
353(defun simple-hatena-go-forward (&optional i)
354  "前の日付へ移動する。前置引数が渡された場合は、その数だけ後の日付に移動する。"
355  (interactive "p")
356  (if (not i)
357      (simple-hatena-internal-go-for 1)
358    (simple-hatena-internal-go-for i)))
359
360(defun simple-hatena-go-back (&optional i)
361  "次の日付へ移動する。前置引数が渡された場合は、その数だけ前の日付に移動する。"
362  (interactive "p")
363  (if (not i)
364      (simple-hatena-internal-go-for -1)
365    (simple-hatena-internal-go-for (- i))))
366
367(defun simple-hatena-toggle-debug-mode ()
368  "デバッグモードをオン/オフする。"
369  (interactive)
370  (if simple-hatena-option-debug-flag
371      (progn
372        (setq simple-hatena-option-debug-flag nil)
373        (message "Debug mode off"))
374    (progn
375      (setq simple-hatena-option-debug-flag t)
376      (message "Debug mode on"))))
377
378(defun simple-hatena-exit ()
379  "simple-hatena-modeの適用されているバッファを全て削除する。"
380  (interactive)
381  (dolist (buffer (buffer-list))
382    (when (and
383           (buffer-file-name buffer)
384           (string-match simple-hatena-filename-regex (buffer-file-name buffer)))
385      (when (buffer-modified-p buffer)
386        (progn
387          (save-current-buffer
388            (set-buffer buffer)
389            (save-buffer))))
390      (kill-buffer buffer)))
391  (message "simple-hatena-mode has been exited"))
392
393(defun simple-hatena-electric-asterisk (arg)
394  "＊(アスタリスク)押下により、タイムスタンプ付き小見出しを挿入する。
395
396ポイントが行頭にある場合のみ、タイムスタンプを挿入し、その他の場合
397は、通常通りアスタリスクを挿入する。"
398  (interactive "*p")
399  (if (and simple-hatena-use-timestamp-permalink-flag
400           (zerop (current-column)))
401      (simple-hatena-timestamp)
402    (self-insert-command arg)))
403
404;;;; * 内部関数
405
406(defun simple-hatena-internal-safe-find-file (filename)
407  "新しいヴァージョンのhtml-helper-modeは、デフォルトでスケルトン
408を作ってウザいので、阻止する。"
409  (let ((html-helper-build-new-buffer nil))
410    (find-file filename)))
411
412(defun simple-hatena-internal-make-diary-file-string (i &optional date)
413  "dateが指定されていない場合は、実行日現在の日付を起点にした日記ファイル名を生成する。
414
415   0: 今日
416   1: 明日
417  -1: 昨日
418
419指定されている場合は、その日付を起点にした日記ファイル名を生成する。"
420  (apply (lambda (s min h d mon y &rest rest)
421           (format-time-string "%Y-%m-%d.txt"
422                               (encode-time s min h (+ d i) mon y)))
423         (if date
424             (append '(0 0 0) date)
425           (apply (lambda (s min h d mon y &rest rest)
426                    (list s min (- h (or simple-hatena-time-offset 0)) d mon y))
427                  (decode-time)))))
428
429(defun simple-hatena-internal-go-for (i)
430  "引数の数だけ前後の日付のファイ名バッファへ移動する。"
431  (simple-hatena-internal-safe-find-file
432   (concat
433    (file-name-directory (buffer-file-name))
434    (simple-hatena-internal-make-diary-file-string
435     i
436       (list (string-to-number simple-hatena-local-current-buffer-day)
437             (string-to-number simple-hatena-local-current-buffer-month)
438             (string-to-number simple-hatena-local-current-buffer-year))))))
439
440(defun simple-hatena-internal-list-directories (dir)
441  "dir下にあるディレクトリをリストにして返す。"
442  (let ((dir-list nil))
443    (dolist (file (directory-files dir t "^[^\.]") dir-list)
444      (if (file-directory-p file)
445          (progn
446            (string-match "\\([^/]+\\)/?$" file)
447            (setq dir-list (cons (match-string 1 file) dir-list)))))))
448
449(defun simple-hatena-internal-completing-read-id (dir)
450  "dir以下からはてなidを抽出し、補完入力させる。"
451  (completing-read
452   "Hatena id: " (simple-hatena-internal-list-directories simple-hatena-root) nil t))
453
454(defun simple-hatena-internal-completing-read-group (id)
455  "dir以下からグループ名を抽出し、補完入力させる。"
456  (completing-read
457   "Group: " (simple-hatena-internal-list-directories
458              (concat simple-hatena-root "/" id "/group")) nil t))
459
460(defun simple-hatena-internal-do-submit (&optional flag)
461  "はてなダイアリ/グループへ日記を投稿する。"
462  (let ((max-mini-window-height 10)) ; hw.plが表示するメッセージを、
463                                     ; echoエリアに表示させるため。
464    (run-hooks 'simple-hatena-before-submit-hook)
465    (when (buffer-modified-p)
466      (save-buffer))
467    (message "%s" "Now posting...")
468    (let* ((buffer (get-buffer-create simple-hatena-process-buffer-name))
469           (proc (get-buffer-process buffer)))
470      (if (and
471           proc
472           (eq (process-status proc) 'run)
473           (yes-or-no-p (format "A %s process is running; kill it?"
474                                (process-name proc))))
475          (progn
476            (interrupt-process proc)
477            (sit-for 1)
478            (delete-process proc)))
479      (with-current-buffer buffer
480        (progn
481          (erase-buffer)
482          (buffer-disable-undo (current-buffer))))
483      (make-comint-in-buffer
484       "simple-hatena-submit" buffer shell-file-name nil
485       shell-command-switch (simple-hatena-internal-build-command flag))
486      (set-process-sentinel
487       (get-buffer-process buffer)
488       '(lambda (process signal)
489          (if (string= signal "finished\n")
490              (let ((max-mini-window-height 10))
491                (display-message-or-buffer (process-buffer process))
492                (run-hooks 'simple-hatena-after-submit-hook))))))))
493
494(defun simple-hatena-internal-build-command (flag)
495  "実行可能なコマンド文字列を作成する。"
496  (let ((flag-list (list flag)))
497    (if simple-hatena-option-debug-flag  (setq flag-list (cons "-d" flag-list)))
498    (if simple-hatena-option-cookie-flag (setq flag-list (cons "-c" flag-list)))
499    (simple-hatena-internal-join
500     " "
501     (cons simple-hatena-bin
502           (append (simple-hatena-internal-build-option-list-from-alist) flag-list)))))
503
504(defun simple-hatena-internal-build-option-list-from-alist ()
505  "引数を取るオプションのリストを作成する。"
506  (let ((opts nil))
507    (dolist (pair
508             `(("-u" . ,simple-hatena-local-current-buffer-id)
509               ("-a" . ,simple-hatena-option-useragent)
510               ("-T" . ,simple-hatena-option-timeout))
511             opts)
512      (if (cdr pair)
513           (setq opts (append opts (list (car pair) (cdr pair))))))))
514
515(defun simple-hatena-internal-join (sep list)
516  "車輪の再発明なんだろうけど、見つからなかったのでjoin実装"
517  (if (<= (length list) 1)
518      (car list)
519    (concat (car list) sep (simple-hatena-internal-join sep (cdr list)))))
520
521(provide 'simple-hatena-mode)
522
523;;; simple-hatena-mode.el ends here
Note: See TracBrowser for help on using the browser.