* nsmenu.m (ns_update_menubar): Exchange place of argument 2 and 3 to
[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>
fee5959d 36#include <c-strcase.h>
5a06864f 37
edfda783
AR
38#include "lisp.h"
39#include "blockinput.h"
40#include "nsterm.h"
41#include "window.h"
e5560ff7 42#include "character.h"
edfda783
AR
43#include "buffer.h"
44#include "keyboard.h"
45#include "termhooks.h"
46#include "fontset.h"
edfda783
AR
47#include "font.h"
48
49#if 0
50int fns_trace_num = 1;
51#define NSTRACE(x) fprintf (stderr, "%s:%d: [%d] " #x "\n", \
52 __FILE__, __LINE__, ++fns_trace_num)
53#else
54#define NSTRACE(x)
55#endif
56
57#ifdef HAVE_NS
58
59extern NSArray *ns_send_types, *ns_return_types, *ns_drag_types;
60
61extern Lisp_Object Qforeground_color;
62extern Lisp_Object Qbackground_color;
63extern Lisp_Object Qcursor_color;
64extern Lisp_Object Qinternal_border_width;
65extern Lisp_Object Qvisibility;
66extern Lisp_Object Qcursor_type;
67extern Lisp_Object Qicon_type;
68extern Lisp_Object Qicon_name;
69extern Lisp_Object Qicon_left;
70extern Lisp_Object Qicon_top;
71extern Lisp_Object Qleft;
72extern Lisp_Object Qright;
73extern Lisp_Object Qtop;
74extern Lisp_Object Qdisplay;
75extern Lisp_Object Qvertical_scroll_bars;
76extern Lisp_Object Qauto_raise;
77extern Lisp_Object Qauto_lower;
78extern Lisp_Object Qbox;
79extern Lisp_Object Qscroll_bar_width;
80extern Lisp_Object Qx_resource_name;
81extern Lisp_Object Qface_set_after_frame_default;
82extern Lisp_Object Qunderline, Qundefined;
83extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
84extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
7ffdf101 85extern Lisp_Object Qnone;
edfda783 86
5d1d3d04 87
edfda783
AR
88Lisp_Object Qbuffered;
89Lisp_Object Qfontsize;
90
91/* hack for OS X file panels */
92char panelOK = 0;
93
edfda783
AR
94EmacsTooltip *ns_tooltip;
95
96/* Need forward declaration here to preserve organizational integrity of file */
9e50ff0c 97Lisp_Object Fx_open_connection (Lisp_Object, Lisp_Object, Lisp_Object);
edfda783
AR
98
99extern BOOL ns_in_resize;
100
08e3161a
JD
101/* Static variables to handle applescript execution. */
102static Lisp_Object as_script, *as_result;
103static int as_status;
edfda783 104
ef884f23 105#ifdef GLYPH_DEBUG
a97f8f3f
JD
106static ptrdiff_t image_cache_refcount;
107#endif
108
edfda783
AR
109/* ==========================================================================
110
111 Internal utility functions
112
113 ========================================================================== */
114
115
116void
117check_ns (void)
118{
119 if (NSApp == nil)
120 error ("OpenStep is not in use or not initialized");
121}
122
123
124/* Nonzero if we can use mouse menus. */
125int
3d608a86 126have_menus_p (void)
edfda783
AR
127{
128 return NSApp != nil;
129}
130
131
132/* Extract a frame as a FRAME_PTR, defaulting to the selected frame
133 and checking validity for NS. */
134static FRAME_PTR
135check_ns_frame (Lisp_Object frame)
136{
137 FRAME_PTR f;
138
139 if (NILP (frame))
140 f = SELECTED_FRAME ();
141 else
142 {
143 CHECK_LIVE_FRAME (frame);
144 f = XFRAME (frame);
145 }
146 if (! FRAME_NS_P (f))
d26fbe1a 147 error ("non-Nextstep frame used");
edfda783
AR
148 return f;
149}
150
151
d26fbe1a
CY
152/* Let the user specify an Nextstep display with a frame.
153 nil stands for the selected frame--or, if that is not an Nextstep frame,
154 the first Nextstep display on the list. */
edfda783
AR
155static struct ns_display_info *
156check_ns_display_info (Lisp_Object frame)
157{
158 if (NILP (frame))
159 {
160 struct frame *f = SELECTED_FRAME ();
161 if (FRAME_NS_P (f) && FRAME_LIVE_P (f) )
162 return FRAME_NS_DISPLAY_INFO (f);
9e50ff0c
DN
163 else if (x_display_list != 0)
164 return x_display_list;
edfda783 165 else
d26fbe1a 166 error ("Nextstep windows are not in use or not initialized");
edfda783
AR
167 }
168 else if (INTEGERP (frame))
169 {
170 struct terminal *t = get_terminal (frame, 1);
171
172 if (t->type != output_ns)
d311d28c 173 error ("Terminal %"pI"d is not a Nextstep display", XINT (frame));
edfda783
AR
174
175 return t->display_info.ns;
176 }
177 else if (STRINGP (frame))
178 return ns_display_info_for_name (frame);
179 else
180 {
181 FRAME_PTR f;
182
183 CHECK_LIVE_FRAME (frame);
184 f = XFRAME (frame);
185 if (! FRAME_NS_P (f))
d26fbe1a 186 error ("non-Nextstep frame used");
edfda783
AR
187 return FRAME_NS_DISPLAY_INFO (f);
188 }
189 return NULL; /* shut compiler up */
190}
191
192
193static id
194ns_get_window (Lisp_Object maybeFrame)
195{
196 id view =nil, window =nil;
197
198 if (!FRAMEP (maybeFrame) || !FRAME_NS_P (XFRAME (maybeFrame)))
199 maybeFrame = selected_frame;/*wrong_type_argument (Qframep, maybeFrame); */
200
201 if (!NILP (maybeFrame))
202 view = FRAME_NS_VIEW (XFRAME (maybeFrame));
203 if (view) window =[view window];
204
205 return window;
206}
207
208
209static NSScreen *
5996e1b7 210ns_get_screen (Lisp_Object screen)
edfda783 211{
474217c8
CY
212 struct frame *f;
213 struct terminal *terminal;
214
215 if (EQ (Qt, screen)) /* not documented */
216 return [NSScreen mainScreen];
217
218 terminal = get_terminal (screen, 1);
5996e1b7 219 if (terminal->type != output_ns)
474217c8
CY
220 return NULL;
221
222 if (NILP (screen))
223 f = SELECTED_FRAME ();
224 else if (FRAMEP (screen))
225 f = XFRAME (screen);
5996e1b7 226 else
edfda783 227 {
5996e1b7 228 struct ns_display_info *dpyinfo = terminal->display_info.ns;
5d1d3d04
J
229 f = dpyinfo->x_focus_frame
230 ? dpyinfo->x_focus_frame : dpyinfo->x_highlight_frame;
edfda783 231 }
474217c8
CY
232
233 return ((f && FRAME_NS_P (f)) ? [[FRAME_NS_VIEW (f) window] screen]
234 : NULL);
edfda783
AR
235}
236
237
238/* Return the X display structure for the display named NAME.
239 Open a new connection if necessary. */
240struct ns_display_info *
3d608a86 241ns_display_info_for_name (Lisp_Object name)
edfda783
AR
242{
243 Lisp_Object names;
244 struct ns_display_info *dpyinfo;
245
246 CHECK_STRING (name);
247
9e50ff0c 248 for (dpyinfo = x_display_list, names = ns_display_name_list;
edfda783
AR
249 dpyinfo;
250 dpyinfo = dpyinfo->next, names = XCDR (names))
251 {
252 Lisp_Object tem;
253 tem = Fstring_equal (XCAR (XCAR (names)), name);
254 if (!NILP (tem))
255 return dpyinfo;
256 }
257
258 error ("Emacs for OpenStep does not yet support multi-display.");
259
9e50ff0c
DN
260 Fx_open_connection (name, Qnil, Qnil);
261 dpyinfo = x_display_list;
edfda783
AR
262
263 if (dpyinfo == 0)
facfbbbd 264 error ("OpenStep on %s not responding.\n", SDATA (name));
edfda783
AR
265
266 return dpyinfo;
267}
268
269
270static Lisp_Object
271interpret_services_menu (NSMenu *menu, Lisp_Object prefix, Lisp_Object old)
272/* --------------------------------------------------------------------------
273 Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
274 -------------------------------------------------------------------------- */
275{
276 int i, count;
15034960 277 NSMenuItem *item;
edfda783
AR
278 const char *name;
279 Lisp_Object nameStr;
280 unsigned short key;
281 NSString *keys;
282 Lisp_Object res;
283
284 count = [menu numberOfItems];
285 for (i = 0; i<count; i++)
286 {
287 item = [menu itemAtIndex: i];
288 name = [[item title] UTF8String];
289 if (!name) continue;
290
291 nameStr = build_string (name);
292
293 if ([item hasSubmenu])
294 {
295 old = interpret_services_menu ([item submenu],
296 Fcons (nameStr, prefix), old);
297 }
298 else
299 {
300 keys = [item keyEquivalent];
301 if (keys && [keys length] )
302 {
303 key = [keys characterAtIndex: 0];
304 res = make_number (key|super_modifier);
305 }
306 else
307 {
308 res = Qundefined;
309 }
310 old = Fcons (Fcons (res,
311 Freverse (Fcons (nameStr,
312 prefix))),
313 old);
314 }
315 }
316 return old;
317}
318
319
320
321/* ==========================================================================
322
323 Frame parameter setters
324
325 ========================================================================== */
326
327
328static void
89e2438a 329x_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
edfda783
AR
330{
331 NSColor *col;
d8c2fa78 332 CGFloat r, g, b, alpha;
edfda783
AR
333
334 if (ns_lisp_to_color (arg, &col))
335 {
336 store_frame_param (f, Qforeground_color, oldval);
337 error ("Unknown color");
338 }
339
340 [col retain];
341 [f->output_data.ns->foreground_color release];
342 f->output_data.ns->foreground_color = col;
343
d8c2fa78
AA
344 [col getRed: &r green: &g blue: &b alpha: &alpha];
345 FRAME_FOREGROUND_PIXEL (f) =
346 ARGB_TO_ULONG ((int)(alpha*0xff), (int)(r*0xff), (int)(g*0xff), (int)(b*0xff));
347
edfda783
AR
348 if (FRAME_NS_VIEW (f))
349 {
350 update_face_from_frame_parameter (f, Qforeground_color, arg);
351 /*recompute_basic_faces (f); */
352 if (FRAME_VISIBLE_P (f))
353 redraw_frame (f);
354 }
355}
356
357
358static void
89e2438a 359x_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
edfda783
AR
360{
361 struct face *face;
362 NSColor *col;
363 NSView *view = FRAME_NS_VIEW (f);
d8c2fa78 364 CGFloat r, g, b, alpha;
edfda783
AR
365
366 if (ns_lisp_to_color (arg, &col))
367 {
368 store_frame_param (f, Qbackground_color, oldval);
369 error ("Unknown color");
370 }
371
372 /* clear the frame; in some instances the NS-internal GC appears not to
373 update, or it does update and cannot clear old text properly */
374 if (FRAME_VISIBLE_P (f))
375 ns_clear_frame (f);
376
377 [col retain];
378 [f->output_data.ns->background_color release];
379 f->output_data.ns->background_color = col;
d8c2fa78
AA
380
381 [col getRed: &r green: &g blue: &b alpha: &alpha];
382 FRAME_BACKGROUND_PIXEL (f) =
383 ARGB_TO_ULONG ((int)(alpha*0xff), (int)(r*0xff), (int)(g*0xff), (int)(b*0xff));
384
edfda783
AR
385 if (view != nil)
386 {
387 [[view window] setBackgroundColor: col];
edfda783 388
edfda783
AR
389 if (alpha != 1.0)
390 [[view window] setOpaque: NO];
391 else
392 [[view window] setOpaque: YES];
393
394 face = FRAME_DEFAULT_FACE (f);
395 if (face)
396 {
45d325c4 397 col = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f);
204ee57f
JD
398 face->background = ns_index_color
399 ([col colorWithAlphaComponent: alpha], f);
edfda783
AR
400
401 update_face_from_frame_parameter (f, Qbackground_color, arg);
402 }
403
404 if (FRAME_VISIBLE_P (f))
405 redraw_frame (f);
406 }
407}
408
409
410static void
89e2438a 411x_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
edfda783
AR
412{
413 NSColor *col;
414
415 if (ns_lisp_to_color (arg, &col))
416 {
417 store_frame_param (f, Qcursor_color, oldval);
418 error ("Unknown color");
419 }
420
c8c057de
AR
421 [FRAME_CURSOR_COLOR (f) release];
422 FRAME_CURSOR_COLOR (f) = [col retain];
edfda783
AR
423
424 if (FRAME_VISIBLE_P (f))
425 {
426 x_update_cursor (f, 0);
427 x_update_cursor (f, 1);
428 }
429 update_face_from_frame_parameter (f, Qcursor_color, arg);
430}
431
c8c057de 432
edfda783 433static void
89e2438a 434x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
edfda783
AR
435{
436 NSView *view = FRAME_NS_VIEW (f);
89e2438a 437 NSTRACE (x_set_icon_name);
edfda783
AR
438
439 if (ns_in_resize)
440 return;
441
442 /* see if it's changed */
443 if (STRINGP (arg))
444 {
445 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
446 return;
447 }
448 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
449 return;
450
451 f->icon_name = arg;
452
453 if (NILP (arg))
454 {
455 if (!NILP (f->title))
456 arg = f->title;
457 else
458 /* explicit name and no icon-name -> explicit_name */
459 if (f->explicit_name)
460 arg = f->name;
461 else
462 {
463 /* no explicit name and no icon-name ->
464 name has to be rebuild from icon_title_format */
465 windows_or_buffers_changed++;
466 return;
467 }
468 }
469
470 /* Don't change the name if it's already NAME. */
471 if ([[view window] miniwindowTitle] &&
472 ([[[view window] miniwindowTitle]
473 isEqualToString: [NSString stringWithUTF8String:
facfbbbd 474 SDATA (arg)]]))
edfda783
AR
475 return;
476
477 [[view window] setMiniwindowTitle:
facfbbbd 478 [NSString stringWithUTF8String: SDATA (arg)]];
edfda783
AR
479}
480
edfda783 481static void
5bbb4727 482ns_set_name_internal (FRAME_PTR f, Lisp_Object name)
edfda783 483{
5bbb4727
JD
484 struct gcpro gcpro1;
485 Lisp_Object encoded_name, encoded_icon_name;
486 NSString *str;
edfda783 487 NSView *view = FRAME_NS_VIEW (f);
edfda783 488
5bbb4727
JD
489 GCPRO1 (name);
490 encoded_name = ENCODE_UTF_8 (name);
491 UNGCPRO;
edfda783 492
5bbb4727 493 str = [NSString stringWithUTF8String: SDATA (encoded_name)];
edfda783 494
5bbb4727
JD
495 /* Don't change the name if it's already NAME. */
496 if (! [[[view window] title] isEqualToString: str])
497 [[view window] setTitle: str];
edfda783 498
5bbb4727
JD
499 if (!STRINGP (f->icon_name))
500 encoded_icon_name = encoded_name;
edfda783 501 else
5fdb398c 502 encoded_icon_name = ENCODE_UTF_8 (f->icon_name);
5bbb4727
JD
503
504 str = [NSString stringWithUTF8String: SDATA (encoded_icon_name)];
edfda783 505
edfda783 506 if ([[view window] miniwindowTitle] &&
5bbb4727
JD
507 ! [[[view window] miniwindowTitle] isEqualToString: str])
508 [[view window] setMiniwindowTitle: str];
edfda783 509
edfda783
AR
510}
511
edfda783
AR
512static void
513ns_set_name (struct frame *f, Lisp_Object name, int explicit)
514{
fec8f0fe 515 NSView *view;
edfda783
AR
516 NSTRACE (ns_set_name);
517
518 if (ns_in_resize)
519 return;
520
521 /* Make sure that requests from lisp code override requests from
522 Emacs redisplay code. */
523 if (explicit)
524 {
525 /* If we're switching from explicit to implicit, we had better
526 update the mode lines and thereby update the title. */
527 if (f->explicit_name && NILP (name))
528 update_mode_lines = 1;
529
530 f->explicit_name = ! NILP (name);
531 }
532 else if (f->explicit_name)
533 return;
534
535 if (NILP (name))
56d513e6 536 name = build_string([ns_app_name UTF8String]);
5bbb4727
JD
537 else
538 CHECK_STRING (name);
539
540 /* Don't change the name if it's already NAME. */
541 if (! NILP (Fstring_equal (name, f->name)))
542 return;
edfda783
AR
543
544 f->name = name;
545
546 /* title overrides explicit name */
547 if (! NILP (f->title))
548 name = f->title;
549
5bbb4727 550 ns_set_name_internal (f, name);
edfda783
AR
551}
552
553
554/* This function should be called when the user's lisp code has
555 specified a name for the frame; the name will override any set by the
556 redisplay code. */
557static void
89e2438a 558x_explicitly_set_name (FRAME_PTR f, Lisp_Object arg, Lisp_Object oldval)
edfda783 559{
89e2438a 560 NSTRACE (x_explicitly_set_name);
edfda783
AR
561 ns_set_name (f, arg, 1);
562}
563
564
565/* This function should be called by Emacs redisplay code to set the
566 name; names set this way will never override names set by the user's
567 lisp code. */
568void
569x_implicitly_set_name (FRAME_PTR f, Lisp_Object arg, Lisp_Object oldval)
570{
571 NSTRACE (x_implicitly_set_name);
5bbb4727
JD
572
573 /* Deal with NS specific format t. */
574 if (FRAME_NS_P (f) && ((FRAME_ICONIFIED_P (f) && EQ (Vicon_title_format, Qt))
575 || EQ (Vframe_title_format, Qt)))
9ae6e189 576 ns_set_name_as_filename (f);
edfda783
AR
577 else
578 ns_set_name (f, arg, 0);
579}
580
581
582/* Change the title of frame F to NAME.
5bbb4727 583 If NAME is nil, use the frame name as the title. */
edfda783 584
edfda783 585static void
89e2438a 586x_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name)
edfda783 587{
89e2438a 588 NSTRACE (x_set_title);
edfda783
AR
589 /* Don't change the title if it's already NAME. */
590 if (EQ (name, f->title))
591 return;
592
593 update_mode_lines = 1;
594
595 f->title = name;
5bbb4727
JD
596
597 if (NILP (name))
598 name = f->name;
599 else
600 CHECK_STRING (name);
601
602 ns_set_name_internal (f, name);
edfda783
AR
603}
604
605
606void
607ns_set_name_as_filename (struct frame *f)
608{
fec8f0fe 609 NSView *view;
aeb7e951 610 Lisp_Object name, filename;
edfda783
AR
611 Lisp_Object buf = XWINDOW (f->selected_window)->buffer;
612 const char *title;
613 NSAutoreleasePool *pool;
5bbb4727 614 struct gcpro gcpro1;
aeb7e951
JD
615 Lisp_Object encoded_name, encoded_filename;
616 NSString *str;
edfda783
AR
617 NSTRACE (ns_set_name_as_filename);
618
619 if (f->explicit_name || ! NILP (f->title) || ns_in_resize)
620 return;
621
622 BLOCK_INPUT;
623 pool = [[NSAutoreleasePool alloc] init];
124c9ff0
JD
624 filename = BVAR (XBUFFER (buf), filename);
625 name = BVAR (XBUFFER (buf), name);
edfda783
AR
626
627 if (NILP (name))
aeb7e951
JD
628 {
629 if (! NILP (filename))
630 name = Ffile_name_nondirectory (filename);
631 else
632 name = build_string ([ns_app_name UTF8String]);
633 }
edfda783 634
5bbb4727
JD
635 GCPRO1 (name);
636 encoded_name = ENCODE_UTF_8 (name);
637 UNGCPRO;
638
fec8f0fe
CY
639 view = FRAME_NS_VIEW (f);
640
edfda783
AR
641 title = FRAME_ICONIFIED_P (f) ? [[[view window] miniwindowTitle] UTF8String]
642 : [[[view window] title] UTF8String];
643
5bbb4727 644 if (title && (! strcmp (title, SDATA (encoded_name))))
edfda783
AR
645 {
646 [pool release];
647 UNBLOCK_INPUT;
648 return;
649 }
650
aeb7e951
JD
651 str = [NSString stringWithUTF8String: SDATA (encoded_name)];
652 if (str == nil) str = @"Bad coding";
653
654 if (FRAME_ICONIFIED_P (f))
655 [[view window] setMiniwindowTitle: str];
5fdb398c 656 else
edfda783 657 {
aeb7e951
JD
658 NSString *fstr;
659
660 if (! NILP (filename))
edfda783 661 {
aeb7e951
JD
662 GCPRO1 (filename);
663 encoded_filename = ENCODE_UTF_8 (filename);
664 UNGCPRO;
665
666 fstr = [NSString stringWithUTF8String: SDATA (encoded_filename)];
667 if (fstr == nil) fstr = @"";
668#ifdef NS_IMPL_COCOA
669 /* work around a bug observed on 10.3 and later where
670 setTitleWithRepresentedFilename does not clear out previous state
671 if given filename does not exist */
672 if (! [[NSFileManager defaultManager] fileExistsAtPath: fstr])
673 [[view window] setRepresentedFilename: @""];
674#endif
edfda783
AR
675 }
676 else
aeb7e951
JD
677 fstr = @"";
678
679 [[view window] setRepresentedFilename: fstr];
680 [[view window] setTitle: str];
edfda783
AR
681 f->name = name;
682 }
aeb7e951 683
edfda783
AR
684 [pool release];
685 UNBLOCK_INPUT;
686}
687
688
689void
6521c534 690ns_set_doc_edited (struct frame *f, Lisp_Object arg)
edfda783
AR
691{
692 NSView *view = FRAME_NS_VIEW (f);
693 NSAutoreleasePool *pool;
9ae6e189
CY
694 if (!MINI_WINDOW_P (XWINDOW (f->selected_window)))
695 {
696 BLOCK_INPUT;
697 pool = [[NSAutoreleasePool alloc] init];
698 [[view window] setDocumentEdited: !NILP (arg)];
699 [pool release];
700 UNBLOCK_INPUT;
701 }
edfda783
AR
702}
703
704
cc98b6a0
DN
705void
706x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
edfda783
AR
707{
708 int nlines;
709 int olines = FRAME_MENU_BAR_LINES (f);
710 if (FRAME_MINIBUF_ONLY_P (f))
711 return;
712
d311d28c 713 if (TYPE_RANGED_INTEGERP (int, value))
edfda783
AR
714 nlines = XINT (value);
715 else
716 nlines = 0;
717
718 FRAME_MENU_BAR_LINES (f) = 0;
719 if (nlines)
720 {
721 FRAME_EXTERNAL_MENU_BAR (f) = 1;
cc98b6a0
DN
722 /* does for all frames, whereas we just want for one frame
723 [NSMenu setMenuBarVisible: YES]; */
edfda783
AR
724 }
725 else
726 {
727 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
728 free_frame_menubar (f);
cc98b6a0 729 /* [NSMenu setMenuBarVisible: NO]; */
edfda783
AR
730 FRAME_EXTERNAL_MENU_BAR (f) = 0;
731 }
732}
733
734
3fe53a83 735/* toolbar support */
cc98b6a0
DN
736void
737x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
edfda783
AR
738{
739 int nlines;
740 Lisp_Object root_window;
741
742 if (FRAME_MINIBUF_ONLY_P (f))
743 return;
744
d311d28c 745 if (RANGED_INTEGERP (0, value, INT_MAX))
edfda783
AR
746 nlines = XFASTINT (value);
747 else
748 nlines = 0;
749
750 if (nlines)
751 {
752 FRAME_EXTERNAL_TOOL_BAR (f) = 1;
753 update_frame_tool_bar (f);
754 }
755 else
756 {
757 if (FRAME_EXTERNAL_TOOL_BAR (f))
758 {
759 free_frame_tool_bar (f);
760 FRAME_EXTERNAL_TOOL_BAR (f) = 0;
761 }
762 }
763
764 x_set_window_size (f, 0, f->text_cols, f->text_lines);
765}
766
767
edfda783
AR
768void
769ns_implicitly_set_icon_type (struct frame *f)
770{
771 Lisp_Object tem;
772 EmacsView *view = FRAME_NS_VIEW (f);
204ee57f 773 id image = nil;
edfda783
AR
774 Lisp_Object chain, elt;
775 NSAutoreleasePool *pool;
776 BOOL setMini = YES;
777
778 NSTRACE (ns_implicitly_set_icon_type);
779
780 BLOCK_INPUT;
781 pool = [[NSAutoreleasePool alloc] init];
782 if (f->output_data.ns->miniimage
facfbbbd 783 && [[NSString stringWithUTF8String: SDATA (f->name)]
edfda783
AR
784 isEqualToString: [(NSImage *)f->output_data.ns->miniimage name]])
785 {
786 [pool release];
787 UNBLOCK_INPUT;
788 return;
789 }
790
791 tem = assq_no_quit (Qicon_type, f->param_alist);
792 if (CONSP (tem) && ! NILP (XCDR (tem)))
793 {
794 [pool release];
795 UNBLOCK_INPUT;
796 return;
797 }
798
799 for (chain = Vns_icon_type_alist;
204ee57f 800 image == nil && CONSP (chain);
edfda783
AR
801 chain = XCDR (chain))
802 {
803 elt = XCAR (chain);
804 /* special case: 't' means go by file type */
facfbbbd 805 if (SYMBOLP (elt) && EQ (elt, Qt) && SDATA (f->name)[0] == '/')
edfda783 806 {
facfbbbd
SM
807 NSString *str
808 = [NSString stringWithUTF8String: SDATA (f->name)];
edfda783
AR
809 if ([[NSFileManager defaultManager] fileExistsAtPath: str])
810 image = [[[NSWorkspace sharedWorkspace] iconForFile: str] retain];
811 }
812 else if (CONSP (elt) &&
813 STRINGP (XCAR (elt)) &&
814 STRINGP (XCDR (elt)) &&
815 fast_string_match (XCAR (elt), f->name) >= 0)
816 {
817 image = [EmacsImage allocInitFromFile: XCDR (elt)];
818 if (image == nil)
819 image = [[NSImage imageNamed:
820 [NSString stringWithUTF8String:
facfbbbd 821 SDATA (XCDR (elt))]] retain];
edfda783
AR
822 }
823 }
824
825 if (image == nil)
826 {
827 image = [[[NSWorkspace sharedWorkspace] iconForFileType: @"text"] retain];
828 setMini = NO;
829 }
830
831 [f->output_data.ns->miniimage release];
832 f->output_data.ns->miniimage = image;
833 [view setMiniwindowImage: setMini];
834 [pool release];
835 UNBLOCK_INPUT;
836}
837
838
839static void
89e2438a 840x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
edfda783
AR
841{
842 EmacsView *view = FRAME_NS_VIEW (f);
843 id image = nil;
844 BOOL setMini = YES;
845
89e2438a 846 NSTRACE (x_set_icon_type);
edfda783
AR
847
848 if (!NILP (arg) && SYMBOLP (arg))
849 {
facfbbbd 850 arg =build_string (SDATA (SYMBOL_NAME (arg)));
edfda783
AR
851 store_frame_param (f, Qicon_type, arg);
852 }
853
854 /* do it the implicit way */
855 if (NILP (arg))
856 {
857 ns_implicitly_set_icon_type (f);
858 return;
859 }
860
861 CHECK_STRING (arg);
862
863 image = [EmacsImage allocInitFromFile: arg];
864 if (image == nil)
865 image =[NSImage imageNamed: [NSString stringWithUTF8String:
facfbbbd 866 SDATA (arg)]];
edfda783
AR
867
868 if (image == nil)
869 {
870 image = [NSImage imageNamed: @"text"];
871 setMini = NO;
872 }
873
874 f->output_data.ns->miniimage = image;
875 [view setMiniwindowImage: setMini];
876}
877
878
3fe53a83 879/* Xism; we stub out (we do implement this in ns-win.el) */
edfda783
AR
880int
881XParseGeometry (char *string, int *x, int *y,
882 unsigned int *width, unsigned int *height)
883{
884 message1 ("Warning: XParseGeometry not supported under NS.\n");
885 return 0;
886}
887
888
6fb5f7da 889/* TODO: move to nsterm? */
edfda783
AR
890int
891ns_lisp_to_cursor_type (Lisp_Object arg)
892{
893 char *str;
894 if (XTYPE (arg) == Lisp_String)
facfbbbd 895 str = SDATA (arg);
edfda783 896 else if (XTYPE (arg) == Lisp_Symbol)
facfbbbd 897 str = SDATA (SYMBOL_NAME (arg));
edfda783 898 else return -1;
c8c057de
AR
899 if (!strcmp (str, "box")) return FILLED_BOX_CURSOR;
900 if (!strcmp (str, "hollow")) return HOLLOW_BOX_CURSOR;
901 if (!strcmp (str, "hbar")) return HBAR_CURSOR;
902 if (!strcmp (str, "bar")) return BAR_CURSOR;
903 if (!strcmp (str, "no")) return NO_CURSOR;
edfda783
AR
904 return -1;
905}
906
907
908Lisp_Object
909ns_cursor_type_to_lisp (int arg)
910{
911 switch (arg)
912 {
c8c057de
AR
913 case FILLED_BOX_CURSOR: return Qbox;
914 case HOLLOW_BOX_CURSOR: return intern ("hollow");
915 case HBAR_CURSOR: return intern ("hbar");
916 case BAR_CURSOR: return intern ("bar");
917 case NO_CURSOR:
918 default: return intern ("no");
edfda783
AR
919 }
920}
921
89e2438a 922/* This is the same as the xfns.c definition. */
06197b17 923void
3d608a86 924x_set_cursor_type (FRAME_PTR f, Lisp_Object arg, Lisp_Object oldval)
edfda783 925{
06197b17 926 set_frame_cursor_types (f, arg);
edfda783 927
06197b17
DR
928 /* Make sure the cursor gets redrawn. */
929 cursor_type_changed = 1;
edfda783 930}
06197b17 931\f
edfda783 932
3fe53a83
AR
933/* called to set mouse pointer color, but all other terms use it to
934 initialize pointer types (and don't set the color ;) */
edfda783 935static void
89e2438a 936x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
edfda783 937{
d26fbe1a 938 /* don't think we can do this on Nextstep */
edfda783
AR
939}
940
941
cb83c00b
AR
942#define Str(x) #x
943#define Xstr(x) Str(x)
944
945static Lisp_Object
3d608a86 946ns_appkit_version_str (void)
cb83c00b
AR
947{
948 char tmp[80];
949
950#ifdef NS_IMPL_GNUSTEP
951 sprintf(tmp, "gnustep-gui-%s", Xstr(GNUSTEP_GUI_VERSION));
952#elif defined(NS_IMPL_COCOA)
953 sprintf(tmp, "apple-appkit-%.2f", NSAppKitVersionNumber);
954#else
955 tmp = "ns-unknown";
956#endif
957 return build_string (tmp);
958}
959
960
f5497e45
AR
961/* This is for use by x-server-version and collapses all version info we
962 have into a single int. For a better picture of the implementation
963 running, use ns_appkit_version_str.*/
964static int
3d608a86 965ns_appkit_version_int (void)
f5497e45
AR
966{
967#ifdef NS_IMPL_GNUSTEP
13cd8a29 968 return GNUSTEP_GUI_MAJOR_VERSION * 100 + GNUSTEP_GUI_MINOR_VERSION;
f5497e45
AR
969#elif defined(NS_IMPL_COCOA)
970 return (int)NSAppKitVersionNumber;
971#endif
972 return 0;
973}
974
975
edfda783 976static void
952913d4 977x_icon (struct frame *f, Lisp_Object parms)
edfda783
AR
978/* --------------------------------------------------------------------------
979 Strangely-named function to set icon position parameters in frame.
980 This is irrelevant under OS X, but might be needed under GNUstep,
981 depending on the window manager used. Note, this is not a standard
982 frame parameter-setter; it is called directly from x-create-frame.
983 -------------------------------------------------------------------------- */
984{
985 Lisp_Object icon_x, icon_y;
986 struct ns_display_info *dpyinfo = check_ns_display_info (Qnil);
987
988 f->output_data.ns->icon_top = Qnil;
989 f->output_data.ns->icon_left = Qnil;
990
991 /* Set the position of the icon. */
992 icon_x = x_get_arg (dpyinfo, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
993 icon_y = x_get_arg (dpyinfo, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
994 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
995 {
996 CHECK_NUMBER (icon_x);
997 CHECK_NUMBER (icon_y);
998 f->output_data.ns->icon_top = icon_y;
999 f->output_data.ns->icon_left = icon_x;
1000 }
1001 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
1002 error ("Both left and top icon corners of icon must be specified");
1003}
1004
1005
3fe53a83 1006/* Note: see frame.c for template, also where generic functions are impl */
edfda783
AR
1007frame_parm_handler ns_frame_parm_handlers[] =
1008{
1009 x_set_autoraise, /* generic OK */
1010 x_set_autolower, /* generic OK */
89e2438a 1011 x_set_background_color,
d26fbe1a
CY
1012 0, /* x_set_border_color, may be impossible under Nextstep */
1013 0, /* x_set_border_width, may be impossible under Nextstep */
89e2438a
DN
1014 x_set_cursor_color,
1015 x_set_cursor_type,
edfda783 1016 x_set_font, /* generic OK */
89e2438a
DN
1017 x_set_foreground_color,
1018 x_set_icon_name,
1019 x_set_icon_type,
edfda783 1020 x_set_internal_border_width, /* generic OK */
cc98b6a0 1021 x_set_menu_bar_lines,
89e2438a
DN
1022 x_set_mouse_color,
1023 x_explicitly_set_name,
edfda783 1024 x_set_scroll_bar_width, /* generic OK */
89e2438a 1025 x_set_title,
edfda783
AR
1026 x_set_unsplittable, /* generic OK */
1027 x_set_vertical_scroll_bars, /* generic OK */
1028 x_set_visibility, /* generic OK */
cc98b6a0 1029 x_set_tool_bar_lines,
edfda783
AR
1030 0, /* x_set_scroll_bar_foreground, will ignore (not possible on NS) */
1031 0, /* x_set_scroll_bar_background, will ignore (not possible on NS) */
1032 x_set_screen_gamma, /* generic OK */
1033 x_set_line_spacing, /* generic OK, sets f->extra_line_spacing to int */
1034 x_set_fringe_width, /* generic OK */
1035 x_set_fringe_width, /* generic OK */
1036 0, /* x_set_wait_for_wm, will ignore */
1037 0, /* x_set_fullscreen will ignore */
dee721c0 1038 x_set_font_backend, /* generic OK */
cad9ef74 1039 x_set_alpha,
5fdb398c
PE
1040 0, /* x_set_sticky */
1041 0, /* x_set_tool_bar_position */
edfda783
AR
1042};
1043
1044
a97f8f3f
JD
1045/* Handler for signals raised during x_create_frame.
1046 FRAME is the frame which is partially constructed. */
1047
1048static Lisp_Object
1049unwind_create_frame (Lisp_Object frame)
1050{
1051 struct frame *f = XFRAME (frame);
1052
1053 /* If frame is already dead, nothing to do. This can happen if the
1054 display is disconnected after the frame has become official, but
1055 before x_create_frame removes the unwind protect. */
1056 if (!FRAME_LIVE_P (f))
1057 return Qnil;
1058
1059 /* If frame is ``official'', nothing to do. */
97f18cc8 1060 if (NILP (Fmemq (frame, Vframe_list)))
a97f8f3f 1061 {
ef884f23 1062#if defined GLYPH_DEBUG && defined ENABLE_CHECKING
a97f8f3f
JD
1063 struct ns_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
1064#endif
1065
1066 x_free_frame_resources (f);
1067 free_glyphs (f);
1068
ef884f23 1069#ifdef GLYPH_DEBUG
a97f8f3f 1070 /* Check that reference counts are indeed correct. */
ef884f23 1071 eassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount);
a97f8f3f
JD
1072#endif
1073 return Qt;
1074 }
1075
1076 return Qnil;
1077}
1078
a0c3fad0
JD
1079/*
1080 * Read geometry related parameters from preferences if not in PARMS.
1081 * Returns the union of parms and any preferences read.
1082 */
a97f8f3f 1083
a0c3fad0
JD
1084static Lisp_Object
1085get_geometry_from_preferences (struct ns_display_info *dpyinfo,
1086 Lisp_Object parms)
1087{
1088 struct {
1089 const char *val;
1090 const char *cls;
1091 Lisp_Object tem;
1092 } r[] = {
1093 { "width", "Width", Qwidth },
1094 { "height", "Height", Qheight },
1095 { "left", "Left", Qleft },
1096 { "top", "Top", Qtop },
1097 };
1098
1099 int i;
1100 for (i = 0; i < sizeof (r)/sizeof (r[0]); ++i)
1101 {
1102 if (NILP (Fassq (r[i].tem, parms)))
1103 {
1104 Lisp_Object value
1105 = x_get_arg (dpyinfo, parms, r[i].tem, r[i].val, r[i].cls,
1106 RES_TYPE_NUMBER);
1107 if (! EQ (value, Qunbound))
1108 parms = Fcons (Fcons (r[i].tem, value), parms);
1109 }
1110 }
a97f8f3f 1111
a0c3fad0
JD
1112 return parms;
1113}
cb83c00b
AR
1114
1115/* ==========================================================================
1116
1117 Lisp definitions
1118
1119 ========================================================================== */
1120
9e50ff0c 1121DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
edfda783 1122 1, 1, 0,
a97f8f3f 1123 doc: /* Make a new Nextstep window, called a "frame" in Emacs terms.
d26fbe1a
CY
1124Return an Emacs frame object.
1125PARMS is an alist of frame parameters.
1126If the parameters specify that the frame should not have a minibuffer,
1127and do not specify a specific minibuffer window to use,
1128then `default-minibuffer-frame' must be a frame whose minibuffer can
a97f8f3f
JD
1129be shared by the new frame.
1130
1131This function is an internal primitive--use `make-frame' instead. */)
5842a27b 1132 (Lisp_Object parms)
edfda783 1133{
edfda783 1134 struct frame *f;
edfda783
AR
1135 Lisp_Object frame, tem;
1136 Lisp_Object name;
1137 int minibuffer_only = 0;
a97f8f3f
JD
1138 int window_prompting = 0;
1139 int width, height;
d311d28c 1140 ptrdiff_t count = specpdl_ptr - specpdl;
a97f8f3f 1141 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
edfda783
AR
1142 Lisp_Object display;
1143 struct ns_display_info *dpyinfo = NULL;
1144 Lisp_Object parent;
1145 struct kboard *kb;
1146 Lisp_Object tfont, tfontsize;
a97f8f3f 1147 static int desc_ctr = 1;
edfda783
AR
1148
1149 check_ns ();
1150
a97f8f3f 1151 /* x_get_arg modifies parms. */
bd6ce2ba
AR
1152 parms = Fcopy_alist (parms);
1153
a97f8f3f
JD
1154 /* Use this general default value to start with
1155 until we know if this frame has a specified name. */
1156 Vx_resource_name = Vinvocation_name;
1157
edfda783
AR
1158 display = x_get_arg (dpyinfo, parms, Qterminal, 0, 0, RES_TYPE_STRING);
1159 if (EQ (display, Qunbound))
1160 display = Qnil;
1161 dpyinfo = check_ns_display_info (display);
a97f8f3f 1162 kb = dpyinfo->terminal->kboard;
edfda783
AR
1163
1164 if (!dpyinfo->terminal->name)
1165 error ("Terminal is not live, can't create new frames on it");
1166
edfda783
AR
1167 name = x_get_arg (dpyinfo, parms, Qname, 0, 0, RES_TYPE_STRING);
1168 if (!STRINGP (name)
1169 && ! EQ (name, Qunbound)
1170 && ! NILP (name))
1171 error ("Invalid frame name--not a string or nil");
1172
1173 if (STRINGP (name))
1174 Vx_resource_name = name;
1175
1176 parent = x_get_arg (dpyinfo, parms, Qparent_id, 0, 0, RES_TYPE_NUMBER);
1177 if (EQ (parent, Qunbound))
1178 parent = Qnil;
1179 if (! NILP (parent))
1180 CHECK_NUMBER (parent);
1181
a97f8f3f
JD
1182 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
1183 /* No need to protect DISPLAY because that's not used after passing
1184 it to make_frame_without_minibuffer. */
edfda783
AR
1185 frame = Qnil;
1186 GCPRO4 (parms, parent, name, frame);
edfda783
AR
1187 tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer",
1188 RES_TYPE_SYMBOL);
1189 if (EQ (tem, Qnone) || NILP (tem))
edfda783 1190 f = make_frame_without_minibuffer (Qnil, kb, display);
edfda783
AR
1191 else if (EQ (tem, Qonly))
1192 {
1193 f = make_minibuffer_frame ();
1194 minibuffer_only = 1;
1195 }
1196 else if (WINDOWP (tem))
edfda783 1197 f = make_frame_without_minibuffer (tem, kb, display);
edfda783 1198 else
edfda783 1199 f = make_frame (1);
edfda783
AR
1200
1201 XSETFRAME (frame, f);
1202 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
1203
1204 f->terminal = dpyinfo->terminal;
edfda783
AR
1205
1206 f->output_method = output_ns;
38182d90 1207 f->output_data.ns = xzalloc (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
ef884f23 1297#ifdef GLYPH_DEBUG
a97f8f3f
JD
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 2229 return !res ? NULL :
fee5959d
PE
2230 (!c_strncasecmp (res, "YES", 3) ? "true" :
2231 (!c_strncasecmp (res, "NO", 2) ? "false" : res));
edfda783
AR
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}