Changeset 15941 for lang/gauche

Timestamp:

07/17/08 21:12:06 (4 months ago)

Author:

kiyoka

Message:

Pretest of 0.3.1

Location:

lang/gauche/oldtype/branches/stable

Files:

• Kahua/oldtype/Makefile (modified) (1 diff)
• Kahua/oldtype/oldtype/format.scm (modified) (1 diff)
• Kahua/oldtype/oldtype/oldtype.css (modified) (1 diff)
• Kahua/oldtype/oldtype/oldtype.kahua (modified) (2 diffs)
• Kahua/oldtype/oldtype/page.scm (modified) (1 diff)
• Kahua/oldtype/oldtype/svn.scm (added)
• Kahua/oldtype/oldtype/timeline.scm (modified) (1 diff)
• Kahua/oldtype/oldtype/util.kahua (modified) (2 diffs)
• Kahua/oldtype/oldtype/util.scm (modified) (2 diffs)
• Kahua/oldtype/oldtype/version.kahua (modified) (1 diff)
• Kahua/oldtype/plugins/oldtype.scm (modified) (1 diff)
• Makefile (modified) (1 diff)
• bin/batch.sh (modified) (1 diff)
• bin/convert.sh (modified) (1 diff)
• command/blog (modified) (3 diffs)
• src/Makefile (modified) (1 diff)
• src/Test.no-timeline.sexp.master (added)
• src/oldtype_to (modified) (1 diff)
• src/test.scm (modified) (4 diffs)

lang/gauche/oldtype/branches/stable/Kahua/oldtype/Makefile

@@ -36 +36 @@
 
 TEST_DIR    = $(PWD)
