(tar-mode): Set write-contents-functions instead of
[bpt/emacs.git] / src / nsfns.m
CommitLineData
edfda783 1/* Functions for the NeXT/Open/GNUstep and MacOSX window system.
edfda783 2 Copyright (C) 1989, 1992, 1993, 1994, 2005, 2006, 2008
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
341ns_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
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
366ns_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
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
415ns_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
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
AR
437static void
438ns_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
439{
440 NSView *view = FRAME_NS_VIEW (f);
441 NSTRACE (ns_set_icon_name);
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
584ns_explicitly_set_name (FRAME_PTR f, Lisp_Object arg, Lisp_Object oldval)
585{
586 NSTRACE (ns_explicitly_set_name);
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
617ns_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name)
618{
619 NSTRACE (ns_set_title);
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
847ns_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
848{
849 EmacsView *view = FRAME_NS_VIEW (f);
850 id image = nil;
851 BOOL setMini = YES;
852
853 NSTRACE (ns_set_icon_type);
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
06197b17
DR
929/* this is like x_set_cursor_type defined in xfns.c */
930void
931ns_set_cursor_type (f, arg, oldval)
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
945ns_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
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
955ns_appkit_version ()
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
edfda783 970static void
952913d4 971x_icon (struct frame *f, Lisp_Object parms)
edfda783
AR
972/* --------------------------------------------------------------------------
973 Strangely-named function to set icon position parameters in frame.
974 This is irrelevant under OS X, but might be needed under GNUstep,
975 depending on the window manager used. Note, this is not a standard
976 frame parameter-setter; it is called directly from x-create-frame.
977 -------------------------------------------------------------------------- */
978{
979 Lisp_Object icon_x, icon_y;
980 struct ns_display_info *dpyinfo = check_ns_display_info (Qnil);
981
982 f->output_data.ns->icon_top = Qnil;
983 f->output_data.ns->icon_left = Qnil;
984
985 /* Set the position of the icon. */
986 icon_x = x_get_arg (dpyinfo, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
987 icon_y = x_get_arg (dpyinfo, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
988 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
989 {
990 CHECK_NUMBER (icon_x);
991 CHECK_NUMBER (icon_y);
992 f->output_data.ns->icon_top = icon_y;
993 f->output_data.ns->icon_left = icon_x;
994 }
995 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
996 error ("Both left and top icon corners of icon must be specified");
997}
998
999
1000/* 23 Note: commented out ns_... entries are no longer used in 23.
1001 commented out x_... entries have not been implemented yet.
1002 see frame.c for template, also where all generic OK functions are impl */
1003frame_parm_handler ns_frame_parm_handlers[] =
1004{
1005 x_set_autoraise, /* generic OK */
1006 x_set_autolower, /* generic OK */
1007 ns_set_background_color,
d26fbe1a
CY
1008 0, /* x_set_border_color, may be impossible under Nextstep */
1009 0, /* x_set_border_width, may be impossible under Nextstep */
edfda783
AR
1010 ns_set_cursor_color,
1011 ns_set_cursor_type,
1012 x_set_font, /* generic OK */
1013 ns_set_foreground_color,
1014 ns_set_icon_name,
1015 ns_set_icon_type,
1016 x_set_internal_border_width, /* generic OK */
cc98b6a0 1017 x_set_menu_bar_lines,
edfda783
AR
1018 ns_set_mouse_color,
1019 ns_explicitly_set_name,
1020 x_set_scroll_bar_width, /* generic OK */
1021 ns_set_title,
1022 x_set_unsplittable, /* generic OK */
1023 x_set_vertical_scroll_bars, /* generic OK */
1024 x_set_visibility, /* generic OK */
cc98b6a0 1025 x_set_tool_bar_lines,
edfda783
AR
1026 0, /* x_set_scroll_bar_foreground, will ignore (not possible on NS) */
1027 0, /* x_set_scroll_bar_background, will ignore (not possible on NS) */
1028 x_set_screen_gamma, /* generic OK */
1029 x_set_line_spacing, /* generic OK, sets f->extra_line_spacing to int */
1030 x_set_fringe_width, /* generic OK */
1031 x_set_fringe_width, /* generic OK */
1032 0, /* x_set_wait_for_wm, will ignore */
1033 0, /* x_set_fullscreen will ignore */
dee721c0 1034 x_set_font_backend, /* generic OK */
59bc82c0 1035 x_set_alpha
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 {
1321 tem = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, RES_TYPE_BOOLEAN);
1322 if (EQ (tem, Qunbound))
1323 tem = Qnil;
1324
1325 x_set_visibility (f, tem, Qnil);
1326 if (EQ (tem, Qt))
1327 [[FRAME_NS_VIEW (f) window] makeKeyWindow];
1328 }
1329
1330 if (FRAME_HAS_MINIBUF_P (f)
1331 && (!FRAMEP (kb->Vdefault_minibuffer_frame)
1332 || !FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame))))
1333 kb->Vdefault_minibuffer_frame = frame;
1334
1335 /* All remaining specified parameters, which have not been "used"
1336 by x_get_arg and friends, now go in the misc. alist of the frame. */
1337 for (tem = parms; CONSP (tem); tem = XCDR (tem))
1338 if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
1339 f->param_alist = Fcons (XCAR (tem), f->param_alist);
1340
1341 UNGCPRO;
1342 Vwindow_list = Qnil;
1343
1344 return unbind_to (count, frame);
1345}
1346
1347
9e50ff0c 1348DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
edfda783
AR
1349 doc: /* Set the input focus to FRAME.
1350FRAME nil means use the selected frame. */)
1351 (frame)
1352 Lisp_Object frame;
1353{
1354 struct frame *f = check_ns_frame (frame);
1355 struct ns_display_info *dpyinfo = FRAME_NS_DISPLAY_INFO (f);
1356
9e50ff0c 1357 if (dpyinfo->x_focus_frame != f)
edfda783
AR
1358 {
1359 EmacsView *view = FRAME_NS_VIEW (f);
1360 BLOCK_INPUT;
1361 [[view window] makeKeyAndOrderFront: view];
1362 UNBLOCK_INPUT;
1363 }
1364
1365 return Qnil;
1366}
1367
1368
1369DEFUN ("ns-popup-prefs-panel", Fns_popup_prefs_panel, Sns_popup_prefs_panel,
51d5ef9f
AR
1370 0, 0, "",
1371 doc: /* Pop up the preferences panel. */)
edfda783
AR
1372 ()
1373{
1374 check_ns ();
1375 [(EmacsApp *)NSApp showPreferencesWindow: NSApp];
1376 return Qnil;
1377}
1378
1379
1380DEFUN ("ns-popup-font-panel", Fns_popup_font_panel, Sns_popup_font_panel,
51d5ef9f
AR
1381 0, 1, "",
1382 doc: /* Pop up the font panel. */)
edfda783
AR
1383 (frame)
1384 Lisp_Object frame;
1385{
1386 id fm;
1387 struct frame *f;
1388
1389 check_ns ();
1390 fm = [NSFontManager new];
1391 if (NILP (frame))
1392 f = SELECTED_FRAME ();
1393 else
1394 {
1395 CHECK_FRAME (frame);
1396 f = XFRAME (frame);
1397 }
1398
1399 [fm setSelectedFont: ((struct nsfont_info *)f->output_data.ns->font)->nsfont
1400 isMultiple: NO];
1401 [fm orderFrontFontPanel: NSApp];
1402 return Qnil;
1403}
1404
1405
1406DEFUN ("ns-popup-color-panel", Fns_popup_color_panel, Sns_popup_color_panel,
51d5ef9f
AR
1407 0, 1, "",
1408 doc: /* Pop up the color panel. */)
edfda783
AR
1409 (frame)
1410 Lisp_Object frame;
1411{
1412 struct frame *f;
1413
1414 check_ns ();
1415 if (NILP (frame))
1416 f = SELECTED_FRAME ();
1417 else
1418 {
1419 CHECK_FRAME (frame);
1420 f = XFRAME (frame);
1421 }
1422
1423 [NSApp orderFrontColorPanel: NSApp];
1424 return Qnil;
1425}
1426
1427
1428DEFUN ("ns-read-file-name", Fns_read_file_name, Sns_read_file_name, 1, 4, 0,
51d5ef9f 1429 doc: /* Use a graphical panel to read a file name, using prompt PROMPT.
d26fbe1a
CY
1430Optional arg DIR, if non-nil, supplies a default directory.
1431Optional arg ISLOAD, if non-nil, means read a file name for saving.
51d5ef9f 1432Optional arg INIT, if non-nil, provides a default file name to use. */)
edfda783
AR
1433 (prompt, dir, isLoad, init)
1434 Lisp_Object prompt, dir, isLoad, init;
1435{
1436 static id fileDelegate = nil;
1437 int ret;
1438 id panel;
1439 NSString *fname;
1440
1441 NSString *promptS = NILP (prompt) || !STRINGP (prompt) ? nil :
facfbbbd 1442 [NSString stringWithUTF8String: SDATA (prompt)];
edfda783 1443 NSString *dirS = NILP (dir) || !STRINGP (dir) ?
facfbbbd
SM
1444 [NSString stringWithUTF8String: SDATA (current_buffer->directory)] :
1445 [NSString stringWithUTF8String: SDATA (dir)];
edfda783 1446 NSString *initS = NILP (init) || !STRINGP (init) ? nil :
facfbbbd 1447 [NSString stringWithUTF8String: SDATA (init)];
edfda783
AR
1448
1449 check_ns ();
1450
1451 if (fileDelegate == nil)
1452 fileDelegate = [EmacsFileDelegate new];
1453
1454 [NSCursor setHiddenUntilMouseMoves: NO];
1455
1456 if ([dirS characterAtIndex: 0] == '~')
1457 dirS = [dirS stringByExpandingTildeInPath];
1458
1459 panel = NILP (isLoad) ?
f2f7f42c 1460 (id)[EmacsSavePanel savePanel] : (id)[EmacsOpenPanel openPanel];
edfda783
AR
1461
1462 [panel setTitle: promptS];
1463
1464 /* Puma (10.1) does not have */
1465 if ([panel respondsToSelector: @selector (setAllowsOtherFileTypes:)])
1466 [panel setAllowsOtherFileTypes: YES];
1467
1468 [panel setTreatsFilePackagesAsDirectories: YES];
1469 [panel setDelegate: fileDelegate];
1470
1471 panelOK = 0;
1472 if (NILP (isLoad))
1473 {
1474 ret = [panel runModalForDirectory: dirS file: initS];
1475 }
1476 else
1477 {
1478 [panel setCanChooseDirectories: YES];
1479 ret = [panel runModalForDirectory: dirS file: initS types: nil];
1480 }
1481
1482 ret = (ret = NSOKButton) || panelOK;
1483
1484 fname = [panel filename];
1485
1486 [[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow];
1487
1488 return ret ? build_string ([fname UTF8String]) : Qnil;
1489}
1490
1491
1492DEFUN ("ns-get-resource", Fns_get_resource, Sns_get_resource, 2, 2, 0,
51d5ef9f
AR
1493 doc: /* Return the value of the property NAME of OWNER from the defaults database.
1494If OWNER is nil, Emacs is assumed. */)
edfda783
AR
1495 (owner, name)
1496 Lisp_Object owner, name;
1497{
1498 const char *value;
1499
1500 check_ns ();
1501 if (NILP (owner))
1502 owner = build_string
1503 ([[[NSProcessInfo processInfo] processName] UTF8String]);
1504 /* CHECK_STRING (owner); this should be just "Emacs" */
1505 CHECK_STRING (name);
1506/*fprintf (stderr, "ns-get-resource checking resource '%s'\n", SDATA (name)); */
1507
1508 value =[[[NSUserDefaults standardUserDefaults]
facfbbbd 1509 objectForKey: [NSString stringWithUTF8String: SDATA (name)]]
edfda783
AR
1510 UTF8String];
1511
1512 if (value)
1513 return build_string (value);
edfda783
AR
1514 return Qnil;
1515}
1516
1517
1518DEFUN ("ns-set-resource", Fns_set_resource, Sns_set_resource, 3, 3, 0,
51d5ef9f 1519 doc: /* Set property NAME of OWNER to VALUE, from the defaults database.
d26fbe1a 1520If OWNER is nil, Emacs is assumed.
51d5ef9f 1521If VALUE is nil, the default is removed. */)
edfda783
AR
1522 (owner, name, value)
1523 Lisp_Object owner, name, value;
1524{
1525 check_ns ();
1526 if (NILP (owner))
facfbbbd
SM
1527 owner
1528 = build_string ([[[NSProcessInfo processInfo] processName] UTF8String]);
edfda783
AR
1529 CHECK_STRING (owner);
1530 CHECK_STRING (name);
1531 if (NILP (value))
1532 {
1533 [[NSUserDefaults standardUserDefaults] removeObjectForKey:
facfbbbd 1534 [NSString stringWithUTF8String: SDATA (name)]];
edfda783
AR
1535 }
1536 else
1537 {
1538 CHECK_STRING (value);
1539 [[NSUserDefaults standardUserDefaults] setObject:
facfbbbd 1540 [NSString stringWithUTF8String: SDATA (value)]
edfda783 1541 forKey: [NSString stringWithUTF8String:
facfbbbd 1542 SDATA (name)]];
edfda783
AR
1543 }
1544
1545 return Qnil;
1546}
1547
1548
1549DEFUN ("ns-set-alpha", Fns_set_alpha, Sns_set_alpha, 2, 2, 0,
51d5ef9f 1550 doc: /* Return a color equivalent to COLOR with alpha setting ALPHA.
d26fbe1a 1551The argument ALPHA should be a number between 0 and 1, where 0 is full
51d5ef9f 1552transparency and 1 is opaque. */)
edfda783
AR
1553 (color, alpha)
1554 Lisp_Object color;
1555 Lisp_Object alpha;
1556{
1557 NSColor *col;
1558 float a;
1559
1560 CHECK_STRING (color);
1561 CHECK_NUMBER_OR_FLOAT (alpha);
1562
1563 if (ns_lisp_to_color (color, &col))
1564 error ("Unknown color.");
1565
1566 a = XFLOATINT (alpha);
1567 if (a < 0.0 || a > 1.0)
1568 error ("Alpha value should be between 0 and 1 inclusive.");
1569
1570 col = [col colorWithAlphaComponent: a];
1571 return ns_color_to_lisp (col);
1572}
1573
1574
952913d4
DN
1575DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
1576 Sx_server_max_request_size,
edfda783 1577 0, 1, 0,
51d5ef9f 1578 doc: /* This function is a no-op. It is only present for completeness. */)
edfda783
AR
1579 (display)
1580 Lisp_Object display;
1581{
1582 check_ns ();
1583 /* This function has no real equivalent under NeXTstep. Return nil to
1584 indicate this. */
1585 return Qnil;
1586}
1587
1588
9e50ff0c 1589DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
51d5ef9f 1590 doc: /* Return the vendor ID string of Nextstep display server DISPLAY.
d26fbe1a 1591DISPLAY should be either a frame or a display name (a string).
51d5ef9f 1592If omitted or nil, the selected frame's display is used. */)
edfda783
AR
1593 (display)
1594 Lisp_Object display;
1595{
edfda783
AR
1596#ifdef NS_IMPL_GNUSTEP
1597 return build_string ("GNU");
1598#else
1599 return build_string ("Apple");
1600#endif
1601}
1602
1603
9e50ff0c 1604DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
51d5ef9f 1605 doc: /* Return the version number of Nextstep display server DISPLAY.
d26fbe1a
CY
1606DISPLAY should be either a frame or a display name (a string).
1607If omitted or nil, the selected frame's display is used.
51d5ef9f 1608See also the function `ns-server-vendor'. */)
edfda783
AR
1609 (display)
1610 Lisp_Object display;
1611{
cb83c00b 1612 return ns_appkit_version ();
edfda783
AR
1613}
1614
1615
9e50ff0c 1616DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
51d5ef9f 1617 doc: /* Return the number of screens on Nextstep display server DISPLAY.
d26fbe1a 1618DISPLAY should be a frame, the display name as a string, or a terminal ID.
51d5ef9f 1619If omitted or nil, the selected frame's display is used. */)
edfda783
AR
1620 (display)
1621 Lisp_Object display;
1622{
1623 int num;
1624
1625 check_ns ();
1626 num = [[NSScreen screens] count];
1627
1628 return (num != 0) ? make_number (num) : Qnil;
1629}
1630
1631
9e50ff0c 1632DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height,
edfda783 1633 0, 1, 0,
51d5ef9f 1634 doc: /* Return the height of Nextstep display server DISPLAY, in millimeters.
d26fbe1a 1635DISPLAY should be a frame, the display name as a string, or a terminal ID.
51d5ef9f 1636If omitted or nil, the selected frame's display is used. */)
edfda783
AR
1637 (display)
1638 Lisp_Object display;
1639{
1640 check_ns ();
1641 return make_number ((int)
1642 ([ns_get_screen (display) frame].size.height/(92.0/25.4)));
1643}
1644
1645
9e50ff0c 1646DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width,
edfda783 1647 0, 1, 0,
51d5ef9f 1648 doc: /* Return the width of Nextstep display server DISPLAY, in millimeters.
d26fbe1a 1649DISPLAY should be a frame, the display name as a string, or a terminal ID.
51d5ef9f 1650If omitted or nil, the selected frame's display is used. */)
edfda783
AR
1651 (display)
1652 Lisp_Object display;
1653{
1654 check_ns ();
1655 return make_number ((int)
1656 ([ns_get_screen (display) frame].size.width/(92.0/25.4)));
1657}
1658
1659
9e50ff0c 1660DEFUN ("x-display-backing-store", Fx_display_backing_store,
51d5ef9f
AR
1661 Sx_display_backing_store, 0, 1, 0,
1662 doc: /* Return whether the Nexstep display DISPLAY supports backing store.
d26fbe1a
CY
1663The value may be `buffered', `retained', or `non-retained'.
1664DISPLAY should be a frame, the display name as a string, or a terminal ID.
51d5ef9f 1665If omitted or nil, the selected frame's display is used. */)
edfda783
AR
1666 (display)
1667 Lisp_Object display;
1668{
1669 check_ns ();
1670 switch ([ns_get_window (display) backingType])
1671 {
1672 case NSBackingStoreBuffered:
1673 return intern ("buffered");
1674 case NSBackingStoreRetained:
1675 return intern ("retained");
1676 case NSBackingStoreNonretained:
1677 return intern ("non-retained");
1678 default:
1679 error ("Strange value for backingType parameter of frame");
1680 }
1681 return Qnil; /* not reached, shut compiler up */
1682}
1683
1684
9e50ff0c 1685DEFUN ("x-display-visual-class", Fx_display_visual_class,
51d5ef9f
AR
1686 Sx_display_visual_class, 0, 1, 0,
1687 doc: /* Return the visual class of the Nextstep display server DISPLAY.
d26fbe1a
CY
1688The value is one of the symbols `static-gray', `gray-scale',
1689`static-color', `pseudo-color', `true-color', or `direct-color'.
1690DISPLAY should be a frame, the display name as a string, or a terminal ID.
51d5ef9f 1691If omitted or nil, the selected frame's display is used. */)
edfda783
AR
1692 (display)
1693 Lisp_Object display;
1694{
1695 NSWindowDepth depth;
1696 check_ns ();
1697 depth = [ns_get_screen (display) depth];
1698
1699 if ( depth == NSBestDepth (NSCalibratedWhiteColorSpace, 2, 2, YES, NULL))
1700 return intern ("static-gray");
1701 else if (depth == NSBestDepth (NSCalibratedWhiteColorSpace, 8, 8, YES, NULL))
1702 return intern ("gray-scale");
1703 else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 8, YES, NULL))
1704 return intern ("pseudo-color");
1705 else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 4, 12, NO, NULL))
1706 return intern ("true-color");
1707 else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 24, NO, NULL))
1708 return intern ("direct-color");
1709 else
d26fbe1a 1710 /* color mgmt as far as we do it is really handled by Nextstep itself anyway */
edfda783
AR
1711 return intern ("direct-color");
1712}
1713
1714
9e50ff0c 1715DEFUN ("x-display-save-under", Fx_display_save_under,
51d5ef9f
AR
1716 Sx_display_save_under, 0, 1, 0,
1717 doc: /* Non-nil if the Nextstep display server supports the save-under feature.
d26fbe1a
CY
1718The optional argument DISPLAY specifies which display to ask about.
1719DISPLAY should be a frame, the display name as a string, or a terminal ID.
51d5ef9f 1720If omitted or nil, the selected frame's display is used. */)
edfda783
AR
1721 (display)
1722 Lisp_Object display;
1723{
1724 check_ns ();
1725 switch ([ns_get_window (display) backingType])
1726 {
1727 case NSBackingStoreBuffered:
1728 return Qt;
1729
1730 case NSBackingStoreRetained:
1731 case NSBackingStoreNonretained:
1732 return Qnil;
1733
1734 default:
1735 error ("Strange value for backingType parameter of frame");
1736 }
1737 return Qnil; /* not reached, shut compiler up */
1738}
1739
1740
9e50ff0c 1741DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
51d5ef9f
AR
1742 1, 3, 0,
1743 doc: /* Open a connection to a Nextstep display server.
d26fbe1a 1744DISPLAY is the name of the display to connect to.
51d5ef9f 1745Optional arguments XRM-STRING and MUST-SUCCEED are currently ignored. */)
edfda783
AR
1746 (display, resource_string, must_succeed)
1747 Lisp_Object display, resource_string, must_succeed;
1748{
1749 struct ns_display_info *dpyinfo;
1750
1751 CHECK_STRING (display);
1752
1753 nxatoms_of_nsselect ();
1754 dpyinfo = ns_term_init (display);
1755 if (dpyinfo == 0)
1756 {
1757 if (!NILP (must_succeed))
1758 fatal ("OpenStep on %s not responding.\n",
facfbbbd 1759 SDATA (display));
edfda783
AR
1760 else
1761 error ("OpenStep on %s not responding.\n",
facfbbbd 1762 SDATA (display));
edfda783
AR
1763 }
1764
1765 /* Register our external input/output types, used for determining
1766 applicable services and also drag/drop eligibility. */
1767 ns_send_types = [[NSArray arrayWithObject: NSStringPboardType] retain];
1768 ns_return_types = [[NSArray arrayWithObject: NSStringPboardType] retain];
1769 ns_drag_types = [[NSArray arrayWithObjects:
1770 NSStringPboardType,
1771 NSTabularTextPboardType,
1772 NSFilenamesPboardType,
1773 NSURLPboardType,
1774 NSColorPboardType,
1775 NSFontPboardType, nil] retain];
1776
1777 return Qnil;
1778}
1779
1780
9e50ff0c 1781DEFUN ("x-close-connection", Fx_close_connection, Sx_close_connection,
51d5ef9f
AR
1782 1, 1, 0,
1783 doc: /* Close the connection to the current Nextstep display server.
1784The second argument DISPLAY is currently ignored. */)
edfda783
AR
1785 (display)
1786 Lisp_Object display;
1787{
1788 check_ns ();
1789#ifdef NS_IMPL_COCOA
1790 PSFlush ();
1791#endif
1792 /*ns_delete_terminal (dpyinfo->terminal); */
1793 [NSApp terminate: NSApp];
1794 return Qnil;
1795}
1796
1797
9e50ff0c 1798DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
51d5ef9f 1799 doc: /* Return the list of display names that Emacs has connections to. */)
edfda783
AR
1800 ()
1801{
1802 Lisp_Object tail, result;
1803
1804 result = Qnil;
1805 for (tail = ns_display_name_list; CONSP (tail); tail = XCDR (tail))
1806 result = Fcons (XCAR (XCAR (tail)), result);
1807
1808 return result;
1809}
1810
1811
1812DEFUN ("ns-hide-others", Fns_hide_others, Sns_hide_others,
51d5ef9f
AR
1813 0, 0, 0,
1814 doc: /* Hides all applications other than emacs. */)
edfda783
AR
1815 ()
1816{
1817 check_ns ();
1818 [NSApp hideOtherApplications: NSApp];
1819 return Qnil;
1820}
1821
1822DEFUN ("ns-hide-emacs", Fns_hide_emacs, Sns_hide_emacs,
51d5ef9f
AR
1823 1, 1, 0,
1824 doc: /* If ON is non-nil, the entire emacs application is hidden.
d26fbe1a
CY
1825Otherwise if emacs is hidden, it is unhidden.
1826If ON is equal to `activate', emacs is unhidden and becomes
51d5ef9f 1827the active application. */)
edfda783
AR
1828 (on)
1829 Lisp_Object on;
1830{
1831 check_ns ();
1832 if (EQ (on, intern ("activate")))
1833 {
1834 [NSApp unhide: NSApp];
1835 [NSApp activateIgnoringOtherApps: YES];
1836 }
1837 else if (NILP (on))
1838 [NSApp unhide: NSApp];
1839 else
1840 [NSApp hide: NSApp];
1841 return Qnil;
1842}
1843
1844
1845DEFUN ("ns-emacs-info-panel", Fns_emacs_info_panel, Sns_emacs_info_panel,
51d5ef9f
AR
1846 0, 0, 0,
1847 doc: /* Shows the 'Info' or 'About' panel for Emacs. */)
edfda783
AR
1848 ()
1849{
1850 check_ns ();
1851 [NSApp orderFrontStandardAboutPanel: nil];
1852 return Qnil;
1853}
1854
1855
edfda783 1856DEFUN ("ns-font-name", Fns_font_name, Sns_font_name, 1, 1, 0,
51d5ef9f 1857 doc: /* Determine font postscript or family name for font NAME.
d26fbe1a
CY
1858NAME should be a string containing either the font name or an XLFD
1859font descriptor. If string contains `fontset' and not
51d5ef9f 1860`fontset-startup', it is left alone. */)
edfda783
AR
1861 (name)
1862 Lisp_Object name;
1863{
1864 char *nm;
1865 CHECK_STRING (name);
1866 nm = SDATA (name);
1867
1868 if (nm[0] != '-')
1869 return name;
1870 if (strstr (nm, "fontset") && !strstr (nm, "fontset-startup"))
1871 return name;
1872
1873 return build_string (ns_xlfd_to_fontname (SDATA (name)));
1874}
1875
1876
1877DEFUN ("ns-list-colors", Fns_list_colors, Sns_list_colors, 0, 1, 0,
51d5ef9f
AR
1878 doc: /* Return a list of all available colors.
1879The optional argument FRAME is currently ignored. */)
edfda783
AR
1880 (frame)
1881 Lisp_Object frame;
1882{
1883 Lisp_Object list = Qnil;
1884 NSEnumerator *colorlists;
1885 NSColorList *clist;
1886
1887 if (!NILP (frame))
1888 {
1889 CHECK_FRAME (frame);
1890 if (! FRAME_NS_P (XFRAME (frame)))
d26fbe1a 1891 error ("non-Nextstep frame used in `ns-list-colors'");
edfda783
AR
1892 }
1893
1894 BLOCK_INPUT;
1895
1896 colorlists = [[NSColorList availableColorLists] objectEnumerator];
1897 while (clist = [colorlists nextObject])
1898 {
1899 if ([[clist name] length] < 7 ||
1900 [[clist name] rangeOfString: @"PANTONE"].location == 0)
1901 {
1902 NSEnumerator *cnames = [[clist allKeys] reverseObjectEnumerator];
1903 NSString *cname;
1904 while (cname = [cnames nextObject])
1905 list = Fcons (build_string ([cname UTF8String]), list);
1906/* for (i = [[clist allKeys] count] - 1; i >= 0; i--)
1907 list = Fcons (build_string ([[[clist allKeys] objectAtIndex: i]
1908 UTF8String]), list); */
1909 }
1910 }
1911
1912 UNBLOCK_INPUT;
1913
1914 return list;
1915}
1916
1917
1918DEFUN ("ns-list-services", Fns_list_services, Sns_list_services, 0, 0, 0,
51d5ef9f 1919 doc: /* List available Nextstep services by querying NSApp. */)
edfda783
AR
1920 ()
1921{
1922 Lisp_Object ret = Qnil;
1923 NSMenu *svcs;
1924 id delegate;
1925
1926 check_ns ();
1927 svcs = [[NSMenu alloc] initWithTitle: @"Services"];
1928 [NSApp setServicesMenu: svcs]; /* this and next rebuild on <10.4 */
1929 [NSApp registerServicesMenuSendTypes: ns_send_types
1930 returnTypes: ns_return_types];
1931
1932/* On Tiger, services menu updating was made lazier (waits for user to
1933 actually click on the menu), so we have to force things along: */
1934#ifdef NS_IMPL_COCOA
1935 if (NSAppKitVersionNumber >= 744.0)
1936 {
1937 delegate = [svcs delegate];
1938 if (delegate != nil)
1939 {
1940 if ([delegate respondsToSelector: @selector (menuNeedsUpdate:)])
1941 [delegate menuNeedsUpdate: svcs];
1942 if ([delegate respondsToSelector:
1943 @selector (menu:updateItem:atIndex:shouldCancel:)])
1944 {
1945 int i, len = [delegate numberOfItemsInMenu: svcs];
1946 for (i =0; i<len; i++)
1947 [svcs addItemWithTitle: @"" action: NULL keyEquivalent: @""];
1948 for (i =0; i<len; i++)
1949 if (![delegate menu: svcs
1950 updateItem: (NSMenuItem *)[svcs itemAtIndex: i]
1951 atIndex: i shouldCancel: NO])
1952 break;
1953 }
1954 }
1955 }
1956#endif
1957
1958 [svcs setAutoenablesItems: NO];
1959#ifdef NS_IMPL_COCOA
1960 [svcs update]; /* on OS X, converts from '/' structure */
1961#endif
1962
1963 ret = interpret_services_menu (svcs, Qnil, ret);
1964 return ret;
1965}
1966
1967
1968DEFUN ("ns-perform-service", Fns_perform_service, Sns_perform_service,
51d5ef9f
AR
1969 2, 2, 0,
1970 doc: /* Perform Nextstep SERVICE on SEND.
d26fbe1a
CY
1971SEND should be either a string or nil.
1972The return value is the result of the service, as string, or nil if
51d5ef9f 1973there was no result. */)
edfda783
AR
1974 (service, send)
1975 Lisp_Object service, send;
1976{
1977 id pb;
1978 NSString *svcName;
1979 char *utfStr;
1980 int len;
1981
1982 CHECK_STRING (service);
1983 check_ns ();
1984
facfbbbd 1985 utfStr = SDATA (service);
edfda783
AR
1986 svcName = [NSString stringWithUTF8String: utfStr];
1987
1988 pb =[NSPasteboard pasteboardWithUniqueName];
1989 ns_string_to_pasteboard (pb, send);
1990
1991 if (NSPerformService (svcName, pb) == NO)
1992 Fsignal (Qquit, Fcons (build_string ("service not available"), Qnil));
1993
1994 if ([[pb types] count] == 0)
1995 return build_string ("");
1996 return ns_string_from_pasteboard (pb);
1997}
1998
1999
2000DEFUN ("ns-convert-utf8-nfd-to-nfc", Fns_convert_utf8_nfd_to_nfc,
2001 Sns_convert_utf8_nfd_to_nfc, 1, 1, 0,
51d5ef9f 2002 doc: /* Return an NFC string that matches the UTF-8 NFD string STR. */)
edfda783
AR
2003 (str)
2004 Lisp_Object str;
2005{
f2f7f42c
AR
2006/* TODO: If GNUstep ever implements precomposedStringWithCanonicalMapping,
2007 remove this. */
edfda783
AR
2008 NSString *utfStr;
2009
2010 CHECK_STRING (str);
f2f7f42c
AR
2011 utfStr = [NSString stringWithUTF8String: SDATA (str)];
2012 if (![utfStr respondsToSelector:
2013 @selector (precomposedStringWithCanonicalMapping)])
2014 {
2015 message1
2016 ("Warning: ns-convert-utf8-nfd-to-nfc unsupported under GNUstep.\n");
2017 return Qnil;
2018 }
2019 else
2020 utfStr = [utfStr precomposedStringWithCanonicalMapping];
edfda783
AR
2021 return build_string ([utfStr UTF8String]);
2022}
2023
2024
583ff3c3
AR
2025#ifdef NS_IMPL_COCOA
2026
2027/* Compile and execute the AppleScript SCRIPT and return the error
2028 status as function value. A zero is returned if compilation and
2029 execution is successful, in which case *RESULT is set to a Lisp
2030 string or a number containing the resulting script value. Otherwise,
2031 1 is returned. */
2032static int
2033ns_do_applescript (script, result)
2034 Lisp_Object script, *result;
2035{
2036 NSAppleEventDescriptor *desc;
2037 NSDictionary* errorDict;
2038 NSAppleEventDescriptor* returnDescriptor = NULL;
2039
2040 NSAppleScript* scriptObject =
2041 [[NSAppleScript alloc] initWithSource:
2042 [NSString stringWithUTF8String: SDATA (script)]];
2043
2044 returnDescriptor = [scriptObject executeAndReturnError: &errorDict];
2045 [scriptObject release];
2046
2047 *result = Qnil;
2048
2049 if (returnDescriptor != NULL)
2050 {
2051 // successful execution
2052 if (kAENullEvent != [returnDescriptor descriptorType])
2053 {
2054 *result = Qt;
2055 // script returned an AppleScript result
2056 if ((typeUnicodeText == [returnDescriptor descriptorType]) ||
2057 (typeUTF16ExternalRepresentation
2058 == [returnDescriptor descriptorType]) ||
2059 (typeUTF8Text == [returnDescriptor descriptorType]) ||
2060 (typeCString == [returnDescriptor descriptorType]))
2061 {
2062 desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
2063 if (desc)
2064 *result = build_string([[desc stringValue] UTF8String]);
2065 }
2066 else
2067 {
2068 /* use typeUTF16ExternalRepresentation? */
2069 // coerce the result to the appropriate ObjC type
2070 desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
2071 if (desc)
2072 *result = make_number([desc int32Value]);
2073 }
2074 }
2075 }
2076 else
2077 {
2078 // no script result, return error
2079 return 1;
2080 }
2081 return 0;
2082}
2083
2084DEFUN ("ns-do-applescript", Fns_do_applescript, Sns_do_applescript, 1, 1, 0,
2085 doc: /* Execute AppleScript SCRIPT and return the result. If
2086compilation and execution are successful, the resulting script value
2087is returned as a string, a number or, in the case of other constructs,
2088t. In case the execution fails, an error is signaled. */)
2089 (script)
2090 Lisp_Object script;
2091{
2092 Lisp_Object result;
2093 long status;
2094
2095 CHECK_STRING (script);
2096 check_ns ();
2097
2098 BLOCK_INPUT;
2099 status = ns_do_applescript (script, &result);
2100 UNBLOCK_INPUT;
2101 if (status == 0)
2102 return result;
2103 else if (!STRINGP (result))
2104 error ("AppleScript error %d", status);
2105 else
2106 error ("%s", SDATA (result));
2107}
2108#endif
2109
2110
2111
edfda783
AR
2112/* ==========================================================================
2113
2114 Miscellaneous functions not called through hooks
2115
2116 ========================================================================== */
2117
2118
2119/* 23: call in image.c */
2120FRAME_PTR
2121check_x_frame (Lisp_Object frame)
2122{
2123 return check_ns_frame (frame);
2124}
2125
2126/* 23: added, due to call in frame.c */
2127struct ns_display_info *
2128check_x_display_info (Lisp_Object frame)
2129{
2130 return check_ns_display_info (frame);
2131}
2132
2133
2134/* 23: new function; we don't have much in the way of flexibility though */
2135void
2136x_set_scroll_bar_default_width (f)
2137 struct frame *f;
2138{
2139 int wid = FRAME_COLUMN_WIDTH (f);
2140 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = NS_SCROLL_BAR_WIDTH_DEFAULT;
2141 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) +
2142 wid - 1) / wid;
2143}
2144
2145
2146/* 23: terms now impl this instead of x-get-resource directly */
2147const char *
2148x_get_string_resource (XrmDatabase rdb, char *name, char *class)
2149{
6fb5f7da 2150 /* remove appname prefix; TODO: allow for !="Emacs" */
edfda783
AR
2151 char *toCheck = class + (!strncmp (class, "Emacs.", 6) ? 6 : 0);
2152 const char *res;
2153 check_ns ();
2154
2155 /* Support emacs-20-style face resources for backwards compatibility */
2156 if (!strncmp (toCheck, "Face", 4))
2157 toCheck = name + (!strncmp (name, "emacs.", 6) ? 6 : 0);
2158
2159/*fprintf (stderr, "Checking '%s'\n", toCheck); */
2160
2161 res = [[[NSUserDefaults standardUserDefaults] objectForKey:
2162 [NSString stringWithUTF8String: toCheck]] UTF8String];
2163 return !res ? NULL :
2164 (!strncasecmp (res, "YES", 3) ? "true" :
2165 (!strncasecmp (res, "NO", 2) ? "false" : res));
2166}
2167
2168
2169Lisp_Object
2170x_get_focus_frame (struct frame *frame)
2171{
2172 struct ns_display_info *dpyinfo = FRAME_NS_DISPLAY_INFO (frame);
2173 Lisp_Object nsfocus;
2174
9e50ff0c 2175 if (!dpyinfo->x_focus_frame)
edfda783
AR
2176 return Qnil;
2177
9e50ff0c 2178 XSETFRAME (nsfocus, dpyinfo->x_focus_frame);
edfda783
AR
2179 return nsfocus;
2180}
2181
2182
2183int
2184x_pixel_width (struct frame *f)
2185{
2186 return FRAME_PIXEL_WIDTH (f);
2187}
2188
2189
2190int
2191x_pixel_height (struct frame *f)
2192{
2193 return FRAME_PIXEL_HEIGHT (f);
2194}
2195
2196
2197int
2198x_char_width (struct frame *f)
2199{
2200 return FRAME_COLUMN_WIDTH (f);
2201}
2202
2203
2204int
2205x_char_height (struct frame *f)
2206{
2207 return FRAME_LINE_HEIGHT (f);
2208}
2209
2210
2211int
2212x_screen_planes (struct frame *f)
2213{
2214 return FRAME_NS_DISPLAY_INFO (f)->n_planes;
2215}
2216
2217
2218void
2219x_sync (Lisp_Object frame)
2220{
2221 /* XXX Not implemented XXX */
2222 return;
2223}
2224
2225
2226
2227/* ==========================================================================
2228
2229 Lisp definitions that, for whatever reason, we can't alias as 'ns-XXX'.
2230
2231 ========================================================================== */
2232
2233
952913d4 2234DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
51d5ef9f
AR
2235 doc: /* Return t if the current Nextstep display supports the color COLOR.
2236The optional argument FRAME is currently ignored. */)
edfda783
AR
2237 (color, frame)
2238 Lisp_Object color, frame;
2239{
2240 NSColor * col;
2241 check_ns ();
2242 return ns_lisp_to_color (color, &col) ? Qnil : Qt;
2243}
2244
2245
952913d4 2246DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
51d5ef9f 2247 doc: /* Return a description of the color named COLOR.
d26fbe1a
CY
2248The value is a list of integer RGBA values--(RED GREEN BLUE ALPHA).
2249These values appear to range from 0 to 65280; white is (65280 65280 65280 0).
51d5ef9f 2250The optional argument FRAME is currently ignored. */)
edfda783
AR
2251 (color, frame)
2252 Lisp_Object color, frame;
2253{
2254 NSColor * col;
2255 float red, green, blue, alpha;
2256 Lisp_Object rgba[4];
2257
2258 check_ns ();
2259 CHECK_STRING (color);
2260
2261 if (ns_lisp_to_color (color, &col))
2262 return Qnil;
2263
2264 [[col colorUsingColorSpaceName: NSCalibratedRGBColorSpace]
2265 getRed: &red green: &green blue: &blue alpha: &alpha];
2266 rgba[0] = make_number (lrint (red*65280));
2267 rgba[1] = make_number (lrint (green*65280));
2268 rgba[2] = make_number (lrint (blue*65280));
2269 rgba[3] = make_number (lrint (alpha*65280));
2270
2271 return Flist (4, rgba);
2272}
2273
2274
2275DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
51d5ef9f 2276 doc: /* Return t if the Nextstep display supports color.
d26fbe1a
CY
2277The optional argument DISPLAY specifies which display to ask about.
2278DISPLAY should be either a frame, a display name (a string), or terminal ID.
51d5ef9f 2279If omitted or nil, that stands for the selected frame's display. */)
edfda783
AR
2280 (display)
2281 Lisp_Object display;
2282{
2283 NSWindowDepth depth;
2284 NSString *colorSpace;
2285 check_ns ();
2286 depth = [ns_get_screen (display) depth];
2287 colorSpace = NSColorSpaceFromDepth (depth);
2288
2289 return [colorSpace isEqualToString: NSDeviceWhiteColorSpace]
2290 || [colorSpace isEqualToString: NSCalibratedWhiteColorSpace]
2291 ? Qnil : Qt;
2292}
2293
2294
2295DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p,
2296 Sx_display_grayscale_p, 0, 1, 0,
51d5ef9f 2297 doc: /* Return t if the Nextstep display supports shades of gray.
d26fbe1a
CY
2298Note that color displays do support shades of gray.
2299The optional argument DISPLAY specifies which display to ask about.
2300DISPLAY should be either a frame, a display name (a string), or terminal ID.
51d5ef9f 2301If omitted or nil, that stands for the selected frame's display. */)
edfda783
AR
2302 (display)
2303 Lisp_Object display;
2304{
2305 NSWindowDepth depth;
2306 check_ns ();
2307 depth = [ns_get_screen (display) depth];
2308
2309 return NSBitsPerPixelFromDepth (depth) > 1 ? Qt : Qnil;
2310}
2311
2312
952913d4 2313DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
edfda783 2314 0, 1, 0,
51d5ef9f 2315 doc: /* Returns the width in pixels of the Nextstep display DISPLAY.
d26fbe1a
CY
2316The optional argument DISPLAY specifies which display to ask about.
2317DISPLAY should be either a frame, a display name (a string), or terminal ID.
51d5ef9f 2318If omitted or nil, that stands for the selected frame's display. */)
edfda783
AR
2319 (display)
2320 Lisp_Object display;
2321{
2322 check_ns ();
2323 return make_number ((int) [ns_get_screen (display) frame].size.width);
2324}
2325
2326
952913d4
DN
2327DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
2328 Sx_display_pixel_height, 0, 1, 0,
51d5ef9f 2329 doc: /* Returns the height 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.height);
2338}
2339
583ff3c3 2340
edfda783
AR
2341DEFUN ("display-usable-bounds", Fns_display_usable_bounds,
2342 Sns_display_usable_bounds, 0, 1, 0,
51d5ef9f 2343 doc: /*Return the bounds of the usable part of the screen.
d26fbe1a
CY
2344The return value is a list of integers (LEFT TOP WIDTH HEIGHT), which
2345are the boundaries of the usable part of the screen, excluding areas
2346reserved for the Mac menu, dock, and so forth.
2347
2348The screen queried corresponds to DISPLAY, which should be either a
2349frame, a display name (a string), or terminal ID. If omitted or nil,
51d5ef9f 2350that stands for the selected frame's display. */)
edfda783
AR
2351 (display)
2352 Lisp_Object display;
2353{
2354 int top;
2355 NSRect vScreen;
2356
2357 check_ns ();
2358 vScreen = [ns_get_screen (display) visibleFrame];
2359 top = vScreen.origin.y == 0.0 ?
2360 (int) [ns_get_screen (display) frame].size.height - vScreen.size.height : 0;
2361
2362 return list4 (make_number ((int) vScreen.origin.x),
2363 make_number (top),
2364 make_number ((int) vScreen.size.width),
2365 make_number ((int) vScreen.size.height));
2366}
2367
2368
952913d4 2369DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
edfda783 2370 0, 1, 0,
51d5ef9f 2371 doc: /* Returns the number of bitplanes of the Nextstep display DISPLAY.
d26fbe1a
CY
2372The optional argument DISPLAY specifies which display to ask about.
2373DISPLAY should be either a frame, a display name (a string), or terminal ID.
51d5ef9f 2374If omitted or nil, that stands for the selected frame's display. */)
edfda783
AR
2375 (display)
2376 Lisp_Object display;
2377{
2378 check_ns ();
2379 return make_number
2380 (NSBitsPerSampleFromDepth ([ns_get_screen (display) depth]));
2381}
2382
2383
952913d4
DN
2384DEFUN ("x-display-color-cells", Fx_display_color_cells,
2385 Sx_display_color_cells, 0, 1, 0,
51d5ef9f 2386 doc: /* Returns the number of color cells of the Nextstep display DISPLAY.
d26fbe1a
CY
2387The optional argument DISPLAY specifies which display to ask about.
2388DISPLAY should be either a frame, a display name (a string), or terminal ID.
51d5ef9f 2389If omitted or nil, that stands for the selected frame's display. */)
edfda783
AR
2390 (display)
2391 Lisp_Object display;
2392{
2393 check_ns ();
2394 struct ns_display_info *dpyinfo = check_ns_display_info (display);
2395
2396 /* We force 24+ bit depths to 24-bit to prevent an overflow. */
2397 return make_number (1 << min (dpyinfo->n_planes, 24));
2398}
2399
2400
2401/* Unused dummy def needed for compatibility. */
2402Lisp_Object tip_frame;
2403
6fb5f7da 2404/* TODO: move to xdisp or similar */
edfda783
AR
2405static void
2406compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y)
2407 struct frame *f;
2408 Lisp_Object parms, dx, dy;
2409 int width, height;
2410 int *root_x, *root_y;
2411{
2412 Lisp_Object left, top;
2413 EmacsView *view = FRAME_NS_VIEW (f);
2414 NSPoint pt;
2415
2416 /* Start with user-specified or mouse position. */
2417 left = Fcdr (Fassq (Qleft, parms));
2418 if (INTEGERP (left))
2419 pt.x = XINT (left);
2420 else
2421 pt.x = last_mouse_motion_position.x;
2422 top = Fcdr (Fassq (Qtop, parms));
2423 if (INTEGERP (top))
2424 pt.y = XINT (top);
2425 else
2426 pt.y = last_mouse_motion_position.y;
2427
2428 /* Convert to screen coordinates */
2429 pt = [view convertPoint: pt toView: nil];
2430 pt = [[view window] convertBaseToScreen: pt];
2431
2432 /* Ensure in bounds. (Note, screen origin = lower left.) */
2433 if (pt.x + XINT (dx) <= 0)
2434 *root_x = 0; /* Can happen for negative dx */
889bd438
CY
2435 else if (pt.x + XINT (dx) + width
2436 <= x_display_pixel_width (FRAME_NS_DISPLAY_INFO (f)))
edfda783
AR
2437 /* It fits to the right of the pointer. */
2438 *root_x = pt.x + XINT (dx);
2439 else if (width + XINT (dx) <= pt.x)
2440 /* It fits to the left of the pointer. */
2441 *root_x = pt.x - width - XINT (dx);
2442 else
2443 /* Put it left justified on the screen -- it ought to fit that way. */
2444 *root_x = 0;
2445
2446 if (pt.y - XINT (dy) - height >= 0)
2447 /* It fits below the pointer. */
2448 *root_y = pt.y - height - XINT (dy);
889bd438
CY
2449 else if (pt.y + XINT (dy) + height
2450 <= x_display_pixel_height (FRAME_NS_DISPLAY_INFO (f)))
edfda783
AR
2451 /* It fits above the pointer */
2452 *root_y = pt.y + XINT (dy);
2453 else
2454 /* Put it on the top. */
889bd438 2455 *root_y = x_display_pixel_height (FRAME_NS_DISPLAY_INFO (f)) - height;
edfda783
AR
2456}
2457
2458
2459DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
2460 doc: /* Show STRING in a "tooltip" window on frame FRAME.
2461A tooltip window is a small window displaying a string.
2462
2463FRAME nil or omitted means use the selected frame.
2464
2465PARMS is an optional list of frame parameters which can be used to
2466change the tooltip's appearance.
2467
2468Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
2469means use the default timeout of 5 seconds.
2470
2471If the list of frame parameters PARMS contains a `left' parameter,
2472the tooltip is displayed at that x-position. Otherwise it is
2473displayed at the mouse position, with offset DX added (default is 5 if
2474DX isn't specified). Likewise for the y-position; if a `top' frame
2475parameter is specified, it determines the y-position of the tooltip
2476window, otherwise it is displayed at the mouse position, with offset
2477DY added (default is -10).
2478
2479A tooltip's maximum size is specified by `x-max-tooltip-size'.
2480Text larger than the specified size is clipped. */)
2481 (string, frame, parms, timeout, dx, dy)
2482 Lisp_Object string, frame, parms, timeout, dx, dy;
2483{
2484 int root_x, root_y;
2485 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2486 int count = SPECPDL_INDEX ();
2487 struct frame *f;
2488 char *str;
2489 NSSize size;
2490
2491 specbind (Qinhibit_redisplay, Qt);
2492
2493 GCPRO4 (string, parms, frame, timeout);
2494
2495 CHECK_STRING (string);
facfbbbd 2496 str = SDATA (string);
edfda783
AR
2497 f = check_x_frame (frame);
2498 if (NILP (timeout))
2499 timeout = make_number (5);
2500 else
2501 CHECK_NATNUM (timeout);
2502
2503 if (NILP (dx))
2504 dx = make_number (5);
2505 else
2506 CHECK_NUMBER (dx);
2507
2508 if (NILP (dy))
2509 dy = make_number (-10);
2510 else
2511 CHECK_NUMBER (dy);
2512
2513 BLOCK_INPUT;
2514 if (ns_tooltip == nil)
2515 ns_tooltip = [[EmacsTooltip alloc] init];
2516 else
2517 Fx_hide_tip ();
2518
2519 [ns_tooltip setText: str];
2520 size = [ns_tooltip frame].size;
2521
2522 /* Move the tooltip window where the mouse pointer is. Resize and
2523 show it. */
2524 compute_tip_xy (f, parms, dx, dy, (int)size.width, (int)size.height,
2525 &root_x, &root_y);
2526
2527 [ns_tooltip showAtX: root_x Y: root_y for: XINT (timeout)];
2528 UNBLOCK_INPUT;
2529
2530 UNGCPRO;
2531 return unbind_to (count, Qnil);
2532}
2533
2534
2535DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
2536 doc: /* Hide the current tooltip window, if there is any.
2537Value is t if tooltip was open, nil otherwise. */)
2538 ()
2539{
2540 if (ns_tooltip == nil || ![ns_tooltip isActive])
2541 return Qnil;
2542 [ns_tooltip hide];
2543 return Qt;
2544}
2545
2546
cc98b6a0
DN
2547/* ==========================================================================
2548
2549 Class implementations
2550
2551 ========================================================================== */
2552
2553
2554@implementation EmacsSavePanel
2555#ifdef NS_IMPL_COCOA
2556/* --------------------------------------------------------------------------
2557 These are overridden to intercept on OS X: ending panel restarts NSApp
2558 event loop if it is stopped. Not sure if this is correct behavior,
2559 perhaps should check if running and if so send an appdefined.
2560 -------------------------------------------------------------------------- */
2561- (void) ok: (id)sender
2562{
2563 [super ok: sender];
2564 panelOK = 1;
2565 [NSApp stop: self];
2566}
2567- (void) cancel: (id)sender
2568{
2569 [super cancel: sender];
2570 [NSApp stop: self];
2571}
2572#endif
2573@end
2574
2575
2576@implementation EmacsOpenPanel
2577#ifdef NS_IMPL_COCOA
2578/* --------------------------------------------------------------------------
2579 These are overridden to intercept on OS X: ending panel restarts NSApp
2580 event loop if it is stopped. Not sure if this is correct behavior,
2581 perhaps should check if running and if so send an appdefined.
2582 -------------------------------------------------------------------------- */
2583- (void) ok: (id)sender
2584{
2585 [super ok: sender];
2586 panelOK = 1;
2587 [NSApp stop: self];
2588}
2589- (void) cancel: (id)sender
2590{
2591 [super cancel: sender];
2592 [NSApp stop: self];
2593}
2594#endif
2595@end
2596
2597
2598@implementation EmacsFileDelegate
2599/* --------------------------------------------------------------------------
2600 Delegate methods for Open/Save panels
2601 -------------------------------------------------------------------------- */
2602- (BOOL)panel: (id)sender isValidFilename: (NSString *)filename
2603{
2604 return YES;
2605}
2606- (BOOL)panel: (id)sender shouldShowFilename: (NSString *)filename
2607{
2608 return YES;
2609}
2610- (NSString *)panel: (id)sender userEnteredFilename: (NSString *)filename
2611 confirmed: (BOOL)okFlag
2612{
2613 return filename;
2614}
2615@end
2616
2617#endif
2618
edfda783
AR
2619/* ==========================================================================
2620
2621 Lisp interface declaration
2622
2623 ========================================================================== */
2624
2625
2626void
2627syms_of_nsfns ()
2628{
2629 int i;
2630
edfda783
AR
2631 Qnone = intern ("none");
2632 staticpro (&Qnone);
2633 Qbuffered = intern ("bufferd");
2634 staticpro (&Qbuffered);
2635 Qfontsize = intern ("fontsize");
2636 staticpro (&Qfontsize);
2637
2638 DEFVAR_LISP ("ns-icon-type-alist", &Vns_icon_type_alist,
51d5ef9f 2639 doc: /* Alist of elements (REGEXP . IMAGE) for images of icons associated to frames.
d26fbe1a
CY
2640If the title of a frame matches REGEXP, then IMAGE.tiff is
2641selected as the image of the icon representing the frame when it's
2642miniaturized. If an element is t, then Emacs tries to select an icon
2643based on the filetype of the visited file.
2644
2645The images have to be installed in a folder called English.lproj in the
2646Emacs folder. You have to restart Emacs after installing new icons.
2647
2648Example: Install an icon Gnus.tiff and execute the following code
2649
2650 (setq ns-icon-type-alist
2651 (append ns-icon-type-alist
2652 '((\"^\\\\*\\\\(Group\\\\*$\\\\|Summary \\\\|Article\\\\*$\\\\)\"
2653 . \"Gnus\"))))
2654
2655When you miniaturize a Group, Summary or Article frame, Gnus.tiff will
51d5ef9f 2656be used as the image of the icon representing the frame. */);
edfda783
AR
2657 Vns_icon_type_alist = Fcons (Qt, Qnil);
2658
cb83c00b
AR
2659 DEFVAR_LISP ("ns-version-string", &Vns_version_string,
2660 doc: /* Toolkit version for NS Windowing. */);
2661 Vns_version_string = ns_appkit_version ();
2662
edfda783
AR
2663 defsubr (&Sns_read_file_name);
2664 defsubr (&Sns_get_resource);
2665 defsubr (&Sns_set_resource);
2666 defsubr (&Sxw_display_color_p); /* this and next called directly by C code */
2667 defsubr (&Sx_display_grayscale_p);
edfda783
AR
2668 defsubr (&Sns_font_name);
2669 defsubr (&Sns_list_colors);
74876614 2670#ifdef NS_IMPL_COCOA
583ff3c3 2671 defsubr (&Sns_do_applescript);
74876614 2672#endif
952913d4
DN
2673 defsubr (&Sxw_color_defined_p);
2674 defsubr (&Sxw_color_values);
2675 defsubr (&Sx_server_max_request_size);
9e50ff0c
DN
2676 defsubr (&Sx_server_vendor);
2677 defsubr (&Sx_server_version);
952913d4
DN
2678 defsubr (&Sx_display_pixel_width);
2679 defsubr (&Sx_display_pixel_height);
edfda783 2680 defsubr (&Sns_display_usable_bounds);
9e50ff0c
DN
2681 defsubr (&Sx_display_mm_width);
2682 defsubr (&Sx_display_mm_height);
2683 defsubr (&Sx_display_screens);
952913d4
DN
2684 defsubr (&Sx_display_planes);
2685 defsubr (&Sx_display_color_cells);
9e50ff0c
DN
2686 defsubr (&Sx_display_visual_class);
2687 defsubr (&Sx_display_backing_store);
2688 defsubr (&Sx_display_save_under);
2689 defsubr (&Sx_create_frame);
edfda783 2690 defsubr (&Sns_set_alpha);
9e50ff0c
DN
2691 defsubr (&Sx_open_connection);
2692 defsubr (&Sx_close_connection);
2693 defsubr (&Sx_display_list);
edfda783
AR
2694
2695 defsubr (&Sns_hide_others);
2696 defsubr (&Sns_hide_emacs);
2697 defsubr (&Sns_emacs_info_panel);
2698 defsubr (&Sns_list_services);
2699 defsubr (&Sns_perform_service);
2700 defsubr (&Sns_convert_utf8_nfd_to_nfc);
9e50ff0c 2701 defsubr (&Sx_focus_frame);
edfda783
AR
2702 defsubr (&Sns_popup_prefs_panel);
2703 defsubr (&Sns_popup_font_panel);
2704 defsubr (&Sns_popup_color_panel);
2705
2706 defsubr (&Sx_show_tip);
2707 defsubr (&Sx_hide_tip);
2708
2709 /* used only in fontset.c */
2710 check_window_system_func = check_ns;
2711
2712}
2713
2f8e74bb 2714// arch-tag: dc2a3f74-1123-4daa-8eed-fb78db6a5642