andros/emacs-gpu
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

(ccl-encode-mac-roman-font, ccl-encode-mac-centraleurroman-font)

Browse source 
(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.
This commit is contained in:
YAMAMOTO Mitsuharu 2005-07-13 09:11:35 +00:00
parent 69d05d838f
commit 852f7e6b6a
1 changed files with 106 additions and 60 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

166
lisp/term/mac-win.el
View file

@ -1561,54 +1561,52 @@ in `selection-converter-alist', which see."
(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 @@ in `selection-converter-alist', which see."
mac-font-encoder-list)
font-ccl-encoder-alist))
(defun fontset-add-mac-fonts (fontset &optional base-family)
(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)))
(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 (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)))))
(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
(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 @@ an appropriate name is generated automatically.
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 @@ It returns a name of the created fontset."
(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)