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