lib/40-findskel.scm

   1 ;------------------------------------------------------------------;
   2 ; opus_libre -- 40-findskel.scm                                    ;
   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 ; Look for skeleton file.
  13
  14 (define default-skel (string-append
  15                       conf:skel-dir "/"
  16                       conf:default-skel ".lyskel"))
  17
  18 (define (make-this-text name suffix)
  19   (let ((mark (ly:parser-lookup parser
  20                                 (string->symbol
  21                                  (string-append name suffix)))))
  22     (if (markup? mark) mark
  23         (begin
  24           (if (ly:get-option 'debug-messages)
  25               (ly:warning "No text found in ~a~a" name suffix))
  26           (if (ly:get-option 'use-variable-names)
  27               (regexp-substitute/global #f "[A-Z]" name 'pre " "0 'post)
  28               point-stencil)))))
  29
  30 (define (read-file x)
  31   "Read a skeleton file and return it as a single string."
  32   (let ((ret-str ""))
  33     (do ((line (read-line x)))
  34         ((eof-object? line))
  35       (begin
  36         (set! line (regexp-substitute/global #f "%" line 'pre))
  37         (set! ret-str (string-append ret-str line))
  38         (set! line (read-line x))))
  39     ret-str))
  40
  41 (define (find-skel skelname)
  42   (let ((local-skel (find-files conf:local-conf-dir
  43                                 (string-append "/"
  44                                 skelname ".lyskel")))
  45         (global-skel (find-files conf:skel-dir
  46                                  (string-append "/"
  47                                  skelname ".lyskel"))))
  48      (if (not (null? local-skel)) (car local-skel)
  49          (if (not (null? global-skel)) (car global-skel)
  50          #f))))
  51
  52 (define skel-file
  53   (if (defined-string? 'skel)
  54       (let* ((requested-skel (ly:parser-lookup parser 'skel))
  55              (file (find-skel requested-skel)))
  56         (if (not file)
  57             (begin (ly:warning "Skeleton not found: ~a.
  58 Defaulting to \"universal\" skeleton." requested-skel)
  59                        default-skel)
  60              file))
  61       (begin (ly:warning "No skeleton defined;
  62 defaulting to \"universal\" skeleton.") default-skel)))