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