/[emacs]/emacs/lisp/term/mac-win.el
ViewVC logotype

Diff of /emacs/lisp/term/mac-win.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.49 by mituharu, Tue Jul 12 11:32:40 2005 UTC revision 1.50 by mituharu, Wed Jul 13 09:11:35 2005 UTC
# Line 1561  in `selection-converter-alist', which se Line 1561  in `selection-converter-alist', which se
1561              (if mac-encoded              (if mac-encoded
1562                  (aset table c mac-encoded))))))))                  (aset table c mac-encoded))))))))
1563    
1564    ;; We assume none of official dim2 charsets (0x90..0x99) are encoded
1565    ;; to these fonts.
1566    
1567  (define-ccl-program ccl-encode-mac-roman-font  (define-ccl-program ccl-encode-mac-roman-font
1568    `(0    `(0
1569      (if (r0 != ,(charset-id 'ascii))      (if (r0 <= ?\xef)
1570          (if (r0 <= ?\x8f)          (translate-character mac-roman-encoder r0 r1)
1571              (translate-character mac-roman-encoder r0 r1)        ((r1 <<= 7)
1572            ((r1 <<= 7)         (r1 |= r2)
1573             (r1 |= r2)         (translate-character mac-roman-encoder r0 r1))))
            (translate-character mac-roman-encoder r0 r1)))))  
1574    "CCL program for Mac Roman font")    "CCL program for Mac Roman font")
1575    
1576  (define-ccl-program ccl-encode-mac-centraleurroman-font  (define-ccl-program ccl-encode-mac-centraleurroman-font
1577    `(0    `(0
1578      (if (r0 != ,(charset-id 'ascii))      (if (r0 <= ?\xef)
1579          (if (r0 <= ?\x8f)          (translate-character encode-mac-centraleurroman r0 r1)
1580              (translate-character encode-mac-centraleurroman r0 r1)        ((r1 <<= 7)
1581            ((r1 <<= 7)         (r1 |= r2)
1582             (r1 |= r2)         (translate-character encode-mac-centraleurroman r0 r1))))
            (translate-character encode-mac-centraleurroman r0 r1)))))  
1583    "CCL program for Mac Central European Roman font")    "CCL program for Mac Central European Roman font")
1584    
1585  (define-ccl-program ccl-encode-mac-cyrillic-font  (define-ccl-program ccl-encode-mac-cyrillic-font
1586    `(0    `(0
1587      (if (r0 != ,(charset-id 'ascii))      (if (r0 <= ?\xef)
1588          (if (r0 <= ?\x8f)          (translate-character encode-mac-cyrillic r0 r1)
1589              (translate-character encode-mac-cyrillic r0 r1)        ((r1 <<= 7)
1590            ((r1 <<= 7)         (r1 |= r2)
1591             (r1 |= r2)         (translate-character encode-mac-cyrillic r0 r1))))
            (translate-character encode-mac-cyrillic r0 r1)))))  
1592    "CCL program for Mac Cyrillic font")    "CCL program for Mac Cyrillic font")
1593    
1594  (define-ccl-program ccl-encode-mac-symbol-font  (define-ccl-program ccl-encode-mac-symbol-font
1595    `(0    `(0
1596      (if (r0 != ,(charset-id 'ascii))      (if (r0 <= ?\xef)
1597          (if (r0 <= ?\x8f)          (translate-character mac-symbol-encoder r0 r1)
1598              (translate-character mac-symbol-encoder r0 r1)        ((r1 <<= 7)
1599            ((r1 <<= 7)         (r1 |= r2)
1600             (r1 |= r2)         (translate-character mac-symbol-encoder r0 r1))))
            (translate-character mac-symbol-encoder r0 r1)))))  
1601    "CCL program for Mac Symbol font")    "CCL program for Mac Symbol font")
1602    
1603  (define-ccl-program ccl-encode-mac-dingbats-font  (define-ccl-program ccl-encode-mac-dingbats-font
1604    `(0    `(0
1605      (if (r0 != ,(charset-id 'ascii))      (if (r0 <= ?\xef)
1606          (if (r0 <= ?\x8f)          (translate-character mac-dingbats-encoder r0 r1)
1607              (translate-character mac-dingbats-encoder r0 r1)        ((r1 <<= 7)
1608            ((r1 <<= 7)         (r1 |= r2)
1609             (r1 |= r2)         (translate-character mac-dingbats-encoder r0 r1))))
            (translate-character mac-dingbats-encoder r0 r1)))))  
1610    "CCL program for Mac Dingbats font")    "CCL program for Mac Dingbats font")
1611    
1612    
# Line 1618  in `selection-converter-alist', which se Line 1616  in `selection-converter-alist', which se
1616                 mac-font-encoder-list)                 mac-font-encoder-list)
1617         font-ccl-encoder-alist))         font-ccl-encoder-alist))
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    
1664  (defun fontset-add-mac-fonts (fontset &optional base-family)  (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."
1673    (if base-family    (if base-family
1674        (setq base-family (downcase base-family))        (if (stringp base-family)
1675      (let ((ascii-font            (setq base-family (downcase base-family))
1676             (downcase (x-resolve-font-name          (let ((ascii-font (fontset-font fontset (charset-id 'ascii))))
1677                        (fontset-font fontset (charset-id 'ascii))))))            (if ascii-font
1678        (setq base-family (aref (x-decompose-font-name ascii-font)                (setq base-family
1679                                xlfd-regexp-family-subnum))))                      (aref (x-decompose-font-name
1680  ;;  (if (not (string-match "^fontset-" fontset))                             (downcase (x-resolve-font-name ascii-font)))
1681  ;;      (setq fontset                            xlfd-regexp-family-subnum))))))
1682  ;;          (concat "fontset-" (aref (x-decompose-font-name fontset)    (let (fontspec-cache fontspec)
1683  ;;                                   xlfd-regexp-encoding-subnum))))      (dolist (char-fontspec mac-char-fontspec-list)
1684    (dolist        (setq fontspec (cdr (assq (cdr char-fontspec) fontspec-cache)))
1685        (font-encoder        (when (null fontspec)
1686         (nreverse          (setq fontspec
1687          (mapcar (lambda (lst)                (cons (and base-family
1688                    (cons (cons (format (nth 3 lst) base-family) (nth 0 lst))                           (format (car (cdr char-fontspec)) base-family))
1689                          (nth 1 lst)))                      (cdr (cdr char-fontspec))))
1690                  mac-font-encoder-list)))          (setq fontspec-cache (cons (cons (cdr char-fontspec) fontspec)
1691      (let ((font (car font-encoder))                                     fontspec-cache)))
1692            (encoder (cdr font-encoder)))        (set-fontset-font fontset (car char-fontspec) fontspec))))
       (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)))))  
1693    
1694  (defun create-fontset-from-mac-roman-font (font &optional resolved-font  (defun create-fontset-from-mac-roman-font (font &optional resolved-font
1695                                                  fontset-name)                                                  fontset-name)
# Line 1663  an appropriate name is generated automat Line 1706  an appropriate name is generated automat
1706  It returns a name of the created fontset."  It returns a name of the created fontset."
1707    (let ((fontset    (let ((fontset
1708           (create-fontset-from-ascii-font font resolved-font fontset-name)))           (create-fontset-from-ascii-font font resolved-font fontset-name)))
1709      (fontset-add-mac-fonts fontset)      (fontset-add-mac-fonts fontset t)
1710      fontset))      fontset))
1711    
1712  ;; Setup the default fontset.  ;; Setup the default fontset.
1713  (setup-default-fontset)  (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"))
1717    
1718  ;; Create a fontset that uses mac-roman font.  With this fontset,  ;; Create a fontset that uses mac-roman font.  With this fontset,
1719  ;; characters decoded from mac-roman encoding (ascii, latin-iso8859-1,  ;; characters decoded from mac-roman encoding (ascii, latin-iso8859-1,
# Line 1675  It returns a name of the created fontset Line 1721  It returns a name of the created fontset
1721  (create-fontset-from-fontset-spec  (create-fontset-from-fontset-spec
1722   "-etl-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-mac,   "-etl-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-mac,
1723  ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman")  ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman")
1724  (fontset-add-mac-fonts "fontset-mac")  (fontset-add-mac-fonts "fontset-mac" t)
1725    
1726  ;; Create fontset specified in X resources "Fontset-N" (N is 0, 1, ...).  ;; Create fontset specified in X resources "Fontset-N" (N is 0, 1, ...).
1727  (create-fontset-from-x-resource)  (create-fontset-from-x-resource)

Legend:
Removed from v.1.49  
changed lines
  Added in v.1.50

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26