lib/include.ly

   1 %------------------------------------------------------------------%
   2 % opus_libre -- include.ly                                         %
   3 %                                                                  %
   4 % (c) 2008-2010 Valentin Villenave <valentin@villenave.net>        %
   5 %                                                                  %
   6 %     opus_libre is a free framework for GNU LilyPond: you may     %
   7 % redistribute it and/or modify it under the terms of the GNU      %
   8 % General Public License, version 3 or later: gnu.org/licenses     %
   9 %                                                                  %
  10 %------------------------------------------------------------------%
  11
  12 % Inclusion functions.
  13
  14 #(ly:set-option 'relative-includes #t)
  15
  16 %%%%%%%%%%%%%%%%%%%%%%%%%% Base functions %%%%%%%%%%%%%%%%%%%%%%%%%%
  17
  18 %% Filesystem browsing --------------------------------------------%
  19
  20 %;;; The following function was retrieved from
  21 %;;; a mail posted by Russ McManus in 1998...
  22 %;;; http://sources.redhat.com/ml/guile/1998-07/msg00370.html
  23
  24 #(define (find-files dir . arg-ls)
  25  "Return a list of files within directory DIR. Two optional arguements
  26  are supported, PREDICATE and RECURSE?. PREDICATE should be a procedure
  27  of one argument that determines whether a particular file should be included
  28  in the returned list. As a special case, if PREDICATE is a string, it is
  29  compiled into a regular expression, and a predicate is generated that applies
  30  this regular expression to the filename. RECURSE? determines whether the
  31  procedure descends into subdirectories, and it defaults to #t. Symbolic
  32  links are not followed."
  33  (let* ((n-args (length arg-ls))
  34         (pred (cond ((= n-args 0)
  35                      (lambda (file) #t))
  36                ((procedure? (list-ref arg-ls 0))
  37                 (list-ref arg-ls 0))
  38                ((string? (list-ref arg-ls 0))
  39                 (let ((rx (make-regexp (list-ref arg-ls 0)
  40                            ;; better use case-insensitive flag here
  41                            regexp/icase)))
  42                  (lambda (file) (regexp-exec rx file))))
  43                (#t (error "bad predicate" (list-ref arg-ls 0)))))
  44         (recurse? (if (>= n-args 2) (list-ref arg-ls 1) #t)))
  45   (define (do-file file basename ret-ls)
  46    (let* ((v (lstat file)))
  47     (cond ((string=? basename ".") ret-ls)
  48      ((string=? basename "..") ret-ls)
  49      ((and (eq? (stat:type v) 'directory)
  50        recurse?)
  51       (do-dir file ret-ls))
  52      ((pred file) (cons file ret-ls))
  53      (#t ret-ls))))
  54   (define (do-dir dir-name ret-ls)
  55    (let ((dir (opendir dir-name)))
  56     (do ((file (readdir dir) (readdir dir)))
  57      ((eof-object? file) ret-ls)
  58      (set! ret-ls
  59       (do-file
  60        ;; (string) now only accepts chars,
  61        ;; better use (string-append) instead
  62        (string-append dir-name "/" file) file ret-ls)))
  63     (closedir dir)
  64     ret-ls))
  65   (do-dir dir '())))
  66
  67
  68 #(define (include-scm dir)
  69  (let ((scm-files (find-files dir ".scm$")))
  70   (map (lambda (x) (load x))
  71    scm-files)))
  72
  73 #(define (include-ly dir)
  74   (let ((ly-files (find-files dir ".i?ly$")))
  75    (display (map (lambda (x)
  76                   (ly:parser-parse-string parser
  77                    (format #f "\\include \"~a\"" x)))
  78              ly-files))))
  79
  80 %------------------------------------------------------------------%