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