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  ; *->lily-string
  34  (scm display-lily))
  35
  36 (define-public (not-null? x) (not (null? x)))
  37 (define-public (false-or-null? x) (or (not x) (null? x)))
  38
  39 (define-public (ly:debug-message string . rest)
  40    (if (ly:get-option 'verbose)
  41        (apply ly:message (cons string rest))))
  42
  43 ;; Base variables initialization ----------------------------------;
  44 ;; (may be overriden later when parsing conf-file)
  45
  46 (define conf:lib-dir "lib")
  47
  48 ;; Filesystem browsing --------------------------------------------;
  49
  50 ;;;; The following function was retrieved from
  51 ;;;; a mail posted by Russ McManus in 1998...
  52 ;;;; http://sources.redhat.com/ml/guile/1998-07/msg00370.html
  53
  54 (define-public (find-files dir . arg-ls)
  55   "List files in DIR, in alphabetical order.  Two optional arguments
  56  are supported: a regexp filter, and a boolean that determines whether
  57  subdirectories should be included (defaults to true)."
  58   (let* ((n-args (length arg-ls))
  59          (pred (cond ((= n-args 0)
  60                       (lambda (file) #t))
  61                      ((procedure? (list-ref arg-ls 0))
  62                       (list-ref arg-ls 0))
  63                      ((string? (list-ref arg-ls 0))
  64                       (let ((rx (make-regexp (list-ref arg-ls 0)
  65                                              ;; better use case-insensitive flag here
  66                                              regexp/icase)))
  67                         (lambda (file) (regexp-exec rx file))))
  68                      (#t (error "bad predicate" (list-ref arg-ls 0)))))
  69          (recurse? (if (>= n-args 2) (list-ref arg-ls 1) #t)))
  70     (define (do-file file basename ret-ls)
  71       (let* ((v (lstat file)))
  72         (cond ((string=? basename ".") ret-ls)
  73               ((string=? basename "..") ret-ls)
  74               ((and (eq? (stat:type v) 'directory)
  75                     recurse?)
  76                (do-dir file ret-ls))
  77               ((pred file) (cons file ret-ls))
  78               (#t ret-ls))))
  79     (define (do-dir dir-name ret-ls)
  80       (let ((dir (opendir dir-name)))
  81         (do ((file (readdir dir) (readdir dir)))
  82             ((eof-object? file) ret-ls)
  83           (set! ret-ls
  84                 (do-file
  85                  ;; (string) now only accepts chars,
  86                  ;; use (string-append) instead
  87                  (string-append dir-name "/" file) file ret-ls)))
  88         (closedir dir)
  89         ret-ls))
  90     (sort (do-dir dir '()) string<?)))
  91
  92 ;; Loading files (similar to ly:load) -----------------------------;
  93
  94 (define-public (scm-load file-name)
  95   (ly:debug "[~A" file-name)
  96   (load file-name)
  97   (if (ly:get-option 'verbose)
  98       (ly:progress "]\n")))
  99
 100 ;; Automatic includes ---------------------------------------------;
 101
 102 (define-public (include-scm dir . numbered?)
 103   "Load all Scheme files in DIR. If NUMBERED is set,
 104  load only numbered files."
 105   (let* ((regx (if (not (false-or-null? numbered?)) "/[0-9].*\\.scm$" ".scm$"))
 106          (scm-files (find-files dir regx)))
 107     (map (lambda (x)
 108            (scm-load x))
 109          scm-files)))
 110
 111 ;------------------------------------------------------------------;