Mercurial > emacs

comparison lisp/term/mac-win.el @ 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 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