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