* Makefile.in (${ns_appdir}): Add touch to avoid removal with equal timestamps.
[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
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);
edfda783
AR
1178
1179 f->terminal = dpyinfo->terminal;
edfda783
AR
1180
1181 f->output_method = output_ns;
38182d90 1182 f->output_data.ns = xzalloc (sizeof *f->output_data.ns);
edfda783
AR
1183
1184 FRAME_FONTSET (f) = -1;
1185
f00af5b1
PE
1186 fset_icon_name (f, x_get_arg (dpyinfo, parms, Qicon_name,
1187 "iconName", "Title",
1188 RES_TYPE_STRING));
e69b0960 1189 if (! STRINGP (f->icon_name))
f00af5b1 1190 fset_icon_name (f, Qnil);
edfda783
AR
1191
1192 FRAME_NS_DISPLAY_INFO (f) = dpyinfo;
1193
a97f8f3f
JD
1194 /* With FRAME_NS_DISPLAY_INFO set up, this unwind-protect is safe. */
1195 record_unwind_protect (unwind_create_frame, frame);
1196
edfda783 1197 f->output_data.ns->window_desc = desc_ctr++;
d311d28c 1198 if (TYPE_RANGED_INTEGERP (Window, parent))
edfda783 1199 {
d311d28c 1200 f->output_data.ns->parent_desc = XFASTINT (parent);
edfda783
AR
1201 f->output_data.ns->explicit_parent = 1;
1202 }
1203 else
1204 {
1205 f->output_data.ns->parent_desc = FRAME_NS_DISPLAY_INFO (f)->root_window;
1206 f->output_data.ns->explicit_parent = 0;
1207 }
1208
a97f8f3f
JD
1209 /* Set the name; the functions to which we pass f expect the name to
1210 be set. */
1211 if (EQ (name, Qunbound) || NILP (name) || ! STRINGP (name))
1212 {
f00af5b1 1213 fset_name (f, build_string ([ns_app_name UTF8String]));
a97f8f3f
JD
1214 f->explicit_name = 0;
1215 }
1216 else
1217 {
f00af5b1 1218 fset_name (f, name);
a97f8f3f
JD
1219 f->explicit_name = 1;
1220 specbind (Qx_resource_name, name);
1221 }
1222
edfda783
AR
1223 f->resx = dpyinfo->resx;
1224 f->resy = dpyinfo->resy;
1225
4d7e6e51 1226 block_input ();
edfda783
AR
1227 register_font_driver (&nsfont_driver, f);
1228 x_default_parameter (f, parms, Qfont_backend, Qnil,
1229 "fontBackend", "FontBackend", RES_TYPE_STRING);
1230
1231 {
1232 /* use for default font name */
1233 id font = [NSFont userFixedPitchFontOfSize: -1.0]; /* default */
1234 tfontsize = x_default_parameter (f, parms, Qfontsize,
1235 make_number (0 /*(int)[font pointSize]*/),
1236 "fontSize", "FontSize", RES_TYPE_NUMBER);
1237 tfont = x_default_parameter (f, parms, Qfont,
1238 build_string ([[font fontName] UTF8String]),
1239 "font", "Font", RES_TYPE_STRING);
1240 }
4d7e6e51 1241 unblock_input ();
edfda783
AR
1242
1243 x_default_parameter (f, parms, Qborder_width, make_number (0),
1244 "borderwidth", "BorderWidth", RES_TYPE_NUMBER);
1245 x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
1246 "internalBorderWidth", "InternalBorderWidth",
1247 RES_TYPE_NUMBER);
1248
1249 /* default scrollbars on right on Mac */
1250 {
facfbbbd 1251 Lisp_Object spos
edfda783 1252#ifdef NS_IMPL_GNUSTEP
facfbbbd 1253 = Qt;
edfda783 1254#else
facfbbbd 1255 = Qright;
edfda783 1256#endif
facfbbbd
SM
1257 x_default_parameter (f, parms, Qvertical_scroll_bars, spos,
1258 "verticalScrollBars", "VerticalScrollBars",
1259 RES_TYPE_SYMBOL);
edfda783
AR
1260 }
1261 x_default_parameter (f, parms, Qforeground_color, build_string ("Black"),
1262 "foreground", "Foreground", RES_TYPE_STRING);
1263 x_default_parameter (f, parms, Qbackground_color, build_string ("White"),
1264 "background", "Background", RES_TYPE_STRING);
22bcf204 1265 /* FIXME: not supported yet in Nextstep */
edfda783
AR
1266 x_default_parameter (f, parms, Qline_spacing, Qnil,
1267 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
1268 x_default_parameter (f, parms, Qleft_fringe, Qnil,
1269 "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
1270 x_default_parameter (f, parms, Qright_fringe, Qnil,
1271 "rightFringe", "RightFringe", RES_TYPE_NUMBER);
edfda783 1272
ef884f23 1273#ifdef GLYPH_DEBUG
a97f8f3f
JD
1274 image_cache_refcount =
1275 FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
1276#endif
edfda783
AR
1277
1278 init_frame_faces (f);
1279
a97f8f3f 1280 /* The resources controlling the menu-bar and tool-bar are
6431f2e6
CY
1281 processed specially at startup, and reflected in the mode
1282 variables; ignore them here. */
1283 x_default_parameter (f, parms, Qmenu_bar_lines,
1284 NILP (Vmenu_bar_mode)
1285 ? make_number (0) : make_number (1),
1286 NULL, NULL, RES_TYPE_NUMBER);
1287 x_default_parameter (f, parms, Qtool_bar_lines,
1288 NILP (Vtool_bar_mode)
1289 ? make_number (0) : make_number (1),
1290 NULL, NULL, RES_TYPE_NUMBER);
1291
edfda783
AR
1292 x_default_parameter (f, parms, Qbuffer_predicate, Qnil, "bufferPredicate",
1293 "BufferPredicate", RES_TYPE_SYMBOL);
1294 x_default_parameter (f, parms, Qtitle, Qnil, "title", "Title",
1295 RES_TYPE_STRING);
1296
a0c3fad0 1297 parms = get_geometry_from_preferences (dpyinfo, parms);
edfda783
AR
1298 window_prompting = x_figure_window_size (f, parms, 1);
1299
1300 tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
1301 f->no_split = minibuffer_only || (!EQ (tem, Qunbound) && !EQ (tem, Qnil));
1302
1303 /* NOTE: on other terms, this is done in set_mouse_color, however this
d26fbe1a 1304 was not getting called under Nextstep */
edfda783
AR
1305 f->output_data.ns->text_cursor = [NSCursor IBeamCursor];
1306 f->output_data.ns->nontext_cursor = [NSCursor arrowCursor];
1307 f->output_data.ns->modeline_cursor = [NSCursor pointingHandCursor];
1308 f->output_data.ns->hand_cursor = [NSCursor pointingHandCursor];
1309 f->output_data.ns->hourglass_cursor = [NSCursor disappearingItemCursor];
1310 f->output_data.ns->horizontal_drag_cursor = [NSCursor resizeLeftRightCursor];
facfbbbd
SM
1311 FRAME_NS_DISPLAY_INFO (f)->vertical_scroll_bar_cursor
1312 = [NSCursor arrowCursor];
edfda783
AR
1313 f->output_data.ns->current_pointer = f->output_data.ns->text_cursor;
1314
1315 [[EmacsView alloc] initFrameFromEmacs: f];
1316
952913d4 1317 x_icon (f, parms);
edfda783 1318
a97f8f3f
JD
1319 /* ns_display_info does not have a reference_count. */
1320 f->terminal->reference_count++;
1321
edfda783
AR
1322 /* It is now ok to make the frame official even if we get an error below.
1323 The frame needs to be on Vframe_list or making it visible won't work. */
1324 Vframe_list = Fcons (frame, Vframe_list);
a97f8f3f
JD
1325
1326 x_default_parameter (f, parms, Qicon_type, Qnil,
1327 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
1328
1329 x_default_parameter (f, parms, Qauto_raise, Qnil,
1330 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
1331 x_default_parameter (f, parms, Qauto_lower, Qnil,
1332 "autoLower", "AutoLower", RES_TYPE_BOOLEAN);
1333 x_default_parameter (f, parms, Qcursor_type, Qbox,
1334 "cursorType", "CursorType", RES_TYPE_SYMBOL);
1335 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
1336 "scrollBarWidth", "ScrollBarWidth",
1337 RES_TYPE_NUMBER);
1338 x_default_parameter (f, parms, Qalpha, Qnil,
1339 "alpha", "Alpha", RES_TYPE_NUMBER);
04fafa46
JD
1340 x_default_parameter (f, parms, Qfullscreen, Qnil,
1341 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
edfda783
AR
1342
1343 width = FRAME_COLS (f);
1344 height = FRAME_LINES (f);
1345
1346 SET_FRAME_COLS (f, 0);
1347 FRAME_LINES (f) = 0;
1348 change_frame_size (f, height, width, 1, 0, 0);
1349
1350 if (! f->output_data.ns->explicit_parent)
1351 {
a97f8f3f
JD
1352 Lisp_Object visibility;
1353
1354 visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0,
1355 RES_TYPE_SYMBOL);
1356 if (EQ (visibility, Qunbound))
1357 visibility = Qt;
1358
1359 if (EQ (visibility, Qicon))
15891144 1360 x_iconify_frame (f);
a97f8f3f 1361 else if (! NILP (visibility))
15891144
DR
1362 {
1363 x_make_frame_visible (f);
15891144
DR
1364 [[FRAME_NS_VIEW (f) window] makeKeyWindow];
1365 }
1366 else
a97f8f3f
JD
1367 {
1368 /* Must have been Qnil. */
1369 }
edfda783
AR
1370 }
1371
1372 if (FRAME_HAS_MINIBUF_P (f)
124c9ff0
JD
1373 && (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame))
1374 || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame)))))
15dbb4d6 1375 kset_default_minibuffer_frame (kb, frame);
edfda783
AR
1376
1377 /* All remaining specified parameters, which have not been "used"
1378 by x_get_arg and friends, now go in the misc. alist of the frame. */
1379 for (tem = parms; CONSP (tem); tem = XCDR (tem))
1380 if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
f00af5b1 1381 fset_param_alist (f, Fcons (XCAR (tem), f->param_alist));
edfda783
AR
1382
1383 UNGCPRO;
a97f8f3f 1384
e543ae91
JD
1385 if (window_prompting & USPosition)
1386 x_set_offset (f, f->left_pos, f->top_pos, 1);
1387
a97f8f3f
JD
1388 /* Make sure windows on this frame appear in calls to next-window
1389 and similar functions. */
edfda783
AR
1390 Vwindow_list = Qnil;
1391
1392 return unbind_to (count, frame);
1393}
1394
1395
9e50ff0c 1396DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
edfda783
AR
1397 doc: /* Set the input focus to FRAME.
1398FRAME nil means use the selected frame. */)
5842a27b 1399 (Lisp_Object frame)
edfda783
AR
1400{
1401 struct frame *f = check_ns_frame (frame);
1402 struct ns_display_info *dpyinfo = FRAME_NS_DISPLAY_INFO (f);
1403
9e50ff0c 1404 if (dpyinfo->x_focus_frame != f)
edfda783
AR
1405 {
1406 EmacsView *view = FRAME_NS_VIEW (f);
4d7e6e51 1407 block_input ();
4acaaa2b 1408 [NSApp activateIgnoringOtherApps: YES];
edfda783 1409 [[view window] makeKeyAndOrderFront: view];
4d7e6e51 1410 unblock_input ();
edfda783
AR
1411 }
1412
1413 return Qnil;
1414}
1415
1416
edfda783 1417DEFUN ("ns-popup-font-panel", Fns_popup_font_panel, Sns_popup_font_panel,
51d5ef9f
AR
1418 0, 1, "",
1419 doc: /* Pop up the font panel. */)
5842a27b 1420 (Lisp_Object frame)
edfda783
AR
1421{
1422 id fm;
1423 struct frame *f;
1424
1425 check_ns ();
320e80c0 1426 fm = [NSFontManager sharedFontManager];
edfda783
AR
1427 if (NILP (frame))
1428 f = SELECTED_FRAME ();
1429 else
1430 {
1431 CHECK_FRAME (frame);
1432 f = XFRAME (frame);
1433 }
1434
1435 [fm setSelectedFont: ((struct nsfont_info *)f->output_data.ns->font)->nsfont
1436 isMultiple: NO];
1437 [fm orderFrontFontPanel: NSApp];
1438 return Qnil;
1439}
1440
1441
b066e6b6 1442DEFUN ("ns-popup-color-panel", Fns_popup_color_panel, Sns_popup_color_panel,
51d5ef9f
AR
1443 0, 1, "",
1444 doc: /* Pop up the color panel. */)
5842a27b 1445 (Lisp_Object frame)
edfda783
AR
1446{
1447 struct frame *f;
1448
1449 check_ns ();
1450 if (NILP (frame))
1451 f = SELECTED_FRAME ();
1452 else
1453 {
1454 CHECK_FRAME (frame);
1455 f = XFRAME (frame);
1456 }
1457
1458 [NSApp orderFrontColorPanel: NSApp];
1459 return Qnil;
1460}
1461
1462
d7e642cc 1463DEFUN ("ns-read-file-name", Fns_read_file_name, Sns_read_file_name, 1, 5, 0,
51d5ef9f 1464 doc: /* Use a graphical panel to read a file name, using prompt PROMPT.
d26fbe1a 1465Optional arg DIR, if non-nil, supplies a default directory.
45cb8994
CY
1466Optional arg MUSTMATCH, if non-nil, means the returned file or
1467directory must exist.
d7e642cc
JD
1468Optional arg INIT, if non-nil, provides a default file name to use.
1469Optional arg DIR_ONLY_P, if non-nil, means choose only directories. */)
1470 (Lisp_Object prompt, Lisp_Object dir, Lisp_Object mustmatch,
1471 Lisp_Object init, Lisp_Object dir_only_p)
edfda783
AR
1472{
1473 static id fileDelegate = nil;
1474 int ret;
1475 id panel;
ba301db3 1476 Lisp_Object fname;
edfda783
AR
1477
1478 NSString *promptS = NILP (prompt) || !STRINGP (prompt) ? nil :
0dc8cf50 1479 [NSString stringWithUTF8String: SSDATA (prompt)];
edfda783 1480 NSString *dirS = NILP (dir) || !STRINGP (dir) ?
0dc8cf50
JD
1481 [NSString stringWithUTF8String: SSDATA (BVAR (current_buffer, directory))] :
1482 [NSString stringWithUTF8String: SSDATA (dir)];
edfda783 1483 NSString *initS = NILP (init) || !STRINGP (init) ? nil :
0dc8cf50 1484 [NSString stringWithUTF8String: SSDATA (init)];
edfda783
AR
1485
1486 check_ns ();
1487
1488 if (fileDelegate == nil)
1489 fileDelegate = [EmacsFileDelegate new];
1490
1491 [NSCursor setHiddenUntilMouseMoves: NO];
1492
1493 if ([dirS characterAtIndex: 0] == '~')
1494 dirS = [dirS stringByExpandingTildeInPath];
1495
d7e642cc 1496 panel = NILP (mustmatch) && NILP (dir_only_p) ?
f2f7f42c 1497 (id)[EmacsSavePanel savePanel] : (id)[EmacsOpenPanel openPanel];
edfda783
AR
1498
1499 [panel setTitle: promptS];
1500
d7e642cc 1501 [panel setAllowsOtherFileTypes: YES];
edfda783
AR
1502 [panel setTreatsFilePackagesAsDirectories: YES];
1503 [panel setDelegate: fileDelegate];
1504
1505 panelOK = 0;
677d5c92 1506 if (! NILP (dir_only_p))
d7e642cc
JD
1507 {
1508 [panel setCanChooseDirectories: YES];
1509 [panel setCanChooseFiles: NO];
1510 }
677d5c92 1511
4d7e6e51 1512 block_input ();
d7e642cc
JD
1513#if defined (NS_IMPL_COCOA) && \
1514 MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
1515 if (! NILP (mustmatch) || ! NILP (dir_only_p))
1516 [panel setAllowedFileTypes: nil];
1517 if (dirS) [panel setDirectoryURL: [NSURL fileURLWithPath: dirS]];
1518 if (initS && NILP (Ffile_directory_p (init)))
1519 [panel setNameFieldStringValue: [initS lastPathComponent]];
1520 else
1521 [panel setNameFieldStringValue: @""];
677d5c92 1522
d7e642cc
JD
1523 ret = [panel runModal];
1524#else
1525 if (NILP (mustmatch) && NILP (dir_only_p))
edfda783
AR
1526 {
1527 ret = [panel runModalForDirectory: dirS file: initS];
1528 }
1529 else
1530 {
1531 [panel setCanChooseDirectories: YES];
1532 ret = [panel runModalForDirectory: dirS file: initS types: nil];
1533 }
d7e642cc 1534#endif
edfda783 1535
575fb8bd 1536 ret = (ret == NSOKButton) || panelOK;
edfda783 1537
ba301db3
AR
1538 if (ret)
1539 fname = build_string ([[panel filename] UTF8String]);
b066e6b6 1540
edfda783 1541 [[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow];
4d7e6e51 1542 unblock_input ();
edfda783 1543
ba301db3 1544 return ret ? fname : Qnil;
edfda783
AR
1545}
1546
f7dfe5d6
JD
1547const char *
1548ns_get_defaults_value (const char *key)
1549{
1550 NSObject *obj = [[NSUserDefaults standardUserDefaults]
1551 objectForKey: [NSString stringWithUTF8String: key]];
1552
1553 if (!obj) return NULL;
1554
1555 return [[NSString stringWithFormat: @"%@", obj] UTF8String];
1556}
1557
edfda783
AR
1558
1559DEFUN ("ns-get-resource", Fns_get_resource, Sns_get_resource, 2, 2, 0,
51d5ef9f
AR
1560 doc: /* Return the value of the property NAME of OWNER from the defaults database.
1561If OWNER is nil, Emacs is assumed. */)
5842a27b 1562 (Lisp_Object owner, Lisp_Object name)
edfda783
AR
1563{
1564 const char *value;
1565
1566 check_ns ();
1567 if (NILP (owner))
56d513e6 1568 owner = build_string([ns_app_name UTF8String]);
edfda783 1569 CHECK_STRING (name);
0dc8cf50 1570/*fprintf (stderr, "ns-get-resource checking resource '%s'\n", SSDATA (name)); */
edfda783 1571
0dc8cf50 1572 value = ns_get_defaults_value (SSDATA (name));
edfda783
AR
1573
1574 if (value)
1575 return build_string (value);
edfda783
AR
1576 return Qnil;
1577}
1578
1579
1580DEFUN ("ns-set-resource", Fns_set_resource, Sns_set_resource, 3, 3, 0,
51d5ef9f 1581 doc: /* Set property NAME of OWNER to VALUE, from the defaults database.
d26fbe1a 1582If OWNER is nil, Emacs is assumed.
51d5ef9f 1583If VALUE is nil, the default is removed. */)
5842a27b 1584 (Lisp_Object owner, Lisp_Object name, Lisp_Object value)
edfda783
AR
1585{
1586 check_ns ();
1587 if (NILP (owner))
56d513e6 1588 owner = build_string ([ns_app_name UTF8String]);
edfda783
AR
1589 CHECK_STRING (name);
1590 if (NILP (value))
1591 {
1592 [[NSUserDefaults standardUserDefaults] removeObjectForKey:
0dc8cf50 1593 [NSString stringWithUTF8String: SSDATA (name)]];
edfda783
AR
1594 }
1595 else
1596 {
1597 CHECK_STRING (value);
1598 [[NSUserDefaults standardUserDefaults] setObject:
0dc8cf50 1599 [NSString stringWithUTF8String: SSDATA (value)]
edfda783 1600 forKey: [NSString stringWithUTF8String:
0dc8cf50 1601 SSDATA (name)]];
edfda783
AR
1602 }
1603
1604 return Qnil;
1605}
1606
1607
952913d4
DN
1608DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
1609 Sx_server_max_request_size,
edfda783 1610 0, 1, 0,
51d5ef9f 1611 doc: /* This function is a no-op. It is only present for completeness. */)
5842a27b 1612 (Lisp_Object display)
edfda783
AR
1613{
1614 check_ns ();
1615 /* This function has no real equivalent under NeXTstep. Return nil to
1616 indicate this. */
1617 return Qnil;
1618}
1619
1620
9e50ff0c 1621DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
51d5ef9f 1622 doc: /* Return the vendor ID string of Nextstep display server DISPLAY.
d26fbe1a 1623DISPLAY should be either a frame or a display name (a string).
51d5ef9f 1624If omitted or nil, the selected frame's display is used. */)
5842a27b 1625 (Lisp_Object display)
edfda783 1626{
edfda783
AR
1627#ifdef NS_IMPL_GNUSTEP
1628 return build_string ("GNU");
1629#else
1630 return build_string ("Apple");
1631#endif
1632}
1633
1634
9e50ff0c 1635DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
f5497e45
AR
1636 doc: /* Return the version numbers of the server of DISPLAY.
1637The value is a list of three integers: the major and minor
1638version numbers of the X Protocol in use, and the distributor-specific
1639release number. See also the function `x-server-vendor'.
1640
1641The optional argument DISPLAY specifies which display to ask about.
d26fbe1a 1642DISPLAY should be either a frame or a display name (a string).
f5497e45 1643If omitted or nil, that stands for the selected frame's display. */)
5842a27b 1644 (Lisp_Object display)
edfda783 1645{
f5497e45
AR
1646 /*NOTE: it is unclear what would best correspond with "protocol";
1647 we return 10.3, meaning Panther, since this is roughly the
1648 level that GNUstep's APIs correspond to.
1649 The last number is where we distinguish between the Apple
1650 and GNUstep implementations ("distributor-specific release
1651 number") and give int'ized versions of major.minor. */
3de717bd 1652 return list3i (10, 3, ns_appkit_version_int ());
edfda783
AR
1653}
1654
1655
9e50ff0c 1656DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
51d5ef9f 1657 doc: /* Return the number of screens on Nextstep display server DISPLAY.
d26fbe1a 1658DISPLAY should be a frame, the display name as a string, or a terminal ID.
51d5ef9f 1659If omitted or nil, the selected frame's display is used. */)
5842a27b 1660 (Lisp_Object display)
edfda783
AR
1661{
1662 int num;
1663
1664 check_ns ();
1665 num = [[NSScreen screens] count];
1666
1667 return (num != 0) ? make_number (num) : Qnil;
1668}
1669
1670
9e50ff0c 1671DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height,
edfda783 1672 0, 1, 0,
51d5ef9f 1673 doc: /* Return the height of Nextstep display server DISPLAY, in millimeters.
d26fbe1a 1674DISPLAY should be a frame, the display name as a string, or a terminal ID.
51d5ef9f 1675If omitted or nil, the selected frame's display is used. */)
5842a27b 1676 (Lisp_Object display)
edfda783
AR
1677{
1678 check_ns ();
1679 return make_number ((int)
1680 ([ns_get_screen (display) frame].size.height/(92.0/25.4)));
1681}
1682
1683
9e50ff0c 1684DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width,
edfda783 1685 0, 1, 0,
51d5ef9f 1686 doc: /* Return the width of Nextstep display server DISPLAY, in millimeters.
d26fbe1a 1687DISPLAY should be a frame, the display name as a string, or a terminal ID.
51d5ef9f 1688If omitted or nil, the selected frame's display is used. */)
5842a27b 1689 (Lisp_Object display)
edfda783
AR
1690{
1691 check_ns ();
1692 return make_number ((int)
1693 ([ns_get_screen (display) frame].size.width/(92.0/25.4)));
1694}
1695
1696
9e50ff0c 1697DEFUN ("x-display-backing-store", Fx_display_backing_store,
51d5ef9f 1698 Sx_display_backing_store, 0, 1, 0,
09e80d9f 1699 doc: /* Return whether the Nextstep display DISPLAY supports backing store.
d26fbe1a
CY
1700The value may be `buffered', `retained', or `non-retained'.
1701DISPLAY should be a frame, the display name as a string, or a terminal ID.
51d5ef9f 1702If omitted or nil, the selected frame's display is used. */)
5842a27b 1703 (Lisp_Object display)
edfda783
AR
1704{
1705 check_ns ();
1706 switch ([ns_get_window (display) backingType])
1707 {
1708 case NSBackingStoreBuffered:
1709 return intern ("buffered");
1710 case NSBackingStoreRetained:
1711 return intern ("retained");
1712 case NSBackingStoreNonretained:
1713 return intern ("non-retained");
1714 default:
1715 error ("Strange value for backingType parameter of frame");
1716 }
1717 return Qnil; /* not reached, shut compiler up */
1718}
1719
1720
9e50ff0c 1721DEFUN ("x-display-visual-class", Fx_display_visual_class,
51d5ef9f
AR
1722 Sx_display_visual_class, 0, 1, 0,
1723 doc: /* Return the visual class of the Nextstep display server DISPLAY.
d26fbe1a
CY
1724The value is one of the symbols `static-gray', `gray-scale',
1725`static-color', `pseudo-color', `true-color', or `direct-color'.
1726DISPLAY should be a frame, the display name as a string, or a terminal ID.
51d5ef9f 1727If omitted or nil, the selected frame's display is used. */)
5842a27b 1728 (Lisp_Object display)
edfda783
AR
1729{
1730 NSWindowDepth depth;
1731 check_ns ();
1732 depth = [ns_get_screen (display) depth];
1733
1734 if ( depth == NSBestDepth (NSCalibratedWhiteColorSpace, 2, 2, YES, NULL))
1735 return intern ("static-gray");
1736 else if (depth == NSBestDepth (NSCalibratedWhiteColorSpace, 8, 8, YES, NULL))
1737 return intern ("gray-scale");
1738 else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 8, YES, NULL))
1739 return intern ("pseudo-color");
1740 else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 4, 12, NO, NULL))
1741 return intern ("true-color");
1742 else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 24, NO, NULL))
1743 return intern ("direct-color");
1744 else
d26fbe1a 1745 /* color mgmt as far as we do it is really handled by Nextstep itself anyway */
edfda783
AR
1746 return intern ("direct-color");
1747}
1748
1749
9e50ff0c 1750DEFUN ("x-display-save-under", Fx_display_save_under,
51d5ef9f 1751 Sx_display_save_under, 0, 1, 0,
4f4f2973 1752 doc: /* Return t if DISPLAY supports the save-under feature.
d26fbe1a
CY
1753The optional argument DISPLAY specifies which display to ask about.
1754DISPLAY should be a frame, the display name as a string, or a terminal ID.
51d5ef9f 1755If omitted or nil, the selected frame's display is used. */)
5842a27b 1756 (Lisp_Object display)
edfda783
AR
1757{
1758 check_ns ();
1759 switch ([ns_get_window (display) backingType])
1760 {
1761 case NSBackingStoreBuffered:
1762 return Qt;
1763
1764 case NSBackingStoreRetained:
1765 case NSBackingStoreNonretained:
1766 return Qnil;
1767
1768 default:
1769 error ("Strange value for backingType parameter of frame");
1770 }
1771 return Qnil; /* not reached, shut compiler up */
1772}
1773
1774
9e50ff0c 1775DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
51d5ef9f 1776 1, 3, 0,
4f4f2973 1777 doc: /* Open a connection to a display server.
d26fbe1a 1778DISPLAY is the name of the display to connect to.
4f4f2973
GM
1779Optional second arg XRM-STRING is a string of resources in xrdb format.
1780If the optional third arg MUST-SUCCEED is non-nil,
1781terminate Emacs if we can't open the connection.
1782\(In the Nextstep version, the last two arguments are currently ignored.) */)
5842a27b 1783 (Lisp_Object display, Lisp_Object resource_string, Lisp_Object must_succeed)
edfda783
AR
1784{
1785 struct ns_display_info *dpyinfo;
1786
1787 CHECK_STRING (display);
1788
1789 nxatoms_of_nsselect ();
1790 dpyinfo = ns_term_init (display);
1791 if (dpyinfo == 0)
1792 {
1793 if (!NILP (must_succeed))
1794 fatal ("OpenStep on %s not responding.\n",
0dc8cf50 1795 SSDATA (display));
edfda783
AR
1796 else
1797 error ("OpenStep on %s not responding.\n",
0dc8cf50 1798 SSDATA (display));
edfda783
AR
1799 }
1800
edfda783
AR
1801 return Qnil;
1802}
1803
1804
9e50ff0c 1805DEFUN ("x-close-connection", Fx_close_connection, Sx_close_connection,
51d5ef9f
AR
1806 1, 1, 0,
1807 doc: /* Close the connection to the current Nextstep display server.
b066e6b6 1808The argument DISPLAY is currently ignored. */)
5842a27b 1809 (Lisp_Object display)
edfda783
AR
1810{
1811 check_ns ();
edfda783
AR
1812 /*ns_delete_terminal (dpyinfo->terminal); */
1813 [NSApp terminate: NSApp];
1814 return Qnil;
1815}
1816
1817
9e50ff0c 1818DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
51d5ef9f 1819 doc: /* Return the list of display names that Emacs has connections to. */)
5842a27b 1820 (void)
edfda783
AR
1821{
1822 Lisp_Object tail, result;
1823
1824 result = Qnil;
1825 for (tail = ns_display_name_list; CONSP (tail); tail = XCDR (tail))
1826 result = Fcons (XCAR (XCAR (tail)), result);
1827
1828 return result;
1829}
1830
1831
1832DEFUN ("ns-hide-others", Fns_hide_others, Sns_hide_others,
51d5ef9f 1833 0, 0, 0,
b066e6b6 1834 doc: /* Hides all applications other than Emacs. */)
5842a27b 1835 (void)
edfda783
AR
1836{
1837 check_ns ();
1838 [NSApp hideOtherApplications: NSApp];
1839 return Qnil;
1840}
1841
1842DEFUN ("ns-hide-emacs", Fns_hide_emacs, Sns_hide_emacs,
51d5ef9f 1843 1, 1, 0,
b066e6b6
JB
1844 doc: /* If ON is non-nil, the entire Emacs application is hidden.
1845Otherwise if Emacs is hidden, it is unhidden.
1846If ON is equal to `activate', Emacs is unhidden and becomes
51d5ef9f 1847the active application. */)
5842a27b 1848 (Lisp_Object on)
edfda783
AR
1849{
1850 check_ns ();
1851 if (EQ (on, intern ("activate")))
1852 {
1853 [NSApp unhide: NSApp];
1854 [NSApp activateIgnoringOtherApps: YES];
1855 }
1856 else if (NILP (on))
1857 [NSApp unhide: NSApp];
1858 else
1859 [NSApp hide: NSApp];
1860 return Qnil;
1861}
1862
1863
1864DEFUN ("ns-emacs-info-panel", Fns_emacs_info_panel, Sns_emacs_info_panel,
51d5ef9f
AR
1865 0, 0, 0,
1866 doc: /* Shows the 'Info' or 'About' panel for Emacs. */)
5842a27b 1867 (void)
edfda783
AR
1868{
1869 check_ns ();
1870 [NSApp orderFrontStandardAboutPanel: nil];
1871 return Qnil;
1872}
1873
1874
edfda783 1875DEFUN ("ns-font-name", Fns_font_name, Sns_font_name, 1, 1, 0,
7877f373 1876 doc: /* Determine font PostScript or family name for font NAME.
d26fbe1a
CY
1877NAME should be a string containing either the font name or an XLFD
1878font descriptor. If string contains `fontset' and not
51d5ef9f 1879`fontset-startup', it is left alone. */)
5842a27b 1880 (Lisp_Object name)
edfda783
AR
1881{
1882 char *nm;
1883 CHECK_STRING (name);
0dc8cf50 1884 nm = SSDATA (name);
edfda783
AR
1885
1886 if (nm[0] != '-')
1887 return name;
1888 if (strstr (nm, "fontset") && !strstr (nm, "fontset-startup"))
1889 return name;
1890
0dc8cf50 1891 return build_string (ns_xlfd_to_fontname (SSDATA (name)));
edfda783
AR
1892}
1893
1894
1895DEFUN ("ns-list-colors", Fns_list_colors, Sns_list_colors, 0, 1, 0,
51d5ef9f
AR
1896 doc: /* Return a list of all available colors.
1897The optional argument FRAME is currently ignored. */)
5842a27b 1898 (Lisp_Object frame)
edfda783
AR
1899{
1900 Lisp_Object list = Qnil;
1901 NSEnumerator *colorlists;
1902 NSColorList *clist;
1903
1904 if (!NILP (frame))
1905 {
1906 CHECK_FRAME (frame);
1907 if (! FRAME_NS_P (XFRAME (frame)))
d26fbe1a 1908 error ("non-Nextstep frame used in `ns-list-colors'");
edfda783
AR
1909 }
1910
4d7e6e51 1911 block_input ();
edfda783
AR
1912
1913 colorlists = [[NSColorList availableColorLists] objectEnumerator];
0dc8cf50 1914 while ((clist = [colorlists nextObject]))
edfda783
AR
1915 {
1916 if ([[clist name] length] < 7 ||
1917 [[clist name] rangeOfString: @"PANTONE"].location == 0)
1918 {
1919 NSEnumerator *cnames = [[clist allKeys] reverseObjectEnumerator];
1920 NSString *cname;
0dc8cf50 1921 while ((cname = [cnames nextObject]))
edfda783
AR
1922 list = Fcons (build_string ([cname UTF8String]), list);
1923/* for (i = [[clist allKeys] count] - 1; i >= 0; i--)
1924 list = Fcons (build_string ([[[clist allKeys] objectAtIndex: i]
1925 UTF8String]), list); */
1926 }
1927 }
1928
4d7e6e51 1929 unblock_input ();
edfda783
AR
1930
1931 return list;
1932}
1933
1934
1935DEFUN ("ns-list-services", Fns_list_services, Sns_list_services, 0, 0, 0,
51d5ef9f 1936 doc: /* List available Nextstep services by querying NSApp. */)
5842a27b 1937 (void)
edfda783 1938{
699c10bd
JD
1939#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
1940 /* You can't get services like this in 10.6+. */
1941 return Qnil;
1942#else
edfda783
AR
1943 Lisp_Object ret = Qnil;
1944 NSMenu *svcs;
1945 id delegate;
1946
1947 check_ns ();
1948 svcs = [[NSMenu alloc] initWithTitle: @"Services"];
335f5ae4 1949 [NSApp setServicesMenu: svcs];
edfda783
AR
1950 [NSApp registerServicesMenuSendTypes: ns_send_types
1951 returnTypes: ns_return_types];
1952
1953/* On Tiger, services menu updating was made lazier (waits for user to
1954 actually click on the menu), so we have to force things along: */
1955#ifdef NS_IMPL_COCOA
335f5ae4
JD
1956 delegate = [svcs delegate];
1957 if (delegate != nil)
edfda783 1958 {
335f5ae4
JD
1959 if ([delegate respondsToSelector: @selector (menuNeedsUpdate:)])
1960 [delegate menuNeedsUpdate: svcs];
1961 if ([delegate respondsToSelector:
1962 @selector (menu:updateItem:atIndex:shouldCancel:)])
edfda783 1963 {
335f5ae4
JD
1964 int i, len = [delegate numberOfItemsInMenu: svcs];
1965 for (i =0; i<len; i++)
1966 [svcs addItemWithTitle: @"" action: NULL keyEquivalent: @""];
1967 for (i =0; i<len; i++)
1968 if (![delegate menu: svcs
1969 updateItem: (NSMenuItem *)[svcs itemAtIndex: i]
1970 atIndex: i shouldCancel: NO])
1971 break;
edfda783
AR
1972 }
1973 }
1974#endif
1975
1976 [svcs setAutoenablesItems: NO];
1977#ifdef NS_IMPL_COCOA
1978 [svcs update]; /* on OS X, converts from '/' structure */
1979#endif
1980
1981 ret = interpret_services_menu (svcs, Qnil, ret);
1982 return ret;
699c10bd 1983#endif
edfda783
AR
1984}
1985
1986
1987DEFUN ("ns-perform-service", Fns_perform_service, Sns_perform_service,
51d5ef9f
AR
1988 2, 2, 0,
1989 doc: /* Perform Nextstep SERVICE on SEND.
d26fbe1a
CY
1990SEND should be either a string or nil.
1991The return value is the result of the service, as string, or nil if
51d5ef9f 1992there was no result. */)
5842a27b 1993 (Lisp_Object service, Lisp_Object send)
edfda783
AR
1994{
1995 id pb;
1996 NSString *svcName;
1997 char *utfStr;
edfda783
AR
1998
1999 CHECK_STRING (service);
2000 check_ns ();
2001
0dc8cf50 2002 utfStr = SSDATA (service);
edfda783
AR
2003 svcName = [NSString stringWithUTF8String: utfStr];
2004
2005 pb =[NSPasteboard pasteboardWithUniqueName];
2006 ns_string_to_pasteboard (pb, send);
2007
2008 if (NSPerformService (svcName, pb) == NO)
2009 Fsignal (Qquit, Fcons (build_string ("service not available"), Qnil));
2010
2011 if ([[pb types] count] == 0)
2012 return build_string ("");
2013 return ns_string_from_pasteboard (pb);
2014}
2015
2016
2017DEFUN ("ns-convert-utf8-nfd-to-nfc", Fns_convert_utf8_nfd_to_nfc,
2018 Sns_convert_utf8_nfd_to_nfc, 1, 1, 0,
b066e6b6 2019 doc: /* Return an NFC string that matches the UTF-8 NFD string STR. */)
5842a27b 2020 (Lisp_Object str)
edfda783 2021{
f2f7f42c
AR
2022/* TODO: If GNUstep ever implements precomposedStringWithCanonicalMapping,
2023 remove this. */
edfda783
AR
2024 NSString *utfStr;
2025
2026 CHECK_STRING (str);
0dc8cf50 2027 utfStr = [NSString stringWithUTF8String: SSDATA (str)];
f2f7f42c
AR
2028 if (![utfStr respondsToSelector:
2029 @selector (precomposedStringWithCanonicalMapping)])
2030 {
2031 message1
2032 ("Warning: ns-convert-utf8-nfd-to-nfc unsupported under GNUstep.\n");
2033 return Qnil;
2034 }
2035 else
2036 utfStr = [utfStr precomposedStringWithCanonicalMapping];
edfda783
AR
2037 return build_string ([utfStr UTF8String]);
2038}
2039
2040
583ff3c3
AR
2041#ifdef NS_IMPL_COCOA
2042
2043/* Compile and execute the AppleScript SCRIPT and return the error
2044 status as function value. A zero is returned if compilation and
2045 execution is successful, in which case *RESULT is set to a Lisp
2046 string or a number containing the resulting script value. Otherwise,
2047 1 is returned. */
2048static int
3d608a86 2049ns_do_applescript (Lisp_Object script, Lisp_Object *result)
583ff3c3
AR
2050{
2051 NSAppleEventDescriptor *desc;
2052 NSDictionary* errorDict;
2053 NSAppleEventDescriptor* returnDescriptor = NULL;
2054
2055 NSAppleScript* scriptObject =
2056 [[NSAppleScript alloc] initWithSource:
0dc8cf50 2057 [NSString stringWithUTF8String: SSDATA (script)]];
583ff3c3
AR
2058
2059 returnDescriptor = [scriptObject executeAndReturnError: &errorDict];
2060 [scriptObject release];
b066e6b6 2061
583ff3c3 2062 *result = Qnil;
b066e6b6 2063
583ff3c3
AR
2064 if (returnDescriptor != NULL)
2065 {
2066 // successful execution
2067 if (kAENullEvent != [returnDescriptor descriptorType])
2068 {
2069 *result = Qt;
2070 // script returned an AppleScript result
2071 if ((typeUnicodeText == [returnDescriptor descriptorType]) ||
335f5ae4 2072#if defined (NS_IMPL_COCOA)
b066e6b6 2073 (typeUTF16ExternalRepresentation
583ff3c3 2074 == [returnDescriptor descriptorType]) ||
a39e2539 2075#endif
583ff3c3
AR
2076 (typeUTF8Text == [returnDescriptor descriptorType]) ||
2077 (typeCString == [returnDescriptor descriptorType]))
2078 {
2079 desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
2080 if (desc)
2081 *result = build_string([[desc stringValue] UTF8String]);
2082 }
2083 else
2084 {
2085 /* use typeUTF16ExternalRepresentation? */
2086 // coerce the result to the appropriate ObjC type
2087 desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
2088 if (desc)
2089 *result = make_number([desc int32Value]);
2090 }
2091 }
2092 }
2093 else
2094 {
2095 // no script result, return error
2096 return 1;
2097 }
2098 return 0;
2099}
2100
08e3161a
JD
2101/* Helper function called from sendEvent to run applescript
2102 from within the main event loop. */
2103
2104void
2105ns_run_ascript (void)
2106{
cf162aee
JD
2107 if (! NILP (as_script))
2108 as_status = ns_do_applescript (as_script, as_result);
2109 as_script = Qnil;
08e3161a
JD
2110}
2111
583ff3c3 2112DEFUN ("ns-do-applescript", Fns_do_applescript, Sns_do_applescript, 1, 1, 0,
b066e6b6
JB
2113 doc: /* Execute AppleScript SCRIPT and return the result.
2114If compilation and execution are successful, the resulting script value
2115is returned as a string, a number or, in the case of other constructs, t.
2116In case the execution fails, an error is signaled. */)
5842a27b 2117 (Lisp_Object script)
583ff3c3
AR
2118{
2119 Lisp_Object result;
5fdb398c 2120 int status;
08e3161a 2121 NSEvent *nxev;
583ff3c3
AR
2122
2123 CHECK_STRING (script);
2124 check_ns ();
2125
4d7e6e51 2126 block_input ();
08e3161a
JD
2127
2128 as_script = script;
2129 as_result = &result;
2130
2131 /* executing apple script requires the event loop to run, otherwise
2132 errors aren't returned and executeAndReturnError hangs forever.
2133 Post an event that runs applescript and then start the event loop.
2134 The event loop is exited when the script is done. */
2135 nxev = [NSEvent otherEventWithType: NSApplicationDefined
2136 location: NSMakePoint (0, 0)
2137 modifierFlags: 0
2138 timestamp: 0
2139 windowNumber: [[NSApp mainWindow] windowNumber]
2140 context: [NSApp context]
2141 subtype: 0
2142 data1: 0
2143 data2: NSAPP_DATA2_RUNASSCRIPT];
2144
2145 [NSApp postEvent: nxev atStart: NO];
cf162aee
JD
2146
2147 // If there are other events, the event loop may exit. Keep running
677d5c92 2148 // until the script has been handled. */
cf162aee
JD
2149 while (! NILP (as_script))
2150 [NSApp run];
08e3161a
JD
2151
2152 status = as_status;
2153 as_status = 0;
08e3161a 2154 as_result = 0;
4d7e6e51 2155 unblock_input ();
583ff3c3
AR
2156 if (status == 0)
2157 return result;
2158 else if (!STRINGP (result))
2159 error ("AppleScript error %d", status);
2160 else
0dc8cf50 2161 error ("%s", SSDATA (result));
583ff3c3
AR
2162}
2163#endif
2164
2165
2166
edfda783
AR
2167/* ==========================================================================
2168
2169 Miscellaneous functions not called through hooks
2170
2171 ========================================================================== */
2172
2173
3fe53a83 2174/* called from image.c */
edfda783
AR
2175FRAME_PTR
2176check_x_frame (Lisp_Object frame)
2177{
2178 return check_ns_frame (frame);
2179}
2180
3fe53a83
AR
2181
2182/* called from frame.c */
edfda783
AR
2183struct ns_display_info *
2184check_x_display_info (Lisp_Object frame)
2185{
2186 return check_ns_display_info (frame);
2187}
2188
2189
edfda783 2190void
3d608a86 2191x_set_scroll_bar_default_width (struct frame *f)
edfda783
AR
2192{
2193 int wid = FRAME_COLUMN_WIDTH (f);
2194 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = NS_SCROLL_BAR_WIDTH_DEFAULT;
2195 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) +
2196 wid - 1) / wid;
2197}
2198
2199
3fe53a83 2200/* terms impl this instead of x-get-resource directly */
edfda783
AR
2201const char *
2202x_get_string_resource (XrmDatabase rdb, char *name, char *class)
2203{
6fb5f7da 2204 /* remove appname prefix; TODO: allow for !="Emacs" */
edfda783
AR
2205 char *toCheck = class + (!strncmp (class, "Emacs.", 6) ? 6 : 0);
2206 const char *res;
2207 check_ns ();
2208
386a49d3
AR
2209 if (inhibit_x_resources)
2210 /* --quick was passed, so this is a no-op. */
2211 return NULL;
edfda783 2212
f7dfe5d6 2213 res = ns_get_defaults_value (toCheck);
edfda783 2214 return !res ? NULL :
fee5959d
PE
2215 (!c_strncasecmp (res, "YES", 3) ? "true" :
2216 (!c_strncasecmp (res, "NO", 2) ? "false" : res));
edfda783
AR
2217}
2218
2219
2220Lisp_Object
2221x_get_focus_frame (struct frame *frame)
2222{
2223 struct ns_display_info *dpyinfo = FRAME_NS_DISPLAY_INFO (frame);
2224 Lisp_Object nsfocus;
2225
9e50ff0c 2226 if (!dpyinfo->x_focus_frame)
edfda783
AR
2227 return Qnil;
2228
9e50ff0c 2229 XSETFRAME (nsfocus, dpyinfo->x_focus_frame);
edfda783
AR
2230 return nsfocus;
2231}
2232
2233
2234int
2235x_pixel_width (struct frame *f)
2236{
2237 return FRAME_PIXEL_WIDTH (f);
2238}
2239
2240
2241int
2242x_pixel_height (struct frame *f)
2243{
2244 return FRAME_PIXEL_HEIGHT (f);
2245}
2246
2247
edfda783
AR
2248int
2249x_screen_planes (struct frame *f)
2250{
2251 return FRAME_NS_DISPLAY_INFO (f)->n_planes;
2252}
2253
2254
2255void
3d608a86 2256x_sync (struct frame *f)
edfda783
AR
2257{
2258 /* XXX Not implemented XXX */
2259 return;
2260}
2261
2262
2263
2264/* ==========================================================================
2265
2266 Lisp definitions that, for whatever reason, we can't alias as 'ns-XXX'.
2267
2268 ========================================================================== */
2269
2270
952913d4 2271DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
4f4f2973
GM
2272 doc: /* Internal function called by `color-defined-p', which see.
2273\(Note that the Nextstep version of this function ignores FRAME.) */)
5842a27b 2274 (Lisp_Object color, Lisp_Object frame)
edfda783
AR
2275{
2276 NSColor * col;
2277 check_ns ();
2278 return ns_lisp_to_color (color, &col) ? Qnil : Qt;
2279}
2280
2281
952913d4 2282DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
fb67c21b 2283 doc: /* Internal function called by `color-values', which see. */)
5842a27b 2284 (Lisp_Object color, Lisp_Object frame)
edfda783
AR
2285{
2286 NSColor * col;
09b1339d 2287 CGFloat red, green, blue, alpha;
edfda783
AR
2288
2289 check_ns ();
2290 CHECK_STRING (color);
2291
2292 if (ns_lisp_to_color (color, &col))
2293 return Qnil;
2294
2295 [[col colorUsingColorSpaceName: NSCalibratedRGBColorSpace]
2296 getRed: &red green: &green blue: &blue alpha: &alpha];
3de717bd
DA
2297 return list3i (lrint (red * 65280), lrint (green * 65280),
2298 lrint (blue * 65280));
edfda783
AR
2299}
2300
2301
2302DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
4f4f2973 2303 doc: /* Internal function called by `display-color-p', which see. */)
5842a27b 2304 (Lisp_Object display)
edfda783
AR
2305{
2306 NSWindowDepth depth;
2307 NSString *colorSpace;
2308 check_ns ();
2309 depth = [ns_get_screen (display) depth];
2310 colorSpace = NSColorSpaceFromDepth (depth);
2311
2312 return [colorSpace isEqualToString: NSDeviceWhiteColorSpace]
2313 || [colorSpace isEqualToString: NSCalibratedWhiteColorSpace]
2314 ? Qnil : Qt;
2315}
2316
2317
2318DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p,
2319 Sx_display_grayscale_p, 0, 1, 0,
51d5ef9f 2320 doc: /* Return t if the Nextstep display supports shades of gray.
d26fbe1a
CY
2321Note that color displays do support shades of gray.
2322The optional argument DISPLAY specifies which display to ask about.
2323DISPLAY should be either a frame, a display name (a string), or terminal ID.
51d5ef9f 2324If omitted or nil, that stands for the selected frame's display. */)
5842a27b 2325 (Lisp_Object display)
edfda783
AR
2326{
2327 NSWindowDepth depth;
2328 check_ns ();
2329 depth = [ns_get_screen (display) depth];
2330
2331 return NSBitsPerPixelFromDepth (depth) > 1 ? Qt : Qnil;
2332}
2333
2334
952913d4 2335DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
edfda783 2336 0, 1, 0,
b066e6b6 2337 doc: /* Return the width in pixels of the Nextstep display DISPLAY.
d26fbe1a
CY
2338The optional argument DISPLAY specifies which display to ask about.
2339DISPLAY should be either a frame, a display name (a string), or terminal ID.
51d5ef9f 2340If omitted or nil, that stands for the selected frame's display. */)
5842a27b 2341 (Lisp_Object display)
edfda783
AR
2342{
2343 check_ns ();
2344 return make_number ((int) [ns_get_screen (display) frame].size.width);
2345}
2346
2347
952913d4
DN
2348DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
2349 Sx_display_pixel_height, 0, 1, 0,
b066e6b6 2350 doc: /* Return the height 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.height);
2358}
2359
583ff3c3 2360
edfda783
AR
2361DEFUN ("display-usable-bounds", Fns_display_usable_bounds,
2362 Sns_display_usable_bounds, 0, 1, 0,
b066e6b6 2363 doc: /* Return the bounds of the usable part of the screen.
d26fbe1a
CY
2364The return value is a list of integers (LEFT TOP WIDTH HEIGHT), which
2365are the boundaries of the usable part of the screen, excluding areas
2366reserved for the Mac menu, dock, and so forth.
2367
2368The screen queried corresponds to DISPLAY, which should be either a
2369frame, a display name (a string), or terminal ID. If omitted or nil,
51d5ef9f 2370that stands for the selected frame's display. */)
5842a27b 2371 (Lisp_Object display)
edfda783 2372{
474217c8 2373 NSScreen *screen;
edfda783
AR
2374 NSRect vScreen;
2375
2376 check_ns ();
474217c8
CY
2377 screen = ns_get_screen (display);
2378 if (!screen)
2379 return Qnil;
2380
2381 vScreen = [screen visibleFrame];
edfda783 2382
474217c8
CY
2383 /* NS coordinate system is upside-down.
2384 Transform to screen-specific coordinates. */
3de717bd
DA
2385 return list4i (vScreen.origin.x,
2386 [screen frame].size.height
2387 - vScreen.size.height - vScreen.origin.y,
2388 vScreen.size.width, vScreen.size.height);
edfda783
AR
2389}
2390
2391
952913d4 2392DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
edfda783 2393 0, 1, 0,
b066e6b6 2394 doc: /* Return the number of bitplanes of the Nextstep display DISPLAY.
d26fbe1a
CY
2395The optional argument DISPLAY specifies which display to ask about.
2396DISPLAY should be either a frame, a display name (a string), or terminal ID.
51d5ef9f 2397If omitted or nil, that stands for the selected frame's display. */)
5842a27b 2398 (Lisp_Object display)
edfda783
AR
2399{
2400 check_ns ();
2401 return make_number
b9126609 2402 (NSBitsPerPixelFromDepth ([ns_get_screen (display) depth]));
edfda783
AR
2403}
2404
2405
952913d4
DN
2406DEFUN ("x-display-color-cells", Fx_display_color_cells,
2407 Sx_display_color_cells, 0, 1, 0,
51d5ef9f 2408 doc: /* Returns the number of color cells 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 2413{
5d1d3d04 2414 struct ns_display_info *dpyinfo;
edfda783 2415 check_ns ();
5fdb398c 2416
5d1d3d04 2417 dpyinfo = check_ns_display_info (display);
edfda783
AR
2418 /* We force 24+ bit depths to 24-bit to prevent an overflow. */
2419 return make_number (1 << min (dpyinfo->n_planes, 24));
2420}
2421
2422
2423/* Unused dummy def needed for compatibility. */
2424Lisp_Object tip_frame;
2425
6fb5f7da 2426/* TODO: move to xdisp or similar */
edfda783 2427static void
3d608a86
J
2428compute_tip_xy (struct frame *f,
2429 Lisp_Object parms,
2430 Lisp_Object dx,
2431 Lisp_Object dy,
2432 int width,
2433 int height,
2434 int *root_x,
2435 int *root_y)
edfda783
AR
2436{
2437 Lisp_Object left, top;
2438 EmacsView *view = FRAME_NS_VIEW (f);
2439 NSPoint pt;
b066e6b6 2440
edfda783
AR
2441 /* Start with user-specified or mouse position. */
2442 left = Fcdr (Fassq (Qleft, parms));
edfda783 2443 top = Fcdr (Fassq (Qtop, parms));
edfda783 2444
7a18115b
J
2445 if (!INTEGERP (left) || !INTEGERP (top))
2446 {
2447 pt = last_mouse_motion_position;
2448 /* Convert to screen coordinates */
2449 pt = [view convertPoint: pt toView: nil];
2450 pt = [[view window] convertBaseToScreen: pt];
2451 }
2452 else
2453 {
2454 /* Absolute coordinates. */
2455 pt.x = XINT (left);
2456 pt.y = x_display_pixel_height (FRAME_NS_DISPLAY_INFO (f)) - XINT (top)
2457 - height;
2458 }
5fdb398c 2459
edfda783 2460 /* Ensure in bounds. (Note, screen origin = lower left.) */
7a18115b
J
2461 if (INTEGERP (left))
2462 *root_x = pt.x;
2463 else if (pt.x + XINT (dx) <= 0)
edfda783 2464 *root_x = 0; /* Can happen for negative dx */
889bd438
CY
2465 else if (pt.x + XINT (dx) + width
2466 <= x_display_pixel_width (FRAME_NS_DISPLAY_INFO (f)))
edfda783
AR
2467 /* It fits to the right of the pointer. */
2468 *root_x = pt.x + XINT (dx);
2469 else if (width + XINT (dx) <= pt.x)
2470 /* It fits to the left of the pointer. */
2471 *root_x = pt.x - width - XINT (dx);
2472 else
2473 /* Put it left justified on the screen -- it ought to fit that way. */
2474 *root_x = 0;
2475
7a18115b
J
2476 if (INTEGERP (top))
2477 *root_y = pt.y;
2478 else if (pt.y - XINT (dy) - height >= 0)
edfda783
AR
2479 /* It fits below the pointer. */
2480 *root_y = pt.y - height - XINT (dy);
889bd438
CY
2481 else if (pt.y + XINT (dy) + height
2482 <= x_display_pixel_height (FRAME_NS_DISPLAY_INFO (f)))
edfda783
AR
2483 /* It fits above the pointer */
2484 *root_y = pt.y + XINT (dy);
2485 else
2486 /* Put it on the top. */
889bd438 2487 *root_y = x_display_pixel_height (FRAME_NS_DISPLAY_INFO (f)) - height;
edfda783
AR
2488}
2489
2490
2491DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
b066e6b6 2492 doc: /* Show STRING in a \"tooltip\" window on frame FRAME.
edfda783
AR
2493A tooltip window is a small window displaying a string.
2494
4f4f2973
GM
2495This is an internal function; Lisp code should call `tooltip-show'.
2496
edfda783
AR
2497FRAME nil or omitted means use the selected frame.
2498
2499PARMS is an optional list of frame parameters which can be used to
2500change the tooltip's appearance.
2501
2502Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
2503means use the default timeout of 5 seconds.
2504
2505If the list of frame parameters PARMS contains a `left' parameter,
2506the tooltip is displayed at that x-position. Otherwise it is
2507displayed at the mouse position, with offset DX added (default is 5 if
2508DX isn't specified). Likewise for the y-position; if a `top' frame
2509parameter is specified, it determines the y-position of the tooltip
2510window, otherwise it is displayed at the mouse position, with offset
2511DY added (default is -10).
2512
2513A tooltip's maximum size is specified by `x-max-tooltip-size'.
2514Text larger than the specified size is clipped. */)
5842a27b 2515 (Lisp_Object string, Lisp_Object frame, Lisp_Object parms, Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy)
edfda783
AR
2516{
2517 int root_x, root_y;
2518 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
d311d28c 2519 ptrdiff_t count = SPECPDL_INDEX ();
edfda783
AR
2520 struct frame *f;
2521 char *str;
2522 NSSize size;
2523
2524 specbind (Qinhibit_redisplay, Qt);
2525
2526 GCPRO4 (string, parms, frame, timeout);
2527
2528 CHECK_STRING (string);
0dc8cf50 2529 str = SSDATA (string);
edfda783
AR
2530 f = check_x_frame (frame);
2531 if (NILP (timeout))
2532 timeout = make_number (5);
2533 else
2534 CHECK_NATNUM (timeout);
2535
2536 if (NILP (dx))
2537 dx = make_number (5);
2538 else
2539 CHECK_NUMBER (dx);
2540
2541 if (NILP (dy))
2542 dy = make_number (-10);
2543 else
2544 CHECK_NUMBER (dy);
2545
4d7e6e51 2546 block_input ();
edfda783
AR
2547 if (ns_tooltip == nil)
2548 ns_tooltip = [[EmacsTooltip alloc] init];
2549 else
2550 Fx_hide_tip ();
2551
2552 [ns_tooltip setText: str];
2553 size = [ns_tooltip frame].size;
2554
2555 /* Move the tooltip window where the mouse pointer is. Resize and
2556 show it. */
2557 compute_tip_xy (f, parms, dx, dy, (int)size.width, (int)size.height,
2558 &root_x, &root_y);
2559
2560 [ns_tooltip showAtX: root_x Y: root_y for: XINT (timeout)];
4d7e6e51 2561 unblock_input ();
edfda783
AR
2562
2563 UNGCPRO;
2564 return unbind_to (count, Qnil);
2565}
2566
2567
2568DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
2569 doc: /* Hide the current tooltip window, if there is any.
2570Value is t if tooltip was open, nil otherwise. */)
5842a27b 2571 (void)
edfda783
AR
2572{
2573 if (ns_tooltip == nil || ![ns_tooltip isActive])
2574 return Qnil;
2575 [ns_tooltip hide];
2576 return Qt;
2577}
2578
2579
cc98b6a0
DN
2580/* ==========================================================================
2581
2582 Class implementations
2583
2584 ========================================================================== */
2585
2586
2587@implementation EmacsSavePanel
2588#ifdef NS_IMPL_COCOA
2589/* --------------------------------------------------------------------------
2590 These are overridden to intercept on OS X: ending panel restarts NSApp
2591 event loop if it is stopped. Not sure if this is correct behavior,
2592 perhaps should check if running and if so send an appdefined.
2593 -------------------------------------------------------------------------- */
2594- (void) ok: (id)sender
2595{
2596 [super ok: sender];
2597 panelOK = 1;
2598 [NSApp stop: self];
2599}
2600- (void) cancel: (id)sender
2601{
2602 [super cancel: sender];
2603 [NSApp stop: self];
2604}
2605#endif
2606@end
2607
2608
2609@implementation EmacsOpenPanel
2610#ifdef NS_IMPL_COCOA
2611/* --------------------------------------------------------------------------
2612 These are overridden to intercept on OS X: ending panel restarts NSApp
2613 event loop if it is stopped. Not sure if this is correct behavior,
2614 perhaps should check if running and if so send an appdefined.
2615 -------------------------------------------------------------------------- */
2616- (void) ok: (id)sender
2617{
2618 [super ok: sender];
2619 panelOK = 1;
2620 [NSApp stop: self];
2621}
2622- (void) cancel: (id)sender
2623{
2624 [super cancel: sender];
2625 [NSApp stop: self];
2626}
2627#endif
2628@end
2629
2630
2631@implementation EmacsFileDelegate
2632/* --------------------------------------------------------------------------
2633 Delegate methods for Open/Save panels
2634 -------------------------------------------------------------------------- */
2635- (BOOL)panel: (id)sender isValidFilename: (NSString *)filename
2636{
2637 return YES;
2638}
2639- (BOOL)panel: (id)sender shouldShowFilename: (NSString *)filename
2640{
2641 return YES;
2642}
2643- (NSString *)panel: (id)sender userEnteredFilename: (NSString *)filename
2644 confirmed: (BOOL)okFlag
2645{
2646 return filename;
2647}
2648@end
2649
2650#endif
2651
ba301db3 2652
edfda783
AR
2653/* ==========================================================================
2654
2655 Lisp interface declaration
2656
2657 ========================================================================== */
2658
2659
2660void
3d608a86 2661syms_of_nsfns (void)
edfda783 2662{
088dcc3e 2663 Qfontsize = intern_c_string ("fontsize");
edfda783
AR
2664 staticpro (&Qfontsize);
2665
fb9d0f5a 2666 DEFVAR_LISP ("ns-icon-type-alist", Vns_icon_type_alist,
51d5ef9f 2667 doc: /* Alist of elements (REGEXP . IMAGE) for images of icons associated to frames.
d26fbe1a
CY
2668If the title of a frame matches REGEXP, then IMAGE.tiff is
2669selected as the image of the icon representing the frame when it's
2670miniaturized. If an element is t, then Emacs tries to select an icon
2671based on the filetype of the visited file.
2672
2673The images have to be installed in a folder called English.lproj in the
2674Emacs folder. You have to restart Emacs after installing new icons.
2675
2676Example: Install an icon Gnus.tiff and execute the following code
2677
2678 (setq ns-icon-type-alist
2679 (append ns-icon-type-alist
2680 '((\"^\\\\*\\\\(Group\\\\*$\\\\|Summary \\\\|Article\\\\*$\\\\)\"
2681 . \"Gnus\"))))
2682
2683When you miniaturize a Group, Summary or Article frame, Gnus.tiff will
51d5ef9f 2684be used as the image of the icon representing the frame. */);
edfda783
AR
2685 Vns_icon_type_alist = Fcons (Qt, Qnil);
2686
fb9d0f5a 2687 DEFVAR_LISP ("ns-version-string", Vns_version_string,
cb83c00b 2688 doc: /* Toolkit version for NS Windowing. */);
f5497e45 2689 Vns_version_string = ns_appkit_version_str ();
cb83c00b 2690
edfda783
AR
2691 defsubr (&Sns_read_file_name);
2692 defsubr (&Sns_get_resource);
2693 defsubr (&Sns_set_resource);
2694 defsubr (&Sxw_display_color_p); /* this and next called directly by C code */
2695 defsubr (&Sx_display_grayscale_p);
edfda783
AR
2696 defsubr (&Sns_font_name);
2697 defsubr (&Sns_list_colors);
74876614 2698#ifdef NS_IMPL_COCOA
583ff3c3 2699 defsubr (&Sns_do_applescript);
74876614 2700#endif
952913d4
DN
2701 defsubr (&Sxw_color_defined_p);
2702 defsubr (&Sxw_color_values);
2703 defsubr (&Sx_server_max_request_size);
9e50ff0c
DN
2704 defsubr (&Sx_server_vendor);
2705 defsubr (&Sx_server_version);
952913d4
DN
2706 defsubr (&Sx_display_pixel_width);
2707 defsubr (&Sx_display_pixel_height);
edfda783 2708 defsubr (&Sns_display_usable_bounds);
9e50ff0c
DN
2709 defsubr (&Sx_display_mm_width);
2710 defsubr (&Sx_display_mm_height);
2711 defsubr (&Sx_display_screens);
952913d4
DN
2712 defsubr (&Sx_display_planes);
2713 defsubr (&Sx_display_color_cells);
9e50ff0c
DN
2714 defsubr (&Sx_display_visual_class);
2715 defsubr (&Sx_display_backing_store);
2716 defsubr (&Sx_display_save_under);
2717 defsubr (&Sx_create_frame);
9e50ff0c
DN
2718 defsubr (&Sx_open_connection);
2719 defsubr (&Sx_close_connection);
2720 defsubr (&Sx_display_list);
edfda783
AR
2721
2722 defsubr (&Sns_hide_others);
2723 defsubr (&Sns_hide_emacs);
2724 defsubr (&Sns_emacs_info_panel);
2725 defsubr (&Sns_list_services);
2726 defsubr (&Sns_perform_service);
2727 defsubr (&Sns_convert_utf8_nfd_to_nfc);
9e50ff0c 2728 defsubr (&Sx_focus_frame);
edfda783
AR
2729 defsubr (&Sns_popup_font_panel);
2730 defsubr (&Sns_popup_color_panel);
2731
2732 defsubr (&Sx_show_tip);
2733 defsubr (&Sx_hide_tip);
2734
2735 /* used only in fontset.c */
2736 check_window_system_func = check_ns;
2737
08e3161a
JD
2738 as_status = 0;
2739 as_script = Qnil;
2740 as_result = 0;
edfda783 2741}