Mercurial > emacs
comparison lisp/term/mac-win.el @ 71500:fd5f866a10be
(mac-handle-font-selection): Change keys of
mac-atsu-font-table from strings to numbers.
(mac-ts-caret-position): Use also when cursor-type is nil.
(mac-ts-update-active-input-area): Add Mac OS Classic support.
Relax condition for using overlay strings. Use
mac-ts-caret-position face when cursor-type is nil.
| author | YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> |
|---|---|
| date | Wed, 28 Jun 2006 08:28:38 +0000 |
| parents | a183bff9cb83 |
| children | 59670fc88353 b19aaf4ab0ee 138ce2701550 |
comparison
equal
deleted
inserted
replaced
| 71499:51f7fe4f6552 | 71500:fd5f866a10be |
|---|---|
| 1782 (defun mac-handle-font-selection (event) | 1782 (defun mac-handle-font-selection (event) |
| 1783 "Change default face attributes according to font selection EVENT." | 1783 "Change default face attributes according to font selection EVENT." |
| 1784 (interactive "e") | 1784 (interactive "e") |
| 1785 (let* ((ae (mac-event-ae event)) | 1785 (let* ((ae (mac-event-ae event)) |
| 1786 (fm-font-size (mac-ae-number ae "fmsz")) | 1786 (fm-font-size (mac-ae-number ae "fmsz")) |
| 1787 (atsu-font-id (cdr (mac-ae-parameter ae "auid"))) | 1787 (atsu-font-id (mac-ae-number ae "auid")) |
| 1788 (attribute-values (gethash atsu-font-id mac-atsu-font-table))) | 1788 (attribute-values (gethash atsu-font-id mac-atsu-font-table))) |
| 1789 (if fm-font-size | 1789 (if fm-font-size |
| 1790 (setq attribute-values | 1790 (setq attribute-values |
| 1791 `(:height ,(* 10 fm-font-size) ,@attribute-values))) | 1791 `(:height ,(* 10 fm-font-size) ,@attribute-values))) |
| 1792 (apply 'set-face-attribute 'default (selected-frame) attribute-values))) | 1792 (apply 'set-face-attribute 'default (selected-frame) attribute-values))) |
| 1813 (setq mac-ts-active-input-overlay (make-overlay 0 0)) | 1813 (setq mac-ts-active-input-overlay (make-overlay 0 0)) |
| 1814 | 1814 |
| 1815 (defface mac-ts-caret-position | 1815 (defface mac-ts-caret-position |
| 1816 '((t :inverse-video t)) | 1816 '((t :inverse-video t)) |
| 1817 "Face for caret position in Mac TSM active input area. | 1817 "Face for caret position in Mac TSM active input area. |
| 1818 This is used only when the active input area is displayed in the | 1818 This is used when the active input area is displayed either in |
| 1819 echo area." | 1819 the echo area or in a buffer where the cursor is not displayed." |
| 1820 :group 'mac) | 1820 :group 'mac) |
| 1821 | 1821 |
| 1822 (defface mac-ts-raw-text | 1822 (defface mac-ts-raw-text |
| 1823 '((t :underline t)) | 1823 '((t :underline t)) |
| 1824 "Face for raw text in Mac TSM active input area." | 1824 "Face for raw text in Mac TSM active input area." |
| 1961 The confirmed text is converted to Emacs input events and pushed | 1961 The confirmed text is converted to Emacs input events and pushed |
| 1962 into `unread-command-events'. The unconfirmed text is displayed | 1962 into `unread-command-events'. The unconfirmed text is displayed |
| 1963 either in the current buffer or in the echo area." | 1963 either in the current buffer or in the echo area." |
| 1964 (interactive "e") | 1964 (interactive "e") |
| 1965 (let* ((ae (mac-event-ae event)) | 1965 (let* ((ae (mac-event-ae event)) |
| 1966 (text (or (cdr (mac-ae-parameter ae "tstx" "utxt")) "")) | 1966 (type-text (mac-ae-parameter ae "tstx")) |
| 1967 (text (or (cdr type-text) "")) | |
| 1968 (decode-fun (if (equal (car type-text) "TEXT") | |
| 1969 'mac-TEXT-to-string 'mac-utxt-to-string)) | |
| 1967 (script-language (mac-ae-script-language ae "tssl")) | 1970 (script-language (mac-ae-script-language ae "tssl")) |
| 1968 (coding (or (cdr (assq (car script-language) | 1971 (coding (or (cdr (assq (car script-language) |
| 1969 mac-script-code-coding-systems)) | 1972 mac-script-code-coding-systems)) |
| 1970 'mac-roman)) | 1973 'mac-roman)) |
| 1971 (fix-len (mac-ae-number ae "tsfx")) | 1974 (fix-len (mac-ae-number ae "tsfx")) |
| 1983 (mac-ts-update-active-input-buf text fix-len hilite-rng update-rng)) | 1986 (mac-ts-update-active-input-buf text fix-len hilite-rng update-rng)) |
| 1984 (let ((use-echo-area | 1987 (let ((use-echo-area |
| 1985 (or isearch-mode | 1988 (or isearch-mode |
| 1986 (and cursor-in-echo-area (current-message)) | 1989 (and cursor-in-echo-area (current-message)) |
| 1987 ;; Overlay strings are not shown in some cases. | 1990 ;; Overlay strings are not shown in some cases. |
| 1988 (get-char-property (point) 'display) | |
| 1989 (get-char-property (point) 'invisible) | 1991 (get-char-property (point) 'invisible) |
| 1990 (get-char-property (point) 'composition))) | 1992 (and (not (bobp)) |
| 1993 (or (and (get-char-property (point) 'display) | |
| 1994 (eq (get-char-property (1- (point)) 'display) | |
| 1995 (get-char-property (point) 'display))) | |
| 1996 (and (get-char-property (point) 'composition) | |
| 1997 (eq (get-char-property (1- (point)) 'composition) | |
| 1998 (get-char-property (point) 'composition))))))) | |
| 1991 active-input-string caret-seen) | 1999 active-input-string caret-seen) |
| 1992 ;; Decode the active input area text with inheriting faces and | 2000 ;; Decode the active input area text with inheriting faces and |
| 1993 ;; the caret position. | 2001 ;; the caret position. |
| 1994 (setq active-input-string | 2002 (setq active-input-string |
| 1995 (mapconcat | 2003 (mapconcat |
| 1996 (lambda (str) | 2004 (lambda (str) |
| 1997 (let ((decoded (mac-utxt-to-string str coding))) | 2005 (let ((decoded (funcall decode-fun str coding))) |
| 1998 (put-text-property 0 (length decoded) 'face | 2006 (put-text-property 0 (length decoded) 'face |
| 1999 (get-text-property 0 'face str) decoded) | 2007 (get-text-property 0 'face str) decoded) |
| 2000 (when (and (not caret-seen) | 2008 (when (and (not caret-seen) |
| 2001 (get-text-property 0 'cursor str)) | 2009 (get-text-property 0 'cursor str)) |
| 2002 (setq caret-seen t) | 2010 (setq caret-seen t) |
| 2003 (if use-echo-area | 2011 (if (or use-echo-area (null cursor-type)) |
| 2004 (put-text-property 0 1 'face 'mac-ts-caret-position | 2012 (put-text-property 0 1 'face 'mac-ts-caret-position |
| 2005 decoded) | 2013 decoded) |
| 2006 (put-text-property 0 1 'cursor t decoded))) | 2014 (put-text-property 0 1 'cursor t decoded))) |
| 2007 decoded)) | 2015 decoded)) |
| 2008 (mac-split-string-by-property-change mac-ts-active-input-buf) | 2016 (mac-split-string-by-property-change mac-ts-active-input-buf) |
| 2028 active-input-string)) | 2036 active-input-string)) |
| 2029 ;; Unread confirmed characters and insert them in a keyboard | 2037 ;; Unread confirmed characters and insert them in a keyboard |
| 2030 ;; macro being defined. | 2038 ;; macro being defined. |
| 2031 (apply 'isearch-unread | 2039 (apply 'isearch-unread |
| 2032 (append (mac-replace-untranslated-utf-8-chars | 2040 (append (mac-replace-untranslated-utf-8-chars |
| 2033 (mac-utxt-to-string confirmed coding)) '()))) | 2041 (funcall decode-fun confirmed coding)) '()))) |
| 2034 ;; The event is successfully processed. Sync the sequence number. | 2042 ;; The event is successfully processed. Sync the sequence number. |
| 2035 (setq mac-ts-update-active-input-area-seqno (1+ seqno)))) | 2043 (setq mac-ts-update-active-input-area-seqno (1+ seqno)))) |
| 2036 | 2044 |
| 2037 (defun mac-ts-unicode-for-key-event (event) | 2045 (defun mac-ts-unicode-for-key-event (event) |
| 2038 "Convert Unicode key EVENT to Emacs key events and unread them." | 2046 "Convert Unicode key EVENT to Emacs key events and unread them." |