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