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.1.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 ;;¡¡¡¡`hatena-image-insert' ¤Ï¤Æ¤Ê¥Õ¥©¥È¥é¥¤¥Õ¤Ë²èÁü¤ò¥¢¥Ã¥×¥í¡¼¥É¤·
  76 ;;     ¥¨¥ó¥È¥ê¤Ë²èÁüÉ½¼¨ÍÑ¤Î¥¿¥°¤òÁÞÆþ¤·¤Þ¤¹¡£
  77 ;;    `hatena-get-webdiary' http://d.hatena.ne.jp/usrid/export ¤ò
  78 ;;    ¼è¤Ã¤Æ¤¤ÆÊÑ´¹¡£Â¤ê¤Ê¤¤ÆüµÊ¬¤ò¥Õ¥¡¥¤¥ë¤ËÂ¤¹¡£
  79 ;;
  80 ;; 4) ¾å°Ì¥â¡¼¥É
  81 ;;    hatena-diary-mode ¤Ï¥Ç¥Õ¥©¥ë¥È¤Ç html-mode ¤ËÈï¤»¤Æ¤¤¤Þ¤¹¡£¤³¤ì¤ò
  82 ;;    html-helper-mode ¤Ë¤·¤¿¤±¤ì¤Ð¡¢
  83 ;;
  84 ;;    -(define-derived-mode hatena-diary-mode html-mode "Hatena"
  85 ;;    +(define-derived-mode hatena-diary-mode html-helper-mode "Hatena"
  86 ;;
  87 ;;    ¤È¤·¤Æ `eval-buffer' ¤·¤Æ²¼¤µ¤¤¡£
  88 ;;
  89 ;; 5) hook ¤Ë¤Ä¤¤¤Æ
  90 ;;    hook ¤È¤Ï¥é¥¤¥Ö¥é¥ê¤òÆÉ¹þ¤ó¤À»þ¡¢½é´ü²½¤¹¤ë»þ¤Ê¤É¡¢ÆÃÄê¤Î¥¿¥¤¥ß
  91 ;;    ¥ó¥°¤Ç¸Æ¤Ó½Ð¤·¤¿¤¤´Ø¿ô¤òÊÝ»ý¤¹¤ëÊÑ¿ô¤Ç¤¹¡£hatena-diary-mode ¤Ë¤Ï°Ê²¼¤Î
  92 ;;    hook ¤¬¤¢¤ê¤Þ¤¹
  93 ;;
  94 ;;    `hatena-diary-mode-hooks' Hatena mode ¤Ë¤·¤¿»þ¤Ë¸Æ¤Ð¤ì¤ë hook .
  95 ;;     Îã .emacs ¤Ë
  96 ;;    (add-hook 'hatena-diary-mode-hooks
  97 ;;        '(lambda ()
  98 ;;           (setq line-spacing 8) ;;¹Ô¤¬µÍ¤Þ¤Ã¤Æ¤ë¤È¥¤¥ä¡¢
  99 ;;           ))
 100 ;;
 101 ;;    `hatena-diary-mode-submit-hook' Æüµ¤ò¥Ý¥¹¥È`hatena-submit' ¤¹¤ëÄ¾Á°¤Ë
 102 ;;     ¸Æ¤Ó½Ð¤¹´Ø¿ô¤Ç¤¹¡£Îã¤¨¤Ð¡¢Ï¢Â³¤·¤Ê¤¤²þ¹Ô¤ò¤¹¤Ù¤Æ½ü¤¯¡¢¤Ê¤É¤Î½èÍý¤¬¹Í¤¨¤é¤ì¤Þ¤¹¡£
 103 ;;
 104 ;;    (add-hook 'hatena-diary-mode-submit-hook
 105 ;;        '(lambda ()
 106 ;;           (goto-char (point-min))
 107 ;;           (replace-regexp "\\([^\n]\\)\n\\([^\n]\\)" "\\1\\2")))
 108 ;;
 109
 110
 111 (require 'hatena-vars)
 112 (require 'hatena-kw)
 113 (require 'font-lock)
 114 (require 'derived)
 115
 116 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 117 ;;ËÜÂÎ
 118
 119 (if hatena-diary-mode-map
 120     ()
 121   (setq hatena-diary-mode-map (make-keymap))
 122   (define-key hatena-diary-mode-map "\C-c\C-p" 'hatena-submit)
 123   (define-key hatena-diary-mode-map "\C-c\C-b" 'hatena-find-previous)
 124   (define-key hatena-diary-mode-map "\C-c\C-f" 'hatena-find-following)
 125   (define-key hatena-diary-mode-map "\C-ct" 'hatena-change-trivial)
 126   (define-key hatena-diary-mode-map "\C-c\C-i" 'hatena-image-insert)
 127   (define-key help-map "4" 'hatena-help-syntax1)
 128   (define-key help-map "5" 'hatena-help-syntax2)
 129   (define-key help-map "6" 'hatena-help-syntax3)
 130   (define-key help-map "7" 'hatena-help-syntax4)
 131   (define-key help-map "8" 'hatena-help-syntax5))
 132
 133 (defconst hatena-today-buffer nil)
 134 (defun hatena (&optional date)
 135   "Hatena::Diary ¥Ú¡¼¥¸¤ò³«¤¯. "
 136   (interactive)
 137   (unless (file-exists-p hatena-directory)
 138     (make-directory hatena-directory t))
 139   (if (not date)
 140       (progn
 141         ;;º£Æü¤ÎÆüµ¤Î¥Ð¥Ã¥Õ¥¡¤ò³ÎÇ§(cookie ¤Î´ÉÍý¤Î¤¿¤á)
 142         ;;Â¸ºß¤·¤Ê¤±¤ì¤Ð¡¢¥¯¥Ã¥¡¼¤ò¼èÆÀ¤¹¤ë¡£
 143         (let ((buffer-new-p t)
 144               (file-new-p t))
 145           (if (memq hatena-today-buffer (buffer-list))
 146               (setq buffer-new-p nil)
 147             (hatena-login))
 148           (setq hatena-today-buffer
 149                 (find-file
 150                  (concat hatena-directory (hatena-today-date))))
 151           ;;¥Õ¥¡¥¤¥ë¡¢¥Ð¥Ã¥Õ¥¡¤¬Â¸ºß¤·¤Ê¤±¤ì¤Ð¡¢web¤ÎÆüµ¤ò¥Á¥§¥Ã¥¯
 152           (if (file-exists-p (concat hatena-directory (hatena-today-date)))
 153               (setq file-new-p nil))
 154           (if (and file-new-p buffer-new-p)
 155               (progn
 156                 (message "Æüµ¥Õ¥¡¥¤¥ë¤â¥Ð¥Ã¥Õ¥¡¤â¤¢¤ê¤Þ¤»¤ó¡£Web¤ò¥Á¥§¥Ã¥¯¤·¤Þ¤¹")
 157                 (hatena-insert-webdiary)))
 158           )
 159         )
 160     (if (string-match hatena-fname-regexp date)
 161         (find-file (concat hatena-directory date))
 162       (error "Not date"))
 163
 164     )
 165   ;;keyword-cheating
 166   (if hatena-kw-if
 167       (hatena-kw-init)
 168     nil)
 169   )
 170
 171 (define-derived-mode hatena-diary-mode html-mode "Hatena"
 172 "¤Ï¤Æ¤Ê¥â¡¼¥É. "
 173     (font-lock-add-keywords 'hatena-diary-mode
 174           (list
 175            (list "^\\(Title\\) \\(.*\\)$"
 176                  '(1 hatena-header-face t)
 177                  '(2 hatena-title-face t))
 178            ;; ¸«½Ð¤·
 179            (list  "\\(<[^\n/].*>\\)\\([^<>\n]*\\)\\(</.*>\\)"
 180                   '(1 hatena-html-face t)
 181                   '(2 hatena-link-face t)
 182                   '(3 hatena-html-face t))
 183            ;; ¸«½Ð¤·2
 184            (list  "^\\(\\*[^\n ]*\\) \\(.*\\)$"
 185                   '(1 hatena-markup-face t)
 186                   '(2 hatena-html-face t))
 187            ;;ÆÃ¼ìµË¡
 188            (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]*\\)\\)"
 189                  '(1 hatena-markup-face t))
 190            (list  "^:\\([^:\n]+\\):"
 191                   '(0 hatena-markup-face t)
 192                   '(1 hatena-link-face t))
 193            (list  "^\\([-+]+\\)"
 194                   '(1 hatena-markup-face t))
 195            (list  "\\(((\\).*\\())\\)"
 196                   '(1 hatena-markup-face t)
 197                   '(2 hatena-markup-Face T))
 198            (list  "^\\(>>\\|<<\\|><!--\\|--><\\|>\\(|.+\\)?|?|\\||?|<\\)"
 199                   '(1 hatena-markup-face t))
 200            (list  "\\(s?https?://\[-_.!~*'()a-zA-Z0-9;/?:@&=+$,%#\]+\\)"
 201                   '(1 hatena-html-face t))))
 202     (font-lock-mode 1)
 203     (set-buffer-modified-p nil)
 204   (run-hooks 'hatena-diary-mode-hook))
 205
 206 ;;hatena-diary-mode ¥È¥°¥ë
 207 (setq auto-mode-alist
 208       (append
 209        (list
 210         (cons (concat hatena-directory hatena-fname-regexp) 'hatena-diary-mode))
 211        auto-mode-alist))
 212
 213
 214 (defun hatena-today-date(&optional offset date)
 215 ;; date ¤ÏÇ¤°Õ¤ÎÆüÉÕ¡¢offset ¤ÏÇ¤°Õ¤Î»þ´Ö¡¢-24 ¤Ç°ìÆü¿Ê¤à
 216   (let ( (lst (if date
 217                   (progn
 218                     (string-match "\\([0-9][0-9][0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)" date)
 219                     (list 0 0 0
 220                           (string-to-int (match-string 3 date))
 221                           (string-to-int (match-string 2 date))
 222                           (string-to-int (match-string 1 date)) 0 nil 32400))
 223                   (decode-time (current-time))) ))
 224     (setcar
 225      (nthcdr 2 lst)
 226      (- (nth 2 lst) (if offset offset hatena-change-day-offset)))
 227     (format-time-string "%Y%m%d"
 228                         (apply 'encode-time lst ))))
 229
 230 (defun hatena-submit (&optional file userid)
 231  "¤Ï¤Æ¤ÊÆüµ http://d.hatena.ne.jp/ ¤Ë post ¥á¥½¥Ã¥É¤ÇÆüµ¤òÁ÷¤ë. curl ¤ò»È¤¦. "
 232   (interactive)
 233
 234   (if file nil
 235     (setq file buffer-file-name)
 236     (save-excursion
 237       ;;"*t*" ¤Ë¤¹¤ë¤« "*pn*" ¤Ë¤¹¤ë¤«
 238       (cond ( (= hatena-entry-type 0)
 239               (progn
 240                 (let ((i 0)
 241                       (j 0))
 242                   (goto-char (point-min))
 243                   (while (re-search-forward "^\\*p\\([0-9]\\)\\*" nil t)
 244                     (if (< i (setq j (string-to-int (match-string 1))))
 245                         (setq i j)))
 246                   (goto-char (point-min))
 247                   (while (re-search-forward "^\\(\\*\\)\\([[ ]\\)" nil t)
 248                     (replace-match
 249                      (concat "*p" (format "%d" (setq i (1+ i))) "*\\2")
 250                      )))))
 251             ( (= hatena-entry-type 1)
 252               (progn
 253                 (goto-char (point-min))
 254                 (while (re-search-forward "^\\(\\*\\)\\([[ ]\\)" nil t)
 255                   (replace-match
 256                    (concat "*t*\\2")
 257                    ))))
 258     (t nil)
 259     )
 260       ;;¥¿¥¤¥È¥ë¤Î*t*¤ò»þ´Ö¤ËÃÖ¤¤«¤¨¤ë
 261       (goto-char (point-min))
 262       (let ((i 0))
 263         (while (re-search-forward "^\\*t\\*" nil t)
 264           (replace-match
 265            (concat "*" (hatena-current-second i) "*")
 266            (setq i (1+ i))
 267            ))))
 268     (save-buffer))
 269
 270   (if (not userid)
 271       (setq userid hatena-usrid))
 272
 273   (let ((filename (file-name-nondirectory file)))
 274     (if (string-match hatena-fname-regexp filename)
 275         (let*
 276             ((year (match-string 1 filename))
 277              (month (match-string 2 filename))
 278              (day (match-string 3 filename))
 279              (date (concat year month day))
 280              ;;¤Ï¤Æ¤Ê¤ËÄÌÃÎ¤¹¤ë¥¿¥¤¥à¥¹¥¿¥ó¥×
 281              (timestamp
 282               (format-time-string "%Y%m%d%H%m%S" (current-time)))
 283
 284              (baseurl (concat "http://d.hatena.ne.jp/" userid "/"))
 285              (referer (concat baseurl "edit?date=" date))
 286              (nexturl (concat baseurl (concat year month day)))
 287              (url (concat baseurl "edit"))
 288
 289              (title "")
 290              (send-file file)
 291              (full-body
 292               (with-temp-buffer
 293                 (insert-file-contents send-file)
 294                 ;; ¥Ð¥Ã¥Õ¥¡¤òÁ÷¤ëÁ°¤Ë¸Æ¤Ð¤ì¤ë hooks
 295                 (run-hooks 'hatena-diary-mode-submit-hook)
 296                 (cond ( (string-match "\\`title[ ¡¡]*\\(.*\\)?\n" (buffer-string))
 297                         (progn
 298                           (setq title (match-string 1 (buffer-string)))
 299                           (substring (buffer-string)
 300                                      (length (match-string 0 (buffer-string))))
 301                           ))
 302                       ;;¸Å¤¤¼ÂÁõ
 303                       ( (string-match hatena-header-regexp (buffer-string))
 304                         (progn
 305                           (setq title (match-string 1 (buffer-string)))
 306                           (substring (buffer-string)
 307                                      (1+ (length (match-string 0 (buffer-string)))))) )
 308                       (t (buffer-string)))))
 309              (body (hatena-url-encode-string full-body hatena-default-coding-system))
 310              (trivial (if hatena-trivial "1" "0"))
 311              (twit (hatena-url-encode-string hatena-twitter-prefix hatena-default-coding-system))
 312              (post-data
 313               (concat "dummy=1"
 314                       "&mode=enter"
 315                       "&body=" body
 316                       "&trivial=" trivial
 317                       "&title=" title
 318                       "&day=" day
 319                       "&month=" month
 320                       "&year=" year
 321               "&twitter_notification_enabled=" (if hatena-twitter-flag "1" "")
 322               "&twitter_notification_prefix=" twit
 323                       ;; session ID for POST to hatena
 324                       ;; this is a scheme of ensuring security in Hatena::Diary
 325                       (concat "&rkm="
 326                               (let* ((md5sum (md5 (with-temp-buffer
 327                                                     (insert-file-contents hatena-cookie)
 328                                                     (re-search-forward "rk\\s \\([0-9a-zA-Z]+\\)")
 329                                                     (concat (buffer-substring
 330                                                              (match-beginning 1)
 331                                                              (match-end 1)))) nil nil 'utf-8))
 332                                      (p 0)
 333                                      (temp ""))
 334                                 (while (> (length md5sum) p)
 335                                   (setq temp
 336                                         (concat
 337                                          temp
 338                                          (char-to-string (string-to-number
 339                                                           (substring md5sum p (+ p 2)) 16))))
 340                                   (setq p (+ p 2)))
 341                                 (substring (base64-encode-string temp) 0 22)))
 342                       ;; if "date" element exists ,
 343                       ;; command can't create the new page at hatena
 344                       (if (hatena-check-newpage referer)
 345                           (concat "&date=" date))
 346                       "&timestamp=" timestamp )))
 347
 348           (with-temp-file hatena-tmpfile
 349             (insert post-data))
 350
 351           (message "%s => %s" filename referer)
 352           (call-process hatena-curl-command nil nil nil
 353                         "-b" hatena-cookie
 354                         "-x" hatena-proxy
 355                         "--data" (concat "@" hatena-tmpfile)
 356                         url)
 357
 358           (message "posted")
 359           (and (functionp hatena-browser-function)
 360                (funcall hatena-browser-function nexturl))
 361           )
 362       (error "Not Hatena file: %s" file)))
 363   (setq hatena-twitter-prefix nil))
 364
 365 (defun hatena-login ()
 366   (interactive)
 367   (if (file-exists-p hatena-cookie)
 368       (delete-file hatena-cookie))
 369   (message (concat "logging in to \"" hatena-url "\" as \"" hatena-usrid "\""))
 370   (let ((password (hatena-ask-password)))
 371
 372     (call-process hatena-curl-command nil nil nil
 373                   "-k"  "-c" hatena-cookie
 374                   "-x" hatena-proxy
 375                   "-d" (concat "name=" hatena-usrid)
 376                   "-d" (concat "password=" password)
 377                   "-d" (concat "autologin=1")
 378                   "-d" (concat "mode=enter")
 379                   "https://www.hatena.ne.jp/login"))
 380     (message "Say HAPPY! to Hatena::Diary"))
 381
 382
 383 (defun hatena-check-newpage (urldate)
 384   "¥Ú¡¼¥¸¤¬ºîÀ®ºÑ¤ß¤«¤É¤¦¤«¥Á¥§¥Ã¥¯"
 385   (message "checking diary ....")
 386   (call-process hatena-curl-command nil nil nil
 387                   "-o" hatena-tmpfile2
 388                   "-b" hatena-cookie
 389                   urldate)
 390   (if (save-excursion
 391         (find-file hatena-tmpfile2)
 392         (prog1
 393             (string-match "name=\"date\""
 394                           (buffer-string))
 395           (kill-this-buffer)))
 396       (progn
 397         (message "modify diary")
 398         t)
 399     (message "make new diary") nil))
 400
 401 (defun hatena-diary-file-p(file)
 402   (let ((fname (file-name-nondirectory file)))
 403     (if (string-match hatena-fname-regexp fname) t nil)))
 404
 405 (defun hatena-get-diary-string(&optional date)
 406   "¤Ï¤Æ¤Ê¤Ë¤¢¤ëÆüµ¥Õ¥¡¥¤¥ë¤ò¼è¤ê¡¢¤½¤ÎÊ¸»úÎó¤òÊÖ¤¹¡£
 407 ¥í¥°¥¤¥ó¤·¤Æ¤¤¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¡£"
 408   (if (not date) (error "not date"))
 409   (message "checking diary of %s ...." date)
 410   (let ((urldate (concat "http://d.hatena.ne.jp/"
 411                          hatena-usrid
 412                          "/edit?date="
 413                          date)))
 414     (call-process hatena-curl-command nil nil nil
 415                   "-o" hatena-tmpfile
 416                   "-b" hatena-cookie
 417                   urldate))
 418   (with-temp-buffer
 419     "*hatena-get*"
 420     (insert-file-contents hatena-tmpfile)
 421     ;;¤³¤³¤Ê¤ó¤È¤«...
 422     (goto-char (point-min))(while (replace-string "&quot;" "\""))
 423     (goto-char (point-min))(while (replace-string "&amp;" "&"))
 424     (goto-char (point-min))(while (replace-string "&gt;" ">"))
 425     (goto-char (point-min))(while (replace-string "&lt;" "<"))
 426     (goto-char (point-min))(while (replace-string "&#39;" "'"))
 427
 428     (if (string-match "<textarea[^>\n]*>\\(\\(\n\\|.\\)*?\\)</textarea>"
 429                       (buffer-string))
 430           (match-string 1 (buffer-string)) nil)))
 431
 432 (defun hatena-insert-webdiary(&optional date)
 433   "web ¤ÎÆüµ¤òÁÞÆþ¤¹¤ë¡£"
 434   (interactive)
 435   (if date nil
 436       (setq date (file-name-nondirectory buffer-file-name)))
 437   (if (string-match hatena-fname-regexp date)
 438       (insert (hatena-get-diary-string date))
 439     (error "not date or hatena file")))
 440
 441 (defun hatena-delete-diary(&optional file userid)
 442   "Æüµ¤òºï½ü¤¹¤ë¡£¥í¡¼¥«¥ë¤Ïºï½ü¤·¤Ê¤¤¡£"
 443   (interactive)
 444   ;;¥Ð¥Ã¥Õ¥¡¤«¤éÆÉ¤à¤ÈÁ÷¿®»þ´Ö¤Î¤È¤³¤í¤Ë"deleted"
 445     (if file nil
 446       (setq file buffer-file-name))
 447     (if (not userid)
 448         (setq userid hatena-usrid))
 449     (let ((filename (file-name-nondirectory file)))
 450       (if (string-match hatena-fname-regexp filename)
 451           (let*
 452               ((year (match-string 1 filename))
 453                (month (match-string 2 filename))
 454                (day (match-string 3 filename))
 455                (date (concat year month day))
 456                (baseurl (concat "http://d.hatena.ne.jp/" userid "/"))
 457                (referer (concat baseurl "edit?date=" date))
 458                (url (concat baseurl "edit"))
 459
 460                (edit (hatena-url-encode-string "¤³¤ÎÆü¤òºï½ü"))
 461                (post-data
 462                 (concat "edit=" edit
 463                         "&date=" date
 464                         (concat "&rkm="
 465                               (let*
 466                                   ((md5sum (md5
 467                                             (with-temp-buffer
 468                                               (insert-file-contents hatena-cookie)
 469                                               (re-search-forward "rk\\s \\([0-9a-zA-Z]+\\)")
 470                                               (concat (buffer-substring
 471                                                        (match-beginning 1)
 472                                                        (match-end 1)))) nil nil 'utf-8))
 473                                    (p 0)
 474                                    (temp ""))
 475                                 (while (> (length md5sum) p)
 476                                   (setq temp
 477                                         (concat
 478                                          temp
 479                                          (char-to-string (string-to-number
 480                                                           (substring md5sum p (+ p 2)) 16))))
 481                                   (setq p (+ p 2)))
 482                                 (substring (base64-encode-string temp) 0 22)))
 483                         "&mode=delete")))
 484             (message "deleting %s" referer)
 485             (with-temp-file hatena-tmpfile (insert post-data))
 486
 487             (call-process hatena-curl-command nil nil nil
 488                           "-b" hatena-cookie
 489                           "-x" hatena-proxy
 490                           "--data" (concat "@" hatena-tmpfile)
 491                           url)
 492
 493             (message "deleted"))
 494         (error "Not Hatena file: %s" file))))
 495
 496 (defun hatena-logout()
 497   (interactive)
 498   (call-process hatena-curl-command nil nil nil
 499                 "-b" hatena-cookie
 500                 "-x" hatena-proxy
 501                 "http://d.hatena.ne.jp/logout")
 502   (message "logged out from d.hatena.ne.jp"))
 503
 504 (defun hatena-ask-password()
 505   (let (pass str)
 506     (if (null hatena-use-file)
 507         (setq pass (read-passwd "password ? : "))
 508       ;;¥Õ¥¡¥¤¥ë¤¬Ìµ¤«¤Ã¤¿¾ì¹ç¤Ïºî¤ë¡£
 509       (if (not (file-exists-p hatena-password-file))
 510           (append-to-file (point) (point) hatena-password-file))
 511       (setq str (with-temp-buffer nil
 512                   (insert-file-contents hatena-password-file)
 513                   (buffer-string)))
 514       (if (string-match "[^ ]+" str)
 515           (setq pass (base64-decode-string (match-string 0 str)))
 516         (setq pass (read-passwd "password ? : "))
 517         (with-temp-file hatena-password-file
 518           (insert (base64-encode-string
 519                    (format "%s" pass)))))
 520     pass)))
 521
 522 (defun hatena-exit()
 523   "hatena-fname-regexp¤Ë¥Þ¥Ã¥Á¤¹¤ë¥Ð¥Ã¥Õ¥¡¤ò¤¹¤Ù¤ÆÊÝÂ¸¤·¤Æ¾Ãµî"
 524   (interactive)
 525   (if (yes-or-no-p "save all diaries and kill buffer ?")
 526       (progn
 527         (let ((buflist (buffer-list))
 528               (i 0))
 529           (while (< i (length buflist))
 530             (let ((bufname (buffer-name (nth i (buffer-list)))))
 531               (if (string-match hatena-fname-regexp bufname)
 532                   (progn
 533                     (if (buffer-modified-p (nth i (buffer-list)))
 534                         (save-buffer (nth i (buffer-list))))
 535                     (kill-buffer (nth i (buffer-list)))))
 536               (setq i (1+ i))))))))
 537
 538 (defun hatena-find-previous (&optional count file)
 539   "count ÆüÁ°¤ÎÆüµ¤ò³«¤¯ count ¤¬ nil ¤Ê¤é°ìÆü¤À¤±Ìá¤ë"
 540   (interactive "p")
 541   (hatena-find-pf (if count (- count) -1) (buffer-name)))
 542
 543 (defun hatena-find-following (&optional count file)
 544   "count Æü¸å¤ÎÆüµ¤ò³«¤¯ count ¤¬ nil ¤Ê¤é°ìÆü¤À¤±¤¹¤¹¤à"
 545   (interactive "p")
 546   (hatena-find-pf (if count count 1) (buffer-name)))
 547
 548 (defun hatena-find-pf(count &optional file)
 549   (if (equal major-mode 'hatena-diary-mode)
 550       (if (not file)
 551           (setq file (buffer-name)))
 552     (error "not hatena mode"))
 553   (let ((find-previous
 554          (lambda (element count lst)
 555            (let* ((sublst (member element lst))
 556                   (result (+ (- (length lst) (length sublst))
 557                              count)))
 558              (if (or (null sublst)
 559                      (< result 0)) nil
 560                (nth result lst)))))
 561         previous)
 562     (setq previous
 563           (funcall find-previous
 564                    (file-name-nondirectory file)
 565                    (if (not count) 1 count)
 566                    (directory-files
 567                     hatena-directory
 568                     nil hatena-fname-regexp)))
 569     (if previous (find-file (concat (file-name-directory file) previous))
 570       ;;¸«¤Ä¤«¤é¤Ê¤¤»þ¤Ï¡¢Ì¤Íè¤ÎÆüÉÕ¤ò¿Ò¤Í¤ë¡£
 571       (let ((filename (read-string "ºîÀ®¤·¤¿¤¤ÆüÉÕ¤òÆþÎÏ: "
 572                                    (hatena-today-date (* -24 count) (buffer-name)) nil)))
 573         (if (string-match hatena-fname-regexp filename)
 574             (progn
 575               (find-file filename)
 576               (save-buffer))
 577           (error "ÆüÉÕ¥Õ¥¡¥¤¥ë¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó!!"))))))
 578
 579 (defun hatena-get-webdiary ()
 580   "http://d.hatena.ne.jp/usrid/export ¤ò¼è¤Ã¤Æ¤¤ÆÊÑ´¹¡£Â¤ê¤Ê¤¤ÆüµÊ¬¤ò¥Õ¥¡¥¤¥ë¤ËÂ¤¹¡£"
 581   (interactive)
 582   ;;export¤ò¤È¤Ã¤Æ¤¯¤ë
 583   (call-process hatena-curl-command nil nil nil
 584                 "-o" hatena-tmpfile
 585                 "-b" hatena-cookie
 586                 (concat "http://d.hatena.ne.jp/" hatena-usrid "/export" ))
 587
 588   ;;export ¤Ï utf-8 ¤Ê¤Î¤Ç¡¢hatena-default-coding-system  ¤ËÄ¾¤¹¡£
 589   (let ((filelst (directory-files
 590                   hatena-directory
 591                   nil hatena-fname-regexp))
 592         (title-regexp "<day date=\"\\([0-9][0-9][0-9][0-9]\\)-\\([0-9][0-9]\\)-\\([0-9][0-9]\\)\" title=\"\\(.*\\)\">\n<body>\n")
 593         pt-start pt-end day title body)
 594     (with-temp-buffer
 595       "*hatena-get*"
 596       (insert-file-contents hatena-tmpfile)
 597       (set-buffer-file-coding-system hatena-default-coding-system)
 598       (hatena-translate-reverse-region (point-min) (point-max))
 599
 600       (while (re-search-forward title-regexp nil t)
 601         (setq day (concat (match-string 1) (match-string 2) (match-string 3)))
 602         (setq title (match-string 4))
 603         (setq pt-start (match-end 0))
 604         (re-search-forward "</body>\n" nil t)
 605         (setq pt-end (match-beginning 0))
 606         (setq body (buffer-substring pt-start pt-end))
 607         (save-excursion
 608           (if (null (member day filelst))
 609               (progn
 610                 (hatena day)
 611                 (set-buffer-file-coding-system hatena-default-coding-system)
 612                 (message "creatig %s" day)
 613                 (insert body)
 614                 (save-buffer)
 615                 (kill-buffer (current-buffer))))))
 616       (message "finished"))))
 617
 618
 619
 620 (defun hatena-url-encode-string (str &optional coding)
 621   "w3m-url-encode-string ¤«¤é¥³¥Ô¡¼"
 622   (apply (function concat)
 623          (mapcar
 624           (lambda (ch)
 625             (cond
 626              ((eq ch ?\n)               ; newline
 627               "%0D%0A")
 628              ((string-match "[-a-zA-Z0-9_:/.]" (char-to-string ch)) ; xxx?
 629               (char-to-string ch))      ; printable
 630              ((char-equal ch ?\x20)     ; space
 631               "+")
 632              (t
 633               (format "%%%02x" ch))))   ; escape
 634           ;; Coerce a string to a list of chars.
 635           (append (encode-coding-string (or str "")
 636                                         (or coding
 637                                             buffer-file-coding-system
 638                                             'iso-2022-7bit))
 639                   nil))))
 640
 641 (defun hatena-twitter-prefix-input (ts)
 642   "Æüµ¹¹¿·»þ¤ÎÆâÍÆÆþÎÏ"
 643   (interactive "sTwitter prefix:")
 644   (setq hatena-twitter-prefix ts))
 645
 646 ;----------------ÆÃ¼ìÊ¸»ú¤ÎÊÑ´¹----------------
 647 ;;yahtml ¤ò²þÊÑ
 648 (defvar hatena-entity-reference-chars-alist
 649   '((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot"))
 650   "translation table from character to entity reference")
 651 (defvar hatena-entity-reference-chars-regexp "[><&\\]")
 652 (defvar hatena-entity-reference-chars-reverse-regexp "&\\(gt\\|lt\\|amp\\|quot\\);")
 653
 654 (defun hatena-translate-region (beg end)
 655   "Translate inhibited literals."
 656   (interactive "r")
 657   (save-excursion
 658     (save-restriction
 659       (narrow-to-region beg end)
 660       (let ((ct hatena-entity-reference-chars-alist))
 661         (goto-char beg)
 662         (while (re-search-forward hatena-entity-reference-chars-regexp nil t)
 663           (replace-match
 664            (concat "&" (cdr (assoc (preceding-char) ct)) ";")))))))
 665
 666 (defun hatena-translate-reverse-region (beg end)
 667   "Translate entity references to literals."
 668   (interactive "r")
 669   (save-excursion
 670     (save-restriction
 671       (narrow-to-region beg end)
 672       (let ((ct hatena-entity-reference-chars-alist))
 673         (goto-char beg)
 674         (while (re-search-forward
 675                 hatena-entity-reference-chars-reverse-regexp nil t)
 676           ;(setq c (preceding-char))
 677           (replace-match
 678            (string (car
 679                  (rassoc (match-string 1)
 680                          ct)))))))))
 681
 682 (defun hatena-change-trivial ()
 683   (interactive)
 684   (if (not hatena-trivial)
 685       (progn
 686         (message "¤Á¤ç¤Ã¤È¤·¤¿¹¹¿·¥â¡¼¥É")
 687         (setq hatena-trivial t))
 688     (setq hatena-trivial nil)
 689     (message "¹¹¿·¥â¡¼¥É")))
 690
 691 (defun hatena-twitter ()
 692   (interactive)
 693   (if (not hatena-twitter-flag)
 694       (progn
 695         (message "twitter¤ËÄÌÃÎ")
 696         (setq hatena-twitter-flag t))
 697     (setq hatena-twitter-flag nil)
 698     (message "twitter¤Ë¤ÏÄÌÃÎ¤·¤Ê¤¤")))
 699
 700 (defun hatena-current-second(number)
 701   "¸½ºß¤Þ¤Ç¤ÎÉÃ¿ô¤òÊÖ¤¹¡£emacs ¤Ç¤ÏÀ°¿ô¤¬¥±¥¿°î¤ì¤¹¤ë¤Î¤Ç¡¢ÉâÆ°¾®¿ôÅÀ¤Ç"
 702   (let* ((ct (current-time))
 703          (high (float (car ct)))
 704          (low (float (car (cdr ct))))
 705          str)
 706     (setq str (format "%f"(+
 707                            (+ (* high (lsh 2 15)) low)
 708                            number)))
 709     (substring str 0 10) ;;
 710     ))
 711
 712
 713 ;-------------------------------------------
 714 ; ¤Ï¤Æ¤ÊµË¡¥Ø¥ë¥×
 715 (defun hatena-help-syntax1 ()
 716   "¤Ï¤Æ¤ÊµË¡ ¥Ø¥ë¥×ÌÜ¼¡¤òÉ½¼¨¤¹¤ë"
 717   (interactive)
 718   (describe-variable 'hatena-help-syntax-index))
 719
 720 (defun hatena-help-syntax2 ()
 721   "¤Ï¤Æ¤ÊµË¡ ÆþÎÏ»Ù±çµË¡¤Î¥Ø¥ë¥×¤òÉ½¼¨¤¹¤ë"
 722   (interactive)
 723   (describe-variable 'hatena-help-syntax-input))
 724
 725 (defun hatena-help-syntax3 ()
 726   "¤Ï¤Æ¤ÊµË¡ ¼«Æ°¥ê¥ó¥¯¤Î¥Ø¥ë¥×¤òÉ½¼¨¤¹¤ë"
 727   (interactive)
 728   (describe-variable 'hatena-help-syntax-autolink))
 729
 730 (defun hatena-help-syntax4 ()
 731   "¤Ï¤Æ¤ÊµË¡ ¤Ï¤Æ¤ÊÆâ¼«Æ°¥ê¥ó¥¯¤Î¥Ø¥ë¥×¤òÉ½¼¨¤¹¤ë"
 732   (interactive)
 733   (describe-variable 'hatena-help-syntax-hatena-autolink))
 734
 735 (defun hatena-help-syntax5 ()
 736   "¤Ï¤Æ¤ÊµË¡ ÆþÎÏ»Ù±çµ¡Ç½¤Î¥Ø¥ë¥×¤òÉ½¼¨¤¹¤ë"
 737   (interactive)
 738   (describe-variable 'hatena-help-syntax-other))
 739
 740
 741 (defun hatena-image-insert (filename filesize)
 742   "²èÁü¤ò¤Ï¤Æ¤Ê¥Õ¥©¥È¥é¥¤¥Õ¤Ë¥¢¥Ã¥×¥í¡¼¥É¤·¡¢Æüµ¤ËÁÞÆþ¤¹¤ë"
 743   (interactive "fImage File:\nsFile Size:")
 744   (let*
 745       ((extension (upcase (substring filename (- (length filename) 3))))
 746        (baseurl (concat "http://f.hatena.ne.jp/" hatena-usrid "/"))
 747        (url (concat baseurl "up"))
 748        (rkm
 749                     (let* ((md5sum (md5 (with-temp-buffer
 750                                           (insert-file-contents hatena-cookie)
 751                                           (re-search-forward "rk\\s \\([0-9a-zA-Z]+\\)")
 752                                           (concat (buffer-substring
 753                                                              (match-beginning 1)
 754                                                              (match-end 1)))) nil nil 'utf-8))
 755                            (p 0)
 756                            (temp ""))
 757                       (while (> (length md5sum) p)
 758                         (setq temp
 759                               (concat
 760                                temp
 761                                (char-to-string (string-to-number
 762                                                 (substring md5sum p (+ p 2)) 16))))
 763                         (setq p (+ p 2)))
 764                       (substring (base64-encode-string temp) 0 22))))
 765     (cond
 766      ((or (string= extension "JPG") (string= extension "GIF") (string= extension "PNG"))
 767       (with-temp-buffer
 768        (call-process hatena-curl-command nil t nil
 769                      "-L"
 770                      "-b" hatena-cookie
 771                      "-x" hatena-proxy
 772                      "-F" (concat "rkm=" rkm)
 773                      "-F" "mode=enter"
 774                      "-F" "fototitle1="
 775                      "-F" (concat "size=" filesize)
 776                      "-F" "taglist="
 777                      "-F" (concat "image1=@" (expand-file-name filename))
 778                      url)
 779        (goto-char (point-min))
 780        (re-search-forward "check-\\([0-9]+\\)")
 781        (setq hatena-photo (concat "[f:id:" hatena-usrid ":" (buffer-substring
 782         (match-beginning 1)
 783         (match-end 1)
 784         ) "p:image]")))
 785       (insert hatena-photo)
 786       (newline)
 787       (insert-image (create-image (expand-file-name filename)))
 788       ))))
 789
 790
 791 (provide 'hatena-diary-mode)
 792
 793 ;;;;;end of file