hatena-diary-mode.el

   1 ;; hatena-diary-mode.el --- major mode for Hatena::Diary (http://d.hatena.ne.jp)
   2
   3 ;; Created:     Thu Jun 17  2004
   4 ;; Keywords:    blog emacs
   5 ;; author:      hikigaeru <http://d.hatena.ne.jp/hikigaeru/>
   6 ;;              hirosandesu <http://d.hatena.ne.jp/suttanipaata/>
   7 ;;
   8 ;; ¸ø³«¥Ú¡¼¥¸:    http://sourceforge.jp/projects/hatena-diary-el/
   9 ;; Special Thanks to :
  10 ;;              http://d.hatena.ne.jp/hikigaeru/20040617
  11 ;;              http://d.hatena.ne.jp/dev-null
  12 ;;              and all users
  13
  14 ;; This program supports the update of your Hatena-Diary.
  15 ;; This program is Elisp program that operates by Emacs.
  16 ;; Copyright (C) 2010  hirosandesu
  17
  18 ;; This program is free software; you can redistribute it and/or modify
  19 ;; it under the terms of the GNU General Public License as published
  20 ;; by the Free Software Foundation; either version 3 of the License, or (at your option) any later version.
  21
  22 ;; This program is distributed in the hope that it will be useful,
  23 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  24 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
  25
  26 ;; You should have received a copy of the GNU General Public License along with this program.
  27 ;; If not, see <http://www.gnu.org/licenses/>.
  28
  29
  30 (defconst hatena-version "2.0" "Version number of hatena.el")
  31
  32 ;; ¢£¥¤¥ó¥¹¥È¡¼¥ëÊýË¡
  33 ;; 1) Å¬Åö¤Ê¥Ç¥£¥ì¥¯¥È¥ê¤Ë¤³¤Î¥Õ¥¡¥¤¥ë¤ò¤ª¤¯.
  34 ;;    (~/elisp/ Æâ¤Ë¤ª¤¤¤¿¤È¤¹¤ë).
  35 ;;
  36 ;; 2) .emacs ¤Ë¼¡¤Î 4 ¹Ô¤òÄÉ²Ã¤¹¤ë.
  37 ;; (setq load-path (cons (expand-file-name "~/elisp") load-path))
  38 ;; (load "hatena-diary-mode")
  39 ;; (setq hatena-usrid "your username on Hatena::Diary")
  40 ;; (setq hatena-plugin-directory "~/elisp")
  41 ;;    `hatena-use-file' ¤ò non-nil ¤Ë¤¹¤ë¤È¥Ñ¥¹¥ï¡¼¥É¤ò base64 ¤Ç
  42 ;;    °Å¹æ²½¤·¤Æ¥Õ¥¡¥¤¥ë¤ËÊÝÂ¸¤·¤Þ¤¹¤¬¡¢"¿Í´Ö¤¬¸«¤Æ¤¹¤°¤ï¤«¤é¤Ê¤¤"¤°¤é¤¤¤Î
  43 ;;    °ÕÌ£¤·¤«¤Ê¤¤¤Î¤ÇÃí°Õ¤·¤Æ²¼¤µ¤¤¡£
  44 ;;
  45 ;; ¢£»È¤¤Êý
  46 ;;
  47 ;; 1)Æüµ¤ò½ñ¤¯
  48 ;;    `M-x hatena' ¤Çº£Æü¤ÎÆüµ¤¬³«¤¤Þ¤¹. ¤¿¤À¤Î¥Æ¥¥¹¥È¥Õ¥¡¥¤¥ë¤Ç¤¹¡£
  49 ;;    ¥¿¥¤¥È¥ë ¤òÉÕ¤±¤¿¤¤¾ì¹ç¤Ï¡¢°ì¹ÔÌÜ¤Ë "title" ¤È½ñ¤¤¤Æ¡¢¤½¤Î¸å¤Ë¥Æ¥¥¹¥È¤ò
  50 ;;    Â³¤±¤Æ¤¯¤À¤µ¤¤¡£
  51 ;;
  52 ;; 2)¥Ý¥¹¥È¤¹¤ë
  53 ;;    Æüµ¤ò½ñ¤¤¤¿¤é, \C-c\C-p ¤Ç send ¤Ç¤¤Þ¤¹.
  54 ;;    ¥Þ¡¼¥¯¥¢¥Ã¥×¤Ï¡¢¤Ï¤Æ¤Ê¤ÎµË¡¤Ë½¾¤¤¤Þ¤¹¡£
  55 ;;    \C-ct ¤Ç¡Ö¹¹¿·¡×¤È¡Ö¤Á¤ç¤Ã¤È¤·¤¿¹¹¿·¡×¤òÀÚ¤ê¤«¤¨¤Þ¤¹¡£
  56 ;;
  57 ;; 3)ÊÑ¿ô¤ä´Ø¿ô
  58 ;;
  59 ;;    `hatena-change-trivial' "¤Á¤ç¤Ã¤È¤·¤¿¹¹¿·"¤«¤É¤¦¤«¤ò digit ¤ËÊÑ¤¨¤Þ¤¹¡£
  60 ;;    `hatena-entry-type' ¥¨¥ó¥È¥ê¤Î "*" ¤ÎÆ°ºî¤òÀÚ¤ê¤«¤¨¤Þ¤¹¡£
  61 ;;                        0 ¤Ç *pn* ¤Ë¡¢1 ¤Ç *t* (¥¿¥¤¥à¥¹¥¿¥ó¥×)¤Ë¤Ê¤ê¤Þ¤¹¡£
  62 ;;
  63 ;;    `hatena-submit' (\C-c\C-p) Æüµ¤ò¤Ï¤Æ¤Ê¤Ë¥Ý¥¹¥È¤·¤Þ¤¹
  64 ;;    `hatena-delete-diary' ¤½¤ÎÆü¤ÎÆüµ¤ò web ¤«¤éºï½ü.
  65 ;;    `hatena-find-previous' (\C-c\C-b)
  66 ;;    `hatena-find-followings' (\C-c\C-f). ¤½¤ì¤¾¤ì¡¢Á°¤ÎÆü¤È¼¡¤ÎÆü¤Î
  67 ;;    Æüµ¥Õ¥¡¥¤¥ë¤ò³«¤¯¡£°ú¿ô¤òÍ¿¤¨¤ë¤È¤½¤ÎÆü¿ô¤À¤±¥¸¥ã¥ó¥×¡£
  68 ;;    ( Îã \C 1 2 \C-c\C-b ¤Ç12ÆüÁ° )
  69 ;;    `hatena-exit' Æüµ buffer ¤ò save ¤·¤Æ ¤¹¤Ù¤Æ kill
  70 ;;    `hatena-browser-function' ¤Ë 'browse-url ¤È¤«¤ä¤ë¤ÈÆüµ¤ò¥Ý¥¹¥È
  71 ;;    ¤·¤¿¸å¤½¤ÎÆü url ¤ò°ú¿ô¤È¤·¤Æ¥Ö¥é¥¦¥¶¤ò¸Æ¤Ó¤Þ¤¹.
  72 ;;    `hatena-insert-webdiary' ¤Ï¤Æ¤Ê¥Ð¥Ã¥Õ¥¡¤Ç¼Â¹Ô¤¹¤ë¤È¡¢¸½ºß web ¤Ë
  73 ;;    ¥¢¥Ã¥×¤µ¤ì¤Æ¤¤¤ë¥Õ¥¡¥¤¥ë¤ò¼è¤Ã¤Æ¤¯¤ë¡£ o
  74 ;;    `hatena-twitter' Æüµ¹¹¿·»þ¤ËTwitter¤ËÄÌÃÎ¤¹¤ë¤«¤É¤¦¤«¤òÊÑ¤¨¤Þ¤¹¡£
  75 ;;
  76 ;; 4) ¾å°Ì¥â¡¼¥É
  77 ;;    hatena-diary-mode ¤Ï¥Ç¥Õ¥©¥ë¥È¤Ç html-mode ¤ËÈï¤»¤Æ¤¤¤Þ¤¹¡£¤³¤ì¤ò
  78 ;;    html-helper-mode ¤Ë¤·¤¿¤±¤ì¤Ð¡¢
  79 ;;
  80 ;;    -(define-derived-mode hatena-diary-mode html-mode "Hatena"
  81 ;;    +(define-derived-mode hatena-diary-mode html-helper-mode "Hatena"
  82 ;;
  83 ;;    ¤È¤·¤Æ `eval-buffer' ¤·¤Æ²¼¤µ¤¤¡£
  84 ;;
  85 ;; 5) hook ¤Ë¤Ä¤¤¤Æ
  86 ;;    hook ¤È¤Ï¥é¥¤¥Ö¥é¥ê¤òÆÉ¹þ¤ó¤À»þ¡¢½é´ü²½¤¹¤ë»þ¤Ê¤É¡¢ÆÃÄê¤Î¥¿¥¤¥ß
  87 ;;    ¥ó¥°¤Ç¸Æ¤Ó½Ð¤·¤¿¤¤´Ø¿ô¤òÊÝ»ý¤¹¤ëÊÑ¿ô¤Ç¤¹¡£hatena-diary-mode ¤Ë¤Ï°Ê²¼¤Î
  88 ;;    hook ¤¬¤¢¤ê¤Þ¤¹
  89 ;;
  90 ;;    `hatena-diary-mode-hooks' Hatena mode ¤Ë¤·¤¿»þ¤Ë¸Æ¤Ð¤ì¤ë hook .
  91 ;;     Îã .emacs ¤Ë
  92 ;;    (add-hook 'hatena-diary-mode-hooks
  93 ;;        '(lambda ()
  94 ;;           (setq line-spacing 8) ;;¹Ô¤¬µÍ¤Þ¤Ã¤Æ¤ë¤È¥¤¥ä¡¢
  95 ;;           ))
  96 ;;
  97 ;;    `hatena-diary-mode-submit-hook' Æüµ¤ò¥Ý¥¹¥È`hatena-submit' ¤¹¤ëÄ¾Á°¤Ë
  98 ;;     ¸Æ¤Ó½Ð¤¹´Ø¿ô¤Ç¤¹¡£Îã¤¨¤Ð¡¢Ï¢Â³¤·¤Ê¤¤²þ¹Ô¤ò¤¹¤Ù¤Æ½ü¤¯¡¢¤Ê¤É¤Î½èÍý¤¬¹Í¤¨¤é¤ì¤Þ¤¹¡£
  99 ;;
 100 ;;    (add-hook 'hatena-diary-mode-submit-hook
 101 ;;        '(lambda ()
 102 ;;           (goto-char (point-min))
 103 ;;           (replace-regexp "\\([^\n]\\)\n\\([^\n]\\)" "\\1\\2")))
 104 ;;
 105
 106
 107 (require 'hatena-vars)
 108 (require 'hatena-kw)
 109 (require 'font-lock)
 110 (require 'derived)
 111
 112 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 113 ;;ËÜÂÎ
 114
 115 (if hatena-diary-mode-map
 116     ()
 117   (setq hatena-diary-mode-map (make-keymap))
 118   (define-key hatena-diary-mode-map "\C-c\C-p" 'hatena-submit)
 119   (define-key hatena-diary-mode-map "\C-c\C-b" 'hatena-find-previous)
 120   (define-key hatena-diary-mode-map "\C-c\C-f" 'hatena-find-following)
 121   (define-key hatena-diary-mode-map "\C-ct" 'hatena-change-trivial))
 122
 123 (defconst hatena-today-buffer nil)
 124 (defun hatena (&optional date)
 125   "Hatena::Diary ¥Ú¡¼¥¸¤ò³«¤¯. "
 126   (interactive)
 127   (unless (file-exists-p hatena-directory)
 128     (make-directory hatena-directory t))
 129   (if (not date)
 130       (progn
 131         ;;º£Æü¤ÎÆüµ¤Î¥Ð¥Ã¥Õ¥¡¤ò³ÎÇ§(cookie ¤Î´ÉÍý¤Î¤¿¤á)
 132         ;;Â¸ºß¤·¤Ê¤±¤ì¤Ð¡¢¥¯¥Ã¥¡¼¤ò¼èÆÀ¤¹¤ë¡£
 133         (let ((buffer-new-p t)
 134               (file-new-p t))
 135           (if (memq hatena-today-buffer (buffer-list))
 136               (setq buffer-new-p nil)
 137             (hatena-login))
 138           (setq hatena-today-buffer
 139                 (find-file
 140                  (concat hatena-directory (hatena-today-date))))
 141           ;;¥Õ¥¡¥¤¥ë¡¢¥Ð¥Ã¥Õ¥¡¤¬Â¸ºß¤·¤Ê¤±¤ì¤Ð¡¢web¤ÎÆüµ¤ò¥Á¥§¥Ã¥¯
 142           (if (file-exists-p (concat hatena-directory (hatena-today-date)))
 143               (setq file-new-p nil))
 144           (if (and file-new-p buffer-new-p)
 145               (progn
 146                 (message "Æüµ¥Õ¥¡¥¤¥ë¤â¥Ð¥Ã¥Õ¥¡¤â¤¢¤ê¤Þ¤»¤ó¡£Web¤ò¥Á¥§¥Ã¥¯¤·¤Þ¤¹")
 147                 (hatena-insert-webdiary)))
 148           )
 149         )
 150     (if (string-match hatena-fname-regexp date)
 151         (find-file (concat hatena-directory date))
 152       (error "Not date"))
 153
 154     )
 155   ;;keyword-cheating
 156   (if hatena-kw-if
 157       (hatena-kw-init)
 158     nil)
 159   )
 160
 161 (define-derived-mode hatena-diary-mode html-mode "Hatena"
 162 "¤Ï¤Æ¤Ê¥â¡¼¥É. "
 163     (font-lock-add-keywords 'hatena-diary-mode
 164           (list
 165            (list "^\\(Title\\) \\(.*\\)$"
 166                  '(1 hatena-header-face t)
 167                  '(2 hatena-title-face t))
 168            ;; ¸«½Ð¤·
 169            (list  "\\(<[^\n/].*>\\)\\([^<>\n]*\\)\\(</.*>\\)"
 170                   '(1 hatena-html-face t)
 171                   '(2 hatena-link-face t)
 172                   '(3 hatena-html-face t))
 173            ;; ¸«½Ð¤·2
 174            (list  "^\\(\\*[^\n ]*\\) \\(.*\\)$"
 175                   '(1 hatena-markup-face t)
 176                   '(2 hatena-html-face t))
 177            ;;ÆÃ¼ìµË¡
 178            (list "\\(\\[?\\(a:id\\|f:id\\|i:id\\|r:id\\|map:id\\|graph:id\\|g.hatena:id\\|b:id:\\|id\\|google\\|isbn\\|asin\\|http\\|http\\|ftp\\|mailto\\|search\\|amazon\\|rakuten\\|jan\\|ean\\|question\\|tex\\):\\(\\([^\n]*\\]\\)\\|[^ ¡¡\n]*\\)\\)"
 179                  '(1 hatena-markup-face t))
 180            (list  "^:\\([^:\n]+\\):"
 181                   '(0 hatena-markup-face t)
 182                   '(1 hatena-link-face t))
 183            (list  "^\\([-+]+\\)"
 184                   '(1 hatena-markup-face t))
 185            (list  "\\(((\\).*\\())\\)"
 186                   '(1 hatena-markup-face t)
 187                   '(2 hatena-markup-Face T))
 188            (list  "^\\(>>\\|<<\\|><!--\\|--><\\|>|?|\\||?|<\\)"
 189                   '(1 hatena-markup-face t))
 190            (list  "\\(s?https?://\[-_.!~*'()a-zA-Z0-9;/?:@&=+$,%#\]+\\)"
 191                   '(1 hatena-html-face t))))
 192     (font-lock-mode 1)
 193     (set-buffer-modified-p nil)
 194   (run-hooks 'hatena-diary-mode-hook))
 195
 196 ;;hatena-diary-mode ¥È¥°¥ë
 197 (setq auto-mode-alist
 198       (append
 199        (list
 200         (cons (concat hatena-directory hatena-fname-regexp) 'hatena-diary-mode))
 201        auto-mode-alist))
 202
 203
 204 (defun hatena-today-date(&optional offset date)
 205 ;; date ¤ÏÇ¤°Õ¤ÎÆüÉÕ¡¢offset ¤ÏÇ¤°Õ¤Î»þ´Ö¡¢-24 ¤Ç°ìÆü¿Ê¤à
 206   (let ( (lst (if date
 207                   (progn
 208                     (string-match "\\([0-9][0-9][0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)" date)
 209                     (list 0 0 0
 210                           (string-to-int (match-string 3 date))
 211                           (string-to-int (match-string 2 date))
 212                           (string-to-int (match-string 1 date)) 0 nil 32400))
 213                   (decode-time (current-time))) ))
 214     (setcar
 215      (nthcdr 2 lst)
 216      (- (nth 2 lst) (if offset offset hatena-change-day-offset)))
 217     (format-time-string "%Y%m%d"
 218                         (apply 'encode-time lst ))))
 219
 220 (defun hatena-submit (&optional file userid)
 221  "¤Ï¤Æ¤ÊÆüµ http://d.hatena.ne.jp/ ¤Ë post ¥á¥½¥Ã¥É¤ÇÆüµ¤òÁ÷¤ë. curl ¤ò»È¤¦. "
 222   (interactive)
 223
 224   (if file nil
 225     (setq file buffer-file-name)
 226     (save-excursion
 227       ;;"*t*" ¤Ë¤¹¤ë¤« "*pn*" ¤Ë¤¹¤ë¤«
 228       (cond ( (= hatena-entry-type 0)
 229               (progn
 230                 (let ((i 0)
 231                       (j 0))
 232                   (goto-char (point-min))
 233                   (while (re-search-forward "^\\*p\\([0-9]\\)\\*" nil t)
 234                     (if (< i (setq j (string-to-int (match-string 1))))
 235                         (setq i j)))
 236                   (goto-char (point-min))
 237                   (while (re-search-forward "^\\(\\*\\)\\([[ ]\\)" nil t)
 238                     (replace-match
 239                      (concat "*p" (format "%d" (setq i (1+ i))) "*\\2")
 240                      )))))
 241             ( (= hatena-entry-type 1)
 242               (progn
 243                 (goto-char (point-min))
 244                 (while (re-search-forward "^\\(\\*\\)\\([[ ]\\)" nil t)
 245                   (replace-match
 246                    (concat "*t*\\2")
 247                    ))))
 248     (t nil)
 249     )
 250       ;;¥¿¥¤¥È¥ë¤Î*t*¤ò»þ´Ö¤ËÃÖ¤¤«¤¨¤ë
 251       (goto-char (point-min))
 252       (let ((i 0))
 253         (while (re-search-forward "^\\*t\\*" nil t)
 254           (replace-match
 255            (concat "*" (hatena-current-second i) "*")
 256            (setq i (1+ i))
 257            ))))
 258     (save-buffer))
 259
 260   (if (not userid)
 261       (setq userid hatena-usrid))
 262
 263   (let ((filename (file-name-nondirectory file)))
 264     (if (string-match hatena-fname-regexp filename)
 265         (let*
 266             ((year (match-string 1 filename))
 267              (month (match-string 2 filename))
 268              (day (match-string 3 filename))
 269              (date (concat year month day))
 270              ;;¤Ï¤Æ¤Ê¤ËÄÌÃÎ¤¹¤ë¥¿¥¤¥à¥¹¥¿¥ó¥×
 271              (timestamp
 272               (format-time-string "%Y%m%d%H%m%S" (current-time)))
 273
 274              (baseurl (concat "http://d.hatena.ne.jp/" userid "/"))
 275              (referer (concat baseurl "edit?date=" date))
 276              (nexturl (concat baseurl (concat year month day)))
 277              (url (concat baseurl "edit"))
 278
 279              (title "")
 280              (send-file file)
 281              (full-body
 282               (with-temp-buffer
 283                 (insert-file-contents send-file)
 284                 ;; ¥Ð¥Ã¥Õ¥¡¤òÁ÷¤ëÁ°¤Ë¸Æ¤Ð¤ì¤ë hooks
 285                 (run-hooks 'hatena-diary-mode-submit-hook)
 286                 (cond ( (string-match "\\`title[ ¡¡]*\\(.*\\)?\n" (buffer-string))
 287                         (progn
 288                           (setq title (match-string 1 (buffer-string)))
 289                           (substring (buffer-string)
 290                                      (length (match-string 0 (buffer-string))))
 291                           ))
 292                       ;;¸Å¤¤¼ÂÁõ
 293                       ( (string-match hatena-header-regexp (buffer-string))
 294                         (progn
 295                           (setq title (match-string 1 (buffer-string)))
 296                           (substring (buffer-string)
 297                                      (1+ (length (match-string 0 (buffer-string)))))) )
 298                       (t (buffer-string)))))
 299              (body (hatena-url-encode-string full-body hatena-default-coding-system))
 300              (trivial (if hatena-trivial "1" "0"))
 301              (twit (hatena-url-encode-string hatena-twitter-prefix hatena-default-coding-system))
 302              (post-data
 303               (concat "dummy=1"
 304                       "&mode=enter"
 305                       "&body=" body
 306                       "&trivial=" trivial
 307                       "&title=" title
 308                       "&day=" day
 309                       "&month=" month
 310                       "&year=" year
 311               "&twitter_notification_enabled=" (if hatena-twitter-flag "1" "")
 312               "&twitter_notification_prefix=" twit
 313                       ;; session ID for POST to hatena
 314                       ;; this is a scheme of ensuring security in Hatena::Diary
 315                       (concat "&rkm="
 316                               (let* ((md5sum (md5 (with-temp-buffer
 317                                                     (insert-file-contents hatena-cookie)
 318                                                     (re-search-forward "rk\\s \\([0-9a-zA-Z]+\\)")
 319                                                     (concat (buffer-substring
 320                                                              (match-beginning 1)
 321                                                              (match-end 1)))) nil nil 'utf-8))
 322                                      (p 0)
 323                                      (temp ""))
 324                                 (while (> (length md5sum) p)
 325                                   (setq temp
 326                                         (concat
 327                                          temp
 328                                          (char-to-string (string-to-number
 329                                                           (substring md5sum p (+ p 2)) 16))))
 330                                   (setq p (+ p 2)))
 331                                 (substring (base64-encode-string temp) 0 22)))
 332                       ;; if "date" element exists ,
 333                       ;; command can't create the new page at hatena
 334                       (if (hatena-check-newpage referer)
 335                           (concat "&date=" date))
 336                       "&timestamp=" timestamp )))
 337
 338           (with-temp-file hatena-tmpfile
 339             (insert post-data))
 340
 341           (message "%s => %s" filename referer)
 342           (call-process hatena-curl-command nil nil nil
 343                         "-b" hatena-cookie
 344                         "-x" hatena-proxy
 345                         "--data" (concat "@" hatena-tmpfile)
 346                         url)
 347
 348           (message "posted")
 349           (and (functionp hatena-browser-function)
 350                (funcall hatena-browser-function nexturl))
 351           )
 352       (error "Not Hatena file: %s" file)))
 353   (setq hatena-twitter-prefix nil))
 354
 355 (defun hatena-login ()
 356   (interactive)
 357   (if (file-exists-p hatena-cookie)
 358       (delete-file hatena-cookie))
 359   (message (concat "logging in to \"" hatena-url "\" as \"" hatena-usrid "\""))
 360   (let ((password (hatena-ask-password)))
 361
 362     (call-process hatena-curl-command nil nil nil
 363                   "-k"  "-c" hatena-cookie
 364                   "-x" hatena-proxy
 365                   "-d" (concat "name=" hatena-usrid)
 366                   "-d" (concat "password=" password)
 367                   "-d" (concat "autologin=1")
 368                   "-d" (concat "mode=enter")
 369                   "https://www.hatena.ne.jp/login"))
 370     (message "Say HAPPY! to Hatena::Diary"))
 371
 372
 373 (defun hatena-check-newpage (urldate)
 374   "¥Ú¡¼¥¸¤¬ºîÀ®ºÑ¤ß¤«¤É¤¦¤«¥Á¥§¥Ã¥¯"
 375   (message "checking diary ....")
 376   (call-process hatena-curl-command nil nil nil
 377                   "-o" hatena-tmpfile2
 378                   "-b" hatena-cookie
 379                   urldate)
 380   (if (save-excursion
 381         (find-file hatena-tmpfile2)
 382         (prog1
 383             (string-match "name=\"date\""
 384                           (buffer-string))
 385           (kill-this-buffer)))
 386       (progn
 387         (message "modify diary")
 388         t)
 389     (message "make new diary") nil))
 390
 391 (defun hatena-diary-file-p(file)
 392   (let ((fname (file-name-nondirectory file)))
 393     (if (string-match hatena-fname-regexp fname) t nil)))
 394
 395 (defun hatena-get-diary-string(&optional date)
 396   "¤Ï¤Æ¤Ê¤Ë¤¢¤ëÆüµ¥Õ¥¡¥¤¥ë¤ò¼è¤ê¡¢¤½¤ÎÊ¸»úÎó¤òÊÖ¤¹¡£
 397 ¥í¥°¥¤¥ó¤·¤Æ¤¤¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£"
 398   (if (not date) (error "not date"))
 399   (message "checking diary of %s ...." date)
 400   (let ((urldate (concat "http://d.hatena.ne.jp/"
 401                          hatena-usrid
 402                          "/edit?date="
 403                          date)))
 404     (call-process hatena-curl-command nil nil nil
 405                   "-o" hatena-tmpfile
 406                   "-b" hatena-cookie
 407                   urldate))
 408   (with-temp-buffer
 409     "*hatena-get*"
 410     (insert-file-contents hatena-tmpfile)
 411     ;;¤³¤³¤Ê¤ó¤È¤«...
 412     (goto-char (point-min))(while (replace-string "&quot;" "\""))
 413     (goto-char (point-min))(while (replace-string "&amp;" "&"))
 414     (goto-char (point-min))(while (replace-string "&gt;" ">"))
 415     (goto-char (point-min))(while (replace-string "&lt;" "<"))
 416     (goto-char (point-min))(while (replace-string "&#39;" "'"))
 417
 418     (if (string-match "<textarea[^>\n]*>\\(\\(\n\\|.\\)*?\\)</textarea>"
 419                       (buffer-string))
 420           (match-string 1 (buffer-string)) nil)))
 421
 422 (defun hatena-insert-webdiary(&optional date)
 423   "web ¤ÎÆüµ¤òÁÞÆþ¤¹¤ë¡£"
 424   (interactive)
 425   (if date nil
 426       (setq date (file-name-nondirectory buffer-file-name)))
 427   (if (string-match hatena-fname-regexp date)
 428       (insert (hatena-get-diary-string date))
 429     (error "not date or hatena file")))
 430
 431 (defun hatena-delete-diary(&optional file userid)
 432   "Æüµ¤òºï½ü¤¹¤ë¡£¥í¡¼¥«¥ë¤Ïºï½ü¤·¤Ê¤¤¡£"
 433   (interactive)
 434   ;;¥Ð¥Ã¥Õ¥¡¤«¤éÆÉ¤à¤ÈÁ÷¿®»þ´Ö¤Î¤È¤³¤í¤Ë"deleted"
 435     (if file nil
 436       (setq file buffer-file-name))
 437     (if (not userid)
 438         (setq userid hatena-usrid))
 439     (let ((filename (file-name-nondirectory file)))
 440       (if (string-match hatena-fname-regexp filename)
 441           (let*
 442               ((year (match-string 1 filename))
 443                (month (match-string 2 filename))
 444                (day (match-string 3 filename))
 445                (date (concat year month day))
 446                (baseurl (concat "http://d.hatena.ne.jp/" userid "/"))
 447                (referer (concat baseurl "edit?date=" date))
 448                (url (concat baseurl "edit"))
 449
 450                (edit (hatena-url-encode-string "¤³¤ÎÆü¤òºï½ü"))
 451                (post-data
 452                 (concat "edit=" edit
 453                         "&date=" date
 454                         (concat "&rkm="
 455                               (let*
 456                                   ((md5sum (md5
 457                                             (with-temp-buffer
 458                                               (insert-file-contents hatena-cookie)
 459                                               (re-search-forward "rk\\s \\([0-9a-zA-Z]+\\)")
 460                                               (concat (buffer-substring
 461                                                        (match-beginning 1)
 462                                                        (match-end 1)))) nil nil 'utf-8))
 463                                    (p 0)
 464                                    (temp ""))
 465                                 (while (> (length md5sum) p)
 466                                   (setq temp
 467                                         (concat
 468                                          temp
 469                                          (char-to-string (string-to-number
 470                                                           (substring md5sum p (+ p 2)) 16))))
 471                                   (setq p (+ p 2)))
 472                                 (substring (base64-encode-string temp) 0 22)))
 473                         "&mode=delete")))
 474             (message "deleting %s" referer)
 475             (with-temp-file hatena-tmpfile (insert post-data))
 476
 477             (call-process hatena-curl-command nil nil nil
 478                           "-b" hatena-cookie
 479                           "-x" hatena-proxy
 480                           "--data" (concat "@" hatena-tmpfile)
 481                           url)
 482
 483             (message "deleted"))
 484         (error "Not Hatena file: %s" file))))
 485
 486 (defun hatena-logout()
 487   (interactive)
 488   (call-process hatena-curl-command nil nil nil
 489                 "-b" hatena-cookie
 490                 "-x" hatena-proxy
 491                 "http://d.hatena.ne.jp/logout")
 492   (message "logged out from d.hatena.ne.jp"))
 493
 494 (defun hatena-ask-password()
 495   (let (pass str)
 496     (if (null hatena-use-file)
 497         (setq pass (read-passwd "password ? : "))
 498       ;;¥Õ¥¡¥¤¥ë¤¬Ìµ¤«¤Ã¤¿¾ì¹ç¤Ïºî¤ë¡£
 499       (if (not (file-exists-p hatena-password-file))
 500           (append-to-file (point) (point) hatena-password-file))
 501       (setq str (with-temp-buffer nil
 502                   (insert-file-contents hatena-password-file)
 503                   (buffer-string)))
 504       (if (string-match "[^ ]+" str)
 505           (setq pass (base64-decode-string (match-string 0 str)))
 506         (setq pass (read-passwd "password ? : "))
 507         (with-temp-file hatena-password-file
 508           (insert (base64-encode-string
 509                    (format "%s" pass)))))
 510     pass)))
 511
 512 (defun hatena-exit()
 513   "hatena-fname-regexp¤Ë¥Þ¥Ã¥Á¤¹¤ë¥Ð¥Ã¥Õ¥¡¤ò¤¹¤Ù¤ÆÊÝÂ¸¤·¤Æ¾Ãµî"
 514   (interactive)
 515   (if (yes-or-no-p "save all diaries and kill buffer ?")
 516       (progn
 517         (let ((buflist (buffer-list))
 518               (i 0))
 519           (while (< i (length buflist))
 520             (let ((bufname (buffer-name (nth i (buffer-list)))))
 521               (if (string-match hatena-fname-regexp bufname)
 522                   (progn
 523                     (if (buffer-modified-p (nth i (buffer-list)))
 524                         (save-buffer (nth i (buffer-list))))
 525                     (kill-buffer (nth i (buffer-list)))))
 526               (setq i (1+ i))))))))
 527
 528 (defun hatena-find-previous (&optional count file)
 529   "count ÆüÁ°¤ÎÆüµ¤ò³«¤¯ count ¤¬ nil ¤Ê¤é°ìÆü¤À¤±Ìá¤ë"
 530   (interactive "p")
 531   (hatena-find-pf (if count (- count) -1) (buffer-name)))
 532
 533 (defun hatena-find-following (&optional count file)
 534   "count Æü¸å¤ÎÆüµ¤ò³«¤¯ count ¤¬ nil ¤Ê¤é°ìÆü¤À¤±¤¹¤¹¤à"
 535   (interactive "p")
 536   (hatena-find-pf (if count count 1) (buffer-name)))
 537
 538 (defun hatena-find-pf(count &optional file)
 539   (if (equal major-mode 'hatena-diary-mode)
 540       (if (not file)
 541           (setq file (buffer-name)))
 542     (error "not hatena mode"))
 543   (let ((find-previous
 544          (lambda (element count lst)
 545            (let* ((sublst (member element lst))
 546                   (result (+ (- (length lst) (length sublst))
 547                              count)))
 548              (if (or (null sublst)
 549                      (< result 0)) nil
 550                (nth result lst)))))
 551         previous)
 552     (setq previous
 553           (funcall find-previous
 554                    (file-name-nondirectory file)
 555                    (if (not count) 1 count)
 556                    (directory-files
 557                     hatena-directory
 558                     nil hatena-fname-regexp)))
 559     (if previous (find-file (concat (file-name-directory file) previous))
 560       ;;¸«¤Ä¤«¤é¤Ê¤¤»þ¤Ï¡¢Ì¤Íè¤ÎÆüÉÕ¤ò¿Ò¤Í¤ë¡£
 561       (let ((filename (read-string "ºîÀ®¤·¤¿¤¤ÆüÉÕ¤òÆþÎÏ: "
 562                                    (hatena-today-date (* -24 count) (buffer-name)) nil)))
 563         (if (string-match hatena-fname-regexp filename)
 564             (progn
 565               (find-file filename)
 566               (save-buffer))
 567           (error "ÆüÉÕ¥Õ¥¡¥¤¥ë¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó!!"))))))
 568
 569 (defun hatena-get-webdiary ()
 570   "http://d.hatena.ne.jp/usrid/export ¤ò¼è¤Ã¤Æ¤¤ÆÊÑ´¹¡£Â¤ê¤Ê¤¤ÆüµÊ¬¤ò¥Õ¥¡¥¤¥ë¤ËÂ¤¹¡£"
 571   (interactive)
 572   ;;export¤ò¤È¤Ã¤Æ¤¯¤ë
 573   (call-process hatena-curl-command nil nil nil
 574                 "-o" hatena-tmpfile
 575                 "-b" hatena-cookie
 576                 (concat "http://d.hatena.ne.jp/" hatena-usrid "/export" ))
 577
 578   ;;export ¤Ï utf-8 ¤Ê¤Î¤Ç¡¢hatena-default-coding-system  ¤ËÄ¾¤¹¡£
 579   (let ((filelst (directory-files
 580                   hatena-directory
 581                   nil hatena-fname-regexp))
 582         (title-regexp "<day date=\"\\([0-9][0-9][0-9][0-9]\\)-\\([0-9][0-9]\\)-\\([0-9][0-9]\\)\" title=\"\\(.*\\)\">\n<body>\n")
 583         pt-start pt-end day title body)
 584     (with-temp-buffer
 585       "*hatena-get*"
 586       (insert-file-contents hatena-tmpfile)
 587       (set-buffer-file-coding-system hatena-default-coding-system)
 588       (hatena-translate-reverse-region (point-min) (point-max))
 589
 590       (while (re-search-forward title-regexp nil t)
 591         (setq day (concat (match-string 1) (match-string 2) (match-string 3)))
 592         (setq title (match-string 4))
 593         (setq pt-start (match-end 0))
 594         (re-search-forward "</body>\n</day>" nil t)
 595         (setq pt-end (match-beginning 0))
 596         (setq body (buffer-substring pt-start pt-end))
 597         (save-excursion
 598           (if (null (member day filelst))
 599               (progn
 600                 (hatena day)
 601                 (set-buffer-file-coding-system hatena-default-coding-system)
 602                 (message "creatig %s" day)
 603                 (insert body)
 604                 (save-buffer)
 605                 (kill-buffer (current-buffer))))))
 606       (message "finished"))))
 607
 608
 609
 610 (defun hatena-url-encode-string (str &optional coding)
 611   "w3m-url-encode-string ¤«¤é¥³¥Ô¡¼"
 612   (apply (function concat)
 613          (mapcar
 614           (lambda (ch)
 615             (cond
 616              ((eq ch ?\n)               ; newline
 617               "%0D%0A")
 618              ((string-match "[-a-zA-Z0-9_:/.]" (char-to-string ch)) ; xxx?
 619               (char-to-string ch))      ; printable
 620              ((char-equal ch ?\x20)     ; space
 621               "+")
 622              (t
 623               (format "%%%02x" ch))))   ; escape
 624           ;; Coerce a string to a list of chars.
 625           (append (encode-coding-string (or str "")
 626                                         (or coding
 627                                             buffer-file-coding-system
 628                                             'iso-2022-7bit))
 629                   nil))))
 630
 631 (defun hatena-twitter-prefix-input (ts)
 632   "Æüµ¹¹¿·»þ¤ÎÆâÍÆÆþÎÏ"
 633   (interactive "sTwitter prefix:")
 634   (setq hatena-twitter-prefix ts))
 635
 636 ;----------------ÆÃ¼ìÊ¸»ú¤ÎÊÑ´¹----------------
 637 ;;yahtml ¤ò²þÊÑ
 638 (defvar hatena-entity-reference-chars-alist
 639   '((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot"))
 640   "translation table from character to entity reference")
 641 (defvar hatena-entity-reference-chars-regexp "[><&\\]")
 642 (defvar hatena-entity-reference-chars-reverse-regexp "&\\(gt\\|lt\\|amp\\|quot\\);")
 643
 644 (defun hatena-translate-region (beg end)
 645   "Translate inhibited literals."
 646   (interactive "r")
 647   (save-excursion
 648     (save-restriction
 649       (narrow-to-region beg end)
 650       (let ((ct hatena-entity-reference-chars-alist))
 651         (goto-char beg)
 652         (while (re-search-forward hatena-entity-reference-chars-regexp nil t)
 653           (replace-match
 654            (concat "&" (cdr (assoc (preceding-char) ct)) ";")))))))
 655
 656 (defun hatena-translate-reverse-region (beg end)
 657   "Translate entity references to literals."
 658   (interactive "r")
 659   (save-excursion
 660     (save-restriction
 661       (narrow-to-region beg end)
 662       (let ((ct hatena-entity-reference-chars-alist))
 663         (goto-char beg)
 664         (while (re-search-forward
 665                 hatena-entity-reference-chars-reverse-regexp nil t)
 666           ;(setq c (preceding-char))
 667           (replace-match
 668            (string (car
 669                  (rassoc (match-string 1)
 670                          ct)))))))))
 671
 672 (defun hatena-change-trivial ()
 673   (interactive)
 674   (if (not hatena-trivial)
 675       (progn
 676         (message "¤Á¤ç¤Ã¤È¤·¤¿¹¹¿·¥â¡¼¥É")
 677         (setq hatena-trivial t))
 678     (setq hatena-trivial nil)
 679     (message "¹¹¿·¥â¡¼¥É")))
 680
 681 (defun hatena-twitter ()
 682   (interactive)
 683   (if (not hatena-twitter-flag)
 684       (progn
 685         (message "twitter¤ËÄÌÃÎ")
 686         (setq hatena-twitter-flag t))
 687     (setq hatena-twitter-flag nil)
 688     (message "twitter¤Ë¤ÏÄÌÃÎ¤·¤Ê¤¤")))
 689
 690 (defun hatena-current-second(number)
 691   "¸½ºß¤Þ¤Ç¤ÎÉÃ¿ô¤òÊÖ¤¹¡£emacs ¤Ç¤ÏÀ°¿ô¤¬¥±¥¿°î¤ì¤¹¤ë¤Î¤Ç¡¢ÉâÆ°¾®¿ôÅÀ¤Ç"
 692   (let* ((ct (current-time))
 693          (high (float (car ct)))
 694          (low (float (car (cdr ct))))
 695          str)
 696     (setq str (format "%f"(+
 697                            (+ (* high (lsh 2 15)) low)
 698                            number)))
 699     (substring str 0 10) ;;
 700     ))
 701
 702 (provide 'hatena-diary-mode)
 703
 704 ;;;;;end of file