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