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