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