(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.

1 files changed, 327 insertions, 18 deletions

diff --git a/lisp/term/mac-win.el b/lisp/term/mac-win.el
index 318503db974..5c546f77d33 100644
--- a/lisp/term/mac-win.el
+++ b/lisp/term/mac-win.el
@@ -84,6 +84,7 @@
 (defvar mac-apple-event-map)
 (defvar mac-atsu-font-table)
 (defvar mac-font-panel-mode)
+(defvar mac-ts-active-input-overlay)
 (defvar x-invocation-args)
 
 (defvar x-command-line-resources nil)
@@ -1570,6 +1571,15 @@ in `selection-converter-alist', which see."
                 (mac-coerce-ae-data (car type-data) (cdr type-data) type))
               (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)
   (or from (setq from 0))
   (or to (setq to (length bytes)))
@@ -1610,6 +1620,65 @@ in `selection-converter-alist', which see."
     (and utf8-text
          (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)
   "Open the documents specified by the Apple event EVENT."
   (interactive "e")
@@ -1637,10 +1706,6 @@ in `selection-converter-alist', which see."
               nil t)))))
   (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)
   "Open the URL specified by the Apple event EVENT.
 Currently the `mailto' scheme is supported."
@@ -1685,14 +1750,7 @@ modifiers, it changes global tool-bar visibility setting."
     (if (and modifiers (not (string= modifiers "\000\000\000\000")))
         ;; Globally toggle tool-bar-mode if some modifier key is pressed.
         (tool-bar-mode)
-      (let ((window-id
-             (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)))
+      (let ((frame (mac-ae-frame ae)))
         (set-frame-parameter frame 'tool-bar-lines
                              (if (= (frame-parameter frame 'tool-bar-lines) 0)
                                  1 0))))))
@@ -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."
   (interactive "e")
   (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")))
          (attribute-values (gethash atsu-font-id mac-atsu-font-table)))
     (if fm-font-size
         (setq attribute-values
-              `(:height ,(* 10 (mac-bytes-to-integer fm-font-size))
-                        ,@attribute-values)))
+              `(:height ,(* 10 fm-font-size) ,@attribute-values)))
     (apply 'set-face-attribute 'default (selected-frame) attribute-values)))
 
 ;; kEventClassFont/kEventFontPanelClosed
@@ -1745,6 +1802,258 @@ With numeric ARG, display the font panel if and only if ARG is positive."
 
 ) ;; (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
 (defun mac-service-open-file ()
   "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."
     ;; returns it.
     (setcar (cdr event) (list (selected-window) (point) '(0 . 0) 0))
     (if (null (mac-ae-parameter ae 'emacs-suspension-id))
-        (call-interactively binding)
+        (command-execute binding nil (vector event) t)
       (condition-case err
           (progn
-            (call-interactively binding)
+            (command-execute binding nil (vector event) t)
             (mac-resume-apple-event ae))
         (error
          (mac-ae-set-reply-parameter ae "errs"
                                      (cons "TEXT" (error-message-string err)))
          (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
 ;; example, files dropped onto the Emacs application icon can only be