;;; ns-win.el --- lisp side of interface with NeXT/Open/GNUstep/MacOS X window system -*- lexical-binding: t -*-
-;; Copyright (C) 1993-1994, 2005-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2005-2015 Free Software Foundation, Inc.
;; Authors: Carl Edman
;; Christian Limpach
(require 'faces)
(require 'menu-bar)
(require 'fontset)
+(require 'dnd)
(defgroup ns nil
"GNUstep/Mac OS X specific features."
;;;; Command line argument handling.
(defvar x-invocation-args)
-(defvar ns-command-line-resources nil) ; FIXME unused?
+;; Set in term/common-win.el; currently unused by Nextstep's x-open-connection.
+(defvar x-command-line-resources)
;; nsterm.m.
(defvar ns-input-file)
(define-key global-map [?\s-~] 'ns-prev-frame)
(define-key global-map [?\s--] 'center-line)
(define-key global-map [?\s-:] 'ispell)
-(define-key global-map [?\s-\;] 'ispell-next)
(define-key global-map [?\s-?] 'info)
(define-key global-map [?\s-^] 'kill-some-buffers)
(define-key global-map [?\s-&] 'kill-this-buffer)
(define-key global-map [ns-power-off] 'save-buffers-kill-emacs)
(define-key global-map [ns-open-file] 'ns-find-file)
(define-key global-map [ns-open-temp-file] [ns-open-file])
-(define-key global-map [ns-drag-file] 'ns-find-file)
-(define-key global-map [ns-drag-color] 'ns-set-foreground-at-mouse)
-(define-key global-map [S-ns-drag-color] 'ns-set-background-at-mouse)
-(define-key global-map [ns-drag-text] 'ns-insert-text)
(define-key global-map [ns-change-font] 'ns-respond-to-change-font)
(define-key global-map [ns-open-file-line] 'ns-open-file-select-line)
(define-key global-map [ns-spi-service-call] 'ns-spi-service-call)
;;;; Inter-app communications support.
-(defvar ns-input-text) ; nsterm.m
-
-(defun ns-insert-text ()
- "Insert contents of `ns-input-text' at point."
- (interactive)
- (insert ns-input-text)
- (setq ns-input-text nil))
-
(defun ns-insert-file ()
"Insert contents of file `ns-input-file' like insert-file but with less
prompting. If file is a directory perform a `find-file' on it."
(ns-hide-emacs 'activate)
(find-file f)))))
+
+(defun ns-drag-n-drop (event &optional new-frame force-text)
+ "Edit the files listed in the drag-n-drop EVENT.
+Switch to a buffer editing the last file dropped."
+ (interactive "e")
+ (let* ((window (posn-window (event-start event)))
+ (arg (car (cdr (cdr event))))
+ (type (car arg))
+ (data (car (cdr arg)))
+ (url-or-string (cond ((eq type 'file)
+ (concat "file:" data))
+ (t data))))
+ (set-frame-selected-window nil window)
+ (when new-frame
+ (select-frame (make-frame)))
+ (raise-frame)
+ (setq window (selected-window))
+ (if force-text
+ (dnd-insert-text window 'private data)
+ (dnd-handle-one-url window 'private url-or-string))))
+
+
+(defun ns-drag-n-drop-other-frame (event)
+ "Edit the files listed in the drag-n-drop EVENT, in other frames.
+May create new frames, or reuse existing ones. The frame editing
+the last file dropped is selected."
+ (interactive "e")
+ (ns-drag-n-drop event t))
+
+(defun ns-drag-n-drop-as-text (event)
+ "Drop the data in EVENT as text."
+ (interactive "e")
+ (ns-drag-n-drop event nil t))
+
+(defun ns-drag-n-drop-as-text-other-frame (event)
+ "Drop the data in EVENT as text in a new frame."
+ (interactive "e")
+ (ns-drag-n-drop event t t))
+
+(global-set-key [drag-n-drop] 'ns-drag-n-drop)
+(global-set-key [C-drag-n-drop] 'ns-drag-n-drop-other-frame)
+(global-set-key [M-drag-n-drop] 'ns-drag-n-drop-as-text)
+(global-set-key [C-M-drag-n-drop] 'ns-drag-n-drop-as-text-other-frame)
+
;;;; Frame-related functions.
;; nsterm.m
(interactive)
(other-frame -1))
-;; If no position specified, make new frame offset by 25 from current.
-;; You'd think this was a window manager's job, but apparently without
-;; this, new frames open exactly on top of old ones (?).
-;; http://lists.gnu.org/archive/html/emacs-devel/2010-10/msg00988.html
-;; Note that AFAICS it is not documented that functions on
-;; before-make-frame-hook can access PARAMETERS.
-(defvar parameters) ; dynamically bound in make-frame
-(add-hook 'before-make-frame-hook
- (lambda ()
- (let ((left (cdr (assq 'left (frame-parameters))))
- (top (cdr (assq 'top (frame-parameters)))))
- (if (consp left) (setq left (cadr left)))
- (if (consp top) (setq top (cadr top)))
- (cond
- ((or (assq 'top parameters) (assq 'left parameters)))
- ((or (not left) (not top)))
- (t
- (setq parameters (cons (cons 'left (+ left 25))
- (cons (cons 'top (+ top 25))
- parameters))))))))
-
-;; frame will be focused anyway, so select it
+;; Frame will be focused anyway, so select it
;; (if this is not done, mode line is dimmed until first interaction)
+;; FIXME: Sounds like we're working around a bug in the underlying code.
(add-hook 'after-make-frame-functions 'select-frame)
(defvar tool-bar-mode)
`(mouse-1 POSITION 1))))
(if (y-or-n-p (format "Print buffer %s? " (buffer-name)))
(print-buffer)
- (error "Cancelled")))
+ (error "Canceled")))
(print-buffer)))
;;;; Font support.
;;;; Pasteboard support.
(declare-function ns-get-selection-internal "nsselect.m" (buffer))
-(declare-function ns-store-selection-internal "nsselect.m" (buffer string))
(define-obsolete-function-alias 'ns-get-cut-buffer-internal
'ns-get-selection-internal "24.1")
(define-obsolete-function-alias 'ns-store-cut-buffer-internal
- 'ns-store-selection-internal "24.1")
-
-
-(defun ns-get-pasteboard ()
- "Returns the value of the pasteboard."
- (ns-get-selection-internal 'CLIPBOARD))
-
-(defun ns-set-pasteboard (string)
- "Store STRING into the pasteboard of the Nextstep display server."
- ;; Check the data type of STRING.
- (if (not (stringp string)) (error "Nonstring given to pasteboard"))
- (ns-store-selection-internal 'CLIPBOARD string))
-
-;; 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-selection-value.
-(defvar ns-last-selected-text nil)
-
-;; Return the value of the current Nextstep selection. For
-;; compatibility with older Nextstep applications, this checks cut
-;; buffer 0 before retrieving the value of the primary selection.
-(defun x-selection-value ()
- (let (text)
- ;; Consult the selection. Treat empty strings as if they were unset.
- (or text (setq text (ns-get-pasteboard)))
- (if (string= text "") (setq text nil))
- (cond
- ((not text) nil)
- ((eq text ns-last-selected-text) nil)
- ((string= text ns-last-selected-text)
- ;; Record the newer string, so subsequent calls can use the `eq' test.
- (setq ns-last-selected-text text)
- nil)
- (t
- (setq ns-last-selected-text text)))))
+ 'gui-set-selection "24.1")
+
(defun ns-copy-including-secondary ()
(interactive)
(call-interactively 'kill-ring-save)
- (ns-store-selection-internal 'SECONDARY
- (buffer-substring (point) (mark t))))
+ (gui-set-selection 'SECONDARY (buffer-substring (point) (mark t))))
+
(defun ns-paste-secondary ()
(interactive)
(insert (ns-get-selection-internal 'SECONDARY)))
(t
nil))))
-(defvar ns-input-color) ; nsterm.m
-
-(defun ns-set-foreground-at-mouse ()
- "Set the foreground color at the mouse location to `ns-input-color'."
- (interactive)
- (let* ((pos (mouse-position))
- (frame (car pos))
- (face (ns-face-at-pos pos)))
- (cond
- ((eq face 'cursor)
- (modify-frame-parameters frame (list (cons 'cursor-color
- ns-input-color))))
- ((not face)
- (modify-frame-parameters frame (list (cons 'foreground-color
- ns-input-color))))
- (t
- (set-face-foreground face ns-input-color frame)))))
+(defun ns-suspend-error ()
+ ;; Don't allow suspending if any of the frames are NS frames.
+ (if (memq 'ns (mapcar 'window-system (frame-list)))
+ (error "Cannot suspend Emacs while running under NS")))
-(defun ns-set-background-at-mouse ()
- "Set the background color at the mouse location to `ns-input-color'."
- (interactive)
- (let* ((pos (mouse-position))
- (frame (car pos))
- (face (ns-face-at-pos pos)))
- (cond
- ((eq face 'cursor)
- (modify-frame-parameters frame (list (cons 'cursor-color
- ns-input-color))))
- ((not face)
- (modify-frame-parameters frame (list (cons 'background-color
- ns-input-color))))
- (t
- (set-face-background face ns-input-color frame)))))
;; Set some options to be as Nextstep-like as possible.
(setq frame-title-format t
(defvar ns-initialized nil
"Non-nil if Nextstep windowing has been initialized.")
+(declare-function x-handle-args "common-win" (args))
(declare-function ns-list-services "nsfns.m" ())
(declare-function x-open-connection "nsfns.m"
(display &optional xrm-string must-succeed))
(format "Creation of the standard fontset failed: %s" err)
:error)))
- (x-open-connection (system-name) nil t)
+ (x-open-connection (system-name) x-command-line-resources t)
+
+ ;; Add GNUstep menu items Services, Hide and Quit. Rename Help to Info
+ ;; and put it first (i.e. omit from menu-bar-final-items.
+ (if (featurep 'gnustep)
+ (progn
+ (setq menu-bar-final-items '(buffer services hide-app quit))
+
+ ;; If running under GNUstep, "Help" is moved and renamed "Info".
+ (bindings--define-key global-map [menu-bar help-menu]
+ (cons "Info" menu-bar-help-menu))
+ (bindings--define-key global-map [menu-bar quit]
+ '(menu-item "Quit" save-buffers-kill-emacs
+ :help "Save unsaved buffers, then exit"))
+ (bindings--define-key global-map [menu-bar hide-app]
+ '(menu-item "Hide" ns-do-hide-emacs
+ :help "Hide Emacs"))
+ (bindings--define-key global-map [menu-bar services]
+ (cons "Services" (make-sparse-keymap "Services")))))
+
(dolist (service (ns-list-services))
(if (eq (car service) 'undefined)
;; FIXME: This will surely lead to "MODIFIED OUTSIDE CUSTOM" warnings.
(menu-bar-mode (if (get-lisp-resource nil "Menus") 1 -1))
+ ;; For Darwin nothing except UTF-8 makes sense.
+ (when (eq system-type 'darwin)
+ (add-hook 'before-init-hook
+ #'(lambda ()
+ (setq locale-coding-system 'utf-8-unix)
+ (setq default-process-coding-system
+ '(utf-8-unix . utf-8-unix)))))
+
;; OS X Lion introduces PressAndHold, which is unsupported by this port.
;; See this thread for more details:
;; http://lists.gnu.org/archive/html/emacs-devel/2011-06/msg00505.html
(ns-set-resource nil "ApplePressAndHoldEnabled" "NO")
(x-apply-session-resources)
- (setq ns-initialized t))
-(add-to-list 'display-format-alist '("\\`ns\\'" . ns))
-(add-to-list 'handle-args-function-alist '(ns . x-handle-args))
-(add-to-list 'frame-creation-function-alist '(ns . x-create-frame-with-faces))
-(add-to-list 'window-system-initialization-alist '(ns . ns-initialize-window-system))
+ ;; Don't let Emacs suspend under NS.
+ (add-hook 'suspend-hook 'ns-suspend-error)
+
+ (setq ns-initialized t))
+;; Any display name is OK.
+(add-to-list 'display-format-alist '(".*" . ns))
+(gui-method-define handle-args-function ns #'x-handle-args)
+(gui-method-define frame-creation-function ns #'x-create-frame-with-faces)
+(gui-method-define window-system-initialization ns
+ #'ns-initialize-window-system)
+
+(gui-method-define gui-set-selection ns
+ (lambda (selection value)
+ (if value (ns-own-selection-internal selection value)
+ (ns-disown-selection-internal selection))))
+(gui-method-define gui-selection-owner-p ns #'ns-selection-owner-p)
+(gui-method-define gui-selection-exists-p ns #'ns-selection-exists-p)
+(gui-method-define gui-get-selection ns #'ns-get-selection)
(provide 'ns-win)