]> code.delx.au - gnu-emacs/blobdiff - lisp/term/ns-win.el
Merge from emacs-24, up to 2012-04-10T02:06:19Z!larsi@gnus.org
[gnu-emacs] / lisp / term / ns-win.el
index 6541ee4b68c3eacfeee62bc661f498b67bebfcb5..b681ec3440f80c82a06e93fe3c3302011ef9e959 100644 (file)
@@ -1,7 +1,6 @@
 ;;; ns-win.el --- lisp side of interface with NeXT/Open/GNUstep/MacOS X window system
 
-;; Copyright (C) 1993, 1994, 2005, 2006, 2007, 2008, 2009, 2010
-;;   Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2005-2012  Free Software Foundation, Inc.
 
 ;; Authors: Carl Edman
 ;;     Christian Limpach
 
 ;;; Code:
 
-
 (or (featurep 'ns)
     (error "%s: Loading ns-win.el but not compiled for GNUstep/MacOS"
            (invocation-name)))
 
-;; Documentation-purposes only: actually loaded in loadup.el
+(eval-when-compile (require 'cl))       ; lexical-let
+
+;; Documentation-purposes only: actually loaded in loadup.el.
 (require 'frame)
 (require 'mouse)
 (require 'faces)
   "GNUstep/Mac OS X specific features."
   :group 'environment)
 
-;; nsterm.m
-(defvar ns-alternate-modifier)
-(defvar ns-right-alternate-modifier)
-
 ;;;; Command line argument handling.
 
 (defvar x-invocation-args)
 ;; nsterm.m.
 (defvar ns-input-file)
 
-(defun ns-handle-nxopen (switch)
-  (setq unread-command-events (append unread-command-events '(ns-open-file))
+(defun ns-handle-nxopen (switch &optional temp)
+  (setq unread-command-events (append unread-command-events
+                                      (if temp '(ns-open-temp-file)
+                                        '(ns-open-file)))
         ns-input-file (append ns-input-file (list (pop x-invocation-args)))))
 
 (defun ns-handle-nxopentemp (switch)
-  (setq unread-command-events (append unread-command-events
-                                     '(ns-open-temp-file))
-        ns-input-file (append ns-input-file (list (pop x-invocation-args)))))
+  (ns-handle-nxopen switch t))
 
 (defun ns-ignore-1-arg (switch)
   (setq x-invocation-args (cdr x-invocation-args)))
-(defun ns-ignore-2-arg (switch)         ; FIXME unused?
-  (setq x-invocation-args (cddr x-invocation-args)))
 
 (defun ns-parse-geometry (geom)
   "Parse a Nextstep-style geometry string GEOM.
@@ -156,20 +150,20 @@ The properties returned may include `top', `left', `height', and `width'."
 (define-key global-map [end] 'end-of-buffer)
 (define-key global-map [kp-home] 'beginning-of-buffer)
 (define-key global-map [kp-end] 'end-of-buffer)
-(define-key global-map [kp-prior] 'scroll-down)
-(define-key global-map [kp-next] 'scroll-up)
+(define-key global-map [kp-prior] 'scroll-down-command)
+(define-key global-map [kp-next] 'scroll-up-command)
 
-;;; Allow shift-clicks to work similarly to under Nextstep
+;; Allow shift-clicks to work similarly to under Nextstep.
 (define-key global-map [S-mouse-1] 'mouse-save-then-kill)
 (global-unset-key [S-down-mouse-1])
 
-
 ;; Special Nextstep-generated events are converted to function keys.  Here
-;; are the bindings for them.
+;; are the bindings for them.  Note, these keys are actually declared in
+;; x-setup-function-keys in common-win.
 (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-insert-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)
@@ -186,55 +180,15 @@ The properties returned may include `top', `left', `height', and `width'."
 
 (defvaralias 'mac-allow-anti-aliasing 'ns-antialias-text)
 (defvaralias 'mac-command-modifier 'ns-command-modifier)
+(defvaralias 'mac-right-command-modifier 'ns-right-command-modifier)
 (defvaralias 'mac-control-modifier 'ns-control-modifier)
+(defvaralias 'mac-right-control-modifier 'ns-right-control-modifier)
 (defvaralias 'mac-option-modifier 'ns-option-modifier)
 (defvaralias 'mac-right-option-modifier 'ns-right-option-modifier)
 (defvaralias 'mac-function-modifier 'ns-function-modifier)
 (declare-function ns-do-applescript "nsfns.m" (script))
 (defalias 'do-applescript 'ns-do-applescript)
 
-;; Add a couple of menus and rearrange some others; easiest just to redo toplvl
-;; Note keymap defns must be given last-to-first
-(define-key global-map [menu-bar] (make-sparse-keymap "menu-bar"))
-
-(setq menu-bar-final-items
-      (cond ((eq system-type 'darwin)
-             '(buffer windows services help-menu))
-            ;; Otherwise, GNUstep.
-            (t
-             '(buffer windows services hide-app quit))))
-
-;; Add standard top-level items to GNUstep menu.
-(unless (eq system-type 'darwin)
-  (define-key global-map [menu-bar quit] '("Quit" . save-buffers-kill-emacs))
-  (define-key global-map [menu-bar hide-app] '("Hide" . ns-do-hide-emacs)))
-
-(define-key global-map [menu-bar services]
-  (cons "Services" (make-sparse-keymap "Services")))
-(define-key global-map [menu-bar buffer]
-  (cons "Buffers" global-buffers-menu-map))
-;;  (cons "Buffers" (make-sparse-keymap "Buffers")))
-(define-key global-map [menu-bar tools] (cons "Tools" menu-bar-tools-menu))
-(define-key global-map [menu-bar options] (cons "Options" menu-bar-options-menu))
-(define-key global-map [menu-bar edit] (cons "Edit" menu-bar-edit-menu))
-(define-key global-map [menu-bar file] (cons "File" menu-bar-file-menu))
-
-;; If running under GNUstep, rename "Help" to "Info"
-(cond ((eq system-type 'darwin)
-       (define-key global-map [menu-bar help-menu]
-        (cons "Help" menu-bar-help-menu)))
-      (t
-       (let ((contents (reverse (cdr menu-bar-help-menu))))
-        (setq menu-bar-help-menu
-              (append (list 'keymap) (cdr contents) (list "Info"))))
-       (define-key global-map [menu-bar help-menu]
-        (cons "Info" menu-bar-help-menu))))
-
-(if (not (eq system-type 'darwin))
-    ;; in OS X it's in the app menu already
-    (define-key menu-bar-help-menu [info-panel]
-      '("About Emacs..." . ns-do-emacs-info-panel)))
-
 ;;;; Services
 (declare-function ns-perform-service "nsfns.m" (service send))
 
@@ -298,10 +252,6 @@ The properties returned may include `top', `left', `height', and `width'."
        (t (error (concat "Service " ns-input-spi-name " not recognized")))))
 
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-
 ;; Composed key sequence handling for Nextstep system input methods.
 ;; (On Nextstep systems, input methods are provided for CJK
 ;; characters, etc. which require multiple keystrokes, and during
@@ -398,29 +348,24 @@ See `ns-insert-working-text'."
 ;;;; OS X file system Unicode UTF-8 NFD (decomposed form) support
 ;; Lisp code based on utf-8m.el, by Seiji Zenitani, Eiji Honjoh, and
 ;; Carsten Bormann.
-(if (eq system-type 'darwin)
-    (progn
-
-      (defun ns-utf8-nfd-post-read-conversion (length)
-       "Calls `ns-convert-utf8-nfd-to-nfc' to compose char sequences."
-       (save-excursion
-         (save-restriction
-           (narrow-to-region (point) (+ (point) length))
-           (let ((str (buffer-string)))
-             (delete-region (point-min) (point-max))
-             (insert (ns-convert-utf8-nfd-to-nfc str))
-             (- (point-max) (point-min))
-             ))))
-
-      (define-coding-system 'utf-8-nfd
-       "UTF-8 NFD (decomposed) encoding."
-       :coding-type 'utf-8
-       :mnemonic ?U
-       :charset-list '(unicode)
-       :post-read-conversion 'ns-utf8-nfd-post-read-conversion)
-      (set-file-name-coding-system 'utf-8-nfd)))
-
-
+(when (eq system-type 'darwin)
+  (defun ns-utf8-nfd-post-read-conversion (length)
+    "Calls `ns-convert-utf8-nfd-to-nfc' to compose char sequences."
+    (save-excursion
+      (save-restriction
+        (narrow-to-region (point) (+ (point) length))
+        (let ((str (buffer-string)))
+          (delete-region (point-min) (point-max))
+          (insert (ns-convert-utf8-nfd-to-nfc str))
+          (- (point-max) (point-min))))))
+
+  (define-coding-system 'utf-8-nfd
+    "UTF-8 NFD (decomposed) encoding."
+    :coding-type 'utf-8
+    :mnemonic ?U
+    :charset-list '(unicode)
+    :post-read-conversion 'ns-utf8-nfd-post-read-conversion)
+  (set-file-name-coding-system 'utf-8-nfd))
 
 ;;;; Inter-app communications support.
 
@@ -436,12 +381,10 @@ See `ns-insert-working-text'."
   "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."
   (interactive)
-  (let ((f))
-    (setq f (car ns-input-file))
-    (setq ns-input-file (cdr ns-input-file))
+  (let ((f (pop ns-input-file)))
     (if (file-directory-p f)
         (find-file f)
-      (push-mark (+ (point) (car (cdr (insert-file-contents f))))))))
+      (push-mark (+ (point) (cadr (insert-file-contents f)))))))
 
 (defvar ns-select-overlay nil
   "Overlay used to highlight areas in files requested by Nextstep apps.")
@@ -494,8 +437,6 @@ Lines are highlighted according to `ns-input-line'."
 
 (add-hook 'first-change-hook 'ns-unselect-line)
 
-
-
 ;;;; Preferences handling.
 (declare-function ns-get-resource "nsfns.m" (owner name))
 
@@ -546,12 +487,12 @@ unless the current buffer is a scratch buffer."
 (defun ns-find-file ()
   "Do a `find-file' with the `ns-input-file' as argument."
   (interactive)
-  (let ((f) (file) (bufwin1) (bufwin2))
-    (setq f (file-truename (car ns-input-file)))
-    (setq ns-input-file (cdr ns-input-file))
-    (setq file (find-file-noselect f))
-    (setq bufwin1 (get-buffer-window file 'visible))
-    (setq bufwin2 (get-buffer-window "*scratch*" 'visibile))
+  (let* ((f (file-truename
+            (expand-file-name (pop ns-input-file)
+                              command-line-default-directory)))
+         (file (find-file-noselect f))
+         (bufwin1 (get-buffer-window file 'visible))
+         (bufwin2 (get-buffer-window "*scratch*" 'visible)))
     (cond
      (bufwin1
       (select-frame (window-frame bufwin1))
@@ -570,12 +511,13 @@ unless the current buffer is a scratch buffer."
       (ns-hide-emacs 'activate)
       (find-file f)))))
 
-
-
 ;;;; Frame-related functions.
 
-;; Don't show the frame name; that's redundant with Nextstep.
-(setq-default mode-line-frame-identification '("  "))
+;; nsterm.m
+(defvar ns-alternate-modifier)
+(defvar ns-right-alternate-modifier)
+(defvar ns-right-command-modifier)
+(defvar ns-right-control-modifier)
 
 ;; You say tomAYto, I say tomAHto..
 (defvaralias 'ns-option-modifier 'ns-alternate-modifier)
@@ -643,10 +585,8 @@ unless the current buffer is a scratch buffer."
   (if (not tool-bar-mode) (tool-bar-mode t)))
 
 
-
 ;;;; Dialog-related functions.
 
-
 ;; Ask user for confirm before printing.  Due to Kevin Rodgers.
 (defun ns-print-buffer ()
   "Interactive front-end to `print-buffer': asks for user confirmation first."
@@ -664,7 +604,6 @@ unless the current buffer is a scratch buffer."
          (error "Cancelled")))
     (print-buffer)))
 
-
 ;;;; Font support.
 
 ;; Needed for font listing functions under both backend and normal
@@ -723,7 +662,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
 (defvar ns-reg-to-script)               ; nsfont.m
 
 ;; This maps font registries (not exposed by NS APIs for font selection) to
-;; unicode scripts (which can be mapped to unicode character ranges which are).
+;; Unicode scripts (which can be mapped to Unicode character ranges which are).
 ;; See ../international/fontset.el
 (setq ns-reg-to-script
       '(("iso8859-1" . latin)
@@ -763,19 +702,24 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
 
 ;;;; Pasteboard support.
 
-(declare-function ns-get-cut-buffer-internal "nsselect.m" (buffer))
+(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-cut-buffer-internal 'CLIPBOARD))
-
-(declare-function ns-store-cut-buffer-internal "nsselect.m" (buffer string))
+  (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-cut-buffer-internal 'CLIPBOARD string))
+  (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
@@ -787,11 +731,9 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
 ;; 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)
@@ -805,12 +747,11 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
 (defun ns-copy-including-secondary ()
   (interactive)
   (call-interactively 'kill-ring-save)
-  (ns-store-cut-buffer-internal 'SECONDARY
-                               (buffer-substring (point) (mark t))))
+  (ns-store-selection-internal 'SECONDARY
+                              (buffer-substring (point) (mark t))))
 (defun ns-paste-secondary ()
   (interactive)
-  (insert (ns-get-cut-buffer-internal 'SECONDARY)))
-
+  (insert (ns-get-selection-internal 'SECONDARY)))
 
 
 ;;;; Scrollbar handling.
@@ -953,6 +894,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
 (declare-function ns-list-services "nsfns.m" ())
 (declare-function x-open-connection "nsfns.m"
                   (display &optional xrm-string must-succeed))
+(declare-function ns-set-resource "nsfns.m" (owner name value))
 
 ;; Do the actual Nextstep Windows setup here; the above code just
 ;; defines functions and variables that we use now.
@@ -977,6 +919,11 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
   ;; FIXME: This will surely lead to "MODIFIED OUTSIDE CUSTOM" warnings.
   (menu-bar-mode (if (get-lisp-resource nil "Menus") 1 -1))
 
+  ;; 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")
+
   (setq ns-initialized t))
 
 (add-to-list 'handle-args-function-alist '(ns . x-handle-args))