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