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