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