root/lang/elisp/simple-hatena-mode/trunk/simple-hatena-mode.el @ 1935

Revision 1935, 27.3 kB (checked in by iwaim, 6 years ago)

lang/elisp/simple-hatena-mode: when simple-hatena-find-diary-for function get null string, it open today file with simple-hatena-time-offset value. (ticket #35)

  • Property svn:mime-type set to text/plain; charset=utf-8
Line 
1;;; -*- coding: utf-8; mode: emacs-lisp; indent-tabs-mode: nil -*-
2;;; simple-hatena-mode.el --- Emacs interface to Hatena::Diary Writer
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.15"
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;; はてなIDの正規表現
193;; > http://d.hatena.ne.jp/keyword/%A4%CF%A4%C6%A4%CAID
194;; > 大文字あるいは小文字のアルファベット・0-9の数字・「-」・「_」(いずれも
195;; 半角)のいずれかを3-32文字並べたもの(ただし最初の文字はアルファベットで
196;; あること)から成る。
197(defconst simple-hatena-id-regex
198  "^[A-z][\-_A-z0-9]+[A-z0-9]$"
199  "")
200
201;; はてなグループ名の正規表現
202;; > http://g.hatena.ne.jp/group?mode=append
203;; > (アルファベットで始まり、アルファベットか数字で終わる3文字以上、
204;; > 24文字以内の半角英数字)
205;; と書かれているが「-」も使える。
206(defconst simple-hatena-group-regex
207  "^[A-z][\-A-z0-9]+[A-z0-9]$"
208  "")
209
210;; simple-hatena-modeを、html-helper-modeの派生モードとして定義する。
211(define-derived-mode simple-hatena-mode html-helper-mode "Simple Hatena"
212  "はてなダイアリーライターを、Emacsから利用するためのインタフェイ
213スを提供するモード。
214
215設定方法や使い方については、以下を参照のこと。
216http://coderepos.org/share/wiki/SimpleHatenaMode"
217
218  ;; 現在開いているバッファの情報
219  (make-local-variable 'simple-hatena-local-current-buffer-info)
220  (make-local-variable 'simple-hatena-local-current-buffer-id)
221  (make-local-variable 'simple-hatena-local-current-buffer-type)
222  (make-local-variable 'simple-hatena-local-current-buffer-group)
223  (make-local-variable 'simple-hatena-local-current-buffer-year)
224  (make-local-variable 'simple-hatena-local-current-buffer-month)
225  (make-local-variable 'simple-hatena-local-current-buffer-day)
226
227  (if (string-match simple-hatena-filename-regex (buffer-file-name))
228      (progn
229        (setq simple-hatena-local-current-buffer-info
230              (match-string 0 (buffer-file-name)))
231        (setq simple-hatena-local-current-buffer-id
232              (match-string 1 (buffer-file-name)))
233        (setq simple-hatena-local-current-buffer-type
234              (match-string 2 (buffer-file-name)))
235        (setq simple-hatena-local-current-buffer-group
236              (match-string 3 (buffer-file-name)))
237        (setq simple-hatena-local-current-buffer-year
238              (match-string 4 (buffer-file-name)))
239        (setq simple-hatena-local-current-buffer-month
240              (match-string 5 (buffer-file-name)))
241        (setq simple-hatena-local-current-buffer-day
242              (match-string 6 (buffer-file-name)))
243        (simple-hatena-update-modeline))
244    (error "Current buffer isn't related to Hatena::Diary Writer data file"))
245
246  ;; フォントロック
247  (font-lock-add-keywords 'simple-hatena-mode
248    (list
249     (list  "^\\(\\*[*a-zA-Z0-9_-]*\\)\\(.*\\)$"
250            '(1 simple-hatena-slag-face t)
251            '(2 simple-hatena-subtitle-face t))
252     ;; 必ず[]で囲まれていなければならないもの
253     (list "\\[[*a-zA-Z0-9_-]+\\(:[^\n]+\\)+\\]"
254           '(0 simple-hatena-inline-face t))
255     ;; 必ずしも[]で囲まれていなくてもよいもの
256     (list "\\[?\\(id\\|a\\|b\\|d\\|f\\|g\\|graph\\|i\\|idea\\|map\\|question\\|r\\|isbn\\|asin\\)\\(:[a-zA-Z0-9_+:-]+\\)+\\]?"
257           '(0 simple-hatena-inline-face t))
258     (list  "^\\(:\\)[^:\n]+\\(:\\)"
259            '(1 simple-hatena-markup-face t)
260            '(2 simple-hatena-markup-face t))
261     (list  "^\\([-+]+\\)"
262            '(1 simple-hatena-markup-face t))
263     (list  "\\(((\\).*\\())\\)"
264            '(1 simple-hatena-markup-face t)
265            '(2 simple-hatena-markup-face t))
266     (list  "^\\(>>\\|<<\\|><!--\\|--><\\|>|?[^|]*|\\||?|<\\|=====?\\)"
267            '(1 simple-hatena-markup-face t))
268     (list  "\\(s?https?://\[-_.!~*'()a-zA-Z0-9;/?:@&=+$,%#\]+\\)"
269            '(1 simple-hatena-link-face t))))
270  (font-lock-mode 1)
271
272  (use-local-map simple-hatena-mode-map)
273  (run-hooks 'simple-hatena-mode-hook))
274
275;; はてダラデータにsimple-hatena-modeを適用する
276;;
277;; - ~/.hatena/hatena-id/diary/YYYY-MM-DD.txt
278;; - ~/.hatena/hatena-id/group/group-name/YYYY-MM-DD.txt
279;;
280;; というファイルを開いたら、simple-hatena-modeにする
281(add-to-list 'auto-mode-alist
282             (cons simple-hatena-filename-regex 'simple-hatena-mode))
283
284;;;; * コマンド
285
286(defun simple-hatena-setup ()
287  (interactive)
288  "ディレクトリ配置をセットアップする。"
289  (and
290   ;; simple-hatena-bin
291   (simple-hatena-setup-check-hatena-bin-exists-p)
292
293   ;; hatena id(s)
294   (simple-hatena-setup-id)
295
296   ;; hatena group
297   (if (y-or-n-p
298        "Set up about `Hatena::Group' next? ")
299       (simple-hatena-group-setup)
300     (message "Enjoy!"))))
301
302(defun simple-hatena-setup-check-hatena-bin-exists-p ()
303  (if (file-executable-p simple-hatena-bin)
304      t
305    (progn
306      (if (y-or-n-p
307           (format
308            "`Hatena Diary Writer' not found in %s. Are you sure to continue setup? "
309            simple-hatena-bin))
310          t
311        (progn
312          (when (y-or-n-p
313                 "Open the documentation of simple-hatnea-mode in your browser? ")
314            (browse-url "http://coderepos.org/share/wiki/SimpleHatenaMode"))
315          (message "You must download and install `Hatena Diary Writer' first")
316          nil)))))
317
318(defun simple-hatena-setup-id ()
319  (let
320      ((ids (list)))
321    (when (file-directory-p simple-hatena-root)
322      (dolist (id (simple-hatena-internal-list-directories simple-hatena-root))
323        (add-to-list 'ids id)))
324
325    (when simple-hatena-default-id
326      (add-to-list 'ids simple-hatena-default-id))
327
328    (while
329        (or (not ids) ;;FIXME incomprehensible.
330            (y-or-n-p
331             (format
332              "Existing id(s): `%s'\nSet up other id? "
333              (mapconcat 'identity
334                         ids "', `"))))
335      (add-to-list
336       'ids (simple-hatena-read-string-and-match-check
337             "Please input your Hatena id: "
338             simple-hatena-id-regex
339             "`%s' is invalid as a Hatena id.")))
340
341    (dolist (id ids)
342      (simple-hatena-setup-id-create-directory-and-file id))
343    ids))
344
345(defun simple-hatena-setup-id-create-directory-and-file (id)
346  (simple-hatena-setup-create-directory-and-file
347   (expand-file-name
348    (format "%s/%s/diary/config.txt"
349            simple-hatena-root id))))
350
351(defun simple-hatena-group-setup ()
352  (interactive)
353  "ディレクトリにはてなグループを追加する。"
354  ;; hatena group(s)
355  (simple-hatena-setup-group))
356
357(defun simple-hatena-setup-group ()
358  (let*
359      ((groups (list))
360       (id (condition-case err
361               simple-hatena-local-current-buffer-id
362             (error (simple-hatena-internal-completing-read-id
363                     simple-hatena-root))))
364       (group-dir (expand-file-name (format "%s/%s/group"
365                                            simple-hatena-root id))))
366
367    (unless (file-directory-p group-dir)
368      (make-directory group-dir 'parents))
369
370    (dolist (group (simple-hatena-internal-list-directories group-dir))
371      (add-to-list 'groups group))
372
373    (while
374        (or (not groups)
375            (y-or-n-p
376             (format
377              "Existing group(s): `%s'\nSet up other group? "
378              (mapconcat 'identity
379                         groups "', `"))))
380      (add-to-list
381       'groups (simple-hatena-read-string-and-match-check
382                (format
383                 "Please input a group name for id:%s: " id)
384                simple-hatena-group-regex
385             "`%s' is invalid as a group name.")))
386
387    (dolist (group groups)
388      (if (string-match simple-hatena-group-regex group)
389          (simple-hatena-setup-group-create-directory-and-file id group)
390        (message (format "`%s' is invalid as a group name." group))))))
391
392(defun simple-hatena-setup-group-create-directory-and-file (id group)
393  (simple-hatena-setup-create-directory-and-file
394   (expand-file-name
395    (format "%s/%s/group/%s/config.txt"
396            simple-hatena-root id group))))
397
398(defun simple-hatena-setup-create-directory-and-file (filename)
399  "Set up a directory and file.
400
401NOTE: Create intermediate directories as required."
402  (let
403      ((dirname (file-name-directory filename)))
404    (unless (file-exists-p filename)
405      (unless (file-directory-p dirname)
406        (make-directory dirname 'parents))
407      (append-to-file 1 1 filename))))
408
409(defun simple-hatena-read-string-and-match-check (prompt regex
410                                                         &optional errmsg)
411  "Read a string from the minibuffer, prompting with string prompt,
412and Cheking input value.
413
414If non-nil, third args, you can set error message.
415
416NOTE: Please refer to `format' for the format of the error
417message."
418  (let
419      ((input nil)
420       (errmsg (or errmsg
421                   "Your input is invalid...")))
422    (while
423        (and
424         (setq input (read-string prompt))
425         (not (string-match regex input)))
426      (message (format errmsg input))
427      (sleep-for 1))
428    input))
429
430(defun simple-hatena (id)
431  "実行日現在の日付のファイルを開く。"
432  (interactive
433   (list
434    (if simple-hatena-default-id
435        simple-hatena-default-id
436      (simple-hatena-internal-completing-read-id simple-hatena-root))))
437  (simple-hatena-internal-safe-find-file (concat
438               simple-hatena-root
439               "/"
440               id
441               "/diary/"
442               (simple-hatena-internal-make-diary-file-string 0))))
443
444(defun simple-hatena-group (id group)
445  "実行日現在の日付の、指定されたグループに投稿するためのファイル
446を開く。"
447  (interactive
448   (if simple-hatena-default-id
449       (list
450        simple-hatena-default-id
451        (if simple-hatena-default-group
452            simple-hatena-default-group
453          (simple-hatena-internal-completing-read-group simple-hatena-default-id)))
454     (let ((id (simple-hatena-internal-completing-read-id simple-hatena-root)))
455       (list
456        id
457        (if simple-hatena-default-group
458            simple-hatena-default-group
459          (simple-hatena-internal-completing-read-group id))))))
460  (simple-hatena-internal-safe-find-file (concat
461              simple-hatena-root
462              "/"
463              id
464              "/group/"
465              group
466              "/"
467              (simple-hatena-internal-make-diary-file-string 0))))
468
469(defun simple-hatena-change-default-id ()
470  "現在のデフォルトidを変更する。"
471  (interactive)
472  (setq simple-hatena-default-id
473        (simple-hatena-internal-completing-read-id simple-hatena-root))
474  (message "Changed current default id to %s" simple-hatena-default-id))
475
476(defun simple-hatena-change-default-group ()
477  "現在のデフォルトグループを変更する。"
478  (interactive)
479  (if simple-hatena-default-id
480      (setq simple-hatena-default-group
481            (simple-hatena-internal-completing-read-group simple-hatena-default-id))
482    (list (simple-hatena-change-default-id)
483          (setq simple-hatena-default-group
484                (simple-hatena-internal-completing-read-group simple-hatena-default-id))))
485  (message "Change current default group to %s" simple-hatena-default-group))
486
487(defun simple-hatena-submit ()
488  "はてなダイアリー/グループに投稿する。"
489  (interactive)
490  (simple-hatena-internal-do-submit))
491
492(defun simple-hatena-trivial-submit ()
493  "はてなダイアリー/グループに「ちょっとした更新」で投稿する。"
494  (interactive)
495  (simple-hatena-internal-do-submit "-t"))
496
497(defun simple-hatena-timestamp ()
498  "実行位置に、「*タイムスタンプ*」を挿入する。"
499  (interactive)
500  (insert (format-time-string "*%s*" (current-time))))
501
502(defun simple-hatena-find-diary-for (date)
503  "指定された日付の日記バッファを表示する。"
504  (interactive "sDate(YYYY-MM-DD): ")
505  (if (equal major-mode 'simple-hatena-mode)
506      (if (string-match "^[0-9][0-9][0-9][0-9]-[01][0-9]-[0-3][0-9]$" date)
507          (simple-hatena-internal-safe-find-file
508           (concat (file-name-directory (buffer-file-name))
509                   (concat date ".txt")))
510        (if (string-match "^$" date)
511            (simple-hatena-internal-safe-find-file
512             (concat (file-name-directory (buffer-file-name))
513                     (simple-hatena-internal-make-diary-file-string 0)))
514          (error "Invalid date")))
515    (error "Current major mode isn't simple-hatena-mode")))
516
517(defun simple-hatena-go-forward (&optional i)
518  "前の日付へ移動する。前置引数が渡された場合は、その数だけ後の日付に移動する。"
519  (interactive "p")
520  (if (not i)
521      (simple-hatena-internal-go-for 1)
522    (simple-hatena-internal-go-for i)))
523
524(defun simple-hatena-go-back (&optional i)
525  "次の日付へ移動する。前置引数が渡された場合は、その数だけ前の日付に移動する。"
526  (interactive "p")
527  (if (not i)
528      (simple-hatena-internal-go-for -1)
529    (simple-hatena-internal-go-for (- i))))
530
531(defun simple-hatena-toggle-debug-mode ()
532  "デバッグモードをオン/オフする。"
533  (interactive)
534  (if simple-hatena-option-debug-flag
535      (progn
536        (setq simple-hatena-option-debug-flag nil)
537        (message "Debug mode off"))
538    (progn
539      (setq simple-hatena-option-debug-flag t)
540      (message "Debug mode on"))))
541
542(defun simple-hatena-exit ()
543  "simple-hatena-modeの適用されているバッファを全て削除する。"
544  (interactive)
545  (dolist (buffer (buffer-list))
546    (when (and
547           (buffer-file-name buffer)
548           (string-match simple-hatena-filename-regex (buffer-file-name buffer)))
549      (when (buffer-modified-p buffer)
550        (progn
551          (save-current-buffer
552            (set-buffer buffer)
553            (save-buffer))))
554      (kill-buffer buffer)))
555  (message "simple-hatena-mode has been exited"))
556
557(defun simple-hatena-electric-asterisk (arg)
558  "*(アスタリスク)押下により、タイムスタンプ付き小見出しを挿入する。
559
560ポイントが行頭にある場合のみ、タイムスタンプを挿入し、その他の場合
561は、通常通りアスタリスクを挿入する。"
562  (interactive "*p")
563  (if (and simple-hatena-use-timestamp-permalink-flag
564           (zerop (current-column)))
565      (simple-hatena-timestamp)
566    (self-insert-command arg)))
567
568;;;; * 内部関数
569
570(defun simple-hatena-internal-safe-find-file (filename)
571  "新しいヴァージョンのhtml-helper-modeは、デフォルトでスケルトン
572を作ってウザいので、阻止する。"
573  (let ((html-helper-build-new-buffer nil))
574    (find-file filename)))
575
576(defun simple-hatena-internal-make-diary-file-string (i &optional date)
577  "dateが指定されていない場合は、実行日現在の日付を起点にした日記ファイル名を生成する。
578
579   0: 今日
580   1: 明日
581  -1: 昨日
582
583指定されている場合は、その日付を起点にした日記ファイル名を生成する。"
584  (apply (lambda (s min h d mon y &rest rest)
585           (format-time-string "%Y-%m-%d.txt"
586                               (encode-time s min h (+ d i) mon y)))
587         (if date
588             (append '(0 0 0) date)
589           (apply (lambda (s min h d mon y &rest rest)
590                    (list s min (- h (or simple-hatena-time-offset 0)) d mon y))
591                  (decode-time)))))
592
593(defun simple-hatena-internal-go-for (i)
594  "引数の数だけ前後の日付のファイ名バッファへ移動する。"
595  (simple-hatena-internal-safe-find-file
596   (concat
597    (file-name-directory (buffer-file-name))
598    (simple-hatena-internal-make-diary-file-string
599     i
600       (list (string-to-number simple-hatena-local-current-buffer-day)
601             (string-to-number simple-hatena-local-current-buffer-month)
602             (string-to-number simple-hatena-local-current-buffer-year))))))
603
604(defun simple-hatena-internal-list-directories (dir)
605  "dir下にあるディレクトリをリストにして返す。"
606  (let ((dir-list nil))
607    (dolist (file (directory-files dir t "^[^\.]") dir-list)
608      (if (file-directory-p file)
609          (progn
610            (string-match "\\([^/]+\\)/?$" file)
611            (setq dir-list (cons (match-string 1 file) dir-list)))))))
612
613(defun simple-hatena-internal-completing-read-id (dir)
614  "dir以下からはてなidを抽出し、補完入力させる。"
615  (completing-read
616   "Hatena id: " (simple-hatena-internal-list-directories simple-hatena-root) nil t))
617
618(defun simple-hatena-internal-completing-read-group (id)
619  "dir以下からグループ名を抽出し、補完入力させる。"
620  (completing-read
621   "Group: " (simple-hatena-internal-list-directories
622              (concat simple-hatena-root "/" id "/group")) nil t))
623
624(defun simple-hatena-internal-do-submit (&optional flag)
625  "はてなダイアリ/グループへ日記を投稿する。"
626  (let ((max-mini-window-height 10)  ; hw.plが表示するメッセージを、
627                                     ; echoエリアに表示させるため。
628        (thisdir (file-name-directory (buffer-file-name))))
629    (run-hooks 'simple-hatena-before-submit-hook)
630    (when (buffer-modified-p)
631      (save-buffer))
632    (message "%s" "Now posting...")
633    (let* ((buffer (get-buffer-create simple-hatena-process-buffer-name))
634           (proc (get-buffer-process buffer)))
635      (if (and
636           proc
637           (eq (process-status proc) 'run))
638          (if (yes-or-no-p (format "A %s process is running; kill it?"
639                                   (process-name proc)))
640              (progn
641                (interrupt-process proc)
642                (sit-for 1)
643                (delete-process proc))
644            (error nil)))
645      (with-current-buffer buffer
646        (progn
647          (erase-buffer)
648          (buffer-disable-undo (current-buffer))
649          (setq default-directory thisdir)))
650      (make-comint-in-buffer
651       "simple-hatena-submit" buffer shell-file-name nil
652       shell-command-switch (simple-hatena-internal-build-command flag))
653      (set-process-sentinel
654       (get-buffer-process buffer)
655       '(lambda (process signal)
656          (if (string= signal "finished\n")
657              (let ((max-mini-window-height 10))
658                (display-message-or-buffer (process-buffer process))
659                (run-hooks 'simple-hatena-after-submit-hook))))))))
660
661(defun simple-hatena-internal-build-command (flag)
662  "実行可能なコマンド文字列を作成する。"
663  (let ((flag-list (list flag)))
664    (if simple-hatena-option-debug-flag  (setq flag-list (cons "-d" flag-list)))
665    (if simple-hatena-option-cookie-flag (setq flag-list (cons "-c" flag-list)))
666    (simple-hatena-internal-join
667     " "
668     (cons simple-hatena-bin
669           (append (simple-hatena-internal-build-option-list-from-alist) flag-list)))))
670
671(defun simple-hatena-internal-build-option-list-from-alist ()
672  "引数を取るオプションのリストを作成する。"
673  (let ((opts nil))
674    (dolist (pair
675             `(("-u" . ,simple-hatena-local-current-buffer-id)
676               ("-g" . ,simple-hatena-local-current-buffer-group)
677               ("-a" . ,simple-hatena-option-useragent)
678               ("-T" . ,(format "%s" simple-hatena-option-timeout)))
679             opts)
680      (if (cdr pair)
681           (setq opts (append opts (list (car pair) (cdr pair))))))))
682
683(defun simple-hatena-internal-join (sep list)
684  "車輪の再発明なんだろうけど、見つからなかったのでjoin実装"
685  (if (<= (length list) 1)
686      (car list)
687    (concat (car list) sep (simple-hatena-internal-join sep (cdr list)))))
688
689(defun simple-hatena-update-modeline ()
690  "モードラインの表示を更新する"
691  (let ((id
692         (concat
693          (if simple-hatena-local-current-buffer-group
694              (format "g:%s:" simple-hatena-local-current-buffer-group)
695            "")
696          (format "id:%s" simple-hatena-local-current-buffer-id))))
697    (setq mode-name (format "Simple Hatena [%s]" id))
698    (force-mode-line-update)))
699
700(provide 'simple-hatena-mode)
701
702;;; simple-hatena-mode.el ends here
Note: See TracBrowser for help on using the browser.