Mercurial > emacs

changeset 64275:a6a8c13a3caa

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(ccl-encode-mac-roman-font, ccl-encode-mac-centraleurroman-font) (ccl-encode-mac-cyrillic-font, ccl-encode-mac-symbol-font): (ccl-encode-mac-dingbats-font): Remove check for ASCII. Change charset-id boundary of dimension to ?\xef. (mac-char-fontspec-list): New constant. (fontset-add-mac-fonts): Use it. Accept non-string `base-family' argument. Nil uses itself as family in font-spec. Previous behavior for nil is now provided by non-nil non-string argument. All callers changed. Add font-specs for Mac fonts to "fontset-default" unless iso8859-1 fonts are installed.
author YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
date Wed, 13 Jul 2005 09:11:35 +0000
parents 33ac839960ee
children 0a062d2d75f3
files lisp/term/mac-win.el
diffstat 1 files changed, 105 insertions(+), 59 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/term/mac-win.el	Wed Jul 13 05:38:25 2005 +0000
+++ b/lisp/term/mac-win.el	Wed Jul 13 09:11:35 2005 +0000
@@ -1561,54 +1561,52 @@
 	    (if mac-encoded
 		(aset table c mac-encoded))))))))
 
+;; We assume none of official dim2 charsets (0x90..0x99) are encoded
+;; to these fonts.
+
 (define-ccl-program ccl-encode-mac-roman-font
   `(0
-    (if (r0 != ,(charset-id 'ascii))
-	(if (r0 <= ?\x8f)
-	    (translate-character mac-roman-encoder r0 r1)
-	  ((r1 <<= 7)
-	   (r1 |= r2)
-	   (translate-character mac-roman-encoder r0 r1)))))
+    (if (r0 <= ?\xef)
+	(translate-character mac-roman-encoder r0 r1)
+      ((r1 <<= 7)
+       (r1 |= r2)
+       (translate-character mac-roman-encoder r0 r1))))
   "CCL program for Mac Roman font")
 
 (define-ccl-program ccl-encode-mac-centraleurroman-font
   `(0
-    (if (r0 != ,(charset-id 'ascii))
-	(if (r0 <= ?\x8f)
-	    (translate-character encode-mac-centraleurroman r0 r1)
-	  ((r1 <<= 7)
-	   (r1 |= r2)
-	   (translate-character encode-mac-centraleurroman r0 r1)))))
+    (if (r0 <= ?\xef)
+	(translate-character encode-mac-centraleurroman r0 r1)
+      ((r1 <<= 7)
+       (r1 |= r2)
+       (translate-character encode-mac-centraleurroman r0 r1))))
   "CCL program for Mac Central European Roman font")
 
 (define-ccl-program ccl-encode-mac-cyrillic-font
   `(0
-    (if (r0 != ,(charset-id 'ascii))
-	(if (r0 <= ?\x8f)
-	    (translate-character encode-mac-cyrillic r0 r1)
-	  ((r1 <<= 7)
-	   (r1 |= r2)
-	   (translate-character encode-mac-cyrillic r0 r1)))))
+    (if (r0 <= ?\xef)
+	(translate-character encode-mac-cyrillic r0 r1)
+      ((r1 <<= 7)
+       (r1 |= r2)
+       (translate-character encode-mac-cyrillic r0 r1))))
   "CCL program for Mac Cyrillic font")
 
 (define-ccl-program ccl-encode-mac-symbol-font
   `(0
-    (if (r0 != ,(charset-id 'ascii))
-	(if (r0 <= ?\x8f)
-	    (translate-character mac-symbol-encoder r0 r1)
-	  ((r1 <<= 7)
-	   (r1 |= r2)
-	   (translate-character mac-symbol-encoder r0 r1)))))
+    (if (r0 <= ?\xef)
+	(translate-character mac-symbol-encoder r0 r1)
+      ((r1 <<= 7)
+       (r1 |= r2)
+       (translate-character mac-symbol-encoder r0 r1))))
   "CCL program for Mac Symbol font")
 
 (define-ccl-program ccl-encode-mac-dingbats-font
   `(0
-    (if (r0 != ,(charset-id 'ascii))
-	(if (r0 <= ?\x8f)
-	    (translate-character mac-dingbats-encoder r0 r1)
-	  ((r1 <<= 7)
-	   (r1 |= r2)
-	   (translate-character mac-dingbats-encoder r0 r1)))))
+    (if (r0 <= ?\xef)
+	(translate-character mac-dingbats-encoder r0 r1)
+      ((r1 <<= 7)
+       (r1 |= r2)
+       (translate-character mac-dingbats-encoder r0 r1))))
   "CCL program for Mac Dingbats font")
 
 
@@ -1618,35 +1616,80 @@
 	       mac-font-encoder-list)
        font-ccl-encoder-alist))
 
