;;; tumblr-mode.el --- Major mode for Tumblr
;;
;; Copyright (C) 2011, 2012 Julian Qian
;;
;; Author: Julian Qian <junist@gmail.com>
;; Created: Dec 25, 2011
;; Version: 0.2
;;
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;
;;; Commentary:
;;
;; tumblr-mode.el is a major mode for tumblr.com.
;;
;; You can write and manage your tumblr posts in Emacs with this mode.
;; It only supports to create regular(text) type in tumblr.com now,
;; because I think it's the most suitable type that can be edited in
;; Emacs.
;;
;; - `tumblr-new-post' create a buffer to post
;; - `tumblr-save-post' save buffer to tumblr.com
;; - `tumblr-list-posts' list tumblr posts in a buffer
;;
;;; Install:
;;
;; Download and put `tumblr-mode.el' into your load-path, then use it in
;; your ~/.emacs:
;;
;; (require 'tumblr-mode)
;;
;;; Code:
(require 'cl)
(require 'url)
(require 'xml)
(defgroup tumblr-mode nil
"A major mode for Tumblr.com")
(defcustom tumblr-hostnames '()
"a list containing all your tumblr hosts, eg:
\(setq tumblr-hostnames
'\(\"myblog.tumblr.com\" \"myphoto.tumblr.com\"\)\)"
:type '(repeat string)
:group 'tumblr-mode)
(defcustom tumblr-email ""
"tumblr login email"
:type 'string
:group 'tumblr-mode)
(defcustom tumblr-password ""
"tumblr login password"
:type 'string
:group 'tumblr-mode)
(defcustom tumblr-post-type "text"
"tumblr post type"
:type 'string
:group 'tumblr-mode)
(defcustom tumblr-post-format "markdown"
"tumblr post format"
:type 'string
:group 'tumblr-mode)
(defcustom tumblr-retrieve-posts-num-total 20
"the number of posts to be listed"
:type 'integer
:group 'tumblr-mode)
(defvar tumblr-current-hostname nil)
(defvar tumblr-current-tag nil)
(defvar tumblr-current-state nil)
(defvar tumblr-post-header-delimiters '("--" . "--")
"A cons containing two flags, to indicate the header, aka. meta info section, of a post.
Default are two \"--\", but you can replace them with \"<!--\"
and \"-->\" for better markdown preview, eg:
(setq tumblr-post-header-delimiters '(\"<!--\" . \"-->\"))
")
(defvar tumblr-post-status '("published" "draft"))
(defvar tumblr-post-types '("text" "quote" "photo" "link" "chat" "video" "audio"))
(defvar tumblr-post-formats '("markdown" "html"))
(defvar tumblr-request-filters '("text" "none"))
(defvar tumblr-retrieve-posts-num-once 20)
(defvar tumblr-retrieve-posts-list nil)
(defvar tumblr-mode-map
(let ((map (make-keymap)))
(suppress-keymap map)
(define-key map (kbd "n") 'next-line)
(define-key map (kbd "p") 'previous-line)
(define-key map (kbd "q") 'bury-buffer)
(define-key map (kbd "g") 'tumblr-list-posts)
map)
"keymap for `tumblr-mode'.")
(defvar tumblr-post-mode-map
(let ((map (make-keymap)))
(define-key map (kbd "C-c C-s") (lambda ()
(interactive)
(call-interactively 'tumblr-save-post)
(set-buffer-modified-p nil)))
map)
"keymap for `tumblr-post-mode'.")
;; utilities
(defun assocref (item alist)
(cdr (assoc item alist)))
(defun assqref (item alist)
(cdr (assq item alist)))
(defun tumblr-format-timestamp (secs)
(format-time-string "%F" (seconds-to-time (if (stringp secs)
(string-to-number secs)
secs))))
(defun tumblr-query-string (args)
(mapconcat (lambda (arg)
(concat (url-hexify-string (car arg))
"="
(url-hexify-string (cdr arg))))
args "&"))
(defun tumblr-get-hostname ()
(setq tumblr-current-hostname
(if (and (listp tumblr-hostnames) (car tumblr-hostnames))
(funcall (if (fboundp 'ido-completing-read)
'ido-completing-read
'completion-read)
"Choose hostname: " tumblr-hostnames nil nil nil nil
(car tumblr-hostnames))
(read-string "Tumblr hostname: "))))
(defun tumblr-get-tag ()
(setq tumblr-current-tag
(read-string "Choose a tag: " nil '(tumblr-current-tag))))
(defun tumblr-get-state ()
(setq tumblr-current-state
(funcall (if (fboundp 'ido-completing-read)
'ido-completing-read
'completion-read)
"Choose state: " tumblr-post-status nil nil nil nil
(car tumblr-post-status))))
(defun tumblr-get-email ()
(or tumblr-email (setq tumblr-email (read-string "Tumblr email: "))))
(defun tumblr-get-password ()
(or tumblr-password (setq tumblr-password (read-passwd "Tumblr password: "))))
;; tumblr format
(defun tumblr-list-posts-format (width content)
(let ((fmt (format "%%-%d.%ds" width (decf width))))
(format fmt content)))
(defun tumblr-mode-line-title-format (title)
(format "*tumblr: %s*" title))
;; http functions
(defun tumblr-authenticated-read-xml-root (hostname params)
(let* ((url-request-method "POST")
;; (url-http-attempt-keepalives nil)
(url-mime-charset-string "utf-8;q=0.7,*;q=0.7")
(url-request-extra-headers
'(("Content-Type" . "application/x-www-form-urlencoded")))
(url-request-data (tumblr-query-string
(append params
`(("email" . ,(tumblr-get-email))
("password" . ,(tumblr-get-password))))))
(coding-system-for-read 'utf-8)
(coding-system-for-write 'utf-8)
(buffer (url-retrieve-synchronously (format "http://%s/api/read" hostname)))
(root (with-current-buffer buffer
(set-buffer-multibyte t)
;; (write-file "/tmp/tumblr.txt" nil)
;; (decode-coding-region (point-min) (point-max) 'utf-8)
(goto-char (point-min))
(if (search-forward "<?xml" nil t) ; skip HTTP header
(xml-parse-region (match-beginning 0) (point-max))
(error "Failed to read from tumblr.")))))
(kill-buffer buffer)
root))
(defun tumblr-write-post (hostname params)
"Post data to HOSTNAME, PARAMS is alist containing request data."
(let* ((url-request-method "POST")
(url-max-redirecton -1)
;; (url-http-attempt-keepalives nil)
(url-mime-charset-string "utf-8;q=0.7,*;q=0.7")
(url-request-extra-headers
'(("Content-Type" . "application/x-www-form-urlencoded")))
(url-request-data (tumblr-query-string
(append params
`(("email" . ,(tumblr-get-email))
("password" . ,(tumblr-get-password))
("group" . ,hostname)
("type" . ,tumblr-post-type)
("format" . ,tumblr-post-format)
("generator" . "tumblr-mode.el")))))
(coding-system-for-read 'utf-8)
(coding-system-for-write 'utf-8))
(url-retrieve
"http://www.tumblr.com/api/write"
(lambda (&rest args)
(message "url-retrieve callback status")
(let ((buffer (current-buffer)))
(set-window-buffer nil buffer)
(with-current-buffer buffer
(goto-char (point-min))
;; take from twittering-mode.el
(when (search-forward-regexp
"\\`\\(\\(HTTP/1\.[01]\\) \\([0-9][0-9][0-9]\\) \\(.*?\\)\\)\r?\n"
nil t)
(let ((status-line (match-string 1))
(http-version (match-string 2))
(status-code (match-string 3))
(reason-phrase (match-string 4)))
(cond
((string= "201" status-code)
(search-forward-regexp "\r?\n\r?\n" nil t)
(let* ((beg (match-end 0))
(end (point-max))
(post-id (buffer-substring beg end)))
;; get post-id
(message "Post OK. return id: %s" post-id)))
((string= "403" status-code)
(message "Failed. Your email address or password were incorrect."))
((string= "400" status-code)
(message "Failed. There was at least one error while trying to save your post."))
(t
(error (format "Unknown failure, maybe network exception :(")))))))
(kill-buffer buffer))))))
;; tumblr functions
(defun tumblr-get-posts-count (hostname &optional tagged state)
(let* ((root (tumblr-authenticated-read-xml-root
hostname
`(("num" . "1")
("filter" . "text")
("tagged" . ,tagged)
("state" . ,state))))
(tumblr (car root))
(posts (car (xml-get-children tumblr 'posts)))
(attrs (xml-node-attributes posts))
(total (assqref 'total attrs)))
(string-to-number total)))
(defun tumblr-list-posts-internal (hostname retrieving &optional tagged state)
(let* ((root (tumblr-authenticated-read-xml-root
hostname
`(("num" . ,(number-to-string retrieving))
("filter" . "text")
("tagged" . ,tagged)
("state" . ,state))))
(tumblr (car root))
(posts (car (xml-get-children tumblr 'posts)))
(post-list (xml-get-children posts 'post)))
(mapcar (lambda (post)
(let* ((attrs (xml-node-attributes post))
(timestamp (assqref 'unix-timestamp attrs))
;; (date (assqref 'date attrs))
(id (assqref 'id attrs))
(slug (assqref 'slug attrs))
(url (assqref 'url attrs))
(title (caddar (xml-get-children post 'regular-title)))
(tags (mapcar (lambda (tag) (caddr tag))
(xml-get-children post 'tag))))
;; return a list of alist
`((timestamp . ,timestamp)
(id . ,id)
(slug . ,slug)
(url . ,url)
(title . ,title)
(tags . ,tags))))
post-list)))
(defun tumblr-list-posts (choose)
"List all regular posts of your hostname.
Default hostname/tag/state can be specified with
`tumblr-default-hostname', `tumblr-default-tag' and
`tumblr-default-state'.
If \\[tumblr-list-posts] is called with a argument, other
hostname/tag/state can also be specified to override default
settings temporarily.
\\[tumblr-list-posts] retrieves posts from tumblr.com
synchronously, during this period, Emacs will seems to hang up
some minutes."
(interactive "P")
(let* ((hostname (if choose
(tumblr-get-hostname)
(or tumblr-current-hostname
(tumblr-get-hostname))))
(tagged (if choose
(tumblr-get-tag)
(or tumblr-current-tag
(tumblr-get-tag))))
(state (if choose
(tumblr-get-state)
(or tumblr-current-state
(tumblr-get-state))))
(total (tumblr-get-posts-count hostname tagged state))
(total-retrieving (or (if (> tumblr-retrieve-posts-num-total total)
total
tumblr-retrieve-posts-num-total) total))
(remaining total-retrieving)
(tumblr-retrieve-posts-list nil))
;; retrieve posts
(while (> remaining 0)
(let ((retrieving (if (> remaining tumblr-retrieve-posts-num-once)
tumblr-retrieve-posts-num-once
remaining)))
(setq remaining (- remaining retrieving))
(setq tumblr-retrieve-posts-list
(append tumblr-retrieve-posts-list
(tumblr-list-posts-internal hostname retrieving tagged state)))))
;; list all posts
(with-current-buffer (get-buffer-create "*tumblr-mode*")
(goto-char (point-min))
(save-excursion
(kill-region (point-min) (point-max))
(let ((title-len 48) ; keep less than 80 columns
(tags-len 20)
(date-len 11))
;; header
(save-excursion
(insert (tumblr-list-posts-format title-len "Title"))
(insert (tumblr-list-posts-format tags-len "Tags"))
(insert (tumblr-list-posts-format date-len "Date"))
(insert "\n"))
(overlay-put (make-overlay (line-beginning-position) (line-end-position))
'face 'header-line)
(forward-line)
;; list posts
(mapc (lambda (post)
(insert (tumblr-list-posts-format
title-len (assqref 'title post)))
(insert (tumblr-list-posts-format
tags-len (mapconcat (lambda (tag) (format "#%s" tag))
(assqref 'tags post) ", ")))
(insert (tumblr-list-posts-format
date-len (tumblr-format-timestamp (assqref 'timestamp post))))
(make-text-button (line-beginning-position) (line-end-position)
'id (assqref 'id post)
'group hostname
'action 'tumblr-get-post-edit
'face 'default)
(insert "\n"))
tumblr-retrieve-posts-list)))
;; skip header
(forward-line)
(tumblr-mode hostname)
(set-window-buffer nil (current-buffer)))
(message "Retrieved total %d posts on %s, tagged %s, state: %s."
total-retrieving hostname tagged state)))
(defun tumblr-get-post (post-id hostname)
(let* ((root (tumblr-authenticated-read-xml-root
hostname
`(("id" . ,post-id)
("filter" . "none"))))
(tumblr (car root))
(posts (car (xml-get-children tumblr 'posts)))
(post (car (xml-get-children posts 'post)))
(attrs (xml-node-attributes post))
(title (caddar (xml-get-children post 'regular-title)))
(body (caddar (xml-get-children post 'regular-body))) ; post content
(tags (mapcar (lambda (tag) (caddr tag))
(xml-get-children post 'tag)))
(buffer (get-buffer-create (tumblr-mode-line-title-format title))))
;; edit post
(with-current-buffer buffer
(goto-char (point-min))
(save-excursion
(kill-region (point-min) (point-max))
;; insert meta info, as octopress does
(tumblr-insert-post-template title attrs tags hostname)
;; insert content
(insert body))
(tumblr-prepare-post-edit))
(set-window-buffer nil buffer)))
(defun tumblr-insert-post-template (title &optional attrs-alist tags-list group)
(if (car tumblr-post-header-delimiters)
(insert (format "%s\n" (car tumblr-post-header-delimiters))))
(let ((date (assqref 'date attrs-alist))
(id (assqref 'id attrs-alist))
(slug (assqref 'slug attrs-alist))
(state (assqref 'state attrs-alist))
(format (assqref 'format attrs-alist))
(tags (mapconcat (lambda (tag) tag) tags-list ", ")))
(and id (insert (format "id: %s\n" id)))
(and title (insert (format "title: %s\n" title)))
(and slug (insert (format "slug: %s\n" slug)))
(and group (insert (format "group: %s\n" group)))
(and tags (insert (format "tags: %s\n" tags)))
(and format (insert (format "format: %s\n" format)))
(and state (insert (format "state: %s\n" state)))
(and date (insert (format "date: %s\n" date))))
(if (cdr tumblr-post-header-delimiters)
(insert (format "%s\n\n" (cdr tumblr-post-header-delimiters)))
(error "cdr of `tumblr-post-header-delimiters' is a must,
otherwise it cannot identify what's header of the post.")))
(defun tumblr-get-post-edit (button)
(tumblr-get-post (button-get button 'id) (button-get button 'group)))
(defun tumblr-save-post ()
"Posting current buffer to tumblr.com. Below options are
accepted headers for posting:
- `title' Post's title, required
- `post-id' Post's identity, required when editing an existed post
- `group' The hostname the post will be posted to, it will
override `tumblr-default-hostname', optional
- `tags' Tags seperated by comma, optional
- `slug' Slug for friendly url, optional
- `state' published/draft/submission/queue, optional
- `date' When the post is posted, optional
One example of the post buffer:
--
title: a post writed by tumblr-mode.el
group: test.tumblr.com
tags: tumblr, emacs
--
blah..blah..blah
"
(interactive)
(let* ((body-start (point-min))
;; get meta properities
(props (save-excursion
;; only search meta info in 0~10 lines
(let ((bound (progn (goto-char (point-min))
(forward-line 10)
(point)))
beg end)
(goto-char (point-min)) ; start to search
;; meta info begin point
(if (and (car tumblr-post-header-delimiters)
(search-forward-regexp
(format "%s\r?\n" (car tumblr-post-header-delimiters)) bound t))
(setq beg (match-end 0))
(setq beg (point-min)))
;; meta info end point
(if (and (cdr tumblr-post-header-delimiters)
(search-forward-regexp
(format "%s\r?\n" (cdr tumblr-post-header-delimiters)) bound t))
(progn
(setq end (match-beginning 0))
)
(error "Can't found the delimiter of post's header and body"))
;; meanwhile, we can get body start point
(if (search-forward-regexp "[^\r\n]" nil t)
(setq body-start (match-beginning 0))
(setq body-start (point)))
;; found meta info
(if (and (< beg end)
(< end body-start))
(let* ((lines-text (buffer-substring-no-properties beg end))
(lines (split-string lines-text "\r?\n" t))
prop)
(mapcar (lambda (line)
(when (string-match "\\s-*\\([^:]+\\)\\s-*:\\s-*\\(.+\\)" line)
`(,(match-string 1 line)
.
,((lambda (str) ; strip tail white space
(if (string-match "\\s-+$" str)
(replace-match "" t t str)
str))
(match-string 2 line)))))
lines))
(error "Failed to parse the post, maybe format is wrong.")))))
;; get body content
(body (buffer-substring-no-properties body-start (point-max)))
(id (assocref "id" props))
(title (assocref "title" props))
(tags (assocref "tags" props))
(date (assocref "date" props))
(group (assocref "group" props))
(state (assocref "state" props))
(slug (assocref "slug" props)))
(when (y-or-n-p (format "%s post [ %s ]?%s"
(if id "Save" "Create")
title
(if tags (format " tags: %s." tags) "")))
(tumblr-write-post
(if (or (null group) (string= "" group))
(tumblr-get-hostname)
group)
`(("post-id" . ,id) ; WTF..api/read is "id", but api/write is "post-id"
("title" . ,title)
("body" . ,body)
("tags" . ,tags)
("date" . ,date)
("slug" . ,slug)
("state" . ,state)))
(set-buffer-modified-p nil))))
(defun tumblr-prepare-post-edit ()
(if (fboundp 'markdown-mode)
(markdown-mode)
(message "Recommand to apply markdown-mode for tumblr post writing."))
(tumblr-post-mode 1)
(set-buffer-modified-p nil))
(defun tumblr-new-post (title)
(interactive "sCreate post title: \n")
(switch-to-buffer (tumblr-mode-line-title-format title))
(tumblr-insert-post-template title
'((slug . " ")
(state . "published"))
nil (or tumblr-current-hostname (tumblr-get-hostname)))
(tumblr-prepare-post-edit))
;; (put 'tumblr-mode 'mode-class 'special)
(defun tumblr-mode (&optional hostname)
(kill-all-local-variables)
(buffer-disable-undo)
(setq major-mode 'tumblr-mode
mode-name "tumblr-mode"
mode-line-buffer-identification
(append (default-value 'mode-line-buffer-identification)
`(,(format " [%s] " hostname))))
(make-local-variable 'tumblr-retrieve-posts-list)
(use-local-map tumblr-mode-map)
(run-mode-hooks 'tumblr-mode-hook))
(define-minor-mode tumblr-post-mode
"A minor mode for tumblr post, see \\[tumblr-new-post] and
\\[tumblr-save-post]"
:init-value nil
:lighter " Tumblr"
:keymap tumblr-post-mode-map
:group 'tumblr-mode)
(provide 'tumblr-mode)
;;; tumblr-mode.el ends here