Preserve text properties when saving primary selection.
[bpt/emacs.git] / src / nsfns.m
CommitLineData
edfda783 1/* Functions for the NeXT/Open/GNUstep and MacOSX window system.
e9bffc61 2
acaf905b 3Copyright (C) 1989, 1992-1994, 2005-2006, 2008-2012
95df8112 4 Free Software Foundation, Inc.
edfda783
AR
5
6This file is part of GNU Emacs.
7
32d235f8 8GNU Emacs is free software: you can redistribute it and/or modify
edfda783 9it under the terms of the GNU General Public License as published by
32d235f8
GM
10the Free Software Foundation, either version 3 of the License, or
11(at your option) any later version.
edfda783
AR
12
13GNU Emacs is distributed in the hope that it will be useful,
14but WITHOUT ANY WARRANTY; without even the implied warranty of
15MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16GNU General Public License for more details.
17
18You should have received a copy of the GNU General Public License
32d235f8 19along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
edfda783 20
32d235f8 21/*
edfda783
AR
22Originally by Carl Edman
23Updated by Christian Limpach (chris@nice.ch)
24OpenStep/Rhapsody port by Scott Bender (sbender@harmony-ds.com)
25MacOSX/Aqua port by Christophe de Dinechin (descubes@earthlink.net)
26GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu)
edfda783
AR
27*/
28
5a06864f
AR
29/* This should be the first include, as it may set up #defines affecting
30 interpretation of even the system includes. */
08a494a3 31#include <config.h>
5a06864f 32
edfda783
AR
33#include <signal.h>
34#include <math.h>
b024548b 35#include <setjmp.h>
fee5959d 36#include <c-strcase.h>
5a06864f 37
edfda783
AR
38#include "lisp.h"
39#include "blockinput.h"
40#include "nsterm.h"
41#include "window.h"
e5560ff7 42#include "character.h"
edfda783
AR
43#include "buffer.h"
44#include "keyboard.h"
45#include "termhooks.h"
46#include "fontset.h"
edfda783
AR
47#include "font.h"
48
49#if 0
50int fns_trace_num = 1;
51#define NSTRACE(x) fprintf (stderr, "%s:%d: [%d] " #x "\n", \
52 __FILE__, __LINE__, ++fns_trace_num)
53#else
54#define NSTRACE(x)
55#endif
56
57#ifdef HAVE_NS
58
59extern NSArray *ns_send_types, *ns_return_types, *ns_drag_types;
60
61extern Lisp_Object Qforeground_color;
62extern Lisp_Object Qbackground_color;
63extern Lisp_Object Qcursor_color;
64extern Lisp_Object Qinternal_border_width;
65extern Lisp_Object Qvisibility;
66extern Lisp_Object Qcursor_type;
67extern Lisp_Object Qicon_type;
68extern Lisp_Object Qicon_name;
69extern Lisp_Object Qicon_left;
70extern Lisp_Object Qicon_top;
71extern Lisp_Object Qleft;
72extern Lisp_Object Qright;
73extern Lisp_Object Qtop;
74extern Lisp_Object Qdisplay;
75extern Lisp_Object Qvertical_scroll_bars;
76extern Lisp_Object Qauto_raise;
77extern Lisp_Object Qauto_lower;
78extern Lisp_Object Qbox;
79extern Lisp_Object Qscroll_bar_width;
80extern Lisp_Object Qx_resource_name;
81extern Lisp_Object Qface_set_after_frame_default;
82extern Lisp_Object Qunderline, Qundefined;
83extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
84extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
7ffdf101 85extern Lisp_Object Qnone;
edfda783 86
5d1d3d04 87
edfda783
AR
88Lisp_Object Qbuffered;
89Lisp_Object Qfontsize;
90
91/* hack for OS X file panels */
92char panelOK = 0;
93
edfda783
AR
94EmacsTooltip *ns_tooltip;
95
96/* Need forward declaration here to preserve organizational integrity of file */
9e50ff0c 97Lisp_Object Fx_open_connection (Lisp_Object, Lisp_Object, Lisp_Object);
edfda783
AR
98
99extern BOOL ns_in_resize;
100
08e3161a
JD
101/* Static variables to handle applescript execution. */
102static Lisp_Object as_script, *as_result;
103static int as_status;
edfda783 104
ef884f23 105#ifdef GLYPH_DEBUG
a97f8f3f
JD
106static ptrdiff_t image_cache_refcount;
107#endif
108
edfda783
AR
109/* ==========================================================================
110
111 Internal utility functions
112
113 ========================================================================== */
114
115
116void
117check_ns (void)
118{
119 if (NSApp == nil)
120 error ("OpenStep is not in use or not initialized");
121}
122
123
124/* Nonzero if we can use mouse menus. */
125int
3d608a86 126have_menus_p (void)
edfda783
AR
127{
128 return NSApp != nil;
129}
130
131
132/* Extract a frame as a FRAME_PTR, defaulting to the selected frame
133 and checking validity for NS. */
134static FRAME_PTR
135check_ns_frame (Lisp_Object frame)
136{
137 FRAME_PTR f;
138
139 if (NILP (frame))
140 f = SELECTED_FRAME ();
141 else
142 {
143 CHECK_LIVE_FRAME (frame);
144 f = XFRAME (frame);
145 }
146 if (! FRAME_NS_P (f))
d26fbe1a 147 error ("non-Nextstep frame used");
edfda783
AR
148 return f;
149}
150
151
d26fbe1a
CY
152/* Let the user specify an Nextstep display with a frame.
153 nil stands for the selected frame--or, if that is not an Nextstep frame,
154 the first Nextstep display on the list. */
edfda783
AR
155static struct ns_display_info *
156check_ns_display_info (Lisp_Object frame)
157{
158 if (NILP (frame))
159 {
160 struct frame *f = SELECTED_FRAME ();
161 if (FRAME_NS_P (f) && FRAME_LIVE_P (f) )
162 return FRAME_NS_DISPLAY_INFO (f);
9e50ff0c
DN
163 else if (x_display_list != 0)
164 return x_display_list;
edfda783 165 else
d26fbe1a 166 error ("Nextstep windows are not in use or not initialized");
edfda783
AR
167 }
168 else if (INTEGERP (frame))
169 {
170 struct terminal *t = get_terminal (frame, 1);
171
172 if (t->type != output_ns)
d311d28c 173 error ("Terminal %"pI"d is not a Nextstep display", XINT (frame));
edfda783
AR
174
175 return t->display_info.ns;
176 }
177 else if (STRINGP (frame))
178 return ns_display_info_for_name (frame);
179 else
180 {
181 FRAME_PTR f;
182
183 CHECK_LIVE_FRAME (frame);
184 f = XFRAME (frame);
185 if (! FRAME_NS_P (f))
d26fbe1a 186 error ("non-Nextstep frame used");
edfda783
AR
187 return FRAME_NS_DISPLAY_INFO (f);
188 }
189 return NULL; /* shut compiler up */
190}
191
192
193static id
194ns_get_window (Lisp_Object maybeFrame)
195{
196 id view =nil, window =nil;
197
198 if (!FRAMEP (maybeFrame) || !FRAME_NS_P (XFRAME (maybeFrame)))
199 maybeFrame = selected_frame;/*wrong_type_argument (Qframep, maybeFrame); */
200
201 if (!NILP (maybeFrame))
202 view = FRAME_NS_VIEW (XFRAME (maybeFrame));
203 if (view) window =[view window];
204
205 return window;
206}
207
208
209static NSScreen *
5996e1b7 210ns_get_screen (Lisp_Object screen)
edfda783 211{
474217c8
CY
212 struct frame *f;
213 struct terminal *terminal;
214
215 if (EQ (Qt, screen)) /* not documented */
216 return [NSScreen mainScreen];
217
218 terminal = get_terminal (screen, 1);
5996e1b7 219 if (terminal->type != output_ns)
474217c8
CY
220 return NULL;
221
222 if (NILP (screen))
223 f = SELECTED_FRAME ();
224 else if (FRAMEP (screen))
225 f = XFRAME (screen);
5996e1b7 226 else
edfda783 227 {
5996e1b7 228 struct ns_display_info *dpyinfo = terminal->display_info.ns;
5d1d3d04
J
229 f = dpyinfo->x_focus_frame
230 ? dpyinfo->x_focus_frame : dpyinfo->x_highlight_frame;
edfda783 231 }
474217c8
CY
232
233 return ((f && FRAME_NS_P (f)) ? [[FRAME_NS_VIEW (f) window] screen]
234 : NULL);
edfda783
AR
235}
236
237
238/* Return the X display structure for the display named NAME.
239 Open a new connection if necessary. */
240struct ns_display_info *
3d608a86 241ns_display_info_for_name (Lisp_Object name)
edfda783
AR
242{
243 Lisp_Object names;
244 struct ns_display_info *dpyinfo;
245
246 CHECK_STRING (name);
247
9e50ff0c 248 for (dpyinfo = x_display_list, names = ns_display_name_list;
edfda783
AR
249 dpyinfo;
250 dpyinfo = dpyinfo->next, names = XCDR (names))
251 {
252 Lisp_Object tem;
253 tem = Fstring_equal (XCAR (XCAR (names)), name);
254 if (!NILP (tem))
255 return dpyinfo;
256 }
257
258 error ("Emacs for OpenStep does not yet support multi-display.");
259
9e50ff0c
DN
260 Fx_open_connection (name, Qnil, Qnil);
261 dpyinfo = x_display_list;
edfda783
AR
262
263 if (dpyinfo == 0)
facfbbbd 264 error ("OpenStep on %s not responding.\n", SDATA (name));
edfda783
AR
265
266 return dpyinfo;
267}
268
269
270static Lisp_Object
271interpret_services_menu (NSMenu *menu, Lisp_Object prefix, Lisp_Object old)
272/* --------------------------------------------------------------------------
273 Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
274 -------------------------------------------------------------------------- */
275{
276 int i, count;
15034960 277 NSMenuItem *item;
edfda783
AR
278 const char *name;
279 Lisp_Object nameStr;
280 unsigned short key;
281 NSString *keys;
282 Lisp_Object res;
283
284 count = [menu numberOfItems];
285 for (i = 0; i<count; i++)
286 {
287 item = [menu itemAtIndex: i];
288 name = [[item title] UTF8String];
289 if (!name) continue;
290
291 nameStr = build_string (name);
292
293 if ([item hasSubmenu])
294 {
295 old = interpret_services_menu ([item submenu],
296 Fcons (nameStr, prefix), old);
297 }
298 else
299 {
300 keys = [item keyEquivalent];
301 if (keys && [keys length] )
302 {
303 key = [keys characterAtIndex: 0];
304 res = make_number (key|super_modifier);
305 }
306 else
307 {
308 res = Qundefined;
309 }
310 old = Fcons (Fcons (res,
311 Freverse (Fcons (nameStr,
312 prefix))),
313 old);
314 }
315 }
316 return old;
317}
318
319
320
321/* ==========================================================================
322
323 Frame parameter setters
324
325 ========================================================================== */
326
327
328static void
89e2438a 329x_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
edfda783
AR
330{
331 NSColor *col;
d8c2fa78 332 CGFloat r, g, b, alpha;
edfda783
AR
333
334 if (ns_lisp_to_color (arg, &col))
335 {
336 store_frame_param (f, Qforeground_color, oldval);
337 error ("Unknown color");
338 }
339
340 [col retain];
341 [f->output_data.ns->foreground_color release];
342 f->output_data.ns->foreground_color = col;
343
d8c2fa78
AA
344 [col getRed: &r green: &g blue: &b alpha: &alpha];
345 FRAME_FOREGROUND_PIXEL (f) =
346 ARGB_TO_ULONG ((int)(alpha*0xff), (int)(r*0xff), (int)(g*0xff), (int)(b*0xff));
347
edfda783
AR
348 if (FRAME_NS_VIEW (f))
349 {
350 update_face_from_frame_parameter (f, Qforeground_color, arg);
351 /*recompute_basic_faces (f); */
352 if (FRAME_VISIBLE_P (f))
353 redraw_frame (f);
354 }
355}
356
357
358static void
89e2438a 359x_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
edfda783
AR
360{
361 struct face *face;
362 NSColor *col;
363 NSView *view = FRAME_NS_VIEW (f);
d8c2fa78 364 CGFloat r, g, b, alpha;
edfda783
AR
365
366 if (ns_lisp_to_color (arg, &col))
367 {
368 store_frame_param (f, Qbackground_color, oldval);
369 error ("Unknown color");
370 }
371
372 /* clear the frame; in some instances the NS-internal GC appears not to
373 update, or it does update and cannot clear old text properly */
374 if (FRAME_VISIBLE_P (f))
375 ns_clear_frame (f);
376
377 [col retain];
378 [f->output_data.ns->background_color release];
379 f->output_data.ns->background_color = col;
d8c2fa78
AA
380
381 [col getRed: &r green: &g blue: &b alpha: &alpha];
382 FRAME_BACKGROUND_PIXEL (f) =
383 ARGB_TO_ULONG ((int)(alpha*0xff), (int)(r*0xff), (int)(g*0xff), (int)(b*0xff));
384
edfda783
AR
385 if (view != nil)
386 {
387 [[view window] setBackgroundColor: col];
edfda783 388
edfda783
AR
389 if (alpha != 1.0)
390 [[view window] setOpaque: NO];
391 else
392 [[view window] setOpaque: YES];
393
394 face = FRAME_DEFAULT_FACE (f);
395 if (face)
396 {
45d325c4 397 col = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f);
204ee57f
JD
398 face->background = ns_index_color
399 ([col colorWithAlphaComponent: alpha], f);
edfda783
AR
400
401 update_face_from_frame_parameter (f, Qbackground_color, arg);
402 }
403
404 if (FRAME_VISIBLE_P (f))
405 redraw_frame (f);
406 }
407}
408
409
410static void
89e2438a 411x_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
edfda783
AR
412{
413 NSColor *col;
414
415 if (ns_lisp_to_color (arg, &col))
416 {
417 store_frame_param (f, Qcursor_color, oldval);
418 error ("Unknown color");
419 }
420
c8c057de
AR
421 [FRAME_CURSOR_COLOR (f) release];
422 FRAME_CURSOR_COLOR (f) = [col retain];
edfda783
AR
423
424 if (FRAME_VISIBLE_P (f))
425 {
426 x_update_cursor (f, 0);
427 x_update_cursor (f, 1);
428 }
429 update_face_from_frame_parameter (f, Qcursor_color, arg);
430}
431
c8c057de 432
edfda783 433static void
89e2438a 434x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
edfda783
AR
435{
436 NSView *view = FRAME_NS_VIEW (f);
89e2438a 437 NSTRACE (x_set_icon_name);
edfda783
AR
438
439 if (ns_in_resize)
440 return;
441
442 /* see if it's changed */
443 if (STRINGP (arg))
444 {
445 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
446 return;
447 }
448 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
449 return;
450
edd74c35 451 FSET (f, icon_name, arg);
edfda783
AR
452
453 if (NILP (arg))
454 {
edd74c35
DA
455 if (!NILP (FGET (f, title)))
456 arg = FGET (f, title);
edfda783
AR
457 else
458 /* explicit name and no icon-name -> explicit_name */
459 if (f->explicit_name)
edd74c35 460 arg = FGET (f, name);
edfda783
AR
461 else
462 {
463 /* no explicit name and no icon-name ->
464 name has to be rebuild from icon_title_format */
465 windows_or_buffers_changed++;
466 return;
467 }
468 }
469
470 /* Don't change the name if it's already NAME. */
471 if ([[view window] miniwindowTitle] &&
472 ([[[view window] miniwindowTitle]
473 isEqualToString: [NSString stringWithUTF8String:
0dc8cf50 474 SSDATA (arg)]]))
edfda783
AR
475 return;
476
477 [[view window] setMiniwindowTitle:
0dc8cf50 478 [NSString stringWithUTF8String: SSDATA (arg)]];
edfda783
AR
479}
480
edfda783 481static void
5bbb4727 482ns_set_name_internal (FRAME_PTR f, Lisp_Object name)
edfda783 483{
5bbb4727
JD
484 struct gcpro gcpro1;
485 Lisp_Object encoded_name, encoded_icon_name;
486 NSString *str;
edfda783 487 NSView *view = FRAME_NS_VIEW (f);
edfda783 488
5bbb4727
JD
489 GCPRO1 (name);
490 encoded_name = ENCODE_UTF_8 (name);
491 UNGCPRO;
edfda783 492
0dc8cf50 493 str = [NSString stringWithUTF8String: SSDATA (encoded_name)];
edfda783 494
5bbb4727
JD
495 /* Don't change the name if it's already NAME. */
496 if (! [[[view window] title] isEqualToString: str])
497 [[view window] setTitle: str];
edfda783 498
edd74c35 499 if (!STRINGP (FGET (f, icon_name)))
5bbb4727 500 encoded_icon_name = encoded_name;
edfda783 501 else
edd74c35 502 encoded_icon_name = ENCODE_UTF_8 (FGET (f, icon_name));
5bbb4727 503
0dc8cf50 504 str = [NSString stringWithUTF8String: SSDATA (encoded_icon_name)];
edfda783 505
edfda783 506 if ([[view window] miniwindowTitle] &&
5bbb4727
JD
507 ! [[[view window] miniwindowTitle] isEqualToString: str])
508 [[view window] setMiniwindowTitle: str];
edfda783 509
edfda783
AR
510}
511
edfda783
AR
512static void
513ns_set_name (struct frame *f, Lisp_Object name, int explicit)
514{
edfda783
AR
515 NSTRACE (ns_set_name);
516
517 if (ns_in_resize)
518 return;
519
520 /* Make sure that requests from lisp code override requests from
521 Emacs redisplay code. */
522 if (explicit)
523 {
524 /* If we're switching from explicit to implicit, we had better
525 update the mode lines and thereby update the title. */
526 if (f->explicit_name && NILP (name))
527 update_mode_lines = 1;
528
529 f->explicit_name = ! NILP (name);
530 }
531 else if (f->explicit_name)
532 return;
533
534 if (NILP (name))
56d513e6 535 name = build_string([ns_app_name UTF8String]);
5bbb4727
JD
536 else
537 CHECK_STRING (name);
538
539 /* Don't change the name if it's already NAME. */
edd74c35 540 if (! NILP (Fstring_equal (name, FGET (f, name))))
5bbb4727 541 return;
edfda783 542
edd74c35 543 FSET (f, name, name);
edfda783
AR
544
545 /* title overrides explicit name */
edd74c35
DA
546 if (! NILP (FGET (f, title)))
547 name = FGET (f, title);
edfda783 548
5bbb4727 549 ns_set_name_internal (f, name);
edfda783
AR
550}
551
552
553/* This function should be called when the user's lisp code has
554 specified a name for the frame; the name will override any set by the
555 redisplay code. */
556static void
89e2438a 557x_explicitly_set_name (FRAME_PTR f, Lisp_Object arg, Lisp_Object oldval)
edfda783 558{
89e2438a 559 NSTRACE (x_explicitly_set_name);
edfda783
AR
560 ns_set_name (f, arg, 1);
561}
562
563
564/* This function should be called by Emacs redisplay code to set the
565 name; names set this way will never override names set by the user's
566 lisp code. */
567void
568x_implicitly_set_name (FRAME_PTR f, Lisp_Object arg, Lisp_Object oldval)
569{
570 NSTRACE (x_implicitly_set_name);
5bbb4727
JD
571
572 /* Deal with NS specific format t. */
573 if (FRAME_NS_P (f) && ((FRAME_ICONIFIED_P (f) && EQ (Vicon_title_format, Qt))
574 || EQ (Vframe_title_format, Qt)))
9ae6e189 575 ns_set_name_as_filename (f);
edfda783
AR
576 else
577 ns_set_name (f, arg, 0);
578}
579
580
581/* Change the title of frame F to NAME.
5bbb4727 582 If NAME is nil, use the frame name as the title. */
edfda783 583
edfda783 584static void
89e2438a 585x_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name)
edfda783 586{
89e2438a 587 NSTRACE (x_set_title);
edfda783 588 /* Don't change the title if it's already NAME. */
edd74c35 589 if (EQ (name, FGET (f, title)))
edfda783
AR
590 return;
591
592 update_mode_lines = 1;
593
edd74c35 594 FSET (f, title, name);
5bbb4727
JD
595
596 if (NILP (name))
edd74c35 597 name = FGET (f, name);
5bbb4727
JD
598 else
599 CHECK_STRING (name);
600
601 ns_set_name_internal (f, name);
edfda783
AR
602}
603
604
605void
606ns_set_name_as_filename (struct frame *f)
607{
fec8f0fe 608 NSView *view;
aeb7e951 609 Lisp_Object name, filename;
077288cf 610 Lisp_Object buf = WGET (XWINDOW (FGET (f, selected_window)), buffer);
edfda783
AR
611 const char *title;
612 NSAutoreleasePool *pool;
5bbb4727 613 struct gcpro gcpro1;
aeb7e951
JD
614 Lisp_Object encoded_name, encoded_filename;
615 NSString *str;
edfda783
AR
616 NSTRACE (ns_set_name_as_filename);
617
edd74c35 618 if (f->explicit_name || ! NILP (FGET (f, title)) || ns_in_resize)
edfda783
AR
619 return;
620
621 BLOCK_INPUT;
622 pool = [[NSAutoreleasePool alloc] init];
124c9ff0
JD
623 filename = BVAR (XBUFFER (buf), filename);
624 name = BVAR (XBUFFER (buf), name);
edfda783
AR
625
626 if (NILP (name))
aeb7e951
JD
627 {
628 if (! NILP (filename))
629 name = Ffile_name_nondirectory (filename);
630 else
631 name = build_string ([ns_app_name UTF8String]);
632 }
edfda783 633
5bbb4727
JD
634 GCPRO1 (name);
635 encoded_name = ENCODE_UTF_8 (name);
636 UNGCPRO;
637
fec8f0fe
CY
638 view = FRAME_NS_VIEW (f);
639
edfda783
AR
640 title = FRAME_ICONIFIED_P (f) ? [[[view window] miniwindowTitle] UTF8String]
641 : [[[view window] title] UTF8String];
642
0dc8cf50 643 if (title && (! strcmp (title, SSDATA (encoded_name))))
edfda783
AR
644 {
645 [pool release];
646 UNBLOCK_INPUT;
647 return;
648 }
649
0dc8cf50 650 str = [NSString stringWithUTF8String: SSDATA (encoded_name)];
aeb7e951
JD
651 if (str == nil) str = @"Bad coding";
652
653 if (FRAME_ICONIFIED_P (f))
654 [[view window] setMiniwindowTitle: str];
5fdb398c 655 else
edfda783 656 {
aeb7e951
JD
657 NSString *fstr;
658
659 if (! NILP (filename))
edfda783 660 {
aeb7e951
JD
661 GCPRO1 (filename);
662 encoded_filename = ENCODE_UTF_8 (filename);
663 UNGCPRO;
664
0dc8cf50 665 fstr = [NSString stringWithUTF8String: SSDATA (encoded_filename)];
aeb7e951
JD
666 if (fstr == nil) fstr = @"";
667#ifdef NS_IMPL_COCOA
668 /* work around a bug observed on 10.3 and later where
669 setTitleWithRepresentedFilename does not clear out previous state
670 if given filename does not exist */
671 if (! [[NSFileManager defaultManager] fileExistsAtPath: fstr])
672 [[view window] setRepresentedFilename: @""];
673#endif
edfda783
AR
674 }
675 else
aeb7e951
JD
676 fstr = @"";
677
678 [[view window] setRepresentedFilename: fstr];
679 [[view window] setTitle: str];
edd74c35 680 FSET (f, name, name);
edfda783 681 }
aeb7e951 682
edfda783
AR
683 [pool release];
684 UNBLOCK_INPUT;
685}
686
687
688void
6521c534 689ns_set_doc_edited (struct frame *f, Lisp_Object arg)
edfda783
AR
690{
691 NSView *view = FRAME_NS_VIEW (f);
692 NSAutoreleasePool *pool;
edd74c35 693 if (!MINI_WINDOW_P (XWINDOW (FGET (f, selected_window))))
9ae6e189
CY
694 {
695 BLOCK_INPUT;
696 pool = [[NSAutoreleasePool alloc] init];
697 [[view window] setDocumentEdited: !NILP (arg)];
698 [pool release];
699 UNBLOCK_INPUT;
700 }
edfda783
AR
701}
702
703
cc98b6a0
DN
704void
705x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
edfda783
AR
706{
707 int nlines;
edfda783
AR
708 if (FRAME_MINIBUF_ONLY_P (f))
709 return;
710
d311d28c 711 if (TYPE_RANGED_INTEGERP (int, value))
edfda783
AR
712 nlines = XINT (value);
713 else
714 nlines = 0;
715
716 FRAME_MENU_BAR_LINES (f) = 0;
717 if (nlines)
718 {
719 FRAME_EXTERNAL_MENU_BAR (f) = 1;
cc98b6a0
DN
720 /* does for all frames, whereas we just want for one frame
721 [NSMenu setMenuBarVisible: YES]; */
edfda783
AR
722 }
723 else
724 {
725 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
726 free_frame_menubar (f);
cc98b6a0 727 /* [NSMenu setMenuBarVisible: NO]; */
edfda783
AR
728 FRAME_EXTERNAL_MENU_BAR (f) = 0;
729 }
730}
731
732
3fe53a83 733/* toolbar support */
cc98b6a0
DN
734void
735x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
edfda783
AR
736{
737 int nlines;
edfda783
AR
738
739 if (FRAME_MINIBUF_ONLY_P (f))
740 return;
741
d311d28c 742 if (RANGED_INTEGERP (0, value, INT_MAX))
edfda783
AR
743 nlines = XFASTINT (value);
744 else
745 nlines = 0;
746
747 if (nlines)
748 {
749 FRAME_EXTERNAL_TOOL_BAR (f) = 1;
750 update_frame_tool_bar (f);
751 }
752 else
753 {
754 if (FRAME_EXTERNAL_TOOL_BAR (f))
755 {
756 free_frame_tool_bar (f);
757 FRAME_EXTERNAL_TOOL_BAR (f) = 0;
758 }
759 }
760
761 x_set_window_size (f, 0, f->text_cols, f->text_lines);
762}
763
764
edfda783
AR
765void
766ns_implicitly_set_icon_type (struct frame *f)
767{
768 Lisp_Object tem;
769 EmacsView *view = FRAME_NS_VIEW (f);
204ee57f 770 id image = nil;
edfda783
AR
771 Lisp_Object chain, elt;
772 NSAutoreleasePool *pool;
773 BOOL setMini = YES;
774
775 NSTRACE (ns_implicitly_set_icon_type);
776
777 BLOCK_INPUT;
778 pool = [[NSAutoreleasePool alloc] init];
779 if (f->output_data.ns->miniimage
edd74c35 780 && [[NSString stringWithUTF8String: SSDATA (FGET (f, name))]
edfda783
AR
781 isEqualToString: [(NSImage *)f->output_data.ns->miniimage name]])
782 {
783 [pool release];
784 UNBLOCK_INPUT;
785 return;
786 }
787
edd74c35 788 tem = assq_no_quit (Qicon_type, FGET (f, param_alist));
edfda783
AR
789 if (CONSP (tem) && ! NILP (XCDR (tem)))
790 {
791 [pool release];
792 UNBLOCK_INPUT;
793 return;
794 }
795
796 for (chain = Vns_icon_type_alist;
204ee57f 797 image == nil && CONSP (chain);
edfda783
AR
798 chain = XCDR (chain))
799 {
800 elt = XCAR (chain);
801 /* special case: 't' means go by file type */
edd74c35 802 if (SYMBOLP (elt) && EQ (elt, Qt) && SSDATA (FGET (f, name))[0] == '/')
edfda783 803 {
facfbbbd 804 NSString *str
edd74c35 805 = [NSString stringWithUTF8String: SSDATA (FGET (f, name))];
edfda783
AR
806 if ([[NSFileManager defaultManager] fileExistsAtPath: str])
807 image = [[[NSWorkspace sharedWorkspace] iconForFile: str] retain];
808 }
809 else if (CONSP (elt) &&
810 STRINGP (XCAR (elt)) &&
811 STRINGP (XCDR (elt)) &&
edd74c35 812 fast_string_match (XCAR (elt), FGET (f, name)) >= 0)
edfda783
AR
813 {
814 image = [EmacsImage allocInitFromFile: XCDR (elt)];
815 if (image == nil)
816 image = [[NSImage imageNamed:
817 [NSString stringWithUTF8String:
0dc8cf50 818 SSDATA (XCDR (elt))]] retain];
edfda783
AR
819 }
820 }
821
822 if (image == nil)
823 {
824 image = [[[NSWorkspace sharedWorkspace] iconForFileType: @"text"] retain];
825 setMini = NO;
826 }
827
828 [f->output_data.ns->miniimage release];
829 f->output_data.ns->miniimage = image;
830 [view setMiniwindowImage: setMini];
831 [pool release];
832 UNBLOCK_INPUT;
833}
834
835
836static void
89e2438a 837x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
edfda783
AR
838{
839 EmacsView *view = FRAME_NS_VIEW (f);
840 id image = nil;
841 BOOL setMini = YES;
842
89e2438a 843 NSTRACE (x_set_icon_type);
edfda783
AR
844
845 if (!NILP (arg) && SYMBOLP (arg))
846 {
0dc8cf50 847 arg =build_string (SSDATA (SYMBOL_NAME (arg)));
edfda783
AR
848 store_frame_param (f, Qicon_type, arg);
849 }
850
851 /* do it the implicit way */
852 if (NILP (arg))
853 {
854 ns_implicitly_set_icon_type (f);
855 return;
856 }
857
858 CHECK_STRING (arg);
859
860 image = [EmacsImage allocInitFromFile: arg];
861 if (image == nil)
862 image =[NSImage imageNamed: [NSString stringWithUTF8String:
0dc8cf50 863 SSDATA (arg)]];
edfda783
AR
864
865 if (image == nil)
866 {
867 image = [NSImage imageNamed: @"text"];
868 setMini = NO;
869 }
870
871 f->output_data.ns->miniimage = image;
872 [view setMiniwindowImage: setMini];
873}
874
875
3fe53a83 876/* Xism; we stub out (we do implement this in ns-win.el) */
edfda783
AR
877int
878XParseGeometry (char *string, int *x, int *y,
879 unsigned int *width, unsigned int *height)
880{
881 message1 ("Warning: XParseGeometry not supported under NS.\n");
882 return 0;
883}
884
885
6fb5f7da 886/* TODO: move to nsterm? */
edfda783
AR
887int
888ns_lisp_to_cursor_type (Lisp_Object arg)
889{
890 char *str;
891 if (XTYPE (arg) == Lisp_String)
0dc8cf50 892 str = SSDATA (arg);
edfda783 893 else if (XTYPE (arg) == Lisp_Symbol)
0dc8cf50 894 str = SSDATA (SYMBOL_NAME (arg));
edfda783 895 else return -1;
c8c057de
AR
896 if (!strcmp (str, "box")) return FILLED_BOX_CURSOR;
897 if (!strcmp (str, "hollow")) return HOLLOW_BOX_CURSOR;
898 if (!strcmp (str, "hbar")) return HBAR_CURSOR;
899 if (!strcmp (str, "bar")) return BAR_CURSOR;
900 if (!strcmp (str, "no")) return NO_CURSOR;
edfda783
AR
901 return -1;
902}
903
904
905Lisp_Object
906ns_cursor_type_to_lisp (int arg)
907{
908 switch (arg)
909 {
c8c057de
AR
910 case FILLED_BOX_CURSOR: return Qbox;
911 case HOLLOW_BOX_CURSOR: return intern ("hollow");
912 case HBAR_CURSOR: return intern ("hbar");
913 case BAR_CURSOR: return intern ("bar");
914 case NO_CURSOR:
915 default: return intern ("no");
edfda783
AR
916 }
917}
918
89e2438a 919/* This is the same as the xfns.c definition. */
06197b17 920void
3d608a86 921x_set_cursor_type (FRAME_PTR f, Lisp_Object arg, Lisp_Object oldval)
edfda783 922{
06197b17 923 set_frame_cursor_types (f, arg);
edfda783 924
06197b17
DR
925 /* Make sure the cursor gets redrawn. */
926 cursor_type_changed = 1;
edfda783 927}
06197b17 928\f
edfda783 929
3fe53a83
AR
930/* called to set mouse pointer color, but all other terms use it to
931 initialize pointer types (and don't set the color ;) */
edfda783 932static void
89e2438a 933x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
edfda783 934{
d26fbe1a 935 /* don't think we can do this on Nextstep */
edfda783
AR
936}
937
938
cb83c00b
AR
939#define Str(x) #x
940#define Xstr(x) Str(x)
941
942static Lisp_Object
3d608a86 943ns_appkit_version_str (void)
cb83c00b
AR
944{
945 char tmp[80];
946
947#ifdef NS_IMPL_GNUSTEP
948 sprintf(tmp, "gnustep-gui-%s", Xstr(GNUSTEP_GUI_VERSION));
949#elif defined(NS_IMPL_COCOA)
950 sprintf(tmp, "apple-appkit-%.2f", NSAppKitVersionNumber);
951#else
952 tmp = "ns-unknown";
953#endif
954 return build_string (tmp);
955}
956
957
f5497e45
AR
958/* This is for use by x-server-version and collapses all version info we
959 have into a single int. For a better picture of the implementation
960 running, use ns_appkit_version_str.*/
961static int
3d608a86 962ns_appkit_version_int (void)
f5497e45
AR
963{
964#ifdef NS_IMPL_GNUSTEP
13cd8a29 965 return GNUSTEP_GUI_MAJOR_VERSION * 100 + GNUSTEP_GUI_MINOR_VERSION;
f5497e45
AR
966#elif defined(NS_IMPL_COCOA)
967 return (int)NSAppKitVersionNumber;
968#endif
969 return 0;
970}
971
972
edfda783 973static void
952913d4 974x_icon (struct frame *f, Lisp_Object parms)
edfda783
AR
975/* --------------------------------------------------------------------------
976 Strangely-named function to set icon position parameters in frame.
977 This is irrelevant under OS X, but might be needed under GNUstep,
978 depending on the window manager used. Note, this is not a standard
979 frame parameter-setter; it is called directly from x-create-frame.
980 -------------------------------------------------------------------------- */
981{
982 Lisp_Object icon_x, icon_y;
983 struct ns_display_info *dpyinfo = check_ns_display_info (Qnil);
984
985 f->output_data.ns->icon_top = Qnil;
986 f->output_data.ns->icon_left = Qnil;
987
988 /* Set the position of the icon. */
989 icon_x = x_get_arg (dpyinfo, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
990 icon_y = x_get_arg (dpyinfo, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
991 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
992 {
993 CHECK_NUMBER (icon_x);
994 CHECK_NUMBER (icon_y);
995 f->output_data.ns->icon_top = icon_y;
996 f->output_data.ns->icon_left = icon_x;
997 }
998 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
999 error ("Both left and top icon corners of icon must be specified");
1000}
1001
1002
3fe53a83 1003/* Note: see frame.c for template, also where generic functions are impl */
edfda783
AR
1004frame_parm_handler ns_frame_parm_handlers[] =
1005{
1006 x_set_autoraise, /* generic OK */
1007 x_set_autolower, /* generic OK */
89e2438a 1008 x_set_background_color,
d26fbe1a
CY
1009 0, /* x_set_border_color, may be impossible under Nextstep */
1010 0, /* x_set_border_width, may be impossible under Nextstep */
89e2438a
DN
1011 x_set_cursor_color,
1012 x_set_cursor_type,
edfda783 1013 x_set_font, /* generic OK */
89e2438a
DN
1014 x_set_foreground_color,
1015 x_set_icon_name,
1016 x_set_icon_type,
edfda783 1017 x_set_internal_border_width, /* generic OK */
cc98b6a0 1018 x_set_menu_bar_lines,
89e2438a
DN
1019 x_set_mouse_color,
1020 x_explicitly_set_name,
edfda783 1021 x_set_scroll_bar_width, /* generic OK */
89e2438a 1022 x_set_title,
edfda783
AR
1023 x_set_unsplittable, /* generic OK */
1024 x_set_vertical_scroll_bars, /* generic OK */
1025 x_set_visibility, /* generic OK */
cc98b6a0 1026 x_set_tool_bar_lines,
edfda783
AR
1027 0, /* x_set_scroll_bar_foreground, will ignore (not possible on NS) */
1028 0, /* x_set_scroll_bar_background, will ignore (not possible on NS) */
1029 x_set_screen_gamma, /* generic OK */
1030 x_set_line_spacing, /* generic OK, sets f->extra_line_spacing to int */
1031 x_set_fringe_width, /* generic OK */
1032 x_set_fringe_width, /* generic OK */
1033 0, /* x_set_wait_for_wm, will ignore */
1034 0, /* x_set_fullscreen will ignore */
dee721c0 1035 x_set_font_backend, /* generic OK */
cad9ef74 1036 x_set_alpha,
5fdb398c
PE
1037 0, /* x_set_sticky */
1038 0, /* x_set_tool_bar_position */
edfda783
AR
1039};
1040
1041
a97f8f3f
JD
1042/* Handler for signals raised during x_create_frame.
1043 FRAME is the frame which is partially constructed. */
1044
1045static Lisp_Object
1046unwind_create_frame (Lisp_Object frame)
1047{
1048 struct frame *f = XFRAME (frame);
1049
1050 /* If frame is already dead, nothing to do. This can happen if the
1051 display is disconnected after the frame has become official, but
1052 before x_create_frame removes the unwind protect. */
1053 if (!FRAME_LIVE_P (f))
1054 return Qnil;
1055
1056 /* If frame is ``official'', nothing to do. */
97f18cc8 1057 if (NILP (Fmemq (frame, Vframe_list)))
a97f8f3f 1058 {
ef884f23 1059#if defined GLYPH_DEBUG && defined ENABLE_CHECKING
a97f8f3f
JD
1060 struct ns_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
1061#endif
1062
1063 x_free_frame_resources (f);
1064 free_glyphs (f);
1065
ef884f23 1066#ifdef GLYPH_DEBUG
a97f8f3f 1067 /* Check that reference counts are indeed correct. */
ef884f23 1068 eassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount);
a97f8f3f
JD
1069#endif
1070 return Qt;
1071 }
1072
1073 return Qnil;
1074}
1075
a0c3fad0
JD
1076/*
1077 * Read geometry related parameters from preferences if not in PARMS.
1078 * Returns the union of parms and any preferences read.
1079 */
a97f8f3f 1080
a0c3fad0
JD
1081static Lisp_Object
1082get_geometry_from_preferences (struct ns_display_info *dpyinfo,
1083 Lisp_Object parms)
1084{
1085 struct {
1086 const char *val;
1087 const char *cls;
1088 Lisp_Object tem;
1089 } r[] = {
1090 { "width", "Width", Qwidth },
1091 { "height", "Height", Qheight },
1092 { "left", "Left", Qleft },
1093 { "top", "Top", Qtop },
1094 };
1095
1096 int i;
1097 for (i = 0; i < sizeof (r)/sizeof (r[0]); ++i)
1098 {
1099 if (NILP (Fassq (r[i].tem, parms)))
1100 {
1101 Lisp_Object value
1102 = x_get_arg (dpyinfo, parms, r[i].tem, r[i].val, r[i].cls,
1103 RES_TYPE_NUMBER);
1104 if (! EQ (value, Qunbound))
1105 parms = Fcons (Fcons (r[i].tem, value), parms);
1106 }
1107 }
a97f8f3f 1108
a0c3fad0
JD
1109 return parms;
1110}
cb83c00b
AR
1111
1112/* ==========================================================================
1113
1114 Lisp definitions
1115
1116 ========================================================================== */
1117
9e50ff0c 1118DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
edfda783 1119 1, 1, 0,
a97f8f3f 1120 doc: /* Make a new Nextstep window, called a "frame" in Emacs terms.
d26fbe1a
CY
1121Return an Emacs frame object.
1122PARMS is an alist of frame parameters.
1123If the parameters specify that the frame should not have a minibuffer,
1124and do not specify a specific minibuffer window to use,
1125then `default-minibuffer-frame' must be a frame whose minibuffer can
a97f8f3f
JD
1126be shared by the new frame.
1127
1128This function is an internal primitive--use `make-frame' instead. */)
5842a27b 1129 (Lisp_Object parms)
edfda783 1130{
edfda783 1131 struct frame *f;
edfda783
AR
1132 Lisp_Object frame, tem;
1133 Lisp_Object name;
1134 int minibuffer_only = 0;
a97f8f3f
JD
1135 int window_prompting = 0;
1136 int width, height;
d311d28c 1137 ptrdiff_t count = specpdl_ptr - specpdl;
a97f8f3f 1138 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
edfda783
AR
1139 Lisp_Object display;
1140 struct ns_display_info *dpyinfo = NULL;
1141 Lisp_Object parent;
1142 struct kboard *kb;
1143 Lisp_Object tfont, tfontsize;
a97f8f3f 1144 static int desc_ctr = 1;
edfda783
AR
1145
1146 check_ns ();
1147
a97f8f3f 1148 /* x_get_arg modifies parms. */
bd6ce2ba
AR
1149 parms = Fcopy_alist (parms);
1150
a97f8f3f
JD
1151 /* Use this general default value to start with
1152 until we know if this frame has a specified name. */
1153 Vx_resource_name = Vinvocation_name;
1154
edfda783
AR
1155 display = x_get_arg (dpyinfo, parms, Qterminal, 0, 0, RES_TYPE_STRING);
1156 if (EQ (display, Qunbound))
1157 display = Qnil;
1158 dpyinfo = check_ns_display_info (display);
a97f8f3f 1159 kb = dpyinfo->terminal->kboard;
edfda783
AR
1160
1161 if (!dpyinfo->terminal->name)
1162 error ("Terminal is not live, can't create new frames on it");
1163
edfda783
AR
1164 name = x_get_arg (dpyinfo, parms, Qname, 0, 0, RES_TYPE_STRING);
1165 if (!STRINGP (name)
1166 && ! EQ (name, Qunbound)
1167 && ! NILP (name))
1168 error ("Invalid frame name--not a string or nil");
1169
1170 if (STRINGP (name))
1171 Vx_resource_name = name;
1172
1173 parent = x_get_arg (dpyinfo, parms, Qparent_id, 0, 0, RES_TYPE_NUMBER);
1174 if (EQ (parent, Qunbound))
1175 parent = Qnil;
1176 if (! NILP (parent))
1177 CHECK_NUMBER (parent);
1178
a97f8f3f
JD
1179 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
1180 /* No need to protect DISPLAY because that's not used after passing
1181 it to make_frame_without_minibuffer. */
edfda783
AR
1182 frame = Qnil;
1183 GCPRO4 (parms, parent, name, frame);
edfda783
AR
1184 tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer",
1185 RES_TYPE_SYMBOL);
1186 if (EQ (tem, Qnone) || NILP (tem))
edfda783 1187 f = make_frame_without_minibuffer (Qnil, kb, display);
edfda783
AR
1188 else if (EQ (tem, Qonly))
1189 {
1190 f = make_minibuffer_frame ();
1191 minibuffer_only = 1;
1192 }
1193 else if (WINDOWP (tem))
edfda783 1194 f = make_frame_without_minibuffer (tem, kb, display);
edfda783 1195 else
edfda783 1196 f = make_frame (1);
edfda783
AR
1197
1198 XSETFRAME (frame, f);
1199 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
1200
1201 f->terminal = dpyinfo->terminal;
edfda783
AR
1202
1203 f->output_method = output_ns;
38182d90 1204 f->output_data.ns = xzalloc (sizeof *f->output_data.ns);
edfda783
AR
1205
1206 FRAME_FONTSET (f) = -1;
1207
edd74c35
DA
1208 FSET (f, icon_name, x_get_arg (dpyinfo, parms, Qicon_name,
1209 "iconName", "Title",
1210 RES_TYPE_STRING));
1211 if (! STRINGP (FGET (f, icon_name)))
1212 FSET (f, icon_name, Qnil);
edfda783
AR
1213
1214 FRAME_NS_DISPLAY_INFO (f) = dpyinfo;
1215
a97f8f3f
JD
1216 /* With FRAME_NS_DISPLAY_INFO set up, this unwind-protect is safe. */
1217 record_unwind_protect (unwind_create_frame, frame);
1218
edfda783 1219 f->output_data.ns->window_desc = desc_ctr++;
d311d28c 1220 if (TYPE_RANGED_INTEGERP (Window, parent))
edfda783 1221 {
d311d28c 1222 f->output_data.ns->parent_desc = XFASTINT (parent);
edfda783
AR
1223 f->output_data.ns->explicit_parent = 1;
1224 }
1225 else
1226 {
1227 f->output_data.ns->parent_desc = FRAME_NS_DISPLAY_INFO (f)->root_window;
1228 f->output_data.ns->explicit_parent = 0;
1229 }
1230
a97f8f3f
JD
1231 /* Set the name; the functions to which we pass f expect the name to
1232 be set. */
1233 if (EQ (name, Qunbound) || NILP (name) || ! STRINGP (name))
1234 {
edd74c35 1235 FSET (f, name, build_string ([ns_app_name UTF8String]));
a97f8f3f
JD
1236 f->explicit_name = 0;
1237 }
1238 else
1239 {
edd74c35 1240 FSET (f, name, name);
a97f8f3f
JD
1241 f->explicit_name = 1;
1242 specbind (Qx_resource_name, name);
1243 }
1244
edfda783
AR
1245 f->resx = dpyinfo->resx;
1246 f->resy = dpyinfo->resy;
1247
1248 BLOCK_INPUT;
1249 register_font_driver (&nsfont_driver, f);
1250 x_default_parameter (f, parms, Qfont_backend, Qnil,
1251 "fontBackend", "FontBackend", RES_TYPE_STRING);
1252
1253 {
1254 /* use for default font name */
1255 id font = [NSFont userFixedPitchFontOfSize: -1.0]; /* default */
1256 tfontsize = x_default_parameter (f, parms, Qfontsize,
1257 make_number (0 /*(int)[font pointSize]*/),
1258 "fontSize", "FontSize", RES_TYPE_NUMBER);
1259 tfont = x_default_parameter (f, parms, Qfont,
1260 build_string ([[font fontName] UTF8String]),
1261 "font", "Font", RES_TYPE_STRING);
1262 }
1263 UNBLOCK_INPUT;
1264
1265 x_default_parameter (f, parms, Qborder_width, make_number (0),
1266 "borderwidth", "BorderWidth", RES_TYPE_NUMBER);
1267 x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
1268 "internalBorderWidth", "InternalBorderWidth",
1269 RES_TYPE_NUMBER);
1270
1271 /* default scrollbars on right on Mac */
1272 {
facfbbbd 1273 Lisp_Object spos
edfda783 1274#ifdef NS_IMPL_GNUSTEP
facfbbbd 1275 = Qt;
edfda783 1276#else
facfbbbd 1277 = Qright;
edfda783 1278#endif
facfbbbd
SM
1279 x_default_parameter (f, parms, Qvertical_scroll_bars, spos,
1280 "verticalScrollBars", "VerticalScrollBars",
1281 RES_TYPE_SYMBOL);
edfda783
AR
1282 }
1283 x_default_parameter (f, parms, Qforeground_color, build_string ("Black"),
1284 "foreground", "Foreground", RES_TYPE_STRING);
1285 x_default_parameter (f, parms, Qbackground_color, build_string ("White"),
1286 "background", "Background", RES_TYPE_STRING);
22bcf204 1287 /* FIXME: not supported yet in Nextstep */
edfda783
AR
1288 x_default_parameter (f, parms, Qline_spacing, Qnil,
1289 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
1290 x_default_parameter (f, parms, Qleft_fringe, Qnil,
1291 "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
1292 x_default_parameter (f, parms, Qright_fringe, Qnil,
1293 "rightFringe", "RightFringe", RES_TYPE_NUMBER);
edfda783 1294
ef884f23 1295#ifdef GLYPH_DEBUG
a97f8f3f
JD
1296 image_cache_refcount =
1297 FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
1298#endif
edfda783
AR
1299
1300 init_frame_faces (f);
1301
a97f8f3f 1302 /* The resources controlling the menu-bar and tool-bar are
6431f2e6
CY
1303 processed specially at startup, and reflected in the mode
1304 variables; ignore them here. */
1305 x_default_parameter (f, parms, Qmenu_bar_lines,
1306 NILP (Vmenu_bar_mode)
1307 ? make_number (0) : make_number (1),
1308 NULL, NULL, RES_TYPE_NUMBER);
1309 x_default_parameter (f, parms, Qtool_bar_lines,
1310 NILP (Vtool_bar_mode)
1311 ? make_number (0) : make_number (1),
1312 NULL, NULL, RES_TYPE_NUMBER);
1313
edfda783
AR
1314 x_default_parameter (f, parms, Qbuffer_predicate, Qnil, "bufferPredicate",
1315 "BufferPredicate", RES_TYPE_SYMBOL);
1316 x_default_parameter (f, parms, Qtitle, Qnil, "title", "Title",
1317 RES_TYPE_STRING);
1318
a0c3fad0 1319 parms = get_geometry_from_preferences (dpyinfo, parms);
edfda783
AR
1320 window_prompting = x_figure_window_size (f, parms, 1);
1321
1322 tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
1323 f->no_split = minibuffer_only || (!EQ (tem, Qunbound) && !EQ (tem, Qnil));
1324
1325 /* NOTE: on other terms, this is done in set_mouse_color, however this
d26fbe1a 1326 was not getting called under Nextstep */
edfda783
AR
1327 f->output_data.ns->text_cursor = [NSCursor IBeamCursor];
1328 f->output_data.ns->nontext_cursor = [NSCursor arrowCursor];
1329 f->output_data.ns->modeline_cursor = [NSCursor pointingHandCursor];
1330 f->output_data.ns->hand_cursor = [NSCursor pointingHandCursor];
1331 f->output_data.ns->hourglass_cursor = [NSCursor disappearingItemCursor];
1332 f->output_data.ns->horizontal_drag_cursor = [NSCursor resizeLeftRightCursor];
facfbbbd
SM
1333 FRAME_NS_DISPLAY_INFO (f)->vertical_scroll_bar_cursor
1334 = [NSCursor arrowCursor];
edfda783
AR
1335 f->output_data.ns->current_pointer = f->output_data.ns->text_cursor;
1336
1337 [[EmacsView alloc] initFrameFromEmacs: f];
1338
952913d4 1339 x_icon (f, parms);
edfda783 1340
a97f8f3f
JD
1341 /* ns_display_info does not have a reference_count. */
1342 f->terminal->reference_count++;
1343
edfda783
AR
1344 /* It is now ok to make the frame official even if we get an error below.
1345 The frame needs to be on Vframe_list or making it visible won't work. */
1346 Vframe_list = Fcons (frame, Vframe_list);
a97f8f3f
JD
1347
1348 x_default_parameter (f, parms, Qicon_type, Qnil,
1349 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
1350
1351 x_default_parameter (f, parms, Qauto_raise, Qnil,
1352 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
1353 x_default_parameter (f, parms, Qauto_lower, Qnil,
1354 "autoLower", "AutoLower", RES_TYPE_BOOLEAN);
1355 x_default_parameter (f, parms, Qcursor_type, Qbox,
1356 "cursorType", "CursorType", RES_TYPE_SYMBOL);
1357 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
1358 "scrollBarWidth", "ScrollBarWidth",
1359 RES_TYPE_NUMBER);
1360 x_default_parameter (f, parms, Qalpha, Qnil,
1361 "alpha", "Alpha", RES_TYPE_NUMBER);
edfda783
AR
1362
1363 width = FRAME_COLS (f);
1364 height = FRAME_LINES (f);
1365
1366 SET_FRAME_COLS (f, 0);
1367 FRAME_LINES (f) = 0;
1368 change_frame_size (f, height, width, 1, 0, 0);
1369
1370 if (! f->output_data.ns->explicit_parent)
1371 {
a97f8f3f
JD
1372 Lisp_Object visibility;
1373
1374 visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0,
1375 RES_TYPE_SYMBOL);
1376 if (EQ (visibility, Qunbound))
1377 visibility = Qt;
1378
1379 if (EQ (visibility, Qicon))
15891144 1380 x_iconify_frame (f);
a97f8f3f 1381 else if (! NILP (visibility))
15891144
DR
1382 {
1383 x_make_frame_visible (f);
15891144
DR
1384 [[FRAME_NS_VIEW (f) window] makeKeyWindow];
1385 }
1386 else
a97f8f3f
JD
1387 {
1388 /* Must have been Qnil. */
1389 }
edfda783
AR
1390 }
1391
1392 if (FRAME_HAS_MINIBUF_P (f)
124c9ff0
JD
1393 && (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame))
1394 || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame)))))
1395 KVAR (kb, Vdefault_minibuffer_frame) = frame;
edfda783
AR
1396
1397 /* All remaining specified parameters, which have not been "used"
1398 by x_get_arg and friends, now go in the misc. alist of the frame. */
1399 for (tem = parms; CONSP (tem); tem = XCDR (tem))
1400 if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
edd74c35 1401 FSET (f, param_alist, Fcons (XCAR (tem), FGET (f, param_alist)));
edfda783
AR
1402
1403 UNGCPRO;
a97f8f3f
JD
1404
1405 /* Make sure windows on this frame appear in calls to next-window
1406 and similar functions. */
edfda783
AR
1407 Vwindow_list = Qnil;
1408
1409 return unbind_to (count, frame);
1410}
1411
1412
9e50ff0c 1413DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
edfda783
AR
1414 doc: /* Set the input focus to FRAME.
1415FRAME nil means use the selected frame. */)
5842a27b 1416 (Lisp_Object frame)
edfda783
AR
1417{
1418 struct frame *f = check_ns_frame (frame);
1419 struct ns_display_info *dpyinfo = FRAME_NS_DISPLAY_INFO (f);
1420
9e50ff0c 1421 if (dpyinfo->x_focus_frame != f)
edfda783
AR
1422 {
1423 EmacsView *view = FRAME_NS_VIEW (f);
1424 BLOCK_INPUT;
4acaaa2b 1425 [NSApp activateIgnoringOtherApps: YES];
edfda783
AR
1426 [[view window] makeKeyAndOrderFront: view];
1427 UNBLOCK_INPUT;
1428 }
1429
1430 return Qnil;
1431}
1432
1433
edfda783 1434DEFUN ("ns-popup-font-panel", Fns_popup_font_panel, Sns_popup_font_panel,
51d5ef9f
AR
1435 0, 1, "",
1436 doc: /* Pop up the font panel. */)
5842a27b 1437 (Lisp_Object frame)
edfda783
AR
1438{
1439 id fm;
1440 struct frame *f;
1441
1442 check_ns ();
320e80c0 1443 fm = [NSFontManager sharedFontManager];
edfda783
AR
1444 if (NILP (frame))
1445 f = SELECTED_FRAME ();
1446 else
1447 {
1448 CHECK_FRAME (frame);
1449 f = XFRAME (frame);
1450 }
1451
1452 [fm setSelectedFont: ((struct nsfont_info *)f->output_data.ns->font)->nsfont
1453 isMultiple: NO];
1454 [fm orderFrontFontPanel: NSApp];
1455 return Qnil;
1456}
1457
1458
b066e6b6 1459DEFUN ("ns-popup-color-panel", Fns_popup_color_panel, Sns_popup_color_panel,
51d5ef9f
AR
1460 0, 1, "",
1461 doc: /* Pop up the color panel. */)
5842a27b 1462 (Lisp_Object frame)
edfda783
AR
1463{
1464 struct frame *f;
1465
1466 check_ns ();
1467 if (NILP (frame))
1468 f = SELECTED_FRAME ();
1469 else
1470 {
1471 CHECK_FRAME (frame);
1472 f = XFRAME (frame);
1473 }
1474
1475 [NSApp orderFrontColorPanel: NSApp];
1476 return Qnil;
1477}
1478
1479
1480DEFUN ("ns-read-file-name", Fns_read_file_name, Sns_read_file_name, 1, 4, 0,
51d5ef9f 1481 doc: /* Use a graphical panel to read a file name, using prompt PROMPT.
d26fbe1a 1482Optional arg DIR, if non-nil, supplies a default directory.
45cb8994
CY
1483Optional arg MUSTMATCH, if non-nil, means the returned file or
1484directory must exist.
51d5ef9f 1485Optional arg INIT, if non-nil, provides a default file name to use. */)
f7ff1b0f 1486 (Lisp_Object prompt, Lisp_Object dir, Lisp_Object mustmatch, Lisp_Object init)
edfda783
AR
1487{
1488 static id fileDelegate = nil;
1489 int ret;
1490 id panel;
ba301db3 1491 Lisp_Object fname;
edfda783
AR
1492
1493 NSString *promptS = NILP (prompt) || !STRINGP (prompt) ? nil :
0dc8cf50 1494 [NSString stringWithUTF8String: SSDATA (prompt)];
edfda783 1495 NSString *dirS = NILP (dir) || !STRINGP (dir) ?
0dc8cf50
JD
1496 [NSString stringWithUTF8String: SSDATA (BVAR (current_buffer, directory))] :
1497 [NSString stringWithUTF8String: SSDATA (dir)];
edfda783 1498 NSString *initS = NILP (init) || !STRINGP (init) ? nil :
0dc8cf50 1499 [NSString stringWithUTF8String: SSDATA (init)];
edfda783
AR
1500
1501 check_ns ();
1502
1503 if (fileDelegate == nil)
1504 fileDelegate = [EmacsFileDelegate new];
1505
1506 [NSCursor setHiddenUntilMouseMoves: NO];
1507
1508 if ([dirS characterAtIndex: 0] == '~')
1509 dirS = [dirS stringByExpandingTildeInPath];
1510
45cb8994 1511 panel = NILP (mustmatch) ?
f2f7f42c 1512 (id)[EmacsSavePanel savePanel] : (id)[EmacsOpenPanel openPanel];
edfda783
AR
1513
1514 [panel setTitle: promptS];
1515
1516 /* Puma (10.1) does not have */
1517 if ([panel respondsToSelector: @selector (setAllowsOtherFileTypes:)])
1518 [panel setAllowsOtherFileTypes: YES];
1519
1520 [panel setTreatsFilePackagesAsDirectories: YES];
1521 [panel setDelegate: fileDelegate];
1522
1523 panelOK = 0;
ba301db3 1524 BLOCK_INPUT;
45cb8994 1525 if (NILP (mustmatch))
edfda783
AR
1526 {
1527 ret = [panel runModalForDirectory: dirS file: initS];
1528 }
1529 else
1530 {
1531 [panel setCanChooseDirectories: YES];
1532 ret = [panel runModalForDirectory: dirS file: initS types: nil];
1533 }
1534
575fb8bd 1535 ret = (ret == NSOKButton) || panelOK;
edfda783 1536
ba301db3
AR
1537 if (ret)
1538 fname = build_string ([[panel filename] UTF8String]);
b066e6b6 1539
edfda783 1540 [[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow];
ba301db3 1541 UNBLOCK_INPUT;
edfda783 1542
ba301db3 1543 return ret ? fname : Qnil;
edfda783
AR
1544}
1545
f7dfe5d6
JD
1546const char *
1547ns_get_defaults_value (const char *key)
1548{
1549 NSObject *obj = [[NSUserDefaults standardUserDefaults]
1550 objectForKey: [NSString stringWithUTF8String: key]];
1551
1552 if (!obj) return NULL;
1553
1554 return [[NSString stringWithFormat: @"%@", obj] UTF8String];
1555}
1556
edfda783
AR
1557
1558DEFUN ("ns-get-resource", Fns_get_resource, Sns_get_resource, 2, 2, 0,
51d5ef9f
AR
1559 doc: /* Return the value of the property NAME of OWNER from the defaults database.
1560If OWNER is nil, Emacs is assumed. */)
5842a27b 1561 (Lisp_Object owner, Lisp_Object name)
edfda783
AR
1562{
1563 const char *value;
1564
1565 check_ns ();
1566 if (NILP (owner))
56d513e6 1567 owner = build_string([ns_app_name UTF8String]);
edfda783 1568 CHECK_STRING (name);
0dc8cf50 1569/*fprintf (stderr, "ns-get-resource checking resource '%s'\n", SSDATA (name)); */
edfda783 1570
0dc8cf50 1571 value = ns_get_defaults_value (SSDATA (name));
edfda783
AR
1572
1573 if (value)
1574 return build_string (value);
edfda783
AR
1575 return Qnil;
1576}
1577
1578
1579DEFUN ("ns-set-resource", Fns_set_resource, Sns_set_resource, 3, 3, 0,
51d5ef9f 1580 doc: /* Set property NAME of OWNER to VALUE, from the defaults database.
d26fbe1a 1581If OWNER is nil, Emacs is assumed.
51d5ef9f 1582If VALUE is nil, the default is removed. */)
5842a27b 1583 (Lisp_Object owner, Lisp_Object name, Lisp_Object value)
edfda783
AR
1584{
1585 check_ns ();
1586 if (NILP (owner))
56d513e6 1587 owner = build_string ([ns_app_name UTF8String]);
edfda783
AR
1588 CHECK_STRING (name);
1589 if (NILP (value))
1590 {
1591 [[NSUserDefaults standardUserDefaults] removeObjectForKey:
0dc8cf50 1592 [NSString stringWithUTF8String: SSDATA (name)]];
edfda783
AR
1593 }
1594 else
1595 {
1596 CHECK_STRING (value);
1597 [[NSUserDefaults standardUserDefaults] setObject:
0dc8cf50 1598 [NSString stringWithUTF8String: SSDATA (value)]
edfda783 1599 forKey: [NSString stringWithUTF8String:
0dc8cf50 1600 SSDATA (name)]];
edfda783
AR
1601 }
1602
1603 return Qnil;
1604}
1605
1606
952913d4
DN
1607DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
1608 Sx_server_max_request_size,
edfda783 1609 0, 1, 0,
51d5ef9f 1610 doc: /* This function is a no-op. It is only present for completeness. */)
5842a27b 1611 (Lisp_Object display)
edfda783
AR
1612{
1613 check_ns ();
1614 /* This function has no real equivalent under NeXTstep. Return nil to
1615 indicate this. */
1616 return Qnil;
1617}
1618
1619
9e50ff0c 1620DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
51d5ef9f 1621 doc: /* Return the vendor ID string of Nextstep display server DISPLAY.
d26fbe1a 1622DISPLAY should be either a frame or a display name (a string).
51d5ef9f 1623If omitted or nil, the selected frame's display is used. */)
5842a27b 1624 (Lisp_Object display)
edfda783 1625{
edfda783
AR
1626#ifdef NS_IMPL_GNUSTEP
1627 return build_string ("GNU");
1628#else
1629 return build_string ("Apple");
1630#endif
1631}
1632
1633
9e50ff0c 1634DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
f5497e45
AR
1635 doc: /* Return the version numbers of the server of DISPLAY.
1636The value is a list of three integers: the major and minor
1637version numbers of the X Protocol in use, and the distributor-specific
1638release number. See also the function `x-server-vendor'.
1639
1640The optional argument DISPLAY specifies which display to ask about.
d26fbe1a 1641DISPLAY should be either a frame or a display name (a string).
f5497e45 1642If omitted or nil, that stands for the selected frame's display. */)
5842a27b 1643 (Lisp_Object display)
edfda783 1644{
f5497e45
AR
1645 /*NOTE: it is unclear what would best correspond with "protocol";
1646 we return 10.3, meaning Panther, since this is roughly the
1647 level that GNUstep's APIs correspond to.
1648 The last number is where we distinguish between the Apple
1649 and GNUstep implementations ("distributor-specific release
1650 number") and give int'ized versions of major.minor. */
1651 return Fcons (make_number (10),
1652 Fcons (make_number (3),
1653 Fcons (make_number (ns_appkit_version_int()), Qnil)));
edfda783
AR
1654}
1655
1656
9e50ff0c 1657DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
51d5ef9f 1658 doc: /* Return the number of screens on Nextstep display server DISPLAY.
d26fbe1a 1659DISPLAY should be a frame, the display name as a string, or a terminal ID.
51d5ef9f 1660If omitted or nil, the selected frame's display is used. */)
5842a27b 1661 (Lisp_Object display)
edfda783
AR
1662{
1663 int num;
1664
1665 check_ns ();
1666 num = [[NSScreen screens] count];
1667
1668 return (num != 0) ? make_number (num) : Qnil;
1669}
1670
1671
9e50ff0c 1672DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height,
edfda783 1673 0, 1, 0,
51d5ef9f 1674 doc: /* Return the height of Nextstep display server DISPLAY, in millimeters.
d26fbe1a 1675DISPLAY should be a frame, the display name as a string, or a terminal ID.
51d5ef9f 1676If omitted or nil, the selected frame's display is used. */)
5842a27b 1677 (Lisp_Object display)
edfda783
AR
1678{
1679 check_ns ();
1680 return make_number ((int)
1681 ([ns_get_screen (display) frame].size.height/(92.0/25.4)));
1682}
1683
1684
9e50ff0c 1685DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width,
edfda783 1686 0, 1, 0,
51d5ef9f 1687 doc: /* Return the width of Nextstep display server DISPLAY, in millimeters.
d26fbe1a 1688DISPLAY should be a frame, the display name as a string, or a terminal ID.
51d5ef9f 1689If omitted or nil, the selected frame's display is used. */)
5842a27b 1690 (Lisp_Object display)
edfda783
AR
1691{
1692 check_ns ();
1693 return make_number ((int)
1694 ([ns_get_screen (display) frame].size.width/(92.0/25.4)));
1695}
1696
1697
9e50ff0c 1698DEFUN ("x-display-backing-store", Fx_display_backing_store,
51d5ef9f 1699 Sx_display_backing_store, 0, 1, 0,
09e80d9f 1700 doc: /* Return whether the Nextstep display DISPLAY supports backing store.
d26fbe1a
CY
1701The value may be `buffered', `retained', or `non-retained'.
1702DISPLAY should be a frame, the display name as a string, or a terminal ID.
51d5ef9f 1703If omitted or nil, the selected frame's display is used. */)
5842a27b 1704 (Lisp_Object display)
edfda783
AR
1705{
1706 check_ns ();
1707 switch ([ns_get_window (display) backingType])
1708 {
1709 case NSBackingStoreBuffered:
1710 return intern ("buffered");
1711 case NSBackingStoreRetained:
1712 return intern ("retained");
1713 case NSBackingStoreNonretained:
1714 return intern ("non-retained");
1715 default:
1716 error ("Strange value for backingType parameter of frame");
1717 }
1718 return Qnil; /* not reached, shut compiler up */
1719}
1720
1721
9e50ff0c 1722DEFUN ("x-display-visual-class", Fx_display_visual_class,
51d5ef9f
AR
1723 Sx_display_visual_class, 0, 1, 0,
1724 doc: /* Return the visual class of the Nextstep display server DISPLAY.
d26fbe1a
CY
1725The value is one of the symbols `static-gray', `gray-scale',
1726`static-color', `pseudo-color', `true-color', or `direct-color'.
1727DISPLAY should be a frame, the display name as a string, or a terminal ID.
51d5ef9f 1728If omitted or nil, the selected frame's display is used. */)
5842a27b 1729 (Lisp_Object display)
edfda783
AR
1730{
1731 NSWindowDepth depth;
1732 check_ns ();
1733 depth = [ns_get_screen (display) depth];
1734
1735 if ( depth == NSBestDepth (NSCalibratedWhiteColorSpace, 2, 2, YES, NULL))
1736 return intern ("static-gray");
1737 else if (depth == NSBestDepth (NSCalibratedWhiteColorSpace, 8, 8, YES, NULL))
1738 return intern ("gray-scale");
1739 else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 8, YES, NULL))
1740 return intern ("pseudo-color");
1741 else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 4, 12, NO, NULL))
1742 return intern ("true-color");
1743 else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 24, NO, NULL))
1744 return intern ("direct-color");
1745 else
d26fbe1a 1746 /* color mgmt as far as we do it is really handled by Nextstep itself anyway */
edfda783
AR
1747 return intern ("direct-color");
1748}
1749
1750
9e50ff0c 1751DEFUN ("x-display-save-under", Fx_display_save_under,
51d5ef9f 1752 Sx_display_save_under, 0, 1, 0,
4f4f2973 1753 doc: /* Return t if DISPLAY supports the save-under feature.
d26fbe1a
CY
1754The optional argument DISPLAY specifies which display to ask about.
1755DISPLAY should be a frame, the display name as a string, or a terminal ID.
51d5ef9f 1756If omitted or nil, the selected frame's display is used. */)
5842a27b 1757 (Lisp_Object display)
edfda783
AR
1758{
1759 check_ns ();
1760 switch ([ns_get_window (display) backingType])
1761 {
1762 case NSBackingStoreBuffered:
1763 return Qt;
1764
1765 case NSBackingStoreRetained:
1766 case NSBackingStoreNonretained:
1767 return Qnil;
1768
1769 default:
1770 error ("Strange value for backingType parameter of frame");
1771 }
1772 return Qnil; /* not reached, shut compiler up */
1773}
1774
1775
9e50ff0c 1776DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
51d5ef9f 1777 1, 3, 0,
4f4f2973 1778 doc: /* Open a connection to a display server.
d26fbe1a 1779DISPLAY is the name of the display to connect to.
4f4f2973
GM
1780Optional second arg XRM-STRING is a string of resources in xrdb format.
1781If the optional third arg MUST-SUCCEED is non-nil,
1782terminate Emacs if we can't open the connection.
1783\(In the Nextstep version, the last two arguments are currently ignored.) */)
5842a27b 1784 (Lisp_Object display, Lisp_Object resource_string, Lisp_Object must_succeed)
edfda783
AR
1785{
1786 struct ns_display_info *dpyinfo;
1787
1788 CHECK_STRING (display);
1789
1790 nxatoms_of_nsselect ();
1791 dpyinfo = ns_term_init (display);
1792 if (dpyinfo == 0)
1793 {
1794 if (!NILP (must_succeed))
1795 fatal ("OpenStep on %s not responding.\n",
0dc8cf50 1796 SSDATA (display));
edfda783
AR
1797 else
1798 error ("OpenStep on %s not responding.\n",
0dc8cf50 1799 SSDATA (display));
edfda783
AR
1800 }
1801
1802 /* Register our external input/output types, used for determining
1803 applicable services and also drag/drop eligibility. */
699c10bd 1804 ns_send_types = [[NSArray arrayWithObjects: NSStringPboardType, nil] retain];
3fe4b549
JD
1805 ns_return_types = [[NSArray arrayWithObjects: NSStringPboardType, nil]
1806 retain];
edfda783
AR
1807 ns_drag_types = [[NSArray arrayWithObjects:
1808 NSStringPboardType,
1809 NSTabularTextPboardType,
1810 NSFilenamesPboardType,
1811 NSURLPboardType,
1812 NSColorPboardType,
1813 NSFontPboardType, nil] retain];
1814
1815 return Qnil;
1816}
1817
1818
9e50ff0c 1819DEFUN ("x-close-connection", Fx_close_connection, Sx_close_connection,
51d5ef9f
AR
1820 1, 1, 0,
1821 doc: /* Close the connection to the current Nextstep display server.
b066e6b6 1822The argument DISPLAY is currently ignored. */)
5842a27b 1823 (Lisp_Object display)
edfda783
AR
1824{
1825 check_ns ();
edfda783
AR
1826 /*ns_delete_terminal (dpyinfo->terminal); */
1827 [NSApp terminate: NSApp];
1828 return Qnil;
1829}
1830
1831
9e50ff0c 1832DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
51d5ef9f 1833 doc: /* Return the list of display names that Emacs has connections to. */)
5842a27b 1834 (void)
edfda783
AR
1835{
1836 Lisp_Object tail, result;
1837
1838 result = Qnil;
1839 for (tail = ns_display_name_list; CONSP (tail); tail = XCDR (tail))
1840 result = Fcons (XCAR (XCAR (tail)), result);
1841
1842 return result;
1843}
1844
1845
1846DEFUN ("ns-hide-others", Fns_hide_others, Sns_hide_others,
51d5ef9f 1847 0, 0, 0,
b066e6b6 1848 doc: /* Hides all applications other than Emacs. */)
5842a27b 1849 (void)
edfda783
AR
1850{
1851 check_ns ();
1852 [NSApp hideOtherApplications: NSApp];
1853 return Qnil;
1854}
1855
1856DEFUN ("ns-hide-emacs", Fns_hide_emacs, Sns_hide_emacs,
51d5ef9f 1857 1, 1, 0,
b066e6b6
JB
1858 doc: /* If ON is non-nil, the entire Emacs application is hidden.
1859Otherwise if Emacs is hidden, it is unhidden.
1860If ON is equal to `activate', Emacs is unhidden and becomes
51d5ef9f 1861the active application. */)
5842a27b 1862 (Lisp_Object on)
edfda783
AR
1863{
1864 check_ns ();
1865 if (EQ (on, intern ("activate")))
1866 {
1867 [NSApp unhide: NSApp];
1868 [NSApp activateIgnoringOtherApps: YES];
1869 }
1870 else if (NILP (on))
1871 [NSApp unhide: NSApp];
1872 else
1873 [NSApp hide: NSApp];
1874 return Qnil;
1875}
1876
1877
1878DEFUN ("ns-emacs-info-panel", Fns_emacs_info_panel, Sns_emacs_info_panel,
51d5ef9f
AR
1879 0, 0, 0,
1880 doc: /* Shows the 'Info' or 'About' panel for Emacs. */)
5842a27b 1881 (void)
edfda783
AR
1882{
1883 check_ns ();
1884 [NSApp orderFrontStandardAboutPanel: nil];
1885 return Qnil;
1886}
1887
1888
edfda783 1889DEFUN ("ns-font-name", Fns_font_name, Sns_font_name, 1, 1, 0,
7877f373 1890 doc: /* Determine font PostScript or family name for font NAME.
d26fbe1a
CY
1891NAME should be a string containing either the font name or an XLFD
1892font descriptor. If string contains `fontset' and not
51d5ef9f 1893`fontset-startup', it is left alone. */)
5842a27b 1894 (Lisp_Object name)
edfda783
AR
1895{
1896 char *nm;
1897 CHECK_STRING (name);
0dc8cf50 1898 nm = SSDATA (name);
edfda783
AR
1899
1900 if (nm[0] != '-')
1901 return name;
1902 if (strstr (nm, "fontset") && !strstr (nm, "fontset-startup"))
1903 return name;
1904
0dc8cf50 1905 return build_string (ns_xlfd_to_fontname (SSDATA (name)));
edfda783
AR
1906}
1907
1908
1909DEFUN ("ns-list-colors", Fns_list_colors, Sns_list_colors, 0, 1, 0,
51d5ef9f
AR
1910 doc: /* Return a list of all available colors.
1911The optional argument FRAME is currently ignored. */)
5842a27b 1912 (Lisp_Object frame)
edfda783
AR
1913{
1914 Lisp_Object list = Qnil;
1915 NSEnumerator *colorlists;
1916 NSColorList *clist;
1917
1918 if (!NILP (frame))
1919 {
1920 CHECK_FRAME (frame);
1921 if (! FRAME_NS_P (XFRAME (frame)))
d26fbe1a 1922 error ("non-Nextstep frame used in `ns-list-colors'");
edfda783
AR
1923 }
1924
1925 BLOCK_INPUT;
1926
1927 colorlists = [[NSColorList availableColorLists] objectEnumerator];
0dc8cf50 1928 while ((clist = [colorlists nextObject]))
edfda783
AR
1929 {
1930 if ([[clist name] length] < 7 ||
1931 [[clist name] rangeOfString: @"PANTONE"].location == 0)
1932 {
1933 NSEnumerator *cnames = [[clist allKeys] reverseObjectEnumerator];
1934 NSString *cname;
0dc8cf50 1935 while ((cname = [cnames nextObject]))
edfda783
AR
1936 list = Fcons (build_string ([cname UTF8String]), list);
1937/* for (i = [[clist allKeys] count] - 1; i >= 0; i--)
1938 list = Fcons (build_string ([[[clist allKeys] objectAtIndex: i]
1939 UTF8String]), list); */
1940 }
1941 }
1942
1943 UNBLOCK_INPUT;
1944
1945 return list;
1946}
1947
1948
1949DEFUN ("ns-list-services", Fns_list_services, Sns_list_services, 0, 0, 0,
51d5ef9f 1950 doc: /* List available Nextstep services by querying NSApp. */)
5842a27b 1951 (void)
edfda783 1952{
699c10bd
JD
1953#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
1954 /* You can't get services like this in 10.6+. */
1955 return Qnil;
1956#else
edfda783
AR
1957 Lisp_Object ret = Qnil;
1958 NSMenu *svcs;
1959 id delegate;
1960
1961 check_ns ();
1962 svcs = [[NSMenu alloc] initWithTitle: @"Services"];
1963 [NSApp setServicesMenu: svcs]; /* this and next rebuild on <10.4 */
1964 [NSApp registerServicesMenuSendTypes: ns_send_types
1965 returnTypes: ns_return_types];
1966
1967/* On Tiger, services menu updating was made lazier (waits for user to
1968 actually click on the menu), so we have to force things along: */
1969#ifdef NS_IMPL_COCOA
1970 if (NSAppKitVersionNumber >= 744.0)
1971 {
1972 delegate = [svcs delegate];
1973 if (delegate != nil)
1974 {
1975 if ([delegate respondsToSelector: @selector (menuNeedsUpdate:)])
1976 [delegate menuNeedsUpdate: svcs];
1977 if ([delegate respondsToSelector:
1978 @selector (menu:updateItem:atIndex:shouldCancel:)])
1979 {
1980 int i, len = [delegate numberOfItemsInMenu: svcs];
1981 for (i =0; i<len; i++)
1982 [svcs addItemWithTitle: @"" action: NULL keyEquivalent: @""];
1983 for (i =0; i<len; i++)
1984 if (![delegate menu: svcs
1985 updateItem: (NSMenuItem *)[svcs itemAtIndex: i]
1986 atIndex: i shouldCancel: NO])
1987 break;
1988 }
1989 }
1990 }
1991#endif
1992
1993 [svcs setAutoenablesItems: NO];
1994#ifdef NS_IMPL_COCOA
1995 [svcs update]; /* on OS X, converts from '/' structure */
1996#endif
1997
1998 ret = interpret_services_menu (svcs, Qnil, ret);
1999 return ret;
699c10bd 2000#endif
edfda783
AR
2001}
2002
2003
2004DEFUN ("ns-perform-service", Fns_perform_service, Sns_perform_service,
51d5ef9f
AR
2005 2, 2, 0,
2006 doc: /* Perform Nextstep SERVICE on SEND.
d26fbe1a
CY
2007SEND should be either a string or nil.
2008The return value is the result of the service, as string, or nil if
51d5ef9f 2009there was no result. */)
5842a27b 2010 (Lisp_Object service, Lisp_Object send)
edfda783
AR
2011{
2012 id pb;
2013 NSString *svcName;
2014 char *utfStr;
edfda783
AR
2015
2016 CHECK_STRING (service);
2017 check_ns ();
2018
0dc8cf50 2019 utfStr = SSDATA (service);
edfda783
AR
2020 svcName = [NSString stringWithUTF8String: utfStr];
2021
2022 pb =[NSPasteboard pasteboardWithUniqueName];
2023 ns_string_to_pasteboard (pb, send);
2024
2025 if (NSPerformService (svcName, pb) == NO)
2026 Fsignal (Qquit, Fcons (build_string ("service not available"), Qnil));
2027
2028 if ([[pb types] count] == 0)
2029 return build_string ("");
2030 return ns_string_from_pasteboard (pb);
2031}
2032
2033
2034DEFUN ("ns-convert-utf8-nfd-to-nfc", Fns_convert_utf8_nfd_to_nfc,
2035 Sns_convert_utf8_nfd_to_nfc, 1, 1, 0,
b066e6b6 2036 doc: /* Return an NFC string that matches the UTF-8 NFD string STR. */)
5842a27b 2037 (Lisp_Object str)
edfda783 2038{
f2f7f42c
AR
2039/* TODO: If GNUstep ever implements precomposedStringWithCanonicalMapping,
2040 remove this. */
edfda783
AR
2041 NSString *utfStr;
2042
2043 CHECK_STRING (str);
0dc8cf50 2044 utfStr = [NSString stringWithUTF8String: SSDATA (str)];
f2f7f42c
AR
2045 if (![utfStr respondsToSelector:
2046 @selector (precomposedStringWithCanonicalMapping)])
2047 {
2048 message1
2049 ("Warning: ns-convert-utf8-nfd-to-nfc unsupported under GNUstep.\n");
2050 return Qnil;
2051 }
2052 else
2053 utfStr = [utfStr precomposedStringWithCanonicalMapping];
edfda783
AR
2054 return build_string ([utfStr UTF8String]);
2055}
2056
2057
583ff3c3
AR
2058#ifdef NS_IMPL_COCOA
2059
2060/* Compile and execute the AppleScript SCRIPT and return the error
2061 status as function value. A zero is returned if compilation and
2062 execution is successful, in which case *RESULT is set to a Lisp
2063 string or a number containing the resulting script value. Otherwise,
2064 1 is returned. */
2065static int
3d608a86 2066ns_do_applescript (Lisp_Object script, Lisp_Object *result)
583ff3c3
AR
2067{
2068 NSAppleEventDescriptor *desc;
2069 NSDictionary* errorDict;
2070 NSAppleEventDescriptor* returnDescriptor = NULL;
2071
2072 NSAppleScript* scriptObject =
2073 [[NSAppleScript alloc] initWithSource:
0dc8cf50 2074 [NSString stringWithUTF8String: SSDATA (script)]];
583ff3c3
AR
2075
2076 returnDescriptor = [scriptObject executeAndReturnError: &errorDict];
2077 [scriptObject release];
b066e6b6 2078
583ff3c3 2079 *result = Qnil;
b066e6b6 2080
583ff3c3
AR
2081 if (returnDescriptor != NULL)
2082 {
2083 // successful execution
2084 if (kAENullEvent != [returnDescriptor descriptorType])
2085 {
2086 *result = Qt;
2087 // script returned an AppleScript result
2088 if ((typeUnicodeText == [returnDescriptor descriptorType]) ||
a39e2539 2089#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_4
b066e6b6 2090 (typeUTF16ExternalRepresentation
583ff3c3 2091 == [returnDescriptor descriptorType]) ||
a39e2539 2092#endif
583ff3c3
AR
2093 (typeUTF8Text == [returnDescriptor descriptorType]) ||
2094 (typeCString == [returnDescriptor descriptorType]))
2095 {
2096 desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
2097 if (desc)
2098 *result = build_string([[desc stringValue] UTF8String]);
2099 }
2100 else
2101 {
2102 /* use typeUTF16ExternalRepresentation? */
2103 // coerce the result to the appropriate ObjC type
2104 desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
2105 if (desc)
2106 *result = make_number([desc int32Value]);
2107 }
2108 }
2109 }
2110 else
2111 {
2112 // no script result, return error
2113 return 1;
2114 }
2115 return 0;
2116}
2117
08e3161a
JD
2118/* Helper function called from sendEvent to run applescript
2119 from within the main event loop. */
2120
2121void
2122ns_run_ascript (void)
2123{
2124 as_status = ns_do_applescript (as_script, as_result);
2125}
2126
583ff3c3 2127DEFUN ("ns-do-applescript", Fns_do_applescript, Sns_do_applescript, 1, 1, 0,
b066e6b6
JB
2128 doc: /* Execute AppleScript SCRIPT and return the result.
2129If compilation and execution are successful, the resulting script value
2130is returned as a string, a number or, in the case of other constructs, t.
2131In case the execution fails, an error is signaled. */)
5842a27b 2132 (Lisp_Object script)
583ff3c3
AR
2133{
2134 Lisp_Object result;
5fdb398c 2135 int status;
08e3161a 2136 NSEvent *nxev;
583ff3c3
AR
2137
2138 CHECK_STRING (script);
2139 check_ns ();
2140
2141 BLOCK_INPUT;
08e3161a
JD
2142
2143 as_script = script;
2144 as_result = &result;
2145
2146 /* executing apple script requires the event loop to run, otherwise
2147 errors aren't returned and executeAndReturnError hangs forever.
2148 Post an event that runs applescript and then start the event loop.
2149 The event loop is exited when the script is done. */
2150 nxev = [NSEvent otherEventWithType: NSApplicationDefined
2151 location: NSMakePoint (0, 0)
2152 modifierFlags: 0
2153 timestamp: 0
2154 windowNumber: [[NSApp mainWindow] windowNumber]
2155 context: [NSApp context]
2156 subtype: 0
2157 data1: 0
2158 data2: NSAPP_DATA2_RUNASSCRIPT];
2159
2160 [NSApp postEvent: nxev atStart: NO];
2161 [NSApp run];
2162
2163 status = as_status;
2164 as_status = 0;
2165 as_script = Qnil;
2166 as_result = 0;
583ff3c3
AR
2167 UNBLOCK_INPUT;
2168 if (status == 0)
2169 return result;
2170 else if (!STRINGP (result))
2171 error ("AppleScript error %d", status);
2172 else
0dc8cf50 2173 error ("%s", SSDATA (result));
583ff3c3
AR
2174}
2175#endif
2176
2177
2178
edfda783
AR
2179/* ==========================================================================
2180
2181 Miscellaneous functions not called through hooks
2182
2183 ========================================================================== */
2184
2185
3fe53a83 2186/* called from image.c */
edfda783
AR
2187FRAME_PTR
2188check_x_frame (Lisp_Object frame)
2189{
2190 return check_ns_frame (frame);
2191}
2192
3fe53a83
AR
2193
2194/* called from frame.c */
edfda783
AR
2195struct ns_display_info *
2196check_x_display_info (Lisp_Object frame)
2197{
2198 return check_ns_display_info (frame);
2199}
2200
2201
edfda783 2202void
3d608a86 2203x_set_scroll_bar_default_width (struct frame *f)
edfda783
AR
2204{
2205 int wid = FRAME_COLUMN_WIDTH (f);
2206 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = NS_SCROLL_BAR_WIDTH_DEFAULT;
2207 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) +
2208 wid - 1) / wid;
2209}
2210
2211
3fe53a83 2212/* terms impl this instead of x-get-resource directly */
edfda783
AR
2213const char *
2214x_get_string_resource (XrmDatabase rdb, char *name, char *class)
2215{
6fb5f7da 2216 /* remove appname prefix; TODO: allow for !="Emacs" */
edfda783
AR
2217 char *toCheck = class + (!strncmp (class, "Emacs.", 6) ? 6 : 0);
2218 const char *res;
2219 check_ns ();
2220
386a49d3
AR
2221 if (inhibit_x_resources)
2222 /* --quick was passed, so this is a no-op. */
2223 return NULL;
edfda783 2224
f7dfe5d6 2225 res = ns_get_defaults_value (toCheck);
edfda783 2226 return !res ? NULL :
fee5959d
PE
2227 (!c_strncasecmp (res, "YES", 3) ? "true" :
2228 (!c_strncasecmp (res, "NO", 2) ? "false" : res));
edfda783
AR
2229}
2230
2231
2232Lisp_Object
2233x_get_focus_frame (struct frame *frame)
2234{
2235 struct ns_display_info *dpyinfo = FRAME_NS_DISPLAY_INFO (frame);
2236 Lisp_Object nsfocus;
2237
9e50ff0c 2238 if (!dpyinfo->x_focus_frame)
edfda783
AR
2239 return Qnil;
2240
9e50ff0c 2241 XSETFRAME (nsfocus, dpyinfo->x_focus_frame);
edfda783
AR
2242 return nsfocus;
2243}
2244
2245
2246int
2247x_pixel_width (struct frame *f)
2248{
2249 return FRAME_PIXEL_WIDTH (f);
2250}
2251
2252
2253int
2254x_pixel_height (struct frame *f)
2255{
2256 return FRAME_PIXEL_HEIGHT (f);
2257}
2258
2259
2260int
2261x_char_width (struct frame *f)
2262{
2263 return FRAME_COLUMN_WIDTH (f);
2264}
2265
2266
2267int
2268x_char_height (struct frame *f)
2269{
2270 return FRAME_LINE_HEIGHT (f);
2271}
2272
2273
2274int
2275x_screen_planes (struct frame *f)
2276{
2277 return FRAME_NS_DISPLAY_INFO (f)->n_planes;
2278}
2279
2280
2281void
3d608a86 2282x_sync (struct frame *f)
edfda783
AR
2283{
2284 /* XXX Not implemented XXX */
2285 return;
2286}
2287
2288
2289
2290/* ==========================================================================
2291
2292 Lisp definitions that, for whatever reason, we can't alias as 'ns-XXX'.
2293
2294 ========================================================================== */
2295
2296
952913d4 2297DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
4f4f2973
GM
2298 doc: /* Internal function called by `color-defined-p', which see.
2299\(Note that the Nextstep version of this function ignores FRAME.) */)
5842a27b 2300 (Lisp_Object color, Lisp_Object frame)
edfda783
AR
2301{
2302 NSColor * col;
2303 check_ns ();
2304 return ns_lisp_to_color (color, &col) ? Qnil : Qt;
2305}
2306
2307
952913d4 2308DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
fb67c21b 2309 doc: /* Internal function called by `color-values', which see. */)
5842a27b 2310 (Lisp_Object color, Lisp_Object frame)
edfda783
AR
2311{
2312 NSColor * col;
09b1339d 2313 CGFloat red, green, blue, alpha;
edfda783
AR
2314
2315 check_ns ();
2316 CHECK_STRING (color);
2317
2318 if (ns_lisp_to_color (color, &col))
2319 return Qnil;
2320
2321 [[col colorUsingColorSpaceName: NSCalibratedRGBColorSpace]
2322 getRed: &red green: &green blue: &blue alpha: &alpha];
fb67c21b
YM
2323 return list3 (make_number (lrint (red*65280)),
2324 make_number (lrint (green*65280)),
2325 make_number (lrint (blue*65280)));
edfda783
AR
2326}
2327
2328
2329DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
4f4f2973 2330 doc: /* Internal function called by `display-color-p', which see. */)
5842a27b 2331 (Lisp_Object display)
edfda783
AR
2332{
2333 NSWindowDepth depth;
2334 NSString *colorSpace;
2335 check_ns ();
2336 depth = [ns_get_screen (display) depth];
2337 colorSpace = NSColorSpaceFromDepth (depth);
2338
2339 return [colorSpace isEqualToString: NSDeviceWhiteColorSpace]
2340 || [colorSpace isEqualToString: NSCalibratedWhiteColorSpace]
2341 ? Qnil : Qt;
2342}
2343
2344
2345DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p,
2346 Sx_display_grayscale_p, 0, 1, 0,
51d5ef9f 2347 doc: /* Return t if the Nextstep display supports shades of gray.
d26fbe1a
CY
2348Note that color displays do support shades of gray.
2349The optional argument DISPLAY specifies which display to ask about.
2350DISPLAY should be either a frame, a display name (a string), or terminal ID.
51d5ef9f 2351If omitted or nil, that stands for the selected frame's display. */)
5842a27b 2352 (Lisp_Object display)
edfda783
AR
2353{
2354 NSWindowDepth depth;
2355 check_ns ();
2356 depth = [ns_get_screen (display) depth];
2357
2358 return NSBitsPerPixelFromDepth (depth) > 1 ? Qt : Qnil;
2359}
2360
2361
952913d4 2362DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
edfda783 2363 0, 1, 0,
b066e6b6 2364 doc: /* Return the width in pixels of the Nextstep display DISPLAY.
d26fbe1a
CY
2365The optional argument DISPLAY specifies which display to ask about.
2366DISPLAY should be either a frame, a display name (a string), or terminal ID.
51d5ef9f 2367If omitted or nil, that stands for the selected frame's display. */)
5842a27b 2368 (Lisp_Object display)
edfda783
AR
2369{
2370 check_ns ();
2371 return make_number ((int) [ns_get_screen (display) frame].size.width);
2372}
2373
2374
952913d4
DN
2375DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
2376 Sx_display_pixel_height, 0, 1, 0,
b066e6b6 2377 doc: /* Return the height in pixels of the Nextstep display DISPLAY.
d26fbe1a
CY
2378The optional argument DISPLAY specifies which display to ask about.
2379DISPLAY should be either a frame, a display name (a string), or terminal ID.
51d5ef9f 2380If omitted or nil, that stands for the selected frame's display. */)
5842a27b 2381 (Lisp_Object display)
edfda783
AR
2382{
2383 check_ns ();
2384 return make_number ((int) [ns_get_screen (display) frame].size.height);
2385}
2386
583ff3c3 2387
edfda783
AR
2388DEFUN ("display-usable-bounds", Fns_display_usable_bounds,
2389 Sns_display_usable_bounds, 0, 1, 0,
b066e6b6 2390 doc: /* Return the bounds of the usable part of the screen.
d26fbe1a
CY
2391The return value is a list of integers (LEFT TOP WIDTH HEIGHT), which
2392are the boundaries of the usable part of the screen, excluding areas
2393reserved for the Mac menu, dock, and so forth.
2394
2395The screen queried corresponds to DISPLAY, which should be either a
2396frame, a display name (a string), or terminal ID. If omitted or nil,
51d5ef9f 2397that stands for the selected frame's display. */)
5842a27b 2398 (Lisp_Object display)
edfda783 2399{
474217c8 2400 NSScreen *screen;
edfda783
AR
2401 NSRect vScreen;
2402
2403 check_ns ();
474217c8
CY
2404 screen = ns_get_screen (display);
2405 if (!screen)
2406 return Qnil;
2407
2408 vScreen = [screen visibleFrame];
edfda783 2409
474217c8
CY
2410 /* NS coordinate system is upside-down.
2411 Transform to screen-specific coordinates. */
edfda783 2412 return list4 (make_number ((int) vScreen.origin.x),
474217c8
CY
2413 make_number ((int) [screen frame].size.height
2414 - vScreen.size.height - vScreen.origin.y),
edfda783
AR
2415 make_number ((int) vScreen.size.width),
2416 make_number ((int) vScreen.size.height));
2417}
2418
2419
952913d4 2420DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
edfda783 2421 0, 1, 0,
b066e6b6 2422 doc: /* Return the number of bitplanes of the Nextstep display DISPLAY.
d26fbe1a
CY
2423The optional argument DISPLAY specifies which display to ask about.
2424DISPLAY should be either a frame, a display name (a string), or terminal ID.
51d5ef9f 2425If omitted or nil, that stands for the selected frame's display. */)
5842a27b 2426 (Lisp_Object display)
edfda783
AR
2427{
2428 check_ns ();
2429 return make_number
b9126609 2430 (NSBitsPerPixelFromDepth ([ns_get_screen (display) depth]));
edfda783
AR
2431}
2432
2433
952913d4
DN
2434DEFUN ("x-display-color-cells", Fx_display_color_cells,
2435 Sx_display_color_cells, 0, 1, 0,
51d5ef9f 2436 doc: /* Returns the number of color cells of the Nextstep display DISPLAY.
d26fbe1a
CY
2437The optional argument DISPLAY specifies which display to ask about.
2438DISPLAY should be either a frame, a display name (a string), or terminal ID.
51d5ef9f 2439If omitted or nil, that stands for the selected frame's display. */)
5842a27b 2440 (Lisp_Object display)
edfda783 2441{
5d1d3d04 2442 struct ns_display_info *dpyinfo;
edfda783 2443 check_ns ();
5fdb398c 2444
5d1d3d04 2445 dpyinfo = check_ns_display_info (display);
edfda783
AR
2446 /* We force 24+ bit depths to 24-bit to prevent an overflow. */
2447 return make_number (1 << min (dpyinfo->n_planes, 24));
2448}
2449
2450
2451/* Unused dummy def needed for compatibility. */
2452Lisp_Object tip_frame;
2453
6fb5f7da 2454/* TODO: move to xdisp or similar */
edfda783 2455static void
3d608a86
J
2456compute_tip_xy (struct frame *f,
2457 Lisp_Object parms,
2458 Lisp_Object dx,
2459 Lisp_Object dy,
2460 int width,
2461 int height,
2462 int *root_x,
2463 int *root_y)
edfda783
AR
2464{
2465 Lisp_Object left, top;
2466 EmacsView *view = FRAME_NS_VIEW (f);
2467 NSPoint pt;
b066e6b6 2468
edfda783
AR
2469 /* Start with user-specified or mouse position. */
2470 left = Fcdr (Fassq (Qleft, parms));
edfda783 2471 top = Fcdr (Fassq (Qtop, parms));
edfda783 2472
7a18115b
J
2473 if (!INTEGERP (left) || !INTEGERP (top))
2474 {
2475 pt = last_mouse_motion_position;
2476 /* Convert to screen coordinates */
2477 pt = [view convertPoint: pt toView: nil];
2478 pt = [[view window] convertBaseToScreen: pt];
2479 }
2480 else
2481 {
2482 /* Absolute coordinates. */
2483 pt.x = XINT (left);
2484 pt.y = x_display_pixel_height (FRAME_NS_DISPLAY_INFO (f)) - XINT (top)
2485 - height;
2486 }
5fdb398c 2487
edfda783 2488 /* Ensure in bounds. (Note, screen origin = lower left.) */
7a18115b
J
2489 if (INTEGERP (left))
2490 *root_x = pt.x;
2491 else if (pt.x + XINT (dx) <= 0)
edfda783 2492 *root_x = 0; /* Can happen for negative dx */
889bd438
CY
2493 else if (pt.x + XINT (dx) + width
2494 <= x_display_pixel_width (FRAME_NS_DISPLAY_INFO (f)))
edfda783
AR
2495 /* It fits to the right of the pointer. */
2496 *root_x = pt.x + XINT (dx);
2497 else if (width + XINT (dx) <= pt.x)
2498 /* It fits to the left of the pointer. */
2499 *root_x = pt.x - width - XINT (dx);
2500 else
2501 /* Put it left justified on the screen -- it ought to fit that way. */
2502 *root_x = 0;
2503
7a18115b
J
2504 if (INTEGERP (top))
2505 *root_y = pt.y;
2506 else if (pt.y - XINT (dy) - height >= 0)
edfda783
AR
2507 /* It fits below the pointer. */
2508 *root_y = pt.y - height - XINT (dy);
889bd438
CY
2509 else if (pt.y + XINT (dy) + height
2510 <= x_display_pixel_height (FRAME_NS_DISPLAY_INFO (f)))
edfda783
AR
2511 /* It fits above the pointer */
2512 *root_y = pt.y + XINT (dy);
2513 else
2514 /* Put it on the top. */
889bd438 2515 *root_y = x_display_pixel_height (FRAME_NS_DISPLAY_INFO (f)) - height;
edfda783
AR
2516}
2517
2518
2519DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
b066e6b6 2520 doc: /* Show STRING in a \"tooltip\" window on frame FRAME.
edfda783
AR
2521A tooltip window is a small window displaying a string.
2522
4f4f2973
GM
2523This is an internal function; Lisp code should call `tooltip-show'.
2524
edfda783
AR
2525FRAME nil or omitted means use the selected frame.
2526
2527PARMS is an optional list of frame parameters which can be used to
2528change the tooltip's appearance.
2529
2530Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
2531means use the default timeout of 5 seconds.
2532
2533If the list of frame parameters PARMS contains a `left' parameter,
2534the tooltip is displayed at that x-position. Otherwise it is
2535displayed at the mouse position, with offset DX added (default is 5 if
2536DX isn't specified). Likewise for the y-position; if a `top' frame
2537parameter is specified, it determines the y-position of the tooltip
2538window, otherwise it is displayed at the mouse position, with offset
2539DY added (default is -10).
2540
2541A tooltip's maximum size is specified by `x-max-tooltip-size'.
2542Text larger than the specified size is clipped. */)
5842a27b 2543 (Lisp_Object string, Lisp_Object frame, Lisp_Object parms, Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy)
edfda783
AR
2544{
2545 int root_x, root_y;
2546 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
d311d28c 2547 ptrdiff_t count = SPECPDL_INDEX ();
edfda783
AR
2548 struct frame *f;
2549 char *str;
2550 NSSize size;
2551
2552 specbind (Qinhibit_redisplay, Qt);
2553
2554 GCPRO4 (string, parms, frame, timeout);
2555
2556 CHECK_STRING (string);
0dc8cf50 2557 str = SSDATA (string);
edfda783
AR
2558 f = check_x_frame (frame);
2559 if (NILP (timeout))
2560 timeout = make_number (5);
2561 else
2562 CHECK_NATNUM (timeout);
2563
2564 if (NILP (dx))
2565 dx = make_number (5);
2566 else
2567 CHECK_NUMBER (dx);
2568
2569 if (NILP (dy))
2570 dy = make_number (-10);
2571 else
2572 CHECK_NUMBER (dy);
2573
2574 BLOCK_INPUT;
2575 if (ns_tooltip == nil)
2576 ns_tooltip = [[EmacsTooltip alloc] init];
2577 else
2578 Fx_hide_tip ();
2579
2580 [ns_tooltip setText: str];
2581 size = [ns_tooltip frame].size;
2582
2583 /* Move the tooltip window where the mouse pointer is. Resize and
2584 show it. */
2585 compute_tip_xy (f, parms, dx, dy, (int)size.width, (int)size.height,
2586 &root_x, &root_y);
2587
2588 [ns_tooltip showAtX: root_x Y: root_y for: XINT (timeout)];
2589 UNBLOCK_INPUT;
2590
2591 UNGCPRO;
2592 return unbind_to (count, Qnil);
2593}
2594
2595
2596DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
2597 doc: /* Hide the current tooltip window, if there is any.
2598Value is t if tooltip was open, nil otherwise. */)
5842a27b 2599 (void)
edfda783
AR
2600{
2601 if (ns_tooltip == nil || ![ns_tooltip isActive])
2602 return Qnil;
2603 [ns_tooltip hide];
2604 return Qt;
2605}
2606
2607
cc98b6a0
DN
2608/* ==========================================================================
2609
2610 Class implementations
2611
2612 ========================================================================== */
2613
2614
2615@implementation EmacsSavePanel
2616#ifdef NS_IMPL_COCOA
2617/* --------------------------------------------------------------------------
2618 These are overridden to intercept on OS X: ending panel restarts NSApp
2619 event loop if it is stopped. Not sure if this is correct behavior,
2620 perhaps should check if running and if so send an appdefined.
2621 -------------------------------------------------------------------------- */
2622- (void) ok: (id)sender
2623{
2624 [super ok: sender];
2625 panelOK = 1;
2626 [NSApp stop: self];
2627}
2628- (void) cancel: (id)sender
2629{
2630 [super cancel: sender];
2631 [NSApp stop: self];
2632}
2633#endif
2634@end
2635
2636
2637@implementation EmacsOpenPanel
2638#ifdef NS_IMPL_COCOA
2639/* --------------------------------------------------------------------------
2640 These are overridden to intercept on OS X: ending panel restarts NSApp
2641 event loop if it is stopped. Not sure if this is correct behavior,
2642 perhaps should check if running and if so send an appdefined.
2643 -------------------------------------------------------------------------- */
2644- (void) ok: (id)sender
2645{
2646 [super ok: sender];
2647 panelOK = 1;
2648 [NSApp stop: self];
2649}
2650- (void) cancel: (id)sender
2651{
2652 [super cancel: sender];
2653 [NSApp stop: self];
2654}
2655#endif
2656@end
2657
2658
2659@implementation EmacsFileDelegate
2660/* --------------------------------------------------------------------------
2661 Delegate methods for Open/Save panels
2662 -------------------------------------------------------------------------- */
2663- (BOOL)panel: (id)sender isValidFilename: (NSString *)filename
2664{
2665 return YES;
2666}
2667- (BOOL)panel: (id)sender shouldShowFilename: (NSString *)filename
2668{
2669 return YES;
2670}
2671- (NSString *)panel: (id)sender userEnteredFilename: (NSString *)filename
2672 confirmed: (BOOL)okFlag
2673{
2674 return filename;
2675}
2676@end
2677
2678#endif
2679
ba301db3 2680
edfda783
AR
2681/* ==========================================================================
2682
2683 Lisp interface declaration
2684
2685 ========================================================================== */
2686
2687
2688void
3d608a86 2689syms_of_nsfns (void)
edfda783 2690{
088dcc3e 2691 Qfontsize = intern_c_string ("fontsize");
edfda783
AR
2692 staticpro (&Qfontsize);
2693
fb9d0f5a 2694 DEFVAR_LISP ("ns-icon-type-alist", Vns_icon_type_alist,
51d5ef9f 2695 doc: /* Alist of elements (REGEXP . IMAGE) for images of icons associated to frames.
d26fbe1a
CY
2696If the title of a frame matches REGEXP, then IMAGE.tiff is
2697selected as the image of the icon representing the frame when it's
2698miniaturized. If an element is t, then Emacs tries to select an icon
2699based on the filetype of the visited file.
2700
2701The images have to be installed in a folder called English.lproj in the
2702Emacs folder. You have to restart Emacs after installing new icons.
2703
2704Example: Install an icon Gnus.tiff and execute the following code
2705
2706 (setq ns-icon-type-alist
2707 (append ns-icon-type-alist
2708 '((\"^\\\\*\\\\(Group\\\\*$\\\\|Summary \\\\|Article\\\\*$\\\\)\"
2709 . \"Gnus\"))))
2710
2711When you miniaturize a Group, Summary or Article frame, Gnus.tiff will
51d5ef9f 2712be used as the image of the icon representing the frame. */);
edfda783
AR
2713 Vns_icon_type_alist = Fcons (Qt, Qnil);
2714
fb9d0f5a 2715 DEFVAR_LISP ("ns-version-string", Vns_version_string,
cb83c00b 2716 doc: /* Toolkit version for NS Windowing. */);
f5497e45 2717 Vns_version_string = ns_appkit_version_str ();
cb83c00b 2718
edfda783
AR
2719 defsubr (&Sns_read_file_name);
2720 defsubr (&Sns_get_resource);
2721 defsubr (&Sns_set_resource);
2722 defsubr (&Sxw_display_color_p); /* this and next called directly by C code */
2723 defsubr (&Sx_display_grayscale_p);
edfda783
AR
2724 defsubr (&Sns_font_name);
2725 defsubr (&Sns_list_colors);
74876614 2726#ifdef NS_IMPL_COCOA
583ff3c3 2727 defsubr (&Sns_do_applescript);
74876614 2728#endif
952913d4
DN
2729 defsubr (&Sxw_color_defined_p);
2730 defsubr (&Sxw_color_values);
2731 defsubr (&Sx_server_max_request_size);
9e50ff0c
DN
2732 defsubr (&Sx_server_vendor);
2733 defsubr (&Sx_server_version);
952913d4
DN
2734 defsubr (&Sx_display_pixel_width);
2735 defsubr (&Sx_display_pixel_height);
edfda783 2736 defsubr (&Sns_display_usable_bounds);
9e50ff0c
DN
2737 defsubr (&Sx_display_mm_width);
2738 defsubr (&Sx_display_mm_height);
2739 defsubr (&Sx_display_screens);
952913d4
DN
2740 defsubr (&Sx_display_planes);
2741 defsubr (&Sx_display_color_cells);
9e50ff0c
DN
2742 defsubr (&Sx_display_visual_class);
2743 defsubr (&Sx_display_backing_store);
2744 defsubr (&Sx_display_save_under);
2745 defsubr (&Sx_create_frame);
9e50ff0c
DN
2746 defsubr (&Sx_open_connection);
2747 defsubr (&Sx_close_connection);
2748 defsubr (&Sx_display_list);
edfda783
AR
2749
2750 defsubr (&Sns_hide_others);
2751 defsubr (&Sns_hide_emacs);
2752 defsubr (&Sns_emacs_info_panel);
2753 defsubr (&Sns_list_services);
2754 defsubr (&Sns_perform_service);
2755 defsubr (&Sns_convert_utf8_nfd_to_nfc);
9e50ff0c 2756 defsubr (&Sx_focus_frame);
edfda783
AR
2757 defsubr (&Sns_popup_font_panel);
2758 defsubr (&Sns_popup_color_panel);
2759
2760 defsubr (&Sx_show_tip);
2761 defsubr (&Sx_hide_tip);
2762
2763 /* used only in fontset.c */
2764 check_window_system_func = check_ns;
2765
08e3161a
JD
2766 as_status = 0;
2767 as_script = Qnil;
2768 as_result = 0;
edfda783 2769}