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