guile/guile-core/scripts punify

[Thien-Thi Nguyen]

CVSROOT:        /cvs
Module name:    guile
Branch:         branch_release-1-6
Changes by:     Thien-Thi Nguyen <address@hidden>       01/11/28 19:04:32

Modified files:
        guile-core/scripts: punify 

Log message:
        (write-punily): Handle symbols with ":" prefix specially.

CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/scripts/punify.diff?cvsroot=OldCVS&only_with_tag=branch_release-1-6&tr1=1.2.2.3&tr2=1.2.2.4&r1=text&r2=text

Patches:
Index: guile/guile-core/scripts/punify
diff -u guile/guile-core/scripts/punify:1.5 guile/guile-core/scripts/punify:1.6
--- guile/guile-core/scripts/punify:1.5 Wed Aug  1 01:09:30 2001
+++ guile/guile-core/scripts/punify     Wed Nov 28 19:01:54 2001
@@ -34,8 +34,8 @@
 ;;
 ;; Example:
 ;; $ wc ./punify ; ./punify ./punify | wc
-;;     81     355    2622 ./punify
-;;      0      34     694
+;;     89     384    3031 ./punify
+;;      0      42     920
 ;;
 ;; TODO: Read from stdin.
 ;;       Handle vectors.
@@ -47,21 +47,29 @@
   :export (punify))
 
 (define (write-punily form)
-  (if (and (list? form) (not (null? form)))
-      (let ((first (car form)))
-        (display "(")
-        (write-punily first)
-        (let loop ((ls (cdr form)) (last-was-list? (list? first)))
-          (if (null? ls)
-              (display ")")
-              (let* ((new-first (car ls))
-                     (this-is-list? (list? new-first)))
-                (and (not last-was-list?)
-                     (not this-is-list?)
-                     (display " "))
-                (write-punily new-first)
-                (loop (cdr ls) this-is-list?)))))
-      (write form)))
+  (cond ((and (list? form) (not (null? form)))
+         (let ((first (car form)))
+           (display "(")
+           (write-punily first)
+           (let loop ((ls (cdr form)) (last-was-list? (list? first)))
+             (if (null? ls)
+                 (display ")")
+                 (let* ((new-first (car ls))
+                        (this-is-list? (list? new-first)))
+                   (and (not last-was-list?)
+                        (not this-is-list?)
+                        (display " "))
+                   (write-punily new-first)
+                   (loop (cdr ls) this-is-list?))))))
+        ((and (symbol? form)
+              (let ((ls (string->list (symbol->string form))))
+                (and (char=? (car ls) #\:)
+                     (not (memq #\space ls))
+                     (list->string (cdr ls)))))
+         => (lambda (symbol-name-after-colon)
+              (display #\:)
+              (display symbol-name-after-colon)))
+        (else (write form))))
 
 (define (punify-one file)
   (with-input-from-file file