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:ly-prefix "ly")\r
  16 (define conf:conf-file "etc/ly.conf")\r
  17 \r
  18 (define (parse-lines-in port prefix)\r
  19   "Read a file line by line and look for defs."\r
  20   (let ((line (read-line port)))\r
  21     (if (string? line)\r
  22         (begin\r
  23           ;; remove comments\r
  24           (set! line (regexp-substitute/global #f "#" line 'pre))\r
  25           ;; Do we have a = sign, and where?\r
  26           (let ((eq (string-index line #\=)))\r
  27             (if (not (boolean? eq))\r
  28                 (let* ((var (string-take line (- eq 1)))\r
  29                        (val (string-drop line (+ eq 1)))\r
  30                        ;; LilyPond variables are camelCased instead of hyphen-ated\r
  31                        (lyvar (string->symbol\r
  32                                (regexp-substitute/global #f "-[a-z]" var 'pre\r
  33                                                          (lambda (m)\r
  34                                                            (string-drop (string-upcase\r
  35                                                                          (match:substring m)) 1)) 'post))))\r
  36                   (if (not (string=? prefix ""))\r
  37                       (set! var (string-append prefix ":" var)))\r
  38                   ;; Native .ly definitions take precedence over .conf defs\r
  39                   (if (defined-string? lyvar)\r
  40                       (set! val (string-append "\""\r
  41                                                (ly:parser-lookup parser lyvar) "\"")))\r
  42                   (eval-string\r
  43                    (format #f "(define-public ~a ~a)" var val)))))\r
  44           ;; then move on to the next line, until EOF.\r
  45           (parse-lines-in port prefix))\r
  46         (close-port port))))\r
  47 \r
  48 (define (parse-def-file file prefix)\r
  49   "Read FILE and turn all definitions into Scheme values."\r
  50   (let ((port (open-input-file file))\r
  51         ;; we don't want ly:prefixed variables, use conf: instead.\r
  52         (prefix (if (eq? conf:ly-prefix prefix) conf:conf-prefix prefix)))\r
  53     (if (ly:get-option 'debug-messages)\r
  54         (ly:message "Parsing configuration file ~a..." file))\r
  55     (parse-lines-in port prefix)))\r
  56 \r
  57 (define (parse-def-dir dir . prefix)\r
  58   "Parse all .conf files found in DIR."\r
  59   (let ((def-files (find-files dir ".conf$" #f)))\r
  60     (map (lambda (x)\r
  61            (parse-def-file x\r
  62              (if (string? prefix) prefix\r
  63                (string-drop-right\r
  64                  (regexp-substitute/global #f "/+" x 'post)\r
  65                   5))))\r
  66          def-files)))\r
  67 \r
  68 (define eval-conf\r
  69   (let ((usr-conf (if (defined-string? 'conf:local-conf-dir)\r
  70                       (let ((usr-dir (string-append score-dir "/" conf:local-conf-dir)))\r
  71                         (if (exists? usr-dir)\r
  72                             (begin\r
  73                               (if (ly:get-option 'debug-messages)\r
  74                                   (ly:message "Local configuration dir found in ~a" usr-dir))\r
  75                               usr-dir)\r
  76                             (begin\r
  77                               (if (ly:get-option 'debug-messages)\r
  78                                   (ly:message "No local overrides found: ~a does not exist." usr-dir))\r
  79                               score-dir)))\r
  80                       score-dir)))\r
  81   (parse-def-file conf:conf-file conf:conf-prefix)\r
  82   (parse-def-dir conf:conf-dir)\r
  83   (set! conf:local-conf-dir usr-conf)\r
  84   (parse-def-dir conf:local-conf-dir)))\r