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