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