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