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