From 04e6f1425482517da29ea708e2cbbb35729d5909 Mon Sep 17 00:00:00 2001 From: Mark Polesky Date: Thu, 5 Jun 2014 10:02:19 -0700 Subject: [PATCH] Issue 3935: Use (pretty-print) for some IR props. --- scm/document-backend.scm | 2 +- scm/document-context-mods.scm | 27 ++++++++--------- scm/document-translation.scm | 19 ++++++------ scm/documentation-lib.scm | 35 +++++++++------------ scm/lily-library.scm | 57 +++++++++++++++++++++++++---------- 5 files changed, 80 insertions(+), 60 deletions(-) diff --git a/scm/document-backend.scm b/scm/document-backend.scm index e311695005..d9ec2b00b5 100644 --- a/scm/document-backend.scm +++ b/scm/document-backend.scm @@ -157,7 +157,7 @@ node." engraver-list)) "." - "\n\nStandard settings:\n\n" + "\n\nStandard settings:\n" (grob-alist->texi description) "\n\nThis object supports the following interface(s):\n" (human-listify ifacedoc) diff --git a/scm/document-context-mods.scm b/scm/document-context-mods.scm index b83ff69cac..0695008d49 100644 --- a/scm/document-context-mods.scm +++ b/scm/document-context-mods.scm @@ -29,25 +29,24 @@ (let ((value (car args)) (path (cdr args))) (string-append - "@item Sets " - (format "grob property @code{~a} " + (format "@item Sets grob property @code{~a} " (grob-property-path path)) - (format "in @code{@rinternals{~a}} to ~a." - name-sym - (scm->texi value)) - "\n"))) + (format "in @code{@rinternals{~a}} to" name-sym) + (if (pretty-printable? value) + (format ":~a\n" (scm->texi value)) + (format " ~a.\n" (scm->texi value)))))) ((pop) (string-append - "@item Reverts " - (format "grob property @code{~a} " + (format "@item Reverts grob property @code{~a} " (grob-property-path (car args))) - (format "in @code{@rinternals{~a}}." - name-sym) - "\n")) + (format "in @code{@rinternals{~a}}.\n" + name-sym))) ((assign) - (format "@item Sets translator property @code{~a} to ~a.\n" - name-sym - (scm->texi (car args)))) + (string-append + (format "@item Sets translator property @code{~a} to" name-sym) + (if (pretty-printable? value) + (format ":~a\n" (scm->texi (car args))) + (format " ~a.\n" (scm->texi (car args)))))) ((unset) (format "@item Unsets translator property @code{~a}.\n" name-sym)) diff --git a/scm/document-translation.scm b/scm/document-translation.scm index b35ce807ce..442c2659bb 100644 --- a/scm/document-translation.scm +++ b/scm/document-translation.scm @@ -143,18 +143,19 @@ (path (cdr args))) (string-append - "@item Set " - (format #f "grob-property @code{~a} " + (format #f "@item Set grob-property @code{~a} " (string-join (map symbol->string path) " ")) - (format #f "in @ref{~a} to ~a." - context-sym (scm->texi value)) - "\n"))) + (format #f "in @ref{~a} to" context-sym) + (if (pretty-printable? value) + (format #f ":~a\n" (scm->texi value)) + (format #f " ~a.\n" (scm->texi value)))))) ((equal? (object-property context-sym 'is-grob?) #t) "") ((equal? tag 'assign) - (format #f "@item Set translator property @code{~a} to ~a.\n" - context-sym - (scm->texi (car args)))) - ))) + (string-append + (format #f "@item Set translator property @code{~a} to" context-sym) + (if (pretty-printable? (car args)) + (format #f ":~a\n" (scm->texi (car args))) + (format #f " ~a.\n" (scm->texi (car args))))))))) (define (context-doc context-desc) diff --git a/scm/documentation-lib.scm b/scm/documentation-lib.scm index ede9e22562..da7d296658 100644 --- a/scm/documentation-lib.scm +++ b/scm/documentation-lib.scm @@ -58,16 +58,15 @@ (define (processing name) (ly:basic-progress (_ "Processing ~S...") name)) -(define (self-evaluating? x) - (or (number? x) (string? x) (procedure? x) (boolean? x))) - -(define (texify x) - x) - -(define (scm->texi x) - (string-append "@code{" (texify (scm->string x)) "}")) - - +(define (scm->texi val) + (let* (; always start on a new line + (open-texi (if (pretty-printable? val) + "\n@verbatim\n" + "\n@code{")) + (close-texi (if (pretty-printable? val) + "@end verbatim" + "}"))) + (string-append open-texi (scm->string val) close-texi))) (define (texi-section-command level) (assoc-get level '( @@ -91,7 +90,7 @@ "Document one (LABEL . DESC); return empty string if LABEL is empty string." (if (eq? (car label-desc-pair) "") "" - (string-append "\n@item " (car label-desc-pair) "\n" (cdr label-desc-pair)))) + (string-append "\n\n@item " (car label-desc-pair) "\n" (cdr label-desc-pair)))) (define (description-list->texi items-alist quote?) @@ -100,9 +99,9 @@ string-to-use). If QUOTE? is #t, embed table in a @quotation environment." (string-append "\n" (if quote? "@quotation\n" "") - "@table @asis\n" + "@table @asis" (string-concatenate (map one-item->texi items-alist)) - "\n" + "\n\n" "@end table\n" (if quote? "@end quotation\n" ""))) @@ -209,12 +208,8 @@ with init values from ALIST (1st optional argument) (ly:error (_ "cannot find description for property ~S (~S)") sym where)) (cons - (string-append "@code{" name "} " - "(" typename ")" + (string-append "@code{" name "} (" typename ")" (if init-value - (string-append - ":\n\n" - (scm->texi init-value) - "\n\n") - "")) + (string-append ":" (scm->texi init-value) "\n") + "")) desc))) diff --git a/scm/lily-library.scm b/scm/lily-library.scm index 78144ec244..472a82da24 100644 --- a/scm/lily-library.scm +++ b/scm/lily-library.scm @@ -22,6 +22,8 @@ ;; for define-safe-public when byte-compiling using Guile V2 (use-modules (scm safe-utility-defs)) +(use-modules (ice-9 pretty-print)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; constants. @@ -942,23 +944,46 @@ print a warning and set an optional @var{default}." (object->string def)) def)))) -;; -;; don't confuse users with # syntax. -;; +(define (self-evaluating? x) + (or (number? x) (string? x) (procedure? x) (boolean? x))) + +(define (ly-type? x) + (any (lambda (p) ((car p) x)) lilypond-exported-predicates)) + +(define-public (pretty-printable? val) + (and (not (self-evaluating? val)) + (not (symbol? val)) + (not (hash-table? val)) + (not (ly-type? val)))) + (define-public (scm->string val) - (if (and (procedure? val) - (symbol? (procedure-name val))) - (symbol->string (procedure-name val)) - (string-append - (if (self-evaluating? val) - (if (string? val) - "\"" - "") - "'") - (call-with-output-string (lambda (port) (display val port))) - (if (string? val) - "\"" - "")))) + (let* ((quote-style (if (string? val) + 'double + (if (or (null? val) ; (ly-type? '()) => #t + (and (not (self-evaluating? val)) + (not (vector? val)) + (not (hash-table? val)) + (not (ly-type? val)))) + 'single + 'none))) + ; don't confuse users with # syntax + (str (if (and (procedure? val) + (symbol? (procedure-name val))) + (symbol->string (procedure-name val)) + (call-with-output-string + (if (pretty-printable? val) + ; property values in PDF hit margin after 64 columns + (lambda (port) + (pretty-print val port #:width (case quote-style + ((single) 63) + (else 64)))) + (lambda (port) (display val port))))))) + (case quote-style + ((single) (string-append + "'" + (string-regexp-substitute "\n " "\n " str))) + ((double) (string-append "\"" str "\"")) + (else str)))) (define-public (!= lst r) (not (= lst r))) -- 2.39.2