lib/20-readconf.scm

   1 ;------------------------------------------------------------------;\r
   2 ; opus_libre -- 20-readconf.scm                                    ;\r
   3 ;                                                                  ;\r
   4 ; (c) 2008-2010 Valentin Villenave <valentin@villenave.net>        ;\r
   5 ;                                                                  ;\r
   6 ;     opus_libre is a free framework for GNU LilyPond: you may     ;\r
   7 ; redistribute it and/or modify it under the terms of the GNU      ;\r
   8 ; General Public License, version 3 or later: gnu.org/licenses     ;\r
   9 ;                                                                  ;\r
  10 ;------------------------------------------------------------------;\r
  11 \r
  12 ; Load configuration files and set variables.\r
  13 \r
  14 (define conf:conf-prefix "conf")\r
  15 (define conf:conf-file "etc/ly.conf")\r
  16 \r
  17 (define (parse-lines-in port prefix)\r
  18   "Read a file line by line and look for defs."\r
  19   (let ((line (read-line port)))\r
  20     (if (string? line)\r
  21         (begin\r
  22           ;; remove comments\r
  23           (set! line (regexp-substitute/global #f "#" line 'pre))\r
  24           ;; Do we have a = sign, and where?\r
  25           (let ((eq (string-index line #\=)))\r
  26             (if (not (boolean? eq))\r
  27                 (let* ((var (string-take line (- eq 1)))\r
  28                        (val (string-drop line (+ eq 1)))\r
  29                        ;; LilyPond variables are camelCased instead of hyphen-ated\r
  30                        (lyvar (string->symbol\r
  31                                (regexp-substitute/global #f "-[a-z]" var 'pre\r
  32                                                          (lambda (m)\r
  33                                                            (string-drop (string-upcase\r
  34                                                                          (match:substring m)) 1)) 'post))))\r
  35                   (if (not (string=? prefix ""))\r
  36                       (set! var (string-append prefix ":" var)))\r
  37                   ;; Native .ly definitions take precedence over .conf defs\r
  38                   (if (is-defined? lyvar)\r
  39                       (set! val (string-append "\""\r
  40                                                (ly:parser-lookup parser lyvar) "\"")))\r
  41                   (eval-string\r
  42                    (format #f "(define-public ~a ~a)" var val)))))\r
  43           ;; then move on to the next line, until EOF.\r
  44           (parse-lines-in port prefix))\r
  45         (close-port port))))\r
  46 \r
  47 (define (parse-def-file file prefix)\r
  48   "Read FILE and turn all definitions into Scheme values."\r
  49   (let ((port (open-input-file file)))\r
  50     (if (ly:get-option 'debug-messages)\r
  51         (ly:message "Parsing configuration file ~a..." file))\r
  52     (parse-lines-in port prefix)))\r
  53 \r
  54 (define (parse-def-dir dir . prefix)\r
  55   "Parse all .conf files found in DIR."\r
  56   (let ((def-files (find-files dir ".conf$" #f)))\r
  57     (map (lambda (x)\r
  58            (parse-def-file x\r
  59              (if (string? prefix) prefix\r
  60                (string-drop-right\r
  61                  (regexp-substitute/global #f "/+" x 'post)\r
  62                   5))))\r
  63          def-files)))\r
  64 \r
  65 (define eval-conf\r
  66   (let ((usr-conf (if (is-defined? 'conf:local-conf-dir)\r
  67                       (let ((usr-dir (string-append score-dir "/" conf:local-conf-dir)))\r
  68                         (if (exists? usr-dir)\r
  69                             (begin\r
  70                               (if (ly:get-option 'debug-messages)\r
  71                                   (ly:message "Local configuration dir found in ~a" usr-dir))\r
  72                               usr-dir)\r
  73                             (begin\r
  74                               (if (ly:get-option 'debug-messages)\r
  75                                   (ly:message "No local overrides found: ~a does not exist." usr-dir))\r
  76                               score-dir)))\r
  77                       score-dir)))\r
  78   (parse-def-file conf:conf-file conf:conf-prefix)\r
  79   (parse-def-dir conf:conf-dir)\r
  80   (set! conf:local-conf-dir usr-conf)\r
  81   (parse-def-dir conf:local-conf-dir conf:conf-prefix)))\r