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