comparison lisp/term/mac-win.el @ 62100:e5deb8b3a701

Don't define or bind scroll bar functions if x-toolkit-scroll-bars is t. (x-select-text, x-get-selection-value): Clear x-last-selected-text-clipboard if x-select-enable-clipboard is nil. (PRIMARY): Put mac-scrap-name property. (mac-select-convert-to-file-url): New function. (public.file-url): New selection target type. Add to selection-converter-alist. (x-get-selection, x-selection-value): Handle it. (x-cut-buffer-or-selection-value): New alias.

62099:d1245d218964

;;; 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)
  (when x-select-enable-clipboard
    (x-set-selection 'CLIPBOARD text)
    (setq x-last-selected-text-clipboard text))
  )

(defun x-get-selection (&optional type data-type)

		     (setq data (decode-coding-string encoded coding))
		     (setq last-coding-system-used coding-save))
		 (setq data
		       (decode-coding-string data 'utf-16)))))
	    ((eq data-type 'com.apple.traditional-mac-plain-text)
	     (setq data (decode-coding-string data coding))))
      (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))))
    (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)))

;;; 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)
    (when x-select-enable-clipboard
      (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

    ;; non-null one).
    (or clip-text primary-text)
    ))

(put 'CLIPBOARD 'mac-scrap-name "com.apple.scrap.clipboard")
(if (eq system-type 'darwin)
    (put 'FIND 'mac-scrap-name "com.apple.scrap.find"))
(put 'com.apple.traditional-mac-plain-text 'mac-ostype "TEXT")
(put 'public.utf16-plain-text 'mac-ostype "utxt")
(put 'public.tiff 'mac-ostype "TIFF")

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

	   )))

      (setq next-selection-coding-system nil)
      (cons type str))))

(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)
	 )
       selection-converter-alist))

(defun mac-services-open-file ()
  (interactive)

;;; Arrange for the kill and yank functions to set and check the clipboard.
(setq interprogram-cut-function 'x-select-text)
(setq interprogram-paste-function 'x-get-selection-value)


;;; Turn off window-splitting optimization; Mac is usually fast enough
;;; that this is only annoying.
(setq split-window-keep-point t)

;; has been created: this is where the files should be opened.
(add-hook 'after-init-hook
	  '(lambda ()
	     (defvar mac-ready-for-drag-n-drop t)))

;;;; Scroll bars

;; for debugging
;; (defun mac-handle-scroll-bar-event (event) (interactive "e") (princ event))

;;(global-set-key [vertical-scroll-bar mouse-1] 'mac-handle-scroll-bar-event)

(defun mac-scroll-up-line ()
  (track-mouse
    (mac-scroll-ignore-events)
    (scroll-up 1)))


;;;; Others

(unless (eq system-type 'darwin)
  ;; This variable specifies the Unix program to call (as a process) to

62100:e5deb8b3a701

;;; 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)

		     (setq data (decode-coding-string encoded coding))
		     (setq last-coding-system-used coding-save))
		 (setq data
		       (decode-coding-string data 'utf-16)))))
	    ((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)))

;;; 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

    ;; 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))

	   )))

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

(defun mac-services-open-file ()
  (interactive)

;;; Arrange for the kill and yank functions to set and check the clipboard.
(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.
(setq split-window-keep-point t)

;; has been created: this is where the files should be opened.
(add-hook 'after-init-hook
	  '(lambda ()
	     (defvar mac-ready-for-drag-n-drop t)))

;;;; Non-toolkit Scroll bars

(unless x-toolkit-scroll-bars

;; for debugging
;; (defun mac-handle-scroll-bar-event (event) (interactive "e") (princ event))

;;(global-set-key [vertical-scroll-bar mouse-1] 'mac-handle-scroll-bar-event)

(defun mac-scroll-up-line ()
  (track-mouse
    (mac-scroll-ignore-events)
    (scroll-up 1)))

)

;;;; Others

(unless (eq system-type 'darwin)
  ;; This variable specifies the Unix program to call (as a process) to