+(defconst mac-char-fontspec-list
+  ;; Directly operate on a char-table instead of a fontset so that it
+  ;; may not create a dummy fontset.
+  (let ((template (make-char-table 'fontset)))
+    (dolist
+	(font-encoder
+	 (nreverse
+	  (mapcar (lambda (lst)
+		    (cons (cons (nth 3 lst) (nth 0 lst)) (nth 1 lst)))
+		  mac-font-encoder-list)))
+      (let ((font (car font-encoder))
+	    (encoder (cdr font-encoder)))
+	(map-char-table
+	 (lambda (key val)
+	   (or (null val)
+	       (generic-char-p key)
+	       (memq (char-charset key)
+		     '(ascii eight-bit-control eight-bit-graphic))
+	       (aset template key font)))
+	 (get encoder 'translation-table))))
+
+    ;; Like fontset-info, but extend a range only if its "to" part is
+    ;; the predecessor of the current char.
+    (let* ((last '((0 nil)))
+	   (accumulator last)
+	   last-char-or-range last-char last-elt)
+      (map-char-table
+       (lambda (char elt)
+	 (when elt
+	   (setq last-char-or-range (car (car last))
+		 last-char (if (consp last-char-or-range)
+			       (cdr last-char-or-range)
+			     last-char-or-range)
+		 last-elt (cdr (car last)))
+	   (if (and (eq elt last-elt)
+		    (= char (1+ last-char))
+		    (eq (char-charset char) (char-charset last-char)))
+	       (if (consp last-char-or-range)
+		   (setcdr last-char-or-range char)
+		 (setcar (car last) (cons last-char char)))
+	     (setcdr last (list (cons char elt)))
+	     (setq last (cdr last)))))
+       template)
+      (cdr accumulator))))
+
 (defun fontset-add-mac-fonts (fontset &optional base-family)
+  "Add font-specs for Mac fonts to FONTSET.
+The added font-specs are determined by BASE-FAMILY and the value
+of `mac-char-fontspec-list', which is a list
+of (CHARACTER-OR-RANGE . (FAMILY-FORMAT . REGISTRY)).  If
+BASE-FAMILY is nil, the font family in the added font-specs is
+also nil.  If BASE-FAMILY is a string, `%s' in FAMILY-FORMAT is
+replaced with the string.  Otherwise, `%s' in FAMILY-FORMAT is
+replaced with the ASCII font family name in FONTSET."
   (if base-family
-      (setq base-family (downcase base-family))
-    (let ((ascii-font
-	   (downcase (x-resolve-font-name
-		      (fontset-font fontset (charset-id 'ascii))))))
-      (setq base-family (aref (x-decompose-font-name ascii-font)
-			      xlfd-regexp-family-subnum))))
-;;  (if (not (string-match "^fontset-" fontset))
-;;      (setq fontset
-;;	    (concat "fontset-" (aref (x-decompose-font-name fontset)
-;;				     xlfd-regexp-encoding-subnum))))
-  (dolist
-      (font-encoder
-       (nreverse
-	(mapcar (lambda (lst)
-		  (cons (cons (format (nth 3 lst) base-family) (nth 0 lst))
-			(nth 1 lst)))
-		mac-font-encoder-list)))
-    (let ((font (car font-encoder))
-	  (encoder (cdr font-encoder)))
-      (map-char-table
-       (lambda (key val)
-	 (or (null val)
-	     (generic-char-p key)
-	     (memq (char-charset key)
-		   '(ascii eight-bit-control eight-bit-graphic))
-	     (set-fontset-font fontset key font)))
-       (get encoder 'translation-table)))))
+      (if (stringp base-family)
+	  (setq base-family (downcase base-family))
+	(let ((ascii-font (fontset-font fontset (charset-id 'ascii))))
+	  (if ascii-font
+	      (setq base-family
+		    (aref (x-decompose-font-name
+			   (downcase (x-resolve-font-name ascii-font)))
+			  xlfd-regexp-family-subnum))))))
+  (let (fontspec-cache fontspec)
+    (dolist (char-fontspec mac-char-fontspec-list)
+      (setq fontspec (cdr (assq (cdr char-fontspec) fontspec-cache)))
+      (when (null fontspec)
+	(setq fontspec
+	      (cons (and base-family
+			 (format (car (cdr char-fontspec)) base-family))
+		    (cdr (cdr char-fontspec))))
+	(setq fontspec-cache (cons (cons (cdr char-fontspec) fontspec)
+				   fontspec-cache)))
+      (set-fontset-font fontset (car char-fontspec) fontspec))))
 
 (defun create-fontset-from-mac-roman-font (font &optional resolved-font
 						fontset-name)
@@ -1663,11 +1706,14 @@
 It returns a name of the created fontset."
   (let ((fontset
 	 (create-fontset-from-ascii-font font resolved-font fontset-name)))
-    (fontset-add-mac-fonts fontset)
+    (fontset-add-mac-fonts fontset t)
     fontset))
 
 ;; Setup the default fontset.
 (setup-default-fontset)
+;; Add Mac-encoding fonts unless ETL fonts are installed.
+(unless (x-list-fonts "*-iso8859-1")
+  (fontset-add-mac-fonts "fontset-default"))
 
 ;; Create a fontset that uses mac-roman font.  With this fontset,
 ;; characters decoded from mac-roman encoding (ascii, latin-iso8859-1,
@@ -1675,7 +1721,7 @@
 (create-fontset-from-fontset-spec
  "-etl-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-mac,
 ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman")
-(fontset-add-mac-fonts "fontset-mac")
+(fontset-add-mac-fonts "fontset-mac" t)
 
 ;; Create fontset specified in X resources "Fontset-N" (N is 0, 1, ...).
 (create-fontset-from-x-resource)