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