HCoop / bpt / emacs.git / blame
| Commit | Line | Data |
|---|---|---|
| c0642f6d GM |
1 | ;;; ns-win.el --- lisp side of interface with NeXT/Open/GNUstep/MacOS X window system |
| 2 | ||
| 5df4f04c | 3 | ;; Copyright (C) 1993, 1994, 2005, 2006, 2007, 2008, 2009, 2010, 2011 |
| a5e1066d | 4 | ;; Free Software Foundation, Inc. |
| c0642f6d | 5 | |
| c5220417 GM |
6 | ;; Authors: Carl Edman |
| 7 | ;; Christian Limpach | |
| 8 | ;; Scott Bender | |
| 9 | ;; Christophe de Dinechin | |
| 10 | ;; Adrian Robert | |
| c0642f6d GM |
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/>. | |
| edfda783 AR |
27 | |
| 28 | ;;; Commentary: | |
| 29 | ||
| a5a1b464 CY |
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. | |
| edfda783 AR |
35 | |
| 36 | ;; startup.el will then examine startup files, and eventually call the hooks | |
| 37 | ;; which create the first window (s). | |
| 38 | ||
| a5a1b464 CY |
39 | ;; A number of other Nextstep convenience functions are defined in |
| 40 | ;; this file, which works in close coordination with src/nsfns.m. | |
| edfda783 AR |
41 | |
| 42 | ;;; Code: | |
| 43 | ||
| 44 | ||
| 601fb9b8 | 45 | (if (not (featurep 'ns)) |
| 3dcdb6ea | 46 | (error "%s: Loading ns-win.el but not compiled for GNUstep/MacOS" |
| edfda783 AR |
47 | (invocation-name))) |
| 48 | ||
| ebe68042 SM |
49 | (eval-when-compile (require 'cl)) |
| 50 | ||
| edfda783 AR |
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 | ||
| ebe68042 SM |
59 | ;; Not needed? |
| 60 | ;;(require 'ispell) | |
| edfda783 | 61 | |
| 20bc68dd GM |
62 | (defgroup ns nil |
| 63 | "GNUstep/Mac OS X specific features." | |
| 64 | :group 'environment) | |
| 65 | ||
| c0642f6d GM |
66 | ;; nsterm.m |
| 67 | (defvar ns-version-string) | |
| c0642f6d | 68 | (defvar ns-alternate-modifier) |
| a2e35ef5 | 69 | (defvar ns-right-alternate-modifier) |
| c0642f6d | 70 | |
| edfda783 AR |
71 | ;;;; Command line argument handling. |
| 72 | ||
| 73 | (defvar ns-invocation-args nil) | |
| 74 | (defvar ns-command-line-resources nil) | |
| 75 | ||
| 76 | ;; Handler for switches of the form "-switch value" or "-switch". | |
| d377ef4a | 77 | (defun ns-handle-switch (switch &optional numeric) |
| edfda783 AR |
78 | (let ((aelt (assoc switch command-line-ns-option-alist))) |
| 79 | (if aelt | |
| d377ef4a GM |
80 | (setq default-frame-alist |
| 81 | (cons (cons (nth 3 aelt) | |
| 82 | (if numeric | |
| 83 | (string-to-number (pop ns-invocation-args)) | |
| 84 | (or (nth 4 aelt) (pop ns-invocation-args)))) | |
| 85 | default-frame-alist))))) | |
| edfda783 AR |
86 | |
| 87 | ;; Handler for switches of the form "-switch n" | |
| 88 | (defun ns-handle-numeric-switch (switch) | |
| d377ef4a | 89 | (ns-handle-switch switch t)) |
| edfda783 AR |
90 | |
| 91 | ;; Make -iconic apply only to the initial frame! | |
| 92 | (defun ns-handle-iconic (switch) | |
| 93 | (setq initial-frame-alist | |
| 94 | (cons '(visibility . icon) initial-frame-alist))) | |
| 95 | ||
| 82a330df | 96 | ;; Handle the -name option, set the name of the initial frame. |
| edfda783 AR |
97 | (defun ns-handle-name-switch (switch) |
| 98 | (or (consp ns-invocation-args) | |
| 99 | (error "%s: missing argument to `%s' option" (invocation-name) switch)) | |
| d377ef4a GM |
100 | (setq initial-frame-alist (cons (cons 'name (pop ns-invocation-args)) |
| 101 | initial-frame-alist))) | |
| 102 | ||
| 103 | ;; Set (but not used?) in frame.el. | |
| 9e50ff0c | 104 | (defvar x-display-name nil |
| 5cc443fe GM |
105 | "The name of the window display on which Emacs was started. |
| 106 | On X, the display name of individual X frames is recorded in the | |
| 107 | `display' frame parameter.") | |
| edfda783 | 108 | |
| c0642f6d GM |
109 | ;; nsterm.m. |
| 110 | (defvar ns-input-file) | |
| 111 | ||
| edfda783 AR |
112 | (defun ns-handle-nxopen (switch) |
| 113 | (setq unread-command-events (append unread-command-events '(ns-open-file)) | |
| d377ef4a | 114 | ns-input-file (append ns-input-file (list (pop ns-invocation-args))))) |
| edfda783 AR |
115 | |
| 116 | (defun ns-handle-nxopentemp (switch) | |
| d377ef4a GM |
117 | (setq unread-command-events (append unread-command-events |
| 118 | '(ns-open-temp-file)) | |
| 119 | ns-input-file (append ns-input-file (list (pop ns-invocation-args))))) | |
| edfda783 | 120 | |
| edfda783 AR |
121 | (defun ns-ignore-1-arg (switch) |
| 122 | (setq ns-invocation-args (cdr ns-invocation-args))) | |
| 123 | (defun ns-ignore-2-arg (switch) | |
| 124 | (setq ns-invocation-args (cddr ns-invocation-args))) | |
| 125 | ||
| 126 | (defun ns-handle-args (args) | |
| a5a1b464 | 127 | "Process Nextstep-related command line options. |
| 82a330df | 128 | This is run before the user's startup file is loaded. |
| a5a1b464 CY |
129 | The options in ARGS are copied to `ns-invocation-args'. |
| 130 | The Nextstep-related settings are then applied using the handlers | |
| 82a330df | 131 | defined in `command-line-ns-option-alist'. |
| a5a1b464 | 132 | The return value is ARGS minus the number of arguments processed." |
| edfda783 AR |
133 | ;; We use ARGS to accumulate the args that we don't handle here, to return. |
| 134 | (setq ns-invocation-args args | |
| 135 | args nil) | |
| 136 | (while ns-invocation-args | |
| d377ef4a | 137 | (let* ((this-switch (pop ns-invocation-args)) |
| edfda783 AR |
138 | (orig-this-switch this-switch) |
| 139 | completion argval aelt handler) | |
| edfda783 AR |
140 | ;; Check for long options with attached arguments |
| 141 | ;; and separate out the attached option argument into argval. | |
| 142 | (if (string-match "^--[^=]*=" this-switch) | |
| 143 | (setq argval (substring this-switch (match-end 0)) | |
| 144 | this-switch (substring this-switch 0 (1- (match-end 0))))) | |
| 145 | ;; Complete names of long options. | |
| 146 | (if (string-match "^--" this-switch) | |
| 147 | (progn | |
| 148 | (setq completion (try-completion this-switch | |
| 149 | command-line-ns-option-alist)) | |
| 150 | (if (eq completion t) | |
| 151 | ;; Exact match for long option. | |
| 152 | nil | |
| 153 | (if (stringp completion) | |
| 154 | (let ((elt (assoc completion command-line-ns-option-alist))) | |
| 155 | ;; Check for abbreviated long option. | |
| 156 | (or elt | |
| 157 | (error "Option `%s' is ambiguous" this-switch)) | |
| 158 | (setq this-switch completion)))))) | |
| 159 | (setq aelt (assoc this-switch command-line-ns-option-alist)) | |
| 160 | (if aelt (setq handler (nth 2 aelt))) | |
| 161 | (if handler | |
| 162 | (if argval | |
| 163 | (let ((ns-invocation-args | |
| 164 | (cons argval ns-invocation-args))) | |
| 165 | (funcall handler this-switch)) | |
| 166 | (funcall handler this-switch)) | |
| 167 | (setq args (cons orig-this-switch args))))) | |
| 168 | (nreverse args)) | |
| 169 | ||
| 489382c5 | 170 | (defun ns-parse-geometry (geom) |
| ba0c843d | 171 | "Parse a Nextstep-style geometry string GEOM. |
| edfda783 AR |
172 | Returns an alist of the form ((top . TOP), (left . LEFT) ... ). |
| 173 | The properties returned may include `top', `left', `height', and `width'." | |
| a5a1b464 CY |
174 | (when (string-match "\\([0-9]+\\)\\( \\([0-9]+\\)\\( \\([0-9]+\\)\ |
| 175 | \\( \\([0-9]+\\) ?\\)?\\)?\\)?" | |
| 176 | geom) | |
| 177 | (apply | |
| 178 | 'append | |
| 179 | (list | |
| 180 | (list (cons 'top (string-to-number (match-string 1 geom)))) | |
| 181 | (if (match-string 3 geom) | |
| 182 | (list (cons 'left (string-to-number (match-string 3 geom))))) | |
| 183 | (if (match-string 5 geom) | |
| 184 | (list (cons 'height (string-to-number (match-string 5 geom))))) | |
| 185 | (if (match-string 7 geom) | |
| 186 | (list (cons 'width (string-to-number (match-string 7 geom))))))))) | |
| edfda783 AR |
187 | |
| 188 | ;;;; Keyboard mapping. | |
| 189 | ||
| 6742a9d2 | 190 | ;; These tell read-char how to convert these special chars to ASCII. |
| 6742a9d2 | 191 | (put 'S-tab 'ascii-character (logior 16 ?\t)) |
| 55e8d9a5 AR |
192 | |
| 193 | (defvar ns-alternatives-map | |
| 194 | (let ((map (make-sparse-keymap))) | |
| 195 | ;; Map certain keypad keys into ASCII characters | |
| 196 | ;; that people usually expect. | |
| 55e8d9a5 | 197 | (define-key map [S-tab] [25]) |
| 55e8d9a5 AR |
198 | (define-key map [M-backspace] [?\M-\d]) |
| 199 | (define-key map [M-delete] [?\M-\d]) | |
| 200 | (define-key map [M-tab] [?\M-\t]) | |
| 201 | (define-key map [M-linefeed] [?\M-\n]) | |
| 202 | (define-key map [M-clear] [?\M-\C-l]) | |
| 203 | (define-key map [M-return] [?\M-\C-m]) | |
| 204 | (define-key map [M-escape] [?\M-\e]) | |
| 205 | map) | |
| 2b4e72e1 | 206 | "Keymap of alternative meanings for some keys under Nextstep.") |
| edfda783 | 207 | |
| a5a1b464 | 208 | ;; Here are some Nextstep-like bindings for command key sequences. |
| 4c785fa7 | 209 | (define-key global-map [?\s-,] 'customize) |
| edfda783 AR |
210 | (define-key global-map [?\s-'] 'next-multiframe-window) |
| 211 | (define-key global-map [?\s-`] 'other-frame) | |
| 212 | (define-key global-map [?\s--] 'center-line) | |
| 213 | (define-key global-map [?\s-:] 'ispell) | |
| 214 | (define-key global-map [?\s-\;] 'ispell-next) | |
| 215 | (define-key global-map [?\s-?] 'info) | |
| 216 | (define-key global-map [?\s-^] 'kill-some-buffers) | |
| 217 | (define-key global-map [?\s-&] 'kill-this-buffer) | |
| 218 | (define-key global-map [?\s-C] 'ns-popup-color-panel) | |
| 219 | (define-key global-map [?\s-D] 'dired) | |
| 220 | (define-key global-map [?\s-E] 'edit-abbrevs) | |
| 221 | (define-key global-map [?\s-L] 'shell-command) | |
| 222 | (define-key global-map [?\s-M] 'manual-entry) | |
| 223 | (define-key global-map [?\s-S] 'ns-write-file-using-panel) | |
| 224 | (define-key global-map [?\s-a] 'mark-whole-buffer) | |
| 225 | (define-key global-map [?\s-c] 'ns-copy-including-secondary) | |
| 226 | (define-key global-map [?\s-d] 'isearch-repeat-backward) | |
| 227 | (define-key global-map [?\s-e] 'isearch-yank-kill) | |
| 228 | (define-key global-map [?\s-f] 'isearch-forward) | |
| 229 | (define-key global-map [?\s-g] 'isearch-repeat-forward) | |
| 230 | (define-key global-map [?\s-h] 'ns-do-hide-emacs) | |
| 231 | (define-key global-map [?\s-H] 'ns-do-hide-others) | |
| 232 | (define-key global-map [?\s-j] 'exchange-point-and-mark) | |
| 233 | (define-key global-map [?\s-k] 'kill-this-buffer) | |
| 234 | (define-key global-map [?\s-l] 'goto-line) | |
| 235 | (define-key global-map [?\s-m] 'iconify-frame) | |
| 236 | (define-key global-map [?\s-n] 'make-frame) | |
| 237 | (define-key global-map [?\s-o] 'ns-open-file-using-panel) | |
| 238 | (define-key global-map [?\s-p] 'ns-print-buffer) | |
| 239 | (define-key global-map [?\s-q] 'save-buffers-kill-emacs) | |
| 240 | (define-key global-map [?\s-s] 'save-buffer) | |
| 241 | (define-key global-map [?\s-t] 'ns-popup-font-panel) | |
| 242 | (define-key global-map [?\s-u] 'revert-buffer) | |
| 243 | (define-key global-map [?\s-v] 'yank) | |
| 244 | (define-key global-map [?\s-w] 'delete-frame) | |
| 245 | (define-key global-map [?\s-x] 'kill-region) | |
| 246 | (define-key global-map [?\s-y] 'ns-paste-secondary) | |
| 247 | (define-key global-map [?\s-z] 'undo) | |
| 248 | (define-key global-map [?\s-|] 'shell-command-on-region) | |
| 249 | (define-key global-map [s-kp-bar] 'shell-command-on-region) | |
| ebe68042 | 250 | ;; (as in Terminal.app) |
| edfda783 AR |
251 | (define-key global-map [s-right] 'ns-next-frame) |
| 252 | (define-key global-map [s-left] 'ns-prev-frame) | |
| 253 | ||
| 254 | (define-key global-map [home] 'beginning-of-buffer) | |
| 255 | (define-key global-map [end] 'end-of-buffer) | |
| 256 | (define-key global-map [kp-home] 'beginning-of-buffer) | |
| 257 | (define-key global-map [kp-end] 'end-of-buffer) | |
| 258 | (define-key global-map [kp-prior] 'scroll-down) | |
| 259 | (define-key global-map [kp-next] 'scroll-up) | |
| 260 | ||
| 55e8d9a5 AR |
261 | ;;; Allow shift-clicks to work similarly to under Nextstep |
| 262 | (define-key global-map [S-mouse-1] 'mouse-save-then-kill) | |
| 263 | (global-unset-key [S-down-mouse-1]) | |
| 264 | ||
| edfda783 | 265 | |
| a5a1b464 | 266 | ;; Special Nextstep-generated events are converted to function keys. Here |
| edfda783 | 267 | ;; are the bindings for them. |
| c6c62e78 | 268 | (define-key global-map [ns-power-off] 'save-buffers-kill-emacs) |
| edfda783 AR |
269 | (define-key global-map [ns-open-file] 'ns-find-file) |
| 270 | (define-key global-map [ns-open-temp-file] [ns-open-file]) | |
| 271 | (define-key global-map [ns-drag-file] 'ns-insert-file) | |
| 272 | (define-key global-map [ns-drag-color] 'ns-set-foreground-at-mouse) | |
| 273 | (define-key global-map [S-ns-drag-color] 'ns-set-background-at-mouse) | |
| 274 | (define-key global-map [ns-drag-text] 'ns-insert-text) | |
| 275 | (define-key global-map [ns-change-font] 'ns-respond-to-change-font) | |
| 276 | (define-key global-map [ns-open-file-line] 'ns-open-file-select-line) | |
| edfda783 | 277 | (define-key global-map [ns-spi-service-call] 'ns-spi-service-call) |
| 4e622592 | 278 | (define-key global-map [ns-new-frame] 'make-frame) |
| 33b35792 | 279 | (define-key global-map [ns-toggle-toolbar] 'ns-toggle-toolbar) |
| c6c62e78 | 280 | (define-key global-map [ns-show-prefs] 'customize) |
| edfda783 AR |
281 | |
| 282 | ||
| 2f93961f CY |
283 | ;; Set up a number of aliases and other layers to pretend we're using |
| 284 | ;; the Choi/Mitsuharu Carbon port. | |
| 285 | ||
| 286 | (defvaralias 'mac-allow-anti-aliasing 'ns-antialias-text) | |
| 287 | (defvaralias 'mac-command-modifier 'ns-command-modifier) | |
| 288 | (defvaralias 'mac-control-modifier 'ns-control-modifier) | |
| 289 | (defvaralias 'mac-option-modifier 'ns-option-modifier) | |
| a2e35ef5 | 290 | (defvaralias 'mac-right-option-modifier 'ns-right-option-modifier) |
| 2f93961f | 291 | (defvaralias 'mac-function-modifier 'ns-function-modifier) |
| 406aaa6f | 292 | (declare-function ns-do-applescript "nsfns.m" (script)) |
| 583ff3c3 AR |
293 | (defalias 'do-applescript 'ns-do-applescript) |
| 294 | ||
| edfda783 | 295 | (defun x-setup-function-keys (frame) |
| 5cc443fe | 296 | "Set up `function-key-map' on the graphical frame FRAME." |
| edfda783 AR |
297 | (unless (terminal-parameter frame 'x-setup-function-keys) |
| 298 | (with-selected-frame frame | |
| 9e50ff0c DN |
299 | (setq interprogram-cut-function 'x-select-text |
| 300 | interprogram-paste-function 'x-cut-buffer-or-selection-value) | |
| 55e8d9a5 AR |
301 | (let ((map (copy-keymap ns-alternatives-map))) |
| 302 | (set-keymap-parent map (keymap-parent local-function-key-map)) | |
| 303 | (set-keymap-parent local-function-key-map map)) | |
| ebe68042 SM |
304 | (setq system-key-alist |
| 305 | (list | |
| 306 | (cons (logior (lsh 0 16) 1) 'ns-power-off) | |
| 307 | (cons (logior (lsh 0 16) 2) 'ns-open-file) | |
| 308 | (cons (logior (lsh 0 16) 3) 'ns-open-temp-file) | |
| 309 | (cons (logior (lsh 0 16) 4) 'ns-drag-file) | |
| 310 | (cons (logior (lsh 0 16) 5) 'ns-drag-color) | |
| 311 | (cons (logior (lsh 0 16) 6) 'ns-drag-text) | |
| 312 | (cons (logior (lsh 0 16) 7) 'ns-change-font) | |
| 313 | (cons (logior (lsh 0 16) 8) 'ns-open-file-line) | |
| 33b35792 AR |
314 | ; (cons (logior (lsh 0 16) 9) 'ns-insert-working-text) |
| 315 | ; (cons (logior (lsh 0 16) 10) 'ns-delete-working-text) | |
| ebe68042 | 316 | (cons (logior (lsh 0 16) 11) 'ns-spi-service-call) |
| 4c785fa7 DR |
317 | (cons (logior (lsh 0 16) 12) 'ns-new-frame) |
| 318 | (cons (logior (lsh 0 16) 13) 'ns-toggle-toolbar) | |
| 319 | (cons (logior (lsh 0 16) 14) 'ns-show-prefs) | |
| 320 | (cons (logior (lsh 1 16) 32) 'f1) | |
| ebe68042 SM |
321 | (cons (logior (lsh 1 16) 33) 'f2) |
| 322 | (cons (logior (lsh 1 16) 34) 'f3) | |
| 323 | (cons (logior (lsh 1 16) 35) 'f4) | |
| 324 | (cons (logior (lsh 1 16) 36) 'f5) | |
| 325 | (cons (logior (lsh 1 16) 37) 'f6) | |
| 326 | (cons (logior (lsh 1 16) 38) 'f7) | |
| 327 | (cons (logior (lsh 1 16) 39) 'f8) | |
| 328 | (cons (logior (lsh 1 16) 40) 'f9) | |
| 329 | (cons (logior (lsh 1 16) 41) 'f10) | |
| 330 | (cons (logior (lsh 1 16) 42) 'f11) | |
| 331 | (cons (logior (lsh 1 16) 43) 'f12) | |
| 332 | (cons (logior (lsh 1 16) 44) 'kp-insert) | |
| 333 | (cons (logior (lsh 1 16) 45) 'kp-delete) | |
| 334 | (cons (logior (lsh 1 16) 46) 'kp-home) | |
| 335 | (cons (logior (lsh 1 16) 47) 'kp-end) | |
| 336 | (cons (logior (lsh 1 16) 48) 'kp-prior) | |
| 337 | (cons (logior (lsh 1 16) 49) 'kp-next) | |
| 338 | (cons (logior (lsh 1 16) 50) 'print-screen) | |
| 339 | (cons (logior (lsh 1 16) 51) 'scroll-lock) | |
| 340 | (cons (logior (lsh 1 16) 52) 'pause) | |
| 341 | (cons (logior (lsh 1 16) 53) 'system) | |
| 342 | (cons (logior (lsh 1 16) 54) 'break) | |
| 343 | (cons (logior (lsh 1 16) 56) 'please-tell-carl-what-this-key-is-called-56) | |
| 344 | (cons (logior (lsh 1 16) 61) 'please-tell-carl-what-this-key-is-called-61) | |
| 345 | (cons (logior (lsh 1 16) 62) 'please-tell-carl-what-this-key-is-called-62) | |
| 346 | (cons (logior (lsh 1 16) 63) 'please-tell-carl-what-this-key-is-called-63) | |
| 347 | (cons (logior (lsh 1 16) 64) 'please-tell-carl-what-this-key-is-called-64) | |
| 348 | (cons (logior (lsh 1 16) 69) 'please-tell-carl-what-this-key-is-called-69) | |
| 349 | (cons (logior (lsh 1 16) 70) 'please-tell-carl-what-this-key-is-called-70) | |
| 350 | (cons (logior (lsh 1 16) 71) 'please-tell-carl-what-this-key-is-called-71) | |
| 351 | (cons (logior (lsh 1 16) 72) 'please-tell-carl-what-this-key-is-called-72) | |
| 352 | (cons (logior (lsh 1 16) 73) 'please-tell-carl-what-this-key-is-called-73) | |
| 353 | (cons (logior (lsh 2 16) 3) 'kp-enter) | |
| 354 | (cons (logior (lsh 2 16) 9) 'kp-tab) | |
| 355 | (cons (logior (lsh 2 16) 28) 'kp-quit) | |
| 356 | (cons (logior (lsh 2 16) 35) 'kp-hash) | |
| 357 | (cons (logior (lsh 2 16) 42) 'kp-multiply) | |
| 358 | (cons (logior (lsh 2 16) 43) 'kp-add) | |
| 359 | (cons (logior (lsh 2 16) 44) 'kp-separator) | |
| 360 | (cons (logior (lsh 2 16) 45) 'kp-subtract) | |
| 361 | (cons (logior (lsh 2 16) 46) 'kp-decimal) | |
| 362 | (cons (logior (lsh 2 16) 47) 'kp-divide) | |
| 363 | (cons (logior (lsh 2 16) 48) 'kp-0) | |
| 364 | (cons (logior (lsh 2 16) 49) 'kp-1) | |
| 365 | (cons (logior (lsh 2 16) 50) 'kp-2) | |
| 366 | (cons (logior (lsh 2 16) 51) 'kp-3) | |
| 367 | (cons (logior (lsh 2 16) 52) 'kp-4) | |
| 368 | (cons (logior (lsh 2 16) 53) 'kp-5) | |
| 369 | (cons (logior (lsh 2 16) 54) 'kp-6) | |
| 370 | (cons (logior (lsh 2 16) 55) 'kp-7) | |
| 371 | (cons (logior (lsh 2 16) 56) 'kp-8) | |
| 372 | (cons (logior (lsh 2 16) 57) 'kp-9) | |
| 373 | (cons (logior (lsh 2 16) 60) 'kp-less) | |
| 374 | (cons (logior (lsh 2 16) 61) 'kp-equal) | |
| 375 | (cons (logior (lsh 2 16) 62) 'kp-more) | |
| 376 | (cons (logior (lsh 2 16) 64) 'kp-at) | |
| 377 | (cons (logior (lsh 2 16) 92) 'kp-backslash) | |
| 378 | (cons (logior (lsh 2 16) 96) 'kp-backtick) | |
| 379 | (cons (logior (lsh 2 16) 124) 'kp-bar) | |
| 380 | (cons (logior (lsh 2 16) 126) 'kp-tilde) | |
| 381 | (cons (logior (lsh 2 16) 157) 'kp-mu) | |
| 382 | (cons (logior (lsh 2 16) 165) 'kp-yen) | |
| 383 | (cons (logior (lsh 2 16) 167) 'kp-paragraph) | |
| 384 | (cons (logior (lsh 2 16) 172) 'left) | |
| 385 | (cons (logior (lsh 2 16) 173) 'up) | |
| 386 | (cons (logior (lsh 2 16) 174) 'right) | |
| 387 | (cons (logior (lsh 2 16) 175) 'down) | |
| 388 | (cons (logior (lsh 2 16) 176) 'kp-ring) | |
| 389 | (cons (logior (lsh 2 16) 201) 'kp-square) | |
| 390 | (cons (logior (lsh 2 16) 204) 'kp-cube) | |
| 391 | (cons (logior (lsh 3 16) 8) 'backspace) | |
| 392 | (cons (logior (lsh 3 16) 9) 'tab) | |
| 393 | (cons (logior (lsh 3 16) 10) 'linefeed) | |
| 394 | (cons (logior (lsh 3 16) 11) 'clear) | |
| 395 | (cons (logior (lsh 3 16) 13) 'return) | |
| 396 | (cons (logior (lsh 3 16) 18) 'pause) | |
| 397 | (cons (logior (lsh 3 16) 25) 'S-tab) | |
| 398 | (cons (logior (lsh 3 16) 27) 'escape) | |
| 399 | (cons (logior (lsh 3 16) 127) 'delete) | |
| 55e8d9a5 AR |
400 | ))) |
| 401 | (set-terminal-parameter frame 'x-setup-function-keys t))) | |
| edfda783 AR |
402 | |
| 403 | ||
| edfda783 AR |
404 | ;; Add a couple of menus and rearrange some others; easiest just to redo toplvl |
| 405 | ;; Note keymap defns must be given last-to-first | |
| 406 | (define-key global-map [menu-bar] (make-sparse-keymap "menu-bar")) | |
| 407 | ||
| ebe68042 SM |
408 | (setq menu-bar-final-items |
| 409 | (cond ((eq system-type 'darwin) | |
| 410 | '(buffer windows services help-menu)) | |
| 411 | ;; Otherwise, GNUstep. | |
| 412 | (t | |
| 413 | '(buffer windows services hide-app quit)))) | |
| edfda783 | 414 | |
| ebe68042 SM |
415 | ;; Add standard top-level items to GNUstep menu. |
| 416 | (unless (eq system-type 'darwin) | |
| 417 | (define-key global-map [menu-bar quit] '("Quit" . save-buffers-kill-emacs)) | |
| 418 | (define-key global-map [menu-bar hide-app] '("Hide" . ns-do-hide-emacs))) | |
| edfda783 AR |
419 | |
| 420 | (define-key global-map [menu-bar services] | |
| 421 | (cons "Services" (make-sparse-keymap "Services"))) | |
| edfda783 AR |
422 | (define-key global-map [menu-bar buffer] |
| 423 | (cons "Buffers" global-buffers-menu-map)) | |
| 424 | ;; (cons "Buffers" (make-sparse-keymap "Buffers"))) | |
| 425 | (define-key global-map [menu-bar tools] (cons "Tools" menu-bar-tools-menu)) | |
| 426 | (define-key global-map [menu-bar options] (cons "Options" menu-bar-options-menu)) | |
| 427 | (define-key global-map [menu-bar edit] (cons "Edit" menu-bar-edit-menu)) | |
| 428 | (define-key global-map [menu-bar file] (cons "File" menu-bar-file-menu)) | |
| 429 | ||
| 430 | ;; If running under GNUstep, rename "Help" to "Info" | |
| 431 | (cond ((eq system-type 'darwin) | |
| 432 | (define-key global-map [menu-bar help-menu] | |
| 433 | (cons "Help" menu-bar-help-menu))) | |
| 434 | (t | |
| 435 | (let ((contents (reverse (cdr menu-bar-help-menu)))) | |
| 436 | (setq menu-bar-help-menu | |
| 437 | (append (list 'keymap) (cdr contents) (list "Info")))) | |
| 438 | (define-key global-map [menu-bar help-menu] | |
| 439 | (cons "Info" menu-bar-help-menu)))) | |
| 440 | ||
| edfda783 AR |
441 | (if (not (eq system-type 'darwin)) |
| 442 | ;; in OS X it's in the app menu already | |
| 443 | (define-key menu-bar-help-menu [info-panel] | |
| 444 | '("About Emacs..." . ns-do-emacs-info-panel))) | |
| 445 | ||
| edfda783 AR |
446 | ;;;; Edit menu: Modify slightly |
| 447 | ||
| ebe68042 | 448 | ;; Substitute a Copy function that works better under X (for GNUstep). |
| edfda783 AR |
449 | (easy-menu-remove-item global-map '("menu-bar" "edit") 'copy) |
| 450 | (define-key-after menu-bar-edit-menu [copy] | |
| 451 | '(menu-item "Copy" ns-copy-including-secondary | |
| ebe68042 SM |
452 | :enable mark-active |
| 453 | :help "Copy text in region between mark and current position") | |
| edfda783 AR |
454 | 'cut) |
| 455 | ||
| ebe68042 SM |
456 | ;; Change to same precondition as select-and-paste, as we don't have |
| 457 | ;; `x-selection-exists-p'. | |
| edfda783 AR |
458 | (easy-menu-remove-item global-map '("menu-bar" "edit") 'paste) |
| 459 | (define-key-after menu-bar-edit-menu [paste] | |
| 460 | '(menu-item "Paste" yank | |
| ebe68042 SM |
461 | :enable (and (cdr yank-menu) (not buffer-read-only)) |
| 462 | :help "Paste (yank) text most recently cut/copied") | |
| edfda783 AR |
463 | 'copy) |
| 464 | ||
| ebe68042 | 465 | ;; Change text to be more consistent with surrounding menu items `paste', etc. |
| edfda783 AR |
466 | (easy-menu-remove-item global-map '("menu-bar" "edit") 'paste-from-menu) |
| 467 | (define-key-after menu-bar-edit-menu [select-paste] | |
| 468 | '(menu-item "Select and Paste" yank-menu | |
| ebe68042 SM |
469 | :enable (and (cdr yank-menu) (not buffer-read-only)) |
| 470 | :help "Choose a string from the kill ring and paste it") | |
| edfda783 AR |
471 | 'paste) |
| 472 | ||
| ebe68042 | 473 | ;; Separate undo from cut/paste section, add spell for platform consistency. |
| edfda783 AR |
474 | (define-key-after menu-bar-edit-menu [separator-undo] '("--") 'undo) |
| 475 | (define-key-after menu-bar-edit-menu [spell] '("Spell" . ispell-menu-map) 'fill) | |
| 476 | ||
| edfda783 AR |
477 | |
| 478 | ;;;; Services | |
| d377ef4a GM |
479 | (declare-function ns-perform-service "nsfns.m" (service send)) |
| 480 | ||
| edfda783 AR |
481 | (defun ns-define-service (path) |
| 482 | (let ((mapping [menu-bar services]) | |
| 483 | (service (mapconcat 'identity path "/")) | |
| 484 | (name (intern | |
| ebe68042 SM |
485 | (subst-char-in-string |
| 486 | ?\s ?- | |
| 487 | (mapconcat 'identity (cons "ns-service" path) "-"))))) | |
| 488 | ;; This defines the function. | |
| 489 | (defalias name | |
| 490 | (lexical-let ((service service)) | |
| 491 | (lambda (arg) | |
| 492 | (interactive "p") | |
| 493 | (let* ((in-string | |
| 494 | (cond ((stringp arg) arg) | |
| 495 | (mark-active | |
| 496 | (buffer-substring (region-beginning) (region-end))))) | |
| 497 | (out-string (ns-perform-service service in-string))) | |
| 498 | (cond | |
| 499 | ((stringp arg) out-string) | |
| 500 | ((and out-string (or (not in-string) | |
| 501 | (not (string= in-string out-string)))) | |
| 502 | (if mark-active (delete-region (region-beginning) (region-end))) | |
| 503 | (insert out-string) | |
| 504 | (setq deactivate-mark nil))))))) | |
| edfda783 AR |
505 | (cond |
| 506 | ((lookup-key global-map mapping) | |
| 507 | (while (cdr path) | |
| 508 | (setq mapping (vconcat mapping (list (intern (car path))))) | |
| 509 | (if (not (keymapp (lookup-key global-map mapping))) | |
| 510 | (define-key global-map mapping | |
| 511 | (cons (car path) (make-sparse-keymap (car path))))) | |
| 512 | (setq path (cdr path))) | |
| 513 | (setq mapping (vconcat mapping (list (intern (car path))))) | |
| 514 | (define-key global-map mapping (cons (car path) name)))) | |
| 515 | name)) | |
| 516 | ||
| c0642f6d GM |
517 | ;; nsterm.m |
| 518 | (defvar ns-input-spi-name) | |
| 519 | (defvar ns-input-spi-arg) | |
| 520 | ||
| f2d9c15f GM |
521 | (declare-function dnd-open-file "dnd" (uri action)) |
| 522 | ||
| edfda783 | 523 | (defun ns-spi-service-call () |
| 82a330df | 524 | "Respond to a service request." |
| edfda783 AR |
525 | (interactive) |
| 526 | (cond ((string-equal ns-input-spi-name "open-selection") | |
| 527 | (switch-to-buffer (generate-new-buffer "*untitled*")) | |
| 528 | (insert ns-input-spi-arg)) | |
| 529 | ((string-equal ns-input-spi-name "open-file") | |
| 530 | (dnd-open-file ns-input-spi-arg nil)) | |
| 531 | ((string-equal ns-input-spi-name "mail-selection") | |
| 532 | (compose-mail) | |
| 533 | (rfc822-goto-eoh) | |
| 534 | (forward-line 1) | |
| 535 | (insert ns-input-spi-arg)) | |
| 536 | ((string-equal ns-input-spi-name "mail-to") | |
| 537 | (compose-mail ns-input-spi-arg)) | |
| 538 | (t (error (concat "Service " ns-input-spi-name " not recognized"))))) | |
| 539 | ||
| 540 | ||
| 541 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 542 | ||
| 543 | ||
| 544 | ||
| 43c660bc SM |
545 | ;; Composed key sequence handling for Nextstep system input methods. |
| 546 | ;; (On Nextstep systems, input methods are provided for CJK | |
| 547 | ;; characters, etc. which require multiple keystrokes, and during | |
| 548 | ;; entry a partial ("working") result is typically shown in the | |
| 549 | ;; editing window.) | |
| edfda783 AR |
550 | |
| 551 | (defface ns-working-text-face | |
| 552 | '((t :underline t)) | |
| 553 | "Face used to highlight working text during compose sequence insert." | |
| 554 | :group 'ns) | |
| 555 | ||
| 556 | (defvar ns-working-overlay nil | |
| 43c660bc SM |
557 | "Overlay used to highlight working text during compose sequence insert. |
| 558 | When text is in th echo area, this just stores the length of the working text.") | |
| edfda783 | 559 | |
| 33b35792 AR |
560 | (defvar ns-working-text) ; nsterm.m |
| 561 | ||
| 562 | ;; Test if in echo area, based on mac-win.el 2007/08/26 unicode-2. | |
| 563 | ;; This will fail if called from a NONASCII_KEYSTROKE event on the global map. | |
| edfda783 AR |
564 | (defun ns-in-echo-area () |
| 565 | "Whether, for purposes of inserting working composition text, the minibuffer | |
| 566 | is currently being used." | |
| 567 | (or isearch-mode | |
| 568 | (and cursor-in-echo-area (current-message)) | |
| 569 | ;; Overlay strings are not shown in some cases. | |
| 570 | (get-char-property (point) 'invisible) | |
| 571 | (and (not (bobp)) | |
| 572 | (or (and (get-char-property (point) 'display) | |
| 573 | (eq (get-char-property (1- (point)) 'display) | |
| 574 | (get-char-property (point) 'display))) | |
| 575 | (and (get-char-property (point) 'composition) | |
| 576 | (eq (get-char-property (1- (point)) 'composition) | |
| 577 | (get-char-property (point) 'composition))))))) | |
| 578 | ||
| 9d8f6d31 AR |
579 | ;; The 'interactive' here stays for subinvocations, so the ns-in-echo-area |
| 580 | ;; always returns nil for some reason. If this WASN'T the case, we could | |
| 581 | ;; map this to [ns-insert-working-text] and eliminate Fevals in nsterm.m. | |
| 33b35792 | 582 | ;; These functions test whether in echo area and delegate accordingly. |
| 9d8f6d31 | 583 | (defun ns-put-working-text () |
| edfda783 | 584 | (interactive) |
| 9d8f6d31 | 585 | (if (ns-in-echo-area) (ns-echo-working-text) (ns-insert-working-text))) |
| 33b35792 AR |
586 | (defun ns-unput-working-text () |
| 587 | (interactive) | |
| 43c660bc | 588 | (ns-delete-working-text)) |
| c0642f6d | 589 | |
| 9d8f6d31 | 590 | (defun ns-insert-working-text () |
| 2b4e72e1 | 591 | "Insert contents of `ns-working-text' as UTF-8 string and mark with |
| 43c660bc SM |
592 | `ns-working-overlay'. Any previously existing working text is cleared first. |
| 593 | The overlay is assigned the face `ns-working-text-face'." | |
| 594 | ;; FIXME: if buffer is read-only, don't try to insert anything | |
| 595 | ;; and if text is bound to a command, execute that instead (Bug#1453) | |
| edfda783 | 596 | (interactive) |
| 43c660bc | 597 | (ns-delete-working-text) |
| edfda783 AR |
598 | (let ((start (point))) |
| 599 | (insert ns-working-text) | |
| 600 | (overlay-put (setq ns-working-overlay (make-overlay start (point) | |
| 601 | (current-buffer) nil t)) | |
| 43c660bc | 602 | 'face 'ns-working-text-face))) |
| edfda783 AR |
603 | |
| 604 | (defun ns-echo-working-text () | |
| 2b4e72e1 | 605 | "Echo contents of `ns-working-text' in message display area. |
| 43c660bc SM |
606 | See `ns-insert-working-text'." |
| 607 | (ns-delete-working-text) | |
| edfda783 AR |
608 | (let* ((msg (current-message)) |
| 609 | (msglen (length msg)) | |
| 610 | message-log-max) | |
| 43c660bc | 611 | (setq ns-working-overlay (length ns-working-text)) |
| edfda783 | 612 | (setq msg (concat msg ns-working-text)) |
| 43c660bc | 613 | (put-text-property msglen (+ msglen ns-working-overlay) |
| 08324aaa | 614 | 'face 'ns-working-text-face msg) |
| 43c660bc | 615 | (message "%s" msg))) |
| edfda783 AR |
616 | |
| 617 | (defun ns-delete-working-text() | |
| 43c660bc | 618 | "Delete working text and clear `ns-working-overlay'." |
| edfda783 | 619 | (interactive) |
| 43c660bc SM |
620 | (cond |
| 621 | ((and (overlayp ns-working-overlay) | |
| 622 | ;; Still alive? | |
| 623 | (overlay-buffer ns-working-overlay)) | |
| 624 | (with-current-buffer (overlay-buffer ns-working-overlay) | |
| 625 | (delete-region (overlay-start ns-working-overlay) | |
| 626 | (overlay-end ns-working-overlay)) | |
| 627 | (delete-overlay ns-working-overlay))) | |
| 628 | ((integerp ns-working-overlay) | |
| 629 | (let ((msg (current-message)) | |
| 630 | message-log-max) | |
| 631 | (setq msg (substring msg 0 (- (length msg) ns-working-overlay))) | |
| 632 | (message "%s" msg)))) | |
| 633 | (setq ns-working-overlay nil)) | |
| edfda783 AR |
634 | |
| 635 | ||
| c0642f6d GM |
636 | (declare-function ns-convert-utf8-nfd-to-nfc "nsfns.m" (str)) |
| 637 | ||
| edfda783 AR |
638 | ;;;; OS X file system Unicode UTF-8 NFD (decomposed form) support |
| 639 | ;; Lisp code based on utf-8m.el, by Seiji Zenitani, Eiji Honjoh, and | |
| 640 | ;; Carsten Bormann. | |
| 641 | (if (eq system-type 'darwin) | |
| 642 | (progn | |
| 643 | ||
| 644 | (defun ns-utf8-nfd-post-read-conversion (length) | |
| 2b4e72e1 | 645 | "Calls `ns-convert-utf8-nfd-to-nfc' to compose char sequences." |
| edfda783 AR |
646 | (save-excursion |
| 647 | (save-restriction | |
| 648 | (narrow-to-region (point) (+ (point) length)) | |
| 649 | (let ((str (buffer-string))) | |
| 650 | (delete-region (point-min) (point-max)) | |
| 651 | (insert (ns-convert-utf8-nfd-to-nfc str)) | |
| 652 | (- (point-max) (point-min)) | |
| 653 | )))) | |
| 654 | ||
| 655 | (define-coding-system 'utf-8-nfd | |
| 656 | "UTF-8 NFD (decomposed) encoding." | |
| 657 | :coding-type 'utf-8 | |
| 658 | :mnemonic ?U | |
| 659 | :charset-list '(unicode) | |
| 660 | :post-read-conversion 'ns-utf8-nfd-post-read-conversion) | |
| 661 | (set-file-name-coding-system 'utf-8-nfd))) | |
| 662 | ||
| edfda783 AR |
663 | |
| 664 | ||
| 665 | ;;;; Inter-app communications support. | |
| 666 | ||
| c0642f6d GM |
667 | (defvar ns-input-text) ; nsterm.m |
| 668 | ||
| edfda783 | 669 | (defun ns-insert-text () |
| 2b4e72e1 | 670 | "Insert contents of `ns-input-text' at point." |
| edfda783 AR |
671 | (interactive) |
| 672 | (insert ns-input-text) | |
| 673 | (setq ns-input-text nil)) | |
| c0642f6d | 674 | |
| edfda783 | 675 | (defun ns-insert-file () |
| 2b4e72e1 JB |
676 | "Insert contents of file `ns-input-file' like insert-file but with less |
| 677 | prompting. If file is a directory perform a `find-file' on it." | |
| edfda783 AR |
678 | (interactive) |
| 679 | (let ((f)) | |
| 680 | (setq f (car ns-input-file)) | |
| 681 | (setq ns-input-file (cdr ns-input-file)) | |
| 682 | (if (file-directory-p f) | |
| 683 | (find-file f) | |
| 684 | (push-mark (+ (point) (car (cdr (insert-file-contents f)))))))) | |
| 685 | ||
| 686 | (defvar ns-select-overlay nil | |
| a5a1b464 | 687 | "Overlay used to highlight areas in files requested by Nextstep apps.") |
| edfda783 AR |
688 | (make-variable-buffer-local 'ns-select-overlay) |
| 689 | ||
| c0642f6d GM |
690 | (defvar ns-input-line) ; nsterm.m |
| 691 | ||
| edfda783 | 692 | (defun ns-open-file-select-line () |
| b90cc058 CY |
693 | "Open a buffer containing the file `ns-input-file'. |
| 694 | Lines are highlighted according to `ns-input-line'." | |
| edfda783 AR |
695 | (interactive) |
| 696 | (ns-find-file) | |
| 697 | (cond | |
| 698 | ((and ns-input-line (buffer-modified-p)) | |
| 699 | (if ns-select-overlay | |
| 700 | (setq ns-select-overlay (delete-overlay ns-select-overlay))) | |
| 701 | (deactivate-mark) | |
| 5f68c1b7 GM |
702 | (goto-char (point-min)) |
| 703 | (forward-line (1- (if (consp ns-input-line) | |
| 704 | (min (car ns-input-line) (cdr ns-input-line)) | |
| 705 | ns-input-line)))) | |
| edfda783 AR |
706 | (ns-input-line |
| 707 | (if (not ns-select-overlay) | |
| d93e053b GM |
708 | (overlay-put (setq ns-select-overlay (make-overlay (point-min) |
| 709 | (point-min))) | |
| edfda783 AR |
710 | 'face 'highlight)) |
| 711 | (let ((beg (save-excursion | |
| d93e053b GM |
712 | (goto-char (point-min)) |
| 713 | (line-beginning-position | |
| 714 | (if (consp ns-input-line) | |
| 715 | (min (car ns-input-line) (cdr ns-input-line)) | |
| 716 | ns-input-line)))) | |
| edfda783 | 717 | (end (save-excursion |
| d93e053b GM |
718 | (goto-char (point-min)) |
| 719 | (line-beginning-position | |
| 720 | (1+ (if (consp ns-input-line) | |
| 721 | (max (car ns-input-line) (cdr ns-input-line)) | |
| 722 | ns-input-line)))))) | |
| edfda783 AR |
723 | (move-overlay ns-select-overlay beg end) |
| 724 | (deactivate-mark) | |
| 725 | (goto-char beg))) | |
| 726 | (t | |
| 727 | (if ns-select-overlay | |
| 728 | (setq ns-select-overlay (delete-overlay ns-select-overlay)))))) | |
| 729 | ||
| 730 | (defun ns-unselect-line () | |
| a5a1b464 | 731 | "Removes any Nextstep highlight a buffer may contain." |
| edfda783 AR |
732 | (if ns-select-overlay |
| 733 | (setq ns-select-overlay (delete-overlay ns-select-overlay)))) | |
| 734 | ||
| 735 | (add-hook 'first-change-hook 'ns-unselect-line) | |
| 736 | ||
| 737 | ||
| 738 | ||
| 739 | ;;;; Preferences handling. | |
| c0642f6d | 740 | (declare-function ns-get-resource "nsfns.m" (owner name)) |
| edfda783 AR |
741 | |
| 742 | (defun get-lisp-resource (arg1 arg2) | |
| 743 | (let ((res (ns-get-resource arg1 arg2))) | |
| 744 | (cond | |
| 745 | ((not res) 'unbound) | |
| 746 | ((string-equal (upcase res) "YES") t) | |
| 747 | ((string-equal (upcase res) "NO") nil) | |
| 748 | (t (read res))))) | |
| 749 | ||
| c0642f6d | 750 | ;; nsterm.m |
| c6c62e78 | 751 | |
| c0642f6d GM |
752 | (declare-function ns-read-file-name "nsfns.m" |
| 753 | (prompt &optional dir isLoad init)) | |
| 754 | ||
| edfda783 AR |
755 | ;;;; File handling. |
| 756 | ||
| 757 | (defun ns-open-file-using-panel () | |
| 758 | "Pop up open-file panel, and load the result in a buffer." | |
| 759 | (interactive) | |
| ebe68042 | 760 | ;; Prompt dir defaultName isLoad initial. |
| edfda783 AR |
761 | (setq ns-input-file (ns-read-file-name "Select File to Load" nil t nil)) |
| 762 | (if ns-input-file | |
| 763 | (and (setq ns-input-file (list ns-input-file)) (ns-find-file)))) | |
| 764 | ||
| 765 | (defun ns-write-file-using-panel () | |
| 766 | "Pop up save-file panel, and save buffer in resulting name." | |
| 767 | (interactive) | |
| 768 | (let (ns-output-file) | |
| ebe68042 | 769 | ;; Prompt dir defaultName isLoad initial. |
| edfda783 AR |
770 | (setq ns-output-file (ns-read-file-name "Save As" nil nil nil)) |
| 771 | (message ns-output-file) | |
| 772 | (if ns-output-file (write-file ns-output-file)))) | |
| 773 | ||
| 73f6360c GM |
774 | (defcustom ns-pop-up-frames 'fresh |
| 775 | "Non-nil means open files upon request from the Workspace in a new frame. | |
| c0642f6d | 776 | If t, always do so. Any other non-nil value means open a new frame |
| 73f6360c GM |
777 | unless the current buffer is a scratch buffer." |
| 778 | :type '(choice (const :tag "Never" nil) | |
| 779 | (const :tag "Always" t) | |
| 780 | (other :tag "Except for scratch buffer" fresh)) | |
| 781 | :version "23.1" | |
| 782 | :group 'ns) | |
| c0642f6d GM |
783 | |
| 784 | (declare-function ns-hide-emacs "nsfns.m" (on)) | |
| 785 | ||
| edfda783 | 786 | (defun ns-find-file () |
| 2b4e72e1 | 787 | "Do a `find-file' with the `ns-input-file' as argument." |
| edfda783 AR |
788 | (interactive) |
| 789 | (let ((f) (file) (bufwin1) (bufwin2)) | |
| 790 | (setq f (file-truename (car ns-input-file))) | |
| 791 | (setq ns-input-file (cdr ns-input-file)) | |
| 792 | (setq file (find-file-noselect f)) | |
| 793 | (setq bufwin1 (get-buffer-window file 'visible)) | |
| 794 | (setq bufwin2 (get-buffer-window "*scratch*" 'visibile)) | |
| 795 | (cond | |
| 796 | (bufwin1 | |
| 797 | (select-frame (window-frame bufwin1)) | |
| 798 | (raise-frame (window-frame bufwin1)) | |
| 799 | (select-window bufwin1)) | |
| 800 | ((and (eq ns-pop-up-frames 'fresh) bufwin2) | |
| 801 | (ns-hide-emacs 'activate) | |
| 802 | (select-frame (window-frame bufwin2)) | |
| 803 | (raise-frame (window-frame bufwin2)) | |
| 804 | (select-window bufwin2) | |
| 805 | (find-file f)) | |
| 806 | (ns-pop-up-frames | |
| 807 | (ns-hide-emacs 'activate) | |
| 808 | (let ((pop-up-frames t)) (pop-to-buffer file nil))) | |
| 809 | (t | |
| 810 | (ns-hide-emacs 'activate) | |
| 811 | (find-file f))))) | |
| 812 | ||
| 813 | ||
| 814 | ||
| 815 | ;;;; Frame-related functions. | |
| 816 | ||
| a5a1b464 | 817 | ;; Don't show the frame name; that's redundant with Nextstep. |
| edfda783 AR |
818 | (setq-default mode-line-frame-identification '(" ")) |
| 819 | ||
| edfda783 AR |
820 | ;; You say tomAYto, I say tomAHto.. |
| 821 | (defvaralias 'ns-option-modifier 'ns-alternate-modifier) | |
| a2e35ef5 | 822 | (defvaralias 'ns-right-option-modifier 'ns-right-alternate-modifier) |
| edfda783 AR |
823 | |
| 824 | (defun ns-do-hide-emacs () | |
| 825 | (interactive) | |
| 826 | (ns-hide-emacs t)) | |
| 827 | ||
| c0642f6d GM |
828 | (declare-function ns-hide-others "nsfns.m" ()) |
| 829 | ||
| edfda783 AR |
830 | (defun ns-do-hide-others () |
| 831 | (interactive) | |
| 832 | (ns-hide-others)) | |
| 833 | ||
| c0642f6d GM |
834 | (declare-function ns-emacs-info-panel "nsfns.m" ()) |
| 835 | ||
| edfda783 AR |
836 | (defun ns-do-emacs-info-panel () |
| 837 | (interactive) | |
| 838 | (ns-emacs-info-panel)) | |
| 839 | ||
| 840 | (defun ns-next-frame () | |
| 841 | "Switch to next visible frame." | |
| 842 | (interactive) | |
| 843 | (other-frame 1)) | |
| 2b4e72e1 | 844 | |
| edfda783 AR |
845 | (defun ns-prev-frame () |
| 846 | "Switch to previous visible frame." | |
| 847 | (interactive) | |
| 848 | (other-frame -1)) | |
| 849 | ||
| ebe68042 | 850 | ;; If no position specified, make new frame offset by 25 from current. |
| e5744c66 | 851 | (defvar parameters) ; dynamically bound in make-frame |
| edfda783 | 852 | (add-hook 'before-make-frame-hook |
| ebe68042 SM |
853 | (lambda () |
| 854 | (let ((left (cdr (assq 'left (frame-parameters)))) | |
| 855 | (top (cdr (assq 'top (frame-parameters))))) | |
| 856 | (if (consp left) (setq left (cadr left))) | |
| 857 | (if (consp top) (setq top (cadr top))) | |
| 858 | (cond | |
| 859 | ((or (assq 'top parameters) (assq 'left parameters))) | |
| 860 | ((or (not left) (not top))) | |
| 861 | (t | |
| 862 | (setq parameters (cons (cons 'left (+ left 25)) | |
| 863 | (cons (cons 'top (+ top 25)) | |
| 864 | parameters)))))))) | |
| 865 | ||
| 866 | ;; frame will be focused anyway, so select it | |
| 55e8d9a5 | 867 | ;; (if this is not done, modeline is dimmed until first interaction) |
| edfda783 AR |
868 | (add-hook 'after-make-frame-functions 'select-frame) |
| 869 | ||
| f2d9c15f GM |
870 | (defvar tool-bar-mode) |
| 871 | (declare-function tool-bar-mode "tool-bar" (&optional arg)) | |
| 872 | ||
| edfda783 AR |
873 | ;; Based on a function by David Reitter <dreitter@inf.ed.ac.uk> ; |
| 874 | ;; see http://lists.gnu.org/archive/html/emacs-devel/2005-09/msg00681.html . | |
| 875 | (defun ns-toggle-toolbar (&optional frame) | |
| 876 | "Switches the tool bar on and off in frame FRAME. | |
| 877 | If FRAME is nil, the change applies to the selected frame." | |
| 878 | (interactive) | |
| ebe68042 SM |
879 | (modify-frame-parameters |
| 880 | frame (list (cons 'tool-bar-lines | |
| edfda783 AR |
881 | (if (> (or (frame-parameter frame 'tool-bar-lines) 0) 0) |
| 882 | 0 1)) )) | |
| 883 | (if (not tool-bar-mode) (tool-bar-mode t))) | |
| 884 | ||
| edfda783 AR |
885 | |
| 886 | ||
| 887 | ;;;; Dialog-related functions. | |
| 888 | ||
| 33b35792 | 889 | |
| edfda783 AR |
890 | ;; Ask user for confirm before printing. Due to Kevin Rodgers. |
| 891 | (defun ns-print-buffer () | |
| 892 | "Interactive front-end to `print-buffer': asks for user confirmation first." | |
| 893 | (interactive) | |
| 32226619 | 894 | (if (and (called-interactively-p 'interactive) |
| ebe68042 SM |
895 | (or (listp last-nonmenu-event) |
| 896 | (and (char-or-string-p (event-basic-type last-command-event)) | |
| 897 | (memq 'super (event-modifiers last-command-event))))) | |
| 898 | (let ((last-nonmenu-event (if (listp last-nonmenu-event) | |
| 899 | last-nonmenu-event | |
| 900 | ;; Fake it: | |
| 901 | `(mouse-1 POSITION 1)))) | |
| 902 | (if (y-or-n-p (format "Print buffer %s? " (buffer-name))) | |
| 903 | (print-buffer) | |
| edfda783 AR |
904 | (error "Cancelled"))) |
| 905 | (print-buffer))) | |
| 906 | ||
| edfda783 AR |
907 | |
| 908 | ;;;; Font support. | |
| 909 | ||
| edfda783 AR |
910 | ;; Needed for font listing functions under both backend and normal |
| 911 | (setq scalable-fonts-allowed t) | |
| 912 | ||
| 913 | ;; Set to use font panel instead | |
| 406aaa6f | 914 | (declare-function ns-popup-font-panel "nsfns.m" (&optional frame)) |
| 28571246 | 915 | (defalias 'x-select-font 'ns-popup-font-panel "Pop up the font panel. |
| 2b4e72e1 | 916 | This function has been overloaded in Nextstep.") |
| 4c785fa7 | 917 | (defalias 'mouse-set-font 'ns-popup-font-panel "Pop up the font panel. |
| 2b4e72e1 | 918 | This function has been overloaded in Nextstep.") |
| edfda783 | 919 | |
| c0642f6d GM |
920 | ;; nsterm.m |
| 921 | (defvar ns-input-font) | |
| 922 | (defvar ns-input-fontsize) | |
| 923 | ||
| edfda783 | 924 | (defun ns-respond-to-change-font () |
| 2b4e72e1 JB |
925 | "Respond to changeFont: event, expecting `ns-input-font' and\n\ |
| 926 | `ns-input-fontsize' of new font." | |
| edfda783 AR |
927 | (interactive) |
| 928 | (modify-frame-parameters (selected-frame) | |
| 929 | (list (cons 'font ns-input-font) | |
| 930 | (cons 'fontsize ns-input-fontsize))) | |
| 931 | (set-frame-font ns-input-font)) | |
| 932 | ||
| 933 | ||
| 934 | ;; Default fontset for Mac OS X. This is mainly here to show how a fontset | |
| 935 | ;; can be set up manually. Ordinarily, fontsets are auto-created whenever | |
| 2b4e72e1 | 936 | ;; a font is chosen by |
| edfda783 | 937 | (defvar ns-standard-fontset-spec |
| ebe68042 SM |
938 | ;; Only some code supports this so far, so use uglier XLFD version |
| 939 | ;; "-ns-*-*-*-*-*-10-*-*-*-*-*-fontset-standard,latin:Courier,han:Kai" | |
| 940 | (mapconcat 'identity | |
| 941 | '("-ns-*-*-*-*-*-10-*-*-*-*-*-fontset-standard" | |
| 942 | "latin:-*-Courier-*-*-*-*-10-*-*-*-*-*-iso10646-1" | |
| 943 | "han:-*-Kai-*-*-*-*-10-*-*-*-*-*-iso10646-1" | |
| 944 | "cyrillic:-*-Trebuchet$MS-*-*-*-*-10-*-*-*-*-*-iso10646-1") | |
| 945 | ",") | |
| 946 | "String of fontset spec of the standard fontset. | |
| edfda783 | 947 | This defines a fontset consisting of the Courier and other fonts that |
| 2b4e72e1 JB |
948 | come with OS X. |
| 949 | See the documentation of `create-fontset-from-fontset-spec' for the format.") | |
| edfda783 | 950 | |
| ebe68042 | 951 | ;; Conditional on new-fontset so bootstrapping works on non-GUI compiles. |
| edfda783 AR |
952 | (if (fboundp 'new-fontset) |
| 953 | (progn | |
| 954 | ;; Setup the default fontset. | |
| 2c035993 | 955 | (create-default-fontset) |
| edfda783 | 956 | ;; Create the standard fontset. |
| 2c035993 KH |
957 | (condition-case err |
| 958 | (create-fontset-from-fontset-spec ns-standard-fontset-spec t) | |
| 2b4e72e1 | 959 | (error (display-warning |
| 2c035993 KH |
960 | 'initialization |
| 961 | (format "Creation of the standard fontset failed: %s" err) | |
| 962 | :error))))) | |
| edfda783 | 963 | |
| 6125167c GM |
964 | (defvar ns-reg-to-script) ; nsfont.m |
| 965 | ||
| a3b4b363 AR |
966 | ;; This maps font registries (not exposed by NS APIs for font selection) to |
| 967 | ;; unicode scripts (which can be mapped to unicode character ranges which are). | |
| 968 | ;; See ../international/fontset.el | |
| 969 | (setq ns-reg-to-script | |
| 970 | '(("iso8859-1" . latin) | |
| 971 | ("iso8859-2" . latin) | |
| 972 | ("iso8859-3" . latin) | |
| 973 | ("iso8859-4" . latin) | |
| 974 | ("iso8859-5" . cyrillic) | |
| 975 | ("microsoft-cp1251" . cyrillic) | |
| 976 | ("koi8-r" . cyrillic) | |
| 977 | ("iso8859-6" . arabic) | |
| 978 | ("iso8859-7" . greek) | |
| 979 | ("iso8859-8" . hebrew) | |
| 980 | ("iso8859-9" . latin) | |
| 981 | ("iso8859-10" . latin) | |
| 982 | ("iso8859-11" . thai) | |
| 983 | ("tis620" . thai) | |
| 984 | ("iso8859-13" . latin) | |
| 985 | ("iso8859-14" . latin) | |
| 986 | ("iso8859-15" . latin) | |
| 987 | ("iso8859-16" . latin) | |
| 988 | ("viscii1.1-1" . latin) | |
| 989 | ("jisx0201" . kana) | |
| 990 | ("jisx0208" . han) | |
| 991 | ("jisx0212" . han) | |
| 992 | ("jisx0213" . han) | |
| 993 | ("gb2312.1980" . han) | |
| 994 | ("gb18030" . han) | |
| 995 | ("gbk-0" . han) | |
| 996 | ("big5" . han) | |
| 997 | ("cns11643" . han) | |
| 998 | ("sisheng_cwnn" . bopomofo) | |
| 999 | ("ksc5601.1987" . hangul) | |
| 1000 | ("ethiopic-unicode" . ethiopic) | |
| 1001 | ("is13194-devanagari" . indian-is13194) | |
| 1002 | ("iso10646.indian-1" . devanagari))) | |
| 1003 | ||
| edfda783 AR |
1004 | |
| 1005 | ;;;; Pasteboard support. | |
| 1006 | ||
| c0642f6d GM |
1007 | (declare-function ns-get-cut-buffer-internal "nsselect.m" (buffer)) |
| 1008 | ||
| edfda783 AR |
1009 | (defun ns-get-pasteboard () |
| 1010 | "Returns the value of the pasteboard." | |
| 1011 | (ns-get-cut-buffer-internal 'PRIMARY)) | |
| 1012 | ||
| c0642f6d GM |
1013 | (declare-function ns-store-cut-buffer-internal "nsselect.m" (buffer string)) |
| 1014 | ||
| edfda783 | 1015 | (defun ns-set-pasteboard (string) |
| a5a1b464 | 1016 | "Store STRING into the pasteboard of the Nextstep display server." |
| edfda783 AR |
1017 | ;; Check the data type of STRING. |
| 1018 | (if (not (stringp string)) (error "Nonstring given to pasteboard")) | |
| 1019 | (ns-store-cut-buffer-internal 'PRIMARY string)) | |
| 1020 | ||
| ebe68042 SM |
1021 | ;; We keep track of the last text selected here, so we can check the |
| 1022 | ;; current selection against it, and avoid passing back our own text | |
| 9e50ff0c | 1023 | ;; from x-cut-buffer-or-selection-value. |
| edfda783 AR |
1024 | (defvar ns-last-selected-text nil) |
| 1025 | ||
| 9e50ff0c | 1026 | (defun x-select-text (text &optional push) |
| 3077d1f6 EZ |
1027 | "Select TEXT, a string, according to the window system. |
| 1028 | ||
| 1029 | On X, put TEXT in the primary X selection. For backward | |
| 1030 | compatibility with older X applications, set the value of X cut | |
| 1031 | buffer 0 as well, and if the optional argument PUSH is non-nil, | |
| 1032 | rotate the cut buffers. If `x-select-enable-clipboard' is | |
| 1033 | non-nil, copy the text to the X clipboard as well. | |
| 1034 | ||
| 1035 | On Windows, make TEXT the current selection. If | |
| 1036 | `x-select-enable-clipboard' is non-nil, copy the text to the | |
| 1037 | clipboard as well. The argument PUSH is ignored. | |
| 1038 | ||
| 1039 | On Nextstep, put TEXT in the pasteboard; PUSH is ignored." | |
| edfda783 AR |
1040 | ;; Don't send the pasteboard too much text. |
| 1041 | ;; It becomes slow, and if really big it causes errors. | |
| 1042 | (ns-set-pasteboard text) | |
| 1043 | (setq ns-last-selected-text text)) | |
| 1044 | ||
| a5a1b464 CY |
1045 | ;; Return the value of the current Nextstep selection. For |
| 1046 | ;; compatibility with older Nextstep applications, this checks cut | |
| 1047 | ;; buffer 0 before retrieving the value of the primary selection. | |
| 9e50ff0c | 1048 | (defun x-cut-buffer-or-selection-value () |
| edfda783 | 1049 | (let (text) |
| d377ef4a | 1050 | |
| edfda783 AR |
1051 | ;; Consult the selection, then the cut buffer. Treat empty strings |
| 1052 | ;; as if they were unset. | |
| 1053 | (or text (setq text (ns-get-pasteboard))) | |
| 1054 | (if (string= text "") (setq text nil)) | |
| d377ef4a | 1055 | |
| edfda783 AR |
1056 | (cond |
| 1057 | ((not text) nil) | |
| 1058 | ((eq text ns-last-selected-text) nil) | |
| 1059 | ((string= text ns-last-selected-text) | |
| 1060 | ;; Record the newer string, so subsequent calls can use the `eq' test. | |
| 1061 | (setq ns-last-selected-text text) | |
| 1062 | nil) | |
| 1063 | (t | |
| 1064 | (setq ns-last-selected-text text))))) | |
| 1065 | ||
| 1066 | (defun ns-copy-including-secondary () | |
| 1067 | (interactive) | |
| 1068 | (call-interactively 'kill-ring-save) | |
| 1069 | (ns-store-cut-buffer-internal 'SECONDARY | |
| 1070 | (buffer-substring (point) (mark t)))) | |
| 1071 | (defun ns-paste-secondary () | |
| 1072 | (interactive) | |
| 1073 | (insert (ns-get-cut-buffer-internal 'SECONDARY))) | |
| 1074 | ||
| edfda783 AR |
1075 | |
| 1076 | ||
| 1077 | ;;;; Scrollbar handling. | |
| 1078 | ||
| 1079 | (global-set-key [vertical-scroll-bar down-mouse-1] 'ns-handle-scroll-bar-event) | |
| 1080 | (global-unset-key [vertical-scroll-bar mouse-1]) | |
| 1081 | (global-unset-key [vertical-scroll-bar drag-mouse-1]) | |
| 1082 | ||
| f2d9c15f GM |
1083 | (declare-function scroll-bar-scale "scroll-bar" (num-denom whole)) |
| 1084 | ||
| edfda783 | 1085 | (defun ns-scroll-bar-move (event) |
| 55e8d9a5 | 1086 | "Scroll the frame according to a Nextstep scroller event." |
| edfda783 AR |
1087 | (interactive "e") |
| 1088 | (let* ((pos (event-end event)) | |
| 1089 | (window (nth 0 pos)) | |
| 1090 | (scale (nth 2 pos))) | |
| 937e6a56 | 1091 | (with-current-buffer (window-buffer window) |
| edfda783 AR |
1092 | (cond |
| 1093 | ((eq (car scale) (cdr scale)) | |
| 1094 | (goto-char (point-max))) | |
| 1095 | ((= (car scale) 0) | |
| 1096 | (goto-char (point-min))) | |
| 1097 | (t | |
| 1098 | (goto-char (+ (point-min) 1 | |
| 1099 | (scroll-bar-scale scale (- (point-max) (point-min))))))) | |
| 1100 | (beginning-of-line) | |
| 1101 | (set-window-start window (point)) | |
| 1102 | (vertical-motion (/ (window-height window) 2) window)))) | |
| 1103 | ||
| 1104 | (defun ns-handle-scroll-bar-event (event) | |
| 55e8d9a5 | 1105 | "Handle scroll bar EVENT to emulate Nextstep style scrolling." |
| edfda783 AR |
1106 | (interactive "e") |
| 1107 | (let* ((position (event-start event)) | |
| 1108 | (bar-part (nth 4 position)) | |
| 1109 | (window (nth 0 position)) | |
| 1110 | (old-window (selected-window))) | |
| 1111 | (cond | |
| 1112 | ((eq bar-part 'ratio) | |
| 1113 | (ns-scroll-bar-move event)) | |
| 1114 | ((eq bar-part 'handle) | |
| 1115 | (if (eq window (selected-window)) | |
| 1116 | (track-mouse (ns-scroll-bar-move event)) | |
| ebe68042 | 1117 | ;; track-mouse faster for selected window, slower for unselected. |
| edfda783 AR |
1118 | (ns-scroll-bar-move event))) |
| 1119 | (t | |
| 1120 | (select-window window) | |
| 1121 | (cond | |
| 1122 | ((eq bar-part 'up) | |
| 1123 | (goto-char (window-start window)) | |
| 1124 | (scroll-down 1)) | |
| 1125 | ((eq bar-part 'above-handle) | |
| 1126 | (scroll-down)) | |
| 1127 | ((eq bar-part 'below-handle) | |
| 1128 | (scroll-up)) | |
| 1129 | ((eq bar-part 'down) | |
| 1130 | (goto-char (window-start window)) | |
| 1131 | (scroll-up 1))) | |
| 1132 | (select-window old-window))))) | |
| 1133 | ||
| 1134 | ||
| 1135 | ;;;; Color support. | |
| 1136 | ||
| c0642f6d GM |
1137 | (declare-function ns-list-colors "nsfns.m" (&optional frame)) |
| 1138 | ||
| edfda783 | 1139 | (defvar x-colors (ns-list-colors) |
| 3077d1f6 EZ |
1140 | "List of basic colors available on color displays. |
| 1141 | For X, the list comes from the `rgb.txt' file,v 10.41 94/02/20. | |
| 1142 | For Nextstep, this is a list of non-PANTONE colors returned by | |
| 1143 | the operating system.") | |
| edfda783 | 1144 | |
| 9e50ff0c | 1145 | (defun xw-defined-colors (&optional frame) |
| 3077d1f6 | 1146 | "Internal function called by `defined-colors'." |
| edfda783 AR |
1147 | (or frame (setq frame (selected-frame))) |
| 1148 | (let ((all-colors x-colors) | |
| 1149 | (this-color nil) | |
| 1150 | (defined-colors nil)) | |
| 1151 | (while all-colors | |
| 1152 | (setq this-color (car all-colors) | |
| 1153 | all-colors (cdr all-colors)) | |
| ebe68042 SM |
1154 | ;; (and (face-color-supported-p frame this-color t) |
| 1155 | (setq defined-colors (cons this-color defined-colors))) ;;) | |
| edfda783 | 1156 | defined-colors)) |
| edfda783 | 1157 | |
| edfda783 AR |
1158 | ;; Functions for color panel + drag |
| 1159 | (defun ns-face-at-pos (pos) | |
| 1160 | (let* ((frame (car pos)) | |
| 1161 | (frame-pos (cons (cadr pos) (cddr pos))) | |
| 1162 | (window (window-at (car frame-pos) (cdr frame-pos) frame)) | |
| 1163 | (window-pos (coordinates-in-window-p frame-pos window)) | |
| 1164 | (buffer (window-buffer window)) | |
| 1165 | (edges (window-edges window))) | |
| 1166 | (cond | |
| 1167 | ((not window-pos) | |
| 1168 | nil) | |
| 1169 | ((eq window-pos 'mode-line) | |
| 1170 | 'modeline) | |
| 1171 | ((eq window-pos 'vertical-line) | |
| 1172 | 'default) | |
| 1173 | ((consp window-pos) | |
| 937e6a56 | 1174 | (with-current-buffer buffer |
| edfda783 AR |
1175 | (let ((p (car (compute-motion (window-start window) |
| 1176 | (cons (nth 0 edges) (nth 1 edges)) | |
| 1177 | (window-end window) | |
| 1178 | frame-pos | |
| 1179 | (- (window-width window) 1) | |
| 1180 | nil | |
| 1181 | window)))) | |
| 1182 | (cond | |
| 1183 | ((eq p (window-point window)) | |
| 1184 | 'cursor) | |
| 1185 | ((and mark-active (< (region-beginning) p) (< p (region-end))) | |
| 1186 | 'region) | |
| 1187 | (t | |
| 1188 | (let ((faces (get-char-property p 'face window))) | |
| 1189 | (if (consp faces) (car faces) faces))))))) | |
| 1190 | (t | |
| 1191 | nil)))) | |
| 1192 | ||
| c0642f6d GM |
1193 | (defvar ns-input-color) ; nsterm.m |
| 1194 | ||
| edfda783 | 1195 | (defun ns-set-foreground-at-mouse () |
| 2b4e72e1 | 1196 | "Set the foreground color at the mouse location to `ns-input-color'." |
| edfda783 AR |
1197 | (interactive) |
| 1198 | (let* ((pos (mouse-position)) | |
| 1199 | (frame (car pos)) | |
| 1200 | (face (ns-face-at-pos pos))) | |
| 1201 | (cond | |
| 1202 | ((eq face 'cursor) | |
| c0642f6d | 1203 | (modify-frame-parameters frame (list (cons 'cursor-color |
| edfda783 AR |
1204 | ns-input-color)))) |
| 1205 | ((not face) | |
| 1206 | (modify-frame-parameters frame (list (cons 'foreground-color | |
| 1207 | ns-input-color)))) | |
| 1208 | (t | |
| 1209 | (set-face-foreground face ns-input-color frame))))) | |
| 1210 | ||
| 1211 | (defun ns-set-background-at-mouse () | |
| 2b4e72e1 | 1212 | "Set the background color at the mouse location to `ns-input-color'." |
| edfda783 AR |
1213 | (interactive) |
| 1214 | (let* ((pos (mouse-position)) | |
| 1215 | (frame (car pos)) | |
| 1216 | (face (ns-face-at-pos pos))) | |
| 1217 | (cond | |
| 1218 | ((eq face 'cursor) | |
| 1219 | (modify-frame-parameters frame (list (cons 'cursor-color | |
| 1220 | ns-input-color)))) | |
| 1221 | ((not face) | |
| 1222 | (modify-frame-parameters frame (list (cons 'background-color | |
| 1223 | ns-input-color)))) | |
| 1224 | (t | |
| 1225 | (set-face-background face ns-input-color frame))))) | |
| 1226 | ||
| a5a1b464 | 1227 | ;; Set some options to be as Nextstep-like as possible. |
| edfda783 AR |
1228 | (setq frame-title-format t |
| 1229 | icon-title-format t) | |
| 1230 | ||
| edfda783 AR |
1231 | |
| 1232 | (defvar ns-initialized nil | |
| a5a1b464 | 1233 | "Non-nil if Nextstep windowing has been initialized.") |
| edfda783 | 1234 | |
| c0642f6d | 1235 | (declare-function ns-list-services "nsfns.m" ()) |
| b51a3365 | 1236 | (declare-function x-open-connection "nsfns.m" |
| f2d9c15f | 1237 | (display &optional xrm-string must-succeed)) |
| c0642f6d | 1238 | |
| a5a1b464 CY |
1239 | ;; Do the actual Nextstep Windows setup here; the above code just |
| 1240 | ;; defines functions and variables that we use now. | |
| edfda783 | 1241 | (defun ns-initialize-window-system () |
| a5a1b464 | 1242 | "Initialize Emacs for Nextstep (Cocoa / GNUstep) windowing." |
| edfda783 | 1243 | |
| ebe68042 | 1244 | ;; PENDING: not needed? |
| edfda783 AR |
1245 | (setq command-line-args (ns-handle-args command-line-args)) |
| 1246 | ||
| 9e50ff0c | 1247 | (x-open-connection (system-name) nil t) |
| edfda783 | 1248 | |
| ebe68042 SM |
1249 | (dolist (service (ns-list-services)) |
| 1250 | (if (eq (car service) 'undefined) | |
| 1251 | (ns-define-service (cdr service)) | |
| 1252 | (define-key global-map (vector (car service)) | |
| 1253 | (ns-define-service (cdr service))))) | |
| edfda783 AR |
1254 | |
| 1255 | (if (and (eq (get-lisp-resource nil "NXAutoLaunch") t) | |
| 1256 | (eq (get-lisp-resource nil "HideOnAutoLaunch") t)) | |
| 1257 | (add-hook 'after-init-hook 'ns-do-hide-emacs)) | |
| 1258 | ||
| ebe68042 | 1259 | ;; FIXME: This will surely lead to "MODIFIED OUTSIDE CUSTOM" warnings. |
| edfda783 | 1260 | (menu-bar-mode (if (get-lisp-resource nil "Menus") 1 -1)) |
| edfda783 AR |
1261 | |
| 1262 | (setq ns-initialized t)) | |
| 1263 | ||
| 1264 | (add-to-list 'handle-args-function-alist '(ns . ns-handle-args)) | |
| 1265 | (add-to-list 'frame-creation-function-alist '(ns . x-create-frame-with-faces)) | |
| 1266 | (add-to-list 'window-system-initialization-alist '(ns . ns-initialize-window-system)) | |
| 1267 | ||
| 1268 | ||
| 1269 | (provide 'ns-win) | |
| 1270 | ||
| 0ae1e5e5 | 1271 | ;; arch-tag: eb138a45-4e2e-4d68-b1c9-a39665731644 |
| edfda783 | 1272 | ;;; ns-win.el ends here |