mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
style: '-S format' canonicalizes comments.
* guix/scripts/style.scm (canonicalize-comment): New procedure. (pretty-print-with-comments): Add #:format-comment. and honor it. (object->string*): Add 'args' and honor them. (format-package-definition): Pass #:format-comment to 'object->string*'. * tests/style.scm ("pretty-print-with-comments, canonicalize-comment"): New test.
This commit is contained in:
parent
c4fe13c294
commit
5d9a5e2301
2 changed files with 56 additions and 8 deletions
|
@ -47,6 +47,7 @@ (define-module (guix scripts style)
|
||||||
#:use-module (srfi srfi-37)
|
#:use-module (srfi srfi-37)
|
||||||
#:export (pretty-print-with-comments
|
#:export (pretty-print-with-comments
|
||||||
read-with-comments
|
read-with-comments
|
||||||
|
canonicalize-comment
|
||||||
|
|
||||||
guix-style))
|
guix-style))
|
||||||
|
|
||||||
|
@ -227,8 +228,23 @@ (define (string-width str)
|
||||||
"Return the \"width\" of STR--i.e., the width of the longest line of 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))))
|
(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 #\;)))))
|
||||||
|
(comment (string-append
|
||||||
|
(if (comment-margin? c)
|
||||||
|
";"
|
||||||
|
(if (string-null? line)
|
||||||
|
";;" ;no trailing space
|
||||||
|
";; "))
|
||||||
|
line "\n")
|
||||||
|
(comment-margin? c))))
|
||||||
|
|
||||||
(define* (pretty-print-with-comments port obj
|
(define* (pretty-print-with-comments port obj
|
||||||
#:key
|
#:key
|
||||||
|
(format-comment identity)
|
||||||
(indent 0)
|
(indent 0)
|
||||||
(max-width 78)
|
(max-width 78)
|
||||||
(long-list 5))
|
(long-list 5))
|
||||||
|
@ -236,7 +252,9 @@ (define* (pretty-print-with-comments port obj
|
||||||
and assuming the current column is INDENT. Comments present in OBJ are
|
and assuming the current column is INDENT. Comments present in OBJ are
|
||||||
included in the output.
|
included in the output.
|
||||||
|
|
||||||
Lists longer than LONG-LIST are written as one element per line."
|
Lists longer than LONG-LIST are written as one element per line. Comments are
|
||||||
|
passed through FORMAT-COMMENT before being emitted; a useful value for
|
||||||
|
FORMAT-COMMENT is 'canonicalize-comment'."
|
||||||
(let loop ((indent indent)
|
(let loop ((indent indent)
|
||||||
(column indent)
|
(column indent)
|
||||||
(delimited? #t) ;true if comes after a delimiter
|
(delimited? #t) ;true if comes after a delimiter
|
||||||
|
@ -301,14 +319,16 @@ (define (special-form? head)
|
||||||
(if (comment-margin? comment)
|
(if (comment-margin? comment)
|
||||||
(begin
|
(begin
|
||||||
(display " " port)
|
(display " " port)
|
||||||
(display (comment->string comment) port))
|
(display (comment->string (format-comment comment))
|
||||||
|
port))
|
||||||
(begin
|
(begin
|
||||||
;; When already at the beginning of a line, for example because
|
;; When already at the beginning of a line, for example because
|
||||||
;; COMMENT follows a margin comment, no need to emit a newline.
|
;; COMMENT follows a margin comment, no need to emit a newline.
|
||||||
(unless (= column indent)
|
(unless (= column indent)
|
||||||
(newline port)
|
(newline port)
|
||||||
(display (make-string indent #\space) port))
|
(display (make-string indent #\space) port))
|
||||||
(display (comment->string comment) port)))
|
(display (comment->string (format-comment comment))
|
||||||
|
port)))
|
||||||
(display (make-string indent #\space) port)
|
(display (make-string indent #\space) port)
|
||||||
indent)
|
indent)
|
||||||
(('quote lst)
|
(('quote lst)
|
||||||
|
@ -443,11 +463,12 @@ (define new-column
|
||||||
(display str port)
|
(display str port)
|
||||||
(+ column (if delimited? 0 1) len))))))))
|
(+ column (if delimited? 0 1) len))))))))
|
||||||
|
|
||||||
(define (object->string* obj indent)
|
(define (object->string* obj indent . args)
|
||||||
(call-with-output-string
|
(call-with-output-string
|
||||||
(lambda (port)
|
(lambda (port)
|
||||||
(pretty-print-with-comments port obj
|
(apply pretty-print-with-comments port obj
|
||||||
#:indent indent))))
|
#:indent indent
|
||||||
|
args))))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
|
@ -701,13 +722,15 @@ (define* (format-package-definition package
|
||||||
(package-full-name package)))
|
(package-full-name package)))
|
||||||
|
|
||||||
(edit-expression
|
(edit-expression
|
||||||
(location->source-properties (package-definition-location package))
|
(location->source-properties
|
||||||
|
(absolute-location (package-definition-location package)))
|
||||||
(lambda (str)
|
(lambda (str)
|
||||||
(let ((exp (call-with-input-string str
|
(let ((exp (call-with-input-string str
|
||||||
read-with-comments)))
|
read-with-comments)))
|
||||||
(object->string* exp
|
(object->string* exp
|
||||||
(location-column
|
(location-column
|
||||||
(package-definition-location package)))))))
|
(package-definition-location package))
|
||||||
|
#:format-comment canonicalize-comment)))))
|
||||||
|
|
||||||
(define (package-location<? p1 p2)
|
(define (package-location<? p1 p2)
|
||||||
"Return true if P1's location is \"before\" P2's."
|
"Return true if P1's location is \"before\" P2's."
|
||||||
|
|
|
@ -485,6 +485,31 @@ (define file
|
||||||
'(#:phases %standard-phases
|
'(#:phases %standard-phases
|
||||||
#:tests? #f)))")
|
#:tests? #f)))")
|
||||||
|
|
||||||
|
(test-equal "pretty-print-with-comments, canonicalize-comment"
|
||||||
|
"\
|
||||||
|
(list abc
|
||||||
|
;; Not a margin comment.
|
||||||
|
;; Ditto.
|
||||||
|
;;
|
||||||
|
;; There's a blank line above.
|
||||||
|
def ;margin comment
|
||||||
|
ghi)"
|
||||||
|
(let ((sexp (call-with-input-string
|
||||||
|
"\
|
||||||
|
(list abc
|
||||||
|
;Not a margin comment.
|
||||||
|
;;; Ditto.
|
||||||
|
;;;;;
|
||||||
|
; There's a blank line above.
|
||||||
|
def ;; margin comment
|
||||||
|
ghi)"
|
||||||
|
read-with-comments)))
|
||||||
|
(call-with-output-string
|
||||||
|
(lambda (port)
|
||||||
|
(pretty-print-with-comments port sexp
|
||||||
|
#:format-comment
|
||||||
|
canonicalize-comment)))))
|
||||||
|
|
||||||
(test-end)
|
(test-end)
|
||||||
|
|
||||||
;; Local Variables:
|
;; Local Variables:
|
||||||
|
|
Loading…
Reference in a new issue