lib/20-readconf.scm

   1 ;------------------------------------------------------------------;
   2 ; opus_libre -- 20-readconf.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 ; Load configuration files and set variables.
  21
  22 (define conf:conf-prefix "conf")
  23 (define conf:ly-prefix "ly")
  24 (define conf:conf-file "etc/ly.conf")
  25
  26 (define (parse-lines-in port prefix)
  27   "Read a file line by line and look for defs."
  28   (let ((line (read-line port)))
  29     (if (string? line)
  30         (begin
  31           ;; remove comments
  32           (set! line (regexp-substitute/global #f
  33                         (if prefix "#" "%") line 'pre))
  34           ;; Do we have a = sign, and where?
  35           (let ((eqchar-index (string-index line #\=)))
  36             (if eqchar-index
  37                 (let* ((var (string-take line eqchar-index))
  38                        (val (string-drop line (+ eqchar-index 1)))
  39                        ;; LilyPond variables are camelCased instead of hyphen-ated
  40                        (lyvar (string->symbol
  41                                (regexp-substitute/global #f "-[a-z]" var 'pre
  42                                   (lambda (m)
  43                                     (string-drop (string-upcase
  44                                                   (match:substring m)) 1)) 'post))))
  45                   (if (not prefix)
  46                       (if (or (string-any (char-set #\{ #\# #\< #\\) var)
  47                               (string-any (char-set #\{ #\# #\< #\\) val)
  48                               (string-every char-set:whitespace val))
  49                           (set! val #f))
  50                       ;; Native .ly definitions take precedence over .conf defs
  51                       (begin
  52                         (if (defined-string? lyvar)
  53                             (set! val (string-append
  54                                        "\"" (ly:parser-lookup lyvar) "\"")))
  55                         (if (not (string=? prefix ""))
  56                             (set! var (string-append prefix ":" var)))))
  57                   (if val (let ((str (format #f "(define-public ~a ~a)" var val)))
  58                             (eval-string str))))))
  59           ;; then move on to the next line, until EOF.
  60           (parse-lines-in port prefix))
  61         (close-port port))))
  62
  63 (define (parse-def-file file prefix)
  64   "Read FILE and turn all definitions into Scheme values."
  65   (let ((port (open-input-file file))
  66         ;; we don't want ly:prefixed variables, use conf: instead.
  67         (prefix (if (equal? conf:ly-prefix prefix) conf:conf-prefix prefix)))
  68     (ly:debug-message "Parsing configuration file ~a..." file)
  69     (parse-lines-in port prefix)))
  70
  71 (define (parse-def-dir dir . prefix)
  72   "Parse all .conf files found in DIR."
  73   (let ((def-files (find-files dir ".conf$" #f)))
  74     (map (lambda (x)
  75            (parse-def-file x
  76                            (if (string? prefix) prefix
  77                                (string-drop-right
  78                                 (regexp-substitute/global #f "/+" x 'post)
  79                                 5))))
  80          def-files)))
  81
  82 (define eval-conf
  83 ;;   "Read all conf files: first in the global conf dir, then in a
  84 ;;   dedicated subdir of the score dir, or if none can be found, in
  85 ;;   the score dir itself.  This allows for local overrides to be
  86 ;;   loaded early in the compilation process."
  87   (let ((local-score (string-append (*current-score*) "/score.ly"))
  88         (usr-conf (if (defined-string? 'conf:local-conf-dir)
  89                       (let ((usr-dir (string-append (*current-score*) "/" conf:local-conf-dir)))
  90                         (if (exists? usr-dir)
  91                             (begin
  92                               (ly:debug-message "Local configuration dir found in ~a" usr-dir)
  93                               usr-dir)
  94                             (begin
  95                               (ly:debug-message "~a does not exist; looking for overrides in parent directory."
  96                                 usr-dir)
  97                               (*current-score*))))
  98                        (*current-score*))))
  99     (parse-def-file conf:conf-file conf:conf-prefix)
 100     (parse-def-dir conf:conf-dir)
 101     (if (exists? local-score)
 102         (if (not (ly:get-option 'skip-local-score-file))
 103             (begin (ly:debug-message "Parsing local definitions in ~a" local-score)
 104                        (parse-def-file local-score #f))))
 105     ;; Set the conf:local-conf-dir variable, that will
 106     ;; be used later for macros, themes, local overrides etc.
 107     (set! conf:local-conf-dir usr-conf)
 108     (parse-def-dir conf:local-conf-dir)))