Changeset 4079 for trunk/lisp/term/mac-win.el

Timestamp:

05/13/06 11:31:18 (3 years ago)

Author:

miyoshi

Message:

Sync up with Emacs CVS HEAD.

Files:

• trunk/lisp/term/mac-win.el (modified) (5 diffs)

trunk/lisp/term/mac-win.el

@@ -80 +80 @@
-
-(defvar mac-charset-info-alist)
-s
+
-(defvar mac-system-script-code)
-(defvar mac-apple-event-map)
+(defvar mac-atsu-font-table)
+(defvar mac-font-panel-mode)
-(defvar x-invocation-args)
-
@@ -1129 +1131 @@
-(mac-add-charset-info "iso10646-1" 126) ; for ATSUI
-
-
-;;;; Keyboard layout/language change events
-(defun mac-handle-language-change (event)
-  "Set keyboard coding system to what is specified in EVENT."
-  (interactive "e")
-  (let ((coding-system
-         (cdr (assq (car (cadr event)) mac-script-code-coding-systems))))
-    (set-keyboard-coding-system (or coding-system 'mac-roman))
-    ;; MacJapanese maps reverse solidus to ?\x80.
-    (if (eq coding-system 'japanese-shift-jis)
-        (define-key key-translation-map [?\x80] "\\"))))
-
-(define-key special-event-map [language-change] 'mac-handle-language-change)
-
-;;;; Selections
-
-;;; We keep track of the last text selected here, so we can check the
-;;; current selection against it, and avoid passing back our own text
-;;; from x-get-selection-value.
-(defvar x-last-selected-text-clipboard nil
-  "The value of the CLIPBOARD selection last time we selected or
-pasted text.")
-(defvar x-last-selected-text-primary nil
-  "The value of the PRIMARY X selection last time we selected or
-pasted text.")
-
-(defcustom x-select-enable-clipboard t
-  "*Non-nil means cutting and pasting uses the clipboard.
-This is in addition to the primary selection."
-  :type 'boolean
-  :group 'killing)
-
-;;; Make TEXT, a string, the primary X selection.
-(defun x-select-text (text &optional push)
-  (x-set-selection 'PRIMARY text)
-  (setq x-last-selected-text-primary text)
-  (if (not x-select-enable-clipboard)
-      (setq x-last-selected-text-clipboard nil)
-    (x-set-selection 'CLIPBOARD text)
-    (setq x-last-selected-text-clipboard text))
-  )
-
-(defun x-get-selection (&optional type data-type)
-  "Return the value of a selection.
-The argument TYPE (default `PRIMARY') says which selection,
-and the argument DATA-TYPE (default `STRING') says
-how to convert the data.
-
-TYPE may be any symbol \(but nil stands for `PRIMARY').  However,
-only a few symbols are commonly used.  They conventionally have
-all upper-case names.  The most often used ones, in addition to
-`PRIMARY', are `SECONDARY' and `CLIPBOARD'.
-
-DATA-TYPE is usually `STRING', but can also be one of the symbols
-in `selection-converter-alist', which see."
-  (let ((data (x-get-selection-internal (or type 'PRIMARY)
-                                        (or data-type 'STRING)))
-        (coding (or next-selection-coding-system
-                    selection-coding-system)))
-    (when (and (stringp data)
-               (setq data-type (get-text-property 0 'foreign-selection data)))
-      (cond ((eq data-type 'public.utf16-plain-text)
-             (let ((encoded (and (fboundp 'mac-code-convert-string)
-                                 (mac-code-convert-string data nil coding))))
-               (if encoded
-                   (setq data (decode-coding-string encoded coding))
-                 (setq data
-                       (decode-coding-string data
-                                             (if (eq (byteorder) ?B)
-                                                 'utf-16be 'utf-16le))))))
-            ((eq data-type 'com.apple.traditional-mac-plain-text)
-             (setq data (decode-coding-string data coding)))
-            ((eq data-type 'public.file-url)
-             (setq data (decode-coding-string data 'utf-8))
-             ;; Remove a trailing nul character.
-             (let ((len (length data)))
-               (if (and (> len 0) (= (aref data (1- len)) ?\0))
-                   (setq data (substring data 0 (1- len)))))))
-      (put-text-property 0 (length data) 'foreign-selection data-type data))
-    data))
-
-(defun x-selection-value (type)
-  (let ((data-types '(public.utf16-plain-text
-                      com.apple.traditional-mac-plain-text
-                      public.file-url))
-        text tiff-image)
-    (while (and (null text) data-types)
-      (setq text (condition-case nil
-                     (x-get-selection type (car data-types))
-                   (error nil)))
-      (setq data-types (cdr data-types)))
-    (if text
-        (remove-text-properties 0 (length text) '(foreign-selection nil) text))
-    (setq tiff-image (condition-case nil
-                         (x-get-selection type 'public.tiff)
-                       (error nil)))
-    (when tiff-image
-      (remove-text-properties 0 (length tiff-image)
-                              '(foreign-selection nil) tiff-image)
-      (setq tiff-image (create-image tiff-image 'tiff t))
-      (or text (setq text " "))
-      (put-text-property 0 (length text) 'display tiff-image text))
-    text))
-
-;;; Return the value of the current selection.
-;;; Treat empty strings as if they were unset.
-;;; If this function is called twice and finds the same text,
-;;; it returns nil the second time.  This is so that a single
-;;; selection won't be added to the kill ring over and over.
-(defun x-get-selection-value ()
-  (let (clip-text primary-text)
-    (if (not x-select-enable-clipboard)
-        (setq x-last-selected-text-clipboard nil)
-      (setq clip-text (x-selection-value 'CLIPBOARD))
-      (if (string= clip-text "") (setq clip-text nil))
-
-      ;; Check the CLIPBOARD selection for 'newness', is it different
-      ;; from what we remebered them to be last time we did a
-      ;; cut/paste operation.
-      (setq clip-text
-            (cond;; check clipboard
-             ((or (not clip-text) (string= clip-text ""))
-              (setq x-last-selected-text-clipboard nil))
-             ((eq      clip-text x-last-selected-text-clipboard) nil)
-             ((string= clip-text x-last-selected-text-clipboard)
-              ;; Record the newer string,
-              ;; so subsequent calls can use the `eq' test.
-              (setq x-last-selected-text-clipboard clip-text)
-              nil)
-             (t
-              (setq x-last-selected-text-clipboard clip-text))))
-      )
-
-    (setq primary-text (x-selection-value 'PRIMARY))
-    ;; Check the PRIMARY selection for 'newness', is it different
-    ;; from what we remebered them to be last time we did a
-    ;; cut/paste operation.
-    (setq primary-text
-          (cond;; check primary selection
-           ((or (not primary-text) (string= primary-text ""))
-            (setq x-last-selected-text-primary nil))
-           ((eq      primary-text x-last-selected-text-primary) nil)
-           ((string= primary-text x-last-selected-text-primary)
-            ;; Record the newer string,
-            ;; so subsequent calls can use the `eq' test.
-            (setq x-last-selected-text-primary primary-text)
-            nil)
-           (t
-            (setq x-last-selected-text-primary primary-text))))
-
-    ;; As we have done one selection, clear this now.
-    (setq next-selection-coding-system nil)
-
-    ;; At this point we have recorded the current values for the
-    ;; selection from clipboard (if we are supposed to) and primary,
-    ;; So return the first one that has changed (which is the first
-    ;; non-null one).
-    (or clip-text primary-text)
-    ))
-
-(put 'CLIPBOARD 'mac-scrap-name "com.apple.scrap.clipboard")
-(when (eq system-type 'darwin)
-  (put 'FIND 'mac-scrap-name "com.apple.scrap.find")
-  (put 'PRIMARY 'mac-scrap-name
-       (format "org.gnu.Emacs.%d.selection.PRIMARY" (emacs-pid))))
-(put 'com.apple.traditional-mac-plain-text 'mac-ostype "TEXT")
-(put 'public.utf16-plain-text 'mac-ostype "utxt")
-(put 'public.tiff 'mac-ostype "TIFF")
-(put 'public.file-url 'mac-ostype "furl")
-
-(defun mac-select-convert-to-string (selection type value)
-  (let ((str (cdr (xselect-convert-to-string selection nil value)))
-        coding)
-    (setq coding (or next-selection-coding-system selection-coding-system))
-    (if coding
-        (setq coding (coding-system-base coding))
-      (setq coding 'raw-text))
-    (when str
-      ;; If TYPE is nil, this is a local request, thus return STR as
-      ;; is.  Otherwise, encode STR.
-      (if (not type)
-          str
-        (let ((inhibit-read-only t))
-          (remove-text-properties 0 (length str) '(composition nil) str)
-          (cond
-           ((eq type 'public.utf16-plain-text)
-            (let (s)
-              (when (and (fboundp 'mac-code-convert-string)
-                         (memq coding (find-coding-systems-string str)))
-                (setq coding (coding-system-change-eol-conversion coding 'mac))
-                (setq s (mac-code-convert-string
-                         (encode-coding-string str coding)
-                         coding nil)))
-              (setq str (or s
-                            (encode-coding-string str
-                                                  (if (eq (byteorder) ?B)
-                                                      'utf-16be-mac
-                                                    'utf-16le-mac))))))
-           ((eq type 'com.apple.traditional-mac-plain-text)
-            (let ((encodables (find-coding-systems-string str))
-                  (rest mac-script-code-coding-systems))
-              (unless (memq coding encodables)
-                (while (and rest (not (memq (cdar rest) encodables)))
-                  (setq rest (cdr rest)))
-                (if rest
-                    (setq coding (cdar rest)))))
-            (setq coding (coding-system-change-eol-conversion coding 'mac))
-            (setq str (encode-coding-string str coding)))
-           (t
-            (error "Unknown selection type: %S" type))
-           )))
-
-      (setq next-selection-coding-system nil)
-      (cons type str))))
-
-(defun mac-select-convert-to-file-url (selection type value)
-  (let ((filename (xselect-convert-to-filename selection type value))
-        (coding (or file-name-coding-system default-file-name-coding-system)))
-    (if (and filename coding)
-        (setq filename (encode-coding-string filename coding)))
-    (and filename
-         (concat "file://localhost"
-                 (mapconcat 'url-hexify-string
-                            (split-string filename "/") "/")))))
-
-(setq selection-converter-alist
-      (nconc
-       '((public.utf16-plain-text . mac-select-convert-to-string)
-         (com.apple.traditional-mac-plain-text . mac-select-convert-to-string)
-         ;; This is not enabled by default because the `Import Image'
-         ;; menu makes Emacs crash or hang for unknown reasons.
-         ;; (public.tiff . nil)
-         (public.file-url . mac-select-convert-to-file-url)
-         )
-       selection-converter-alist))
-
-;;;; Apple events, HICommand events, and Services menu
-
-;;; Event classes
-(put 'core-event     'mac-apple-event-class "aevt") ; kCoreEventClass
-(put 'internet-event 'mac-apple-event-class "GURL") ; kAEInternetEventClass
-
-;;; 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
-;; kAEInternetEventClass
-(put 'get-url            'mac-apple-event-id "GURL") ; kAEGetURL
-;; Converted HICommand events
-(put 'about              'mac-apple-event-id "abou") ; kHICommandAbout
-
-(defmacro mac-event-spec (event)
-  `(nth 1 ,event))
-
-(defmacro mac-event-ae (event)
-  `(nth 2 ,event))
-
-(defun mac-ae-parameter (ae &optional keyword type)
-  (or keyword (setq keyword "----")) ;; Direct object.
-  (if (not (and (consp ae) (equal (car ae) "aevt")))
-      (error "Not an Apple event: %S" ae)
-    (let ((type-data (cdr (assoc keyword (cdr ae))))
-          data)
-      (when (and type type-data (not (equal type (car type-data))))
-        (setq data (mac-coerce-ae-data (car type-data) (cdr type-data) type))
-        (setq type-data (if data (cons type data) nil)))
-      type-data)))
-
-(defun mac-ae-list (ae &optional keyword type)
-  (or keyword (setq keyword "----")) ;; Direct object.
-  (let ((desc (mac-ae-parameter ae keyword "list")))
-    (cond ((null desc)
-           nil)
-          ((not (equal (car desc) "list"))
-           (error "Parameter for \"%s\" is not a list" keyword))
-          (t
-           (if (null type)
-               (cdr desc)
-             (mapcar
-              (lambda (type-data)
-                (mac-coerce-ae-data (car type-data) (cdr type-data) type))
-              (cdr desc)))))))
-
-(defun mac-bytes-to-integer (bytes &optional from to)
-  (or from (setq from 0))
-  (or to (setq to (length bytes)))
-  (let* ((len (- to from))
-         (extended-sign-len (- (1+ (ceiling (log most-positive-fixnum 2)))
-                               (* 8 len)))
-         (result 0))
-    (dotimes (i len)
-      (setq result (logior (lsh result 8)
-                           (aref bytes (+ from (if (eq (byteorder) ?B) i
-                                                 (- len i 1)))))))
-    (if (> extended-sign-len 0)
-        (ash (lsh result extended-sign-len) (- extended-sign-len))
-      result)))
-
-(defun mac-ae-selection-range (ae)
-;; #pragma options align=mac68k
-;; typedef struct SelectionRange {
-;;   short unused1; // 0 (not used)
-;;   short lineNum; // line to select (<0 to specify range)
-;;   long startRange; // start of selection range (if line < 0)
-;;   long endRange; // end of selection range (if line < 0)
-;;   long unused2; // 0 (not used)
-;;   long theDate; // modification date/time
-;; } SelectionRange;
-;; #pragma options align=reset
-  (let ((range-bytes (cdr (mac-ae-parameter ae "kpos" "TEXT"))))
-    (and range-bytes
-         (list (mac-bytes-to-integer range-bytes 2 4)
-               (mac-bytes-to-integer range-bytes 4 8)
-               (mac-bytes-to-integer range-bytes 8 12)
-               (mac-bytes-to-integer range-bytes 16 20)))))
-
-;; On Mac OS X 10.4 and later, the `open-document' event contains an
-;; optional parameter keyAESearchText from the Spotlight search.
-(defun mac-ae-text-for-search (ae)
-  (let ((utf8-text (cdr (mac-ae-parameter ae "stxt" "utf8"))))
-    (and utf8-text
-         (decode-coding-string utf8-text 'utf-8))))
-
-(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)))
-    (let ((selection-range (mac-ae-selection-range ae))
-          (search-text (mac-ae-text-for-search ae)))
-      (cond (selection-range
-             (let ((line (car selection-range))
-                   (start (cadr selection-range))
-                   (end (nth 2 selection-range)))
-               (if (> line 0)
-                   (goto-line line)
-                 (if (and (> start 0) (> end 0))
-                     (progn (set-mark start)
-                            (goto-char end))))))
-            ((stringp search-text)
-             (re-search-forward
-              (mapconcat 'regexp-quote (split-string search-text) "\\|")
-              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."
-  (interactive "e")
-  (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)))))
-
-(setq mac-apple-event-map (make-sparse-keymap))
-
-;; Received when Emacs is launched without associated documents.
-;; Accept it as an Apple event, but no Emacs event is generated so as
-;; not to erase the splash screen.
-(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)
-
-(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)
-
-(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)
-
-(defun mac-services-open-file ()
-  "Open the file specified by the selection value for Services."
-  (interactive)
-  (find-file-existing (x-selection-value mac-services-selection)))
-
-(defun mac-services-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))
-  (sit-for 0)
-  (save-buffer) ; It pops up the save dialog.
-  )
-
-(defun mac-services-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"))
-
-(defun mac-services-mail-to ()
-  "Prepare a mail buffer to be sent to the selection value for Services."
-  (interactive)
-  (compose-mail (x-selection-value mac-services-selection)))
-
-(defun mac-services-insert-text ()
-  "Insert the selection value for Services."
-  (interactive)
-  (let ((text (x-selection-value mac-services-selection)))
-    (if (not buffer-read-only)
-        (insert text)
-      (kill-new text)
-      (message
-       (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)
-
-(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")))))
-    (when service-message
-      (setq service-message
-            (intern (decode-coding-string service-message 'utf-8)))
-      (setq binding (lookup-key binding (vector service-message))))
-    ;; 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)))
-
-(global-set-key [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
-;; processed when the initial frame has been created: this is where
-;; the files should be opened.
-(add-hook 'after-init-hook 'mac-process-deferred-apple-events)
-
-;;; Do the actual Windows setup here; the above code just defines
-;;; functions and variables that we use now.
-
-(setq command-line-args (x-handle-args command-line-args))
-
-;;; Make sure we have a valid resource name.
-(or (stringp x-resource-name)
-    (let (i)
-      (setq x-resource-name (invocation-name))
-
-      ;; Change any . or * characters in x-resource-name to hyphens,
-      ;; so as not to choke when we use it in X resource queries.
-      (while (setq i (string-match "[.*]" x-resource-name))
-        (aset x-resource-name i ?-))))
-
-(if (x-display-list)
-    ;; On Mac OS 8/9, Most coding systems used in code conversion for
-    ;; font names are not ready at the time when the terminal frame is
-    ;; created.  So we reconstruct font name table for the initial
-    ;; frame.
-    (mac-clear-font-name-table)
-  (x-open-connection "Mac"
-                     x-command-line-resources
-                     ;; Exit Emacs with fatal error if this fails.
-                     t))
-
-(setq frame-creation-function 'x-create-frame-with-faces)
-
-(cp-make-coding-system
- mac-centraleurroman
@@ -1709 +1221 @@
-    (char-table-extra-slot translation-table 0)))
-
+(defconst mac-system-coding-system
+  (let ((base (or (cdr (assq mac-system-script-code
+                             mac-script-code-coding-systems))
+                  'mac-roman)))
+    (if (eq system-type 'darwin)
+        base
+      (coding-system-change-eol-conversion base 'mac)))
+  "Coding system derived from the system script code.")
+
+(set-selection-coding-system mac-system-coding-system)
+
+
+;;;; Keyboard layout/language change events
+(defun mac-handle-language-change (event)
+  "Set keyboard coding system to what is specified in EVENT."
+  (interactive "e")
+  (let ((coding-system
+         (cdr (assq (car (cadr event)) mac-script-code-coding-systems))))
+    (set-keyboard-coding-system (or coding-system 'mac-roman))
+    ;; MacJapanese maps reverse solidus to ?\x80.
+    (if (eq coding-system 'japanese-shift-jis)
+        (define-key key-translation-map [?\x80] "\\"))))
+
+(define-key special-event-map [language-change] 'mac-handle-language-change)
+
+
+;;;; Conversion between common flavors and Lisp string.
+
+(defconst mac-text-encoding-mac-japanese-basic-variant #x20001
+  "MacJapanese text encoding without Apple double-byte extensions.")
+
+(defun mac-utxt-to-string (data &optional coding-system)
+  (or coding-system (setq coding-system mac-system-coding-system))
+  (let* ((encoding
+          (and (eq system-type 'darwin)
+               (eq (coding-system-base coding-system) 'japanese-shift-jis)
+               mac-text-encoding-mac-japanese-basic-variant))
+         (str (and (fboundp 'mac-code-convert-string)
+                   (mac-code-convert-string data nil
+                                            (or encoding coding-system)))))
+    (when str
+      (setq str (decode-coding-string str coding-system))
+      (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)
+              (subst-char-in-string ?\x5c ?\¥ str t)
+              (subst-char-in-string ?\x80 ?\\ str t)))))
+    (or str
+        (decode-coding-string data
+                              (if (eq (byteorder) ?B) 'utf-16be 'utf-16le)))))
+
+(defun mac-string-to-utxt (string &optional coding-system)
+  (or coding-system (setq coding-system mac-system-coding-system))
+  (let (data encoding)
+    (when (and (fboundp 'mac-code-convert-string)
+               (memq (coding-system-base coding-system)
+                     (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 ?\¥ ?\x5c string t))
+      (setq data (mac-code-convert-string
+                  (encode-coding-string string coding-system)
+                  (or encoding coding-system) nil)))
+    (or data (encode-coding-string string (if (eq (byteorder) ?B)
+                                              'utf-16be-mac
+                                            'utf-16le-mac)))))
+
+(defun mac-TEXT-to-string (data &optional coding-system)
+  (or coding-system (setq coding-system mac-system-coding-system))
+  (prog1 (setq data (decode-coding-string data coding-system))
+    (when (eq (coding-system-base coding-system) 'japanese-shift-jis)
+      ;; (subst-char-in-string ?\x5c ?\¥ data t)
+      (subst-char-in-string ?\x80 ?\\ data t))))
+
+(defun mac-string-to-TEXT (string &optional coding-system)
+  (or coding-system (setq coding-system mac-system-coding-system))
+  (let ((encodables (find-coding-systems-string string))
+        (rest mac-script-code-coding-systems))
+    (unless (memq (coding-system-base coding-system) encodables)
+      (while (and rest (not (memq (cdar rest) encodables)))
+        (setq rest (cdr rest)))
+      (if rest
+          (setq coding-system (cdar rest)))))
+  (setq coding-system
+        (coding-system-change-eol-conversion coding-system 'mac))
+  (when (eq coding-system 'japanese-shift-jis-mac)
+    ;; (setq string (subst-char-in-string ?\\ ?\x80 string))
+    (setq string (subst-char-in-string ?\¥ ?\x5c string)))
+  (encode-coding-string string coding-system))
+
+(defun mac-furl-to-string (data)
+  ;; Remove a trailing nul character.
+  (let ((len (length data)))
+    (if (and (> len 0) (= (aref data (1- len)) ?\0))
+        (substring data 0 (1- len))
+      data)))
+
+(defun mac-TIFF-to-string (data &optional text)
+  (prog1 (or text (setq text (copy-sequence " ")))
+    (put-text-property 0 (length text) 'display (create-image data 'tiff t)
+                       text)))
+
+;;;; Selections
+
+;;; We keep track of the last text selected here, so we can check the
+;;; current selection against it, and avoid passing back our own text
+;;; from x-get-selection-value.
+(defvar x-last-selected-text-clipboard nil
+  "The value of the CLIPBOARD selection last time we selected or
+pasted text.")
+(defvar x-last-selected-text-primary nil
+  "The value of the PRIMARY X selection last time we selected or
+pasted text.")
+
+(defcustom x-select-enable-clipboard t
+  "*Non-nil means cutting and pasting uses the clipboard.
+This is in addition to the primary selection."
+  :type 'boolean
+  :group 'killing)
+
+;;; Make TEXT, a string, the primary X selection.
+(defun x-select-text (text &optional push)
+  (x-set-selection 'PRIMARY text)
+  (setq x-last-selected-text-primary text)
+  (if (not x-select-enable-clipboard)
+      (setq x-last-selected-text-clipboard nil)
+    (x-set-selection 'CLIPBOARD text)
+    (setq x-last-selected-text-clipboard text))
+  )
+
+(defun x-get-selection (&optional type data-type)
+  "Return the value of a selection.
+The argument TYPE (default `PRIMARY') says which selection,
+and the argument DATA-TYPE (default `STRING') says
+how to convert the data.
+
+TYPE may be any symbol \(but nil stands for `PRIMARY').  However,
+only a few symbols are commonly used.  They conventionally have
+all upper-case names.  The most often used ones, in addition to
+`PRIMARY', are `SECONDARY' and `CLIPBOARD'.
+
+DATA-TYPE is usually `STRING', but can also be one of the symbols
+in `selection-converter-alist', which see."
+  (let ((data (x-get-selection-internal (or type 'PRIMARY)
+                                        (or data-type 'STRING)))
+        (coding (or next-selection-coding-system
+                    selection-coding-system)))
+    (when (and (stringp data)
+               (setq data-type (get-text-property 0 'foreign-selection data)))
+      (cond ((eq data-type 'public.utf16-plain-text)
+             (setq data (mac-utxt-to-string data coding)))
+            ((eq data-type 'com.apple.traditional-mac-plain-text)
+             (setq data (mac-TEXT-to-string data coding)))
+            ((eq data-type 'public.file-url)
+             (setq data (mac-furl-to-string data))))
+      (put-text-property 0 (length data) 'foreign-selection data-type data))
+    data))
+
+(defun x-selection-value (type)
+  (let ((data-types '(public.utf16-plain-text
+                      com.apple.traditional-mac-plain-text
+                      public.file-url))
+        text tiff-image)
+    (while (and (null text) data-types)
+      (setq text (condition-case nil
+                     (x-get-selection type (car data-types))
+                   (error nil)))
+      (setq data-types (cdr data-types)))
+    (if text
+        (remove-text-properties 0 (length text) '(foreign-selection nil) text))
+    (setq tiff-image (condition-case nil
+                         (x-get-selection type 'public.tiff)
+                       (error nil)))
+    (when tiff-image
+      (remove-text-properties 0 (length tiff-image)
+                              '(foreign-selection nil) tiff-image)
+      (setq text (mac-TIFF-to-string tiff-image text)))
+    text))
+
+;;; Return the value of the current selection.
+;;; Treat empty strings as if they were unset.
+;;; If this function is called twice and finds the same text,
+;;; it returns nil the second time.  This is so that a single
+;;; selection won't be added to the kill ring over and over.
+(defun x-get-selection-value ()
+  (let (clip-text primary-text)
+    (if (not x-select-enable-clipboard)
+        (setq x-last-selected-text-clipboard nil)
+      (setq clip-text (x-selection-value 'CLIPBOARD))
+      (if (string= clip-text "") (setq clip-text nil))
+
+      ;; Check the CLIPBOARD selection for 'newness', is it different
+      ;; from what we remebered them to be last time we did a
+      ;; cut/paste operation.
+      (setq clip-text
+            (cond;; check clipboard
+             ((or (not clip-text) (string= clip-text ""))
+              (setq x-last-selected-text-clipboard nil))
+             ((eq      clip-text x-last-selected-text-clipboard) nil)
+             ((string= clip-text x-last-selected-text-clipboard)
+              ;; Record the newer string,
+              ;; so subsequent calls can use the `eq' test.
+              (setq x-last-selected-text-clipboard clip-text)
+              nil)
+             (t
+              (setq x-last-selected-text-clipboard clip-text))))
+      )
+
+    (setq primary-text (x-selection-value 'PRIMARY))
+    ;; Check the PRIMARY selection for 'newness', is it different
+    ;; from what we remebered them to be last time we did a
+    ;; cut/paste operation.
+    (setq primary-text
+          (cond;; check primary selection
+           ((or (not primary-text) (string= primary-text ""))
+            (setq x-last-selected-text-primary nil))
+           ((eq      primary-text x-last-selected-text-primary) nil)
+           ((string= primary-text x-last-selected-text-primary)
+            ;; Record the newer string,
+            ;; so subsequent calls can use the `eq' test.
+            (setq x-last-selected-text-primary primary-text)
+            nil)
+           (t
+            (setq x-last-selected-text-primary primary-text))))
+
+    ;; As we have done one selection, clear this now.
+    (setq next-selection-coding-system nil)
+
+    ;; At this point we have recorded the current values for the
+    ;; selection from clipboard (if we are supposed to) and primary,
+    ;; So return the first one that has changed (which is the first
+    ;; non-null one).
+    (or clip-text primary-text)
+    ))
+
+(put 'CLIPBOARD 'mac-scrap-name "com.apple.scrap.clipboard")
+(when (eq system-type 'darwin)
+  (put 'FIND 'mac-scrap-name "com.apple.scrap.find")
+  (put 'PRIMARY 'mac-scrap-name
+       (format "org.gnu.Emacs.%d.selection.PRIMARY" (emacs-pid))))
+(put 'com.apple.traditional-mac-plain-text 'mac-ostype "TEXT")
+(put 'public.utf16-plain-text 'mac-ostype "utxt")
+(put 'public.tiff 'mac-ostype "TIFF")
+(put 'public.file-url 'mac-ostype "furl")
+
+(defun mac-select-convert-to-string (selection type value)
+  (let ((str (cdr (xselect-convert-to-string selection nil value)))
+        (coding (or next-selection-coding-system selection-coding-system)))
+    (when str
+      ;; If TYPE is nil, this is a local request, thus return STR as
+      ;; is.  Otherwise, encode STR.
+      (if (not type)
+          str
+        (let ((inhibit-read-only t))
+          (remove-text-properties 0 (length str) '(composition nil) str)
+          (cond
+           ((eq type 'public.utf16-plain-text)
+            (setq str (mac-string-to-utxt str coding)))
+           ((eq type 'com.apple.traditional-mac-plain-text)
+            (setq str (mac-string-to-TEXT str coding)))
+           (t
+            (error "Unknown selection type: %S" type))
+           )))
+
+      (setq next-selection-coding-system nil)
+      (cons type str))))
+
+(defun mac-select-convert-to-file-url (selection type value)
+  (let ((filename (xselect-convert-to-filename selection type value))
+        (coding (or file-name-coding-system default-file-name-coding-system)))
+    (if (and filename coding)
+        (setq filename (encode-coding-string filename coding)))
+    (and filename
+         (concat "file://localhost"
+                 (mapconcat 'url-hexify-string
+                            (split-string filename "/") "/")))))
+
+(setq selection-converter-alist
+      (nconc
+       '((public.utf16-plain-text . mac-select-convert-to-string)
+         (com.apple.traditional-mac-plain-text . mac-select-convert-to-string)
+         ;; This is not enabled by default because the `Import Image'
+         ;; menu makes Emacs crash or hang for unknown reasons.
+         ;; (public.tiff . nil)
+         (public.file-url . mac-select-convert-to-file-url)
+         )
+       selection-converter-alist))
+
+;;;; Apple events, HICommand events, and Services menu
+
+;;; Event classes
+(put 'core-event     'mac-apple-event-class "aevt") ; kCoreEventClass
+(put 'internet-event 'mac-apple-event-class "GURL") ; kAEInternetEventClass
+
+;;; 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
+;; kAEInternetEventClass
+(put 'get-url            'mac-apple-event-id "GURL") ; kAEGetURL
+;; Converted HICommand events
+(put 'about              'mac-apple-event-id "abou") ; kHICommandAbout
+
+(defmacro mac-event-spec (event)
+  `(nth 1 ,event))
+
+(defmacro mac-event-ae (event)
+  `(nth 2 ,event))
+
+(defun mac-ae-parameter (ae &optional keyword type)
+  (or keyword (setq keyword "----")) ;; Direct object.
+  (if (not (and (consp ae) (equal (car ae) "aevt")))
+      (error "Not an Apple event: %S" ae)
+    (let ((type-data (cdr (assoc keyword (cdr ae))))
+          data)
+      (when (and type type-data (not (equal type (car type-data))))
+        (setq data (mac-coerce-ae-data (car type-data) (cdr type-data) type))
+        (setq type-data (if data (cons type data) nil)))
+      type-data)))
+
+(defun mac-ae-list (ae &optional keyword type)
+  (or keyword (setq keyword "----")) ;; Direct object.
+  (let ((desc (mac-ae-parameter ae keyword "list")))
+    (cond ((null desc)
+           nil)
+          ((not (equal (car desc) "list"))
+           (error "Parameter for \"%s\" is not a list" keyword))
+          (t
+           (if (null type)
+               (cdr desc)
+             (mapcar
+              (lambda (type-data)
+                (mac-coerce-ae-data (car type-data) (cdr type-data) type))
+              (cdr desc)))))))
+
+(defun mac-bytes-to-integer (bytes &optional from to)
+  (or from (setq from 0))
+  (or to (setq to (length bytes)))
+  (let* ((len (- to from))
+         (extended-sign-len (- (1+ (ceiling (log most-positive-fixnum 2)))
+                               (* 8 len)))
+         (result 0))
+    (dotimes (i len)
+      (setq result (logior (lsh result 8)
+                           (aref bytes (+ from (if (eq (byteorder) ?B) i
+                                                 (- len i 1)))))))
+    (if (> extended-sign-len 0)
+        (ash (lsh result extended-sign-len) (- extended-sign-len))
+      result)))
+
+(defun mac-bytes-to-digits (bytes &optional from to)
+  (or from (setq from 0))
+  (or to (setq to (length bytes)))
+  (let ((len (- to from))
+        (val 0.0))
+    (dotimes (i len)
+      (setq val (+ (* val 256.0)
+                   (aref bytes (+ from (if (eq (byteorder) ?B) i
+                                         (- len i 1)))))))
+    (format "%.0f" val)))
+
+(defun mac-ae-selection-range (ae)
+;; #pragma options align=mac68k
+;; typedef struct SelectionRange {
+;;   short unused1; // 0 (not used)
+;;   short lineNum; // line to select (<0 to specify range)
+;;   long startRange; // start of selection range (if line < 0)
+;;   long endRange; // end of selection range (if line < 0)
+;;   long unused2; // 0 (not used)
+;;   long theDate; // modification date/time
+;; } SelectionRange;
+;; #pragma options align=reset
+  (let ((range-bytes (cdr (mac-ae-parameter ae "kpos" "TEXT"))))
+    (and range-bytes
+         (list (mac-bytes-to-integer range-bytes 2 4)
+               (mac-bytes-to-integer range-bytes 4 8)
+               (mac-bytes-to-integer range-bytes 8 12)
+               (mac-bytes-to-integer range-bytes 16 20)))))
+
+;; On Mac OS X 10.4 and later, the `open-document' event contains an
+;; optional parameter keyAESearchText from the Spotlight search.
+(defun mac-ae-text-for-search (ae)
+  (let ((utf8-text (cdr (mac-ae-parameter ae "stxt" "utf8"))))
+    (and utf8-text
+         (decode-coding-string utf8-text 'utf-8))))
+
+(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)))
+    (let ((selection-range (mac-ae-selection-range ae))
+          (search-text (mac-ae-text-for-search ae)))
+      (cond (selection-range
+             (let ((line (car selection-range))
+                   (start (cadr selection-range))
+                   (end (nth 2 selection-range)))
+               (if (> line 0)
+                   (goto-line line)
+                 (if (and (> start 0) (> end 0))
+                     (progn (set-mark start)
+                            (goto-char end))))))
+            ((stringp search-text)
+             (re-search-forward
+              (mapconcat 'regexp-quote (split-string search-text) "\\|")
+              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.")))