Mercurial > emacs
comparison lisp/term/mac-win.el @ 64275:a6a8c13a3caa
(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 | 4748803d9fb2 |
children | 34bd8e434dd7 fbb2bea03df9 |
comparison
equal
deleted
inserted
replaced
64274:33ac839960ee | 64275:a6a8c13a3caa |
---|---|
1559 (mu (aref ucs-mule-to-mule-unicode c)) | 1559 (mu (aref ucs-mule-to-mule-unicode c)) |
1560 (mac-encoded (and mu (aref table mu)))) | 1560 (mac-encoded (and mu (aref table mu)))) |
1561 (if mac-encoded | 1561 (if mac-encoded |
1562 (aset table c mac-encoded)))))))) | 1562 (aset table c mac-encoded)))))))) |
1563 | 1563 |
1564 ;; We assume none of official dim2 charsets (0x90..0x99) are encoded | |
1565 ;; to these fonts. | |
1566 | |
1564 (define-ccl-program ccl-encode-mac-roman-font | 1567 (define-ccl-program ccl-encode-mac-roman-font |
1565 `(0 | 1568 `(0 |
1566 (if (r0 != ,(charset-id 'ascii)) | 1569 (if (r0 <= ?\xef) |
1567 (if (r0 <= ?\x8f) | 1570 (translate-character mac-roman-encoder r0 r1) |
1568 (translate-character mac-roman-encoder r0 r1) | 1571 ((r1 <<= 7) |
1569 ((r1 <<= 7) | 1572 (r1 |= r2) |
1570 (r1 |= r2) | 1573 (translate-character mac-roman-encoder r0 r1)))) |
1571 (translate-character mac-roman-encoder r0 r1))))) | |
1572 "CCL program for Mac Roman font") | 1574 "CCL program for Mac Roman font") |
1573 | 1575 |
1574 (define-ccl-program ccl-encode-mac-centraleurroman-font | 1576 (define-ccl-program ccl-encode-mac-centraleurroman-font |
1575 `(0 | 1577 `(0 |
1576 (if (r0 != ,(charset-id 'ascii)) | 1578 (if (r0 <= ?\xef) |
1577 (if (r0 <= ?\x8f) | 1579 (translate-character encode-mac-centraleurroman r0 r1) |
1578 (translate-character encode-mac-centraleurroman r0 r1) | 1580 ((r1 <<= 7) |
1579 ((r1 <<= 7) | 1581 (r1 |= r2) |
1580 (r1 |= r2) | 1582 (translate-character encode-mac-centraleurroman r0 r1)))) |
1581 (translate-character encode-mac-centraleurroman r0 r1))))) | |
1582 "CCL program for Mac Central European Roman font") | 1583 "CCL program for Mac Central European Roman font") |
1583 | 1584 |
1584 (define-ccl-program ccl-encode-mac-cyrillic-font | 1585 (define-ccl-program ccl-encode-mac-cyrillic-font |
1585 `(0 | 1586 `(0 |
1586 (if (r0 != ,(charset-id 'ascii)) | 1587 (if (r0 <= ?\xef) |
1587 (if (r0 <= ?\x8f) | 1588 (translate-character encode-mac-cyrillic r0 r1) |
1588 (translate-character encode-mac-cyrillic r0 r1) | 1589 ((r1 <<= 7) |
1589 ((r1 <<= 7) | 1590 (r1 |= r2) |
1590 (r1 |= r2) | 1591 (translate-character encode-mac-cyrillic r0 r1)))) |
1591 (translate-character encode-mac-cyrillic r0 r1))))) | |
1592 "CCL program for Mac Cyrillic font") | 1592 "CCL program for Mac Cyrillic font") |
1593 | 1593 |
1594 (define-ccl-program ccl-encode-mac-symbol-font | 1594 (define-ccl-program ccl-encode-mac-symbol-font |
1595 `(0 | 1595 `(0 |
1596 (if (r0 != ,(charset-id 'ascii)) | 1596 (if (r0 <= ?\xef) |
1597 (if (r0 <= ?\x8f) | 1597 (translate-character mac-symbol-encoder r0 r1) |
1598 (translate-character mac-symbol-encoder r0 r1) | 1598 ((r1 <<= 7) |
1599 ((r1 <<= 7) | 1599 (r1 |= r2) |
1600 (r1 |= r2) | 1600 (translate-character mac-symbol-encoder r0 r1)))) |
1601 (translate-character mac-symbol-encoder r0 r1))))) | |
1602 "CCL program for Mac Symbol font") | 1601 "CCL program for Mac Symbol font") |
1603 | 1602 |
1604 (define-ccl-program ccl-encode-mac-dingbats-font | 1603 (define-ccl-program ccl-encode-mac-dingbats-font |
1605 `(0 | 1604 `(0 |
1606 (if (r0 != ,(charset-id 'ascii)) | 1605 (if (r0 <= ?\xef) |
1607 (if (r0 <= ?\x8f) | 1606 (translate-character mac-dingbats-encoder r0 r1) |
1608 (translate-character mac-dingbats-encoder r0 r1) | 1607 ((r1 <<= 7) |
1609 ((r1 <<= 7) | 1608 (r1 |= r2) |
1610 (r1 |= r2) | 1609 (translate-character mac-dingbats-encoder r0 r1)))) |
1611 (translate-character mac-dingbats-encoder r0 r1))))) | |
1612 "CCL program for Mac Dingbats font") | 1610 "CCL program for Mac Dingbats font") |
1613 | 1611 |
1614 | 1612 |
1615 (setq font-ccl-encoder-alist | 1613 (setq font-ccl-encoder-alist |
1616 (nconc | 1614 (nconc |
1617 (mapcar (lambda (lst) (cons (nth 0 lst) (nth 2 lst))) | 1615 (mapcar (lambda (lst) (cons (nth 0 lst) (nth 2 lst))) |
1618 mac-font-encoder-list) | 1616 mac-font-encoder-list) |
1619 font-ccl-encoder-alist)) | 1617 font-ccl-encoder-alist)) |
1620 | 1618 |
1619 (defconst mac-char-fontspec-list | |
1620 ;; Directly operate on a char-table instead of a fontset so that it | |
1621 ;; may not create a dummy fontset. | |
1622 (let ((template (make-char-table 'fontset))) | |
1623 (dolist | |
1624 (font-encoder | |
1625 (nreverse | |
1626 (mapcar (lambda (lst) | |
1627 (cons (cons (nth 3 lst) (nth 0 lst)) (nth 1 lst))) | |
1628 mac-font-encoder-list))) | |
1629 (let ((font (car font-encoder)) | |
1630 (encoder (cdr font-encoder))) | |
1631 (map-char-table | |
1632 (lambda (key val) | |
1633 (or (null val) | |
1634 (generic-char-p key) | |
1635 (memq (char-charset key) | |
1636 '(ascii eight-bit-control eight-bit-graphic)) | |
1637 (aset template key font))) | |
1638 (get encoder 'translation-table)))) | |
1639 | |
1640 ;; Like fontset-info, but extend a range only if its "to" part is | |
1641 ;; the predecessor of the current char. | |
1642 (let* ((last '((0 nil))) | |
1643 (accumulator last) | |
1644 last-char-or-range last-char last-elt) | |
1645 (map-char-table | |
1646 (lambda (char elt) | |
1647 (when elt | |
1648 (setq last-char-or-range (car (car last)) | |
1649 last-char (if (consp last-char-or-range) | |
1650 (cdr last-char-or-range) | |
1651 last-char-or-range) | |
1652 last-elt (cdr (car last))) | |
1653 (if (and (eq elt last-elt) | |
1654 (= char (1+ last-char)) | |
1655 (eq (char-charset char) (char-charset last-char))) | |
1656 (if (consp last-char-or-range) | |
1657 (setcdr last-char-or-range char) | |
1658 (setcar (car last) (cons last-char char))) | |
1659 (setcdr last (list (cons char elt))) | |
1660 (setq last (cdr last))))) | |
1661 template) | |
1662 (cdr accumulator)))) | |
1663 | |
1621 (defun fontset-add-mac-fonts (fontset &optional base-family) | 1664 (defun fontset-add-mac-fonts (fontset &optional base-family) |
1665 "Add font-specs for Mac fonts to FONTSET. | |
1666 The added font-specs are determined by BASE-FAMILY and the value | |
1667 of `mac-char-fontspec-list', which is a list | |
1668 of (CHARACTER-OR-RANGE . (FAMILY-FORMAT . REGISTRY)). If | |
1669 BASE-FAMILY is nil, the font family in the added font-specs is | |
1670 also nil. If BASE-FAMILY is a string, `%s' in FAMILY-FORMAT is | |
1671 replaced with the string. Otherwise, `%s' in FAMILY-FORMAT is | |
1672 replaced with the ASCII font family name in FONTSET." | |
1622 (if base-family | 1673 (if base-family |
1623 (setq base-family (downcase base-family)) | 1674 (if (stringp base-family) |
1624 (let ((ascii-font | 1675 (setq base-family (downcase base-family)) |
1625 (downcase (x-resolve-font-name | 1676 (let ((ascii-font (fontset-font fontset (charset-id 'ascii)))) |
1626 (fontset-font fontset (charset-id 'ascii)))))) | 1677 (if ascii-font |
1627 (setq base-family (aref (x-decompose-font-name ascii-font) | 1678 (setq base-family |
1628 xlfd-regexp-family-subnum)))) | 1679 (aref (x-decompose-font-name |
1629 ;; (if (not (string-match "^fontset-" fontset)) | 1680 (downcase (x-resolve-font-name ascii-font))) |
1630 ;; (setq fontset | 1681 xlfd-regexp-family-subnum)))))) |
1631 ;; (concat "fontset-" (aref (x-decompose-font-name fontset) | 1682 (let (fontspec-cache fontspec) |
1632 ;; xlfd-regexp-encoding-subnum)))) | 1683 (dolist (char-fontspec mac-char-fontspec-list) |
1633 (dolist | 1684 (setq fontspec (cdr (assq (cdr char-fontspec) fontspec-cache))) |
1634 (font-encoder | 1685 (when (null fontspec) |
1635 (nreverse | 1686 (setq fontspec |
1636 (mapcar (lambda (lst) | 1687 (cons (and base-family |
1637 (cons (cons (format (nth 3 lst) base-family) (nth 0 lst)) | 1688 (format (car (cdr char-fontspec)) base-family)) |
1638 (nth 1 lst))) | 1689 (cdr (cdr char-fontspec)))) |
1639 mac-font-encoder-list))) | 1690 (setq fontspec-cache (cons (cons (cdr char-fontspec) fontspec) |
1640 (let ((font (car font-encoder)) | 1691 fontspec-cache))) |
1641 (encoder (cdr font-encoder))) | 1692 (set-fontset-font fontset (car char-fontspec) fontspec)))) |
1642 (map-char-table | |
1643 (lambda (key val) | |
1644 (or (null val) | |
1645 (generic-char-p key) | |
1646 (memq (char-charset key) | |
1647 '(ascii eight-bit-control eight-bit-graphic)) | |
1648 (set-fontset-font fontset key font))) | |
1649 (get encoder 'translation-table))))) | |
1650 | 1693 |
1651 (defun create-fontset-from-mac-roman-font (font &optional resolved-font | 1694 (defun create-fontset-from-mac-roman-font (font &optional resolved-font |
1652 fontset-name) | 1695 fontset-name) |
1653 "Create a fontset from a Mac roman font FONT. | 1696 "Create a fontset from a Mac roman font FONT. |
1654 | 1697 |
1661 an appropriate name is generated automatically. | 1704 an appropriate name is generated automatically. |
1662 | 1705 |
1663 It returns a name of the created fontset." | 1706 It returns a name of the created fontset." |
1664 (let ((fontset | 1707 (let ((fontset |
1665 (create-fontset-from-ascii-font font resolved-font fontset-name))) | 1708 (create-fontset-from-ascii-font font resolved-font fontset-name))) |
1666 (fontset-add-mac-fonts fontset) | 1709 (fontset-add-mac-fonts fontset t) |
1667 fontset)) | 1710 fontset)) |
1668 | 1711 |
1669 ;; Setup the default fontset. | 1712 ;; Setup the default fontset. |
1670 (setup-default-fontset) | 1713 (setup-default-fontset) |
1714 ;; Add Mac-encoding fonts unless ETL fonts are installed. | |
1715 (unless (x-list-fonts "*-iso8859-1") | |
1716 (fontset-add-mac-fonts "fontset-default")) | |
1671 | 1717 |
1672 ;; Create a fontset that uses mac-roman font. With this fontset, | 1718 ;; Create a fontset that uses mac-roman font. With this fontset, |
1673 ;; characters decoded from mac-roman encoding (ascii, latin-iso8859-1, | 1719 ;; characters decoded from mac-roman encoding (ascii, latin-iso8859-1, |
1674 ;; and mule-unicode-xxxx-yyyy) are displayed by a mac-roman font. | 1720 ;; and mule-unicode-xxxx-yyyy) are displayed by a mac-roman font. |
1675 (create-fontset-from-fontset-spec | 1721 (create-fontset-from-fontset-spec |
1676 "-etl-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-mac, | 1722 "-etl-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-mac, |
1677 ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman") | 1723 ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman") |
1678 (fontset-add-mac-fonts "fontset-mac") | 1724 (fontset-add-mac-fonts "fontset-mac" t) |
1679 | 1725 |
1680 ;; Create fontset specified in X resources "Fontset-N" (N is 0, 1, ...). | 1726 ;; Create fontset specified in X resources "Fontset-N" (N is 0, 1, ...). |
1681 (create-fontset-from-x-resource) | 1727 (create-fontset-from-x-resource) |
1682 | 1728 |
1683 ;; Try to create a fontset from a font specification which comes | 1729 ;; Try to create a fontset from a font specification which comes |