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