[cl-blogger commit] r13 - blogger.lisp (get-content-from-file): Delete changing line, and do not

0 views

Skip to first unread message

codesite...@google.com

unread,

Apr 8, 2009, 8:20:47 AM4/8/09

to cl-bl...@googlegroups.com

Author: read.eval.print
Date: Wed Apr 8 05:19:42 2009
New Revision: 13

Added:
trunk/test/ (props changed)
trunk/test/blogger-test.lisp
trunk/test/test.muse
Modified:
trunk/ChangeLog
trunk/blogger.asd
trunk/blogger.lisp

Log:
blogger.lisp (get-content-from-file): Delete changing line, and do not
insert space for a CJK character. Delete changing line, and insert
space except for a CJK character. Because #\Newline and #\Space are
unnecessary at changin line for Japanese.

Modified: trunk/ChangeLog
==============================================================================
--- trunk/ChangeLog (original)
+++ trunk/ChangeLog Wed Apr 8 05:19:42 2009
@@ -1,6 +1,14 @@
+2009-04-08 Yoshinori Tahara <read.ev...@gmail.com>
+
+ * blogger.lisp (get-content-from-file): Delete changing line, and
+ do not insert space for a CJK character. Delete changing line, and
+ insert space except for a CJK character.
+ Because #\Newline and #\Space are unnecessary at changin line for
+ Japanese.
+
2009-04-05 Plato Wu <stand...@tianya.cn>

- * blogger.el (muse-html-markup-footnote):
+ * blogger.el (muse-html-markup-footnote):
redefine it to support multi post's footnote.

2009-03-28 Yoshinori Tahara <read.ev...@gmail.com>
@@ -10,14 +18,14 @@
I'd like markup section to h4, subsection to h5...

2009-03-23 Plato Wu <stand...@tianya.cn>
-
+
* blogger.lisp
Use xhtml1.1 to avoid the problem that the Blogger.com request
every html tag is symmetry. It is good based on my testing.
-
+
2009-03-17 Plato Wu <stand...@tianya.cn>
-
- * blogger.lisp
+
+ * blogger.lisp
Add supporting of label for post. The normal format of label is:
; labels: label1,label2,label3

Modified: trunk/blogger.asd
==============================================================================
--- trunk/blogger.asd (original)
+++ trunk/blogger.asd Wed Apr 8 05:19:42 2009
@@ -4,4 +4,4 @@
:serial t
:components ((:file "packages")
(:file "blogger"))
- :depends-on (drakma cl-ppcre s-xml))
+ :depends-on (drakma cl-ppcre s-xml cl-unicode))

Modified: trunk/blogger.lisp
==============================================================================
--- trunk/blogger.lisp (original)
+++ trunk/blogger.lisp Wed Apr 8 05:19:42 2009
@@ -186,21 +186,52 @@
:type (format nil "~a.html" (pathname-type muse-file))
:defaults muse-file))))

+(defun need-space-char-p (char)
+ (not
+ (loop for i in '("CJK" "Hiragana" "Katakana"
+ "Halfwidth and Fullwidth Forms")
+ with code-block = (cl-unicode:code-block char)
+ thereis (search i code-block))))
+
+(defun need-space-p (current next)
+ (cond ((null next)
+ nil)
+ ((string= next "")
+ nil)
+ ((scan "^" next)
+ nil)
+ ((scan "$" current)
+ nil)
+ ((string= current "")
+ t)
+ ((need-space-char-p (char current (1- (length current))))
+ t)
+ ((need-space-char-p (char next 0))
+ t)))
+
(defun get-content-from-file (file)
+ "Remove #\Newline.
+We need a #\Newline in pre tag.
+We need a space between lines in English.
+We do not need any space between lines in Japanese."
(with-output-to-string (out)
(with-open-file (in file)
- (loop
- (multiple-value-bind (line newline pre-p) (read-line in nil nil)
- (if (null line) (return))
- (write-string line out)
- (unless newline
- (write-char #\Newline out))
- (cond ((eql 0 (search "<pre" line))
- (setf pre-p t))
- ((eql 0 (search "</pre>" line))
- (setf pre-p nil))
- (t
- (when pre-p (terpri out)))))))))
+ (loop with pre-p = nil
+ for current = (read-line in nil) then next
+ for next = (read-line in nil)
+ while current
+ do (write-string current out)
+ do (cond ((scan "<pre[^>]*>.+$" current)
+ (setf pre-p t)
+ (terpri out))
+ ((eql 0 (search "<pre" current))
+ (setf pre-p t))
+ ((eql 0 (search "</pre>" current))
+ (setf pre-p nil))
+ (pre-p
+ (terpri out))
+ ((need-space-p current next)
+ (write-string " " out)))))))

(defun add-post-id-to-file (muse-file)
(register-groups-bind (post-id) (".*/(.*)" (edit-href *blogger*))

Added: trunk/test/blogger-test.lisp
==============================================================================
--- (empty file)
+++ trunk/test/blogger-test.lisp Wed Apr 8 05:19:42 2009
@@ -0,0 +1,56 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (asdf:oos 'asdf:load-op :blogger)
+ (asdf:oos 'asdf:load-op :stefil)
+ (use-package :stefil))
+
+(defsuite blogger-test)
+
+(in-suite blogger-test)
+
+(deftest test-get-content-from-file ()
+ (labels ((path (&optional (name "a.txt"))
+ (merge-pathnames name *load-pathname*))
+ (f (test-data expected)
+ (with-open-file (out (path) :direction :output
+ :if-exists :supersede)
+ (write-string test-data out))
+ (is (string= expected (blogger::get-content-from-file
(path))))))
+ (f
+ "This is
+a test.
+
+これは
+テストです。
+
+
+
+This is
+テスト。
+
+
+これは
+test.
+
+emphasis
+strong emphasis
+very strong emphasis
+underlined
+<code>verbatim and monospace</code>
+
+<pre class=\"src\">
+(defun foo ()
+ 'foo)
+あ
+い
+</pre>
+
+おしまい
+"
+ "This is a test.これはテストです。This is テスト。
これは test.emphasis strong
emphasis very strong emphasis underlined <code>verbatim and
monospace</code> <pre class=\"src\">(defun foo ()
+ 'foo)
+あ
+い
+</pre>おしまい")
+ ))
+
+(blogger-test)

Added: trunk/test/test.muse
==============================================================================
--- (empty file)
+++ trunk/test/test.muse Wed Apr 8 05:19:42 2009
@@ -0,0 +1,49 @@
+#title Test entroy
+
+This is
+a test.
+
+And test.
+
+これは
+テストです。
+
+
+
+This is
+テスト。
+
+
+これは
+test.
+
+*emphasis*
+*emphasis*
+*強調*
+*強調*
+_underlined_
+_underlined_
+_下線_
+_下線_
+
+<src lang="lisp">
+(defun foo ()
+ 'foo)
+あ
+い
+</src>
+
+おしまい
+
+* 見出し1
+
+あああ
+
+** 見出し2
+
+いいい
+
+*** 見出し3
+
+ううう
+; post-id 8831186664503574049

Reply all

Reply to author

Forward

0 new messages