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