lib/20-readconf.scm

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