Emacs编辑Blogger

找了半天, 没有一个很好, 如 g-client, emacs-atom-api, 这些还不如 Blogger 的在线编辑器.

又发现Blogger不能自动将空行当作新段. 倒是有一个选项, 将换行替换为HTML语言里新行, 但那样的话, 会破坏精心设计的 HTML 排版, 我就遇到过这种情形.

后来, 发现还是邮件形式的最简单—虽然不能编辑发表过的帖子, 也不知道怎么加 Tags.

但我还是懒编辑HTML, 将每段文本加段落符, 这种应该是机器做的事. 如是, 我将 想 Muse 集成到邮件编写器里, 所以就有下面的代码.

使用: 将下面的代码存为文件 mbmuse.el, 如改名, 请相应改 (provide 'mbmuse)
;; Author: jiangzuoyan@gmail.com
;; Time-stamp: <Changsheng Jiang 2008-04-04 20:36:19>
;; for blogger

(setq pt-mbmail-multipart-regexp
"
<#multipart type=alternative>
<#part type=\"text/imuse\" disposition=inline>
\\(\\(?:\n\\|.\\)*?\\)
<#/part>
<#part type=\"text/html\" disposition=inline>
\\(\\(?:\n\\|.\\)*?\\)
<#/part>
<#/multipart>
"
)


(defun pt-mbmail-part-tohtml-string (text)
"encode the string to a html text"
(let ((muse-publishing-current-style "xhtml1.1")
  (muse-publishing-p t)
  (muse-xhtml-header "")
  (muse-xhtml-footer "")
  (buf (generate-new-buffer (concat "*pt-mbmail-part*")))
  (html-content nil)
  )
(with-current-buffer buf
(insert text)
(muse-publish-markup-buffer "pt-mbmail-part" muse-publishing-current-style)
(goto-char (point-min))
(let ((inhibit-read-only t))
  (remove-text-properties (point-min) (point-max)
                          '(rear-nonsticky nil read-only nil)))
(set 'html-content (buffer-string)))
(kill-buffer buf)
(message "html-content %s" html-content)
html-content
)
)

(defun pt-mbmail-new ()
"new multipart of mbmail"
(interactive)
(let ((spos nil))
(insert "\n<#multipart type=alternative>\n<#part type=\"text/imuse\" disposition=inline>\n")
(set 'spos (point))
(insert "\n<#/part>
<#part type=\"text/html\" disposition=inline>\n
<#/part>
<#/multipart>\n")
(goto-char spos)
)
)

(defun pt-mbmail-part ()
"update text/imuse to htmlized content"
(interactive)
(save-excursion
(goto-char (point-min))
(setq case-fold-search t)
(while (re-search-forward pt-mbmail-multipart-regexp (point-max) t)
(let ((imuse (match-string 1))
      (imuse-html-content nil)
      (imuse-nend (match-end 2)))
  (message "FOUND")
  (set 'imuse-nend (- imuse-nend (length (match-string 2))))
  (goto-char (match-beginning 2))
  (kill-region (match-beginning 2) (match-end 2))
  (set 'imuse-html-content (pt-mbmail-part-tohtml-string imuse))
  (set 'imuse-nend (+ imuse-nend (length imuse-html-content)))
  (insert imuse-html-content)
  (goto-char imuse-nend)
  )
)
))


(provide 'mbmuse)

No comments: