Scripts/eblogger.el at master · yami/Scripts · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
;; Eblogger.el is a GNU Emacs extension to publish restructedText or
;; Org-mode buffer to google www.blogger.com.
;;
;; Entry point: eblogger-publish-new
;;
;;
;; It is 'filter' based, i.e., for rst or Org-mode buffer, we have two
;; sets of filters. For example, for rst, the first filter calls
;; eblogger-filter-rst, which calls rst2html command to convert
;; current buffer into HTML format. Then some other filters are called
;; to convert/remove some HTML tags, because google does not like
;; them.
;;
;; TODO:
;; 1. reuse (co-use) auth-session with firefox
;; 2. better debug interface
;; 3. formal customization

(require 'g-auth)
(require 'g-utils)

(defconst eblogger-service-name "blogger"
  "")

(defconst eblogger-user-email nil
  "")

(defconst eblogger-user-password nil
  "")

(defconst eblogger-buffer-name "*eblogger output*"
  "temporary buffer to hold intermediate results from filters.")

;; TODO: should be defcustom
(defconst eblogger-filter-alist
  '((rst-mode . (eblogger-filter-rst
                 eblogger-filter-fix-xhtml
                 eblogger-filter-xhtml))
    (org-mode . (eblogger-filter-org
                 eblogger-filter-fix-xhtml
                 eblogger-filter-xhtml)))
  "Filter definition list. Each item is of form (MAJOR-MODE
  . FILTER-LIST), which means FILTER-LIST only applies to major
  mode MAJOR-MODE.")

;; TODO: should be defcustom
(defconst eblogger-post-url-new
  "http://scameung.blogspot.com/feeds/posts/default"
  "URL for posting a new blogger entry.")

(defconst eblogger-curl
  "/usr/bin/curl"
  "Path to curl, which send HTML content to the remote server.")

(defconst eblogger-curl-common-options
  "--compressed --silent --location --location-trusted --raw"
  "Command Options for curl.")


(defconst eblogger-author
  "yami"
  "Author to fill in eblogger-new-entry-template.")

(defvar eblogger-new-entry-template
  "<entry xmlns='http://www.w3.org/2005/Atom'>
  <generator url=\"%s\">%s</generator>
  <author> <name>%s </name> </author>
  <title mode=\"escaped\" type=\"text/html\"> %%s </title>
  <content type='xhtml'>
    <div xmlns=\"http://www.w3.org/1999/xhtml\">
    %%s
    </div>
  </content>
</entry>"
  "Template for new Blogger entries.")

(defun eblogger-new-entry-template-rst ()
  (format eblogger-new-entry-template
          "http://docutils.sourceforge.net/"
          "Docutils 0.4.1"
          eblogger-author))


(defun eblogger-buffer ()
  "Get or create a eblogger-buffer for filters to use."
  (get-buffer-create eblogger-buffer-name))


(defun eblogger-shell-command (command &optional min max)
  "Run shell command on eblogger-buffer."
  (setq min (or min (point-min)))
  (setq max (or max (point-max)))
  (shell-command-on-region
   min max
   command
   (eblogger-buffer)))


;;
;; filters infrastructure
;;

;; TODO: need more defensive-programming here.  since a failed command
;; running might corrupt/erase all contents in eblogger-buffer.
(defun eblogger-run-filters (filters)
  "Run filters on current buffer according to the major-mode."
  (unless (eq (current-buffer) (eblogger-buffer))
    (let ((initial-content (buffer-string)))
      (with-current-buffer (eblogger-buffer)
        (erase-buffer)
        (insert initial-content))))

  (with-current-buffer (eblogger-buffer)
    (dolist (filter filters)
      (goto-char (point-min))
      (funcall filter))))


(defun eblogger-get-filters ()
  "Get corresponding filters according to current buffer's major-mode."
  (cdr (assq major-mode eblogger-filter-alist)))


;;
;; filters
;;

;; A naive parser for XML tags.
;;
;; TODO: use xml-parse-file?

;; eblogger-xhtml-tag finds a tag beginning and ending, and returns a
;; list:
;;   ((beg0 end0) (beg1 end1))
;;
;; For tag HEAD like following
;;     <head ...>
;;     ^beg0     ^end0
;;     </head>
;;     ^beg1 ^end1
(defun eblogger-tinfo-beg0 (tinfo)
  (caar tinfo))

(defun eblogger-tinfo-beg1 (tinfo)
  (cdar tinfo))

(defun eblogger-tinfo-end0 (tinfo)
  (cadr tinfo))

(defun eblogger-tinfo-end1 (tinfo)
  (cddr tinfo))

(defun eblogger-xhtml-tag (tag &optional start)
  (let ((rexp (format "\\(<%s.*?>\\)\\|\\(</%s>\\)" tag tag))
        (unmatched '())
        (tinfo '()))
    (save-excursion
      (setq start (or start (point-min)))
      (goto-char start)
      (while (when (search-forward-regexp rexp nil t)
               (if (match-string 1)
                   (push (cons (match-beginning 1) (match-end 1)) unmatched)
                 (if (= (length unmatched) 1)
                     (progn (setq tinfo
                                  (cons (car unmatched)
                                        (cons (match-beginning 2) (match-end 2))))
                            nil)
                   (pop unmatched)))))
      tinfo)))

(defun eblogger-xhtml-cut-tag (tag)
  "Remove the tag and it's content and returns the cut part."
  (let* ((tinfo (eblogger-xhtml-tag tag))
         (beg (eblogger-tinfo-beg0 tinfo))
         (end (eblogger-tinfo-end1 tinfo)))
    (if tinfo
      (delete-and-extract-region beg end)
      "")))

(defun eblogger-xhtml-cut-content (tag)
  "Remove the content of enclosed by the tag only, and returns
the cut part."
  (let* ((tinfo (eblogger-xhtml-tag tag))
         (beg (eblogger-tinfo-end0 tinfo))
         (end (eblogger-tinfo-beg1 tinfo)))
    (if tinfo
      (delete-and-extract-region beg end)
      "")))


(defun eblogger-fix-xhtml-pre ()
  "in PRE tag, google does not like new-line char."
  (let (tinfo beg end marker)
    (goto-char (point-min))
    (while (setq tinfo (eblogger-xhtml-tag "pre" (point)))
      (setq beg (eblogger-tinfo-beg1 tinfo))
      (setq end (eblogger-tinfo-end1 tinfo))

      (goto-char end)
      (setq marker (point-marker))

      (goto-char beg)
      (while (re-search-forward "\n" (marker-position marker) t)
        (replace-match "<br />"))
      (goto-char (marker-position marker)))))

(defun eblogger-fix-xhtml-ndash ()
  "google does not like &ndash;."
  (goto-char (point-min))
  (while (re-search-forward "&ndash;" nil t)
    (replace-match "--")))

(defun eblogger-filter-fix-xhtml ()
  (eblogger-fix-xhtml-pre)
  (eblogger-fix-xhtml-ndash))

(defun eblogger-filter-xhtml ()
  "Convert xhtml to the one accepted by blogger."
  (let ((title (eblogger-xhtml-cut-content "title"))
        (style (eblogger-xhtml-cut-tag "style"))
        (body  (eblogger-xhtml-cut-content "body"))
        (template (eblogger-new-entry-template-rst)))
    (erase-buffer)
    (message (format "title: %s" title))
    (insert
     (format template
             title
             (concat style body)))))

(defun eblogger-filter-rst ()
  (rst-mode)
  (eblogger-shell-command "rst2html"))

(defun eblogger-filter-org ()
  (org-mode)
  (org-export-as-html 3 nil nil eblogger-buffer-name))


(defun eblogger-make-auth-handle ()
  (make-g-auth :service eblogger-service-name
               :email eblogger-user-email
               :password eblogger-user-password))

(setq eblogger-auth-handle
  (eblogger-make-auth-handle)
 )


(defun eblogger-send-buffer (url http-method)
  "like gblogger-send-buffer-contents"
  (with-current-buffer (eblogger-buffer)
    (let ( (cmd (format "%s %s -H Content-length:%s %s %s -i -X %s --data-binary @- %s"
                        eblogger-curl eblogger-curl-common-options
                        (buffer-size) (g-authorization eblogger-auth-handle)
                        g-cookie-options http-method url))
           (content (buffer-string)) )
      (message cmd)
      (eblogger-shell-command cmd)
      (goto-char (point-max))
      (insert content))))


(defun eblogger-publish-new (post-url)
  "Publish current rst or org-mode buffer to www.blogger.com."
  (interactive
   (list (or eblogger-post-url-new
             (read-from-minibuffer "Post URL:"))))
  (g-auth-ensure-token eblogger-auth-handle)
  (eblogger-run-filters (eblogger-get-filters))
  (eblogger-send-buffer post-url "POST"))


(defun eblogger-publish-test (post-url)
  "Just run filters without publishing for testing purpose."
  (interactive
   (list (or eblogger-post-url-new
             (read-from-minibuffer "Post URL:"))))
  (eblogger-run-filters (eblogger-get-filters)))