diff lisp/term/ns-win.el @ 111183:72ef880ed198

Let ns load common-win. * lisp/term/common-win.el (x-select-enable-clipboard): * lisp/term/pc-win.el (x-select-enable-clipboard): Doc fix. * lisp/term/ns-win.el: No need to require cl when compiling. (x-display-name, x-setup-function-keys, x-select-text, x-colors) (xw-defined-colors): Use the common-win definitions. (ns-alternatives-map): Make it an obsolete alias for x-alternatives-map. (ns-handle-iconic): Make it an alias for x-handle-iconic. * lisp/term/common-win.el (x-select-text, x-alternatives-map) (x-setup-function-keys, x-colors, xw-defined-colors): Handle 'ns case. * lisp/loadup.el [ns]: Load common-win.

--- a/lisp/term/ns-win.el	Tue Oct 26 10:31:27 2010 +0900
+++ b/lisp/term/ns-win.el	Mon Oct 25 19:59:05 2010 -0700
@@ -42,11 +42,9 @@
 ;;; Code:
 
 
-(if (not (featurep 'ns))
+(or (featurep 'ns)
     (error "%s: Loading ns-win.el but not compiled for GNUstep/MacOS"
-	   (invocation-name)))
-
-(eval-when-compile (require 'cl))
+           (invocation-name)))
 
 ;; Documentation-purposes only: actually loaded in loadup.el
 (require 'frame)
@@ -84,10 +82,7 @@
 (defun ns-handle-numeric-switch (switch)
   (ns-handle-switch switch t))
 
-;; Make -iconic apply only to the initial frame!
-(defun ns-handle-iconic (switch)
-  (setq initial-frame-alist
-        (cons '(visibility . icon) initial-frame-alist)))
+(defalias 'ns-handle-iconic 'x-handle-iconic)
 
 ;; Handle the -name option, set the name of the initial frame.
 (defun ns-handle-name-switch (switch)
@@ -96,12 +91,6 @@
   (setq initial-frame-alist (cons (cons 'name (pop ns-invocation-args))
                                   initial-frame-alist)))
 
-;; Set (but not used?) in frame.el.
-(defvar x-display-name nil
-  "The name of the window display on which Emacs was started.
-On X, the display name of individual X frames is recorded in the
-`display' frame parameter.")
-
 ;; nsterm.m.
 (defvar ns-input-file)
 
@@ -183,20 +172,7 @@
 
 ;;;; Keyboard mapping.
 
-(defvar ns-alternatives-map
-  (let ((map (make-sparse-keymap)))
-    ;; Map certain keypad keys into ASCII characters
-    ;; that people usually expect.
-    (define-key map [S-tab] [backtab])
-    (define-key map [M-backspace] [?\M-\d])
-    (define-key map [M-delete] [?\M-\d])
-    (define-key map [M-tab] [?\M-\t])
-    (define-key map [M-linefeed] [?\M-\n])
-    (define-key map [M-clear] [?\M-\C-l])
-    (define-key map [M-return] [?\M-\C-m])
-    (define-key map [M-escape] [?\M-\e])
-    map)
-  "Keymap of alternative meanings for some keys under Nextstep.")
+(define-obsolete-variable-alias 'ns-alternatives-map 'x-alternatives-map "24.1")
 
 ;; Here are some Nextstep-like bindings for command key sequences.
 (define-key global-map [?\s-,] 'customize)
@@ -286,115 +262,6 @@
 (declare-function ns-do-applescript "nsfns.m" (script))
 (defalias 'do-applescript 'ns-do-applescript)
 
-(defun x-setup-function-keys (frame)
-  "Set up `function-key-map' on the graphical frame FRAME."
-  (unless (terminal-parameter frame 'x-setup-function-keys)
-    (with-selected-frame frame
-      (setq interprogram-cut-function 'x-select-text
-	    interprogram-paste-function 'x-selection-value)
-      (let ((map (copy-keymap ns-alternatives-map)))
-	(set-keymap-parent map (keymap-parent local-function-key-map))
-	(set-keymap-parent local-function-key-map map))
-      (setq system-key-alist
-            (list
-             (cons (logior (lsh 0 16)   1) 'ns-power-off)
-             (cons (logior (lsh 0 16)   2) 'ns-open-file)
-             (cons (logior (lsh 0 16)   3) 'ns-open-temp-file)
-             (cons (logior (lsh 0 16)   4) 'ns-drag-file)
-             (cons (logior (lsh 0 16)   5) 'ns-drag-color)
-             (cons (logior (lsh 0 16)   6) 'ns-drag-text)
-             (cons (logior (lsh 0 16)   7) 'ns-change-font)
-             (cons (logior (lsh 0 16)   8) 'ns-open-file-line)
-;             (cons (logior (lsh 0 16)   9) 'ns-insert-working-text)
-;             (cons (logior (lsh 0 16)  10) 'ns-delete-working-text)
-             (cons (logior (lsh 0 16)  11) 'ns-spi-service-call)
-	     (cons (logior (lsh 0 16)  12) 'ns-new-frame)
-	     (cons (logior (lsh 0 16)  13) 'ns-toggle-toolbar)
-	     (cons (logior (lsh 0 16)  14) 'ns-show-prefs)
-	     (cons (logior (lsh 1 16)  32) 'f1)
-             (cons (logior (lsh 1 16)  33) 'f2)
-             (cons (logior (lsh 1 16)  34) 'f3)
-             (cons (logior (lsh 1 16)  35) 'f4)
-             (cons (logior (lsh 1 16)  36) 'f5)
-             (cons (logior (lsh 1 16)  37) 'f6)
-             (cons (logior (lsh 1 16)  38) 'f7)
-             (cons (logior (lsh 1 16)  39) 'f8)
-             (cons (logior (lsh 1 16)  40) 'f9)
-             (cons (logior (lsh 1 16)  41) 'f10)
-             (cons (logior (lsh 1 16)  42) 'f11)
-             (cons (logior (lsh 1 16)  43) 'f12)
-             (cons (logior (lsh 1 16)  44) 'kp-insert)
-             (cons (logior (lsh 1 16)  45) 'kp-delete)
-             (cons (logior (lsh 1 16)  46) 'kp-home)
-             (cons (logior (lsh 1 16)  47) 'kp-end)
-             (cons (logior (lsh 1 16)  48) 'kp-prior)
-             (cons (logior (lsh 1 16)  49) 'kp-next)
-             (cons (logior (lsh 1 16)  50) 'print-screen)
-             (cons (logior (lsh 1 16)  51) 'scroll-lock)
-             (cons (logior (lsh 1 16)  52) 'pause)
-             (cons (logior (lsh 1 16)  53) 'system)
-             (cons (logior (lsh 1 16)  54) 'break)
-             (cons (logior (lsh 1 16)  56) 'please-tell-carl-what-this-key-is-called-56)
-             (cons (logior (lsh 1 16)  61) 'please-tell-carl-what-this-key-is-called-61)
-             (cons (logior (lsh 1 16)  62) 'please-tell-carl-what-this-key-is-called-62)
-             (cons (logior (lsh 1 16)  63) 'please-tell-carl-what-this-key-is-called-63)
-             (cons (logior (lsh 1 16)  64) 'please-tell-carl-what-this-key-is-called-64)
-             (cons (logior (lsh 1 16)  69) 'please-tell-carl-what-this-key-is-called-69)
-             (cons (logior (lsh 1 16)  70) 'please-tell-carl-what-this-key-is-called-70)
-             (cons (logior (lsh 1 16)  71) 'please-tell-carl-what-this-key-is-called-71)
-             (cons (logior (lsh 1 16)  72) 'please-tell-carl-what-this-key-is-called-72)
-             (cons (logior (lsh 1 16)  73) 'please-tell-carl-what-this-key-is-called-73)
-             (cons (logior (lsh 2 16)   3) 'kp-enter)
-             (cons (logior (lsh 2 16)   9) 'kp-tab)
-             (cons (logior (lsh 2 16)  28) 'kp-quit)
-             (cons (logior (lsh 2 16)  35) 'kp-hash)
-             (cons (logior (lsh 2 16)  42) 'kp-multiply)
-             (cons (logior (lsh 2 16)  43) 'kp-add)
-             (cons (logior (lsh 2 16)  44) 'kp-separator)
-             (cons (logior (lsh 2 16)  45) 'kp-subtract)
-             (cons (logior (lsh 2 16)  46) 'kp-decimal)
-             (cons (logior (lsh 2 16)  47) 'kp-divide)
-             (cons (logior (lsh 2 16)  48) 'kp-0)
-             (cons (logior (lsh 2 16)  49) 'kp-1)
-             (cons (logior (lsh 2 16)  50) 'kp-2)
-             (cons (logior (lsh 2 16)  51) 'kp-3)
-             (cons (logior (lsh 2 16)  52) 'kp-4)
-             (cons (logior (lsh 2 16)  53) 'kp-5)
-             (cons (logior (lsh 2 16)  54) 'kp-6)
-             (cons (logior (lsh 2 16)  55) 'kp-7)
-             (cons (logior (lsh 2 16)  56) 'kp-8)
-             (cons (logior (lsh 2 16)  57) 'kp-9)
-             (cons (logior (lsh 2 16)  60) 'kp-less)
-             (cons (logior (lsh 2 16)  61) 'kp-equal)
-             (cons (logior (lsh 2 16)  62) 'kp-more)
-             (cons (logior (lsh 2 16)  64) 'kp-at)
-             (cons (logior (lsh 2 16)  92) 'kp-backslash)
-             (cons (logior (lsh 2 16)  96) 'kp-backtick)
-             (cons (logior (lsh 2 16) 124) 'kp-bar)
-             (cons (logior (lsh 2 16) 126) 'kp-tilde)
-             (cons (logior (lsh 2 16) 157) 'kp-mu)
-             (cons (logior (lsh 2 16) 165) 'kp-yen)
-             (cons (logior (lsh 2 16) 167) 'kp-paragraph)
-             (cons (logior (lsh 2 16) 172) 'left)
-             (cons (logior (lsh 2 16) 173) 'up)
-             (cons (logior (lsh 2 16) 174) 'right)
-             (cons (logior (lsh 2 16) 175) 'down)
-             (cons (logior (lsh 2 16) 176) 'kp-ring)
-             (cons (logior (lsh 2 16) 201) 'kp-square)
-             (cons (logior (lsh 2 16) 204) 'kp-cube)
-             (cons (logior (lsh 3 16)   8) 'backspace)
-             (cons (logior (lsh 3 16)   9) 'tab)
-             (cons (logior (lsh 3 16)  10) 'linefeed)
-             (cons (logior (lsh 3 16)  11) 'clear)
-             (cons (logior (lsh 3 16)  13) 'return)
-             (cons (logior (lsh 3 16)  18) 'pause)
-             (cons (logior (lsh 3 16)  25) 'S-tab)
-             (cons (logior (lsh 3 16)  27) 'escape)
-             (cons (logior (lsh 3 16) 127) 'delete)
-             )))
-    (set-terminal-parameter frame 'x-setup-function-keys t)))
-
-
 ;; 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"))
@@ -911,17 +778,16 @@
 See the documentation of `create-fontset-from-fontset-spec' for the format.")
 
 ;; Conditional on new-fontset so bootstrapping works on non-GUI compiles.
-(if (fboundp 'new-fontset)
-    (progn
-      ;; Setup the default fontset.
-      (create-default-fontset)
-      ;; Create the standard fontset.
-      (condition-case err
-	  (create-fontset-from-fontset-spec ns-standard-fontset-spec t)
-	(error (display-warning
-		'initialization
-		(format "Creation of the standard fontset failed: %s" err)
-		:error)))))
+(when (fboundp 'new-fontset)
+  ;; Setup the default fontset.
+  (create-default-fontset)
+  ;; Create the standard fontset.
+  (condition-case err
+      (create-fontset-from-fontset-spec ns-standard-fontset-spec t)
+    (error (display-warning
+            'initialization
+            (format "Creation of the standard fontset failed: %s" err)
+            :error))))
 
 (defvar ns-reg-to-script)               ; nsfont.m
 
@@ -985,23 +851,6 @@
 ;; from x-selection-value.
 (defvar ns-last-selected-text nil)
 
-(defun x-select-text (text)
-  "Select TEXT, a string, according to the window system.
-
-On X, if `x-select-enable-clipboard' is non-nil, copy TEXT to the
-clipboard.  If `x-select-enable-primary' is non-nil, put TEXT in
-the primary selection.
-
-On MS-Windows, make TEXT the current selection.  If
-`x-select-enable-clipboard' is non-nil, copy the text to the
-clipboard as well.
-
-On Nextstep, put TEXT in the pasteboard."
-  ;; Don't send the pasteboard too much text.
-  ;; It becomes slow, and if really big it causes errors.
-  (ns-set-pasteboard text)
-  (setq ns-last-selected-text text))
-
 ;; 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.
@@ -1093,27 +942,6 @@
 
 ;;;; Color support.
 
-(declare-function ns-list-colors "nsfns.m" (&optional frame))
-
-(defvar x-colors (ns-list-colors)
-  "List of basic colors available on color displays.
-For X, the list comes from the `rgb.txt' file,v 10.41 94/02/20.
-For Nextstep, this is a list of non-PANTONE colors returned by
-the operating system.")
-
-(defun xw-defined-colors (&optional frame)
-  "Internal function called by `defined-colors', which see."
-  (or frame (setq frame (selected-frame)))
-  (let ((all-colors x-colors)
-	(this-color nil)
-	(defined-colors nil))
-    (while all-colors
-      (setq this-color (car all-colors)
-	    all-colors (cdr all-colors))
-      ;; (and (face-color-supported-p frame this-color t)
-      (setq defined-colors (cons this-color defined-colors))) ;;)
-    defined-colors))
-
 ;; Functions for color panel + drag
 (defun ns-face-at-pos (pos)
   (let* ((frame (car pos))