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