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