[bug#56898] [PATCH 09/13] read-print: 'canonicalize-comment' leaves top-level comments unchanged.

["Ludovic Courtès" <ludo@gnu.org>]

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 @@ (define (string-width str)
   "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 @@ (define (special-form? head)
        (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 @@ (define (special-form? head)
              (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 @@ (define-syntax-rule (test-pretty-print/sequence str args ...)
 
 (test-pretty-print/sequence "
 ;;; Hello!
+;;; Notice that there are three semicolons here.
 
 (define-module (foo bar)
   #:use-module (guix)
@@ -286,7 +287,8 @@ (define-module (foo bar)
   (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"
   "\
-- 
2.37.1