11/17: read-print: 'canonicalize-comment' leaves top-level comments unchanged.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 90ef692e9b48732ae2e3921ff5d101e186506a85
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Tue Aug 2 17:39:55 2022 +0200

    read-print: 'canonicalize-comment' leaves top-level comments unchanged.
    
    This lets users use three leading semicolons, for instance, in top-level
    comments.
    
    * guix/read-print.scm (canonicalize-comment): Add INDENT parameter and
    honor it.
    (pretty-print-with-comments): Change default value of #:format-comment.
    Call FORMAT-COMMENT with INDENT as the second argument.
    * tests/read-print.scm: Adjust test accordingly.
---
 guix/read-print.scm  | 35 +++++++++++++++++++----------------
 tests/read-print.scm |  4 +++-
 2 files changed, 22 insertions(+), 17 deletions(-)

diff --git a/guix/read-print.scm b/guix/read-print.scm
index 4a3afdd4f9..2fc3d85a25 100644
--- a/guix/read-print.scm
+++ b/guix/read-print.scm
@@ -371,23 +371,26 @@ particular newlines, is left as is."
   "Return the \"width\" of STR--i.e., the width of the longest line of STR."
   (apply max (map string-length (string-split str #\newline))))
 
-(define (canonicalize-comment c)
-  "Canonicalize comment C, ensuring it has the \"right\" number of leading
-semicolons."
-  (let ((line (string-trim-both
-               (string-trim (comment->string c) (char-set #\;)))))
-    (string->comment (string-append
-                      (if (comment-margin? c)
-                          ";"
-                          (if (string-null? line)
-                              ";;"                        ;no trailing space
-                              ";; "))
-                      line "\n")
-                     (comment-margin? c))))
+(define (canonicalize-comment comment indent)
+  "Canonicalize COMMENT, which is to be printed at INDENT, ensuring it has the
+\"right\" number of leading semicolons."
+  (if (zero? indent)
+      comment                              ;leave top-level comments unchanged
+      (let ((line (string-trim-both
+                   (string-trim (comment->string comment) (char-set #\;)))))
+        (string->comment (string-append
+                          (if (comment-margin? comment)
+                              ";"
+                              (if (string-null? line)
+                                  ";;"            ;no trailing space
+                                  ";; "))
+                          line "\n")
+                         (comment-margin? comment)))))
 
 (define* (pretty-print-with-comments port obj
                                      #:key
-                                     (format-comment identity)
+                                     (format-comment
+                                      (lambda (comment indent) comment))
                                      (format-vertical-space identity)
                                      (indent 0)
                                      (max-width 78)
@@ -475,7 +478,7 @@ FORMAT-VERTICAL-SPACE; a useful value of 
'canonicalize-vertical-space'."
        (if (comment-margin? comment)
            (begin
              (display " " port)
-             (display (comment->string (format-comment comment))
+             (display (comment->string (format-comment comment indent))
                       port))
            (begin
              ;; When already at the beginning of a line, for example because
@@ -483,7 +486,7 @@ FORMAT-VERTICAL-SPACE; a useful value of 
'canonicalize-vertical-space'."
              (unless (= column indent)
                (newline port)
                (display (make-string indent #\space) port))
-             (display (comment->string (format-comment comment))
+             (display (comment->string (format-comment comment indent))
                       port)))
        (display (make-string indent #\space) port)
        indent)
diff --git a/tests/read-print.scm b/tests/read-print.scm
index 94f018dd44..e3f23194af 100644
--- a/tests/read-print.scm
+++ b/tests/read-print.scm
@@ -274,6 +274,7 @@ mnopqrstuvwxyz.\")"
 
 (test-pretty-print/sequence "
 ;;; Hello!
+;;; Notice that there are three semicolons here.
 
 (define-module (foo bar)
   #:use-module (guix)
@@ -286,7 +287,8 @@ mnopqrstuvwxyz.\")"
   (locale \"eo_EO.UTF-8\")
 
   (services
-   (cons (service mcron-service-type) %base-services)))\n")
+   (cons (service mcron-service-type) %base-services)))\n"
+                            #:format-comment canonicalize-comment)
 
 (test-equal "pretty-print-with-comments, canonicalize-comment"
   "\