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