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