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