Changeset 22008 for lang/gauche/oldtype/trunk/Kahua/oldtype/oldtype/format.scm

Timestamp:

10/24/08 07:06:05 (5 years ago)

Author:

kiyoka

Message:

Supported HTML format for description part of RSS 2.0 feed.

Files:

• lang/gauche/oldtype/trunk/Kahua/oldtype/oldtype/format.scm (modified) (6 diffs)

lang/gauche/oldtype/trunk/Kahua/oldtype/oldtype/format.scm

@@ -73 +73 @@
             wikiname)))
 
-(define (oldtype:wiki-macro->plain expr)
+(define (oldtype:wiki-macro->plain expr rich-mode)
   (let ((command (car expr))
         (arg  ;; symbol list to string list.
@@ -84 +84 @@
         (len (length (cdr expr))))
     (case command
-      ((img)        "[img] ")
+      ((img img-s img-m)
+       (if (and (#/^http:/ (car arg)) rich-mode)
+           (string-append "<img src=\"" (car arg) "\"/>")
+           "[img] "))
       ((todo)       "[TODO] ")
       ((done)       "[DONE] ")
-      ((youtube)    "[YouTube] ")
+      ((youtube youtube-s youtube-m)
+           (if (< 0 len)
+               (let ((_videoid (car arg)))
+                 (if (not rich-mode)
+                     (format #f "[YouTube ~a] " _videoid)
+                     (string-append "<img src=\"" (oldtype:youtube-thumbnail _videoid) "\""
+                                    (case command
+                                      ((youtube)   " ")
+                                      ((youtube-s) (format #f " height=~a " oldtype:image-height-s))
+                                      ((youtube-m) (format #f " height=~a " oldtype:image-height-m)))
+                                    "/>")))
+               "!!Error : No argument ##(youtube VIDEOID) command"))
       ((thumb)
        (if (< 0 len)
@@ -93 +107 @@
                  (string-append "[Thumb " _url "] "))
            "!!Error : No argument ##(thumb URL) command"))
-      ((amazon)
+      ((amazon amazon-s amazon-m)
        (if (< 0 len)
            (let* ((_asin (car arg))
@@ -100 +114 @@
                              _asin)))
              (if (#/^[0-9a-zA-Z]+$/ _asin)
-                 (format "[Amazon ~a] " _asin)
+                 (if (not rich-mode)
+                     (format #f "[Amazon ~a]" _asin)
+                     (string-append "<img src=\"" (oldtype:amazon-thumbnail _asin) "\""
+                                    (case command
+                                      ((amazon)   " ")
+                                      ((amazon-s) (format #f " height=~a " oldtype:image-height-s))
+                                      ((amazon-m) (format #f " height=~a " oldtype:image-height-m)))
+                                    "/>"))
                  (format "!!Error : ASIN code format error for ##(amazon asin) command \"~a\"!!" _asin)))
-           "!!Error : No argument ##(amazon URL) command"))
+           "!!Error : No argument ##(amazon ASINCODE) command"))
       ;; timestamp
       ((timestamp)   "[timestamp] ")
@@ -165 +186 @@
 ;;   )
 ;;
-(define (oldtype:sxml->plain-text sxmls)
+(define (oldtype:sxml->plain-text sxmls rich-mode)
   (tree->string
    (let rec
@@ -191 +212 @@
                       ((pre-ol2)     (cons "## "    (rec arg)))
                       ((pre-ol3)     (cons "### "   (rec arg)))
-                      ((h1)          (cons "[] "    (rec arg)))
-                      ((h2)          (cons "* "     (rec arg)))
-                      ((h3)          (cons "** "    (rec arg)))
-                      ((h4)          (cons "*** "   (rec arg)))
-                      ((h5)          (cons "**** "  (rec arg)))
-                      ((h6)          (cons "***** " (rec arg)))
-                      ((wiki-macro)  (oldtype:wiki-macro->plain arg))
+                      ((h1)          (if rich-mode
+                                         (list "<h1>"   (rec arg) "</h1>")
+                                         (cons "[] "    (rec arg))))
+                      ((h2)          (if rich-mode
+                                         (list "<h2>"   (rec arg) "</h2>")
+                                         (cons "* "     (rec arg))))
+                      ((h3)          (if rich-mode
+                                         (list "<h3>"   (rec arg) "</h3>")
+                                         (cons "** "    (rec arg))))
+                      ((h4)          (if rich-mode
+                                         (list "<h4>"   (rec arg) "</h4>")
+                                         (cons "*** "   (rec arg))))
+                      ((h5)          (if rich-mode
+                                         (list "<h5>"   (rec arg) "</h5>")
+                                         (cons "**** "  (rec arg))))
+                      ((h6)          (if rich-mode
+                                         (list "<h6>"   (rec arg) "</h6>")
+                                         (cons "***** " (rec arg))))
+                      ((wiki-macro)  (oldtype:wiki-macro->plain arg rich-mode))
                       ((wiki-name)   (oldtype:wikiname->plain (car arg)))
-                      ((hr)          (list "----\n"))
+                      ((hr)          (if rich-mode
+                                         (list "<hr>")
+                                         (list "----\n")))
                       ((@)           '())
                       ((@@)          '())