use dynwind_begin and dynwind_end
[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 (STRINGP (arg))
827 str = SSDATA (arg);
828 else if (SYMBOLP (arg))
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[256];
877
878 #ifdef NS_IMPL_GNUSTEP
879 sprintf(tmp, "gnustep-gui-%s", Xstr(GNUSTEP_GUI_VERSION));
880 #elif defined (NS_IMPL_COCOA)
881 NSString *osversion
882 = [[NSProcessInfo processInfo] operatingSystemVersionString];
883 sprintf(tmp, "appkit-%.2f %s",
884 NSAppKitVersionNumber,
885 [osversion UTF8String]);
886 #else
887 tmp = "ns-unknown";
888 #endif
889 return build_string (tmp);
890 }
891
892
893 /* This is for use by x-server-version and collapses all version info we
894 have into a single int. For a better picture of the implementation
895 running, use ns_appkit_version_str.*/
896 static int
897 ns_appkit_version_int (void)
898 {
899 #ifdef NS_IMPL_GNUSTEP
900 return GNUSTEP_GUI_MAJOR_VERSION * 100 + GNUSTEP_GUI_MINOR_VERSION;
901 #elif defined (NS_IMPL_COCOA)
902 return (int)NSAppKitVersionNumber;
903 #endif
904 return 0;
905 }
906
907
908 static void
909 x_icon (struct frame *f, Lisp_Object parms)
910 /* --------------------------------------------------------------------------
911 Strangely-named function to set icon position parameters in frame.
912 This is irrelevant under OS X, but might be needed under GNUstep,
913 depending on the window manager used. Note, this is not a standard
914 frame parameter-setter; it is called directly from x-create-frame.
915 -------------------------------------------------------------------------- */
916 {
917 Lisp_Object icon_x, icon_y;
918 struct ns_display_info *dpyinfo = check_ns_display_info (Qnil);
919
920 f->output_data.ns->icon_top = Qnil;
921 f->output_data.ns->icon_left = Qnil;
922
923 /* Set the position of the icon. */
924 icon_x = x_get_arg (dpyinfo, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
925 icon_y = x_get_arg (dpyinfo, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
926 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
927 {
928 CHECK_NUMBER (icon_x);
929 CHECK_NUMBER (icon_y);
930 f->output_data.ns->icon_top = icon_y;
931 f->output_data.ns->icon_left = icon_x;
932 }
933 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
934 error ("Both left and top icon corners of icon must be specified");
935 }
936
937
938 /* Note: see frame.c for template, also where generic functions are impl */
939 frame_parm_handler ns_frame_parm_handlers[] =
940 {
941 x_set_autoraise, /* generic OK */
942 x_set_autolower, /* generic OK */
943 x_set_background_color,
944 0, /* x_set_border_color, may be impossible under Nextstep */
945 0, /* x_set_border_width, may be impossible under Nextstep */
946 x_set_cursor_color,
947 x_set_cursor_type,
948 x_set_font, /* generic OK */
949 x_set_foreground_color,
950 x_set_icon_name,
951 x_set_icon_type,
952 x_set_internal_border_width, /* generic OK */
953 0, /* x_set_right_divider_width */
954 0, /* x_set_bottom_divider_width */
955 x_set_menu_bar_lines,
956 x_set_mouse_color,
957 x_explicitly_set_name,
958 x_set_scroll_bar_width, /* generic OK */
959 x_set_title,
960 x_set_unsplittable, /* generic OK */
961 x_set_vertical_scroll_bars, /* generic OK */
962 x_set_visibility, /* generic OK */
963 x_set_tool_bar_lines,
964 0, /* x_set_scroll_bar_foreground, will ignore (not possible on NS) */
965 0, /* x_set_scroll_bar_background, will ignore (not possible on NS) */
966 x_set_screen_gamma, /* generic OK */
967 x_set_line_spacing, /* generic OK, sets f->extra_line_spacing to int */
968 x_set_fringe_width, /* generic OK */
969 x_set_fringe_width, /* generic OK */
970 0, /* x_set_wait_for_wm, will ignore */
971 x_set_fullscreen, /* generic OK */
972 x_set_font_backend, /* generic OK */
973 x_set_alpha,
974 0, /* x_set_sticky */
975 0, /* x_set_tool_bar_position */
976 };
977
978
979 /* Handler for signals raised during x_create_frame.
980 FRAME is the frame which is partially constructed. */
981
982 static void
983 unwind_create_frame (Lisp_Object frame)
984 {
985 struct frame *f = XFRAME (frame);
986
987 /* If frame is already dead, nothing to do. This can happen if the
988 display is disconnected after the frame has become official, but
989 before x_create_frame removes the unwind protect. */
990 if (!FRAME_LIVE_P (f))
991 return;
992
993 /* If frame is ``official'', nothing to do. */
994 if (NILP (Fmemq (frame, Vframe_list)))
995 {
996 #if defined GLYPH_DEBUG && defined ENABLE_CHECKING
997 struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
998 #endif
999
1000 x_free_frame_resources (f);
1001 free_glyphs (f);
1002
1003 #ifdef GLYPH_DEBUG
1004 /* Check that reference counts are indeed correct. */
1005 eassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount);
1006 #endif
1007 }
1008 }
1009
1010 /*
1011 * Read geometry related parameters from preferences if not in PARMS.
1012 * Returns the union of parms and any preferences read.
1013 */
1014
1015 static Lisp_Object
1016 get_geometry_from_preferences (struct ns_display_info *dpyinfo,
1017 Lisp_Object parms)
1018 {
1019 struct {
1020 const char *val;
1021 const char *cls;
1022 Lisp_Object tem;
1023 } r[] = {
1024 { "width", "Width", Qwidth },
1025 { "height", "Height", Qheight },
1026 { "left", "Left", Qleft },
1027 { "top", "Top", Qtop },
1028 };
1029
1030 int i;
1031 for (i = 0; i < ARRAYELTS (r); ++i)
1032 {
1033 if (NILP (Fassq (r[i].tem, parms)))
1034 {
1035 Lisp_Object value
1036 = x_get_arg (dpyinfo, parms, r[i].tem, r[i].val, r[i].cls,
1037 RES_TYPE_NUMBER);
1038 if (! EQ (value, Qunbound))
1039 parms = Fcons (Fcons (r[i].tem, value), parms);
1040 }
1041 }
1042
1043 return parms;
1044 }
1045
1046 /* ==========================================================================
1047
1048 Lisp definitions
1049
1050 ========================================================================== */
1051
1052 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
1053 1, 1, 0,
1054 doc: /* Make a new Nextstep window, called a "frame" in Emacs terms.
1055 Return an Emacs frame object.
1056 PARMS is an alist of frame parameters.
1057 If the parameters specify that the frame should not have a minibuffer,
1058 and do not specify a specific minibuffer window to use,
1059 then `default-minibuffer-frame' must be a frame whose minibuffer can
1060 be shared by the new frame.
1061
1062 This function is an internal primitive--use `make-frame' instead. */)
1063 (Lisp_Object parms)
1064 {
1065 struct frame *f;
1066 Lisp_Object frame, tem;
1067 Lisp_Object name;
1068 int minibuffer_only = 0;
1069 long window_prompting = 0;
1070 int width, height;
1071 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1072 Lisp_Object display;
1073 struct ns_display_info *dpyinfo = NULL;
1074 Lisp_Object parent;
1075 struct kboard *kb;
1076 static int desc_ctr = 1;
1077
1078 /* x_get_arg modifies parms. */
1079 parms = Fcopy_alist (parms);
1080
1081 /* Use this general default value to start with
1082 until we know if this frame has a specified name. */
1083 Vx_resource_name = Vinvocation_name;
1084
1085 display = x_get_arg (dpyinfo, parms, Qterminal, 0, 0, RES_TYPE_STRING);
1086 if (EQ (display, Qunbound))
1087 display = Qnil;
1088 dpyinfo = check_ns_display_info (display);
1089 kb = dpyinfo->terminal->kboard;
1090
1091 if (!dpyinfo->terminal->name)
1092 error ("Terminal is not live, can't create new frames on it");
1093
1094 name = x_get_arg (dpyinfo, parms, Qname, 0, 0, RES_TYPE_STRING);
1095 if (!STRINGP (name)
1096 && ! EQ (name, Qunbound)
1097 && ! NILP (name))
1098 error ("Invalid frame name--not a string or nil");
1099
1100 if (STRINGP (name))
1101 Vx_resource_name = name;
1102
1103 parent = x_get_arg (dpyinfo, parms, Qparent_id, 0, 0, RES_TYPE_NUMBER);
1104 if (EQ (parent, Qunbound))
1105 parent = Qnil;
1106 if (! NILP (parent))
1107 CHECK_NUMBER (parent);
1108
1109 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
1110 /* No need to protect DISPLAY because that's not used after passing
1111 it to make_frame_without_minibuffer. */
1112 frame = Qnil;
1113 GCPRO4 (parms, parent, name, frame);
1114 tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer",
1115 RES_TYPE_SYMBOL);
1116 if (EQ (tem, Qnone) || NILP (tem))
1117 f = make_frame_without_minibuffer (Qnil, kb, display);
1118 else if (EQ (tem, Qonly))
1119 {
1120 f = make_minibuffer_frame ();
1121 minibuffer_only = 1;
1122 }
1123 else if (WINDOWP (tem))
1124 f = make_frame_without_minibuffer (tem, kb, display);
1125 else
1126 f = make_frame (1);
1127
1128 XSETFRAME (frame, f);
1129
1130 f->terminal = dpyinfo->terminal;
1131
1132 f->output_method = output_ns;
1133 f->output_data.ns = xzalloc (sizeof *f->output_data.ns);
1134
1135 FRAME_FONTSET (f) = -1;
1136
1137 fset_icon_name (f, x_get_arg (dpyinfo, parms, Qicon_name,
1138 "iconName", "Title",
1139 RES_TYPE_STRING));
1140 if (! STRINGP (f->icon_name))
1141 fset_icon_name (f, Qnil);
1142
1143 FRAME_DISPLAY_INFO (f) = dpyinfo;
1144
1145 dynwind_begin ();
1146
1147 /* With FRAME_DISPLAY_INFO set up, this unwind-protect is safe. */
1148 record_unwind_protect (unwind_create_frame, frame);
1149
1150 f->output_data.ns->window_desc = desc_ctr++;
1151 if (TYPE_RANGED_INTEGERP (Window, parent))
1152 {
1153 f->output_data.ns->parent_desc = XFASTINT (parent);
1154 f->output_data.ns->explicit_parent = 1;
1155 }
1156 else
1157 {
1158 f->output_data.ns->parent_desc = FRAME_DISPLAY_INFO (f)->root_window;
1159 f->output_data.ns->explicit_parent = 0;
1160 }
1161
1162 /* Set the name; the functions to which we pass f expect the name to
1163 be set. */
1164 if (EQ (name, Qunbound) || NILP (name) || ! STRINGP (name))
1165 {
1166 fset_name (f, build_string ([ns_app_name UTF8String]));
1167 f->explicit_name = 0;
1168 }
1169 else
1170 {
1171 fset_name (f, name);
1172 f->explicit_name = 1;
1173 specbind (Qx_resource_name, name);
1174 }
1175
1176 block_input ();
1177
1178 #ifdef NS_IMPL_COCOA
1179 #if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_5
1180 if (CTGetCoreTextVersion != NULL
1181 && CTGetCoreTextVersion () >= kCTVersionNumber10_5)
1182 mac_register_font_driver (f);
1183 #endif
1184 #endif
1185 register_font_driver (&nsfont_driver, f);
1186
1187 x_default_parameter (f, parms, Qfont_backend, Qnil,
1188 "fontBackend", "FontBackend", RES_TYPE_STRING);
1189
1190 {
1191 /* use for default font name */
1192 id font = [NSFont userFixedPitchFontOfSize: -1.0]; /* default */
1193 x_default_parameter (f, parms, Qfontsize,
1194 make_number (0 /*(int)[font pointSize]*/),
1195 "fontSize", "FontSize", RES_TYPE_NUMBER);
1196 // Remove ' Regular', not handled by backends.
1197 char *fontname = xstrdup ([[font displayName] UTF8String]);
1198 int len = strlen (fontname);
1199 if (len > 8 && strcmp (fontname + len - 8, " Regular") == 0)
1200 fontname[len-8] = '\0';
1201 x_default_parameter (f, parms, Qfont,
1202 build_string (fontname),
1203 "font", "Font", RES_TYPE_STRING);
1204 xfree (fontname);
1205 }
1206 unblock_input ();
1207
1208 x_default_parameter (f, parms, Qborder_width, make_number (0),
1209 "borderwidth", "BorderWidth", RES_TYPE_NUMBER);
1210 x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
1211 "internalBorderWidth", "InternalBorderWidth",
1212 RES_TYPE_NUMBER);
1213
1214 /* default scrollbars on right on Mac */
1215 {
1216 Lisp_Object spos
1217 #ifdef NS_IMPL_GNUSTEP
1218 = Qt;
1219 #else
1220 = Qright;
1221 #endif
1222 x_default_parameter (f, parms, Qvertical_scroll_bars, spos,
1223 "verticalScrollBars", "VerticalScrollBars",
1224 RES_TYPE_SYMBOL);
1225 }
1226 x_default_parameter (f, parms, Qforeground_color, build_string ("Black"),
1227 "foreground", "Foreground", RES_TYPE_STRING);
1228 x_default_parameter (f, parms, Qbackground_color, build_string ("White"),
1229 "background", "Background", RES_TYPE_STRING);
1230 /* FIXME: not supported yet in Nextstep */
1231 x_default_parameter (f, parms, Qline_spacing, Qnil,
1232 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
1233 x_default_parameter (f, parms, Qleft_fringe, Qnil,
1234 "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
1235 x_default_parameter (f, parms, Qright_fringe, Qnil,
1236 "rightFringe", "RightFringe", RES_TYPE_NUMBER);
1237
1238 #ifdef GLYPH_DEBUG
1239 image_cache_refcount =
1240 FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
1241 #endif
1242
1243 init_frame_faces (f);
1244
1245 /* Read comment about this code in corresponding place in xfns.c. */
1246 width = FRAME_TEXT_WIDTH (f);
1247 height = FRAME_TEXT_HEIGHT (f);
1248 FRAME_TEXT_HEIGHT (f) = 0;
1249 SET_FRAME_WIDTH (f, 0);
1250 change_frame_size (f, width, height, 1, 0, 0, 1);
1251
1252 /* The resources controlling the menu-bar and tool-bar are
1253 processed specially at startup, and reflected in the mode
1254 variables; ignore them here. */
1255 x_default_parameter (f, parms, Qmenu_bar_lines,
1256 NILP (Vmenu_bar_mode)
1257 ? make_number (0) : make_number (1),
1258 NULL, NULL, RES_TYPE_NUMBER);
1259 x_default_parameter (f, parms, Qtool_bar_lines,
1260 NILP (Vtool_bar_mode)
1261 ? make_number (0) : make_number (1),
1262 NULL, NULL, RES_TYPE_NUMBER);
1263
1264 x_default_parameter (f, parms, Qbuffer_predicate, Qnil, "bufferPredicate",
1265 "BufferPredicate", RES_TYPE_SYMBOL);
1266 x_default_parameter (f, parms, Qtitle, Qnil, "title", "Title",
1267 RES_TYPE_STRING);
1268
1269 parms = get_geometry_from_preferences (dpyinfo, parms);
1270 window_prompting = x_figure_window_size (f, parms, 1);
1271
1272 tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
1273 f->no_split = minibuffer_only || (!EQ (tem, Qunbound) && !EQ (tem, Qnil));
1274
1275 /* NOTE: on other terms, this is done in set_mouse_color, however this
1276 was not getting called under Nextstep */
1277 f->output_data.ns->text_cursor = [NSCursor IBeamCursor];
1278 f->output_data.ns->nontext_cursor = [NSCursor arrowCursor];
1279 f->output_data.ns->modeline_cursor = [NSCursor pointingHandCursor];
1280 f->output_data.ns->hand_cursor = [NSCursor pointingHandCursor];
1281 f->output_data.ns->hourglass_cursor = [NSCursor disappearingItemCursor];
1282 f->output_data.ns->horizontal_drag_cursor = [NSCursor resizeLeftRightCursor];
1283 f->output_data.ns->vertical_drag_cursor = [NSCursor resizeUpDownCursor];
1284 FRAME_DISPLAY_INFO (f)->vertical_scroll_bar_cursor
1285 = [NSCursor arrowCursor];
1286 f->output_data.ns->current_pointer = f->output_data.ns->text_cursor;
1287
1288 [[EmacsView alloc] initFrameFromEmacs: f];
1289
1290 x_icon (f, parms);
1291
1292 /* ns_display_info does not have a reference_count. */
1293 f->terminal->reference_count++;
1294
1295 /* It is now ok to make the frame official even if we get an error below.
1296 The frame needs to be on Vframe_list or making it visible won't work. */
1297 Vframe_list = Fcons (frame, Vframe_list);
1298
1299 x_default_parameter (f, parms, Qicon_type, Qnil,
1300 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
1301
1302 x_default_parameter (f, parms, Qauto_raise, Qnil,
1303 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
1304 x_default_parameter (f, parms, Qauto_lower, Qnil,
1305 "autoLower", "AutoLower", RES_TYPE_BOOLEAN);
1306 x_default_parameter (f, parms, Qcursor_type, Qbox,
1307 "cursorType", "CursorType", RES_TYPE_SYMBOL);
1308 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
1309 "scrollBarWidth", "ScrollBarWidth",
1310 RES_TYPE_NUMBER);
1311 x_default_parameter (f, parms, Qalpha, Qnil,
1312 "alpha", "Alpha", RES_TYPE_NUMBER);
1313 x_default_parameter (f, parms, Qfullscreen, Qnil,
1314 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
1315
1316 width = FRAME_TEXT_WIDTH (f);
1317 height = FRAME_TEXT_HEIGHT (f);
1318 FRAME_TEXT_HEIGHT (f) = 0;
1319 SET_FRAME_WIDTH (f, 0);
1320 change_frame_size (f, width, height, 1, 0, 0, 1);
1321
1322 if (! f->output_data.ns->explicit_parent)
1323 {
1324 Lisp_Object visibility;
1325
1326 visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0,
1327 RES_TYPE_SYMBOL);
1328 if (EQ (visibility, Qunbound))
1329 visibility = Qt;
1330
1331 if (EQ (visibility, Qicon))
1332 x_iconify_frame (f);
1333 else if (! NILP (visibility))
1334 {
1335 x_make_frame_visible (f);
1336 [[FRAME_NS_VIEW (f) window] makeKeyWindow];
1337 }
1338 else
1339 {
1340 /* Must have been Qnil. */
1341 }
1342 }
1343
1344 if (FRAME_HAS_MINIBUF_P (f)
1345 && (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame))
1346 || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame)))))
1347 kset_default_minibuffer_frame (kb, frame);
1348
1349 /* All remaining specified parameters, which have not been "used"
1350 by x_get_arg and friends, now go in the misc. alist of the frame. */
1351 for (tem = parms; CONSP (tem); tem = XCDR (tem))
1352 if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
1353 fset_param_alist (f, Fcons (XCAR (tem), f->param_alist));
1354
1355 UNGCPRO;
1356
1357 if (window_prompting & USPosition)
1358 x_set_offset (f, f->left_pos, f->top_pos, 1);
1359
1360 /* Make sure windows on this frame appear in calls to next-window
1361 and similar functions. */
1362 Vwindow_list = Qnil;
1363
1364 dynwind_end ();
1365 return frame;
1366 }
1367
1368 void
1369 x_focus_frame (struct frame *f)
1370 {
1371 struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
1372
1373 if (dpyinfo->x_focus_frame != f)
1374 {
1375 EmacsView *view = FRAME_NS_VIEW (f);
1376 block_input ();
1377 [NSApp activateIgnoringOtherApps: YES];
1378 [[view window] makeKeyAndOrderFront: view];
1379 unblock_input ();
1380 }
1381 }
1382
1383
1384 DEFUN ("ns-popup-font-panel", Fns_popup_font_panel, Sns_popup_font_panel,
1385 0, 1, "",
1386 doc: /* Pop up the font panel. */)
1387 (Lisp_Object frame)
1388 {
1389 struct frame *f = decode_window_system_frame (frame);
1390 id fm = [NSFontManager sharedFontManager];
1391 struct font *font = f->output_data.ns->font;
1392 NSFont *nsfont;
1393 if (EQ (font->driver->type, Qns))
1394 nsfont = ((struct nsfont_info *)font)->nsfont;
1395 #if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_5
1396 else
1397 nsfont = (NSFont *) macfont_get_nsctfont (font);
1398 #endif
1399 [fm setSelectedFont: nsfont isMultiple: NO];
1400 [fm orderFrontFontPanel: NSApp];
1401 return Qnil;
1402 }
1403
1404
1405 DEFUN ("ns-popup-color-panel", Fns_popup_color_panel, Sns_popup_color_panel,
1406 0, 1, "",
1407 doc: /* Pop up the color panel. */)
1408 (Lisp_Object frame)
1409 {
1410 check_window_system (NULL);
1411 [NSApp orderFrontColorPanel: NSApp];
1412 return Qnil;
1413 }
1414
1415 static struct
1416 {
1417 id panel;
1418 BOOL ret;
1419 #if ! defined (NS_IMPL_COCOA) || \
1420 MAC_OS_X_VERSION_MAX_ALLOWED < MAC_OS_X_VERSION_10_6
1421 NSString *dirS, *initS;
1422 BOOL no_types;
1423 #endif
1424 } ns_fd_data;
1425
1426 void
1427 ns_run_file_dialog (void)
1428 {
1429 if (ns_fd_data.panel == nil) return;
1430 #if defined (NS_IMPL_COCOA) && \
1431 MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
1432 ns_fd_data.ret = [ns_fd_data.panel runModal];
1433 #else
1434 if (ns_fd_data.no_types)
1435 {
1436 ns_fd_data.ret = [ns_fd_data.panel
1437 runModalForDirectory: ns_fd_data.dirS
1438 file: ns_fd_data.initS];
1439 }
1440 else
1441 {
1442 ns_fd_data.ret = [ns_fd_data.panel
1443 runModalForDirectory: ns_fd_data.dirS
1444 file: ns_fd_data.initS
1445 types: nil];
1446 }
1447 #endif
1448 ns_fd_data.panel = nil;
1449 }
1450
1451 DEFUN ("ns-read-file-name", Fns_read_file_name, Sns_read_file_name, 1, 5, 0,
1452 doc: /* Use a graphical panel to read a file name, using prompt PROMPT.
1453 Optional arg DIR, if non-nil, supplies a default directory.
1454 Optional arg MUSTMATCH, if non-nil, means the returned file or
1455 directory must exist.
1456 Optional arg INIT, if non-nil, provides a default file name to use.
1457 Optional arg DIR_ONLY_P, if non-nil, means choose only directories. */)
1458 (Lisp_Object prompt, Lisp_Object dir, Lisp_Object mustmatch,
1459 Lisp_Object init, Lisp_Object dir_only_p)
1460 {
1461 static id fileDelegate = nil;
1462 BOOL ret;
1463 BOOL isSave = NILP (mustmatch) && NILP (dir_only_p);
1464 id panel;
1465 Lisp_Object fname;
1466
1467 NSString *promptS = NILP (prompt) || !STRINGP (prompt) ? nil :
1468 [NSString stringWithUTF8String: SSDATA (prompt)];
1469 NSString *dirS = NILP (dir) || !STRINGP (dir) ?
1470 [NSString stringWithUTF8String: SSDATA (BVAR (current_buffer, directory))] :
1471 [NSString stringWithUTF8String: SSDATA (dir)];
1472 NSString *initS = NILP (init) || !STRINGP (init) ? nil :
1473 [NSString stringWithUTF8String: SSDATA (init)];
1474 NSEvent *nxev;
1475
1476 check_window_system (NULL);
1477
1478 if (fileDelegate == nil)
1479 fileDelegate = [EmacsFileDelegate new];
1480
1481 [NSCursor setHiddenUntilMouseMoves: NO];
1482
1483 if ([dirS characterAtIndex: 0] == '~')
1484 dirS = [dirS stringByExpandingTildeInPath];
1485
1486 panel = isSave ?
1487 (id)[EmacsSavePanel savePanel] : (id)[EmacsOpenPanel openPanel];
1488
1489 [panel setTitle: promptS];
1490
1491 [panel setAllowsOtherFileTypes: YES];
1492 [panel setTreatsFilePackagesAsDirectories: YES];
1493 [panel setDelegate: fileDelegate];
1494
1495 if (! NILP (dir_only_p))
1496 {
1497 [panel setCanChooseDirectories: YES];
1498 [panel setCanChooseFiles: NO];
1499 }
1500 else if (! isSave)
1501 {
1502 /* This is not quite what the documentation says, but it is compatible
1503 with the Gtk+ code. Also, the menu entry says "Open File...". */
1504 [panel setCanChooseDirectories: NO];
1505 [panel setCanChooseFiles: YES];
1506 }
1507
1508 block_input ();
1509 ns_fd_data.panel = panel;
1510 ns_fd_data.ret = NO;
1511 #if defined (NS_IMPL_COCOA) && \
1512 MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
1513 if (! NILP (mustmatch) || ! NILP (dir_only_p))
1514 [panel setAllowedFileTypes: nil];
1515 if (dirS) [panel setDirectoryURL: [NSURL fileURLWithPath: dirS]];
1516 if (initS && NILP (Ffile_directory_p (init)))
1517 [panel setNameFieldStringValue: [initS lastPathComponent]];
1518 else
1519 [panel setNameFieldStringValue: @""];
1520
1521 #else
1522 ns_fd_data.no_types = NILP (mustmatch) && NILP (dir_only_p);
1523 ns_fd_data.dirS = dirS;
1524 ns_fd_data.initS = initS;
1525 #endif
1526
1527 /* runModalForDirectory/runModal restarts the main event loop when done,
1528 so we must start an event loop and then pop up the file dialog.
1529 The file dialog may pop up a confirm dialog after Ok has been pressed,
1530 so we can not simply pop down on the Ok/Cancel press.
1531 */
1532 nxev = [NSEvent otherEventWithType: NSApplicationDefined
1533 location: NSMakePoint (0, 0)
1534 modifierFlags: 0
1535 timestamp: 0
1536 windowNumber: [[NSApp mainWindow] windowNumber]
1537 context: [NSApp context]
1538 subtype: 0
1539 data1: 0
1540 data2: NSAPP_DATA2_RUNFILEDIALOG];
1541
1542 [NSApp postEvent: nxev atStart: NO];
1543 while (ns_fd_data.panel != nil)
1544 [NSApp run];
1545
1546 ret = (ns_fd_data.ret == NSOKButton);
1547
1548 if (ret)
1549 {
1550 NSString *str = ns_filename_from_panel (panel);
1551 if (! str) str = ns_directory_from_panel (panel);
1552 if (! str) ret = NO;
1553 else fname = build_string ([str UTF8String]);
1554 }
1555
1556 [[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow];
1557 unblock_input ();
1558
1559 return ret ? fname : Qnil;
1560 }
1561
1562 const char *
1563 ns_get_defaults_value (const char *key)
1564 {
1565 NSObject *obj = [[NSUserDefaults standardUserDefaults]
1566 objectForKey: [NSString stringWithUTF8String: key]];
1567
1568 if (!obj) return NULL;
1569
1570 return [[NSString stringWithFormat: @"%@", obj] UTF8String];
1571 }
1572
1573
1574 DEFUN ("ns-get-resource", Fns_get_resource, Sns_get_resource, 2, 2, 0,
1575 doc: /* Return the value of the property NAME of OWNER from the defaults database.
1576 If OWNER is nil, Emacs is assumed. */)
1577 (Lisp_Object owner, Lisp_Object name)
1578 {
1579 const char *value;
1580
1581 check_window_system (NULL);
1582 if (NILP (owner))
1583 owner = build_string([ns_app_name UTF8String]);
1584 CHECK_STRING (name);
1585
1586 value = ns_get_defaults_value (SSDATA (name));
1587
1588 if (value)
1589 return build_string (value);
1590 return Qnil;
1591 }
1592
1593
1594 DEFUN ("ns-set-resource", Fns_set_resource, Sns_set_resource, 3, 3, 0,
1595 doc: /* Set property NAME of OWNER to VALUE, from the defaults database.
1596 If OWNER is nil, Emacs is assumed.
1597 If VALUE is nil, the default is removed. */)
1598 (Lisp_Object owner, Lisp_Object name, Lisp_Object value)
1599 {
1600 check_window_system (NULL);
1601 if (NILP (owner))
1602 owner = build_string ([ns_app_name UTF8String]);
1603 CHECK_STRING (name);
1604 if (NILP (value))
1605 {
1606 [[NSUserDefaults standardUserDefaults] removeObjectForKey:
1607 [NSString stringWithUTF8String: SSDATA (name)]];
1608 }
1609 else
1610 {
1611 CHECK_STRING (value);
1612 [[NSUserDefaults standardUserDefaults] setObject:
1613 [NSString stringWithUTF8String: SSDATA (value)]
1614 forKey: [NSString stringWithUTF8String:
1615 SSDATA (name)]];
1616 }
1617
1618 return Qnil;
1619 }
1620
1621
1622 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
1623 Sx_server_max_request_size,
1624 0, 1, 0,
1625 doc: /* This function is a no-op. It is only present for completeness. */)
1626 (Lisp_Object terminal)
1627 {
1628 check_ns_display_info (terminal);
1629 /* This function has no real equivalent under NeXTstep. Return nil to
1630 indicate this. */
1631 return Qnil;
1632 }
1633
1634
1635 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
1636 doc: /* Return the "vendor ID" string of Nextstep display server TERMINAL.
1637 \(Labeling every distributor as a "vendor" embodies the false assumption
1638 that operating systems cannot be developed and distributed noncommercially.)
1639 The optional argument TERMINAL specifies which display to ask about.
1640 TERMINAL should be a terminal object, a frame or a display name (a string).
1641 If omitted or nil, that stands for the selected frame's display. */)
1642 (Lisp_Object terminal)
1643 {
1644 check_ns_display_info (terminal);
1645 #ifdef NS_IMPL_GNUSTEP
1646 return build_string ("GNU");
1647 #else
1648 return build_string ("Apple");
1649 #endif
1650 }
1651
1652
1653 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
1654 doc: /* Return the version numbers of the server of display TERMINAL.
1655 The value is a list of three integers: the major and minor
1656 version numbers of the X Protocol in use, and the distributor-specific release
1657 number. See also the function `x-server-vendor'.
1658
1659 The optional argument TERMINAL specifies which display to ask about.
1660 TERMINAL should be a terminal object, a frame or a display name (a string).
1661 If omitted or nil, that stands for the selected frame's display. */)
1662 (Lisp_Object terminal)
1663 {
1664 check_ns_display_info (terminal);
1665 /*NOTE: it is unclear what would best correspond with "protocol";
1666 we return 10.3, meaning Panther, since this is roughly the
1667 level that GNUstep's APIs correspond to.
1668 The last number is where we distinguish between the Apple
1669 and GNUstep implementations ("distributor-specific release
1670 number") and give int'ized versions of major.minor. */
1671 return list3i (10, 3, ns_appkit_version_int ());
1672 }
1673
1674
1675 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
1676 doc: /* Return the number of screens on Nextstep display server TERMINAL.
1677 The optional argument TERMINAL specifies which display to ask about.
1678 TERMINAL should be a terminal object, a frame or a display name (a string).
1679 If omitted or nil, that stands for the selected frame's display.
1680
1681 Note: "screen" here is not in Nextstep terminology but in X11's. For
1682 the number of physical monitors, use `(length
1683 (display-monitor-attributes-list TERMINAL))' instead. */)
1684 (Lisp_Object terminal)
1685 {
1686 check_ns_display_info (terminal);
1687 return make_number (1);
1688 }
1689
1690
1691 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
1692 doc: /* Return the height in millimeters of the Nextstep display TERMINAL.
1693 The optional argument TERMINAL specifies which display to ask about.
1694 TERMINAL should be a terminal object, a frame or a display name (a string).
1695 If omitted or nil, that stands for the selected frame's display.
1696
1697 On \"multi-monitor\" setups this refers to the height in millimeters for
1698 all physical monitors associated with TERMINAL. To get information
1699 for each physical monitor, use `display-monitor-attributes-list'. */)
1700 (Lisp_Object terminal)
1701 {
1702 struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
1703
1704 return make_number (x_display_pixel_height (dpyinfo) / (92.0/25.4));
1705 }
1706
1707
1708 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
1709 doc: /* Return the width in millimeters of the Nextstep display TERMINAL.
1710 The optional argument TERMINAL specifies which display to ask about.
1711 TERMINAL should be a terminal object, a frame or a display name (a string).
1712 If omitted or nil, that stands for the selected frame's display.
1713
1714 On \"multi-monitor\" setups this refers to the width in millimeters for
1715 all physical monitors associated with TERMINAL. To get information
1716 for each physical monitor, use `display-monitor-attributes-list'. */)
1717 (Lisp_Object terminal)
1718 {
1719 struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
1720
1721 return make_number (x_display_pixel_width (dpyinfo) / (92.0/25.4));
1722 }
1723
1724
1725 DEFUN ("x-display-backing-store", Fx_display_backing_store,
1726 Sx_display_backing_store, 0, 1, 0,
1727 doc: /* Return an indication of whether the Nextstep display TERMINAL does backing store.
1728 The value may be `buffered', `retained', or `non-retained'.
1729 The optional argument TERMINAL specifies which display to ask about.
1730 TERMINAL should be a terminal object, a frame or a display name (a string).
1731 If omitted or nil, that stands for the selected frame's display. */)
1732 (Lisp_Object terminal)
1733 {
1734 check_ns_display_info (terminal);
1735 switch ([ns_get_window (terminal) backingType])
1736 {
1737 case NSBackingStoreBuffered:
1738 return intern ("buffered");
1739 case NSBackingStoreRetained:
1740 return intern ("retained");
1741 case NSBackingStoreNonretained:
1742 return intern ("non-retained");
1743 default:
1744 error ("Strange value for backingType parameter of frame");
1745 }
1746 return Qnil; /* not reached, shut compiler up */
1747 }
1748
1749
1750 DEFUN ("x-display-visual-class", Fx_display_visual_class,
1751 Sx_display_visual_class, 0, 1, 0,
1752 doc: /* Return the visual class of the Nextstep display TERMINAL.
1753 The value is one of the symbols `static-gray', `gray-scale',
1754 `static-color', `pseudo-color', `true-color', or `direct-color'.
1755
1756 The optional argument TERMINAL specifies which display to ask about.
1757 TERMINAL should a terminal object, a frame or a display name (a string).
1758 If omitted or nil, that stands for the selected frame's display. */)
1759 (Lisp_Object terminal)
1760 {
1761 NSWindowDepth depth;
1762
1763 check_ns_display_info (terminal);
1764 depth = [[[NSScreen screens] objectAtIndex:0] depth];
1765
1766 if ( depth == NSBestDepth (NSCalibratedWhiteColorSpace, 2, 2, YES, NULL))
1767 return intern ("static-gray");
1768 else if (depth == NSBestDepth (NSCalibratedWhiteColorSpace, 8, 8, YES, NULL))
1769 return intern ("gray-scale");
1770 else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 8, YES, NULL))
1771 return intern ("pseudo-color");
1772 else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 4, 12, NO, NULL))
1773 return intern ("true-color");
1774 else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 24, NO, NULL))
1775 return intern ("direct-color");
1776 else
1777 /* color mgmt as far as we do it is really handled by Nextstep itself anyway */
1778 return intern ("direct-color");
1779 }
1780
1781
1782 DEFUN ("x-display-save-under", Fx_display_save_under,
1783 Sx_display_save_under, 0, 1, 0,
1784 doc: /* Return t if TERMINAL supports the save-under feature.
1785 The optional argument TERMINAL specifies which display to ask about.
1786 TERMINAL should be a terminal object, a frame or a display name (a string).
1787 If omitted or nil, that stands for the selected frame's display. */)
1788 (Lisp_Object terminal)
1789 {
1790 check_ns_display_info (terminal);
1791 switch ([ns_get_window (terminal) backingType])
1792 {
1793 case NSBackingStoreBuffered:
1794 return Qt;
1795
1796 case NSBackingStoreRetained:
1797 case NSBackingStoreNonretained:
1798 return Qnil;
1799
1800 default:
1801 error ("Strange value for backingType parameter of frame");
1802 }
1803 return Qnil; /* not reached, shut compiler up */
1804 }
1805
1806
1807 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
1808 1, 3, 0,
1809 doc: /* Open a connection to a display server.
1810 DISPLAY is the name of the display to connect to.
1811 Optional second arg XRM-STRING is a string of resources in xrdb format.
1812 If the optional third arg MUST-SUCCEED is non-nil,
1813 terminate Emacs if we can't open the connection.
1814 \(In the Nextstep version, the last two arguments are currently ignored.) */)
1815 (Lisp_Object display, Lisp_Object resource_string, Lisp_Object must_succeed)
1816 {
1817 struct ns_display_info *dpyinfo;
1818
1819 CHECK_STRING (display);
1820
1821 nxatoms_of_nsselect ();
1822 dpyinfo = ns_term_init (display);
1823 if (dpyinfo == 0)
1824 {
1825 if (!NILP (must_succeed))
1826 fatal ("Display on %s not responding.\n",
1827 SSDATA (display));
1828 else
1829 error ("Display on %s not responding.\n",
1830 SSDATA (display));
1831 }
1832
1833 return Qnil;
1834 }
1835
1836
1837 DEFUN ("x-close-connection", Fx_close_connection, Sx_close_connection,
1838 1, 1, 0,
1839 doc: /* Close the connection to TERMINAL's Nextstep display server.
1840 For TERMINAL, specify a terminal object, a frame or a display name (a
1841 string). If TERMINAL is nil, that stands for the selected frame's
1842 terminal. */)
1843 (Lisp_Object terminal)
1844 {
1845 check_ns_display_info (terminal);
1846 [NSApp terminate: NSApp];
1847 return Qnil;
1848 }
1849
1850
1851 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
1852 doc: /* Return the list of display names that Emacs has connections to. */)
1853 (void)
1854 {
1855 Lisp_Object result = Qnil;
1856 struct ns_display_info *ndi;
1857
1858 for (ndi = x_display_list; ndi; ndi = ndi->next)
1859 result = Fcons (XCAR (ndi->name_list_element), result);
1860
1861 return result;
1862 }
1863
1864
1865 DEFUN ("ns-hide-others", Fns_hide_others, Sns_hide_others,
1866 0, 0, 0,
1867 doc: /* Hides all applications other than Emacs. */)
1868 (void)
1869 {
1870 check_window_system (NULL);
1871 [NSApp hideOtherApplications: NSApp];
1872 return Qnil;
1873 }
1874
1875 DEFUN ("ns-hide-emacs", Fns_hide_emacs, Sns_hide_emacs,
1876 1, 1, 0,
1877 doc: /* If ON is non-nil, the entire Emacs application is hidden.
1878 Otherwise if Emacs is hidden, it is unhidden.
1879 If ON is equal to `activate', Emacs is unhidden and becomes
1880 the active application. */)
1881 (Lisp_Object on)
1882 {
1883 check_window_system (NULL);
1884 if (EQ (on, intern ("activate")))
1885 {
1886 [NSApp unhide: NSApp];
1887 [NSApp activateIgnoringOtherApps: YES];
1888 }
1889 else if (NILP (on))
1890 [NSApp unhide: NSApp];
1891 else
1892 [NSApp hide: NSApp];
1893 return Qnil;
1894 }
1895
1896
1897 DEFUN ("ns-emacs-info-panel", Fns_emacs_info_panel, Sns_emacs_info_panel,
1898 0, 0, 0,
1899 doc: /* Shows the 'Info' or 'About' panel for Emacs. */)
1900 (void)
1901 {
1902 check_window_system (NULL);
1903 [NSApp orderFrontStandardAboutPanel: nil];
1904 return Qnil;
1905 }
1906
1907
1908 DEFUN ("ns-font-name", Fns_font_name, Sns_font_name, 1, 1, 0,
1909 doc: /* Determine font PostScript or family name for font NAME.
1910 NAME should be a string containing either the font name or an XLFD
1911 font descriptor. If string contains `fontset' and not
1912 `fontset-startup', it is left alone. */)
1913 (Lisp_Object name)
1914 {
1915 char *nm;
1916 CHECK_STRING (name);
1917 nm = SSDATA (name);
1918
1919 if (nm[0] != '-')
1920 return name;
1921 if (strstr (nm, "fontset") && !strstr (nm, "fontset-startup"))
1922 return name;
1923
1924 return build_string (ns_xlfd_to_fontname (SSDATA (name)));
1925 }
1926
1927
1928 DEFUN ("ns-list-colors", Fns_list_colors, Sns_list_colors, 0, 1, 0,
1929 doc: /* Return a list of all available colors.
1930 The optional argument FRAME is currently ignored. */)
1931 (Lisp_Object frame)
1932 {
1933 Lisp_Object list = Qnil;
1934 NSEnumerator *colorlists;
1935 NSColorList *clist;
1936
1937 if (!NILP (frame))
1938 {
1939 CHECK_FRAME (frame);
1940 if (! FRAME_NS_P (XFRAME (frame)))
1941 error ("non-Nextstep frame used in `ns-list-colors'");
1942 }
1943
1944 block_input ();
1945
1946 colorlists = [[NSColorList availableColorLists] objectEnumerator];
1947 while ((clist = [colorlists nextObject]))
1948 {
1949 if ([[clist name] length] < 7 ||
1950 [[clist name] rangeOfString: @"PANTONE"].location == 0)
1951 {
1952 NSEnumerator *cnames = [[clist allKeys] reverseObjectEnumerator];
1953 NSString *cname;
1954 while ((cname = [cnames nextObject]))
1955 list = Fcons (build_string ([cname UTF8String]), list);
1956 /* for (i = [[clist allKeys] count] - 1; i >= 0; i--)
1957 list = Fcons (build_string ([[[clist allKeys] objectAtIndex: i]
1958 UTF8String]), list); */
1959 }
1960 }
1961
1962 unblock_input ();
1963
1964 return list;
1965 }
1966
1967
1968 DEFUN ("ns-list-services", Fns_list_services, Sns_list_services, 0, 0, 0,
1969 doc: /* List available Nextstep services by querying NSApp. */)
1970 (void)
1971 {
1972 #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
1973 /* You can't get services like this in 10.6+. */
1974 return Qnil;
1975 #else
1976 Lisp_Object ret = Qnil;
1977 NSMenu *svcs;
1978 #ifdef NS_IMPL_COCOA
1979 id delegate;
1980 #endif
1981
1982 check_window_system (NULL);
1983 svcs = [[NSMenu alloc] initWithTitle: @"Services"];
1984 [NSApp setServicesMenu: svcs];
1985 [NSApp registerServicesMenuSendTypes: ns_send_types
1986 returnTypes: ns_return_types];
1987
1988 /* On Tiger, services menu updating was made lazier (waits for user to
1989 actually click on the menu), so we have to force things along: */
1990 #ifdef NS_IMPL_COCOA
1991 delegate = [svcs delegate];
1992 if (delegate != nil)
1993 {
1994 if ([delegate respondsToSelector: @selector (menuNeedsUpdate:)])
1995 [delegate menuNeedsUpdate: svcs];
1996 if ([delegate respondsToSelector:
1997 @selector (menu:updateItem:atIndex:shouldCancel:)])
1998 {
1999 int i, len = [delegate numberOfItemsInMenu: svcs];
2000 for (i =0; i<len; i++)
2001 [svcs addItemWithTitle: @"" action: NULL keyEquivalent: @""];
2002 for (i =0; i<len; i++)
2003 if (![delegate menu: svcs
2004 updateItem: (NSMenuItem *)[svcs itemAtIndex: i]
2005 atIndex: i shouldCancel: NO])
2006 break;
2007 }
2008 }
2009 #endif
2010
2011 [svcs setAutoenablesItems: NO];
2012 #ifdef NS_IMPL_COCOA
2013 [svcs update]; /* on OS X, converts from '/' structure */
2014 #endif
2015
2016 ret = interpret_services_menu (svcs, Qnil, ret);
2017 return ret;
2018 #endif
2019 }
2020
2021
2022 DEFUN ("ns-perform-service", Fns_perform_service, Sns_perform_service,
2023 2, 2, 0,
2024 doc: /* Perform Nextstep SERVICE on SEND.
2025 SEND should be either a string or nil.
2026 The return value is the result of the service, as string, or nil if
2027 there was no result. */)
2028 (Lisp_Object service, Lisp_Object send)
2029 {
2030 id pb;
2031 NSString *svcName;
2032 char *utfStr;
2033
2034 CHECK_STRING (service);
2035 check_window_system (NULL);
2036
2037 utfStr = SSDATA (service);
2038 svcName = [NSString stringWithUTF8String: utfStr];
2039
2040 pb =[NSPasteboard pasteboardWithUniqueName];
2041 ns_string_to_pasteboard (pb, send);
2042
2043 if (NSPerformService (svcName, pb) == NO)
2044 Fsignal (Qquit, list1 (build_string ("service not available")));
2045
2046 if ([[pb types] count] == 0)
2047 return build_string ("");
2048 return ns_string_from_pasteboard (pb);
2049 }
2050
2051
2052 DEFUN ("ns-convert-utf8-nfd-to-nfc", Fns_convert_utf8_nfd_to_nfc,
2053 Sns_convert_utf8_nfd_to_nfc, 1, 1, 0,
2054 doc: /* Return an NFC string that matches the UTF-8 NFD string STR. */)
2055 (Lisp_Object str)
2056 {
2057 /* TODO: If GNUstep ever implements precomposedStringWithCanonicalMapping,
2058 remove this. */
2059 NSString *utfStr;
2060 Lisp_Object ret = Qnil;
2061 NSAutoreleasePool *pool;
2062
2063 CHECK_STRING (str);
2064 pool = [[NSAutoreleasePool alloc] init];
2065 utfStr = [NSString stringWithUTF8String: SSDATA (str)];
2066 #ifdef NS_IMPL_COCOA
2067 if (utfStr)
2068 utfStr = [utfStr precomposedStringWithCanonicalMapping];
2069 #endif
2070 if (utfStr)
2071 {
2072 const char *cstr = [utfStr UTF8String];
2073 if (cstr)
2074 ret = build_string (cstr);
2075 }
2076
2077 [pool release];
2078 if (NILP (ret))
2079 error ("Invalid UTF-8");
2080
2081 return ret;
2082 }
2083
2084
2085 #ifdef NS_IMPL_COCOA
2086
2087 /* Compile and execute the AppleScript SCRIPT and return the error
2088 status as function value. A zero is returned if compilation and
2089 execution is successful, in which case *RESULT is set to a Lisp
2090 string or a number containing the resulting script value. Otherwise,
2091 1 is returned. */
2092 static int
2093 ns_do_applescript (Lisp_Object script, Lisp_Object *result)
2094 {
2095 NSAppleEventDescriptor *desc;
2096 NSDictionary* errorDict;
2097 NSAppleEventDescriptor* returnDescriptor = NULL;
2098
2099 NSAppleScript* scriptObject =
2100 [[NSAppleScript alloc] initWithSource:
2101 [NSString stringWithUTF8String: SSDATA (script)]];
2102
2103 returnDescriptor = [scriptObject executeAndReturnError: &errorDict];
2104 [scriptObject release];
2105 *result = Qnil;
2106
2107 if (returnDescriptor != NULL)
2108 {
2109 // successful execution
2110 if (kAENullEvent != [returnDescriptor descriptorType])
2111 {
2112 *result = Qt;
2113 // script returned an AppleScript result
2114 if ((typeUnicodeText == [returnDescriptor descriptorType]) ||
2115 #if defined (NS_IMPL_COCOA)
2116 (typeUTF16ExternalRepresentation
2117 == [returnDescriptor descriptorType]) ||
2118 #endif
2119 (typeUTF8Text == [returnDescriptor descriptorType]) ||
2120 (typeCString == [returnDescriptor descriptorType]))
2121 {
2122 desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
2123 if (desc)
2124 *result = build_string([[desc stringValue] UTF8String]);
2125 }
2126 else
2127 {
2128 /* use typeUTF16ExternalRepresentation? */
2129 // coerce the result to the appropriate ObjC type
2130 desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
2131 if (desc)
2132 *result = make_number([desc int32Value]);
2133 }
2134 }
2135 }
2136 else
2137 {
2138 // no script result, return error
2139 return 1;
2140 }
2141 return 0;
2142 }
2143
2144 /* Helper function called from sendEvent to run applescript
2145 from within the main event loop. */
2146
2147 void
2148 ns_run_ascript (void)
2149 {
2150 if (! NILP (as_script))
2151 as_status = ns_do_applescript (as_script, as_result);
2152 as_script = Qnil;
2153 }
2154
2155 DEFUN ("ns-do-applescript", Fns_do_applescript, Sns_do_applescript, 1, 1, 0,
2156 doc: /* Execute AppleScript SCRIPT and return the result.
2157 If compilation and execution are successful, the resulting script value
2158 is returned as a string, a number or, in the case of other constructs, t.
2159 In case the execution fails, an error is signaled. */)
2160 (Lisp_Object script)
2161 {
2162 Lisp_Object result;
2163 int status;
2164 NSEvent *nxev;
2165 struct input_event ev;
2166
2167 CHECK_STRING (script);
2168 check_window_system (NULL);
2169
2170 block_input ();
2171
2172 as_script = script;
2173 as_result = &result;
2174
2175 /* executing apple script requires the event loop to run, otherwise
2176 errors aren't returned and executeAndReturnError hangs forever.
2177 Post an event that runs applescript and then start the event loop.
2178 The event loop is exited when the script is done. */
2179 nxev = [NSEvent otherEventWithType: NSApplicationDefined
2180 location: NSMakePoint (0, 0)
2181 modifierFlags: 0
2182 timestamp: 0
2183 windowNumber: [[NSApp mainWindow] windowNumber]
2184 context: [NSApp context]
2185 subtype: 0
2186 data1: 0
2187 data2: NSAPP_DATA2_RUNASSCRIPT];
2188
2189 [NSApp postEvent: nxev atStart: NO];
2190
2191 // If there are other events, the event loop may exit. Keep running
2192 // until the script has been handled. */
2193 ns_init_events (&ev);
2194 while (! NILP (as_script))
2195 [NSApp run];
2196 ns_finish_events ();
2197
2198 status = as_status;
2199 as_status = 0;
2200 as_result = 0;
2201 unblock_input ();
2202 if (status == 0)
2203 return result;
2204 else if (!STRINGP (result))
2205 error ("AppleScript error %d", status);
2206 else
2207 error ("%s", SSDATA (result));
2208 }
2209 #endif
2210
2211
2212
2213 /* ==========================================================================
2214
2215 Miscellaneous functions not called through hooks
2216
2217 ========================================================================== */
2218
2219 /* called from frame.c */
2220 struct ns_display_info *
2221 check_x_display_info (Lisp_Object frame)
2222 {
2223 return check_ns_display_info (frame);
2224 }
2225
2226
2227 void
2228 x_set_scroll_bar_default_width (struct frame *f)
2229 {
2230 int wid = FRAME_COLUMN_WIDTH (f);
2231 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = NS_SCROLL_BAR_WIDTH_DEFAULT;
2232 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) +
2233 wid - 1) / wid;
2234 }
2235
2236 /* terms impl this instead of x-get-resource directly */
2237 char *
2238 x_get_string_resource (XrmDatabase rdb, const char *name, const char *class)
2239 {
2240 /* remove appname prefix; TODO: allow for !="Emacs" */
2241 const char *res, *toCheck = class + (!strncmp (class, "Emacs.", 6) ? 6 : 0);
2242
2243 check_window_system (NULL);
2244
2245 if (inhibit_x_resources)
2246 /* --quick was passed, so this is a no-op. */
2247 return NULL;
2248
2249 res = ns_get_defaults_value (toCheck);
2250 return (!res ? NULL :
2251 (!c_strncasecmp (res, "YES", 3) ? "true" :
2252 (!c_strncasecmp (res, "NO", 2) ? "false" : (char *) res)));
2253 }
2254
2255
2256 Lisp_Object
2257 x_get_focus_frame (struct frame *frame)
2258 {
2259 struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (frame);
2260 Lisp_Object nsfocus;
2261
2262 if (!dpyinfo->x_focus_frame)
2263 return Qnil;
2264
2265 XSETFRAME (nsfocus, dpyinfo->x_focus_frame);
2266 return nsfocus;
2267 }
2268
2269 /* ==========================================================================
2270
2271 Lisp definitions that, for whatever reason, we can't alias as 'ns-XXX'.
2272
2273 ========================================================================== */
2274
2275
2276 DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
2277 doc: /* Internal function called by `color-defined-p', which see.
2278 \(Note that the Nextstep version of this function ignores FRAME.) */)
2279 (Lisp_Object color, Lisp_Object frame)
2280 {
2281 NSColor * col;
2282 check_window_system (NULL);
2283 return ns_lisp_to_color (color, &col) ? Qnil : Qt;
2284 }
2285
2286
2287 DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
2288 doc: /* Internal function called by `color-values', which see. */)
2289 (Lisp_Object color, Lisp_Object frame)
2290 {
2291 NSColor * col;
2292 EmacsCGFloat red, green, blue, alpha;
2293
2294 check_window_system (NULL);
2295 CHECK_STRING (color);
2296
2297 if (ns_lisp_to_color (color, &col))
2298 return Qnil;
2299
2300 [[col colorUsingDefaultColorSpace]
2301 getRed: &red green: &green blue: &blue alpha: &alpha];
2302 return list3i (lrint (red * 65280), lrint (green * 65280),
2303 lrint (blue * 65280));
2304 }
2305
2306
2307 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
2308 doc: /* Internal function called by `display-color-p', which see. */)
2309 (Lisp_Object terminal)
2310 {
2311 NSWindowDepth depth;
2312 NSString *colorSpace;
2313
2314 check_ns_display_info (terminal);
2315 depth = [[[NSScreen screens] objectAtIndex:0] depth];
2316 colorSpace = NSColorSpaceFromDepth (depth);
2317
2318 return [colorSpace isEqualToString: NSDeviceWhiteColorSpace]
2319 || [colorSpace isEqualToString: NSCalibratedWhiteColorSpace]
2320 ? Qnil : Qt;
2321 }
2322
2323
2324 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
2325 0, 1, 0,
2326 doc: /* Return t if the Nextstep display supports shades of gray.
2327 Note that color displays do support shades of gray.
2328 The optional argument TERMINAL specifies which display to ask about.
2329 TERMINAL should be a terminal object, a frame or a display name (a string).
2330 If omitted or nil, that stands for the selected frame's display. */)
2331 (Lisp_Object terminal)
2332 {
2333 NSWindowDepth depth;
2334
2335 check_ns_display_info (terminal);
2336 depth = [[[NSScreen screens] objectAtIndex:0] depth];
2337
2338 return NSBitsPerPixelFromDepth (depth) > 1 ? Qt : Qnil;
2339 }
2340
2341
2342 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
2343 0, 1, 0,
2344 doc: /* Return the width in pixels of the Nextstep display TERMINAL.
2345 The optional argument TERMINAL specifies which display to ask about.
2346 TERMINAL should be a terminal object, a frame or a display name (a string).
2347 If omitted or nil, that stands for the selected frame's display.
2348
2349 On \"multi-monitor\" setups this refers to the pixel width for all
2350 physical monitors associated with TERMINAL. To get information for
2351 each physical monitor, use `display-monitor-attributes-list'. */)
2352 (Lisp_Object terminal)
2353 {
2354 struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
2355
2356 return make_number (x_display_pixel_width (dpyinfo));
2357 }
2358
2359
2360 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
2361 Sx_display_pixel_height, 0, 1, 0,
2362 doc: /* Return the height in pixels of the Nextstep display TERMINAL.
2363 The optional argument TERMINAL specifies which display to ask about.
2364 TERMINAL should be a terminal object, a frame or a display name (a string).
2365 If omitted or nil, that stands for the selected frame's display.
2366
2367 On \"multi-monitor\" setups this refers to the pixel height for all
2368 physical monitors associated with TERMINAL. To get information for
2369 each physical monitor, use `display-monitor-attributes-list'. */)
2370 (Lisp_Object terminal)
2371 {
2372 struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
2373
2374 return make_number (x_display_pixel_height (dpyinfo));
2375 }
2376
2377 #ifdef NS_IMPL_COCOA
2378
2379 /* Returns the name for the screen that OBJ represents, or NULL.
2380 Caller must free return value.
2381 */
2382
2383 static char *
2384 ns_get_name_from_ioreg (io_object_t obj)
2385 {
2386 char *name = NULL;
2387
2388 NSDictionary *info = (NSDictionary *)
2389 IODisplayCreateInfoDictionary (obj, kIODisplayOnlyPreferredName);
2390 NSDictionary *names = [info objectForKey:
2391 [NSString stringWithUTF8String:
2392 kDisplayProductName]];
2393
2394 if ([names count] > 0)
2395 {
2396 NSString *n = [names objectForKey: [[names allKeys]
2397 objectAtIndex:0]];
2398 if (n != nil) name = xstrdup ([n UTF8String]);
2399 }
2400
2401 [info release];
2402
2403 return name;
2404 }
2405
2406 /* Returns the name for the screen that DID came from, or NULL.
2407 Caller must free return value.
2408 */
2409
2410 static char *
2411 ns_screen_name (CGDirectDisplayID did)
2412 {
2413 char *name = NULL;
2414
2415 #if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_9
2416 mach_port_t masterPort;
2417 io_iterator_t it;
2418 io_object_t obj;
2419
2420 // CGDisplayIOServicePort is deprecated. Do it another (harder) way.
2421
2422 if (IOMasterPort (MACH_PORT_NULL, &masterPort) != kIOReturnSuccess
2423 || IOServiceGetMatchingServices (masterPort,
2424 IOServiceMatching ("IONDRVDevice"),
2425 &it) != kIOReturnSuccess)
2426 return name;
2427
2428 /* Must loop until we find a name. Many devices can have the same unit
2429 number (represents different GPU parts), but only one has a name. */
2430 while (! name && (obj = IOIteratorNext (it)))
2431 {
2432 CFMutableDictionaryRef props;
2433 const void *val;
2434
2435 if (IORegistryEntryCreateCFProperties (obj,
2436 &props,
2437 kCFAllocatorDefault,
2438 kNilOptions) == kIOReturnSuccess
2439 && props != nil
2440 && (val = CFDictionaryGetValue(props, @"IOFBDependentIndex")))
2441 {
2442 unsigned nr = [(NSNumber *)val unsignedIntegerValue];
2443 if (nr == CGDisplayUnitNumber (did))
2444 name = ns_get_name_from_ioreg (obj);
2445 }
2446
2447 CFRelease (props);
2448 IOObjectRelease (obj);
2449 }
2450
2451 IOObjectRelease (it);
2452
2453 #else
2454
2455 name = ns_get_name_from_ioreg (CGDisplayIOServicePort (did));
2456
2457 #endif
2458 return name;
2459 }
2460 #endif
2461
2462 static Lisp_Object
2463 ns_make_monitor_attribute_list (struct MonitorInfo *monitors,
2464 int n_monitors,
2465 int primary_monitor,
2466 const char *source)
2467 {
2468 Lisp_Object monitor_frames = Fmake_vector (make_number (n_monitors), Qnil);
2469 Lisp_Object frame, rest;
2470 NSArray *screens = [NSScreen screens];
2471 int i;
2472
2473 FOR_EACH_FRAME (rest, frame)
2474 {
2475 struct frame *f = XFRAME (frame);
2476
2477 if (FRAME_NS_P (f))
2478 {
2479 NSView *view = FRAME_NS_VIEW (f);
2480 NSScreen *screen = [[view window] screen];
2481 NSUInteger k;
2482
2483 i = -1;
2484 for (k = 0; i == -1 && k < [screens count]; ++k)
2485 {
2486 if ([screens objectAtIndex: k] == screen)
2487 i = (int)k;
2488 }
2489
2490 if (i > -1)
2491 ASET (monitor_frames, i, Fcons (frame, AREF (monitor_frames, i)));
2492 }
2493 }
2494
2495 return make_monitor_attribute_list (monitors, n_monitors, primary_monitor,
2496 monitor_frames, source);
2497 }
2498
2499 DEFUN ("ns-display-monitor-attributes-list",
2500 Fns_display_monitor_attributes_list,
2501 Sns_display_monitor_attributes_list,
2502 0, 1, 0,
2503 doc: /* Return a list of physical monitor attributes on the X display TERMINAL.
2504
2505 The optional argument TERMINAL specifies which display to ask about.
2506 TERMINAL should be a terminal object, a frame or a display name (a string).
2507 If omitted or nil, that stands for the selected frame's display.
2508
2509 In addition to the standard attribute keys listed in
2510 `display-monitor-attributes-list', the following keys are contained in
2511 the attributes:
2512
2513 source -- String describing the source from which multi-monitor
2514 information is obtained, \"NS\" is always the source."
2515
2516 Internal use only, use `display-monitor-attributes-list' instead. */)
2517 (Lisp_Object terminal)
2518 {
2519 struct terminal *term = get_terminal (terminal, 1);
2520 NSArray *screens;
2521 NSUInteger i, n_monitors;
2522 struct MonitorInfo *monitors;
2523 Lisp_Object attributes_list = Qnil;
2524 CGFloat primary_display_height = 0;
2525
2526 if (term->type != output_ns)
2527 return Qnil;
2528
2529 screens = [NSScreen screens];
2530 n_monitors = [screens count];
2531 if (n_monitors == 0)
2532 return Qnil;
2533
2534 monitors = xzalloc (n_monitors * sizeof *monitors);
2535
2536 for (i = 0; i < [screens count]; ++i)
2537 {
2538 NSScreen *s = [screens objectAtIndex:i];
2539 struct MonitorInfo *m = &monitors[i];
2540 NSRect fr = [s frame];
2541 NSRect vfr = [s visibleFrame];
2542 short y, vy;
2543
2544 #ifdef NS_IMPL_COCOA
2545 NSDictionary *dict = [s deviceDescription];
2546 NSNumber *nid = [dict objectForKey:@"NSScreenNumber"];
2547 CGDirectDisplayID did = [nid unsignedIntValue];
2548 #endif
2549 if (i == 0)
2550 {
2551 primary_display_height = fr.size.height;
2552 y = (short) fr.origin.y;
2553 vy = (short) vfr.origin.y;
2554 }
2555 else
2556 {
2557 // Flip y coordinate as NS has y starting from the bottom.
2558 y = (short) (primary_display_height - fr.size.height - fr.origin.y);
2559 vy = (short) (primary_display_height -
2560 vfr.size.height - vfr.origin.y);
2561 }
2562
2563 m->geom.x = (short) fr.origin.x;
2564 m->geom.y = y;
2565 m->geom.width = (unsigned short) fr.size.width;
2566 m->geom.height = (unsigned short) fr.size.height;
2567
2568 m->work.x = (short) vfr.origin.x;
2569 // y is flipped on NS, so vy - y are pixels missing at the bottom,
2570 // and fr.size.height - vfr.size.height are pixels missing in total.
2571 // Pixels missing at top are
2572 // fr.size.height - vfr.size.height - vy + y.
2573 // work.y is then pixels missing at top + y.
2574 m->work.y = (short) (fr.size.height - vfr.size.height) - vy + y + y;
2575 m->work.width = (unsigned short) vfr.size.width;
2576 m->work.height = (unsigned short) vfr.size.height;
2577
2578 #ifdef NS_IMPL_COCOA
2579 m->name = ns_screen_name (did);
2580
2581 {
2582 CGSize mms = CGDisplayScreenSize (did);
2583 m->mm_width = (int) mms.width;
2584 m->mm_height = (int) mms.height;
2585 }
2586
2587 #else
2588 // Assume 92 dpi as x-display-mm-height/x-display-mm-width does.
2589 m->mm_width = (int) (25.4 * fr.size.width / 92.0);
2590 m->mm_height = (int) (25.4 * fr.size.height / 92.0);
2591 #endif
2592 }
2593
2594 // Primary monitor is always first for NS.
2595 attributes_list = ns_make_monitor_attribute_list (monitors, n_monitors,
2596 0, "NS");
2597
2598 free_monitors (monitors, n_monitors);
2599 return attributes_list;
2600 }
2601
2602
2603 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
2604 0, 1, 0,
2605 doc: /* Return the number of bitplanes of the Nextstep display TERMINAL.
2606 The optional argument TERMINAL specifies which display to ask about.
2607 TERMINAL should be a terminal object, a frame or a display name (a string).
2608 If omitted or nil, that stands for the selected frame's display. */)
2609 (Lisp_Object terminal)
2610 {
2611 check_ns_display_info (terminal);
2612 return make_number
2613 (NSBitsPerPixelFromDepth ([[[NSScreen screens] objectAtIndex:0] depth]));
2614 }
2615
2616
2617 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
2618 0, 1, 0,
2619 doc: /* Returns the number of color cells of the Nextstep display TERMINAL.
2620 The optional argument TERMINAL specifies which display to ask about.
2621 TERMINAL should be a terminal object, a frame or a display name (a string).
2622 If omitted or nil, that stands for the selected frame's display. */)
2623 (Lisp_Object terminal)
2624 {
2625 struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
2626 /* We force 24+ bit depths to 24-bit to prevent an overflow. */
2627 return make_number (1 << min (dpyinfo->n_planes, 24));
2628 }
2629
2630
2631 /* Unused dummy def needed for compatibility. */
2632 Lisp_Object tip_frame;
2633
2634 /* TODO: move to xdisp or similar */
2635 static void
2636 compute_tip_xy (struct frame *f,
2637 Lisp_Object parms,
2638 Lisp_Object dx,
2639 Lisp_Object dy,
2640 int width,
2641 int height,
2642 int *root_x,
2643 int *root_y)
2644 {
2645 Lisp_Object left, top;
2646 EmacsView *view = FRAME_NS_VIEW (f);
2647 struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
2648 NSPoint pt;
2649
2650 /* Start with user-specified or mouse position. */
2651 left = Fcdr (Fassq (Qleft, parms));
2652 top = Fcdr (Fassq (Qtop, parms));
2653
2654 if (!INTEGERP (left) || !INTEGERP (top))
2655 {
2656 pt.x = dpyinfo->last_mouse_motion_x;
2657 pt.y = dpyinfo->last_mouse_motion_y;
2658 /* Convert to screen coordinates */
2659 pt = [view convertPoint: pt toView: nil];
2660 pt = [[view window] convertBaseToScreen: pt];
2661 }
2662 else
2663 {
2664 /* Absolute coordinates. */
2665 pt.x = XINT (left);
2666 pt.y = x_display_pixel_height (FRAME_DISPLAY_INFO (f)) - XINT (top)
2667 - height;
2668 }
2669
2670 /* Ensure in bounds. (Note, screen origin = lower left.) */
2671 if (INTEGERP (left))
2672 *root_x = pt.x;
2673 else if (pt.x + XINT (dx) <= 0)
2674 *root_x = 0; /* Can happen for negative dx */
2675 else if (pt.x + XINT (dx) + width
2676 <= x_display_pixel_width (FRAME_DISPLAY_INFO (f)))
2677 /* It fits to the right of the pointer. */
2678 *root_x = pt.x + XINT (dx);
2679 else if (width + XINT (dx) <= pt.x)
2680 /* It fits to the left of the pointer. */
2681 *root_x = pt.x - width - XINT (dx);
2682 else
2683 /* Put it left justified on the screen -- it ought to fit that way. */
2684 *root_x = 0;
2685
2686 if (INTEGERP (top))
2687 *root_y = pt.y;
2688 else if (pt.y - XINT (dy) - height >= 0)
2689 /* It fits below the pointer. */
2690 *root_y = pt.y - height - XINT (dy);
2691 else if (pt.y + XINT (dy) + height
2692 <= x_display_pixel_height (FRAME_DISPLAY_INFO (f)))
2693 /* It fits above the pointer */
2694 *root_y = pt.y + XINT (dy);
2695 else
2696 /* Put it on the top. */
2697 *root_y = x_display_pixel_height (FRAME_DISPLAY_INFO (f)) - height;
2698 }
2699
2700
2701 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
2702 doc: /* Show STRING in a \"tooltip\" window on frame FRAME.
2703 A tooltip window is a small window displaying a string.
2704
2705 This is an internal function; Lisp code should call `tooltip-show'.
2706
2707 FRAME nil or omitted means use the selected frame.
2708
2709 PARMS is an optional list of frame parameters which can be used to
2710 change the tooltip's appearance.
2711
2712 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
2713 means use the default timeout of 5 seconds.
2714
2715 If the list of frame parameters PARMS contains a `left' parameter,
2716 the tooltip is displayed at that x-position. Otherwise it is
2717 displayed at the mouse position, with offset DX added (default is 5 if
2718 DX isn't specified). Likewise for the y-position; if a `top' frame
2719 parameter is specified, it determines the y-position of the tooltip
2720 window, otherwise it is displayed at the mouse position, with offset
2721 DY added (default is -10).
2722
2723 A tooltip's maximum size is specified by `x-max-tooltip-size'.
2724 Text larger than the specified size is clipped. */)
2725 (Lisp_Object string, Lisp_Object frame, Lisp_Object parms, Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy)
2726 {
2727 int root_x, root_y;
2728 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2729 struct frame *f;
2730 char *str;
2731 NSSize size;
2732
2733 dynwind_begin ();
2734 specbind (Qinhibit_redisplay, Qt);
2735
2736 GCPRO4 (string, parms, frame, timeout);
2737
2738 CHECK_STRING (string);
2739 str = SSDATA (string);
2740 f = decode_window_system_frame (frame);
2741 if (NILP (timeout))
2742 timeout = make_number (5);
2743 else
2744 CHECK_NATNUM (timeout);
2745
2746 if (NILP (dx))
2747 dx = make_number (5);
2748 else
2749 CHECK_NUMBER (dx);
2750
2751 if (NILP (dy))
2752 dy = make_number (-10);
2753 else
2754 CHECK_NUMBER (dy);
2755
2756 block_input ();
2757 if (ns_tooltip == nil)
2758 ns_tooltip = [[EmacsTooltip alloc] init];
2759 else
2760 Fx_hide_tip ();
2761
2762 [ns_tooltip setText: str];
2763 size = [ns_tooltip frame].size;
2764
2765 /* Move the tooltip window where the mouse pointer is. Resize and
2766 show it. */
2767 compute_tip_xy (f, parms, dx, dy, (int)size.width, (int)size.height,
2768 &root_x, &root_y);
2769
2770 [ns_tooltip showAtX: root_x Y: root_y for: XINT (timeout)];
2771 unblock_input ();
2772
2773 UNGCPRO;
2774 dynwind_end ();
2775 return Qnil;
2776 }
2777
2778
2779 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
2780 doc: /* Hide the current tooltip window, if there is any.
2781 Value is t if tooltip was open, nil otherwise. */)
2782 (void)
2783 {
2784 if (ns_tooltip == nil || ![ns_tooltip isActive])
2785 return Qnil;
2786 [ns_tooltip hide];
2787 return Qt;
2788 }
2789
2790
2791 /* ==========================================================================
2792
2793 Class implementations
2794
2795 ========================================================================== */
2796
2797 /*
2798 Handle arrow/function/control keys and copy/paste/cut in file dialogs.
2799 Return YES if handled, NO if not.
2800 */
2801 static BOOL
2802 handlePanelKeys (NSSavePanel *panel, NSEvent *theEvent)
2803 {
2804 NSString *s;
2805 int i;
2806 BOOL ret = NO;
2807
2808 if ([theEvent type] != NSKeyDown) return NO;
2809 s = [theEvent characters];
2810
2811 for (i = 0; i < [s length]; ++i)
2812 {
2813 int ch = (int) [s characterAtIndex: i];
2814 switch (ch)
2815 {
2816 case NSHomeFunctionKey:
2817 case NSDownArrowFunctionKey:
2818 case NSUpArrowFunctionKey:
2819 case NSLeftArrowFunctionKey:
2820 case NSRightArrowFunctionKey:
2821 case NSPageUpFunctionKey:
2822 case NSPageDownFunctionKey:
2823 case NSEndFunctionKey:
2824 /* Don't send command modified keys, as those are handled in the
2825 performKeyEquivalent method of the super class.
2826 */
2827 if (! ([theEvent modifierFlags] & NSCommandKeyMask))
2828 {
2829 [panel sendEvent: theEvent];
2830 ret = YES;
2831 }
2832 break;
2833 /* As we don't have the standard key commands for
2834 copy/paste/cut/select-all in our edit menu, we must handle
2835 them here. TODO: handle Emacs key bindings for copy/cut/select-all
2836 here, paste works, because we have that in our Edit menu.
2837 I.e. refactor out code in nsterm.m, keyDown: to figure out the
2838 correct modifier.
2839 */
2840 case 'x': // Cut
2841 case 'c': // Copy
2842 case 'v': // Paste
2843 case 'a': // Select all
2844 if ([theEvent modifierFlags] & NSCommandKeyMask)
2845 {
2846 [NSApp sendAction:
2847 (ch == 'x'
2848 ? @selector(cut:)
2849 : (ch == 'c'
2850 ? @selector(copy:)
2851 : (ch == 'v'
2852 ? @selector(paste:)
2853 : @selector(selectAll:))))
2854 to:nil from:panel];
2855 ret = YES;
2856 }
2857 default:
2858 // Send all control keys, as the text field supports C-a, C-f, C-e
2859 // C-b and more.
2860 if ([theEvent modifierFlags] & NSControlKeyMask)
2861 {
2862 [panel sendEvent: theEvent];
2863 ret = YES;
2864 }
2865 break;
2866 }
2867 }
2868
2869
2870 return ret;
2871 }
2872
2873 @implementation EmacsSavePanel
2874 - (BOOL)performKeyEquivalent:(NSEvent *)theEvent
2875 {
2876 BOOL ret = handlePanelKeys (self, theEvent);
2877 if (! ret)
2878 ret = [super performKeyEquivalent:theEvent];
2879 return ret;
2880 }
2881 @end
2882
2883
2884 @implementation EmacsOpenPanel
2885 - (BOOL)performKeyEquivalent:(NSEvent *)theEvent
2886 {
2887 // NSOpenPanel inherits NSSavePanel, so passing self is OK.
2888 BOOL ret = handlePanelKeys (self, theEvent);
2889 if (! ret)
2890 ret = [super performKeyEquivalent:theEvent];
2891 return ret;
2892 }
2893 @end
2894
2895
2896 @implementation EmacsFileDelegate
2897 /* --------------------------------------------------------------------------
2898 Delegate methods for Open/Save panels
2899 -------------------------------------------------------------------------- */
2900 - (BOOL)panel: (id)sender isValidFilename: (NSString *)filename
2901 {
2902 return YES;
2903 }
2904 - (BOOL)panel: (id)sender shouldShowFilename: (NSString *)filename
2905 {
2906 return YES;
2907 }
2908 - (NSString *)panel: (id)sender userEnteredFilename: (NSString *)filename
2909 confirmed: (BOOL)okFlag
2910 {
2911 return filename;
2912 }
2913 @end
2914
2915 #endif
2916
2917
2918 /* ==========================================================================
2919
2920 Lisp interface declaration
2921
2922 ========================================================================== */
2923
2924
2925 void
2926 syms_of_nsfns (void)
2927 {
2928 #include "nsfns.x"
2929
2930 Qfontsize = intern_c_string ("fontsize");
2931 staticpro (&Qfontsize);
2932
2933 DEFVAR_LISP ("ns-icon-type-alist", Vns_icon_type_alist,
2934 doc: /* Alist of elements (REGEXP . IMAGE) for images of icons associated to frames.
2935 If the title of a frame matches REGEXP, then IMAGE.tiff is
2936 selected as the image of the icon representing the frame when it's
2937 miniaturized. If an element is t, then Emacs tries to select an icon
2938 based on the filetype of the visited file.
2939
2940 The images have to be installed in a folder called English.lproj in the
2941 Emacs folder. You have to restart Emacs after installing new icons.
2942
2943 Example: Install an icon Gnus.tiff and execute the following code
2944
2945 (setq ns-icon-type-alist
2946 (append ns-icon-type-alist
2947 '((\"^\\\\*\\\\(Group\\\\*$\\\\|Summary \\\\|Article\\\\*$\\\\)\"
2948 . \"Gnus\"))))
2949
2950 When you miniaturize a Group, Summary or Article frame, Gnus.tiff will
2951 be used as the image of the icon representing the frame. */);
2952 Vns_icon_type_alist = list1 (Qt);
2953
2954 DEFVAR_LISP ("ns-version-string", Vns_version_string,
2955 doc: /* Toolkit version for NS Windowing. */);
2956 Vns_version_string = ns_appkit_version_str ();
2957
2958 as_status = 0;
2959 as_script = Qnil;
2960 as_result = 0;
2961 }