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)
(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))
(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)
(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 '(
"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?)
(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" "")))
(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)))
;; for define-safe-public when byte-compiling using Guile V2
(use-modules (scm safe-utility-defs))
+(use-modules (ice-9 pretty-print))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; constants.
(object->string def))
def))))
-;;
-;; don't confuse users with #<procedure .. > 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 #<procedure ...> 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)))