Commit | Line | Data |
---|---|---|
e95a67dc | 1 | ;;; ns-win.el --- lisp side of interface with NeXT/Open/GNUstep/MacOS X window system -*- lexical-binding: t -*- |
c0642f6d | 2 | |
ba318903 | 3 | ;; Copyright (C) 1993-1994, 2005-2014 Free Software Foundation, Inc. |
c0642f6d | 4 | |
c5220417 GM |
5 | ;; Authors: Carl Edman |
6 | ;; Christian Limpach | |
7 | ;; Scott Bender | |
8 | ;; Christophe de Dinechin | |
9 | ;; Adrian Robert | |
c0642f6d GM |
10 | ;; Keywords: terminals |
11 | ||
12 | ;; This file is part of GNU Emacs. | |
13 | ||
14 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
15 | ;; it under the terms of the GNU General Public License as published by | |
16 | ;; the Free Software Foundation, either version 3 of the License, or | |
17 | ;; (at your option) any later version. | |
18 | ||
19 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
20 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
21 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
22 | ;; GNU General Public License for more details. | |
23 | ||
24 | ;; You should have received a copy of the GNU General Public License | |
25 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
edfda783 AR |
26 | |
27 | ;;; Commentary: | |
28 | ||
a5a1b464 CY |
29 | ;; ns-win.el: this file is loaded from ../lisp/startup.el when it |
30 | ;; recognizes that Nextstep windows are to be used. Command line | |
31 | ;; switches are parsed and those pertaining to Nextstep are processed | |
32 | ;; and removed from the command line. The Nextstep display is opened | |
33 | ;; and hooks are set for popping up the initial window. | |
edfda783 AR |
34 | |
35 | ;; startup.el will then examine startup files, and eventually call the hooks | |
36 | ;; which create the first window (s). | |
37 | ||
a5a1b464 CY |
38 | ;; A number of other Nextstep convenience functions are defined in |
39 | ;; this file, which works in close coordination with src/nsfns.m. | |
edfda783 AR |
40 | |
41 | ;;; Code: | |
efc3dd3c | 42 | (eval-when-compile (require 'cl-lib)) |
725513b7 | 43 | (or (featurep 'ns) |
3dcdb6ea | 44 | (error "%s: Loading ns-win.el but not compiled for GNUstep/MacOS" |
725513b7 | 45 | (invocation-name))) |
ebe68042 | 46 | |
1bcc4637 | 47 | ;; Documentation-purposes only: actually loaded in loadup.el. |
edfda783 AR |
48 | (require 'frame) |
49 | (require 'mouse) | |
50 | (require 'faces) | |
edfda783 AR |
51 | (require 'menu-bar) |
52 | (require 'fontset) | |
1269a680 | 53 | (require 'dnd) |
edfda783 | 54 | |
20bc68dd GM |
55 | (defgroup ns nil |
56 | "GNUstep/Mac OS X specific features." | |
57 | :group 'environment) | |
58 | ||
edfda783 AR |
59 | ;;;; Command line argument handling. |
60 | ||
d7d8c62a | 61 | (defvar x-invocation-args) |
a2403e3d JB |
62 | ;; Set in term/common-win.el; currently unused by Nextstep's x-open-connection. |
63 | (defvar x-command-line-resources) | |
d377ef4a | 64 | |
c0642f6d GM |
65 | ;; nsterm.m. |
66 | (defvar ns-input-file) | |
67 | ||
e95a67dc | 68 | (defun ns-handle-nxopen (_switch &optional temp) |
1bcc4637 GM |
69 | (setq unread-command-events (append unread-command-events |
70 | (if temp '(ns-open-temp-file) | |
71 | '(ns-open-file))) | |
d7d8c62a | 72 | ns-input-file (append ns-input-file (list (pop x-invocation-args))))) |
edfda783 AR |
73 | |
74 | (defun ns-handle-nxopentemp (switch) | |
1bcc4637 | 75 | (ns-handle-nxopen switch t)) |
edfda783 | 76 | |
e95a67dc | 77 | (defun ns-ignore-1-arg (_switch) |
d7d8c62a | 78 | (setq x-invocation-args (cdr x-invocation-args))) |
edfda783 | 79 | |
489382c5 | 80 | (defun ns-parse-geometry (geom) |
ba0c843d | 81 | "Parse a Nextstep-style geometry string GEOM. |
edfda783 AR |
82 | Returns an alist of the form ((top . TOP), (left . LEFT) ... ). |
83 | The properties returned may include `top', `left', `height', and `width'." | |
a5a1b464 CY |
84 | (when (string-match "\\([0-9]+\\)\\( \\([0-9]+\\)\\( \\([0-9]+\\)\ |
85 | \\( \\([0-9]+\\) ?\\)?\\)?\\)?" | |
86 | geom) | |
87 | (apply | |
88 | 'append | |
89 | (list | |
90 | (list (cons 'top (string-to-number (match-string 1 geom)))) | |
91 | (if (match-string 3 geom) | |
92 | (list (cons 'left (string-to-number (match-string 3 geom))))) | |
93 | (if (match-string 5 geom) | |
94 | (list (cons 'height (string-to-number (match-string 5 geom))))) | |
95 | (if (match-string 7 geom) | |
96 | (list (cons 'width (string-to-number (match-string 7 geom))))))))) | |
edfda783 AR |
97 | |
98 | ;;;; Keyboard mapping. | |
99 | ||
725513b7 | 100 | (define-obsolete-variable-alias 'ns-alternatives-map 'x-alternatives-map "24.1") |
edfda783 | 101 | |
a5a1b464 | 102 | ;; Here are some Nextstep-like bindings for command key sequences. |
4c785fa7 | 103 | (define-key global-map [?\s-,] 'customize) |
edfda783 AR |
104 | (define-key global-map [?\s-'] 'next-multiframe-window) |
105 | (define-key global-map [?\s-`] 'other-frame) | |
79cb9c05 | 106 | (define-key global-map [?\s-~] 'ns-prev-frame) |
edfda783 AR |
107 | (define-key global-map [?\s--] 'center-line) |
108 | (define-key global-map [?\s-:] 'ispell) | |
edfda783 AR |
109 | (define-key global-map [?\s-?] 'info) |
110 | (define-key global-map [?\s-^] 'kill-some-buffers) | |
111 | (define-key global-map [?\s-&] 'kill-this-buffer) | |
112 | (define-key global-map [?\s-C] 'ns-popup-color-panel) | |
113 | (define-key global-map [?\s-D] 'dired) | |
114 | (define-key global-map [?\s-E] 'edit-abbrevs) | |
115 | (define-key global-map [?\s-L] 'shell-command) | |
116 | (define-key global-map [?\s-M] 'manual-entry) | |
117 | (define-key global-map [?\s-S] 'ns-write-file-using-panel) | |
118 | (define-key global-map [?\s-a] 'mark-whole-buffer) | |
119 | (define-key global-map [?\s-c] 'ns-copy-including-secondary) | |
120 | (define-key global-map [?\s-d] 'isearch-repeat-backward) | |
121 | (define-key global-map [?\s-e] 'isearch-yank-kill) | |
122 | (define-key global-map [?\s-f] 'isearch-forward) | |
123 | (define-key global-map [?\s-g] 'isearch-repeat-forward) | |
124 | (define-key global-map [?\s-h] 'ns-do-hide-emacs) | |
125 | (define-key global-map [?\s-H] 'ns-do-hide-others) | |
126 | (define-key global-map [?\s-j] 'exchange-point-and-mark) | |
127 | (define-key global-map [?\s-k] 'kill-this-buffer) | |
128 | (define-key global-map [?\s-l] 'goto-line) | |
129 | (define-key global-map [?\s-m] 'iconify-frame) | |
130 | (define-key global-map [?\s-n] 'make-frame) | |
131 | (define-key global-map [?\s-o] 'ns-open-file-using-panel) | |
132 | (define-key global-map [?\s-p] 'ns-print-buffer) | |
133 | (define-key global-map [?\s-q] 'save-buffers-kill-emacs) | |
134 | (define-key global-map [?\s-s] 'save-buffer) | |
135 | (define-key global-map [?\s-t] 'ns-popup-font-panel) | |
136 | (define-key global-map [?\s-u] 'revert-buffer) | |
137 | (define-key global-map [?\s-v] 'yank) | |
138 | (define-key global-map [?\s-w] 'delete-frame) | |
139 | (define-key global-map [?\s-x] 'kill-region) | |
140 | (define-key global-map [?\s-y] 'ns-paste-secondary) | |
141 | (define-key global-map [?\s-z] 'undo) | |
142 | (define-key global-map [?\s-|] 'shell-command-on-region) | |
143 | (define-key global-map [s-kp-bar] 'shell-command-on-region) | |
ebe68042 | 144 | ;; (as in Terminal.app) |
edfda783 AR |
145 | (define-key global-map [s-right] 'ns-next-frame) |
146 | (define-key global-map [s-left] 'ns-prev-frame) | |
147 | ||
148 | (define-key global-map [home] 'beginning-of-buffer) | |
149 | (define-key global-map [end] 'end-of-buffer) | |
150 | (define-key global-map [kp-home] 'beginning-of-buffer) | |
151 | (define-key global-map [kp-end] 'end-of-buffer) | |
ce3cefcc CY |
152 | (define-key global-map [kp-prior] 'scroll-down-command) |
153 | (define-key global-map [kp-next] 'scroll-up-command) | |
edfda783 | 154 | |
1bcc4637 | 155 | ;; Allow shift-clicks to work similarly to under Nextstep. |
55e8d9a5 AR |
156 | (define-key global-map [S-mouse-1] 'mouse-save-then-kill) |
157 | (global-unset-key [S-down-mouse-1]) | |
158 | ||
a5a1b464 | 159 | ;; Special Nextstep-generated events are converted to function keys. Here |
fc3eda04 AR |
160 | ;; are the bindings for them. Note, these keys are actually declared in |
161 | ;; x-setup-function-keys in common-win. | |
c6c62e78 | 162 | (define-key global-map [ns-power-off] 'save-buffers-kill-emacs) |
edfda783 AR |
163 | (define-key global-map [ns-open-file] 'ns-find-file) |
164 | (define-key global-map [ns-open-temp-file] [ns-open-file]) | |
edfda783 AR |
165 | (define-key global-map [ns-change-font] 'ns-respond-to-change-font) |
166 | (define-key global-map [ns-open-file-line] 'ns-open-file-select-line) | |
edfda783 | 167 | (define-key global-map [ns-spi-service-call] 'ns-spi-service-call) |
3e972d98 | 168 | (define-key global-map [ns-new-frame] 'make-frame) |
33b35792 | 169 | (define-key global-map [ns-toggle-toolbar] 'ns-toggle-toolbar) |
3e972d98 | 170 | (define-key global-map [ns-show-prefs] 'customize) |
edfda783 AR |
171 | |
172 | ||
2f93961f CY |
173 | ;; Set up a number of aliases and other layers to pretend we're using |
174 | ;; the Choi/Mitsuharu Carbon port. | |
175 | ||
176 | (defvaralias 'mac-allow-anti-aliasing 'ns-antialias-text) | |
177 | (defvaralias 'mac-command-modifier 'ns-command-modifier) | |
b7d1e144 | 178 | (defvaralias 'mac-right-command-modifier 'ns-right-command-modifier) |
2f93961f | 179 | (defvaralias 'mac-control-modifier 'ns-control-modifier) |
b7d1e144 | 180 | (defvaralias 'mac-right-control-modifier 'ns-right-control-modifier) |
2f93961f | 181 | (defvaralias 'mac-option-modifier 'ns-option-modifier) |
a2e35ef5 | 182 | (defvaralias 'mac-right-option-modifier 'ns-right-option-modifier) |
2f93961f | 183 | (defvaralias 'mac-function-modifier 'ns-function-modifier) |
406aaa6f | 184 | (declare-function ns-do-applescript "nsfns.m" (script)) |
583ff3c3 AR |
185 | (defalias 'do-applescript 'ns-do-applescript) |
186 | ||
edfda783 | 187 | ;;;; Services |
d377ef4a GM |
188 | (declare-function ns-perform-service "nsfns.m" (service send)) |
189 | ||
edfda783 AR |
190 | (defun ns-define-service (path) |
191 | (let ((mapping [menu-bar services]) | |
192 | (service (mapconcat 'identity path "/")) | |
193 | (name (intern | |
ebe68042 SM |
194 | (subst-char-in-string |
195 | ?\s ?- | |
196 | (mapconcat 'identity (cons "ns-service" path) "-"))))) | |
197 | ;; This defines the function. | |
198 | (defalias name | |
e95a67dc SM |
199 | (lambda (arg) |
200 | (interactive "p") | |
201 | (let* ((in-string | |
202 | (cond ((stringp arg) arg) | |
203 | (mark-active | |
204 | (buffer-substring (region-beginning) (region-end))))) | |
205 | (out-string (ns-perform-service service in-string))) | |
206 | (cond | |
207 | ((stringp arg) out-string) | |
208 | ((and out-string (or (not in-string) | |
209 | (not (string= in-string out-string)))) | |
210 | (if mark-active (delete-region (region-beginning) (region-end))) | |
211 | (insert out-string) | |
212 | (setq deactivate-mark nil)))))) | |
edfda783 AR |
213 | (cond |
214 | ((lookup-key global-map mapping) | |
215 | (while (cdr path) | |
216 | (setq mapping (vconcat mapping (list (intern (car path))))) | |
217 | (if (not (keymapp (lookup-key global-map mapping))) | |
218 | (define-key global-map mapping | |
219 | (cons (car path) (make-sparse-keymap (car path))))) | |
220 | (setq path (cdr path))) | |
221 | (setq mapping (vconcat mapping (list (intern (car path))))) | |
222 | (define-key global-map mapping (cons (car path) name)))) | |
223 | name)) | |
224 | ||
c0642f6d GM |
225 | ;; nsterm.m |
226 | (defvar ns-input-spi-name) | |
227 | (defvar ns-input-spi-arg) | |
228 | ||
f2d9c15f GM |
229 | (declare-function dnd-open-file "dnd" (uri action)) |
230 | ||
edfda783 | 231 | (defun ns-spi-service-call () |
82a330df | 232 | "Respond to a service request." |
edfda783 AR |
233 | (interactive) |
234 | (cond ((string-equal ns-input-spi-name "open-selection") | |
235 | (switch-to-buffer (generate-new-buffer "*untitled*")) | |
236 | (insert ns-input-spi-arg)) | |
237 | ((string-equal ns-input-spi-name "open-file") | |
238 | (dnd-open-file ns-input-spi-arg nil)) | |
239 | ((string-equal ns-input-spi-name "mail-selection") | |
240 | (compose-mail) | |
241 | (rfc822-goto-eoh) | |
242 | (forward-line 1) | |
243 | (insert ns-input-spi-arg)) | |
244 | ((string-equal ns-input-spi-name "mail-to") | |
245 | (compose-mail ns-input-spi-arg)) | |
246 | (t (error (concat "Service " ns-input-spi-name " not recognized"))))) | |
247 | ||
248 | ||
43c660bc SM |
249 | ;; Composed key sequence handling for Nextstep system input methods. |
250 | ;; (On Nextstep systems, input methods are provided for CJK | |
251 | ;; characters, etc. which require multiple keystrokes, and during | |
252 | ;; entry a partial ("working") result is typically shown in the | |
253 | ;; editing window.) | |
edfda783 AR |
254 | |
255 | (defface ns-working-text-face | |
256 | '((t :underline t)) | |
257 | "Face used to highlight working text during compose sequence insert." | |
258 | :group 'ns) | |
259 | ||
260 | (defvar ns-working-overlay nil | |
43c660bc SM |
261 | "Overlay used to highlight working text during compose sequence insert. |
262 | When text is in th echo area, this just stores the length of the working text.") | |
edfda783 | 263 | |
33b35792 AR |
264 | (defvar ns-working-text) ; nsterm.m |
265 | ||
266 | ;; Test if in echo area, based on mac-win.el 2007/08/26 unicode-2. | |
267 | ;; This will fail if called from a NONASCII_KEYSTROKE event on the global map. | |
edfda783 AR |
268 | (defun ns-in-echo-area () |
269 | "Whether, for purposes of inserting working composition text, the minibuffer | |
270 | is currently being used." | |
271 | (or isearch-mode | |
272 | (and cursor-in-echo-area (current-message)) | |
273 | ;; Overlay strings are not shown in some cases. | |
274 | (get-char-property (point) 'invisible) | |
275 | (and (not (bobp)) | |
276 | (or (and (get-char-property (point) 'display) | |
277 | (eq (get-char-property (1- (point)) 'display) | |
278 | (get-char-property (point) 'display))) | |
279 | (and (get-char-property (point) 'composition) | |
280 | (eq (get-char-property (1- (point)) 'composition) | |
281 | (get-char-property (point) 'composition))))))) | |
282 | ||
9d8f6d31 AR |
283 | ;; The 'interactive' here stays for subinvocations, so the ns-in-echo-area |
284 | ;; always returns nil for some reason. If this WASN'T the case, we could | |
285 | ;; map this to [ns-insert-working-text] and eliminate Fevals in nsterm.m. | |
33b35792 | 286 | ;; These functions test whether in echo area and delegate accordingly. |
9d8f6d31 | 287 | (defun ns-put-working-text () |
edfda783 | 288 | (interactive) |
9d8f6d31 | 289 | (if (ns-in-echo-area) (ns-echo-working-text) (ns-insert-working-text))) |
33b35792 AR |
290 | (defun ns-unput-working-text () |
291 | (interactive) | |
43c660bc | 292 | (ns-delete-working-text)) |
c0642f6d | 293 | |
9d8f6d31 | 294 | (defun ns-insert-working-text () |
2b4e72e1 | 295 | "Insert contents of `ns-working-text' as UTF-8 string and mark with |
43c660bc SM |
296 | `ns-working-overlay'. Any previously existing working text is cleared first. |
297 | The overlay is assigned the face `ns-working-text-face'." | |
298 | ;; FIXME: if buffer is read-only, don't try to insert anything | |
299 | ;; and if text is bound to a command, execute that instead (Bug#1453) | |
edfda783 | 300 | (interactive) |
43c660bc | 301 | (ns-delete-working-text) |
edfda783 AR |
302 | (let ((start (point))) |
303 | (insert ns-working-text) | |
304 | (overlay-put (setq ns-working-overlay (make-overlay start (point) | |
305 | (current-buffer) nil t)) | |
43c660bc | 306 | 'face 'ns-working-text-face))) |
edfda783 AR |
307 | |
308 | (defun ns-echo-working-text () | |
2b4e72e1 | 309 | "Echo contents of `ns-working-text' in message display area. |
43c660bc SM |
310 | See `ns-insert-working-text'." |
311 | (ns-delete-working-text) | |
edfda783 AR |
312 | (let* ((msg (current-message)) |
313 | (msglen (length msg)) | |
314 | message-log-max) | |
43c660bc | 315 | (setq ns-working-overlay (length ns-working-text)) |
edfda783 | 316 | (setq msg (concat msg ns-working-text)) |
43c660bc | 317 | (put-text-property msglen (+ msglen ns-working-overlay) |
08324aaa | 318 | 'face 'ns-working-text-face msg) |
43c660bc | 319 | (message "%s" msg))) |
edfda783 AR |
320 | |
321 | (defun ns-delete-working-text() | |
43c660bc | 322 | "Delete working text and clear `ns-working-overlay'." |
edfda783 | 323 | (interactive) |
43c660bc SM |
324 | (cond |
325 | ((and (overlayp ns-working-overlay) | |
326 | ;; Still alive? | |
327 | (overlay-buffer ns-working-overlay)) | |
328 | (with-current-buffer (overlay-buffer ns-working-overlay) | |
329 | (delete-region (overlay-start ns-working-overlay) | |
330 | (overlay-end ns-working-overlay)) | |
331 | (delete-overlay ns-working-overlay))) | |
332 | ((integerp ns-working-overlay) | |
333 | (let ((msg (current-message)) | |
334 | message-log-max) | |
335 | (setq msg (substring msg 0 (- (length msg) ns-working-overlay))) | |
336 | (message "%s" msg)))) | |
337 | (setq ns-working-overlay nil)) | |
edfda783 AR |
338 | |
339 | ||
c0642f6d GM |
340 | (declare-function ns-convert-utf8-nfd-to-nfc "nsfns.m" (str)) |
341 | ||
edfda783 AR |
342 | ;;;; OS X file system Unicode UTF-8 NFD (decomposed form) support |
343 | ;; Lisp code based on utf-8m.el, by Seiji Zenitani, Eiji Honjoh, and | |
344 | ;; Carsten Bormann. | |
e925113b GM |
345 | (when (eq system-type 'darwin) |
346 | (defun ns-utf8-nfd-post-read-conversion (length) | |
347 | "Calls `ns-convert-utf8-nfd-to-nfc' to compose char sequences." | |
348 | (save-excursion | |
349 | (save-restriction | |
350 | (narrow-to-region (point) (+ (point) length)) | |
351 | (let ((str (buffer-string))) | |
352 | (delete-region (point-min) (point-max)) | |
353 | (insert (ns-convert-utf8-nfd-to-nfc str)) | |
1bcc4637 | 354 | (- (point-max) (point-min)))))) |
e925113b GM |
355 | |
356 | (define-coding-system 'utf-8-nfd | |
357 | "UTF-8 NFD (decomposed) encoding." | |
358 | :coding-type 'utf-8 | |
359 | :mnemonic ?U | |
360 | :charset-list '(unicode) | |
361 | :post-read-conversion 'ns-utf8-nfd-post-read-conversion) | |
362 | (set-file-name-coding-system 'utf-8-nfd)) | |
edfda783 AR |
363 | |
364 | ;;;; Inter-app communications support. | |
365 | ||
edfda783 | 366 | (defun ns-insert-file () |
2b4e72e1 JB |
367 | "Insert contents of file `ns-input-file' like insert-file but with less |
368 | prompting. If file is a directory perform a `find-file' on it." | |
edfda783 | 369 | (interactive) |
c6efd3dd | 370 | (let ((f (pop ns-input-file))) |
edfda783 AR |
371 | (if (file-directory-p f) |
372 | (find-file f) | |
1bcc4637 | 373 | (push-mark (+ (point) (cadr (insert-file-contents f))))))) |
edfda783 AR |
374 | |
375 | (defvar ns-select-overlay nil | |
a5a1b464 | 376 | "Overlay used to highlight areas in files requested by Nextstep apps.") |
edfda783 AR |
377 | (make-variable-buffer-local 'ns-select-overlay) |
378 | ||
c0642f6d GM |
379 | (defvar ns-input-line) ; nsterm.m |
380 | ||
edfda783 | 381 | (defun ns-open-file-select-line () |
b90cc058 CY |
382 | "Open a buffer containing the file `ns-input-file'. |
383 | Lines are highlighted according to `ns-input-line'." | |
edfda783 AR |
384 | (interactive) |
385 | (ns-find-file) | |
386 | (cond | |
387 | ((and ns-input-line (buffer-modified-p)) | |
388 | (if ns-select-overlay | |
389 | (setq ns-select-overlay (delete-overlay ns-select-overlay))) | |
390 | (deactivate-mark) | |
5f68c1b7 GM |
391 | (goto-char (point-min)) |
392 | (forward-line (1- (if (consp ns-input-line) | |
393 | (min (car ns-input-line) (cdr ns-input-line)) | |
394 | ns-input-line)))) | |
edfda783 AR |
395 | (ns-input-line |
396 | (if (not ns-select-overlay) | |
d93e053b GM |
397 | (overlay-put (setq ns-select-overlay (make-overlay (point-min) |
398 | (point-min))) | |
edfda783 AR |
399 | 'face 'highlight)) |
400 | (let ((beg (save-excursion | |
d93e053b GM |
401 | (goto-char (point-min)) |
402 | (line-beginning-position | |
403 | (if (consp ns-input-line) | |
404 | (min (car ns-input-line) (cdr ns-input-line)) | |
405 | ns-input-line)))) | |
edfda783 | 406 | (end (save-excursion |
d93e053b GM |
407 | (goto-char (point-min)) |
408 | (line-beginning-position | |
409 | (1+ (if (consp ns-input-line) | |
410 | (max (car ns-input-line) (cdr ns-input-line)) | |
411 | ns-input-line)))))) | |
edfda783 AR |
412 | (move-overlay ns-select-overlay beg end) |
413 | (deactivate-mark) | |
414 | (goto-char beg))) | |
415 | (t | |
416 | (if ns-select-overlay | |
417 | (setq ns-select-overlay (delete-overlay ns-select-overlay)))))) | |
418 | ||
419 | (defun ns-unselect-line () | |
a5a1b464 | 420 | "Removes any Nextstep highlight a buffer may contain." |
edfda783 AR |
421 | (if ns-select-overlay |
422 | (setq ns-select-overlay (delete-overlay ns-select-overlay)))) | |
423 | ||
424 | (add-hook 'first-change-hook 'ns-unselect-line) | |
425 | ||
edfda783 | 426 | ;;;; Preferences handling. |
c0642f6d | 427 | (declare-function ns-get-resource "nsfns.m" (owner name)) |
edfda783 AR |
428 | |
429 | (defun get-lisp-resource (arg1 arg2) | |
430 | (let ((res (ns-get-resource arg1 arg2))) | |
431 | (cond | |
432 | ((not res) 'unbound) | |
433 | ((string-equal (upcase res) "YES") t) | |
434 | ((string-equal (upcase res) "NO") nil) | |
435 | (t (read res))))) | |
436 | ||
c0642f6d | 437 | ;; nsterm.m |
c6c62e78 | 438 | |
c0642f6d | 439 | (declare-function ns-read-file-name "nsfns.m" |
fcacb558 | 440 | (prompt &optional dir mustmatch init dir_only_p)) |
c0642f6d | 441 | |
edfda783 AR |
442 | ;;;; File handling. |
443 | ||
d7e642cc JD |
444 | (defun x-file-dialog (prompt dir default_filename mustmatch only_dir_p) |
445 | "Read file name, prompting with PROMPT in directory DIR. | |
446 | Use a file selection dialog. Select DEFAULT-FILENAME in the dialog's file | |
447 | selection box, if specified. If MUSTMATCH is non-nil, the returned file | |
448 | or directory must exist. | |
449 | ||
450 | This function is only defined on NS, MS Windows, and X Windows with the | |
451 | Motif or Gtk toolkits. With the Motif toolkit, ONLY-DIR-P is ignored. | |
452 | Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories." | |
453 | (ns-read-file-name prompt dir mustmatch default_filename only_dir_p)) | |
454 | ||
edfda783 AR |
455 | (defun ns-open-file-using-panel () |
456 | "Pop up open-file panel, and load the result in a buffer." | |
457 | (interactive) | |
ebe68042 | 458 | ;; Prompt dir defaultName isLoad initial. |
edfda783 AR |
459 | (setq ns-input-file (ns-read-file-name "Select File to Load" nil t nil)) |
460 | (if ns-input-file | |
461 | (and (setq ns-input-file (list ns-input-file)) (ns-find-file)))) | |
462 | ||
463 | (defun ns-write-file-using-panel () | |
464 | "Pop up save-file panel, and save buffer in resulting name." | |
465 | (interactive) | |
466 | (let (ns-output-file) | |
ebe68042 | 467 | ;; Prompt dir defaultName isLoad initial. |
edfda783 AR |
468 | (setq ns-output-file (ns-read-file-name "Save As" nil nil nil)) |
469 | (message ns-output-file) | |
470 | (if ns-output-file (write-file ns-output-file)))) | |
471 | ||
73f6360c GM |
472 | (defcustom ns-pop-up-frames 'fresh |
473 | "Non-nil means open files upon request from the Workspace in a new frame. | |
c0642f6d | 474 | If t, always do so. Any other non-nil value means open a new frame |
73f6360c GM |
475 | unless the current buffer is a scratch buffer." |
476 | :type '(choice (const :tag "Never" nil) | |
477 | (const :tag "Always" t) | |
478 | (other :tag "Except for scratch buffer" fresh)) | |
479 | :version "23.1" | |
480 | :group 'ns) | |
c0642f6d GM |
481 | |
482 | (declare-function ns-hide-emacs "nsfns.m" (on)) | |
483 | ||
edfda783 | 484 | (defun ns-find-file () |
2b4e72e1 | 485 | "Do a `find-file' with the `ns-input-file' as argument." |
edfda783 | 486 | (interactive) |
14beddf4 CY |
487 | (let* ((f (file-truename |
488 | (expand-file-name (pop ns-input-file) | |
489 | command-line-default-directory))) | |
c6efd3dd GM |
490 | (file (find-file-noselect f)) |
491 | (bufwin1 (get-buffer-window file 'visible)) | |
ee7683eb | 492 | (bufwin2 (get-buffer-window "*scratch*" 'visible))) |
edfda783 AR |
493 | (cond |
494 | (bufwin1 | |
495 | (select-frame (window-frame bufwin1)) | |
496 | (raise-frame (window-frame bufwin1)) | |
497 | (select-window bufwin1)) | |
498 | ((and (eq ns-pop-up-frames 'fresh) bufwin2) | |
499 | (ns-hide-emacs 'activate) | |
500 | (select-frame (window-frame bufwin2)) | |
501 | (raise-frame (window-frame bufwin2)) | |
502 | (select-window bufwin2) | |
503 | (find-file f)) | |
504 | (ns-pop-up-frames | |
505 | (ns-hide-emacs 'activate) | |
506 | (let ((pop-up-frames t)) (pop-to-buffer file nil))) | |
507 | (t | |
508 | (ns-hide-emacs 'activate) | |
509 | (find-file f))))) | |
510 | ||
1269a680 JD |
511 | |
512 | (defun ns-drag-n-drop (event &optional new-frame force-text) | |
513 | "Edit the files listed in the drag-n-drop EVENT. | |
514 | Switch to a buffer editing the last file dropped." | |
515 | (interactive "e") | |
516 | (let* ((window (posn-window (event-start event))) | |
517 | (arg (car (cdr (cdr event)))) | |
518 | (type (car arg)) | |
519 | (data (car (cdr arg))) | |
520 | (url-or-string (cond ((eq type 'file) | |
521 | (concat "file:" data)) | |
522 | (t data)))) | |
523 | (set-frame-selected-window nil window) | |
524 | (when new-frame | |
525 | (select-frame (make-frame))) | |
526 | (raise-frame) | |
527 | (setq window (selected-window)) | |
528 | (if force-text | |
529 | (dnd-insert-text window 'private data) | |
530 | (dnd-handle-one-url window 'private url-or-string)))) | |
531 | ||
532 | ||
533 | (defun ns-drag-n-drop-other-frame (event) | |
534 | "Edit the files listed in the drag-n-drop EVENT, in other frames. | |
535 | May create new frames, or reuse existing ones. The frame editing | |
536 | the last file dropped is selected." | |
537 | (interactive "e") | |
538 | (ns-drag-n-drop event t)) | |
539 | ||
540 | (defun ns-drag-n-drop-as-text (event) | |
541 | "Drop the data in EVENT as text." | |
542 | (interactive "e") | |
543 | (ns-drag-n-drop event nil t)) | |
544 | ||
545 | (defun ns-drag-n-drop-as-text-other-frame (event) | |
546 | "Drop the data in EVENT as text in a new frame." | |
547 | (interactive "e") | |
548 | (ns-drag-n-drop event t t)) | |
549 | ||
550 | (global-set-key [drag-n-drop] 'ns-drag-n-drop) | |
551 | (global-set-key [C-drag-n-drop] 'ns-drag-n-drop-other-frame) | |
552 | (global-set-key [M-drag-n-drop] 'ns-drag-n-drop-as-text) | |
553 | (global-set-key [C-M-drag-n-drop] 'ns-drag-n-drop-as-text-other-frame) | |
554 | ||
edfda783 AR |
555 | ;;;; Frame-related functions. |
556 | ||
e925113b GM |
557 | ;; nsterm.m |
558 | (defvar ns-alternate-modifier) | |
559 | (defvar ns-right-alternate-modifier) | |
b7d1e144 JD |
560 | (defvar ns-right-command-modifier) |
561 | (defvar ns-right-control-modifier) | |
e925113b | 562 | |
edfda783 AR |
563 | ;; You say tomAYto, I say tomAHto.. |
564 | (defvaralias 'ns-option-modifier 'ns-alternate-modifier) | |
a2e35ef5 | 565 | (defvaralias 'ns-right-option-modifier 'ns-right-alternate-modifier) |
edfda783 AR |
566 | |
567 | (defun ns-do-hide-emacs () | |
568 | (interactive) | |
569 | (ns-hide-emacs t)) | |
570 | ||
c0642f6d GM |
571 | (declare-function ns-hide-others "nsfns.m" ()) |
572 | ||
edfda783 AR |
573 | (defun ns-do-hide-others () |
574 | (interactive) | |
575 | (ns-hide-others)) | |
576 | ||
c0642f6d GM |
577 | (declare-function ns-emacs-info-panel "nsfns.m" ()) |
578 | ||
edfda783 AR |
579 | (defun ns-do-emacs-info-panel () |
580 | (interactive) | |
581 | (ns-emacs-info-panel)) | |
582 | ||
583 | (defun ns-next-frame () | |
584 | "Switch to next visible frame." | |
585 | (interactive) | |
586 | (other-frame 1)) | |
2b4e72e1 | 587 | |
edfda783 AR |
588 | (defun ns-prev-frame () |
589 | "Switch to previous visible frame." | |
590 | (interactive) | |
591 | (other-frame -1)) | |
592 | ||
379add74 | 593 | ;; Frame will be focused anyway, so select it |
37269466 | 594 | ;; (if this is not done, mode line is dimmed until first interaction) |
379add74 | 595 | ;; FIXME: Sounds like we're working around a bug in the underlying code. |
edfda783 AR |
596 | (add-hook 'after-make-frame-functions 'select-frame) |
597 | ||
f2d9c15f GM |
598 | (defvar tool-bar-mode) |
599 | (declare-function tool-bar-mode "tool-bar" (&optional arg)) | |
600 | ||
edfda783 AR |
601 | ;; Based on a function by David Reitter <dreitter@inf.ed.ac.uk> ; |
602 | ;; see http://lists.gnu.org/archive/html/emacs-devel/2005-09/msg00681.html . | |
603 | (defun ns-toggle-toolbar (&optional frame) | |
604 | "Switches the tool bar on and off in frame FRAME. | |
605 | If FRAME is nil, the change applies to the selected frame." | |
606 | (interactive) | |
ebe68042 SM |
607 | (modify-frame-parameters |
608 | frame (list (cons 'tool-bar-lines | |
edfda783 AR |
609 | (if (> (or (frame-parameter frame 'tool-bar-lines) 0) 0) |
610 | 0 1)) )) | |
611 | (if (not tool-bar-mode) (tool-bar-mode t))) | |
612 | ||
edfda783 | 613 | |
edfda783 AR |
614 | ;;;; Dialog-related functions. |
615 | ||
616 | ;; Ask user for confirm before printing. Due to Kevin Rodgers. | |
617 | (defun ns-print-buffer () | |
618 | "Interactive front-end to `print-buffer': asks for user confirmation first." | |
619 | (interactive) | |
32226619 | 620 | (if (and (called-interactively-p 'interactive) |
ebe68042 SM |
621 | (or (listp last-nonmenu-event) |
622 | (and (char-or-string-p (event-basic-type last-command-event)) | |
623 | (memq 'super (event-modifiers last-command-event))))) | |
624 | (let ((last-nonmenu-event (if (listp last-nonmenu-event) | |
625 | last-nonmenu-event | |
626 | ;; Fake it: | |
627 | `(mouse-1 POSITION 1)))) | |
628 | (if (y-or-n-p (format "Print buffer %s? " (buffer-name))) | |
629 | (print-buffer) | |
d5081c1e | 630 | (error "Canceled"))) |
edfda783 AR |
631 | (print-buffer))) |
632 | ||
edfda783 AR |
633 | ;;;; Font support. |
634 | ||
edfda783 AR |
635 | ;; Needed for font listing functions under both backend and normal |
636 | (setq scalable-fonts-allowed t) | |
637 | ||
638 | ;; Set to use font panel instead | |
406aaa6f | 639 | (declare-function ns-popup-font-panel "nsfns.m" (&optional frame)) |
28571246 | 640 | (defalias 'x-select-font 'ns-popup-font-panel "Pop up the font panel. |
2b4e72e1 | 641 | This function has been overloaded in Nextstep.") |
4c785fa7 | 642 | (defalias 'mouse-set-font 'ns-popup-font-panel "Pop up the font panel. |
2b4e72e1 | 643 | This function has been overloaded in Nextstep.") |
edfda783 | 644 | |
c0642f6d GM |
645 | ;; nsterm.m |
646 | (defvar ns-input-font) | |
647 | (defvar ns-input-fontsize) | |
648 | ||
edfda783 | 649 | (defun ns-respond-to-change-font () |
2b4e72e1 JB |
650 | "Respond to changeFont: event, expecting `ns-input-font' and\n\ |
651 | `ns-input-fontsize' of new font." | |
edfda783 AR |
652 | (interactive) |
653 | (modify-frame-parameters (selected-frame) | |
fcacb558 JD |
654 | (list (cons 'fontsize ns-input-fontsize))) |
655 | (modify-frame-parameters (selected-frame) | |
656 | (list (cons 'font ns-input-font))) | |
edfda783 AR |
657 | (set-frame-font ns-input-font)) |
658 | ||
659 | ||
660 | ;; Default fontset for Mac OS X. This is mainly here to show how a fontset | |
661 | ;; can be set up manually. Ordinarily, fontsets are auto-created whenever | |
2b4e72e1 | 662 | ;; a font is chosen by |
edfda783 | 663 | (defvar ns-standard-fontset-spec |
ebe68042 SM |
664 | ;; Only some code supports this so far, so use uglier XLFD version |
665 | ;; "-ns-*-*-*-*-*-10-*-*-*-*-*-fontset-standard,latin:Courier,han:Kai" | |
666 | (mapconcat 'identity | |
667 | '("-ns-*-*-*-*-*-10-*-*-*-*-*-fontset-standard" | |
668 | "latin:-*-Courier-*-*-*-*-10-*-*-*-*-*-iso10646-1" | |
669 | "han:-*-Kai-*-*-*-*-10-*-*-*-*-*-iso10646-1" | |
670 | "cyrillic:-*-Trebuchet$MS-*-*-*-*-10-*-*-*-*-*-iso10646-1") | |
671 | ",") | |
672 | "String of fontset spec of the standard fontset. | |
edfda783 | 673 | This defines a fontset consisting of the Courier and other fonts that |
2b4e72e1 JB |
674 | come with OS X. |
675 | See the documentation of `create-fontset-from-fontset-spec' for the format.") | |
edfda783 | 676 | |
6125167c GM |
677 | (defvar ns-reg-to-script) ; nsfont.m |
678 | ||
a3b4b363 | 679 | ;; This maps font registries (not exposed by NS APIs for font selection) to |
fe7a3057 | 680 | ;; Unicode scripts (which can be mapped to Unicode character ranges which are). |
a3b4b363 AR |
681 | ;; See ../international/fontset.el |
682 | (setq ns-reg-to-script | |
683 | '(("iso8859-1" . latin) | |
684 | ("iso8859-2" . latin) | |
685 | ("iso8859-3" . latin) | |
686 | ("iso8859-4" . latin) | |
687 | ("iso8859-5" . cyrillic) | |
688 | ("microsoft-cp1251" . cyrillic) | |
689 | ("koi8-r" . cyrillic) | |
690 | ("iso8859-6" . arabic) | |
691 | ("iso8859-7" . greek) | |
692 | ("iso8859-8" . hebrew) | |
693 | ("iso8859-9" . latin) | |
694 | ("iso8859-10" . latin) | |
695 | ("iso8859-11" . thai) | |
696 | ("tis620" . thai) | |
697 | ("iso8859-13" . latin) | |
698 | ("iso8859-14" . latin) | |
699 | ("iso8859-15" . latin) | |
700 | ("iso8859-16" . latin) | |
701 | ("viscii1.1-1" . latin) | |
702 | ("jisx0201" . kana) | |
703 | ("jisx0208" . han) | |
704 | ("jisx0212" . han) | |
705 | ("jisx0213" . han) | |
706 | ("gb2312.1980" . han) | |
707 | ("gb18030" . han) | |
708 | ("gbk-0" . han) | |
709 | ("big5" . han) | |
710 | ("cns11643" . han) | |
711 | ("sisheng_cwnn" . bopomofo) | |
712 | ("ksc5601.1987" . hangul) | |
713 | ("ethiopic-unicode" . ethiopic) | |
714 | ("is13194-devanagari" . indian-is13194) | |
715 | ("iso10646.indian-1" . devanagari))) | |
716 | ||
edfda783 AR |
717 | |
718 | ;;;; Pasteboard support. | |
719 | ||
c803b2b7 JD |
720 | (declare-function ns-get-selection-internal "nsselect.m" (buffer)) |
721 | (declare-function ns-store-selection-internal "nsselect.m" (buffer string)) | |
722 | ||
723 | (define-obsolete-function-alias 'ns-get-cut-buffer-internal | |
724 | 'ns-get-selection-internal "24.1") | |
725 | (define-obsolete-function-alias 'ns-store-cut-buffer-internal | |
726 | 'ns-store-selection-internal "24.1") | |
727 | ||
c0642f6d | 728 | |
edfda783 AR |
729 | (defun ns-get-pasteboard () |
730 | "Returns the value of the pasteboard." | |
c803b2b7 | 731 | (ns-get-selection-internal 'CLIPBOARD)) |
c0642f6d | 732 | |
edfda783 | 733 | (defun ns-set-pasteboard (string) |
a5a1b464 | 734 | "Store STRING into the pasteboard of the Nextstep display server." |
edfda783 AR |
735 | ;; Check the data type of STRING. |
736 | (if (not (stringp string)) (error "Nonstring given to pasteboard")) | |
c803b2b7 | 737 | (ns-store-selection-internal 'CLIPBOARD string)) |
edfda783 | 738 | |
ebe68042 SM |
739 | ;; We keep track of the last text selected here, so we can check the |
740 | ;; current selection against it, and avoid passing back our own text | |
6d7cc563 | 741 | ;; from x-selection-value. |
edfda783 AR |
742 | (defvar ns-last-selected-text nil) |
743 | ||
a5a1b464 CY |
744 | ;; Return the value of the current Nextstep selection. For |
745 | ;; compatibility with older Nextstep applications, this checks cut | |
746 | ;; buffer 0 before retrieving the value of the primary selection. | |
6d7cc563 | 747 | (defun x-selection-value () |
edfda783 | 748 | (let (text) |
45240125 | 749 | ;; Consult the selection. Treat empty strings as if they were unset. |
edfda783 AR |
750 | (or text (setq text (ns-get-pasteboard))) |
751 | (if (string= text "") (setq text nil)) | |
edfda783 AR |
752 | (cond |
753 | ((not text) nil) | |
754 | ((eq text ns-last-selected-text) nil) | |
755 | ((string= text ns-last-selected-text) | |
756 | ;; Record the newer string, so subsequent calls can use the `eq' test. | |
757 | (setq ns-last-selected-text text) | |
758 | nil) | |
759 | (t | |
760 | (setq ns-last-selected-text text))))) | |
761 | ||
762 | (defun ns-copy-including-secondary () | |
763 | (interactive) | |
764 | (call-interactively 'kill-ring-save) | |
c803b2b7 JD |
765 | (ns-store-selection-internal 'SECONDARY |
766 | (buffer-substring (point) (mark t)))) | |
edfda783 AR |
767 | (defun ns-paste-secondary () |
768 | (interactive) | |
c803b2b7 | 769 | (insert (ns-get-selection-internal 'SECONDARY))) |
edfda783 | 770 | |
edfda783 | 771 | |
edfda783 AR |
772 | ;;;; Scrollbar handling. |
773 | ||
774 | (global-set-key [vertical-scroll-bar down-mouse-1] 'ns-handle-scroll-bar-event) | |
775 | (global-unset-key [vertical-scroll-bar mouse-1]) | |
776 | (global-unset-key [vertical-scroll-bar drag-mouse-1]) | |
777 | ||
f2d9c15f GM |
778 | (declare-function scroll-bar-scale "scroll-bar" (num-denom whole)) |
779 | ||
edfda783 | 780 | (defun ns-scroll-bar-move (event) |
55e8d9a5 | 781 | "Scroll the frame according to a Nextstep scroller event." |
edfda783 AR |
782 | (interactive "e") |
783 | (let* ((pos (event-end event)) | |
784 | (window (nth 0 pos)) | |
785 | (scale (nth 2 pos))) | |
937e6a56 | 786 | (with-current-buffer (window-buffer window) |
edfda783 AR |
787 | (cond |
788 | ((eq (car scale) (cdr scale)) | |
789 | (goto-char (point-max))) | |
790 | ((= (car scale) 0) | |
791 | (goto-char (point-min))) | |
792 | (t | |
793 | (goto-char (+ (point-min) 1 | |
794 | (scroll-bar-scale scale (- (point-max) (point-min))))))) | |
795 | (beginning-of-line) | |
796 | (set-window-start window (point)) | |
797 | (vertical-motion (/ (window-height window) 2) window)))) | |
798 | ||
799 | (defun ns-handle-scroll-bar-event (event) | |
55e8d9a5 | 800 | "Handle scroll bar EVENT to emulate Nextstep style scrolling." |
edfda783 AR |
801 | (interactive "e") |
802 | (let* ((position (event-start event)) | |
803 | (bar-part (nth 4 position)) | |
804 | (window (nth 0 position)) | |
805 | (old-window (selected-window))) | |
806 | (cond | |
807 | ((eq bar-part 'ratio) | |
808 | (ns-scroll-bar-move event)) | |
809 | ((eq bar-part 'handle) | |
810 | (if (eq window (selected-window)) | |
811 | (track-mouse (ns-scroll-bar-move event)) | |
ebe68042 | 812 | ;; track-mouse faster for selected window, slower for unselected. |
edfda783 AR |
813 | (ns-scroll-bar-move event))) |
814 | (t | |
815 | (select-window window) | |
816 | (cond | |
817 | ((eq bar-part 'up) | |
818 | (goto-char (window-start window)) | |
819 | (scroll-down 1)) | |
820 | ((eq bar-part 'above-handle) | |
821 | (scroll-down)) | |
822 | ((eq bar-part 'below-handle) | |
823 | (scroll-up)) | |
824 | ((eq bar-part 'down) | |
825 | (goto-char (window-start window)) | |
826 | (scroll-up 1))) | |
827 | (select-window old-window))))) | |
828 | ||
829 | ||
830 | ;;;; Color support. | |
831 | ||
edfda783 AR |
832 | ;; Functions for color panel + drag |
833 | (defun ns-face-at-pos (pos) | |
834 | (let* ((frame (car pos)) | |
835 | (frame-pos (cons (cadr pos) (cddr pos))) | |
836 | (window (window-at (car frame-pos) (cdr frame-pos) frame)) | |
837 | (window-pos (coordinates-in-window-p frame-pos window)) | |
838 | (buffer (window-buffer window)) | |
839 | (edges (window-edges window))) | |
840 | (cond | |
841 | ((not window-pos) | |
842 | nil) | |
843 | ((eq window-pos 'mode-line) | |
37269466 | 844 | 'mode-line) |
edfda783 AR |
845 | ((eq window-pos 'vertical-line) |
846 | 'default) | |
847 | ((consp window-pos) | |
937e6a56 | 848 | (with-current-buffer buffer |
edfda783 AR |
849 | (let ((p (car (compute-motion (window-start window) |
850 | (cons (nth 0 edges) (nth 1 edges)) | |
851 | (window-end window) | |
852 | frame-pos | |
853 | (- (window-width window) 1) | |
854 | nil | |
855 | window)))) | |
856 | (cond | |
857 | ((eq p (window-point window)) | |
858 | 'cursor) | |
859 | ((and mark-active (< (region-beginning) p) (< p (region-end))) | |
860 | 'region) | |
861 | (t | |
862 | (let ((faces (get-char-property p 'face window))) | |
863 | (if (consp faces) (car faces) faces))))))) | |
864 | (t | |
865 | nil)))) | |
866 | ||
f0a10576 JD |
867 | (defun ns-suspend-error () |
868 | ;; Don't allow suspending if any of the frames are NS frames. | |
869 | (if (memq 'ns (mapcar 'window-system (frame-list))) | |
870 | (error "Cannot suspend Emacs while running under NS"))) | |
871 | ||
872 | ||
a5a1b464 | 873 | ;; Set some options to be as Nextstep-like as possible. |
edfda783 AR |
874 | (setq frame-title-format t |
875 | icon-title-format t) | |
876 | ||
edfda783 AR |
877 | |
878 | (defvar ns-initialized nil | |
a5a1b464 | 879 | "Non-nil if Nextstep windowing has been initialized.") |
edfda783 | 880 | |
f4a1d572 | 881 | (declare-function x-handle-args "common-win" (args)) |
c0642f6d | 882 | (declare-function ns-list-services "nsfns.m" ()) |
b51a3365 | 883 | (declare-function x-open-connection "nsfns.m" |
f2d9c15f | 884 | (display &optional xrm-string must-succeed)) |
cc232200 | 885 | (declare-function ns-set-resource "nsfns.m" (owner name value)) |
c0642f6d | 886 | |
a5a1b464 CY |
887 | ;; Do the actual Nextstep Windows setup here; the above code just |
888 | ;; defines functions and variables that we use now. | |
51646b62 | 889 | (defun ns-initialize-window-system (&optional _display) |
a5a1b464 | 890 | "Initialize Emacs for Nextstep (Cocoa / GNUstep) windowing." |
efc3dd3c | 891 | (cl-assert (not ns-initialized)) |
edfda783 | 892 | |
ebe68042 | 893 | ;; PENDING: not needed? |
d7d8c62a | 894 | (setq command-line-args (x-handle-args command-line-args)) |
edfda783 | 895 | |
c2350548 JD |
896 | ;; Setup the default fontset. |
897 | (create-default-fontset) | |
898 | ;; Create the standard fontset. | |
899 | (condition-case err | |
900 | (create-fontset-from-fontset-spec ns-standard-fontset-spec t) | |
901 | (error (display-warning | |
902 | 'initialization | |
903 | (format "Creation of the standard fontset failed: %s" err) | |
904 | :error))) | |
905 | ||
a2403e3d | 906 | (x-open-connection (system-name) x-command-line-resources t) |
edfda783 | 907 | |
a6c4680a | 908 | ;; Add GNUstep menu items Services, Hide and Quit. Rename Help to Info |
5f161884 | 909 | ;; and put it first (i.e. omit from menu-bar-final-items. |
aca5fcdc JD |
910 | (if (featurep 'gnustep) |
911 | (progn | |
912 | (setq menu-bar-final-items '(buffer services hide-app quit)) | |
5f161884 JD |
913 | |
914 | ;; If running under GNUstep, "Help" is moved and renamed "Info". | |
915 | (bindings--define-key global-map [menu-bar help-menu] | |
916 | (cons "Info" menu-bar-help-menu)) | |
aca5fcdc JD |
917 | (bindings--define-key global-map [menu-bar quit] |
918 | '(menu-item "Quit" save-buffers-kill-emacs | |
919 | :help "Save unsaved buffers, then exit")) | |
920 | (bindings--define-key global-map [menu-bar hide-app] | |
921 | '(menu-item "Hide" ns-do-hide-emacs | |
922 | :help "Hide Emacs")) | |
923 | (bindings--define-key global-map [menu-bar services] | |
924 | (cons "Services" (make-sparse-keymap "Services"))))) | |
925 | ||
926 | ||
ebe68042 SM |
927 | (dolist (service (ns-list-services)) |
928 | (if (eq (car service) 'undefined) | |
929 | (ns-define-service (cdr service)) | |
930 | (define-key global-map (vector (car service)) | |
931 | (ns-define-service (cdr service))))) | |
edfda783 AR |
932 | |
933 | (if (and (eq (get-lisp-resource nil "NXAutoLaunch") t) | |
934 | (eq (get-lisp-resource nil "HideOnAutoLaunch") t)) | |
935 | (add-hook 'after-init-hook 'ns-do-hide-emacs)) | |
936 | ||
ebe68042 | 937 | ;; FIXME: This will surely lead to "MODIFIED OUTSIDE CUSTOM" warnings. |
edfda783 | 938 | (menu-bar-mode (if (get-lisp-resource nil "Menus") 1 -1)) |
edfda783 | 939 | |
0daa0804 JD |
940 | ;; For Darwin nothing except UTF-8 makes sense. |
941 | (when (eq system-type 'darwin) | |
942 | (add-hook 'before-init-hook | |
943 | #'(lambda () | |
944 | (setq locale-coding-system 'utf-8-unix) | |
945 | (setq default-process-coding-system | |
946 | '(utf-8-unix . utf-8-unix))))) | |
832966e5 | 947 | |
cc232200 | 948 | ;; OS X Lion introduces PressAndHold, which is unsupported by this port. |
cd93b359 DR |
949 | ;; See this thread for more details: |
950 | ;; http://lists.gnu.org/archive/html/emacs-devel/2011-06/msg00505.html | |
951 | (ns-set-resource nil "ApplePressAndHoldEnabled" "NO") | |
952 | ||
15cd8efd | 953 | (x-apply-session-resources) |
f0a10576 JD |
954 | |
955 | ;; Don't let Emacs suspend under NS. | |
956 | (add-hook 'suspend-hook 'ns-suspend-error) | |
957 | ||
edfda783 AR |
958 | (setq ns-initialized t)) |
959 | ||
a3b49114 JD |
960 | ;; Any display name is OK. |
961 | (add-to-list 'display-format-alist '(".*" . ns)) | |
d7d8c62a | 962 | (add-to-list 'handle-args-function-alist '(ns . x-handle-args)) |
edfda783 AR |
963 | (add-to-list 'frame-creation-function-alist '(ns . x-create-frame-with-faces)) |
964 | (add-to-list 'window-system-initialization-alist '(ns . ns-initialize-window-system)) | |
965 | ||
966 | ||
967 | (provide 'ns-win) | |
968 | ||
969 | ;;; ns-win.el ends here |