X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e834108f7df677ac323d554934fd6ea60560e289..cb5b9015b372175f1fc90cb7ba3f43298c621509:/lisp/term/mac-win.el

diff --git a/lisp/term/mac-win.el b/lisp/term/mac-win.el
index 8e810284b7..e39e1fffeb 100644
--- a/lisp/term/mac-win.el
+++ b/lisp/term/mac-win.el
@@ -1,7 +1,7 @@
 ;;; mac-win.el --- parse switches controlling interface with Mac window system -*-coding: iso-2022-7bit;-*-
 
-;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
-;;   2005, 2006 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
+;;   2005, 2006, 2007 Free Software Foundation, Inc.
 
 ;; Author: Andrew Choi <akochoi@mac.com>
 ;; Keywords: terminals
@@ -10,7 +10,7 @@
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -79,9 +79,11 @@
 (eval-when-compile (require 'url))
 
 (defvar mac-charset-info-alist)
-(defvar mac-services-selection)
+(defvar mac-service-selection)
 (defvar mac-system-script-code)
 (defvar mac-apple-event-map)
+(defvar mac-font-panel-mode)
+(defvar mac-ts-active-input-overlay)
 (defvar x-invocation-args)
 
 (defvar x-command-line-resources nil)
@@ -1246,6 +1248,9 @@ correspoinding TextEncodingBase value."
 
 ;;;; Conversion between common flavors and Lisp string.
 
+(defconst mac-text-encoding-ascii #x600
+  "ASCII text encoding.")
+
 (defconst mac-text-encoding-mac-japanese-basic-variant #x20001
   "MacJapanese text encoding without Apple double-byte extensions.")
 
@@ -1260,13 +1265,13 @@ correspoinding TextEncodingBase value."
 					    (or encoding coding-system)))))
     (when str
       (setq str (decode-coding-string str coding-system))
-      (if (= encoding mac-text-encoding-mac-japanese-basic-variant)
+      (if (eq encoding mac-text-encoding-mac-japanese-basic-variant)
 	  ;; Does it contain Apple one-byte extensions other than
 	  ;; reverse solidus?
 	  (if (string-match "[\xa0\xfd-\xff]" str)
 	      (setq str nil)
 	    ;; ASCII-only?
-	    (unless (string-match "\\`[[:ascii:]]*\\'" str)
+	    (unless (mac-code-convert-string data nil mac-text-encoding-ascii)
 	      (subst-char-in-string ?\x5c ?\(J\(B str t)
 	      (subst-char-in-string ?\x80 ?\\ str t)))))
     (or str
@@ -1281,14 +1286,19 @@ correspoinding TextEncodingBase value."
 		     (find-coding-systems-string string)))
       (setq coding-system
 	    (coding-system-change-eol-conversion coding-system 'mac))
-      (when (and (eq system-type 'darwin)
-		 (eq coding-system 'japanese-shift-jis-mac))
-	(setq encoding mac-text-encoding-mac-japanese-basic-variant)
-	(setq string (subst-char-in-string ?\\ ?\x80 string))
-	(subst-char-in-string ?\(J\(B ?\x5c string t))
-      (setq data (mac-code-convert-string
-		  (encode-coding-string string coding-system)
-		  (or encoding coding-system) nil)))
+      (let ((str string))
+	(when (and (eq system-type 'darwin)
+		   (eq coding-system 'japanese-shift-jis-mac))
+	  (setq encoding mac-text-encoding-mac-japanese-basic-variant)
+	  (setq str (subst-char-in-string ?\\ ?\x80 str))
+	  (subst-char-in-string ?\(J\(B ?\x5c str t)
+	  ;; ASCII-only?
+	  (if (string-match "\\`[\x00-\x7f]*\\'" str)
+	      (setq str nil)))
+	(and str
+	     (setq data (mac-code-convert-string
+			 (encode-coding-string str coding-system)
+			 (or encoding coding-system) nil)))))
     (or data (encode-coding-string string (if (eq (byteorder) ?B)
 					      'utf-16be-mac
 					    'utf-16le-mac)))))
@@ -1522,19 +1532,20 @@ in `selection-converter-alist', which see."
 
 ;;; Event IDs
 ;; kCoreEventClass
-(put 'open-application   'mac-apple-event-id "oapp") ; kAEOpenApplication
-(put 'reopen-application 'mac-apple-event-id "rapp") ; kAEReopenApplication
-(put 'open-documents     'mac-apple-event-id "odoc") ; kAEOpenDocuments
-(put 'print-documents    'mac-apple-event-id "pdoc") ; kAEPrintDocuments
-(put 'open-contents      'mac-apple-event-id "ocon") ; kAEOpenContents
-(put 'quit-application   'mac-apple-event-id "quit") ; kAEQuitApplication
-(put 'application-died   'mac-apple-event-id "obit") ; kAEApplicationDied
-(put 'show-preferences   'mac-apple-event-id "pref") ; kAEShowPreferences
-(put 'autosave-now       'mac-apple-event-id "asav") ; kAEAutosaveNow
+(put 'open-application     'mac-apple-event-id "oapp") ; kAEOpenApplication
+(put 'reopen-application   'mac-apple-event-id "rapp") ; kAEReopenApplication
+(put 'open-documents       'mac-apple-event-id "odoc") ; kAEOpenDocuments
+(put 'print-documents      'mac-apple-event-id "pdoc") ; kAEPrintDocuments
+(put 'open-contents        'mac-apple-event-id "ocon") ; kAEOpenContents
+(put 'quit-application     'mac-apple-event-id "quit") ; kAEQuitApplication
+(put 'application-died     'mac-apple-event-id "obit") ; kAEApplicationDied
+(put 'show-preferences     'mac-apple-event-id "pref") ; kAEShowPreferences
+(put 'autosave-now         'mac-apple-event-id "asav") ; kAEAutosaveNow
 ;; kAEInternetEventClass
-(put 'get-url            'mac-apple-event-id "GURL") ; kAEGetURL
-;; Converted HICommand events
-(put 'about              'mac-apple-event-id "abou") ; kHICommandAbout
+(put 'get-url              'mac-apple-event-id "GURL") ; kAEGetURL
+;; Converted HI command events
+(put 'about                'mac-apple-event-id "abou") ; kHICommandAbout
+(put 'show-hide-font-panel 'mac-apple-event-id "shfp") ; kHICommandShowHideFontPanel
 
 (defmacro mac-event-spec (event)
   `(nth 1 ,event))
@@ -1568,6 +1579,18 @@ 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")))
+	(let ((num (string-to-number str)))
+	  ;; Mac OS Classic may return "0e+0" as the coerced value for
+	  ;; the type "magn" and the data "\000\000\000\000".
+	  (if (= num 0.0) 0 num))
+      nil)))
+
 (defun mac-bytes-to-integer (bytes &optional from to)
   (or from (setq from 0))
   (or to (setq to (length bytes)))
@@ -1608,13 +1631,108 @@ 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))
+
+(defconst mac-keyboard-modifier-mask-alist
+  (mapcar
+   (lambda (modifier-bit)
+     (cons (car modifier-bit) (lsh 1 (cdr modifier-bit))))
+   '((command  . 8)			; cmdKeyBit
+     (shift    . 9)			; shiftKeyBit
+     (option   . 11)			; optionKeyBit
+     (control  . 12)			; controlKeyBit
+     (function . 17)))			; kEventKeyModifierFnBit
+  "Alist of Mac keyboard modifier symbols vs masks.")
+
+(defun mac-ae-keyboard-modifiers (ae)
+  (let ((modifiers-value (mac-ae-number ae "kmod"))
+	modifiers)
+    (if modifiers-value
+	(dolist (modifier-mask mac-keyboard-modifier-mask-alist)
+	  (if (/= (logand modifiers-value (cdr modifier-mask)) 0)
+	      (setq modifiers (cons (car modifier-mask) modifiers)))))
+    modifiers))
+
+(defun mac-ae-reopen-application (event)
+  "Show some frame in response to the Apple event EVENT.
+The frame to be shown is chosen from visible or iconified frames
+if possible.  If there's no such frame, a new frame is created."
+  (interactive "e")
+  (unless (frame-visible-p (selected-frame))
+    (let ((frame (or (car (visible-frame-list))
+		     (car (filtered-frame-list 'frame-visible-p)))))
+      (if frame
+	  (select-frame frame)
+	(switch-to-buffer-other-frame "*scratch*"))))
+  (select-frame-set-input-focus (selected-frame)))
+
 (defun mac-ae-open-documents (event)
   "Open the documents specified by the Apple event EVENT."
   (interactive "e")
   (let ((ae (mac-event-ae event)))
     (dolist (file-name (mac-ae-list ae nil 'undecoded-file-name))
       (if file-name
-	  (dnd-open-local-file (concat "file:" file-name) nil)))
+	  (dnd-open-local-file
+	   (concat "file://"
+		   (mapconcat 'url-hexify-string
+			      (split-string file-name "/") "/")) nil)))
     (let ((selection-range (mac-ae-selection-range ae))
 	  (search-text (mac-ae-text-for-search ae)))
       (cond (selection-range
@@ -1632,9 +1750,14 @@ 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-quit-application (event)
+  "Quit the application Emacs with the Apple event EVENT."
+  (interactive "e")
+  (let ((ae (mac-event-ae event)))
+    (unwind-protect
+	(save-buffers-kill-emacs)
+      ;; Reaches here if the user has canceled the quit.
+      (mac-resume-apple-event ae -128)))) ; userCanceledErr
 
 (defun mac-ae-get-url (event)
   "Open the URL specified by the Apple event EVENT.
@@ -1643,8 +1766,10 @@ Currently the `mailto' scheme is supported."
   (let* ((ae (mac-event-ae event))
 	 (parsed-url (url-generic-parse-url (mac-ae-text ae))))
     (if (string= (url-type parsed-url) "mailto")
-	(url-mailto parsed-url)
-      (error "Unsupported URL scheme: %s" (url-type parsed-url)))))
+	(progn
+	  (url-mailto parsed-url)
+	  (select-frame-set-input-focus (selected-frame)))
+      (mac-resume-apple-event ae t))))
 
 (setq mac-apple-event-map (make-sparse-keymap))
 
@@ -1654,51 +1779,386 @@ Currently the `mailto' scheme is supported."
 (define-key mac-apple-event-map [core-event open-application] 0)
 
 ;; Received when a dock or application icon is clicked and Emacs is
-;; already running.  Simply ignored.  Another idea is to make a new
-;; frame if all frames are invisible.
-(define-key mac-apple-event-map [core-event reopen-application] 'ignore)
+;; already running.
+(define-key mac-apple-event-map [core-event reopen-application]
+  'mac-ae-reopen-application)
 
 (define-key mac-apple-event-map [core-event open-documents]
   'mac-ae-open-documents)
 (define-key mac-apple-event-map [core-event show-preferences] 'customize)
 (define-key mac-apple-event-map [core-event quit-application]
-  'save-buffers-kill-emacs)
+  'mac-ae-quit-application)
 
 (define-key mac-apple-event-map [internet-event get-url] 'mac-ae-get-url)
 
-(define-key mac-apple-event-map [hicommand about] 'display-splash-screen)
+(define-key mac-apple-event-map [hi-command about] 'about-emacs)
+
+;;; Converted Carbon Events
+(defun mac-handle-toolbar-switch-mode (event)
+  "Toggle visibility of tool-bars in response to EVENT.
+With no keyboard modifiers, it toggles the visibility of the
+frame where the tool-bar toggle button was pressed.  With some
+modifiers, it changes the global tool-bar visibility setting."
+  (interactive "e")
+  (let ((ae (mac-event-ae event)))
+    (if (mac-ae-keyboard-modifiers ae)
+	;; Globally toggle tool-bar-mode if some modifier key is pressed.
+	(tool-bar-mode 'toggle)
+      (let ((frame (mac-ae-frame ae)))
+	(set-frame-parameter frame 'tool-bar-lines
+			     (if (= (frame-parameter frame 'tool-bar-lines) 0)
+				 1 0))))))
+
+;; kEventClassWindow/kEventWindowToolbarSwitchMode
+(define-key mac-apple-event-map [window toolbar-switch-mode]
+  'mac-handle-toolbar-switch-mode)
+
+;;; Font panel
+(when (fboundp 'mac-set-font-panel-visible-p)
+
+(define-minor-mode mac-font-panel-mode
+  "Toggle use of the font panel.
+With numeric ARG, display the font panel if and only if ARG is positive."
+  :init-value nil
+  :global t
+  :group 'mac
+  (mac-set-font-panel-visible-p mac-font-panel-mode))
+
+(defun mac-handle-font-panel-closed (event)
+  "Update internal status in response to font panel closed EVENT."
+  (interactive "e")
+  ;; Synchronize with the minor mode variable.
+  (mac-font-panel-mode 0))
+
+(defun mac-handle-font-selection (event)
+  "Change default face attributes according to font selection EVENT."
+  (interactive "e")
+  (let* ((ae (mac-event-ae event))
+	 (fm-font-size (mac-ae-number ae "fmsz"))
+	 (atsu-font-id (mac-ae-number ae "auid"))
+	 (attribute-values (and atsu-font-id
+				(mac-atsu-font-face-attributes atsu-font-id))))
+    (if fm-font-size
+	(setq attribute-values
+	      `(:height ,(* 10 fm-font-size) ,@attribute-values)))
+    (apply 'set-face-attribute 'default (selected-frame) attribute-values)))
+
+;; kEventClassFont/kEventFontPanelClosed
+(define-key mac-apple-event-map [font panel-closed]
+  'mac-handle-font-panel-closed)
+;; kEventClassFont/kEventFontSelection
+(define-key mac-apple-event-map [font selection] 'mac-handle-font-selection)
+(define-key mac-apple-event-map [hi-command show-hide-font-panel]
+  'mac-font-panel-mode)
+
+(define-key-after menu-bar-showhide-menu [mac-font-panel-mode]
+  (menu-bar-make-mm-toggle mac-font-panel-mode
+			   "Font Panel"
+			   "Show the font panel as a floating dialog")
+  'showhide-speedbar)
+
+) ;; (fboundp 'mac-set-font-panel-visible-p)
+
+;;; 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 when the active input area is displayed either in
+the echo area or in a buffer where the cursor is not displayed."
+  :group 'mac)
 
-(defun mac-services-open-file ()
+(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-keyboard-translate-char (ch)
+  (if (and (char-valid-p ch)
+	   (or (char-table-p keyboard-translate-table)
+	       (and (or (stringp keyboard-translate-table)
+			(vectorp keyboard-translate-table))
+		    (> (length keyboard-translate-table) ch))))
+      (or (aref keyboard-translate-table ch) ch)
+    ch))
+
+(defun mac-unread-string (string)
+  ;; Unread characters and insert them in a keyboard macro being
+  ;; defined.
+  (apply 'isearch-unread
+	 (mapcar 'mac-keyboard-translate-char
+		 (mac-replace-untranslated-utf-8-chars 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))
+	 (type-text (mac-ae-parameter ae "tstx"))
+	 (text (or (cdr type-text) ""))
+	 (decode-fun (if (equal (car type-text) "TEXT")
+			 'mac-TEXT-to-string 'mac-utxt-to-string))
+	 (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-ae-number ae "tsfx"))
+	 ;; 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) 'invisible)
+	       (and (not (bobp))
+		    (or (and (get-char-property (point) 'display)
+			     (eq (get-char-property (1- (point)) 'display)
+				 (get-char-property (point) 'display)))
+			(and (get-char-property (point) 'composition)
+			     (eq (get-char-property (1- (point)) 'composition)
+				 (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 (funcall decode-fun 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 (or use-echo-area (null cursor-type))
+		       (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 (current-message))
+		message-log-max)
+	    (if (and msg
+		     ;; Don't get confused by previously displayed
+		     ;; `active-input-string'.
+		     (null (get-text-property 0 'mac-ts-active-input-string
+					      msg)))
+		(setq msg (propertize msg 'display
+				      (concat msg 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))
+      (mac-unread-string (funcall decode-fun 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)))
+    (if text
+	(mac-unread-string (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."
   (interactive)
-  (find-file-existing (x-selection-value mac-services-selection)))
+  (find-file-existing (x-selection-value mac-service-selection)))
 
-(defun mac-services-open-selection ()
+(defun mac-service-open-selection ()
   "Create a new buffer containing the selection value for Services."
   (interactive)
   (switch-to-buffer (generate-new-buffer "*untitled*"))
-  (insert (x-selection-value mac-services-selection))
+  (insert (x-selection-value mac-service-selection))
   (sit-for 0)
   (save-buffer) ; It pops up the save dialog.
   )
 
-(defun mac-services-mail-selection ()
+(defun mac-service-mail-selection ()
   "Prepare a mail buffer containing the selection value for Services."
   (interactive)
   (compose-mail)
   (rfc822-goto-eoh)
   (forward-line 1)
-  (insert (x-selection-value mac-services-selection) "\n"))
+  (insert (x-selection-value mac-service-selection) "\n"))
 
-(defun mac-services-mail-to ()
+(defun mac-service-mail-to ()
   "Prepare a mail buffer to be sent to the selection value for Services."
   (interactive)
-  (compose-mail (x-selection-value mac-services-selection)))
+  (compose-mail (x-selection-value mac-service-selection)))
 
-(defun mac-services-insert-text ()
+(defun mac-service-insert-text ()
   "Insert the selection value for Services."
   (interactive)
-  (let ((text (x-selection-value mac-services-selection)))
+  (let ((text (x-selection-value mac-service-selection)))
     (if (not buffer-read-only)
 	(insert text)
       (kill-new text)
@@ -1706,23 +2166,25 @@ Currently the `mailto' scheme is supported."
        (substitute-command-keys
 	"The text from the Services menu can be accessed with \\[yank]")))))
 
-(define-key mac-apple-event-map [services paste] 'mac-services-insert-text)
-(define-key mac-apple-event-map [services perform open-file]
-  'mac-services-open-file)
-(define-key mac-apple-event-map [services perform open-selection]
-  'mac-services-open-selection)
-(define-key mac-apple-event-map [services perform mail-selection]
-  'mac-services-mail-selection)
-(define-key mac-apple-event-map [services perform mail-to]
-  'mac-services-mail-to)
+;; kEventClassService/kEventServicePaste
+(define-key mac-apple-event-map [service paste] 'mac-service-insert-text)
+;; kEventClassService/kEventServicePerform
+(define-key mac-apple-event-map [service perform open-file]
+  'mac-service-open-file)
+(define-key mac-apple-event-map [service perform open-selection]
+  'mac-service-open-selection)
+(define-key mac-apple-event-map [service perform mail-selection]
+  'mac-service-mail-selection)
+(define-key mac-apple-event-map [service perform mail-to]
+  'mac-service-mail-to)
 
 (defun mac-dispatch-apple-event (event)
   "Dispatch EVENT according to the keymap `mac-apple-event-map'."
   (interactive "e")
   (let* ((binding (lookup-key mac-apple-event-map (mac-event-spec event)))
-	 (service-message
-	  (and (keymapp binding)
-	       (cdr (mac-ae-parameter (mac-event-ae event) "svmg")))))
+	 (ae (mac-event-ae event))
+	 (service-message (and (keymapp binding)
+			       (cdr (mac-ae-parameter ae "svmg")))))
     (when service-message
       (setq service-message
 	    (intern (decode-coding-string service-message 'utf-8)))
@@ -1730,9 +2192,18 @@ Currently the `mailto' scheme is supported."
     ;; Replace (cadr event) with a dummy position so that event-start
     ;; returns it.
     (setcar (cdr event) (list (selected-window) (point) '(0 . 0) 0))
-    (call-interactively binding)))
+    (if (null (mac-ae-parameter ae 'emacs-suspension-id))
+	(command-execute binding nil (vector event) t)
+      (condition-case err
+	  (progn
+	    (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
@@ -1740,6 +2211,8 @@ Currently the `mailto' scheme is supported."
 ;; the files should be opened.
 (add-hook 'after-init-hook 'mac-process-deferred-apple-events)
 
+(run-with-idle-timer 5 t 'mac-cleanup-expired-apple-events)
+
 
 ;;;; Drag and drop
 
@@ -1751,7 +2224,7 @@ Currently the `mailto' scheme is supported."
     ("TIFF" . mac-dnd-insert-TIFF))
   "Which function to call to handle a drop of that type.
 The function takes three arguments, WINDOW, ACTION and DATA.
-WINDOW is where the drop occured, ACTION is always `private' on
+WINDOW is where the drop occurred, ACTION is always `private' on
 Mac.  DATA is the drop data.  Unlike the x-dnd counterpart, the
 return value of the function is not significant.
 
@@ -1786,19 +2259,20 @@ See also `mac-dnd-known-types'."
 (defun mac-dnd-insert-TIFF (window action data)
   (dnd-insert-text window action (mac-TIFF-to-string data)))
 
-(defun mac-dnd-drop-data (event frame window data type)
+(defun mac-dnd-drop-data (event frame window data type &optional action)
+  (or action (setq action 'private))
   (let* ((type-info (assoc type mac-dnd-types-alist))
 	 (handler (cdr type-info))
-	 (action 'private)
 	 (w (posn-window (event-start event))))
     (when handler
-      (if (and (windowp w) (window-live-p w)
+      (if (and (window-live-p w)
 	       (not (window-minibuffer-p w))
 	       (not (window-dedicated-p w)))
 	  ;; If dropping in an ordinary window which we could use,
 	  ;; let dnd-open-file-other-window specify what to do.
 	  (progn
-	    (goto-char (posn-point (event-start event)))
+	    (when (not mouse-yank-at-point)
+	      (goto-char (posn-point (event-start event))))
 	    (funcall handler window action data))
 	;; If we can't display the file here,
 	;; make a new window for it.
@@ -1809,13 +2283,16 @@ See also `mac-dnd-known-types'."
 (defun mac-dnd-handle-drag-n-drop-event (event)
   "Receive drag and drop events."
   (interactive "e")
-  (let ((window (posn-window (event-start event))))
+  (let ((window (posn-window (event-start event)))
+	(ae (mac-event-ae event))
+	action)
     (when (windowp window) (select-window window))
-    (dolist (item (mac-ae-list (mac-event-ae event)))
+    (if (memq 'option (mac-ae-keyboard-modifiers ae))
+	(setq action 'copy))
+    (dolist (item (mac-ae-list ae))
       (if (not (equal (car item) "null"))
 	  (mac-dnd-drop-data event (selected-frame) window
-			     (cdr item) (car item)))))
-  (select-frame-set-input-focus (selected-frame)))
+			     (cdr item) (car item) action)))))
 
 ;;; Do the actual Windows setup here; the above code just defines
 ;;; functions and variables that we use now.
@@ -2040,7 +2517,7 @@ It returns a name of the created fontset."
 
 ;; Setup the default fontset.
 (setup-default-fontset)
-(cond ((x-list-fonts "*-iso10646-1")
+(cond ((x-list-fonts "*-iso10646-1" nil nil 1)
        ;; Use ATSUI (if available) for the following charsets.
        (dolist
 	   (charset '(latin-iso8859-1
@@ -2052,7 +2529,7 @@ It returns a name of the created fontset."
 		      vietnamese-viscii-lower vietnamese-viscii-upper
 		      lao ethiopic tibetan))
 	 (set-fontset-font nil charset '(nil . "iso10646-1"))))
-      ((null (x-list-fonts "*-iso8859-1"))
+      ((null (x-list-fonts "*-iso8859-1" nil nil 1))
        ;; Add Mac-encoding fonts unless ETL fonts are installed.
        (fontset-add-mac-fonts "fontset-default")))
 
@@ -2107,12 +2584,15 @@ ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman")
 			       (cons '(user-size . t) parsed))))
 	;; All geometry parms apply to the initial frame.
 	(setq initial-frame-alist (append initial-frame-alist parsed))
-	;; The size parms apply to all frames.
-	(if (assq 'height parsed)
+	;; The size parms apply to all frames.  Don't set it if there are
+	;; sizes there already (from command line).
+	(if (and (assq 'height parsed)
+		 (not (assq 'height default-frame-alist)))
 	    (setq default-frame-alist
 		  (cons (cons 'height (cdr (assq 'height parsed)))
 			default-frame-alist)))
-	(if (assq 'width parsed)
+	(if (and (assq 'width parsed)
+		 (not (assq 'width default-frame-alist)))
 	    (setq default-frame-alist
 		  (cons (cons 'width (cdr (assq 'width parsed)))
 			default-frame-alist))))))
@@ -2151,8 +2631,7 @@ ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman")
 
 ;; Initiate drag and drop
 
-(global-set-key [drag-n-drop] 'mac-dnd-handle-drag-n-drop-event)
-(global-set-key [M-drag-n-drop] 'mac-dnd-handle-drag-n-drop-event)
+(define-key special-event-map [drag-n-drop] 'mac-dnd-handle-drag-n-drop-event)
 
 
 ;;;; Non-toolkit Scroll bars