-SCRIPTFILES = $(package)/$(package).kahua $(package)/version.kahua $(package)/util.kahua $(package)/format.scm $(package)/core.scm $(package)/parse.scm $(package)/util.scm $(package)/pasttime.scm $(package)/page.scm $(package)/timeline.scm $(package)/log.scm
+SCRIPTFILES = \
+        $(package)/$(package).kahua $(package)/version.kahua $(package)/util.kahua $(package)/format.scm $(package)/core.scm \
+        $(package)/parse.scm $(package)/util.scm $(package)/pasttime.scm $(package)/page.scm $(package)/timeline.scm \
+        $(package)/log.scm $(package)/svn.scm
 STATICFILES = $(package)/$(package).css $(package)/staticimg/*.png $(package)/*.el $(package)/import/*.js $(package)/import/*.css $(package)/$(package).js
 

lang/gauche/oldtype/branches/stable/Kahua/oldtype/oldtype/format.scm

@@ -109 +109 @@
       ;; download link oldtype-mode.el source code
       ((download-el) "[Download oldtype-mode.el now]")
+      ;; comment-data
+      ((comment-data)
+       (if (< 1 len)
+           (string-append (format "----< ~a >----" (uri-decode-string (car arg)))
+                          "\n"
+                          (uri-decode-string (cadr arg)))
+           (format "!!Error : comment-data format error for ##(comment-data user string) command")))
+      ;; else
       (else
-       (format "!!Error : no such macro \"~a\"!!" command)))))
+       (format "[~a]" command)))))
 
 

lang/gauche/oldtype/branches/stable/Kahua/oldtype/oldtype/oldtype.css

@@ -681 +681 @@
     color: white;
 }
+
+pre.comment {
+        margin-left:    0.5em;
+        font-size:      medium;
+        padding-left:   0.5em;
+        margin-top:     1px;
+        margin-bottom:  1px;
+}
+
+table.comment {
+        width: 70%;
+        text-align: left;
+}

lang/gauche/oldtype/branches/stable/Kahua/oldtype/oldtype/oldtype.kahua

@@ -14 +14 @@
 (use oldtype.timeline)
 (use oldtype.page)
+(use oldtype.svn)
 (use srfi-1)
 (use srfi-19)
+(use srfi-27)
 (load "oldtype/version.kahua")
 (load "oldtype/util.kahua")
@@ -259 +261 @@
                                 ((h5)          `(,@(h5/  (@/ (id "h5"))                  (node-set (rec arg)))))
                                 ((h6)          `(,@(h6/  (@/ (id "h6"))                  (node-set (rec arg))))))))
-                         ((wiki-macro)  `(,@(oldtype:format-macro arg)))
+                         ((wiki-macro)  `(,@(oldtype:format-macro arg oldtype-page)))
                          ((wiki-name)   `(,@(oldtype:expand-wiki-name (car arg))))
                          ((hr)          (hr/))

lang/gauche/oldtype/branches/stable/Kahua/oldtype/oldtype/page.scm

@@ -82 +82 @@
 
 
+;; Parsing wiki format
+;;
+;;   In case of log-file or ann-file is #f, this function takes only parse action.
+;;
 (define-method parse ((self <oldtype-page>) wiki-port log-file ann-file)
   (let1 timeline (make <oldtype-timeline> :name (name-of self))
         (set! (timeline-of self)
-              (parse timeline log-file ann-file)))
+              (if (and log-file ann-file)
+                  (parse timeline log-file ann-file)
+                  timeline)))
   (set! (sxml-of self)
         (oldtype:sxml->internal

lang/gauche/oldtype/branches/stable/Kahua/oldtype/oldtype/timeline.scm

@@ -70 +70 @@
    ;; vector of <oldtype-log> in page
    (annotation    :accessor annotation-of    :init-keyword :annotation
-                  :init-value '())
+                  :init-value '#())
    ;; vector of text in page
    (text          :accessor text-of          :init-keyword :text
-                  :init-value '())
+                  :init-value '#())
    ;; distribution of revision
    (distribution  :accessor distribution-of  :init-keyword :distribution

lang/gauche/oldtype/branches/stable/Kahua/oldtype/oldtype/util.kahua

@@ -230 +230 @@
      (img/ (@/ (src (string-append (oldtype:static-image-path) "icon.article_text.png"))
                (alt "PLAIN"))))
+    ((comment)
+     (img/ (@/ (src (string-append (oldtype:static-image-path) "icon.comment_blue.png"))
+               (alt "COMMENT"))))
+    ((double-comment)
+     (img/ (@/ (src (string-append (oldtype:static-image-path) "icon.double_comment.png"))
+               (alt "DCOMMENT"))))
+    ((alert)
+     (img/ (@/ (src (string-append (oldtype:static-image-path) "icon.stop_round.png"))
+               (alt "ALERT"))))
     (else
      `(p/ ,(format "!!Error : no such icon-image \"~a\"!!" sym)))))
-    
-
-(define (oldtype:format-macro expr)
+
+
+(define (oldtype:add-comment oldtype-page name comment)
+  (apply append
+         (map
+          (lambda (str)
+            (if (#/##\(comment\)/ str)
+                `(
+                  ,(format "##(comment-data ~a ~a)"
+                           (uri-encode-string name)
+                           (uri-encode-string comment))
+                  ,str)
+                `(,str)))
+          (get-text-list oldtype-page))))
+
+
+(define (oldtype:format-macro expr oldtype-page)
   (let ((command (car expr))
         (arg  ;; symbol list to string list.
@@ -337 +360 @@
       ;; input comment
       ((comment)
-       (form/ (@/ (action "."))
-              (table/
-               (tr/ (th/ "Post a comment"))
-               (tr/ (td/
-                     "Name:"
-                     (input/
-                      (@/ (type "text") (value "") (size 20)))))
-               (tr/ (td/
-                     (textarea/
-                      (@/ (cols 120) (rows 3)))))
-               (tr/ (td/
-                     (input/ (@/ (type "submit") (value "Submit comment"))))))))
+       (form/cont/
+        (@@/ (cont
+              (entry-lambda (:keyword name comment)
+                (let1 nodes 
+                      (p/
+                       (oldtype:icon-image 'alert)
+                       "Error: commit action missed.")
+                      (if (or (> 1 (string-length name))
+                              (> 1 (string-length comment)))
+                          (set! nodes (p/
+                                       (oldtype:icon-image 'alert)
+                                       "Please input name and comment."))
+                          (let1 work (make <svn-work>
+                                       :url      (oldtype:get-arguments 'svn)
+                                       :user     (oldtype:get-arguments 'anon-user)
+                                       :pass     (oldtype:get-arguments 'anon-pass)
+                                       :basepath (oldtype:workpath))
+                                (init work (string-append
+                                            (number->string (sys-time))
+                                            "."
+                                            (number->string (random-integer 100))))
+                                (save-text-list work (name-of oldtype-page)
+                                                (oldtype:add-comment oldtype-page name comment))
+                                (let1 result (status work (name-of oldtype-page))
+                                      (when (string=? "M" (car result))
+                                        (begin
+                                          (commit work)
+                                          (set! nodes
+                                                (p/
+                                                 (oldtype:icon-image 'info)
+                                                 "Thank you! Your comment was registered.")))))))
+                      (standard-page
+                       (name-of oldtype-page)
+                       (br/)
+                       (div/
+                        nodes
+                        (p/ "Back to " (oldtype:expand-wiki-name (name-of oldtype-page))))
+                       ""
+                       1)))))
+        (table/ (@/ (class "comment"))
+                (tr/ (th/
+                      (oldtype:icon-image 'double-comment)
+                      "Post a comment"))
+                (tr/ (td/
+                      "Name:"
+                      (input/
+                       (@/ (type "text") (name "name") (value "") (size 20)))))
+                (tr/ (td/
+                      (textarea/
+                       (@/ (cols 120) (rows 3) (name "comment")))))
+                (tr/ (td/
+                      (input/ (@/ (type "submit") (value "Submit comment"))))))))
+      
+      ;; display comment
+      ((comment-data)
+       (if (> 2 len)
+           (p/ "!!Error : No argument ##(comment-data user str) command")
+           (table/ (@/ (class "comment"))
+                   (tr/ (th/
+                         (oldtype:icon-image 'comment)
+                         (uri-decode-string (car arg))))
+                   (tr/ (td/
+                         (pre/ (@/ (class "comment"))
+                               (uri-decode-string (cadr arg))))))))
 
       ;; no listing to !RecentChanges

lang/gauche/oldtype/branches/stable/Kahua/oldtype/oldtype/util.scm

@@ -44 +44 @@
           oldtype:get-string-of-today
           oldtype:editpath
+          oldtype:workpath
           oldtype:user-local
           oldtype:user-backend
@@ -84 +85 @@
    (sys-getenv "OT_SITE")
    "/tmp/oldtype/edit"))
+
+(define (oldtype:workpath)
+  (string-append
+   (sys-getenv "OT_SITE")
+   "/tmp/work"))
 
 (define (oldtype:user-local)

lang/gauche/oldtype/branches/stable/Kahua/oldtype/oldtype/version.kahua

@@ -7 +7 @@
 
 ;;---------------------------------------------------------
-(define *oldtype-version* "0.3.0")
+(define *oldtype-version* "0.3.1")

lang/gauche/oldtype/branches/stable/Kahua/oldtype/plugins/oldtype.scm

@@ -18 +18 @@
 (allow-module oldtype.timeline)
 (allow-module oldtype.page)
+(allow-module oldtype.svn)
 (allow-module rfc.uri)

lang/gauche/oldtype/branches/stable/Makefile

@@ -7 +7 @@
         tar xfC ../stable.tar ../branches/stable
         /bin/rm -f ../stable.tar
-        cat ./config.sh | sed 's/OT_MASTER=nil/OT_MASTER=t/' | sed 's/site-unstable/site-stable/' > ../branches/stable/config.sh
+        cat ./config.sh | sed 's/OT_MASTER=nil/OT_MASTER=t/' | sed 's/site-unstable/site-stable/' | sed 's/newtype/oldtype/' > ../branches/stable/config.sh
         cat ./Kahua/oldtype/Makefile | sed 's/site-unstable/site-stable/' > ../branches/stable/Kahua/oldtype/Makefile

lang/gauche/oldtype/branches/stable/bin/batch.sh

@@ -38 +38 @@
   #run-parts ${OT_HOME}/hook
   echo -n [info] sleep...
-  sleep 5
+  sleep 1
   echo wakeup
 }

lang/gauche/oldtype/branches/stable/bin/convert.sh

@@ -49 +49 @@
   echo ${base} | grep "!" > /dev/null
   generated=$?
-  if [ "0" = $generated ] ; then
+  if [ "0" = "$generated" ] ; then
     diffs=`_svn t diff ${base}.ot | wc -l | awk '{ print $1; }'`
 #    echo diffs : ${diffs}
     [ "0" != "${diffs}" -o ! -f ../_out/${base}.sexp ]
     status=$?
+
+    ## TODO: fix me ( Must implement !xxxxx.ot contents converttion check )
+    status=0
+
 #    echo status : ${status}
   else 

lang/gauche/oldtype/branches/stable/command/blog

@@ -2 +2 @@
 
 (use srfi-1)
+(use util.list)
 (use oldtype.util)
 
@@ -36 +37 @@
                  (display 
                   (string-append "* [[" (oldtype:otpath->wikiname filename) "]]"))))
-             (for-each print (port->string-list (current-input-port))))))
+             (for-each
+              (lambda (line)
+                (if (#/##\(comment\)/ line)
+                    (print (string-append "comment please => [[" (oldtype:otpath->wikiname filename) "]]"))
+                    (print line)))
+              (port->string-list (current-input-port))))))
        entrylist)
       (display appendix)
@@ -60 +66 @@
                (cons
                 ot-blog-header
-                (take (ot-blog-entrylist) ot-new-entry-limit))
+                (take* (ot-blog-entrylist) ot-new-entry-limit))
                "")
   (output-blog-list (string-append ot-blog ".list.ot")

lang/gauche/oldtype/branches/stable/src/Makefile

@@ -5 +5 @@
 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/Test.ot                            > Test.no-timeline.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

lang/gauche/oldtype/branches/stable/src/oldtype_to

@@ -145 +145 @@
     (case type
       ('internal
-       (when (< 1 (length rest))
-         (let1 oldtype-page   (parse (make <oldtype-page> :name wikiname) input-port (car rest) (cadr rest))
-               (pretty-print-sexp (serialize oldtype-page)))))
+       (if (< 1 (length rest))
+           (let1 oldtype-page   (parse (make <oldtype-page> :name wikiname) input-port (car rest) (cadr rest))
+                 (pretty-print-sexp (serialize oldtype-page)))
+           (let1 oldtype-page   (parse (make <oldtype-page> :name wikiname) input-port #f #f)
+                 (pretty-print-sexp (serialize oldtype-page)))))
       ('sxml
        (let1 sxml (oldtype-parse input-port)

lang/gauche/oldtype/branches/stable/src/test.scm

@@ -13 +13 @@
 (use oldtype.page)
 (use oldtype.core)
+(use oldtype.svn)
 (use gauche.test)                                                     
 (use util.list)
@@ -35 +36 @@
           (open-input-string converted-str)))
     (let ((oldtype-page #f)
+          (oldtype-page-no-timeline #f)
           (oldtype-timeline #f)
-          (loaded        (with-input-from-file "Test.sexp.master"
-                           (lambda ()
-                             (read)))))
-
+          (loaded
+           (with-input-from-file "Test.sexp.master"
+             (lambda ()
+               (read))))
+          (loaded-no-timeline
+           (with-input-from-file "Test.no-timeline.sexp.master"
+             (lambda ()
+               (read)))))
       (test-start "serialize,deserialize")
 
@@ -53 +59 @@
 
       (test-section "oldtype-page")
-      (set! oldtype-page (parse (make <oldtype-page> :name "Test") input-port log-file ann-file))
+      (set! oldtype-page
+            (parse (make <oldtype-page> :name "Test") input-port log-file ann-file))
+      (port-seek input-port 0)
+      (set! oldtype-page-no-timeline
+            (parse (make <oldtype-page> :name "Test") input-port #f #f))
+
       (let1 serialized     (serialize oldtype-page)
-            (test "serialized == DATA        "
+            (test "serialized == DATA (1)  "
                   loaded
                   (lambda () (serialize oldtype-page)))
-
+            
             (test "serialized == deserialized" serialized (lambda () 
                                                             (serialize
                                                              (deserialize
                                                               (make <oldtype-page>)
-                                                              serialized)))))
+                                                              serialized))))
+            (test "serialized == DATA (2)  "
+                  loaded-no-timeline
+                  (lambda () (serialize oldtype-page-no-timeline))))
       (test-end)
 
@@ -168 +182 @@
       (test-end)
 
+      (test-start "svn commit")
+
+      (let1 work
+            (make <svn-work> :url "http://genkan.sumibi.org/svn/newtype" :user "anonymous" :pass "anonymous" :basepath "/Users/kiyoka/work/tmp")
+            
+            (test "Initialize svn work directory"
+                  #t
+                  (lambda ()
+                    (string? (init work (number->string (sys-time))))))
+
+            (test "status of wikiname (no changes)"
+                  '("" "")
+                  (lambda ()
+                    (status work "_kiyoka")))
+
+            (test "status of wikiname (some changes)"
+                  "M"
+                  (lambda ()
+                    (save-text-list work
+                                    "test"
+                                    '("UnitTest用ページ。" "----" "##(comment)"))
+                    (car (status work "test"))))
+            
+            (when
+                #t
+              (test "commit from work"
+                    #t
+                    (lambda ()
+                      (commit work)))))
+      
+      (test-end)
+      
       )))