diff lisp/term/mac-win.el @ 90180:62afea0771d8

Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-51 Merge from emacs--cvs-trunk--0 Patches applied: * emacs--cvs-trunk--0 (patch 289-301) - Update from CVS - Merge from gnus--rel--5.10 * gnus--rel--5.10 (patch 68) - Update from CVS
author Miles Bader <miles@gnu.org>
date Thu, 12 May 2005 03:41:19 +0000
parents 08185296b491 eaa9acd9122c
children f042e7c0fe20
line wrap: on
line diff
--- a/lisp/term/mac-win.el	Thu May 12 02:47:44 2005 +0000
+++ b/lisp/term/mac-win.el	Thu May 12 03:41:19 2005 +0000
@@ -1,6 +1,6 @@
 ;;; mac-win.el --- parse switches controlling interface with Mac window system -*-coding: utf-8
 
-;; Copyright (C) 1999, 2000, 2002, 2003, 2004, 2005
+;; Copyright (C) 1999, 2000, 2002, 2003, 2005
 ;;   Free Software Foundation, Inc.
 
 ;; Author: Andrew Choi <akochoi@mac.com>
@@ -1168,7 +1168,8 @@
 (defun x-select-text (text &optional push)
   (x-set-selection 'PRIMARY text)
   (setq x-last-selected-text-primary text)
-  (when x-select-enable-clipboard
+  (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))
   )
@@ -1203,20 +1204,26 @@
 		 (setq data
 		       (decode-coding-string data 'utf-16)))))
 	    ((eq data-type 'com.apple.traditional-mac-plain-text)
-	     (setq data (decode-coding-string data coding))))
+	     (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 (text tiff-image)
-    (setq text (condition-case nil
-		   (x-get-selection type 'public.utf16-plain-text)
-		 (error nil)))
-    (if (not text)
-	(setq text (condition-case nil
-		       (x-get-selection type
-					'com.apple.traditional-mac-plain-text)
-		     (error nil))))
+  (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
@@ -1237,7 +1244,8 @@
 ;;; selection won't be added to the kill ring over and over.
 (defun x-get-selection-value ()
   (let (clip-text primary-text)
-    (when x-select-enable-clipboard
+    (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))
 
@@ -1286,11 +1294,14 @@
     ))
 
 (put 'CLIPBOARD 'mac-scrap-name "com.apple.scrap.clipboard")
-(if (eq system-type 'darwin)
-    (put 'FIND 'mac-scrap-name "com.apple.scrap.find"))
+(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)))
@@ -1326,6 +1337,16 @@
       (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)
@@ -1333,6 +1354,7 @@
 	 ;; 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))
 
@@ -1657,6 +1679,7 @@
 (setq interprogram-cut-function 'x-select-text)
 (setq interprogram-paste-function 'x-get-selection-value)
 
+(defalias 'x-cut-buffer-or-selection-value 'x-get-selection-value)
 
 ;;; Turn off window-splitting optimization; Mac is usually fast enough
 ;;; that this is only annoying.
@@ -1711,7 +1734,9 @@
 	  '(lambda ()
 	     (defvar mac-ready-for-drag-n-drop t)))
 
-;;;; Scroll bars
+;;;; Non-toolkit Scroll bars
+
+(unless x-toolkit-scroll-bars
 
 ;; for debugging
 ;; (defun mac-handle-scroll-bar-event (event) (interactive "e") (princ event))
@@ -1771,6 +1796,7 @@
     (mac-scroll-ignore-events)
     (scroll-up 1)))
 
+)
 
 ;;;; Others