lisp/term/ns-win.el

   1 ;;; ns-win.el --- lisp side of interface with NeXT/Open/GNUstep/MacOS X window system
   2
   3 ;; Copyright (C) 1993, 1994, 2005, 2006, 2007, 2008, 2009
   4 ;;   Free Software Foundation, Inc.
   5
   6 ;; Authors: Carl Edman
   7 ;;      Christian Limpach
   8 ;;      Scott Bender
   9 ;;      Christophe de Dinechin
  10 ;;      Adrian Robert
  11 ;; Keywords: terminals
  12
  13 ;; This file is part of GNU Emacs.
  14
  15 ;; GNU Emacs is free software: you can redistribute it and/or modify
  16 ;; it under the terms of the GNU General Public License as published by
  17 ;; the Free Software Foundation, either version 3 of the License, or
  18 ;; (at your option) any later version.
  19
  20 ;; GNU Emacs is distributed in the hope that it will be useful,
  21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 ;; GNU General Public License for more details.
  24
  25 ;; You should have received a copy of the GNU General Public License
  26 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  27
  28 ;;; Commentary:
  29
  30 ;; ns-win.el: this file is loaded from ../lisp/startup.el when it
  31 ;; recognizes that Nextstep windows are to be used.  Command line
  32 ;; switches are parsed and those pertaining to Nextstep are processed
  33 ;; and removed from the command line.  The Nextstep display is opened
  34 ;; and hooks are set for popping up the initial window.
  35
  36 ;; startup.el will then examine startup files, and eventually call the hooks
  37 ;; which create the first window (s).
  38
  39 ;; A number of other Nextstep convenience functions are defined in
  40 ;; this file, which works in close coordination with src/nsfns.m.
  41
  42 ;;; Code:
  43
  44
  45 (if (not (featurep 'ns))
  46     (error "%s: Loading ns-win.el but not compiled for GNUstep/MacOS"
  47            (invocation-name)))
  48
  49 (eval-when-compile (require 'cl))
  50
  51 ;; Documentation-purposes only: actually loaded in loadup.el
  52 (require 'frame)
  53 (require 'mouse)
  54 (require 'faces)
  55 (require 'easymenu)
  56 (require 'menu-bar)
  57 (require 'fontset)
  58
  59 ;; Not needed?
  60 ;;(require 'ispell)
  61
  62 (defgroup ns nil
  63   "GNUstep/Mac OS X specific features."
  64   :group 'environment)
  65
  66 ;; nsterm.m
  67 (defvar ns-version-string)
  68 (defvar ns-expand-space)
  69 (defvar ns-alternate-modifier)
  70
  71 ;;;; Command line argument handling.
  72
  73 (defvar ns-invocation-args nil)
  74 (defvar ns-command-line-resources nil)
  75
  76 ;; Handler for switches of the form "-switch value" or "-switch".
  77 (defun ns-handle-switch (switch &optional numeric)
  78   (let ((aelt (assoc switch command-line-ns-option-alist)))
  79     (if aelt
  80         (setq default-frame-alist
  81               (cons (cons (nth 3 aelt)
  82                           (if numeric
  83                               (string-to-number (pop ns-invocation-args))
  84                             (or (nth 4 aelt) (pop ns-invocation-args))))
  85                     default-frame-alist)))))
  86
  87 ;; Handler for switches of the form "-switch n"
  88 (defun ns-handle-numeric-switch (switch)
  89   (ns-handle-switch switch t))
  90
  91 ;; Make -iconic apply only to the initial frame!
  92 (defun ns-handle-iconic (switch)
  93   (setq initial-frame-alist
  94         (cons '(visibility . icon) initial-frame-alist)))
  95
  96 ;; Handle the -name option, set the name of the initial frame.
  97 (defun ns-handle-name-switch (switch)
  98   (or (consp ns-invocation-args)
  99       (error "%s: missing argument to `%s' option" (invocation-name) switch))
 100   (setq initial-frame-alist (cons (cons 'name (pop ns-invocation-args))
 101                                   initial-frame-alist)))
 102
 103 ;; Set (but not used?) in frame.el.
 104 (defvar x-display-name nil
 105   "The name of the Nextstep display on which Emacs was started.")
 106
 107 ;; nsterm.m.
 108 (defvar ns-input-file)
 109
 110 (defun ns-handle-nxopen (switch)
 111   (setq unread-command-events (append unread-command-events '(ns-open-file))
 112         ns-input-file (append ns-input-file (list (pop ns-invocation-args)))))
 113
 114 (defun ns-handle-nxopentemp (switch)
 115   (setq unread-command-events (append unread-command-events
 116                                       '(ns-open-temp-file))
 117         ns-input-file (append ns-input-file (list (pop ns-invocation-args)))))
 118
 119 (defun ns-ignore-1-arg (switch)
 120   (setq ns-invocation-args (cdr ns-invocation-args)))
 121 (defun ns-ignore-2-arg (switch)
 122   (setq ns-invocation-args (cddr ns-invocation-args)))
 123
 124 (defun ns-handle-args (args)
 125   "Process Nextstep-related command line options.
 126 This is run before the user's startup file is loaded.
 127 The options in ARGS are copied to `ns-invocation-args'.
 128 The Nextstep-related settings are then applied using the handlers
 129 defined in `command-line-ns-option-alist'.
 130 The return value is ARGS minus the number of arguments processed."
 131   ;; We use ARGS to accumulate the args that we don't handle here, to return.
 132   (setq ns-invocation-args args
 133         args nil)
 134   (while ns-invocation-args
 135     (let* ((this-switch (pop ns-invocation-args))
 136            (orig-this-switch this-switch)
 137            completion argval aelt handler)
 138       ;; Check for long options with attached arguments
 139       ;; and separate out the attached option argument into argval.
 140       (if (string-match "^--[^=]*=" this-switch)
 141           (setq argval (substring this-switch (match-end 0))
 142                 this-switch (substring this-switch 0 (1- (match-end 0)))))
 143       ;; Complete names of long options.
 144       (if (string-match "^--" this-switch)
 145           (progn
 146             (setq completion (try-completion this-switch
 147                                              command-line-ns-option-alist))
 148             (if (eq completion t)
 149                 ;; Exact match for long option.
 150                 nil
 151               (if (stringp completion)
 152                   (let ((elt (assoc completion command-line-ns-option-alist)))
 153                     ;; Check for abbreviated long option.
 154                     (or elt
 155                         (error "Option `%s' is ambiguous" this-switch))
 156                     (setq this-switch completion))))))
 157       (setq aelt (assoc this-switch command-line-ns-option-alist))
 158       (if aelt (setq handler (nth 2 aelt)))
 159       (if handler
 160           (if argval
 161               (let ((ns-invocation-args
 162                      (cons argval ns-invocation-args)))
 163                 (funcall handler this-switch))
 164             (funcall handler this-switch))
 165         (setq args (cons orig-this-switch args)))))
 166   (nreverse args))
 167
 168 (defun ns-parse-geometry (geom)
 169   "Parse a Nextstep-style geometry string GEOM.
 170 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
 171 The properties returned may include `top', `left', `height', and `width'."
 172   (when (string-match "\\([0-9]+\\)\\( \\([0-9]+\\)\\( \\([0-9]+\\)\
 173 \\( \\([0-9]+\\) ?\\)?\\)?\\)?"
 174                       geom)
 175     (apply
 176      'append
 177      (list
 178       (list (cons 'top (string-to-number (match-string 1 geom))))
 179       (if (match-string 3 geom)
 180           (list (cons 'left (string-to-number (match-string 3 geom)))))
 181       (if (match-string 5 geom)
 182           (list (cons 'height (string-to-number (match-string 5 geom)))))
 183       (if (match-string 7 geom)
 184           (list (cons 'width (string-to-number (match-string 7 geom)))))))))
 185
 186 ;;;; Keyboard mapping.
 187
 188 ;; These tell read-char how to convert these special chars to ASCII.
 189 ;;TODO: all terms have these, and at least the return mapping is necessary
 190 ;;      for tramp to recognize the enter key.
 191 ;;      Perhaps they should be moved into common code somewhere
 192 ;;      (when a window system is active).
 193 ;;      Remove if no problems for some time after 2008-08-06.
 194 (put 'backspace 'ascii-character 127)
 195 (put 'delete 'ascii-character 127)
 196 (put 'tab 'ascii-character ?\t)
 197 (put 'S-tab 'ascii-character (logior 16 ?\t))
 198 (put 'linefeed 'ascii-character ?\n)
 199 (put 'clear 'ascii-character 12)
 200 (put 'return 'ascii-character 13)
 201 (put 'escape 'ascii-character ?\e)
 202
 203
 204 (defvar ns-alternatives-map
 205   (let ((map (make-sparse-keymap)))
 206     ;; Map certain keypad keys into ASCII characters
 207     ;; that people usually expect.
 208     (define-key map [backspace] [?\d])
 209     (define-key map [delete] [?\d])
 210     (define-key map [tab] [?\t])
 211     (define-key map [S-tab] [25])
 212     (define-key map [linefeed] [?\n])
 213     (define-key map [clear] [?\C-l])
 214     (define-key map [return] [?\C-m])
 215     (define-key map [escape] [?\e])
 216     (define-key map [M-backspace] [?\M-\d])
 217     (define-key map [M-delete] [?\M-\d])
 218     (define-key map [M-tab] [?\M-\t])
 219     (define-key map [M-linefeed] [?\M-\n])
 220     (define-key map [M-clear] [?\M-\C-l])
 221     (define-key map [M-return] [?\M-\C-m])
 222     (define-key map [M-escape] [?\M-\e])
 223     map)
 224   "Keymap of alternative meanings for some keys under NS.")
 225
 226 ;; Here are some Nextstep-like bindings for command key sequences.
 227 (define-key global-map [?\s-,] 'ns-popup-prefs-panel)
 228 (define-key global-map [?\s-'] 'next-multiframe-window)
 229 (define-key global-map [?\s-`] 'other-frame)
 230 (define-key global-map [?\s--] 'center-line)
 231 (define-key global-map [?\s-:] 'ispell)
 232 (define-key global-map [?\s-\;] 'ispell-next)
 233 (define-key global-map [?\s-?] 'info)
 234 (define-key global-map [?\s-^] 'kill-some-buffers)
 235 (define-key global-map [?\s-&] 'kill-this-buffer)
 236 (define-key global-map [?\s-C] 'ns-popup-color-panel)
 237 (define-key global-map [?\s-D] 'dired)
 238 (define-key global-map [?\s-E] 'edit-abbrevs)
 239 (define-key global-map [?\s-L] 'shell-command)
 240 (define-key global-map [?\s-M] 'manual-entry)
 241 (define-key global-map [?\s-S] 'ns-write-file-using-panel)
 242 (define-key global-map [?\s-a] 'mark-whole-buffer)
 243 (define-key global-map [?\s-c] 'ns-copy-including-secondary)
 244 (define-key global-map [?\s-d] 'isearch-repeat-backward)
 245 (define-key global-map [?\s-e] 'isearch-yank-kill)
 246 (define-key global-map [?\s-f] 'isearch-forward)
 247 (define-key global-map [?\s-g] 'isearch-repeat-forward)
 248 (define-key global-map [?\s-h] 'ns-do-hide-emacs)
 249 (define-key global-map [?\s-H] 'ns-do-hide-others)
 250 (define-key global-map [?\s-j] 'exchange-point-and-mark)
 251 (define-key global-map [?\s-k] 'kill-this-buffer)
 252 (define-key global-map [?\s-l] 'goto-line)
 253 (define-key global-map [?\s-m] 'iconify-frame)
 254 (define-key global-map [?\s-n] 'make-frame)
 255 (define-key global-map [?\s-o] 'ns-open-file-using-panel)
 256 (define-key global-map [?\s-p] 'ns-print-buffer)
 257 (define-key global-map [?\s-q] 'save-buffers-kill-emacs)
 258 (define-key global-map [?\s-s] 'save-buffer)
 259 (define-key global-map [?\s-t] 'ns-popup-font-panel)
 260 (define-key global-map [?\s-u] 'revert-buffer)
 261 (define-key global-map [?\s-v] 'yank)
 262 (define-key global-map [?\s-w] 'delete-frame)
 263 (define-key global-map [?\s-x] 'kill-region)
 264 (define-key global-map [?\s-y] 'ns-paste-secondary)
 265 (define-key global-map [?\s-z] 'undo)
 266 (define-key global-map [?\s-|] 'shell-command-on-region)
 267 (define-key global-map [s-kp-bar] 'shell-command-on-region)
 268 ;; (as in Terminal.app)
 269 (define-key global-map [s-right] 'ns-next-frame)
 270 (define-key global-map [s-left] 'ns-prev-frame)
 271
 272 (define-key global-map [home] 'beginning-of-buffer)
 273 (define-key global-map [end] 'end-of-buffer)
 274 (define-key global-map [kp-home] 'beginning-of-buffer)
 275 (define-key global-map [kp-end] 'end-of-buffer)
 276 (define-key global-map [kp-prior] 'scroll-down)
 277 (define-key global-map [kp-next] 'scroll-up)
 278
 279 ;;; Allow shift-clicks to work similarly to under Nextstep
 280 (define-key global-map [S-mouse-1] 'mouse-save-then-kill)
 281 (global-unset-key [S-down-mouse-1])
 282
 283
 284 ;; Special Nextstep-generated events are converted to function keys.  Here
 285 ;; are the bindings for them.
 286 (define-key global-map [ns-power-off]
 287   (lambda () (interactive) (save-buffers-kill-emacs t)))
 288 (define-key global-map [ns-open-file] 'ns-find-file)
 289 (define-key global-map [ns-open-temp-file] [ns-open-file])
 290 (define-key global-map [ns-drag-file] 'ns-insert-file)
 291 (define-key global-map [ns-drag-color] 'ns-set-foreground-at-mouse)
 292 (define-key global-map [S-ns-drag-color] 'ns-set-background-at-mouse)
 293 (define-key global-map [ns-drag-text] 'ns-insert-text)
 294 (define-key global-map [ns-change-font] 'ns-respond-to-change-font)
 295 (define-key global-map [ns-open-file-line] 'ns-open-file-select-line)
 296 (define-key global-map [ns-spi-service-call] 'ns-spi-service-call)
 297 (define-key global-map [ns-new-frame] 'make-frame)
 298 (define-key global-map [ns-toggle-toolbar] 'ns-toggle-toolbar)
 299 (define-key global-map [ns-info-prefs] 'ns-show-preferences-help)
 300
 301
 302 ;; Functions to set environment variables by running a subshell.
 303 ;;; Idea based on Nextstep 4.2 distribution, this version of code
 304 ;;; based on mac-read-environment-vars-from-shell () by David Reitter.
 305 ;;; Mostly used only under ns-extended-platform-support-mode.
 306
 307 (defun ns-make-command-string (cmdlist)
 308   (mapconcat 'identity cmdlist " ; "))
 309
 310 ;;;###autoload
 311 (defun ns-grabenv (&optional shell-path startup)
 312   "Set the Emacs environment using the output of a shell command.
 313 This runs a shell subprocess, and interpret its output as a
 314 series of environment variables to insert into the emacs
 315 environment.
 316 SHELL-PATH gives the path to the shell; if nil, this defaults to
 317 the current setting of `shell-file-name'.
 318 STARTUP is a list of commands for the shell to execute; if nil,
 319 this defaults to \"printenv\"."
 320   (interactive)
 321   (with-temp-buffer
 322     (let ((shell-file-name (if shell-path shell-path shell-file-name))
 323           (cmd (ns-make-command-string (if startup startup '("printenv")))))
 324       (shell-command cmd t)
 325       (while (search-forward-regexp "^\\([A-Za-z_0-9]+\\)=\\(.*\\)$" nil t)
 326         (setenv (match-string 1)
 327                 (if (equal (match-string 1) "PATH")
 328                     (concat (getenv "PATH") ":" (match-string 2))
 329                   (match-string 2)))))))
 330
 331 ;; Set up a number of aliases and other layers to pretend we're using
 332 ;; the Choi/Mitsuharu Carbon port.
 333
 334 (defvaralias 'mac-allow-anti-aliasing 'ns-antialias-text)
 335 (defvaralias 'mac-command-modifier 'ns-command-modifier)
 336 (defvaralias 'mac-control-modifier 'ns-control-modifier)
 337 (defvaralias 'mac-option-modifier 'ns-option-modifier)
 338 (defvaralias 'mac-function-modifier 'ns-function-modifier)
 339 (declare-function ns-do-applescript "nsfns.m" (script))
 340 (defalias 'do-applescript 'ns-do-applescript)
 341
 342
 343 (defvar menu-bar-ns-file-menu)          ; below
 344
 345 ;; Toggle some additional Nextstep-like features that may interfere
 346 ;; with users' expectations coming from emacs on other platforms.
 347 (define-minor-mode ns-extended-platform-support-mode
 348   "Toggle Nextstep extended platform support features.
 349    When this mode is active (no modeline indicator):
 350    - File menu is altered slightly in keeping with conventions.
 351    - Screen position is preserved in scrolling.
 352    - Transient mark mode is activated"
 353   :init-value nil
 354   :global t
 355   :group 'ns
 356   (if ns-extended-platform-support-mode
 357       (progn
 358         (defun ns-show-manual () "Show Emacs.app section in the Emacs manual"
 359           (interactive)
 360           (info "(emacs) Mac OS / GNUstep"))
 361         (setq where-is-preferred-modifier 'super)
 362         (setq scroll-preserve-screen-position t)
 363         (transient-mark-mode 1)
 364
 365         ;; Change file menu to simplify and add a couple of
 366         ;; Nextstep-specific items
 367         (easy-menu-remove-item global-map '("menu-bar") 'file)
 368         (easy-menu-add-item global-map '(menu-bar)
 369                             (cons "File" menu-bar-ns-file-menu) 'edit)
 370         (define-key menu-bar-help-menu [ns-manual]
 371           '(menu-item "Read the Emacs.app Manual Chapter" ns-show-manual)))
 372     (progn
 373       ;; Undo everything above.
 374       (fmakunbound 'ns-show-manual)
 375       (setq where-is-preferred-modifier 'nil)
 376       (setq scroll-preserve-screen-position nil)
 377       (transient-mark-mode 0)
 378       (easy-menu-remove-item global-map '("menu-bar") 'file)
 379       (easy-menu-add-item global-map '(menu-bar)
 380                           (cons "File" menu-bar-file-menu) 'edit)
 381       (easy-menu-remove-item global-map '("menu-bar" "help-menu") 'ns-manual)
 382 )))
 383
 384
 385 (defun x-setup-function-keys (frame)
 386   "Set up function Keys for Nextstep for frame FRAME."
 387   (unless (terminal-parameter frame 'x-setup-function-keys)
 388     (with-selected-frame frame
 389       (setq interprogram-cut-function 'x-select-text
 390             interprogram-paste-function 'x-cut-buffer-or-selection-value)
 391       (let ((map (copy-keymap ns-alternatives-map)))
 392         (set-keymap-parent map (keymap-parent local-function-key-map))
 393         (set-keymap-parent local-function-key-map map))
 394       (setq system-key-alist
 395             (list
 396              (cons (logior (lsh 0 16)   1) 'ns-power-off)
 397              (cons (logior (lsh 0 16)   2) 'ns-open-file)
 398              (cons (logior (lsh 0 16)   3) 'ns-open-temp-file)
 399              (cons (logior (lsh 0 16)   4) 'ns-drag-file)
 400              (cons (logior (lsh 0 16)   5) 'ns-drag-color)
 401              (cons (logior (lsh 0 16)   6) 'ns-drag-text)
 402              (cons (logior (lsh 0 16)   7) 'ns-change-font)
 403              (cons (logior (lsh 0 16)   8) 'ns-open-file-line)
 404 ;             (cons (logior (lsh 0 16)   9) 'ns-insert-working-text)
 405 ;             (cons (logior (lsh 0 16)  10) 'ns-delete-working-text)
 406              (cons (logior (lsh 0 16)  11) 'ns-spi-service-call)
 407              (cons (logior (lsh 0 16)  12) 'ns-new-frame)
 408              (cons (logior (lsh 0 16)  13) 'ns-toggle-toolbar)
 409              (cons (logior (lsh 0 16)  14) 'ns-info-prefs)
 410              (cons (logior (lsh 1 16)  32) 'f1)
 411              (cons (logior (lsh 1 16)  33) 'f2)
 412              (cons (logior (lsh 1 16)  34) 'f3)
 413              (cons (logior (lsh 1 16)  35) 'f4)
 414              (cons (logior (lsh 1 16)  36) 'f5)
 415              (cons (logior (lsh 1 16)  37) 'f6)
 416              (cons (logior (lsh 1 16)  38) 'f7)
 417              (cons (logior (lsh 1 16)  39) 'f8)
 418              (cons (logior (lsh 1 16)  40) 'f9)
 419              (cons (logior (lsh 1 16)  41) 'f10)
 420              (cons (logior (lsh 1 16)  42) 'f11)
 421              (cons (logior (lsh 1 16)  43) 'f12)
 422              (cons (logior (lsh 1 16)  44) 'kp-insert)
 423              (cons (logior (lsh 1 16)  45) 'kp-delete)
 424              (cons (logior (lsh 1 16)  46) 'kp-home)
 425              (cons (logior (lsh 1 16)  47) 'kp-end)
 426              (cons (logior (lsh 1 16)  48) 'kp-prior)
 427              (cons (logior (lsh 1 16)  49) 'kp-next)
 428              (cons (logior (lsh 1 16)  50) 'print-screen)
 429              (cons (logior (lsh 1 16)  51) 'scroll-lock)
 430              (cons (logior (lsh 1 16)  52) 'pause)
 431              (cons (logior (lsh 1 16)  53) 'system)
 432              (cons (logior (lsh 1 16)  54) 'break)
 433              (cons (logior (lsh 1 16)  56) 'please-tell-carl-what-this-key-is-called-56)
 434              (cons (logior (lsh 1 16)  61) 'please-tell-carl-what-this-key-is-called-61)
 435              (cons (logior (lsh 1 16)  62) 'please-tell-carl-what-this-key-is-called-62)
 436              (cons (logior (lsh 1 16)  63) 'please-tell-carl-what-this-key-is-called-63)
 437              (cons (logior (lsh 1 16)  64) 'please-tell-carl-what-this-key-is-called-64)
 438              (cons (logior (lsh 1 16)  69) 'please-tell-carl-what-this-key-is-called-69)
 439              (cons (logior (lsh 1 16)  70) 'please-tell-carl-what-this-key-is-called-70)
 440              (cons (logior (lsh 1 16)  71) 'please-tell-carl-what-this-key-is-called-71)
 441              (cons (logior (lsh 1 16)  72) 'please-tell-carl-what-this-key-is-called-72)
 442              (cons (logior (lsh 1 16)  73) 'please-tell-carl-what-this-key-is-called-73)
 443              (cons (logior (lsh 2 16)   3) 'kp-enter)
 444              (cons (logior (lsh 2 16)   9) 'kp-tab)
 445              (cons (logior (lsh 2 16)  28) 'kp-quit)
 446              (cons (logior (lsh 2 16)  35) 'kp-hash)
 447              (cons (logior (lsh 2 16)  42) 'kp-multiply)
 448              (cons (logior (lsh 2 16)  43) 'kp-add)
 449              (cons (logior (lsh 2 16)  44) 'kp-separator)
 450              (cons (logior (lsh 2 16)  45) 'kp-subtract)
 451              (cons (logior (lsh 2 16)  46) 'kp-decimal)
 452              (cons (logior (lsh 2 16)  47) 'kp-divide)
 453              (cons (logior (lsh 2 16)  48) 'kp-0)
 454              (cons (logior (lsh 2 16)  49) 'kp-1)
 455              (cons (logior (lsh 2 16)  50) 'kp-2)
 456              (cons (logior (lsh 2 16)  51) 'kp-3)
 457              (cons (logior (lsh 2 16)  52) 'kp-4)
 458              (cons (logior (lsh 2 16)  53) 'kp-5)
 459              (cons (logior (lsh 2 16)  54) 'kp-6)
 460              (cons (logior (lsh 2 16)  55) 'kp-7)
 461              (cons (logior (lsh 2 16)  56) 'kp-8)
 462              (cons (logior (lsh 2 16)  57) 'kp-9)
 463              (cons (logior (lsh 2 16)  60) 'kp-less)
 464              (cons (logior (lsh 2 16)  61) 'kp-equal)
 465              (cons (logior (lsh 2 16)  62) 'kp-more)
 466              (cons (logior (lsh 2 16)  64) 'kp-at)
 467              (cons (logior (lsh 2 16)  92) 'kp-backslash)
 468              (cons (logior (lsh 2 16)  96) 'kp-backtick)
 469              (cons (logior (lsh 2 16) 124) 'kp-bar)
 470              (cons (logior (lsh 2 16) 126) 'kp-tilde)
 471              (cons (logior (lsh 2 16) 157) 'kp-mu)
 472              (cons (logior (lsh 2 16) 165) 'kp-yen)
 473              (cons (logior (lsh 2 16) 167) 'kp-paragraph)
 474              (cons (logior (lsh 2 16) 172) 'left)
 475              (cons (logior (lsh 2 16) 173) 'up)
 476              (cons (logior (lsh 2 16) 174) 'right)
 477              (cons (logior (lsh 2 16) 175) 'down)
 478              (cons (logior (lsh 2 16) 176) 'kp-ring)
 479              (cons (logior (lsh 2 16) 201) 'kp-square)
 480              (cons (logior (lsh 2 16) 204) 'kp-cube)
 481              (cons (logior (lsh 3 16)   8) 'backspace)
 482              (cons (logior (lsh 3 16)   9) 'tab)
 483              (cons (logior (lsh 3 16)  10) 'linefeed)
 484              (cons (logior (lsh 3 16)  11) 'clear)
 485              (cons (logior (lsh 3 16)  13) 'return)
 486              (cons (logior (lsh 3 16)  18) 'pause)
 487              (cons (logior (lsh 3 16)  25) 'S-tab)
 488              (cons (logior (lsh 3 16)  27) 'escape)
 489              (cons (logior (lsh 3 16) 127) 'delete)
 490              )))
 491     (set-terminal-parameter frame 'x-setup-function-keys t)))
 492
 493
 494
 495 ;; Must come after keybindings.
 496
 497 (fmakunbound 'clipboard-yank)
 498 (fmakunbound 'clipboard-kill-ring-save)
 499 (fmakunbound 'clipboard-kill-region)
 500 (fmakunbound 'menu-bar-enable-clipboard)
 501
 502 ;; Add a couple of menus and rearrange some others; easiest just to redo toplvl
 503 ;; Note keymap defns must be given last-to-first
 504 (define-key global-map [menu-bar] (make-sparse-keymap "menu-bar"))
 505
 506 (setq menu-bar-final-items
 507       (cond ((eq system-type 'darwin)
 508              '(buffer windows services help-menu))
 509             ;; Otherwise, GNUstep.
 510             (t
 511              '(buffer windows services hide-app quit))))
 512
 513 ;; Add standard top-level items to GNUstep menu.
 514 (unless (eq system-type 'darwin)
 515   (define-key global-map [menu-bar quit] '("Quit" . save-buffers-kill-emacs))
 516   (define-key global-map [menu-bar hide-app] '("Hide" . ns-do-hide-emacs)))
 517
 518 (define-key global-map [menu-bar services]
 519   (cons "Services" (make-sparse-keymap "Services")))
 520 (define-key global-map [menu-bar windows] (make-sparse-keymap "Windows"))
 521 (define-key global-map [menu-bar buffer]
 522   (cons "Buffers" global-buffers-menu-map))
 523 ;;  (cons "Buffers" (make-sparse-keymap "Buffers")))
 524 (define-key global-map [menu-bar tools] (cons "Tools" menu-bar-tools-menu))
 525 (define-key global-map [menu-bar options] (cons "Options" menu-bar-options-menu))
 526 (define-key global-map [menu-bar edit] (cons "Edit" menu-bar-edit-menu))
 527 (define-key global-map [menu-bar file] (cons "File" menu-bar-file-menu))
 528
 529 ;; If running under GNUstep, rename "Help" to "Info"
 530 (cond ((eq system-type 'darwin)
 531        (define-key global-map [menu-bar help-menu]
 532          (cons "Help" menu-bar-help-menu)))
 533       (t
 534        (let ((contents (reverse (cdr menu-bar-help-menu))))
 535          (setq menu-bar-help-menu
 536                (append (list 'keymap) (cdr contents) (list "Info"))))
 537        (define-key global-map [menu-bar help-menu]
 538          (cons "Info" menu-bar-help-menu))))
 539
 540 (if (not (eq system-type 'darwin))
 541     ;; in OS X it's in the app menu already
 542     (define-key menu-bar-help-menu [info-panel]
 543       '("About Emacs..." . ns-do-emacs-info-panel)))
 544
 545
 546 ;;;; File menu, replaces standard under ns-extended-platform-support
 547 (defvar menu-bar-ns-file-menu (make-sparse-keymap "File"))
 548 (define-key menu-bar-ns-file-menu [one-window]
 549   '("Remove Splits" . delete-other-windows))
 550 (define-key menu-bar-ns-file-menu [split-window]
 551   '("Split Window" . split-window-vertically))
 552
 553 (define-key menu-bar-ns-file-menu [separator-print] '("--"))
 554
 555 (defvar ns-ps-print-menu-map (make-sparse-keymap "Postscript Print"))
 556 (define-key ns-ps-print-menu-map [ps-print-region]
 557   '("Region (B+W)" . ps-print-region))
 558 (define-key ns-ps-print-menu-map [ps-print-buffer]
 559   '("Buffer (B+W)" . ps-print-buffer))
 560 (define-key ns-ps-print-menu-map [ps-print-region-faces]
 561   '("Region" . ps-print-region-with-faces))
 562 (define-key ns-ps-print-menu-map [ps-print-buffer-faces]
 563   '("Buffer" . ps-print-buffer-with-faces))
 564 (define-key menu-bar-ns-file-menu [postscript-print]
 565   (cons "Postscript Print" ns-ps-print-menu-map))
 566
 567 (define-key menu-bar-ns-file-menu [print-region]
 568   '("Print Region" . print-region))
 569 (define-key menu-bar-ns-file-menu [print-buffer]
 570   '("Print Buffer" . ns-print-buffer))
 571
 572 (define-key menu-bar-ns-file-menu [separator-save] '("--"))
 573
 574 (define-key menu-bar-ns-file-menu [recover-session]
 575   '("Recover Crashed Session" . recover-session))
 576 (define-key menu-bar-ns-file-menu [revert-buffer]
 577   '("Revert Buffer" . revert-buffer))
 578 (define-key menu-bar-ns-file-menu [write-file]
 579   '("Save Buffer As..." . ns-write-file-using-panel))
 580 (define-key menu-bar-ns-file-menu [save-buffer] '("Save Buffer" . save-buffer))
 581
 582 (define-key menu-bar-ns-file-menu [kill-buffer]
 583   '("Kill Current Buffer" . kill-this-buffer))
 584 (define-key menu-bar-ns-file-menu [delete-this-frame]
 585   '("Close Frame" . delete-frame))
 586
 587 (define-key menu-bar-ns-file-menu [separator-open] '("--"))
 588
 589 (define-key menu-bar-ns-file-menu [insert-file]
 590   '("Insert File..." . insert-file))
 591 (define-key menu-bar-ns-file-menu [dired]
 592   '("Open Directory..." . ns-open-file-using-panel))
 593 (define-key menu-bar-ns-file-menu [open-file]
 594   '("Open File..." . ns-open-file-using-panel))
 595 (define-key menu-bar-ns-file-menu [make-frame]
 596   '("New Frame" . make-frame))
 597
 598
 599 ;;;; Edit menu: Modify slightly
 600
 601 ;; Substitute a Copy function that works better under X (for GNUstep).
 602 (easy-menu-remove-item global-map '("menu-bar" "edit") 'copy)
 603 (define-key-after menu-bar-edit-menu [copy]
 604   '(menu-item "Copy" ns-copy-including-secondary
 605     :enable mark-active
 606     :help "Copy text in region between mark and current position")
 607   'cut)
 608
 609 ;; Change to same precondition as select-and-paste, as we don't have
 610 ;; `x-selection-exists-p'.
 611 (easy-menu-remove-item global-map '("menu-bar" "edit") 'paste)
 612 (define-key-after menu-bar-edit-menu [paste]
 613   '(menu-item "Paste" yank
 614     :enable (and (cdr yank-menu) (not buffer-read-only))
 615     :help "Paste (yank) text most recently cut/copied")
 616   'copy)
 617
 618 ;; Change text to be more consistent with surrounding menu items `paste', etc.
 619 (easy-menu-remove-item global-map '("menu-bar" "edit") 'paste-from-menu)
 620 (define-key-after menu-bar-edit-menu [select-paste]
 621   '(menu-item "Select and Paste" yank-menu
 622     :enable (and (cdr yank-menu) (not buffer-read-only))
 623     :help "Choose a string from the kill ring and paste it")
 624   'paste)
 625
 626 ;; Separate undo from cut/paste section, add spell for platform consistency.
 627 (define-key-after menu-bar-edit-menu [separator-undo] '("--") 'undo)
 628 (define-key-after menu-bar-edit-menu [spell] '("Spell" . ispell-menu-map) 'fill)
 629
 630 (defun menu-bar-update-frames ()
 631   ;; If user discards the Windows item, play along.
 632   (when (lookup-key (current-global-map) [menu-bar windows])
 633     (let ((frames (frame-list))
 634           (frames-menu (make-sparse-keymap "Select Frame")))
 635       (setcdr frames-menu
 636               (nconc
 637                (mapcar (lambda (frame)
 638                          (list*
 639                           (frame-parameter frame 'window-id)
 640                           (frame-parameter frame 'name)
 641                           `(lambda ()
 642                              (interactive) (menu-bar-select-frame ,frame))))
 643                        frames)
 644                (cdr frames-menu)))
 645       (define-key frames-menu [separator-frames] '("--"))
 646       (define-key frames-menu [popup-color-panel]
 647         '("Colors..." . ns-popup-color-panel))
 648       (define-key frames-menu [popup-font-panel]
 649         '("Font Panel..." . ns-popup-font-panel))
 650       (define-key frames-menu [separator-arrange] '("--"))
 651       (define-key frames-menu [arrange-all-frames]
 652         '("Arrange All Frames" . ns-arrange-all-frames))
 653       (define-key frames-menu [arrange-visible-frames]
 654         '("Arrange Visible Frames" . ns-arrange-visible-frames))
 655       ;; Don't use delete-frame as event name
 656       ;; because that is a special event.
 657       (define-key (current-global-map) [menu-bar windows]
 658         (cons "Windows" frames-menu)))))
 659
 660 (defun force-menu-bar-update-buffers ()
 661   ;; This is a hack to get around fact that we already checked
 662   ;; frame-or-buffer-changed-p and reset it, so menu-bar-update-buffers
 663   ;; does not pick up any change.
 664   (menu-bar-update-buffers t))
 665
 666 (add-hook 'menu-bar-update-fab-hook 'menu-bar-update-frames)
 667 (add-hook 'menu-bar-update-fab-hook 'force-menu-bar-update-buffers)
 668
 669 (defun menu-bar-update-frames-and-buffers ()
 670   (if (frame-or-buffer-changed-p)
 671       (run-hooks 'menu-bar-update-fab-hook)))
 672
 673 (setq menu-bar-update-hook
 674       (delq 'menu-bar-update-buffers menu-bar-update-hook))
 675 (add-hook 'menu-bar-update-hook 'menu-bar-update-frames-and-buffers)
 676
 677 (menu-bar-update-frames-and-buffers)
 678
 679
 680 ;; ns-arrange functions contributed
 681 ;; by Eberhard Mandler <mandler@dbag.ulm.DaimlerBenz.COM>
 682 (defun ns-arrange-all-frames ()
 683   "Arranges all frames according to topline"
 684   (interactive)
 685   (ns-arrange-frames t))
 686
 687 (defun ns-arrange-visible-frames ()
 688   "Arranges all visible frames according to topline"
 689   (interactive)
 690   (ns-arrange-frames nil))
 691
 692 (defun ns-arrange-frames (vis)
 693   (let ((frame (next-frame))
 694         (end-frame (selected-frame))
 695         (inc-x 20)                      ;relative position of frames
 696         (inc-y 22)
 697         (x-pos 100)                     ;start position
 698         (y-pos 40)
 699         (done nil))
 700     (while (not done)                   ;cycle through all frames
 701       (if (not (or vis (eq (frame-visible-p frame) t)))
 702           (setq x-pos x-pos); do nothing; true case
 703         (set-frame-position frame x-pos y-pos)
 704         (setq x-pos (+ x-pos inc-x))
 705         (setq y-pos (+ y-pos inc-y))
 706         (raise-frame frame))
 707       (select-frame frame)
 708       (setq frame (next-frame))
 709       (setq done (equal frame end-frame)))
 710     (set-frame-position end-frame x-pos y-pos)
 711     (raise-frame frame)
 712     (select-frame frame)))
 713
 714
 715 ;;;; Services
 716 (declare-function ns-perform-service "nsfns.m" (service send))
 717
 718 (defun ns-define-service (path)
 719   (let ((mapping [menu-bar services])
 720         (service (mapconcat 'identity path "/"))
 721         (name (intern
 722                (subst-char-in-string
 723                 ?\s ?-
 724                 (mapconcat 'identity (cons "ns-service" path) "-")))))
 725     ;; This defines the function.
 726     (defalias name
 727       (lexical-let ((service service))
 728         (lambda (arg)
 729           (interactive "p")
 730           (let* ((in-string
 731                   (cond ((stringp arg) arg)
 732                         (mark-active
 733                          (buffer-substring (region-beginning) (region-end)))))
 734                  (out-string (ns-perform-service service in-string)))
 735             (cond
 736              ((stringp arg) out-string)
 737              ((and out-string (or (not in-string)
 738                                   (not (string= in-string out-string))))
 739               (if mark-active (delete-region (region-beginning) (region-end)))
 740               (insert out-string)
 741               (setq deactivate-mark nil)))))))
 742     (cond
 743      ((lookup-key global-map mapping)
 744       (while (cdr path)
 745         (setq mapping (vconcat mapping (list (intern (car path)))))
 746         (if (not (keymapp (lookup-key global-map mapping)))
 747             (define-key global-map mapping
 748               (cons (car path) (make-sparse-keymap (car path)))))
 749         (setq path (cdr path)))
 750       (setq mapping (vconcat mapping (list (intern (car path)))))
 751       (define-key global-map mapping (cons (car path) name))))
 752     name))
 753
 754 ;; nsterm.m
 755 (defvar ns-input-spi-name)
 756 (defvar ns-input-spi-arg)
 757
 758 (declare-function dnd-open-file "dnd" (uri action))
 759
 760 (defun ns-spi-service-call ()
 761   "Respond to a service request."
 762   (interactive)
 763   (cond ((string-equal ns-input-spi-name "open-selection")
 764          (switch-to-buffer (generate-new-buffer "*untitled*"))
 765          (insert ns-input-spi-arg))
 766         ((string-equal ns-input-spi-name "open-file")
 767          (dnd-open-file ns-input-spi-arg nil))
 768         ((string-equal ns-input-spi-name "mail-selection")
 769          (compose-mail)
 770          (rfc822-goto-eoh)
 771          (forward-line 1)
 772          (insert ns-input-spi-arg))
 773         ((string-equal ns-input-spi-name "mail-to")
 774          (compose-mail ns-input-spi-arg))
 775         (t (error (concat "Service " ns-input-spi-name " not recognized")))))
 776
 777
 778 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 779
 780
 781
 782 ;;;; Composed key sequence handling for Nextstep system input methods.
 783 ;;;; (On Nextstep systems, input methods are provided for CJK
 784 ;;;; characters, etc. which require multiple keystrokes, and during
 785 ;;;; entry a partial ("working") result is typically shown in the
 786 ;;;; editing window.)
 787
 788 (defface ns-working-text-face
 789   '((t :underline t))
 790   "Face used to highlight working text during compose sequence insert."
 791   :group 'ns)
 792
 793 (defvar ns-working-overlay nil
 794   "Overlay used to highlight working text during compose sequence insert.")
 795 (make-variable-buffer-local 'ns-working-overlay)
 796 (defvar ns-working-overlay-len 0
 797   "Length of working text during compose sequence insert.")
 798 (make-variable-buffer-local 'ns-working-overlay-len)
 799
 800 (defvar ns-working-text)                ; nsterm.m
 801
 802 ;; Test if in echo area, based on mac-win.el 2007/08/26 unicode-2.
 803 ;; This will fail if called from a NONASCII_KEYSTROKE event on the global map.
 804 (defun ns-in-echo-area ()
 805   "Whether, for purposes of inserting working composition text, the minibuffer
 806 is currently being used."
 807   (or isearch-mode
 808       (and cursor-in-echo-area (current-message))
 809       ;; Overlay strings are not shown in some cases.
 810       (get-char-property (point) 'invisible)
 811       (and (not (bobp))
 812            (or (and (get-char-property (point) 'display)
 813                     (eq (get-char-property (1- (point)) 'display)
 814                         (get-char-property (point) 'display)))
 815                (and (get-char-property (point) 'composition)
 816                     (eq (get-char-property (1- (point)) 'composition)
 817                         (get-char-property (point) 'composition)))))))
 818
 819 ;; The 'interactive' here stays for subinvocations, so the ns-in-echo-area
 820 ;; always returns nil for some reason.  If this WASN'T the case, we could
 821 ;; map this to [ns-insert-working-text] and eliminate Fevals in nsterm.m.
 822 ;; These functions test whether in echo area and delegate accordingly.
 823 (defun ns-put-working-text ()
 824   (interactive)
 825   (if (ns-in-echo-area) (ns-echo-working-text) (ns-insert-working-text)))
 826 (defun ns-unput-working-text ()
 827   (interactive)
 828   (if (ns-in-echo-area) (ns-unecho-working-text) (ns-delete-working-text)))
 829
 830 (defun ns-insert-working-text ()
 831   "Insert contents of ns-working-text as UTF8 string and mark with
 832 ns-working-overlay.  Any previously existing working text is cleared first.
 833 The overlay is assigned the face ns-working-text-face."
 834 ;; FIXME: if buffer is read-only, don't try to insert anything
 835 ;;  and if text is bound to a command, execute that instead (Bug#1453)
 836   (interactive)
 837   (if ns-working-overlay (ns-delete-working-text))
 838   (let ((start (point)))
 839     (insert ns-working-text)
 840     (overlay-put (setq ns-working-overlay (make-overlay start (point)
 841                                                         (current-buffer) nil t))
 842                  'face 'ns-working-text-face)
 843     (setq ns-working-overlay-len (+ ns-working-overlay-len (- (point) start)))))
 844
 845 (defun ns-echo-working-text ()
 846   "Echo contents of ns-working-text in message display area.
 847 See ns-insert-working-text."
 848   (if ns-working-overlay (ns-unecho-working-text))
 849   (let* ((msg (current-message))
 850          (msglen (length msg))
 851          message-log-max)
 852     (setq ns-working-overlay-len (length ns-working-text))
 853     (setq msg (concat msg ns-working-text))
 854     (put-text-property msglen (+ msglen ns-working-overlay-len)
 855                        'face 'ns-working-text-face msg)
 856     (message "%s" msg)
 857     (setq ns-working-overlay t)))
 858
 859 (defun ns-delete-working-text()
 860   "Delete working text and clear ns-working-overlay."
 861   (interactive)
 862   (delete-backward-char ns-working-overlay-len)
 863   (setq ns-working-overlay-len 0)
 864   (delete-overlay ns-working-overlay))
 865
 866 (defun ns-unecho-working-text()
 867   "Delete working text from echo area and clear ns-working-overlay."
 868   (let ((msg (current-message))
 869         message-log-max)
 870     (setq msg (substring msg 0 (- (length msg) ns-working-overlay-len)))
 871     (message "%s" msg)
 872     (setq ns-working-overlay-len 0)
 873     (setq ns-working-overlay nil)))
 874
 875
 876 (declare-function ns-convert-utf8-nfd-to-nfc "nsfns.m" (str))
 877
 878 ;;;; OS X file system Unicode UTF-8 NFD (decomposed form) support
 879 ;; Lisp code based on utf-8m.el, by Seiji Zenitani, Eiji Honjoh, and
 880 ;; Carsten Bormann.
 881 (if (eq system-type 'darwin)
 882     (progn
 883
 884       (defun ns-utf8-nfd-post-read-conversion (length)
 885         "Calls ns-convert-utf8-nfd-to-nfc to compose char sequences."
 886         (save-excursion
 887           (save-restriction
 888             (narrow-to-region (point) (+ (point) length))
 889             (let ((str (buffer-string)))
 890               (delete-region (point-min) (point-max))
 891               (insert (ns-convert-utf8-nfd-to-nfc str))
 892               (- (point-max) (point-min))
 893               ))))
 894
 895       (define-coding-system 'utf-8-nfd
 896         "UTF-8 NFD (decomposed) encoding."
 897         :coding-type 'utf-8
 898         :mnemonic ?U
 899         :charset-list '(unicode)
 900         :post-read-conversion 'ns-utf8-nfd-post-read-conversion)
 901       (set-file-name-coding-system 'utf-8-nfd)))
 902
 903 ;; PENDING: disable composition-based display for Indic scripts as it
 904 ;;        is not working well under Nextstep for some reason
 905 (set-char-table-range composition-function-table
 906                       '(#x0900 . #x0DFF) nil)
 907
 908
 909 ;;;; Inter-app communications support.
 910
 911 (defvar ns-input-text)                  ; nsterm.m
 912
 913 (defun ns-insert-text ()
 914   "Insert contents of ns-input-text at point."
 915   (interactive)
 916   (insert ns-input-text)
 917   (setq ns-input-text nil))
 918
 919 (defun ns-insert-file ()
 920   "Insert contents of file ns-input-file like insert-file but with less
 921 prompting.  If file is a directory perform a find-file on it."
 922   (interactive)
 923   (let ((f))
 924     (setq f (car ns-input-file))
 925     (setq ns-input-file (cdr ns-input-file))
 926     (if (file-directory-p f)
 927         (find-file f)
 928       (push-mark (+ (point) (car (cdr (insert-file-contents f))))))))
 929
 930 (defvar ns-select-overlay nil
 931   "Overlay used to highlight areas in files requested by Nextstep apps.")
 932 (make-variable-buffer-local 'ns-select-overlay)
 933
 934 (defvar ns-input-line)                  ; nsterm.m
 935
 936 (defun ns-open-file-select-line ()
 937   "Open a buffer containing the file `ns-input-file'.
 938 Lines are highlighted according to `ns-input-line'."
 939   (interactive)
 940   (ns-find-file)
 941   (cond
 942    ((and ns-input-line (buffer-modified-p))
 943     (if ns-select-overlay
 944         (setq ns-select-overlay (delete-overlay ns-select-overlay)))
 945     (deactivate-mark)
 946     (goto-line (if (consp ns-input-line)
 947                    (min (car ns-input-line) (cdr ns-input-line))
 948                  ns-input-line)))
 949    (ns-input-line
 950     (if (not ns-select-overlay)
 951         (overlay-put (setq ns-select-overlay (make-overlay (point-min) (point-min)))
 952                      'face 'highlight))
 953     (let ((beg (save-excursion
 954                  (goto-line (if (consp ns-input-line)
 955                                 (min (car ns-input-line) (cdr ns-input-line))
 956                               ns-input-line))
 957                  (point)))
 958           (end (save-excursion
 959                  (goto-line (+ 1 (if (consp ns-input-line)
 960                                      (max (car ns-input-line) (cdr ns-input-line))
 961                                    ns-input-line)))
 962                  (point))))
 963       (move-overlay ns-select-overlay beg end)
 964       (deactivate-mark)
 965       (goto-char beg)))
 966    (t
 967     (if ns-select-overlay
 968         (setq ns-select-overlay (delete-overlay ns-select-overlay))))))
 969
 970 (defun ns-unselect-line ()
 971   "Removes any Nextstep highlight a buffer may contain."
 972   (if ns-select-overlay
 973       (setq ns-select-overlay (delete-overlay ns-select-overlay))))
 974
 975 (add-hook 'first-change-hook 'ns-unselect-line)
 976
 977
 978
 979 ;;;; Preferences handling.
 980 (declare-function ns-get-resource "nsfns.m" (owner name))
 981
 982 (defun get-lisp-resource (arg1 arg2)
 983   (let ((res (ns-get-resource arg1 arg2)))
 984     (cond
 985      ((not res) 'unbound)
 986      ((string-equal (upcase res) "YES") t)
 987      ((string-equal (upcase res) "NO")  nil)
 988      (t (read res)))))
 989
 990 ;; nsterm.m
 991 (defvar ns-command-modifier)
 992 (defvar ns-control-modifier)
 993 (defvar ns-function-modifier)
 994 (defvar ns-antialias-text)
 995 (defvar ns-use-qd-smoothing)
 996 (defvar ns-use-system-highlight-color)
 997 (defvar ns-confirm-quit)
 998
 999 (declare-function ns-set-resource "nsfns.m" (owner name value))
1000 (declare-function ns-font-name "nsfns.m" (name))
1001 (declare-function ns-read-file-name "nsfns.m"
1002                   (prompt &optional dir isLoad init))
1003
1004 (defun ns-save-preferences ()
1005   "Set all the defaults."
1006   (interactive)
1007   ;; Global preferences
1008   (ns-set-resource nil "AlternateModifier" (symbol-name ns-alternate-modifier))
1009   (ns-set-resource nil "CommandModifier" (symbol-name ns-command-modifier))
1010   (ns-set-resource nil "ControlModifier" (symbol-name ns-control-modifier))
1011   (ns-set-resource nil "FunctionModifier" (symbol-name ns-function-modifier))
1012   (ns-set-resource nil "ExpandSpace"
1013                    (if ns-expand-space
1014                        (number-to-string ns-expand-space)
1015                      "NO"))
1016   (ns-set-resource nil "GSFontAntiAlias" (if ns-antialias-text "YES" "NO"))
1017   (ns-set-resource nil "UseQuickdrawSmoothing"
1018                    (if ns-use-qd-smoothing "YES" "NO"))
1019   (ns-set-resource nil "UseSystemHighlightColor"
1020                    (if ns-use-system-highlight-color "YES" "NO"))
1021   (ns-set-resource nil "ConfirmQuit"
1022                    (if ns-confirm-quit "YES" "NO"))
1023   ;; Default frame parameters
1024   (let ((p (frame-parameters))
1025         v)
1026     (if (setq v (assq 'font p))
1027         (ns-set-resource nil "Font" (ns-font-name (cdr v))))
1028     (if (setq v (assq 'fontsize p))
1029         (ns-set-resource nil "FontSize" (number-to-string (cdr v))))
1030     (if (setq v (assq 'foreground-color p))
1031         (ns-set-resource nil "Foreground" (cdr v)))
1032     (if (setq v (assq 'background-color p))
1033         (ns-set-resource nil "Background" (cdr v)))
1034     (if (setq v (assq 'cursor-color p))
1035         (ns-set-resource nil "CursorColor" (cdr v)))
1036     (if (setq v (assq 'cursor-type p))
1037         (ns-set-resource nil "CursorType" (if (symbolp (cdr v))
1038                                               (symbol-name (cdr v))
1039                                             (cdr v))))
1040     (if (setq v (assq 'underline p))
1041         (ns-set-resource nil "Underline"
1042                          (case (cdr v)
1043                                ((t) "YES")
1044                                ((nil) "NO")
1045                                (t (cdr v)))))
1046     (if (setq v (assq 'internal-border-width p))
1047         (ns-set-resource nil "InternalBorderWidth"
1048                          (number-to-string (cdr v))))
1049     (if (setq v (assq 'vertical-scroll-bars p))
1050         (ns-set-resource nil "VerticalScrollBars"
1051                          (case (cdr v)
1052                                ((t) "YES")
1053                                ((nil) "NO")
1054                                ((left) "left")
1055                                ((right) "right")
1056                                (t nil))))
1057     (if (setq v (assq 'height p))
1058         (ns-set-resource nil "Height" (number-to-string (cdr v))))
1059     (if (setq v (assq 'width p))
1060         (ns-set-resource nil "Width" (number-to-string (cdr v))))
1061     (if (setq v (assq 'top p))
1062         (ns-set-resource nil "Top" (number-to-string (cdr v))))
1063     (if (setq v (assq 'left p))
1064         (ns-set-resource nil "Left" (number-to-string (cdr v))))
1065     ;; These not fully supported
1066     (if (setq v (assq 'auto-raise p))
1067         (ns-set-resource nil "AutoRaise" (if (cdr v) "YES" "NO")))
1068     (if (setq v (assq 'auto-lower p))
1069         (ns-set-resource nil "AutoLower" (if (cdr v) "YES" "NO")))
1070     (if (setq v (assq 'menu-bar-lines p))
1071         (ns-set-resource nil "Menus" (if (cdr v) "YES" "NO")))
1072     )
1073   (let ((fl (face-list)))
1074     (while (consp fl)
1075       (or (eq 'default (car fl))
1076           ;; dont save Default* since it causes all created faces to
1077           ;; inherit its values.  The properties of the default face
1078           ;; have already been saved from the frame-parameters anyway.
1079           (let* ((name (symbol-name (car fl)))
1080                  (font (face-font (car fl)))
1081                  ;; (fontsize (face-fontsize (car fl)))
1082                  (foreground (face-foreground (car fl)))
1083                  (background (face-background (car fl)))
1084                  (underline (face-underline-p (car fl)))
1085                  (italic (face-italic-p (car fl)))
1086                  (bold (face-bold-p (car fl)))
1087                  (stipple (face-stipple (car fl))))
1088             ;; (ns-set-resource nil (concat name ".attributeFont")
1089             ;;                  (if font font nil))
1090             ;; (ns-set-resource nil (concat name ".attributeFontSize")
1091             ;;                  (if fontsize (number-to-string fontsize) nil))
1092             (ns-set-resource nil (concat name ".attributeForeground")
1093                              (if foreground foreground nil))
1094             (ns-set-resource nil (concat name ".attributeBackground")
1095                              (if background background nil))
1096             (ns-set-resource nil (concat name ".attributeUnderline")
1097                              (if underline "YES" nil))
1098             (ns-set-resource nil (concat name ".attributeItalic")
1099                              (if italic "YES" nil))
1100             (ns-set-resource nil (concat name ".attributeBold")
1101                              (if bold "YES" nil))
1102             (and stipple
1103                  (or (stringp stipple)
1104                      (setq stipple (prin1-to-string stipple))))
1105             (ns-set-resource nil (concat name ".attributeStipple")
1106                              (if stipple stipple nil))))
1107       (setq fl (cdr fl)))))
1108
1109 (declare-function menu-bar-options-save-orig "ns-win" () t)
1110
1111 ;; call ns-save-preferences when menu-bar-options-save is called
1112 (fset 'menu-bar-options-save-orig (symbol-function 'menu-bar-options-save))
1113 (defun ns-save-options ()
1114   (interactive)
1115   (menu-bar-options-save-orig)
1116   (ns-save-preferences))
1117 (fset 'menu-bar-options-save (symbol-function 'ns-save-options))
1118
1119
1120 ;;;; File handling.
1121
1122 (defun ns-open-file-using-panel ()
1123   "Pop up open-file panel, and load the result in a buffer."
1124   (interactive)
1125   ;; Prompt dir defaultName isLoad initial.
1126   (setq ns-input-file (ns-read-file-name "Select File to Load" nil t nil))
1127   (if ns-input-file
1128       (and (setq ns-input-file (list ns-input-file)) (ns-find-file))))
1129
1130 (defun ns-write-file-using-panel ()
1131   "Pop up save-file panel, and save buffer in resulting name."
1132   (interactive)
1133   (let (ns-output-file)
1134     ;; Prompt dir defaultName isLoad initial.
1135     (setq ns-output-file (ns-read-file-name "Save As" nil nil nil))
1136     (message ns-output-file)
1137     (if ns-output-file (write-file ns-output-file))))
1138
1139 (defvar ns-pop-up-frames 'fresh
1140   "*Non-nil means open files upon request from the Workspace in a new frame.
1141 If t, always do so.  Any other non-nil value means open a new frame
1142 unless the current buffer is a scratch buffer.")
1143
1144 (declare-function ns-hide-emacs "nsfns.m" (on))
1145
1146 (defun ns-find-file ()
1147   "Do a find-file with the ns-input-file as argument."
1148   (interactive)
1149   (let ((f) (file) (bufwin1) (bufwin2))
1150     (setq f (file-truename (car ns-input-file)))
1151     (setq ns-input-file (cdr ns-input-file))
1152     (setq file (find-file-noselect f))
1153     (setq bufwin1 (get-buffer-window file 'visible))
1154     (setq bufwin2 (get-buffer-window "*scratch*" 'visibile))
1155     (cond
1156      (bufwin1
1157       (select-frame (window-frame bufwin1))
1158       (raise-frame (window-frame bufwin1))
1159       (select-window bufwin1))
1160      ((and (eq ns-pop-up-frames 'fresh) bufwin2)
1161       (ns-hide-emacs 'activate)
1162       (select-frame (window-frame bufwin2))
1163       (raise-frame (window-frame bufwin2))
1164       (select-window bufwin2)
1165       (find-file f))
1166      (ns-pop-up-frames
1167       (ns-hide-emacs 'activate)
1168       (let ((pop-up-frames t)) (pop-to-buffer file nil)))
1169      (t
1170       (ns-hide-emacs 'activate)
1171       (find-file f)))))
1172
1173
1174
1175 ;;;; Frame-related functions.
1176
1177 ;; Don't show the frame name; that's redundant with Nextstep.
1178 (setq-default mode-line-frame-identification '("  "))
1179
1180 ;; You say tomAYto, I say tomAHto..
1181 (defvaralias 'ns-option-modifier 'ns-alternate-modifier)
1182
1183 (defun ns-do-hide-emacs ()
1184   (interactive)
1185   (ns-hide-emacs t))
1186
1187 (declare-function ns-hide-others "nsfns.m" ())
1188
1189 (defun ns-do-hide-others ()
1190   (interactive)
1191   (ns-hide-others))
1192
1193 (declare-function ns-emacs-info-panel "nsfns.m" ())
1194
1195 (defun ns-do-emacs-info-panel ()
1196   (interactive)
1197   (ns-emacs-info-panel))
1198
1199 (defun ns-next-frame ()
1200   "Switch to next visible frame."
1201   (interactive)
1202   (other-frame 1))
1203 (defun ns-prev-frame ()
1204   "Switch to previous visible frame."
1205   (interactive)
1206   (other-frame -1))
1207
1208 ;; If no position specified, make new frame offset by 25 from current.
1209 (defvar parameters)                  ; dynamically bound in make-frame
1210 (add-hook 'before-make-frame-hook
1211           (lambda ()
1212             (let ((left (cdr (assq 'left (frame-parameters))))
1213                   (top (cdr (assq 'top (frame-parameters)))))
1214               (if (consp left) (setq left (cadr left)))
1215               (if (consp top) (setq top (cadr top)))
1216               (cond
1217                ((or (assq 'top parameters) (assq 'left parameters)))
1218                ((or (not left) (not top)))
1219                (t
1220                 (setq parameters (cons (cons 'left (+ left 25))
1221                                        (cons (cons 'top (+ top 25))
1222                                              parameters))))))))
1223
1224 ;; frame will be focused anyway, so select it
1225 ;; (if this is not done, modeline is dimmed until first interaction)
1226 (add-hook 'after-make-frame-functions 'select-frame)
1227
1228 (defvar tool-bar-mode)
1229 (declare-function tool-bar-mode "tool-bar" (&optional arg))
1230
1231 ;; Based on a function by David Reitter <dreitter@inf.ed.ac.uk> ;
1232 ;; see http://lists.gnu.org/archive/html/emacs-devel/2005-09/msg00681.html .
1233 (defun ns-toggle-toolbar (&optional frame)
1234   "Switches the tool bar on and off in frame FRAME.
1235  If FRAME is nil, the change applies to the selected frame."
1236   (interactive)
1237   (modify-frame-parameters
1238    frame (list (cons 'tool-bar-lines
1239                        (if (> (or (frame-parameter frame 'tool-bar-lines) 0) 0)
1240                                    0 1)) ))
1241   (if (not tool-bar-mode) (tool-bar-mode t)))
1242
1243
1244
1245 ;;;; Dialog-related functions.
1246
1247
1248 (defun ns-show-preferences-help ()
1249  "Show NS Preferences panel section in the Emacs manual"
1250   (interactive)
1251   (info "(emacs)Mac / GNUstep Customization"))
1252
1253 ;; Ask user for confirm before printing.  Due to Kevin Rodgers.
1254 (defun ns-print-buffer ()
1255   "Interactive front-end to `print-buffer': asks for user confirmation first."
1256   (interactive)
1257   (if (and (interactive-p)
1258            (or (listp last-nonmenu-event)
1259                (and (char-or-string-p (event-basic-type last-command-event))
1260                     (memq 'super (event-modifiers last-command-event)))))
1261       (let ((last-nonmenu-event (if (listp last-nonmenu-event)
1262                                     last-nonmenu-event
1263                                   ;; Fake it:
1264                                   `(mouse-1 POSITION 1))))
1265         (if (y-or-n-p (format "Print buffer %s? " (buffer-name)))
1266             (print-buffer)
1267           (error "Cancelled")))
1268     (print-buffer)))
1269
1270
1271 ;;;; Font support.
1272
1273 ;; Needed for font listing functions under both backend and normal
1274 (setq scalable-fonts-allowed t)
1275
1276 ;; Set to use font panel instead
1277 (declare-function ns-popup-font-panel "nsfns.m" (&optional frame))
1278 (defalias 'generate-fontset-menu 'ns-popup-font-panel)
1279 (defalias 'mouse-set-font 'ns-popup-font-panel)
1280
1281 ;; nsterm.m
1282 (defvar ns-input-font)
1283 (defvar ns-input-fontsize)
1284
1285 (defun ns-respond-to-change-font ()
1286   "Respond to changeFont: event, expecting ns-input-font and\n\
1287 ns-input-fontsize of new font."
1288   (interactive)
1289   (modify-frame-parameters (selected-frame)
1290                            (list (cons 'font ns-input-font)
1291                                  (cons 'fontsize ns-input-fontsize)))
1292   (set-frame-font ns-input-font))
1293
1294
1295 ;; Default fontset for Mac OS X.  This is mainly here to show how a fontset
1296 ;; can be set up manually.  Ordinarily, fontsets are auto-created whenever
1297 ;; a font is chosen by
1298 (defvar ns-standard-fontset-spec
1299   ;; Only some code supports this so far, so use uglier XLFD version
1300   ;; "-ns-*-*-*-*-*-10-*-*-*-*-*-fontset-standard,latin:Courier,han:Kai"
1301   (mapconcat 'identity
1302              '("-ns-*-*-*-*-*-10-*-*-*-*-*-fontset-standard"
1303                "latin:-*-Courier-*-*-*-*-10-*-*-*-*-*-iso10646-1"
1304                "han:-*-Kai-*-*-*-*-10-*-*-*-*-*-iso10646-1"
1305                "cyrillic:-*-Trebuchet$MS-*-*-*-*-10-*-*-*-*-*-iso10646-1")
1306              ",")
1307   "String of fontset spec of the standard fontset.
1308 This defines a fontset consisting of the Courier and other fonts that
1309 come with OS X\".
1310 See the documentation of `create-fontset-from-fontset-spec for the format.")
1311
1312 ;; Conditional on new-fontset so bootstrapping works on non-GUI compiles.
1313 (if (fboundp 'new-fontset)
1314     (progn
1315       ;; Setup the default fontset.
1316       (setup-default-fontset)
1317       ;; Create the standard fontset.
1318       (create-fontset-from-fontset-spec ns-standard-fontset-spec t)))
1319
1320 ;;(push (cons 'font "-ns-*-*-*-*-*-10-*-*-*-*-*-fontset-standard")
1321 ;;      default-frame-alist)
1322
1323 ;; Add some additional scripts to var we use for fontset generation.
1324 (setq script-representative-chars
1325       (cons '(kana #xff8a)
1326             (cons '(symbol #x2295 #x2287 #x25a1)
1327                   script-representative-chars)))
1328
1329
1330 ;;;; Pasteboard support.
1331
1332 (declare-function ns-get-cut-buffer-internal "nsselect.m" (buffer))
1333
1334 (defun ns-get-pasteboard ()
1335   "Returns the value of the pasteboard."
1336   (ns-get-cut-buffer-internal 'PRIMARY))
1337
1338 (declare-function ns-store-cut-buffer-internal "nsselect.m" (buffer string))
1339
1340 (defun ns-set-pasteboard (string)
1341   "Store STRING into the pasteboard of the Nextstep display server."
1342   ;; Check the data type of STRING.
1343   (if (not (stringp string)) (error "Nonstring given to pasteboard"))
1344   (ns-store-cut-buffer-internal 'PRIMARY string))
1345
1346 ;; We keep track of the last text selected here, so we can check the
1347 ;; current selection against it, and avoid passing back our own text
1348 ;; from x-cut-buffer-or-selection-value.
1349 (defvar ns-last-selected-text nil)
1350
1351 (defun x-select-text (text &optional push)
1352   "Put TEXT, a string, on the pasteboard."
1353   ;; Don't send the pasteboard too much text.
1354   ;; It becomes slow, and if really big it causes errors.
1355   (ns-set-pasteboard text)
1356   (setq ns-last-selected-text text))
1357
1358 ;; Return the value of the current Nextstep selection.  For
1359 ;; compatibility with older Nextstep applications, this checks cut
1360 ;; buffer 0 before retrieving the value of the primary selection.
1361 (defun x-cut-buffer-or-selection-value ()
1362   (let (text)
1363
1364     ;; Consult the selection, then the cut buffer.  Treat empty strings
1365     ;; as if they were unset.
1366     (or text (setq text (ns-get-pasteboard)))
1367     (if (string= text "") (setq text nil))
1368
1369     (cond
1370      ((not text) nil)
1371      ((eq text ns-last-selected-text) nil)
1372      ((string= text ns-last-selected-text)
1373       ;; Record the newer string, so subsequent calls can use the `eq' test.
1374       (setq ns-last-selected-text text)
1375       nil)
1376      (t
1377       (setq ns-last-selected-text text)))))
1378
1379 (defun ns-copy-including-secondary ()
1380   (interactive)
1381   (call-interactively 'kill-ring-save)
1382   (ns-store-cut-buffer-internal 'SECONDARY
1383                                 (buffer-substring (point) (mark t))))
1384 (defun ns-paste-secondary ()
1385   (interactive)
1386   (insert (ns-get-cut-buffer-internal 'SECONDARY)))
1387
1388 ;; PENDING: not sure what to do here.. for now interprog- are set in
1389 ;; init-fn-keys, and unsure whether these x- settings have an effect.
1390 ;;(setq interprogram-cut-function 'x-select-text
1391 ;;      interprogram-paste-function 'x-cut-buffer-or-selection-value)
1392 ;; These only needed if above not working.
1393
1394 (set-face-background 'region "ns_selection_color")
1395
1396
1397
1398 ;;;; Scrollbar handling.
1399
1400 (global-set-key [vertical-scroll-bar down-mouse-1] 'ns-handle-scroll-bar-event)
1401 (global-unset-key [vertical-scroll-bar mouse-1])
1402 (global-unset-key [vertical-scroll-bar drag-mouse-1])
1403
1404 (declare-function scroll-bar-scale "scroll-bar" (num-denom whole))
1405
1406 (defun ns-scroll-bar-move (event)
1407   "Scroll the frame according to a Nextstep scroller event."
1408   (interactive "e")
1409   (let* ((pos (event-end event))
1410          (window (nth 0 pos))
1411          (scale (nth 2 pos)))
1412     (save-excursion
1413       (set-buffer (window-buffer window))
1414       (cond
1415        ((eq (car scale) (cdr scale))
1416         (goto-char (point-max)))
1417        ((= (car scale) 0)
1418         (goto-char (point-min)))
1419        (t
1420         (goto-char (+ (point-min) 1
1421                       (scroll-bar-scale scale (- (point-max) (point-min)))))))
1422       (beginning-of-line)
1423       (set-window-start window (point))
1424       (vertical-motion (/ (window-height window) 2) window))))
1425
1426 (defun ns-handle-scroll-bar-event (event)
1427   "Handle scroll bar EVENT to emulate Nextstep style scrolling."
1428   (interactive "e")
1429   (let* ((position (event-start event))
1430          (bar-part (nth 4 position))
1431          (window (nth 0 position))
1432          (old-window (selected-window)))
1433     (cond
1434      ((eq bar-part 'ratio)
1435       (ns-scroll-bar-move event))
1436      ((eq bar-part 'handle)
1437       (if (eq window (selected-window))
1438           (track-mouse (ns-scroll-bar-move event))
1439         ;; track-mouse faster for selected window, slower for unselected.
1440         (ns-scroll-bar-move event)))
1441      (t
1442       (select-window window)
1443       (cond
1444        ((eq bar-part 'up)
1445         (goto-char (window-start window))
1446         (scroll-down 1))
1447        ((eq bar-part 'above-handle)
1448         (scroll-down))
1449        ((eq bar-part 'below-handle)
1450         (scroll-up))
1451        ((eq bar-part 'down)
1452         (goto-char (window-start window))
1453         (scroll-up 1)))
1454       (select-window old-window)))))
1455
1456
1457 ;;;; Color support.
1458
1459 (declare-function ns-list-colors "nsfns.m" (&optional frame))
1460
1461 (defvar x-colors (ns-list-colors)
1462   "The list of colors defined in non-PANTONE color files.")
1463
1464 (defun xw-defined-colors (&optional frame)
1465   "Return a list of colors supported for a particular frame.
1466 The argument FRAME specifies which frame to try.
1467 The value may be different for frames on different Nextstep displays."
1468   (or frame (setq frame (selected-frame)))
1469   (let ((all-colors x-colors)
1470         (this-color nil)
1471         (defined-colors nil))
1472     (while all-colors
1473       (setq this-color (car all-colors)
1474             all-colors (cdr all-colors))
1475       ;; (and (face-color-supported-p frame this-color t)
1476       (setq defined-colors (cons this-color defined-colors))) ;;)
1477     defined-colors))
1478
1479 (declare-function ns-set-alpha "nsfns.m" (color alpha))
1480
1481 ;; Convenience and work-around for fact that set color fns now require named.
1482 (defun ns-set-background-alpha (alpha)
1483   "Sets alpha (opacity) of background.
1484 Set from 0.0 (fully transparent) to 1.0 (fully opaque; default).
1485 Note, tranparency works better on Tiger (10.4) and higher."
1486   (interactive "nSet background alpha to: ")
1487   (let ((bgcolor (cdr (assq 'background-color (frame-parameters)))))
1488     (set-frame-parameter (selected-frame)
1489                          'background-color (ns-set-alpha bgcolor alpha))))
1490
1491 ;; Functions for color panel + drag
1492 (defun ns-face-at-pos (pos)
1493   (let* ((frame (car pos))
1494          (frame-pos (cons (cadr pos) (cddr pos)))
1495          (window (window-at (car frame-pos) (cdr frame-pos) frame))
1496          (window-pos (coordinates-in-window-p frame-pos window))
1497          (buffer (window-buffer window))
1498          (edges (window-edges window)))
1499     (cond
1500      ((not window-pos)
1501       nil)
1502      ((eq window-pos 'mode-line)
1503       'modeline)
1504      ((eq window-pos 'vertical-line)
1505       'default)
1506      ((consp window-pos)
1507       (save-excursion
1508         (set-buffer buffer)
1509         (let ((p (car (compute-motion (window-start window)
1510                                       (cons (nth 0 edges) (nth 1 edges))
1511                                       (window-end window)
1512                                       frame-pos
1513                                       (- (window-width window) 1)
1514                                       nil
1515                                       window))))
1516           (cond
1517            ((eq p (window-point window))
1518             'cursor)
1519            ((and mark-active (< (region-beginning) p) (< p (region-end)))
1520             'region)
1521            (t
1522             (let ((faces (get-char-property p 'face window)))
1523               (if (consp faces) (car faces) faces)))))))
1524      (t
1525       nil))))
1526
1527 (defvar ns-input-color)                 ; nsterm.m
1528
1529 (defun ns-set-foreground-at-mouse ()
1530   "Set the foreground color at the mouse location to ns-input-color."
1531   (interactive)
1532   (let* ((pos (mouse-position))
1533          (frame (car pos))
1534          (face (ns-face-at-pos pos)))
1535     (cond
1536      ((eq face 'cursor)
1537       (modify-frame-parameters frame (list (cons 'cursor-color
1538                                                  ns-input-color))))
1539      ((not face)
1540       (modify-frame-parameters frame (list (cons 'foreground-color
1541                                                  ns-input-color))))
1542      (t
1543       (set-face-foreground face ns-input-color frame)))))
1544
1545 (defun ns-set-background-at-mouse ()
1546   "Set the background color at the mouse location to ns-input-color."
1547   (interactive)
1548   (let* ((pos (mouse-position))
1549          (frame (car pos))
1550          (face (ns-face-at-pos pos)))
1551     (cond
1552      ((eq face 'cursor)
1553       (modify-frame-parameters frame (list (cons 'cursor-color
1554                                                  ns-input-color))))
1555      ((not face)
1556       (modify-frame-parameters frame (list (cons 'background-color
1557                                                  ns-input-color))))
1558      (t
1559       (set-face-background face ns-input-color frame)))))
1560
1561 ;; Set some options to be as Nextstep-like as possible.
1562 (setq frame-title-format t
1563       icon-title-format t)
1564
1565
1566 (defvar ns-initialized nil
1567   "Non-nil if Nextstep windowing has been initialized.")
1568
1569 (declare-function ns-list-services "nsfns.m" ())
1570 (declare-function x-open-connection "nsfns.m"
1571                   (display &optional xrm-string must-succeed))
1572
1573 ;; Do the actual Nextstep Windows setup here; the above code just
1574 ;; defines functions and variables that we use now.
1575 (defun ns-initialize-window-system ()
1576   "Initialize Emacs for Nextstep (Cocoa / GNUstep) windowing."
1577
1578   ;; PENDING: not needed?
1579   (setq command-line-args (ns-handle-args command-line-args))
1580
1581   (x-open-connection (system-name) nil t)
1582
1583   (dolist (service (ns-list-services))
1584       (if (eq (car service) 'undefined)
1585           (ns-define-service (cdr service))
1586         (define-key global-map (vector (car service))
1587           (ns-define-service (cdr service)))))
1588
1589   (if (and (eq (get-lisp-resource nil "NXAutoLaunch") t)
1590            (eq (get-lisp-resource nil "HideOnAutoLaunch") t))
1591       (add-hook 'after-init-hook 'ns-do-hide-emacs))
1592
1593   ;; FIXME: This will surely lead to "MODIFIED OUTSIDE CUSTOM" warnings.
1594   (menu-bar-mode (if (get-lisp-resource nil "Menus") 1 -1))
1595   (mouse-wheel-mode 1)
1596
1597   (setq ns-initialized t))
1598
1599 (add-to-list 'handle-args-function-alist '(ns . ns-handle-args))
1600 (add-to-list 'frame-creation-function-alist '(ns . x-create-frame-with-faces))
1601 (add-to-list 'window-system-initialization-alist '(ns . ns-initialize-window-system))
1602
1603
1604 (provide 'ns-win)
1605
1606 ;; arch-tag: eb138a45-4e2e-4d68-b1c9-a39665731644
1607 ;;; ns-win.el ends here