Am Sa., 2. Jan. 2021 um 00:37 Uhr schrieb Thomas Morley <[email protected]>: > > Am Fr., 1. Jan. 2021 um 23:25 Uhr schrieb Thomas Morley > <[email protected]>: > > > > Am Fr., 1. Jan. 2021 um 20:24 Uhr schrieb David Nalesnik > > <[email protected]>: > > > > > > Hi Harm, > > > > > > On Fri, Jan 1, 2021 at 12:44 PM Thomas Morley <[email protected]> > > > wrote: > > > > > > > > the above linked code catches none-public definitions as well, not sure > > > > why... > > > > P.e. `split-at-predicate` > > > > > > > > Best wishes. > > > > Harm > > > > > > Nice catch! > > > > > > This change should catch only the exported bindings: > > > > > > #(define (get-binding-list iface) > > > (ly:module->alist (resolve-interface iface))) > > > > If I'm not mistaken this _is_ already used in > > https://www.mail-archive.com/[email protected]/msg100337.html > > > > Cheers, > > Harm > > I misread. > You changed resolve-module to resolve-interface > Now working as expected. > > Thanks, > Harm
I've put some more work on it. Makes it work for unnamed modules, like (current-module). Changes negative logic omit-markups? to positive logic include-markups?. Changes the final caller to be more conveniant and taking optional arguments for the port, include-markups? and public?. Closes the ouput-port, if none-default was specified. Adds some (currently commented) code to display used interfaces and the amount of found closures to current-error-port. Cheers, Harm
\version "2.20.0" %% based upon %% https://www.mail-archive.com/[email protected]/msg100337.html %% by Daved Nalesnik #(define (get-binding-list public? iface) ;; return bindings in iface as an alist ;; (current-module) is an unnamed module, use such modules directly ;; otherwise resolve iface to get public or all bindings (ly:module->alist (if (and (module? iface) (not (module-name iface))) iface (if public? (resolve-interface iface) (resolve-module iface))))) #(define (symbol-closure-list public? iface) ;; returns an alphabetical sorted list with closures from iface ;; if public? is true, only public closures are catched. (let* ((bindings (get-binding-list public? iface)) (closures (filter (lambda (b) (closure? (cdr b))) bindings)) (sorted-closures (sort closures (lambda (x y) (symbol<? (car x) (car y)))))) sorted-closures)) #(define (omit-markup-functions lst) (remove (lambda (elt) (string-contains (symbol->string (car elt)) "markup")) lst)) #(define (symbol-closure-doc-list iface include-markups? public?) ;; returns a nested list, each sublist contains ;; (closure-name value doc-string) (let* ((raw-closures (symbol-closure-list public? iface)) (closures (if include-markups? raw-closures (omit-markup-functions raw-closures)))) (map (lambda (c) (list (car c) (cdr c) (or (procedure-documentation (cdr c)) "DOCME"))) closures))) #(define (print-used-interfaces iface) ;; print used interfaces of iface to current-error-port (pretty-print (module-uses (if (and (module? iface) (not (module-name iface))) iface (resolve-module iface))) (current-error-port))) #(define* (print-closures iface #:optional port include-markups? (public? #t)) ;; Prints closures from iface to port with name, value and description, ;; probably omitting markups, probably limited to public ones. ;; ;; Examples: ;; (print-closures '(lily)) ;; prints to current-output-port, mostly defaulting to terminal ;; markups are omitted ;; only public ones ;; (print-closures '(lily) #f #t #f) ;; prints to current-output-port, mostly defulting to terminal ;; markups are included ;; all closures are catched ;; (print-closures '(lily) "foo.txt" #t #f) ;; same as above, but printing to file foo.txt ;; probably of interest, commented for now ;(print-used-interfaces iface) (let* ((output-port (if port (open-output-file port) (current-output-port))) (list-to-print (symbol-closure-doc-list iface include-markups? public?))) ;; probably of interest, commented for now ;(format (current-error-port) "~a closures found" (length list-to-print)) (format output-port "~:{~a~%~a~%~3t~s~%__________~%~%~}" list-to-print) (if port (close-output-port output-port)))) %%%%%%%%%%%%%%%%%%%%%%%%%%%% %% EXAMPLES %%%%%%%%%%%%%%%%%%%%%%%%%%%% #(print-closures '(lily) "closures.txt" #t #f) %#(print-closures '(srfi srfi-1) "closures.txt" #f #f) %#(print-closures (current-module) "closures.txt" #t #f)
