lib/70-findskel.scm

   1 ;------------------------------------------------------------------;
   2 ; opus_libre -- 70-findskel.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 ; Look for skeleton file.
  21
  22 (define default-skel (string-append
  23                       conf:skel-dir "/"
  24                       conf:default-skel ".lyskel"))
  25
  26 (define (read-file x)
  27   "Read a skeleton file and return it as a single string."
  28   (let ((ret-str ""))
  29     (do ((line (read-line x)))
  30         ((eof-object? line))
  31       (begin
  32         (set! line (regexp-substitute/global #f "%" line 'pre))
  33         (set! ret-str (string-append ret-str line))
  34         (set! line (read-line x))))
  35     ret-str))
  36
  37 (define (find-skel skelname)
  38   "Try to find a skeleton of the given name, either
  39 in the local conf dir or in the global skeleton repository."
  40   (let ((local-skel (find-files conf:local-conf-dir
  41                                 (string-append "/"
  42                                                skelname ".lyskel$")))
  43         (global-skel (find-files conf:skel-dir
  44                                  (string-append "/"
  45                                                 skelname ".lyskel$"))))
  46     (if (not-null? local-skel) (car local-skel)
  47         (if (not-null? global-skel) (car global-skel)
  48             #f))))
  49
  50 (define (skel-file arg)
  51   "The skeleton that will be used to compile the current part.
  52 If no skeleton has been specified or if the requested skeleton
  53 wasn't found, a default, versatile skeleton will be tried."
  54   (if (string? (find-skel arg)) arg
  55       (if (defined-string? 'skel)
  56           (let* ((requested-skel (ly:parser-lookup 'skel))
  57                  (file (find-skel requested-skel)))
  58              (if (or (not file)
  59                      (eq? file ""))
  60                  (begin (ly:warning "Skeleton not found: ~a.
  61 Defaulting to \"universal\" skeleton." requested-skel)
  62                         default-skel)
  63                  requested-skel))
  64           (begin (ly:warning "No skeleton defined;
  65 defaulting to \"universal\" skeleton.") default-skel))))