scm/lily.scm

   1 ;;;; lily.scm -- implement Scheme output routines for TeX and PostScript
   2 ;;;;
   3 ;;;;  source file of the GNU LilyPond music typesetter
   4 ;;;;
   5 ;;;; (c) 1998--2001 Jan Nieuwenhuizen <janneke@gnu.org>
   6 ;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
   7
   8 ;;; Library functions
   9
  10 (use-modules (ice-9 regex))
  11
  12 ;;(write standalone (current-error-port))
  13
  14 ;;; General settings
  15
  16 (debug-enable 'backtrace)
  17
  18
  19 (define point-and-click #f)
  20 (define security-paranoia #f)
  21 (define midi-debug #f)
  22
  23 (define (line-column-location line col file)
  24   "Print an input location, including column number ."
  25   (string-append (number->string line) ":"
  26                  (number->string col) " " file)
  27   )
  28
  29 (define (line-location line col file)
  30   "Print an input location, without column number ."
  31   (string-append (number->string line) " " file)
  32   )
  33
  34 ;; cpp hack to get useful error message
  35 (define ifdef "First run this through cpp.")
  36 (define ifndef "First run this through cpp.")
  37
  38 (define default-script-alist '())
  39 (define font-name-alist  '())
  40
  41 (if (not (defined? 'standalone))
  42     (define standalone (not (defined? 'ly-gulp-file))))
  43
  44 ;; The regex module may not be available, or may be broken.
  45 (define use-regex
  46   (let ((os (string-downcase (vector-ref (uname) 0))))
  47     (not (equal? "cygwin" (substring os 0 (min 6 (string-length os)))))))
  48
  49 ;; If you have trouble with regex, define #f
  50 (define use-regex #t)
  51 ;;(define use-regex #f)
  52
  53
  54 ;;; Un-assorted stuff
  55
  56 ;; URG guile-1.4/1.4.x compatibility
  57 (if (not (defined? 'primitive-eval))
  58     (define (primitive-eval form)
  59       (eval2 form #f)))
  60
  61 (define (sign x)
  62   (if (= x 0)
  63       1
  64       (if (< x 0) -1 1)))
  65
  66 (define (write-me n x)
  67   (display n)
  68   (write x)
  69   (newline)
  70   x)
  71
  72 (define (empty? x)
  73   (equal? x '()))
  74
  75 (define (!= l r)
  76   (not (= l r)))
  77
  78 (define (filter-list pred? list)
  79   "return that part of LIST for which PRED is true."
  80   (if (null? list) '()
  81       (let* ((rest  (filter-list pred? (cdr list))))
  82         (if (pred?  (car list))
  83             (cons (car list)  rest)
  84             rest))))
  85
  86 (define (filter-out-list pred? list)
  87   "return that part of LIST for which PRED is true."
  88   (if (null? list) '()
  89       (let* ((rest  (filter-list pred? (cdr list))))
  90         (if (not (pred?  (car list)))
  91             (cons (car list)  rest)
  92             rest))))
  93
  94 (define (uniqued-alist  alist acc)
  95   (if (null? alist) acc
  96       (if (assoc (caar alist) acc)
  97           (uniqued-alist (cdr alist) acc)
  98           (uniqued-alist (cdr alist) (cons (car alist) acc)))))
  99
 100 (define (uniq-list list)
 101   (if (null? list) '()
 102       (if (null? (cdr list))
 103           list
 104           (if (equal? (car list) (cadr list))
 105               (uniq-list (cdr list))
 106               (cons (car list) (uniq-list (cdr list)))))))
 107
 108 (define (alist<? x y)
 109   (string<? (symbol->string (car x))
 110             (symbol->string (car y))))
 111
 112
 113 (map (lambda (x) (eval-string (ly-gulp-file x)))
 114      '("output-lib.scm"
 115        "tex.scm"
 116        "ps.scm"
 117        "pdf.scm"
 118        "pdftex.scm"
 119        "ascii-script.scm"
 120        ))
 121
 122 (define ctor list)
 123
 124
 125 (define (ly-load x) (eval-string (ly-gulp-file x)))
 126
 127 (if (not standalone)
 128     (map ly-load
 129                                         ; load-from-path
 130          '("c++.scm"
 131            "grob-property-description.scm"
 132            "translator-property-description.scm"
 133            "context-description.scm"
 134            "interface-description.scm"
 135            "beam.scm"
 136            "clef.scm"
 137            "slur.scm"
 138            "font.scm"
 139            "music-functions.scm"
 140            "music-property-description.scm"
 141            "auto-beam.scm"
 142            "generic-property.scm"
 143            "basic-properties.scm"
 144            "chord-name.scm"
 145            "grob-description.scm"
 146            "script.scm"
 147            "drums.scm"
 148            "midi.scm"
 149            )))
 150
 151
 152