lib/init.scm

   1 ;------------------------------------------------------------------;
   2 ; opus_libre -- init.scm                                           ;
   3 ;                                                                  ;
   4 ; (c) 2008-2011 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 as published by the Free Software         ;
   9 ; Foundation, either version 3 of the License, or (at your option) ;
  10 ; any later version.                                               ;
  11 ;     This program is distributed WITHOUT ANY WARRANTY; without    ;
  12 ; even the implied warranty of MERCHANTABILITY or FITNESS FOR A    ;
  13 ; PARTICULAR PURPOSE.  You should have received a copy of the GNU  ;
  14 ; General Public License along with this program (typically in the ;
  15 ; share/doc/ directory).  If not, see http://www.gnu.org/licenses/ ;
  16 ;                                                                  ;
  17 ;------------------------------------------------------------------;
  18
  19
  20 ; Init file: mandatory variables and functions.
  21
  22 (use-modules
  23  ; regular expressions
  24  (ice-9 regex)
  25  ; optional arguments
  26  (ice-9 optargs)
  27  ; delimited i/o
  28  (ice-9 rdelim)
  29  ; command pipe
  30  (ice-9 popen)
  31  ; parameters
  32  (srfi srfi-39))
  33
  34 (define-public (not-null? x) (not (null? x)))
  35 (define-public (false-or-null? x) (or (not x) (null? x)))
  36
  37 (define-public (ly:debug-message string . rest)
  38    (if (ly:get-option 'verbose)
  39        (apply ly:message (cons string rest))))
  40
  41 ;; Base variables initialization ----------------------------------;
  42 ;; (may be overriden later when parsing conf-file)
  43
  44 (define conf:lib-dir "lib")
  45
  46 ;; Filesystem browsing --------------------------------------------;
  47
  48 ;;;; The following function was retrieved from
  49 ;;;; a mail posted by Russ McManus in 1998...
  50 ;;;; http://sources.redhat.com/ml/guile/1998-07/msg00370.html
  51
  52 (define-public (find-files dir . arg-ls)
  53   "List files in DIR, in alphabetical order.  Two optional arguments
  54  are supported: a regexp filter, and a boolean that determines whether
  55  subdirectories should be included (defaults to true)."
  56   (let* ((n-args (length arg-ls))
  57          (pred (cond ((= n-args 0)
  58                       (lambda (file) #t))
  59                      ((procedure? (list-ref arg-ls 0))
  60                       (list-ref arg-ls 0))
  61                      ((string? (list-ref arg-ls 0))
  62                       (let ((rx (make-regexp (list-ref arg-ls 0)
  63                                              ;; better use case-insensitive flag here
  64                                              regexp/icase)))
  65                         (lambda (file) (regexp-exec rx file))))
  66                      (#t (error "bad predicate" (list-ref arg-ls 0)))))
  67          (recurse? (if (>= n-args 2) (list-ref arg-ls 1) #t)))
  68     (define (do-file file basename ret-ls)
  69       (let* ((v (lstat file)))
  70         (cond ((string=? basename ".") ret-ls)
  71               ((string=? basename "..") ret-ls)
  72               ((and (eq? (stat:type v) 'directory)
  73                     recurse?)
  74                (do-dir file ret-ls))
  75               ((pred file) (cons file ret-ls))
  76               (#t ret-ls))))
  77     (define (do-dir dir-name ret-ls)
  78       (let ((dir (opendir dir-name)))
  79         (do ((file (readdir dir) (readdir dir)))
  80             ((eof-object? file) ret-ls)
  81           (set! ret-ls
  82                 (do-file
  83                  ;; (string) now only accepts chars,
  84                  ;; use (string-append) instead
  85                  (string-append dir-name "/" file) file ret-ls)))
  86         (closedir dir)
  87         ret-ls))
  88     (sort (do-dir dir '()) string<?)))
  89
  90 ;; Loading files (similar to ly:load) -----------------------------;
  91
  92 (define-public (scm-load file-name)
  93   (ly:debug "[~A" file-name)
  94   (load file-name)
  95   (if (ly:get-option 'verbose)
  96       (ly:progress "]\n")))
  97
  98 ;; Automatic includes ---------------------------------------------;
  99
 100 (define-public (include-scm dir . numbered?)
 101   "Load all Scheme files in DIR. If NUMBERED is set,
 102  load only numbered files."
 103   (let* ((regx (if (not (false-or-null? numbered?)) "/[0-9].*\\.scm$" ".scm$"))
 104          (scm-files (find-files dir regx)))
 105     (map (lambda (x)
 106            (scm-load x))
 107          scm-files)))
 108
 109 ;------------------------------------------------------------------;