Changeset 14228 for lang/gauche

Timestamp:

06/18/08 23:39:31 (5 months ago)

Author:

kiyoka

Message:

Supported plain text layouter.

Location:

lang/gauche/oldtype/trunk

Files:

• Kahua/oldtype/oldtype/format.scm (modified) (2 diffs)
• Kahua/oldtype/oldtype/parse.scm (modified) (4 diffs)
• edit/Sample1.ot (added)
• edit/Sample2.ot (added)
• src (modified) (1 prop)
• src/Makefile (modified) (1 diff)
• src/oldtype_to (modified) (1 diff)

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

@@ -52 +52 @@
           oldtype:expand-page
           oldtype:format-line-plainly
-          )
-  )
+          oldtype:oldtype-page->plain-text
+  ))
 (select-module oldtype.format)
 
@@ -65 +65 @@
 (define (oldtype:calculate-heading-id headings)
   (string-append "H-" (number->string (hash headings) 36)))
+
+
+(define (oldtype:wikiname->plain wikiname)
+  (let1 m (#/[|](.+)/ wikiname)
+        (if m
+            (rxmatch-substring m 1)
+            wikiname)))
+
+(define (oldtype:wiki-macro->plain expr)
+  (let ((command (car expr))
+        (arg  ;; symbol list to string list.
+         (map
+          (lambda (x)
+            (if (number? x)
+                (number->string x)
+                (symbol->string x)))
+          (cdr expr)))
+        (len (length (cdr expr))))
+    (case command
+      ((img)        "[img] ")
+      ((todo)       "[TODO] ")
+      ((done)       "[DONE] ")
+      ((youtube)    "[YouTube] ")
+      ((thumb)
+       (if (< 0 len)
+           (let1 _url (car arg)
+                 (string-append "[Thumb " _url "] "))
+           "!!Error : No argument ##(thumb URL) command"))
+      ((amazon)
+       (if (< 0 len)
+           (let* ((_asin (car arg))
+                  (_asin (if (#/^[0-9]+$/ _asin)
+                             (format "~10,,,'0@a" _asin)
+                             _asin)))
+             (if (#/^[0-9a-zA-Z]+$/ _asin)
+                 (format "[Amazon ~a] " _asin)
+                 (format "!!Error : ASIN code format error for ##(amazon asin) command \"~a\"!!" _asin)))
+           "!!Error : No argument ##(amazon URL) command"))
+      ;; timestamp
+      ((timestamp)   "[timestamp] ")
+      ;; since
+      ((since)       "[since] ")
+      ;; download link oldtype-mode.el source code
+      ((download-el) "[Download oldtype-mode.el now]")
+      (else
+       (format "!!Error : no such macro \"~a\"!!" command)))))
+
+
+(define (oldtype:oldtype-page->plain-text sxmls)
+  (let rec
+      ((sxmls sxmls))
+    (match sxmls
+           (()  '())
+           (((and (name . _) sxml) . rest) ;; generic node
+            (let1 arg (cdr sxml)
+                  (cons
+                   (case name
+                     ((div)
+                      (let* ((param (car arg)) ;; param is assoc-list
+                             (lineno (assq-ref param 'lineno)))
+                        (rec (cdr arg))))
+                     ((a)
+                      (let1 param (car arg) ;; param is assoc-list
+                            (rec (cdr arg))))
+                     ((p-normal)    (rec arg))
+                     ((pre-quote)   (rec arg))
+                     ((pre-verb)    (rec arg))
+                     ((pre-ul1)     (cons "- "     (rec arg)))
+                     ((pre-ul2)     (cons "-- "    (rec arg)))
+                     ((pre-ul3)     (cons "--- "   (rec arg)))
+                     ((pre-ol1)     (cons "# "     (rec arg)))
+                     ((pre-ol2)     (cons "## "    (rec arg)))
+                     ((pre-ol3)     (cons "### "   (rec arg)))
+                     ((h1)          (cons "[] "    (rec (cdr arg))))
+                     ((h2)          (cons "* "     (rec (cdr arg))))
+                     ((h3)          (cons "** "    (rec (cdr arg))))
+                     ((h4)          (cons "*** "   (rec (cdr arg))))
+                     ((h5)          (cons "**** "  (rec (cdr arg))))
+                     ((h6)          (cons "***** " (rec (cdr arg))))
+                     ((wiki-macro)  (oldtype:wiki-macro->plain arg))
+                     ((wiki-name)   (oldtype:wikiname->plain (car arg)))
+                     ((hr)          (list "----\n"))
+                     (else
+                      (format "!!Error : no such tag \"~a\"!!" name)))
+                   (rec rest))))
+           ((other . rest)
+            (cons other (rec rest))))))
+
+
 
 ;; utility : strips wiki markup and returns a plaintext line.

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

@@ -181 +181 @@
               ((string=? "----" line)            '(hr))
               ((string-prefix? "!" line)         `(open-single-verb . ,line))
-              ((string=? "{{{" line)             '(open-verb))
-              ((string=? "<<<" line)             '(open-quote))
-              ((and (string=? ">>>" line)
-                    (memq 'blockquote ctx))      '(close-quote))
               ((string-prefix? " " line)         `(pre . ,line))
               ((rxmatch #/^(\*{1,}) / line)      => (cut cons 'heading <>))
@@ -212 +208 @@
       (case (token-type tok)
         ((eof)  (reverse! seed))
-        ((null) (block (next-token ctx) ctx seed))
+        ((null) (block (next-token ctx) ctx (cons `(div (@@ (lineno ,line-no)) (p-normal "\n")) seed)))
         ((hr)   (block (next-token ctx) ctx (cons `(div (@@ (lineno ,line-no)) (hr)) seed)))
         ((open-single-verb)
@@ -243 +239 @@
                 (pre-verb 
                  ,@(expand-tab 
-                    (string-drop (token-value tok) 1))))))
+                    (string-drop (token-value tok) 1))
+                 "\n"))))
 
   ;; Verbatim
@@ -444 +441 @@
       (cond ((eof-object? line)
              (if (null? r) line (string-concatenate-reverse r)))
-            (verbatim
-             (when (string=? "}}}" line) (set! verbatim #f))
-             line)
-            ((string-prefix? ";;" line)
-             (rec (getline) r))
-            ((string=? "{{{" line)
-             (if (null? r)
-               (begin (set! verbatim #t) line)
-               (begin (ungetline line) (string-concatenate-reverse r))))
-            ((string-prefix? "~" line)
-             (rec (getline) (cons (string-drop line 1) r)))
             (else
              (if (null? r)
-               (rec (getline) (cons line r))
-               (begin (ungetline line) (string-concatenate-reverse r))))
+                 (rec (getline) (cons line r))
+                 (begin (ungetline line) (string-concatenate-reverse r))))
             )))
   )

lang/gauche/oldtype/trunk/src

@@ -12 +12 @@
 out.txt
 test.log
+Sample1.sxml
+Sample1.txt
+Sample2.sxml
+Sample2.txt

@@ -12 +12 @@
 out.txt
 test.log
+Sample1.sxml
+Sample1.txt
+Sample2.sxml
+Sample2.txt

lang/gauche/oldtype/trunk/src/Makefile

@@ -3 +3 @@
 OTSAMPLE='../edit/Test.ot'
 
-all: log.txt  Test.ann.txt  Entry1.ann.txt  Entry2.ann.txt 
+all: log.txt  Test.ann.txt  Entry1.ann.txt  Entry2.ann.txt
         gosh -I ../Kahua/oldtype ./oldtype_to internal  ../edit/Test.ot    log.txt Test.ann.txt    > Test.sexp
         gosh -I ../Kahua/oldtype ./oldtype_to internal  ../edit/Entry1.ot  log.txt Entry1.ann.txt  > Entry1.sexp
         gosh -I ../Kahua/oldtype ./oldtype_to internal  ../edit/Entry2.ot  log.txt Entry2.ann.txt  > Entry2.sexp
-        gosh -I ../Kahua/oldtype ./oldtype_to sxml      ${OTSAMPLE} > out.sxml
-        gosh -I ../Kahua/oldtype ./oldtype_to plain     ${OTSAMPLE} > out.txt
+        gosh -I ../Kahua/oldtype ./oldtype_to sxml      ../edit/Sample1.ot > Sample1.sxml
+        gosh -I ../Kahua/oldtype ./oldtype_to sxml      ../edit/Sample2.ot > Sample2.sxml
+        gosh -I ../Kahua/oldtype ./oldtype_to plain     ../edit/Sample1.ot > Sample1.txt
+        gosh -I ../Kahua/oldtype ./oldtype_to plain     ../edit/Sample2.ot > Sample2.txt
 
 test: log.txt Test.ann.txt

lang/gauche/oldtype/trunk/src/oldtype_to

@@ -158 +158 @@
       ('plain
        (let* (
-              (tree           (oldtype:format-line-plainly converted-str)))
-         (for-each
-          print
-          tree)))
+              (sxml           (oldtype-parse input-port))
+              (sexp           (oldtype:oldtype-page->plain-text sxml)))
+         (print
+          (tree->string
+           sexp))))
       (else
        (cerr (format "Unsupported type. [~a]" (symbol->string type)))

@@ -12 +12 @@
 out.txt
 test.log
+Sample1.sxml
+Sample1.txt
+Sample2.sxml
+Sample2.txt