Graham Percival wrote:
> I think this is the coolest thing I've ever seen on a lilypond
> mailist, and that says a lot. :)
Thanks, Graham!
Regarding the all-grob-properties alist in define-grobs.scm...
I've written a function that will automatically sort the alist
(soon after its definition) so that:
* all meta fields are forced to the end of each property list.
* all grobs, properties, and interfaces are listed in an intuitive
order in the docs.
This required some new definitions that I put into a small file
called lily-sort.scm, which define-public's 6 binary predicates:
ly:string<? ly:string-ci<?
ly:symbol<? ly:symbol-ci<?
ly:alist<? ly:alist-ci<?
I suppose the additional code is small enough to be incorporated
into lily-library.scm, but for the moment it's a separate file.
Also, my work on sorting the grob-list* inspired me to write a
debugging tool, which I did. The debugging tool also assists in
manual code cleanup (for future developers as well) by displaying
an analysis of the alist in the console. I created a separate file
for this as well, called debug-groblist.scm. When turned on, it
generates a (potentially long) string at compile time and sends it
to the console.
*http://codereview.appspot.com/83042/show
To implement this, I added the following lines immediately after
the definition of the alist, and just before the function which
sorts the alist for the docs.
;; cleanup/debugging for this file (define-grobs.scm)
;; change to #t and compile an empty .ly file
(if #f (begin (load "debug-groblist.scm")
(display groblist-debug-string)))
Really the main purpose of the cleanup tool is to provide an easy
way to periodically check up on the orderliness of the code. It
does not affect the end user in any way (in the sense that the
sorting function which follows does). When all-grob-descriptions
is perfectly ordered, the debugger prints this:
**********************************************************
Analysis of all-grob-descriptions alist (define-grobs.scm)
**********************************************************
+ All grob descriptions are pairs.
+ All meta fields are in proper tail position.
+ No grobs have duplicate properties.
+ All grob descriptions are in order.
+ All grob interfaces are in order.
Running the debugger on define-grobs.scm as it currently
exists generates this:
**********************************************************
Analysis of all-grob-descriptions alist (define-grobs.scm)
**********************************************************
+ All grob descriptions are pairs.
+ All meta fields are in proper tail position.
- The following grobs have duplicate properties:
TextScript: (direction).
- The following pairs of grobs are out of order
(for each pair, move the first one down or the second one up):
AccidentalSuggestion AccidentalPlacement
AmbitusLine AmbitusAccidental
BreakAlignment BreakAlignGroup
... (+ 10 more lines)
- The interfaces of the following grobs are not in order.
AccidentalSuggestion
Ambitus
AmbitusLine
... (+ 88 more lines)
It is of course not necessary, for example, for all grob
properties to be in order in the code; Neil raised a good point
that certain related properties (like 'kern and 'thin-kern) might
be better left together. However, a few exceptions to the sorting
can be noted where they occur, and the sorting function that
follows the debugger will ensure that they're listed intuitively
in the docs.
One thing I don't understand: why do I need to use (load ...) to
retrieve functions that are defined with define-public in the same
directory?
Anyway, if anyone is curious to test this out, save the attached
files lily-sort.scm and debug-groblist.scm to the /scm folder and
add the lines (included below this message) to define-grobs.scm
-- just after the definition of all-grob-descriptions and just
before the line
(define (completize-grob-entry x) ...
I'd really like this (or something along these lines) to get
incorporated into the source code. If not the debugger, at least
the lily-sort stuff. If nothing else, it makes doc-searching for
things a lot easier. Also, if this is generally well-received by
the developers-that-be, I'd like to extend the idea to other lists
of things, like IR 4: Scheme functions. I can't tell you how many
times I couldn't find ly:grob? because it wasn't between
ly:get-option and ly:grob-alist-chain...
I'll format a patch if anyone thinks a few changes would make it
feasible for inclusion.
(The debugger is turned on for you already)
Hope you enjoy it.
- Mark
______________________________________________________
;; cleanup/debugging for this file (define-grobs.scm)
;; change to #t and compile an empty .ly file
(if #t (begin (load "debug-groblist.scm")
(display groblist-debug-string)))
; this is temporary:
(load "lily-sort.scm")
(define (sort-grob-properties x)
;; force 'meta to the end of each prop-list
(let ((meta (assoc 'meta x)))
(append (sort (assoc-remove! x 'meta) ly:alist-ci<?)
(list meta))))
; properly sort all grobs, properties, and interfaces
(map
(lambda (x)
(let* ((props (assoc-ref all-grob-descriptions (car x)))
(meta (assoc-ref props 'meta))
(interfaces (assoc-ref meta 'interfaces)))
(set! all-grob-descriptions
(sort (assoc-set! all-grob-descriptions (car x)
(sort-grob-properties
(assoc-set! props 'meta
(assoc-set! meta 'interfaces
(sort interfaces ly:symbol-ci<?)))))
ly:alist-ci<?))))
all-grob-descriptions)
;; this is temporary....set to #t to see the effect of above sort.
(if #f (begin (load "debug-groblist.scm")
(display groblist-debug-string)))
;; ly-sort.scm
;;
;; LilyPond-specific sorting of symbols, strings, and alists.
;;
;; (c) 2009 Mark Polesky
;;
;; for an explanation/rationale, see:
;; http://lists.gnu.org/archive/html/lilypond-devel/2009-06/msg00472.html
; maybe add this to lily-library.scm?
;(define-public (symbol-ci<? a b)
; (string-ci<? (symbol->string a) (symbol->string b)))
(define (ly:char<? a b)
(let* ((init-list (string->list " !?<=>:-_"))
(mem-a (member a init-list))
(mem-b (member b init-list)))
(if mem-a
(if mem-b
(< (length mem-b) (length mem-a))
#t)
(char<? a b))))
(define (ly:char-ci<? a b)
(let* ((init-list (string->list " !?<=>:-_"))
(mem-a (member a init-list))
(mem-b (member b init-list)))
(if mem-a
(if mem-b
(< (length mem-b) (length mem-a))
#t)
(char-ci<? a b))))
(define (mismatch str0 str1 ci?)
(let loop ((a (string->list str0)) (b (string->list str1)))
(cond ((null? a) (if (null? b) #f (cons #f (car b))))
((null? b) (cons (car a) #f))
(((if ci? char-ci=? char=?) (car a) (car b))
(loop (cdr a) (cdr b)))
(else (cons (car a) (car b))))))
(define-public (ly:string<? a b)
"Move the characters <space> !?<=>:-_ to the front of the ASCII set,
then do a case-sensitive comparison using the new order."
(let ((mismatch (mismatch a b #f)))
(if mismatch
(if (car mismatch)
(if (cdr mismatch)
(ly:char<? (car mismatch) (cdr mismatch))
#f)
(if (cdr mismatch) #t #f))
#f)))
(define-public (ly:string-ci<? a b)
"Move the characters <space> !?<=>:-_ to the front of the ASCII set,
then do a case-insensitive comparison using the new order."
(let ((mismatch (mismatch a b #t)))
(if mismatch
(if (car mismatch)
(if (cdr mismatch)
(ly:char-ci<? (car mismatch) (cdr mismatch))
#f)
(if (cdr mismatch) #t #f))
#f)))
(define-public (ly:symbol<? a b)
(ly:string<? (symbol->string a) (symbol->string b)))
(define-public (ly:symbol-ci<? a b)
(ly:string-ci<? (symbol->string a) (symbol->string b)))
(define-public (ly:alist<? a b)
(ly:string<? (symbol->string (car a))
(symbol->string (car b))))
(define-public (ly:alist-ci<? a b)
(ly:string-ci<? (symbol->string (car a))
(symbol->string (car b))))
;;;;;; demonstration ;;;;;;
(if #f
(begin
(use-modules (ice-9 pretty-print))
(pretty-print
(sort
'(ly:module->alist
ly:module-copy
ly:moment-sub
ly:moment<?
ly:moment?
ly:otf->cff
ly:otf-font-glyph-info
ly:otf-font?
ly:staff-symbol-referencer::callback
ly:staff-symbol::print
X-offset
Y-offset)
;; replace with ly:symbol-ci<? to see the difference
symbol<?))))
;; debug-groblist.scm
;;
;; cleanup/debugging tool for define-grobs.scm
;;
;; (c) 2009 Mark Polesky
;;
;; in define-grobs.scm, following the definition of
;; all-grob-descriptions, change the (if #f ...) to (if #t ...)
;; then compile an empty .ly file
(load "lily-sort.scm")
;;; misc (perhaps some of these could be added to lily-library.scm)
(define (filter-out pred lst)
(filter (lambda (x) (not (pred x))) lst))
(define (and-not-null? x)
(and x (not (null? x))))
(define (get-alist-duplicates alist)
(let loop ((dups '()) (lst (map car (cdr alist))))
(cond
((null? lst)
(if (null? dups) '() (cons (car alist) (list dups))))
((and (member (car lst) (cdr lst))
(not (member (car lst) dups))); <- list multiple dups once
(loop (append dups (list (car lst)))
(cdr lst)))
(else (loop dups (cdr lst))))))
(define (get-disordered-alist-keys alist pred)
(let loop ((pairs '()) (keys (map car (cdr alist))))
(cond
((or (null? (cdr keys)) (null? (cddr keys))) pairs)
((pred (car keys) (cadr keys)) (loop pairs (cdr keys)))
(else (loop (append pairs (list (cons (car keys) (cadr keys))))
(cdr keys))))))
;;; test for non-pairs
(define non-pairs
(filter-out boolean? (map (lambda (x) (if (pair? x) #f x))
all-grob-descriptions)))
(define non-pairs-str ; string or #f
(if (and-not-null? non-pairs)
(let loop ((str "") (grobs non-pairs))
(if (null? grobs)
str
(loop (string-append str
(format #f " ~a\n"
(car grobs)))
(cdr grobs))))
#f))
;;; test for non-tail meta fields
(define (meta-not-tail? alist)
(let ((meta (member 'meta (map car (cdr alist)))))
(if (and meta (null? (cdr meta)))
#f
(car alist))))
(define non-tail-metas
(filter-out boolean? (map meta-not-tail? all-grob-descriptions)))
(define non-tail-metas-str ; string or #f
(if (and-not-null? non-tail-metas)
(let loop ((str "") (grobs non-tail-metas))
(if (null? grobs)
str
(loop (format #f " ~a\n" (car grobs))
(cdr grobs))))
#f))
;;; test for duplicate properties
(define duplicates
(filter-out null?
(map get-alist-duplicates all-grob-descriptions)))
(define duplicates-str ; string or #f
(if (and-not-null? duplicates)
(let loop ((str "") (pairs duplicates))
(if (null? pairs)
str
(loop (string-append str
(format #f " ~a: ~a.\n" ;" ~a: ~{~a~^, ~}.\n"
(caar pairs) (cadar pairs)))
(cdr pairs))))
#f))
;;; test for properties out of order
(define unsorted-properties
(get-disordered-alist-keys all-grob-descriptions ly:symbol-ci<?))
(define unsorted-properties-str
(if (and-not-null? unsorted-properties)
(let loop ((str "") (pairs unsorted-properties))
(if (null? pairs)
str
(loop (string-append str
(format #f " ~a ~a\n"
(caar pairs) (cdar pairs)))
(cdr pairs))))
#f))
;;; test for interfaces out of order
(define unsorted-interfaces
(filter-out boolean?
(map
(lambda (x)
(if (sorted? (cdr (assq 'interfaces
(cdr (assq 'meta (cdr x)))))
ly:symbol-ci<?)
#f
(car x)))
all-grob-descriptions)))
(define unsorted-interfaces-str ; string or #f
(if (and-not-null? unsorted-interfaces)
(let loop ((str "") (grobs unsorted-interfaces))
(if (null? grobs)
str
(loop (string-append str
(format #f " ~a\n"
(car grobs)))
(cdr grobs))))
#f))
;; create groblist-debug-string
(define-public groblist-debug-string
(string-append
(make-string 58 #\*) "\n"
"Analysis of all-grob-descriptions alist (define-grobs.scm)\n"
(make-string 58 #\*) "\n"
(if non-pairs-str
(string-append
"- The following entries in all-grob-descriptions are not pairs:\n"
non-pairs-str)
"+ All grob descriptions are pairs.\n")
(if non-tail-metas-str
(string-append
"- The following meta fields are not in tail position:\n"
non-tail-metas-str)
"+ All meta fields are in proper tail position.\n")
(if duplicates-str
(string-append
"- The following grobs have duplicate properties:\n"
duplicates-str)
"+ No grobs have duplicate properties.\n")
(if unsorted-properties-str
(string-append
"- The following pairs of grobs are out of order\n"
" (for each pair, move the first one down or the second one up):\n"
unsorted-properties-str)
"+ All grob descriptions are in order.\n")
(if unsorted-interfaces-str
(string-append
"- The interfaces of the following grobs are not in order.\n"
unsorted-interfaces-str)
"+ All grob interfaces are in order.\n")))_______________________________________________
lilypond-devel mailing list
lilypond-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/lilypond-devel
