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