Commit dc34c597 authored by YAMAMOTO Mitsuharu's avatar YAMAMOTO Mitsuharu

(mac-ts-active-input-overlay): Add defvar.

(mac-ae-number, mac-ae-frame, mac-ae-script-language)
(mac-bytes-to-text-range, mac-ae-text-range-array)
(mac-ts-update-active-input-buf, mac-split-string-by-property-change)
(mac-replace-untranslated-utf-8-chars, mac-ts-update-active-input-area)
(mac-ts-unicode-for-key-event):	New functions.
(mac-handle-toolbar-switch-mode): Use mac-ae-frame.
(mac-handle-font-selection): Use mac-ae-number.
(mac-ts-active-input-buf, mac-ts-update-active-input-area-seqno):
New variables.
(mac-ts-caret-position, mac-ts-raw-text, mac-ts-selected-raw-text)
(mac-ts-converted-text, mac-ts-selected-converted-text)
(mac-ts-block-fill-text, mac-ts-outline-text)
(mac-ts-selected-text, mac-ts-no-hilite): New faces.
(mac-ts-hilite-style-faces): New constant.
(mac-apple-event-map): Bind text input events.
(mac-dispatch-apple-event): Use command-execute instead of
call-interactively.
(global-map): Don't bind mac-apple-event.
(special-event-map): Bind mac-apple-event.
parent 4985dde2
...@@ -84,6 +84,7 @@ ...@@ -84,6 +84,7 @@
(defvar mac-apple-event-map) (defvar mac-apple-event-map)
(defvar mac-atsu-font-table) (defvar mac-atsu-font-table)
(defvar mac-font-panel-mode) (defvar mac-font-panel-mode)
(defvar mac-ts-active-input-overlay)
(defvar x-invocation-args) (defvar x-invocation-args)
(defvar x-command-line-resources nil) (defvar x-command-line-resources nil)
...@@ -1570,6 +1571,15 @@ in `selection-converter-alist', which see." ...@@ -1570,6 +1571,15 @@ in `selection-converter-alist', which see."
(mac-coerce-ae-data (car type-data) (cdr type-data) type)) (mac-coerce-ae-data (car type-data) (cdr type-data) type))
(cdr desc))))))) (cdr desc)))))))
(defun mac-ae-number (ae keyword)
(let ((type-data (mac-ae-parameter ae keyword))
str)
(if (and type-data
(setq str (mac-coerce-ae-data (car type-data)
(cdr type-data) "TEXT")))
(string-to-number str)
nil)))
(defun mac-bytes-to-integer (bytes &optional from to) (defun mac-bytes-to-integer (bytes &optional from to)
(or from (setq from 0)) (or from (setq from 0))
(or to (setq to (length bytes))) (or to (setq to (length bytes)))
...@@ -1610,6 +1620,65 @@ in `selection-converter-alist', which see." ...@@ -1610,6 +1620,65 @@ in `selection-converter-alist', which see."
(and utf8-text (and utf8-text
(decode-coding-string utf8-text 'utf-8)))) (decode-coding-string utf8-text 'utf-8))))
(defun mac-ae-text (ae)
(or (cdr (mac-ae-parameter ae nil "TEXT"))
(error "No text in Apple event.")))
(defun mac-ae-frame (ae &optional keyword type)
(let ((bytes (cdr (mac-ae-parameter ae keyword type))))
(if (or (null bytes) (/= (length bytes) 4))
(error "No window reference in Apple event.")
(let ((window-id (mac-coerce-ae-data "long" bytes "TEXT"))
(rest (frame-list))
frame)
(while (and (null frame) rest)
(if (string= (frame-parameter (car rest) 'window-id) window-id)
(setq frame (car rest)))
(setq rest (cdr rest)))
frame))))
(defun mac-ae-script-language (ae keyword)
;; struct WritingCode {
;; ScriptCode theScriptCode;
;; LangCode theLangCode;
;; };
(let ((bytes (cdr (mac-ae-parameter ae keyword "intl"))))
(and bytes
(cons (mac-bytes-to-integer bytes 0 2)
(mac-bytes-to-integer bytes 2 4)))))
(defun mac-bytes-to-text-range (bytes &optional from to)
;; struct TextRange {
;; long fStart;
;; long fEnd;
;; short fHiliteStyle;
;; };
(or from (setq from 0))
(or to (setq to (length bytes)))
(and (= (- to from) (+ 4 4 2))
(list (mac-bytes-to-integer bytes from (+ from 4))
(mac-bytes-to-integer bytes (+ from 4) (+ from 8))
(mac-bytes-to-integer bytes (+ from 8) to))))
(defun mac-ae-text-range-array (ae keyword)
;; struct TextRangeArray {
;; short fNumOfRanges;
;; TextRange fRange[1];
;; };
(let* ((bytes (cdr (mac-ae-parameter ae keyword "tray")))
(len (length bytes))
nranges result)
(when (and bytes (>= len 2)
(progn
(setq nranges (mac-bytes-to-integer bytes 0 2))
(= len (+ 2 (* nranges 10)))))
(setq result (make-vector nranges nil))
(dotimes (i nranges)
(aset result i
(mac-bytes-to-text-range bytes (+ (* i 10) 2)
(+ (* i 10) 12)))))
result))
(defun mac-ae-open-documents (event) (defun mac-ae-open-documents (event)
"Open the documents specified by the Apple event EVENT." "Open the documents specified by the Apple event EVENT."
(interactive "e") (interactive "e")
...@@ -1637,10 +1706,6 @@ in `selection-converter-alist', which see." ...@@ -1637,10 +1706,6 @@ in `selection-converter-alist', which see."
nil t))))) nil t)))))
(select-frame-set-input-focus (selected-frame))) (select-frame-set-input-focus (selected-frame)))
(defun mac-ae-text (ae)
(or (cdr (mac-ae-parameter ae nil "TEXT"))
(error "No text in Apple event.")))
(defun mac-ae-get-url (event) (defun mac-ae-get-url (event)
"Open the URL specified by the Apple event EVENT. "Open the URL specified by the Apple event EVENT.
Currently the `mailto' scheme is supported." Currently the `mailto' scheme is supported."
...@@ -1685,14 +1750,7 @@ modifiers, it changes global tool-bar visibility setting." ...@@ -1685,14 +1750,7 @@ modifiers, it changes global tool-bar visibility setting."
(if (and modifiers (not (string= modifiers "\000\000\000\000"))) (if (and modifiers (not (string= modifiers "\000\000\000\000")))
;; Globally toggle tool-bar-mode if some modifier key is pressed. ;; Globally toggle tool-bar-mode if some modifier key is pressed.
(tool-bar-mode) (tool-bar-mode)
(let ((window-id (let ((frame (mac-ae-frame ae)))
(mac-coerce-ae-data "long" (cdr (mac-ae-parameter ae)) "TEXT"))
(rest (frame-list))
frame)
(while (and (null frame) rest)
(if (string= (frame-parameter (car rest) 'window-id) window-id)
(setq frame (car rest)))
(setq rest (cdr rest)))
(set-frame-parameter frame 'tool-bar-lines (set-frame-parameter frame 'tool-bar-lines
(if (= (frame-parameter frame 'tool-bar-lines) 0) (if (= (frame-parameter frame 'tool-bar-lines) 0)
1 0)))))) 1 0))))))
...@@ -1722,13 +1780,12 @@ With numeric ARG, display the font panel if and only if ARG is positive." ...@@ -1722,13 +1780,12 @@ With numeric ARG, display the font panel if and only if ARG is positive."
"Change default face attributes according to font selection EVENT." "Change default face attributes according to font selection EVENT."
(interactive "e") (interactive "e")
(let* ((ae (mac-event-ae event)) (let* ((ae (mac-event-ae event))
(fm-font-size (cdr (mac-ae-parameter ae "fmsz"))) (fm-font-size (mac-ae-number ae "fmsz"))
(atsu-font-id (cdr (mac-ae-parameter ae "auid"))) (atsu-font-id (cdr (mac-ae-parameter ae "auid")))
(attribute-values (gethash atsu-font-id mac-atsu-font-table))) (attribute-values (gethash atsu-font-id mac-atsu-font-table)))
(if fm-font-size (if fm-font-size
(setq attribute-values (setq attribute-values
`(:height ,(* 10 (mac-bytes-to-integer fm-font-size)) `(:height ,(* 10 fm-font-size) ,@attribute-values)))
,@attribute-values)))
(apply 'set-face-attribute 'default (selected-frame) attribute-values))) (apply 'set-face-attribute 'default (selected-frame) attribute-values)))
;; kEventClassFont/kEventFontPanelClosed ;; kEventClassFont/kEventFontPanelClosed
...@@ -1745,6 +1802,258 @@ With numeric ARG, display the font panel if and only if ARG is positive." ...@@ -1745,6 +1802,258 @@ With numeric ARG, display the font panel if and only if ARG is positive."
) ;; (fboundp 'mac-set-font-panel-visibility) ) ;; (fboundp 'mac-set-font-panel-visibility)
;;; Text Services
(defvar mac-ts-active-input-buf ""
"Byte sequence of the current Mac TSM active input area.")
(defvar mac-ts-update-active-input-area-seqno 0
"Number of processed update-active-input-area events.")
(setq mac-ts-active-input-overlay (make-overlay 0 0))
(defface mac-ts-caret-position
'((t :inverse-video t))
"Face for caret position in Mac TSM active input area.
This is used only when the active input area is displayed in the
echo area."
:group 'mac)
(defface mac-ts-raw-text
'((t :underline t))
"Face for raw text in Mac TSM active input area."
:group 'mac)
(defface mac-ts-selected-raw-text
'((t :underline t))
"Face for selected raw text in Mac TSM active input area."
:group 'mac)
(defface mac-ts-converted-text
'((((background dark)) :underline "gray20")
(t :underline "gray80"))
"Face for converted text in Mac TSM active input area."
:group 'mac)
(defface mac-ts-selected-converted-text
'((t :underline t))
"Face for selected converted text in Mac TSM active input area."
:group 'mac)
(defface mac-ts-block-fill-text
'((t :underline t))
"Face for block fill text in Mac TSM active input area."
:group 'mac)
(defface mac-ts-outline-text
'((t :underline t))
"Face for outline text in Mac TSM active input area."
:group 'mac)
(defface mac-ts-selected-text
'((t :underline t))
"Face for selected text in Mac TSM active input area."
:group 'mac)
(defface mac-ts-no-hilite
'((t :inherit default))
"Face for no hilite in Mac TSM active input area."
:group 'mac)
(defconst mac-ts-hilite-style-faces
'((2 . mac-ts-raw-text) ; kTSMHiliteRawText
(3 . mac-ts-selected-raw-text) ; kTSMHiliteSelectedRawText
(4 . mac-ts-converted-text) ; kTSMHiliteConvertedText
(5 . mac-ts-selected-converted-text) ; kTSMHiliteSelectedConvertedText
(6 . mac-ts-block-fill-text) ; kTSMHiliteBlockFillText
(7 . mac-ts-outline-text) ; kTSMHiliteOutlineText
(8 . mac-ts-selected-text) ; kTSMHiliteSelectedText
(9 . mac-ts-no-hilite)) ; kTSMHiliteNoHilite
"Alist of Mac TSM hilite style vs Emacs face.")
(defun mac-ts-update-active-input-buf (text fix-len hilite-rng update-rng)
(let ((buf-len (length mac-ts-active-input-buf))
confirmed)
(if (or (null update-rng)
(/= (% (length update-rng) 2) 0))
;; The parameter is missing (or in a bad format). The
;; existing inline input session is completely replaced with
;; the new text.
(setq mac-ts-active-input-buf text)
;; Otherwise, the current subtext specified by the (2*j)-th
;; range is replaced with the new subtext specified by the
;; (2*j+1)-th range.
(let ((tail buf-len)
(i (length update-rng))
segments rng)
(while (> i 0)
(setq i (- i 2))
(setq rng (aref update-rng i))
(if (and (<= 0 (cadr rng)) (< (cadr rng) tail)
(<= tail buf-len))
(setq segments
(cons (substring mac-ts-active-input-buf (cadr rng) tail)
segments)))
(setq tail (car rng))
(setq rng (aref update-rng (1+ i)))
(if (and (<= 0 (car rng)) (< (car rng) (cadr rng))
(<= (cadr rng) (length text)))
(setq segments
(cons (substring text (car rng) (cadr rng))
segments))))
(if (and (< 0 tail) (<= tail buf-len))
(setq segments
(cons (substring mac-ts-active-input-buf 0 tail)
segments)))
(setq mac-ts-active-input-buf (apply 'concat segments))))
(setq buf-len (length mac-ts-active-input-buf))
;; Confirm (a part of) inline input session.
(cond ((< fix-len 0)
;; Entire inline session is being confirmed.
(setq confirmed mac-ts-active-input-buf)
(setq mac-ts-active-input-buf ""))
((= fix-len 0)
;; None of the text is being confirmed (yet).
(setq confirmed ""))
(t
(if (> fix-len buf-len)
(setq fix-len buf-len))
(setq confirmed (substring mac-ts-active-input-buf 0 fix-len))
(setq mac-ts-active-input-buf
(substring mac-ts-active-input-buf fix-len))))
(setq buf-len (length mac-ts-active-input-buf))
;; Update highlighting and the caret position in the new inline
;; input session.
(remove-text-properties 0 buf-len '(cursor nil) mac-ts-active-input-buf)
(mapc (lambda (rng)
(cond ((and (= (nth 2 rng) 1) ; kTSMHiliteCaretPosition
(<= 0 (car rng)) (< (car rng) buf-len))
(put-text-property (car rng) buf-len
'cursor t mac-ts-active-input-buf))
((and (<= 0 (car rng)) (< (car rng) (cadr rng))
(<= (cadr rng) buf-len))
(put-text-property (car rng) (cadr rng) 'face
(cdr (assq (nth 2 rng)
mac-ts-hilite-style-faces))
mac-ts-active-input-buf))))
hilite-rng)
confirmed))
(defun mac-split-string-by-property-change (string)
(let ((tail (length string))
head result)
(unless (= tail 0)
(while (setq head (previous-property-change tail string)
result (cons (substring string (or head 0) tail) result)
tail head)))
result))
(defun mac-replace-untranslated-utf-8-chars (string &optional to-string)
(or to-string (setq to-string "$,3u=(B"))
(mapconcat
(lambda (str)
(if (get-text-property 0 'untranslated-utf-8 str) to-string str))
(mac-split-string-by-property-change string)
""))
(defun mac-ts-update-active-input-area (event)
"Update Mac TSM active input area according to EVENT.
The confirmed text is converted to Emacs input events and pushed
into `unread-command-events'. The unconfirmed text is displayed
either in the current buffer or in the echo area."
(interactive "e")
(let* ((ae (mac-event-ae event))
(text (or (cdr (mac-ae-parameter ae "tstx" "utxt")) ""))
(script-language (mac-ae-script-language ae "tssl"))
(coding (or (cdr (assq (car script-language)
mac-script-code-coding-systems))
'mac-roman))
(fix-len (mac-bytes-to-integer
(cdr (mac-ae-parameter ae "tsfx" "long"))))
;; Optional parameters
(hilite-rng (mac-ae-text-range-array ae "tshi"))
(update-rng (mac-ae-text-range-array ae "tsup"))
;;(pin-rng (mac-bytes-to-text-range (cdr (mac-ae-parameter ae "tspn" "txrn"))))
;;(clause-offsets (cdr (mac-ae-parameter ae "tscl" "ofay")))
(seqno (mac-ae-number ae "tsSn"))
confirmed)
(unless (= seqno mac-ts-update-active-input-area-seqno)
;; Reset internal states if sequence number is out of sync.
(setq mac-ts-active-input-buf ""))
(setq confirmed
(mac-ts-update-active-input-buf text fix-len hilite-rng update-rng))
(let ((use-echo-area
(or isearch-mode
(and cursor-in-echo-area (current-message))
;; Overlay strings are not shown in some cases.
(get-char-property (point) 'display)
(get-char-property (point) 'invisible)
(get-char-property (point) 'composition)))
active-input-string caret-seen)
;; Decode the active input area text with inheriting faces and
;; the caret position.
(setq active-input-string
(mapconcat
(lambda (str)
(let ((decoded (mac-utxt-to-string str coding)))
(put-text-property 0 (length decoded) 'face
(get-text-property 0 'face str) decoded)
(when (and (not caret-seen)
(get-text-property 0 'cursor str))
(setq caret-seen t)
(if use-echo-area
(put-text-property 0 1 'face 'mac-ts-caret-position
decoded)
(put-text-property 0 1 'cursor t decoded)))
decoded))
(mac-split-string-by-property-change mac-ts-active-input-buf)
""))
(put-text-property 0 (length active-input-string)
'mac-ts-active-input-string t active-input-string)
(if use-echo-area
(let (msg message-log-max)
(if (and (current-message)
;; Don't get confused by previously displayed
;; `active-input-string'.
(null (get-text-property 0 'mac-ts-active-input-string
(current-message))))
(setq msg (propertize (current-message) 'display
(concat (current-message)
active-input-string)))
(setq msg active-input-string))
(message "%s" msg)
(overlay-put mac-ts-active-input-overlay 'before-string nil))
(move-overlay mac-ts-active-input-overlay
(point) (point) (current-buffer))
(overlay-put mac-ts-active-input-overlay 'before-string
active-input-string))
;; Unread confirmed characters and insert them in a keyboard
;; macro being defined.
(apply 'isearch-unread
(append (mac-replace-untranslated-utf-8-chars
(mac-utxt-to-string confirmed coding)) '())))
;; The event is successfully processed. Sync the sequence number.
(setq mac-ts-update-active-input-area-seqno (1+ seqno))))
(defun mac-ts-unicode-for-key-event (event)
"Convert Unicode key EVENT to Emacs key events and unread them."
(interactive "e")
(let* ((ae (mac-event-ae event))
(text (cdr (mac-ae-parameter ae "tstx" "utxt")))
(script-language (mac-ae-script-language ae "tssl"))
(coding (or (cdr (assq (car script-language)
mac-script-code-coding-systems))
'mac-roman)))
;; Unread characters and insert them in a keyboard macro being
;; defined.
(apply 'isearch-unread
(append (mac-replace-untranslated-utf-8-chars
(mac-utxt-to-string text coding)) '()))))
;; kEventClassTextInput/kEventTextInputUpdateActiveInputArea
(define-key mac-apple-event-map [text-input update-active-input-area]
'mac-ts-update-active-input-area)
;; kEventClassTextInput/kEventTextInputUnicodeForKeyEvent
(define-key mac-apple-event-map [text-input unicode-for-key-event]
'mac-ts-unicode-for-key-event)
;;; Services ;;; Services
(defun mac-service-open-file () (defun mac-service-open-file ()
"Open the file specified by the selection value for Services." "Open the file specified by the selection value for Services."
...@@ -1811,17 +2120,17 @@ With numeric ARG, display the font panel if and only if ARG is positive." ...@@ -1811,17 +2120,17 @@ With numeric ARG, display the font panel if and only if ARG is positive."
;; returns it. ;; returns it.
(setcar (cdr event) (list (selected-window) (point) '(0 . 0) 0)) (setcar (cdr event) (list (selected-window) (point) '(0 . 0) 0))
(if (null (mac-ae-parameter ae 'emacs-suspension-id)) (if (null (mac-ae-parameter ae 'emacs-suspension-id))
(call-interactively binding) (command-execute binding nil (vector event) t)
(condition-case err (condition-case err
(progn (progn
(call-interactively binding) (command-execute binding nil (vector event) t)
(mac-resume-apple-event ae)) (mac-resume-apple-event ae))
(error (error
(mac-ae-set-reply-parameter ae "errs" (mac-ae-set-reply-parameter ae "errs"
(cons "TEXT" (error-message-string err))) (cons "TEXT" (error-message-string err)))
(mac-resume-apple-event ae -10000)))))) ; errAEEventFailed (mac-resume-apple-event ae -10000)))))) ; errAEEventFailed
(global-set-key [mac-apple-event] 'mac-dispatch-apple-event) (define-key special-event-map [mac-apple-event] 'mac-dispatch-apple-event)
;; Processing of Apple events are deferred at the startup time. For ;; Processing of Apple events are deferred at the startup time. For
;; example, files dropped onto the Emacs application icon can only be ;; example, files dropped onto the Emacs application icon can only be
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment