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