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