From: hanwen <hanwen>
Date: Tue, 6 Apr 2004 00:03:58 +0000 (+0000)
Subject: * scm/encoding.scm (read-encoding-file): split up large function,
X-Git-Tag: release/2.3.9^2~411
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=b34a1aa706bb3c812492046086dbe1df704edbc8;p=lilypond.git

* scm/encoding.scm (read-encoding-file): split up large function,
leave caching to (delay)

* lily/lily-guile.cc (LY_DEFINE): typecheck argument.
---

diff --git a/ChangeLog b/ChangeLog
index dae08f1149..694db14fd5 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2004-04-06  Han-Wen Nienhuys   <hanwen@xs4all.nl>
+
+	* scm/encoding.scm (read-encoding-file): split up large function,
+	leave caching to (delay)
+
+	* lily/lily-guile.cc (LY_DEFINE): typecheck argument.
+
 2004-04-05  Jan Nieuwenhuizen  <janneke@gnu.org>
 
 	* lily/my-lily-lexer.cc (set_encoding): New method.
diff --git a/lily/lexer.ll b/lily/lexer.ll
index a70a1af478..2f7b7fd91d 100644
--- a/lily/lexer.ll
+++ b/lily/lexer.ll
@@ -488,7 +488,7 @@ HYPHEN		--
 				return MARKUP_HEAD_SCM0_MARKUP1;
 			else if (tag == ly_symbol2scm ("scheme0-scheme1-markup2"))
 				return MARKUP_HEAD_SCM0_SCM1_MARKUP2;
-			else if (tag ==4 ly_symbol2scm ("scheme0-scheme1-scheme2"))
+			else if (tag == ly_symbol2scm ("scheme0-scheme1-scheme2"))
 				return MARKUP_HEAD_SCM0_SCM1_SCM2;
 			else {
 				programming_error ("No parser tag defined for this signature. Abort"); 
diff --git a/lily/lily-guile.cc b/lily/lily-guile.cc
index 5a259137fd..d2b9eec320 100644
--- a/lily/lily-guile.cc
+++ b/lily/lily-guile.cc
@@ -107,6 +107,7 @@ LY_DEFINE (ly_gulp_file, "ly:gulp-file",
 	   "Read the file @var{name}, and return its contents in a string.  "
 	   "The file is looked up using the search path.")
 {
+  SCM_ASSERT_TYPE (gh_string_p (name), name, SCM_ARG1, __FUNCTION__, "string");
   return scm_makfrom0str (gulp_file_to_string (ly_scm2string (name)).to_str0 ());
 }
 
diff --git a/mf/feta-beugel.mf b/mf/feta-beugel.mf
index 0278114472..aafc1a690e 100644
--- a/mf/feta-beugel.mf
+++ b/mf/feta-beugel.mf
@@ -94,7 +94,7 @@ for i := 0 step 1 until font_count:
     y := y + increment;
 
     if y > infinity/hppp:
-      message "Resolution/magnification is too high";
+      message "Resolution and/or magnification is too high";
       error please report: <bug-lilypond@gnu.org>;
     fi
 
diff --git a/scm/encoding.scm b/scm/encoding.scm
index 3c37774307..c0f9f5f3d6 100644
--- a/scm/encoding.scm
+++ b/scm/encoding.scm
@@ -11,59 +11,109 @@
 ;; #(display (reencode-string "adobe" "latin1" "hellö fóebär"))
 ;;
 
-(define coding-file-alist
-  ;; 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")
-    
-    ("T1" . "tex256.enc")
 
-    ;; for testing -- almost adome
-    ("adobe" . "ad.enc")
-    ("latin1" . "cork.enc")
-    
-    ;; LilyPond.
-    ("feta braces" . "feta-braces0.enc")
-    ("feta number" . "feta-nummer10.enc")
-    ("feta music" . "feta20.enc")
-    ("parmesan music" . "parmesan20.enc")))
-
-(define encoding-alist '())
-
-;; TODO: run this once and 'cache' output of (write lst) in <coding>.scm ?
-(define (read-coding-file coding)
-  (let* ((raw (ly:gulp-file (assoc-get coding coding-file-alist)))
-	 ;;(raw (ly:gulp-file "f7b6d320.enc"))
+(define (read-encoding-file filename)
+  "Read .enc file, returning a vector of symbols."
+  (let* ((raw (ly:gulp-file filename))
 	 (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))
-	 (vector (list->vector lst))
-	 (table (make-hash-table 256)))
-    (do ((i 0 (+ i 1)))
-	((>= i 256))
-      (hash-create-handle! table (vector-ref vector i) i))
-    (let ((entry (cons coding (cons vector table))))
-      (set! encoding-alist (append (list entry) encoding-alist))
-      (cdr entry))))
-
-(define (get-coding-table coding)
-  (let ((entry (assoc-get coding encoding-alist #f)))
-    (if entry (cdr entry)
-	(cdr (read-coding-file coding)))))
-
-(define (get-coding-vector coding)
-  (let ((entry (assoc-get coding encoding-alist #f)))
-    (if entry (car entry)
-	(car (read-coding-file coding)))))
+	 (vector (list->vector lst)))
+
+    vector))
+
+(define (make-encoding-table encoding-vector)
+  "Return a hash table mapping names to chars. ENCODING-VECTOR is a
+vector of symbols."
+
+  (let* ((h (make-hash-table 256)))
+    
+    (for-each
+     (lambda (i)
+       (hash-set! h (vector-ref encoding-vector i)
+		  (integer->char i)))
+     (iota 256))
+
+    h))
+
+(define-public (reencode-string permutation str)
+  "Apply PERMUTATION (a vector of [0..256) -> [0..256) to STR"
+  (string-map (lambda (chr)
+		(vector-ref permutation (char->integer chr)))
+	      str))
+
+(define-public (encoding-permutation input-encoding
+				     output-encoding)
+
+  "Contruct a permutation 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)))
+
+	;; substitute space for unknown characters.
+	(if (char? new-char)
+	    new-char
+	    #\ )))
+    (iota 256))))
 
+
+(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)))
+
+
+
+;; coding-alist maps NAME -> (list VECTOR TAB)
+(define coding-alist
+  
+  (map (lambda (x)
+	 (cons (car 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")
+	 
+	 ("T1" . "tex256.enc")
+
+	 ;; for testing -- almost adome
+	 ("adobe" . "ad.enc")
+	 ("latin1" . "cork.enc")
+	 
+	 ;; LilyPond.
+	 ("feta braces" . "feta-braces0.enc")
+	 ("feta number" . "feta-nummer10.enc")
+	 ("feta music" . "feta20.enc")
+	 ("parmesan music" . "parmesan20.enc"))
+       ))
+
+(define (get-coding coding-name)
+  (force (assoc-get coding-name coding-alist )))
+
+(define (get-coding-vector coding-name)
+  (car (get-coding coding-name)))
+
+(define (get-coding-table coding-name)
+  (cadr (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))
@@ -72,11 +122,3 @@
     (format (current-error-port) "CHAR: ~S\n" char)
     (hash-ref font char)))
 
-(define-public (reencode-string font-coding input-coding s)
-  ;; ughr?
-  (list->string
-   (map integer->char 
-	(map (lambda (x) (encoded-index font-coding input-coding x))
-	     ;;(map char->integer (string->list s))))))
-	     (map char->integer (plain-string->list s))))))
-