]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/encoding.scm
*** empty log message ***
[lilypond.git] / scm / encoding.scm
index f161696926cd4ff0ae1689999beb1dba2d7ac91e..5d35fe5745303e2d371d8beccf288911acf6b8ae 100644 (file)
@@ -5,24 +5,24 @@
 ;;;; (c) 2004 Jan Nieuwenhuizen <janneke@gnu.org>
 
 ;; WIP
-;; cp /usr/share/texmf/dvips/base/*.enc mf/out
-;; cp /usr/share/texmf/dvips/tetex/*.enc mf/out
 ;; encoding.ly:
 ;; #(display (reencode-string "adobe" "latin1" "hellö fóebär"))
 ;;
 
 
-(define (read-encoding-file filename)
-  "Read .enc file, returning a vector of symbols."
-  (let* ((raw (ly:gulp-file filename))
+(define-public (read-encoding-file filename)
+  "Read .enc file, return (COMMAND-NAME . VECTOR-OF-SYMBOLS)."
+  (let* ((path (ly:kpathsea-expand-path filename))
+        (unused (if (string? path) #t (ly:warn "can't find ~s" filename)))
+        (raw (ly:gulp-file path))
         (string (regexp-substitute/global #f "%[^\n]*" raw 'pre "" 'post))
-        (start (string-index string #\[))
-        (end (string-index string #\]))
-        (ps-lst (string-tokenize (substring string (+ start 1) end)))
-        (lst (map (lambda (x) (substring x 1)) ps-lst))
+        (command (match:substring
+                  (string-match "/([^ \t\n\r]*)[ \t\n\r]+[[]" string) 1))
+        (encoding (match:substring (string-match "[[](.*)[]]" string) 1))
+        (ps-lst (string-tokenize encoding))
+        (lst (map (lambda (x) (string->symbol (substring x 1))) ps-lst))
         (vector (list->vector lst)))
-
-    vector))
+    (cons command vector)))
 
 (define (make-encoding-table encoding-vector)
   "Return a hash table mapping names to chars. ENCODING-VECTOR is a
@@ -38,22 +38,20 @@ vector of symbols."
 
     h))
 
-(define-public (reencode-string permutation str)
-  "Apply PERMUTATION, a vector of [0..256) -> char, to STR"
+(define-public (reencode-string mapping str)
+  "Apply MAPPING, a vector of [0..256) -> char, to STR"
   (string-map (lambda (chr)
-               (vector-ref permutation (char->integer chr)))
+               (vector-ref mapping (char->integer chr)))
              str))
 
-(define-public (encoding-permutation input-encoding
-                                    output-encoding)
-
-  "Contruct a permutation by applying output-encoding after input-encoding "
+(define-public (make-encoding-mapping input-encoding output-encoding)
+  "Contruct a mapping by applying output-encoding after input-encoding "
   (list->vector
    (map
-    (lambda (chr)
-      (let*
-         ((new-char (hash-ref output-encoding
-                              (vector-ref input-encoding (char->integer chr)) #f)))
+    (lambda (byte)
+      (let ((new-char (hash-ref
+                      output-encoding (vector-ref input-encoding byte) #f)))
+                      ;;input-encoding (vector-ref output-encoding byte) #f)))
 
        ;; substitute space for unknown characters.
        (if (char? new-char)
@@ -64,59 +62,66 @@ vector of symbols."
 
 (define (get-coding-from-file filename)
   "Read FILENAME, return a list containing encoding vector and table"
-  
-  (let*
-      ((vec (read-encoding-file filename))
-       (tab (make-encoding-table vec)))
-    (list vec tab)))
+   (let* ((coding (read-encoding-file filename))
+         (com (car coding))
+         (vec (cdr coding))
+         (tab (make-encoding-table vec)))
+    (list com vec tab)))
 
-;; coding-alist maps NAME -> (list VECTOR TAB)
+;; coding-alist maps NAME -> (list FILENAME COMMAND VECTOR TAB)
 (define coding-alist
   
   (map (lambda (x)
         (cons (car x)
-              (delay (get-coding-from-file (cdr x)))))
+              (cons (cdr x) (delay (get-coding-from-file (cdr x))))))
        
        '(
-        ;; teTeX
-        ("TeX typewriter text" . "09fbbfac.enc") ;; cmtt10
-        ("TeX math symbols" . "10037936.enc") ;; cmbsy
-        ("ASCII caps and digits" . "1b6d048e") ;; cminch
-        ("TeX math italic" . "aae443f0.enc")  ;; cmmi10
-        ("TeX extended ASCII" . "d9b29452.enc")
-        ("TeX text" . "f7b6d320.enc")
-        ("TeX text without f-ligatures" . "0ef0afca.enc")
-        ("Extended TeX Font Encoding - Latin" . "tex256.enc")
-        
+        ;; teTeX font (output) encodings
+        ("TeX-typewriter-text" . "09fbbfac.enc") ;; cmtt10
+        ("TeX-math-symbols" . "10037936.enc") ;; cmbsy
+        ("ASCII-caps-and-digits" . "1b6d048e.enc") ;; cminch
+        ("TeX-math-italic" . "aae443f0.enc")  ;; cmmi10
+        ("TeX-extended-ASCII" . "d9b29452.enc")
+        ("TeX-text" . "cmr.enc")
+        ("TeX-text-without-f-ligatures" . "0ef0afca.enc")
+        ("Extended-TeX-Font-Encoding---Latin" . "tex256.enc")
+        ("AdobeStandardEncoding" . "8a.enc")
         ("T1" . "tex256.enc")
-
-        ;; for testing -- almost adome
-        ("adobe" . "ad.enc")
-        ("latin1" . "cork.enc")
+        ("adobe" . "8a.enc")
+        ("ec" . "EC.enc")
         
-        ;; LilyPond.
-        ("feta braces" . "feta-braces0.enc")
-        ("feta number" . "feta-nummer10.enc")
-        ("feta music" . "feta20.enc")
-        ("parmesan music" . "parmesan20.enc"))
+        ;; input encodings
+        ("latin1" . "latin1.enc")
+        ("cork" . "cork.enc")
+
+        ;; LilyPond FETA music font
+        ("fetaBraces" . "feta-braces-a.enc")
+        ("fetaNumber" . "feta-nummer10.enc")
+        ("fetaMusic" . "feta20.enc")
+        ("parmesanMusic" . "parmesan20.enc"))
        ))
 
 (define (get-coding coding-name)
-  (force (assoc-get coding-name coding-alist )))
-
-(define (get-coding-vector coding-name)
+  (let ((entry (assoc-get coding-name coding-alist)))
+    (if entry
+       (cons (car entry) (force (cdr entry)))
+       (if (equal? coding-name "feta-music")
+           (begin
+             (ly:warn "installation problem: deprecated encoding requested: ~S" coding-name)
+             (exit 1))
+           (let ((fallback "latin1"))
+             (ly:programming-error "no such encoding: ~S" coding-name)
+             (ly:programming-error "programming error: cross thumbs, using: ~S:" fallback)
+             (get-coding fallback))))))
+
+(define-public (get-coding-filename coding-name)
   (car (get-coding coding-name)))
 
-(define (get-coding-table coding-name)
+(define-public (get-coding-command coding-name)
   (cadr (get-coding coding-name)))
 
+(define-public (get-coding-vector coding-name)
+  (caddr (get-coding coding-name)))
 
-;;; what's this for? --hwn
-(define-public (encoded-index font-coding input-coding code)
-  (format (current-error-port) "CODE: ~S\n" code)
-  (let* ((font (get-coding-table font-coding))
-        (in (get-coding-vector input-coding))
-        (char (vector-ref in code)))
-    (format (current-error-port) "CHAR: ~S\n" char)
-    (hash-ref font char)))
-
+(define-public (get-coding-table coding-name)
+  (cadddr (get-coding coding-name)))