comparison lisp/term/mac-win.el @ 61778:1b44d34506e4

Require select. Set selection-coding-system to mac-system-coding-system. Call menu-bar-enable-clipboard. (x-last-selected-text-clipboard, x-last-selected-text-primary) (x-select-enable-clipboard): New variables. (x-select-text, x-get-selection, x-selection-value) (x-get-selection-value, mac-select-convert-to-string) (mac-services-open-file, mac-services-open-selection) (mac-services-insert-text): New functions. (CLIPBOARD, FIND): Put mac-scrap-name property. (com.apple.traditional-mac-plain-text, public.utf16-plain-text) (public.tiff): Put mac-ostype property. (selection-converter-alist): Add entries for them. (mac-application-menu-map): New keymap. (interprogram-cut-function, interprogram-paste-function): Set to x-select-text and x-get-selection-value, respectively. (split-window-keep-point): Set to t.

61777:c323711ae68f

(require 'frame)
(require 'mouse)
(require 'scroll-bar)
(require 'faces)
;;(require 'select)
(require 'menu-bar)
(require 'fontset)
(require 'dnd)

(defvar x-invocation-args)

    (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 and cut buffers

;; Setup to use the Mac clipboard.  The functions mac-cut-function and
;; mac-paste-function are defined in mac.c.
(set-selection-coding-system 'compound-text-mac)

(setq interprogram-cut-function
      '(lambda (str push)
	 (mac-cut-function
	  (encode-coding-string str selection-coding-system t) push)))

(setq interprogram-paste-function
      '(lambda ()
	 (let ((clipboard (mac-paste-function)))
	   (if clipboard
	       (decode-coding-string clipboard selection-coding-system t)))))

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

	     (generic-char-p key)
	     (memq (char-charset key)
		   '(ascii eight-bit-control eight-bit-graphic))
	     (set-fontset-font fontset key font)))
       (get encoder 'translation-table)))))
 
(defun create-fontset-from-mac-roman-font (font &optional resolved-font
						fontset-name)
  "Create a fontset from a Mac roman font FONT.

Optional 1st arg RESOLVED-FONT is a resolved name of FONT.  If

(defun x-win-suspend-error ()
  (error "Suspending an Emacs running under Mac makes no sense"))
(add-hook 'suspend-hook 'x-win-suspend-error)

;; Don't show the frame name; that's redundant.
(setq-default mode-line-frame-identification "  ")

;; Turn on support for mouse wheels.
(mouse-wheel-mode 1)

(defun mac-drag-n-drop (event)
  "Edit the files listed in the drag-n-drop EVENT.
Switch to a buffer editing the last file dropped."
  (interactive "e")

61778:1b44d34506e4

(require 'frame)
(require 'mouse)
(require 'scroll-bar)
(require 'faces)
(require 'select)
(require 'menu-bar)
(require 'fontset)
(require 'dnd)

(defvar x-invocation-args)

    (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 and Services menu

;; Setup to use the Mac clipboard.
(set-selection-coding-system mac-system-coding-system)

;;; 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)
  (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)
  "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
							  'utf-16 coding))))
	       (if encoded
		   (let ((coding-save last-coding-system-used))
		     (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)))
    (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)
    (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
      ;; 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")
(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))
    (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 'utf-16)))
	      (setq str (or s (encode-coding-string str 'utf-16-mac)))))
	   ((eq type 'com.apple.traditional-mac-plain-text)
	    (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))))

(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)
  (find-file-existing (x-selection-value mac-services-selection)))

(defun mac-services-open-selection ()
  (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-insert-text ()
  (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]")))))

(defvar mac-application-menu-map (make-sparse-keymap))
(define-key mac-application-menu-map [quit] 'save-buffers-kill-emacs)
(define-key mac-application-menu-map [services perform open-file]
  'mac-services-open-file)
(define-key mac-application-menu-map [services perform open-selection]
  'mac-services-open-selection)
(define-key mac-application-menu-map [services paste]
  'mac-services-insert-text)
(define-key mac-application-menu-map [preferences] 'customize)
(define-key mac-application-menu-map [about] 'display-splash-screen)
(global-set-key [menu-bar application] mac-application-menu-map)

;;; 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))

	     (generic-char-p key)
	     (memq (char-charset key)
		   '(ascii eight-bit-control eight-bit-graphic))
	     (set-fontset-font fontset key font)))
       (get encoder 'translation-table)))))

(defun create-fontset-from-mac-roman-font (font &optional resolved-font
						fontset-name)
  "Create a fontset from a Mac roman font FONT.

Optional 1st arg RESOLVED-FONT is a resolved name of FONT.  If

(defun x-win-suspend-error ()
  (error "Suspending an Emacs running under Mac makes no sense"))
(add-hook 'suspend-hook 'x-win-suspend-error)

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

;; Don't show the frame name; that's redundant.
(setq-default mode-line-frame-identification "  ")

;; Turn on support for mouse wheels.
(mouse-wheel-mode 1)


;; Enable CLIPBOARD copy/paste through menu bar commands.
(menu-bar-enable-clipboard)

(defun mac-drag-n-drop (event)
  "Edit the files listed in the drag-n-drop EVENT.
Switch to a buffer editing the last file dropped."
  (interactive "e")