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