Changeset 15903 for lang/gauche

Timestamp:

07/16/08 22:58:57 (4 months ago)

Author:

kiyoka

Message:

Supported posting comment feature.

Location:

lang/gauche/oldtype/trunk

Files:

• 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/svn.scm (modified) (3 diffs)
• Kahua/oldtype/oldtype/util.kahua (modified) (2 diffs)
• Kahua/oldtype/oldtype/util.scm (modified) (2 diffs)
• bin/batch.sh (modified) (1 diff)
• src/test.scm (modified) (2 diffs)

lang/gauche/oldtype/trunk/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/trunk/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%;
+}

lang/gauche/oldtype/trunk/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/trunk/Kahua/oldtype/oldtype/svn.scm

@@ -41 +41 @@
           status
           get-fullpath
+          save-text-list
           <svn-work>
           ))
@@ -107 +108 @@
            (display str)
            (if (string= "" str)
-               #f
+               '("" "")
                (string-split str #/[ ]+/))))))
 
@@ -121 +122 @@
 
 
+(define-method save-text-list ((self <svn-work>) wikiname text-list)
+  (with-output-to-file (format "~a/edit/~a.ot" (get-fullpath self) wikiname)
+    (lambda ()
+      (for-each
+       (lambda (str)
+         (display str)
+         (newline))
+       text-list))))
+
+
 (provide "oldtype/svn")

lang/gauche/oldtype/trunk/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/trunk/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/trunk/bin/batch.sh

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

lang/gauche/oldtype/trunk/src/test.scm

@@ -190 +190 @@
                   #t
                   (lambda ()
-                    (string? (init work "123"))))
+                    (string? (init work (number->string (sys-time))))))
 
             (test "status of wikiname (no changes)"
-                  #f
+                  '("" "")
                   (lambda ()
                     (status work "_kiyoka")))
@@ -200 +200 @@
                   "M"
                   (lambda ()
-                    (sys-system (format "echo 'a' >> ~a/~a/~a" (get-fullpath work) "edit" "test.ot"))
+                    (save-text-list work
+                                    "test"
+                                    '("UnitTest用ページ。" "----" "##(comment)"))
                     (car (status work "test"))))
             
             (when
-                #f
+                #t
               (test "commit from work"
                     #t