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