aboutsummaryrefslogtreecommitdiffstats
path: root/src/nsfns.m
diff options
context:
space:
mode:
Diffstat (limited to 'src/nsfns.m')
-rw-r--r--src/nsfns.m2668
1 files changed, 2668 insertions, 0 deletions
diff --git a/src/nsfns.m b/src/nsfns.m
new file mode 100644
index 00000000000..a39a8342bf9
--- /dev/null
+++ b/src/nsfns.m
@@ -0,0 +1,2668 @@
1/* Functions for the NeXT/Open/GNUstep and MacOSX window system.
2
3 Copyright (C) 1989, 1992, 1993, 1994, 2005, 2006, 2008
4 Free Software Foundation, Inc..
5
6This file is part of GNU Emacs.
7
8GNU Emacs is free software; you can redistribute it and/or modify
9it under the terms of the GNU General Public License as published by
10the Free Software Foundation; either version 3, or (at your option)
11any later version.
12
13GNU Emacs is distributed in the hope that it will be useful,
14but WITHOUT ANY WARRANTY; without even the implied warranty of
15MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16GNU General Public License for more details.
17
18You should have received a copy of the GNU General Public License
19along with GNU Emacs; see the file COPYING. If not, write to
20the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21Boston, MA 02110-1301, USA.
22
23Originally by Carl Edman
24Updated by Christian Limpach (chris@nice.ch)
25OpenStep/Rhapsody port by Scott Bender (sbender@harmony-ds.com)
26MacOSX/Aqua port by Christophe de Dinechin (descubes@earthlink.net)
27GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu)
28
29*/
30
31#include <signal.h>
32#include <math.h>
33#include "config.h"
34#include "lisp.h"
35#include "blockinput.h"
36#include "nsterm.h"
37#include "window.h"
38#include "buffer.h"
39#include "keyboard.h"
40#include "termhooks.h"
41#include "fontset.h"
42
43#include "character.h"
44#include "font.h"
45
46#if 0
47int fns_trace_num = 1;
48#define NSTRACE(x) fprintf (stderr, "%s:%d: [%d] " #x "\n", \
49 __FILE__, __LINE__, ++fns_trace_num)
50#else
51#define NSTRACE(x)
52#endif
53
54#ifdef HAVE_NS
55
56extern NSArray *ns_send_types, *ns_return_types, *ns_drag_types;
57
58extern Lisp_Object Qforeground_color;
59extern Lisp_Object Qbackground_color;
60extern Lisp_Object Qcursor_color;
61extern Lisp_Object Qinternal_border_width;
62extern Lisp_Object Qvisibility;
63extern Lisp_Object Qcursor_type;
64extern Lisp_Object Qicon_type;
65extern Lisp_Object Qicon_name;
66extern Lisp_Object Qicon_left;
67extern Lisp_Object Qicon_top;
68extern Lisp_Object Qleft;
69extern Lisp_Object Qright;
70extern Lisp_Object Qtop;
71extern Lisp_Object Qdisplay;
72extern Lisp_Object Qvertical_scroll_bars;
73extern Lisp_Object Qauto_raise;
74extern Lisp_Object Qauto_lower;
75extern Lisp_Object Qbox;
76extern Lisp_Object Qscroll_bar_width;
77extern Lisp_Object Qx_resource_name;
78extern Lisp_Object Qface_set_after_frame_default;
79extern Lisp_Object Qunderline, Qundefined;
80extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
81extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
82
83Lisp_Object Qnone;
84Lisp_Object Qns_frame_parameter;
85Lisp_Object Qbuffered;
86Lisp_Object Qfontsize;
87
88/* hack for OS X file panels */
89char panelOK = 0;
90
91/* Alist of elements (REGEXP . IMAGE) for images of icons associated
92 to frames.*/
93Lisp_Object Vns_icon_type_alist;
94
95EmacsTooltip *ns_tooltip;
96
97/* Need forward declaration here to preserve organizational integrity of file */
98Lisp_Object Fns_open_connection (Lisp_Object, Lisp_Object, Lisp_Object);
99
100extern BOOL ns_in_resize;
101
102
103/* ==========================================================================
104
105 Internal utility functions
106
107 ========================================================================== */
108
109
110void
111check_ns (void)
112{
113 if (NSApp == nil)
114 error ("OpenStep is not in use or not initialized");
115}
116
117
118/* Nonzero if we can use mouse menus. */
119int
120have_menus_p ()
121{
122 return NSApp != nil;
123}
124
125
126/* Extract a frame as a FRAME_PTR, defaulting to the selected frame
127 and checking validity for NS. */
128static FRAME_PTR
129check_ns_frame (Lisp_Object frame)
130{
131 FRAME_PTR f;
132
133 if (NILP (frame))
134 f = SELECTED_FRAME ();
135 else
136 {
137 CHECK_LIVE_FRAME (frame);
138 f = XFRAME (frame);
139 }
140 if (! FRAME_NS_P (f))
141 error ("non-NS frame used");
142 return f;
143}
144
145
146/* Let the user specify an NS display with a frame.
147 nil stands for the selected frame--or, if that is not an NS frame,
148 the first NS display on the list. */
149static struct ns_display_info *
150check_ns_display_info (Lisp_Object frame)
151{
152 if (NILP (frame))
153 {
154 struct frame *f = SELECTED_FRAME ();
155 if (FRAME_NS_P (f) && FRAME_LIVE_P (f) )
156 return FRAME_NS_DISPLAY_INFO (f);
157 else if (ns_display_list != 0)
158 return ns_display_list;
159 else
160 error ("NS windows are not in use or not initialized");
161 }
162 else if (INTEGERP (frame))
163 {
164 struct terminal *t = get_terminal (frame, 1);
165
166 if (t->type != output_ns)
167 error ("Terminal %d is not an NS display", XINT (frame));
168
169 return t->display_info.ns;
170 }
171 else if (STRINGP (frame))
172 return ns_display_info_for_name (frame);
173 else
174 {
175 FRAME_PTR f;
176
177 CHECK_LIVE_FRAME (frame);
178 f = XFRAME (frame);
179 if (! FRAME_NS_P (f))
180 error ("non-NS frame used");
181 return FRAME_NS_DISPLAY_INFO (f);
182 }
183 return NULL; /* shut compiler up */
184}
185
186
187static id
188ns_get_window (Lisp_Object maybeFrame)
189{
190 id view =nil, window =nil;
191
192 if (!FRAMEP (maybeFrame) || !FRAME_NS_P (XFRAME (maybeFrame)))
193 maybeFrame = selected_frame;/*wrong_type_argument (Qframep, maybeFrame); */
194
195 if (!NILP (maybeFrame))
196 view = FRAME_NS_VIEW (XFRAME (maybeFrame));
197 if (view) window =[view window];
198
199 return window;
200}
201
202
203static NSScreen *
204ns_get_screen (Lisp_Object anythingUnderTheSun)
205{
206 id window =nil;
207 NSScreen *screen = 0;
208
209 struct terminal *terminal;
210 struct ns_display_info *dpyinfo;
211 struct frame *f = NULL;
212 Lisp_Object frame;
213
214 if (INTEGERP (anythingUnderTheSun)) {
215 /* we got a terminal */
216 terminal = get_terminal (anythingUnderTheSun, 1);
217 dpyinfo = terminal->display_info.ns;
218 f = dpyinfo->ns_focus_frame;
219 if (!f)
220 f = dpyinfo->ns_highlight_frame;
221
222 } else if (FRAMEP (anythingUnderTheSun) &&
223 FRAME_NS_P (XFRAME (anythingUnderTheSun))) {
224 /* we got a frame */
225 f = XFRAME (anythingUnderTheSun);
226
227 } else if (STRINGP (anythingUnderTheSun)) { /* FIXME/cl for multi-display */
228 }
229
230 if (!f)
231 f = SELECTED_FRAME ();
232 if (f)
233 {
234 XSETFRAME (frame, f);
235 window = ns_get_window (frame);
236 }
237
238 if (window)
239 screen = [window screen];
240 if (!screen)
241 screen = [NSScreen mainScreen];
242
243 return screen;
244}
245
246
247/* Return the X display structure for the display named NAME.
248 Open a new connection if necessary. */
249struct ns_display_info *
250ns_display_info_for_name (name)
251 Lisp_Object name;
252{
253 Lisp_Object names;
254 struct ns_display_info *dpyinfo;
255
256 CHECK_STRING (name);
257
258 for (dpyinfo = ns_display_list, names = ns_display_name_list;
259 dpyinfo;
260 dpyinfo = dpyinfo->next, names = XCDR (names))
261 {
262 Lisp_Object tem;
263 tem = Fstring_equal (XCAR (XCAR (names)), name);
264 if (!NILP (tem))
265 return dpyinfo;
266 }
267
268 error ("Emacs for OpenStep does not yet support multi-display.");
269
270 Fns_open_connection (name, Qnil, Qnil);
271 dpyinfo = ns_display_list;
272
273 if (dpyinfo == 0)
274 error ("OpenStep on %s not responding.\n", XSTRING (name)->data);
275
276 return dpyinfo;
277}
278
279
280static Lisp_Object
281interpret_services_menu (NSMenu *menu, Lisp_Object prefix, Lisp_Object old)
282/* --------------------------------------------------------------------------
283 Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
284 -------------------------------------------------------------------------- */
285{
286 int i, count;
287 id<NSMenuItem> item;
288 const char *name;
289 Lisp_Object nameStr;
290 unsigned short key;
291 NSString *keys;
292 Lisp_Object res;
293
294 count = [menu numberOfItems];
295 for (i = 0; i<count; i++)
296 {
297 item = [menu itemAtIndex: i];
298 name = [[item title] UTF8String];
299 if (!name) continue;
300
301 nameStr = build_string (name);
302
303 if ([item hasSubmenu])
304 {
305 old = interpret_services_menu ([item submenu],
306 Fcons (nameStr, prefix), old);
307 }
308 else
309 {
310 keys = [item keyEquivalent];
311 if (keys && [keys length] )
312 {
313 key = [keys characterAtIndex: 0];
314 res = make_number (key|super_modifier);
315 }
316 else
317 {
318 res = Qundefined;
319 }
320 old = Fcons (Fcons (res,
321 Freverse (Fcons (nameStr,
322 prefix))),
323 old);
324 }
325 }
326 return old;
327}
328
329
330
331/* ==========================================================================
332
333 Frame parameter setters
334
335 ========================================================================== */
336
337
338static void
339ns_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
340{
341 NSColor *col;
342
343 if (ns_lisp_to_color (arg, &col))
344 {
345 store_frame_param (f, Qforeground_color, oldval);
346 error ("Unknown color");
347 }
348
349 [col retain];
350 [f->output_data.ns->foreground_color release];
351 f->output_data.ns->foreground_color = col;
352
353 if (FRAME_NS_VIEW (f))
354 {
355 update_face_from_frame_parameter (f, Qforeground_color, arg);
356 /*recompute_basic_faces (f); */
357 if (FRAME_VISIBLE_P (f))
358 redraw_frame (f);
359 }
360}
361
362
363static void
364ns_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
365{
366 struct face *face;
367 NSColor *col;
368 NSView *view = FRAME_NS_VIEW (f);
369 float alpha;
370
371 if (ns_lisp_to_color (arg, &col))
372 {
373 store_frame_param (f, Qbackground_color, oldval);
374 error ("Unknown color");
375 }
376
377 /* clear the frame; in some instances the NS-internal GC appears not to
378 update, or it does update and cannot clear old text properly */
379 if (FRAME_VISIBLE_P (f))
380 ns_clear_frame (f);
381
382 [col retain];
383 [f->output_data.ns->background_color release];
384 f->output_data.ns->background_color = col;
385 if (view != nil)
386 {
387 [[view window] setBackgroundColor: col];
388 alpha = [col alphaComponent];
389
390#ifdef NS_IMPL_COCOA
391 /* the alpha code below only works on 10.4, so we need to do something
392 else (albeit less good) otherwise.
393 Check NSApplication.h for useful NSAppKitVersionNumber values. */
394 if (NSAppKitVersionNumber < 744.0)
395 [[view window] setAlphaValue: alpha];
396#endif
397
398 if (alpha != 1.0)
399 [[view window] setOpaque: NO];
400 else
401 [[view window] setOpaque: YES];
402
403 face = FRAME_DEFAULT_FACE (f);
404 if (face)
405 {
406 col = NS_FACE_BACKGROUND (face);
407 face->background =
408 (EMACS_UINT) [[col colorWithAlphaComponent: alpha] retain];
409 [col release];
410
411 update_face_from_frame_parameter (f, Qbackground_color, arg);
412 }
413
414 if (FRAME_VISIBLE_P (f))
415 redraw_frame (f);
416 }
417}
418
419
420static void
421ns_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
422{
423 NSColor *col;
424
425 if (ns_lisp_to_color (arg, &col))
426 {
427 store_frame_param (f, Qcursor_color, oldval);
428 error ("Unknown color");
429 }
430
431 [f->output_data.ns->desired_cursor_color release];
432 f->output_data.ns->desired_cursor_color = [col retain];
433
434 if (FRAME_VISIBLE_P (f))
435 {
436 x_update_cursor (f, 0);
437 x_update_cursor (f, 1);
438 }
439 update_face_from_frame_parameter (f, Qcursor_color, arg);
440}
441
442
443static void
444ns_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
445{
446 NSView *view = FRAME_NS_VIEW (f);
447 NSTRACE (ns_set_icon_name);
448
449 if (ns_in_resize)
450 return;
451
452 /* see if it's changed */
453 if (STRINGP (arg))
454 {
455 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
456 return;
457 }
458 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
459 return;
460
461 f->icon_name = arg;
462
463 if (NILP (arg))
464 {
465 if (!NILP (f->title))
466 arg = f->title;
467 else
468 /* explicit name and no icon-name -> explicit_name */
469 if (f->explicit_name)
470 arg = f->name;
471 else
472 {
473 /* no explicit name and no icon-name ->
474 name has to be rebuild from icon_title_format */
475 windows_or_buffers_changed++;
476 return;
477 }
478 }
479
480 /* Don't change the name if it's already NAME. */
481 if ([[view window] miniwindowTitle] &&
482 ([[[view window] miniwindowTitle]
483 isEqualToString: [NSString stringWithUTF8String:
484 XSTRING (arg)->data]]))
485 return;
486
487 [[view window] setMiniwindowTitle:
488 [NSString stringWithUTF8String: XSTRING (arg)->data]];
489}
490
491
492static void
493ns_set_name_iconic (struct frame *f, Lisp_Object name, int explicit)
494{
495 NSView *view = FRAME_NS_VIEW (f);
496 NSTRACE (ns_set_name_iconic);
497
498 if (ns_in_resize)
499 return;
500
501 /* Make sure that requests from lisp code override requests from
502 Emacs redisplay code. */
503 if (explicit)
504 {
505 /* If we're switching from explicit to implicit, we had better
506 update the mode lines and thereby update the title. */
507 if (f->explicit_name && NILP (name))
508 update_mode_lines = 1;
509
510 f->explicit_name = ! NILP (name);
511 }
512 else if (f->explicit_name)
513 name = f->name;
514
515 /* title overrides explicit name */
516 if (! NILP (f->title))
517 name = f->title;
518
519 /* icon_name overrides title and explicit name */
520 if (! NILP (f->icon_name))
521 name = f->icon_name;
522
523 if (NILP (name))
524 name = build_string
525 ([[[NSProcessInfo processInfo] processName] UTF8String]);
526 else
527 CHECK_STRING (name);
528
529 /* Don't change the name if it's already NAME. */
530 if ([[view window] miniwindowTitle] &&
531 ([[[view window] miniwindowTitle]
532 isEqualToString: [NSString stringWithUTF8String:
533 XSTRING (name)->data]]))
534 return;
535
536 [[view window] setMiniwindowTitle:
537 [NSString stringWithUTF8String: XSTRING (name)->data]];
538}
539
540
541static void
542ns_set_name (struct frame *f, Lisp_Object name, int explicit)
543{
544 NSView *view = FRAME_NS_VIEW (f);
545 NSTRACE (ns_set_name);
546
547 if (ns_in_resize)
548 return;
549
550 /* Make sure that requests from lisp code override requests from
551 Emacs redisplay code. */
552 if (explicit)
553 {
554 /* If we're switching from explicit to implicit, we had better
555 update the mode lines and thereby update the title. */
556 if (f->explicit_name && NILP (name))
557 update_mode_lines = 1;
558
559 f->explicit_name = ! NILP (name);
560 }
561 else if (f->explicit_name)
562 return;
563
564 if (NILP (name))
565 name = build_string
566 ([[[NSProcessInfo processInfo] processName] UTF8String]);
567
568 f->name = name;
569
570 /* title overrides explicit name */
571 if (! NILP (f->title))
572 name = f->title;
573
574 CHECK_STRING (name);
575
576 /* Don't change the name if it's already NAME. */
577 if ([[[view window] title]
578 isEqualToString: [NSString stringWithUTF8String:
579 XSTRING (name)->data]])
580 return;
581 [[view window] setTitle: [NSString stringWithUTF8String:
582 XSTRING (name)->data]];
583}
584
585
586/* This function should be called when the user's lisp code has
587 specified a name for the frame; the name will override any set by the
588 redisplay code. */
589static void
590ns_explicitly_set_name (FRAME_PTR f, Lisp_Object arg, Lisp_Object oldval)
591{
592 NSTRACE (ns_explicitly_set_name);
593 ns_set_name_iconic (f, arg, 1);
594 ns_set_name (f, arg, 1);
595}
596
597
598/* This function should be called by Emacs redisplay code to set the
599 name; names set this way will never override names set by the user's
600 lisp code. */
601void
602x_implicitly_set_name (FRAME_PTR f, Lisp_Object arg, Lisp_Object oldval)
603{
604 NSTRACE (x_implicitly_set_name);
605 if (FRAME_ICONIFIED_P (f))
606 ns_set_name_iconic (f, arg, 0);
607 else
608 ns_set_name (f, arg, 0);
609}
610
611
612/* Change the title of frame F to NAME.
613 If NAME is nil, use the frame name as the title.
614
615 If EXPLICIT is non-zero, that indicates that lisp code is setting the
616 name; if NAME is a string, set F's name to NAME and set
617 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
618
619 If EXPLICIT is zero, that indicates that Emacs redisplay code is
620 suggesting a new name, which lisp code should override; if
621 F->explicit_name is set, ignore the new name; otherwise, set it. */
622static void
623ns_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name)
624{
625 NSTRACE (ns_set_title);
626 /* Don't change the title if it's already NAME. */
627 if (EQ (name, f->title))
628 return;
629
630 update_mode_lines = 1;
631
632 f->title = name;
633}
634
635
636void
637ns_set_name_as_filename (struct frame *f)
638{
639 NSView *view = FRAME_NS_VIEW (f);
640 Lisp_Object name;
641 Lisp_Object buf = XWINDOW (f->selected_window)->buffer;
642 const char *title;
643 NSAutoreleasePool *pool;
644 NSTRACE (ns_set_name_as_filename);
645
646 if (f->explicit_name || ! NILP (f->title) || ns_in_resize)
647 return;
648
649 BLOCK_INPUT;
650 pool = [[NSAutoreleasePool alloc] init];
651 name =XBUFFER (buf)->filename;
652 if (NILP (name) || FRAME_ICONIFIED_P (f)) name =XBUFFER (buf)->name;
653
654 if (FRAME_ICONIFIED_P (f) && !NILP (f->icon_name))
655 name = f->icon_name;
656
657 if (NILP (name))
658 name = build_string
659 ([[[NSProcessInfo processInfo] processName] UTF8String]);
660 else
661 CHECK_STRING (name);
662
663 title = FRAME_ICONIFIED_P (f) ? [[[view window] miniwindowTitle] UTF8String]
664 : [[[view window] title] UTF8String];
665
666 if (title && (! strcmp (title, XSTRING (name)->data)))
667 {
668 [pool release];
669 UNBLOCK_INPUT;
670 return;
671 }
672
673 if (! FRAME_ICONIFIED_P (f))
674 {
675#ifdef NS_IMPL_COCOA
676 /* work around a bug observed on 10.3 where
677 setTitleWithRepresentedFilename does not clear out previous state
678 if given filename does not exist */
679 NSString *str = [NSString stringWithUTF8String: XSTRING (name)->data];
680 if (![[NSFileManager defaultManager] fileExistsAtPath: str])
681 {
682 [[view window] setTitleWithRepresentedFilename: @""];
683 [[view window] setTitle: str];
684 }
685 else
686 {
687 [[view window] setTitleWithRepresentedFilename: str];
688 }
689#else
690 [[view window] setTitleWithRepresentedFilename:
691 [NSString stringWithUTF8String: XSTRING (name)->data]];
692#endif
693 f->name = name;
694 }
695 else
696 {
697 [[view window] setMiniwindowTitle:
698 [NSString stringWithUTF8String: XSTRING (name)->data]];
699 }
700 [pool release];
701 UNBLOCK_INPUT;
702}
703
704
705void
706ns_set_doc_edited (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
707{
708 NSView *view = FRAME_NS_VIEW (f);
709 NSAutoreleasePool *pool;
710 BLOCK_INPUT;
711 pool = [[NSAutoreleasePool alloc] init];
712 [[view window] setDocumentEdited: !NILP (arg)];
713 [pool release];
714 UNBLOCK_INPUT;
715}
716
717
718static void
719ns_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
720{
721 int nlines;
722 int olines = FRAME_MENU_BAR_LINES (f);
723 if (FRAME_MINIBUF_ONLY_P (f))
724 return;
725
726 if (INTEGERP (value))
727 nlines = XINT (value);
728 else
729 nlines = 0;
730
731 FRAME_MENU_BAR_LINES (f) = 0;
732 if (nlines)
733 {
734 FRAME_EXTERNAL_MENU_BAR (f) = 1;
735/* does for all frames, whereas we just want for one frame
736 [NSMenu setMenuBarVisible: YES]; */
737 }
738 else
739 {
740 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
741 free_frame_menubar (f);
742/* [NSMenu setMenuBarVisible: NO]; */
743 FRAME_EXTERNAL_MENU_BAR (f) = 0;
744 }
745}
746
747
748/* 23: PENDING: there is an erroneous direct call in window.c to this fn */
749void
750x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
751{
752 ns_set_menu_bar_lines (f, value, oldval);
753}
754
755
756/* 23: toolbar support */
757static void
758ns_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
759{
760 int nlines;
761 Lisp_Object root_window;
762
763 if (FRAME_MINIBUF_ONLY_P (f))
764 return;
765
766 if (INTEGERP (value) && XINT (value) >= 0)
767 nlines = XFASTINT (value);
768 else
769 nlines = 0;
770
771 if (nlines)
772 {
773 FRAME_EXTERNAL_TOOL_BAR (f) = 1;
774 update_frame_tool_bar (f);
775 }
776 else
777 {
778 if (FRAME_EXTERNAL_TOOL_BAR (f))
779 {
780 free_frame_tool_bar (f);
781 FRAME_EXTERNAL_TOOL_BAR (f) = 0;
782 }
783 }
784
785 x_set_window_size (f, 0, f->text_cols, f->text_lines);
786}
787
788
789/* 23: PENDING: there is an erroneous direct call in window.c to this fn */
790void
791x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
792{
793 ns_set_tool_bar_lines (f, value, oldval);
794}
795
796
797void
798ns_implicitly_set_icon_type (struct frame *f)
799{
800 Lisp_Object tem;
801 EmacsView *view = FRAME_NS_VIEW (f);
802 id image =nil;
803 Lisp_Object chain, elt;
804 NSAutoreleasePool *pool;
805 BOOL setMini = YES;
806
807 NSTRACE (ns_implicitly_set_icon_type);
808
809 BLOCK_INPUT;
810 pool = [[NSAutoreleasePool alloc] init];
811 if (f->output_data.ns->miniimage
812 && [[NSString stringWithUTF8String: XSTRING (f->name)->data]
813 isEqualToString: [(NSImage *)f->output_data.ns->miniimage name]])
814 {
815 [pool release];
816 UNBLOCK_INPUT;
817 return;
818 }
819
820 tem = assq_no_quit (Qicon_type, f->param_alist);
821 if (CONSP (tem) && ! NILP (XCDR (tem)))
822 {
823 [pool release];
824 UNBLOCK_INPUT;
825 return;
826 }
827
828 for (chain = Vns_icon_type_alist;
829 (image = nil) && CONSP (chain);
830 chain = XCDR (chain))
831 {
832 elt = XCAR (chain);
833 /* special case: 't' means go by file type */
834 if (SYMBOLP (elt) && elt == Qt && XSTRING (f->name)->data[0] == '/')
835 {
836 NSString *str =
837 [NSString stringWithUTF8String: XSTRING (f->name)->data];
838 if ([[NSFileManager defaultManager] fileExistsAtPath: str])
839 image = [[[NSWorkspace sharedWorkspace] iconForFile: str] retain];
840 }
841 else if (CONSP (elt) &&
842 STRINGP (XCAR (elt)) &&
843 STRINGP (XCDR (elt)) &&
844 fast_string_match (XCAR (elt), f->name) >= 0)
845 {
846 image = [EmacsImage allocInitFromFile: XCDR (elt)];
847 if (image == nil)
848 image = [[NSImage imageNamed:
849 [NSString stringWithUTF8String:
850 XSTRING (XCDR (elt))->data]] retain];
851 }
852 }
853
854 if (image == nil)
855 {
856 image = [[[NSWorkspace sharedWorkspace] iconForFileType: @"text"] retain];
857 setMini = NO;
858 }
859
860 [f->output_data.ns->miniimage release];
861 f->output_data.ns->miniimage = image;
862 [view setMiniwindowImage: setMini];
863 [pool release];
864 UNBLOCK_INPUT;
865}
866
867
868static void
869ns_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
870{
871 EmacsView *view = FRAME_NS_VIEW (f);
872 id image = nil;
873 BOOL setMini = YES;
874
875 NSTRACE (ns_set_icon_type);
876
877 if (!NILP (arg) && SYMBOLP (arg))
878 {
879 arg =build_string (XSTRING (XSYMBOL (arg)->xname)->data);
880 store_frame_param (f, Qicon_type, arg);
881 }
882
883 /* do it the implicit way */
884 if (NILP (arg))
885 {
886 ns_implicitly_set_icon_type (f);
887 return;
888 }
889
890 CHECK_STRING (arg);
891
892 image = [EmacsImage allocInitFromFile: arg];
893 if (image == nil)
894 image =[NSImage imageNamed: [NSString stringWithUTF8String:
895 XSTRING (arg)->data]];
896
897 if (image == nil)
898 {
899 image = [NSImage imageNamed: @"text"];
900 setMini = NO;
901 }
902
903 f->output_data.ns->miniimage = image;
904 [view setMiniwindowImage: setMini];
905}
906
907
908/* 23: added Xism; we stub out (we do implement this in ns-win.el) */
909int
910XParseGeometry (char *string, int *x, int *y,
911 unsigned int *width, unsigned int *height)
912{
913 message1 ("Warning: XParseGeometry not supported under NS.\n");
914 return 0;
915}
916
917
918/*PENDING: move to nsterm? */
919int
920ns_lisp_to_cursor_type (Lisp_Object arg)
921{
922 char *str;
923 if (XTYPE (arg) == Lisp_String)
924 str =XSTRING (arg)->data;
925 else if (XTYPE (arg) == Lisp_Symbol)
926 str =XSTRING (XSYMBOL (arg)->xname)->data;
927 else return -1;
928 if (!strcmp (str, "box")) return filled_box;
929 if (!strcmp (str, "hollow")) return hollow_box;
930 if (!strcmp (str, "underscore")) return underscore;
931 if (!strcmp (str, "bar")) return bar;
932 if (!strcmp (str, "no")) return no_highlight;
933 return -1;
934}
935
936
937Lisp_Object
938ns_cursor_type_to_lisp (int arg)
939{
940 switch (arg)
941 {
942 case filled_box: return Qbox;
943 case hollow_box: return intern ("hollow");
944 case underscore: return intern ("underscore");
945 case bar: return intern ("bar");
946 case no_highlight:
947 default: return intern ("no");
948 }
949}
950
951
952static void
953ns_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
954{
955 int val;
956
957 val = ns_lisp_to_cursor_type (arg);
958 if (val >= 0)
959 {
960 f->output_data.ns->desired_cursor =val;
961 }
962 else
963 {
964 store_frame_param (f, Qcursor_type, oldval);
965 error ("the `cursor-type' frame parameter should be either `no', `box', \
966`hollow', `underscore' or `bar'.");
967 }
968
969 update_mode_lines++;
970}
971
972
973/* 23: called to set mouse pointer color, but all other terms use it to
974 initialize pointer types (and don't set the color ;) */
975static void
976ns_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
977{
978 /* don't think we can do this on NS */
979}
980
981
982static void
983ns_icon (struct frame *f, Lisp_Object parms)
984/* --------------------------------------------------------------------------
985 Strangely-named function to set icon position parameters in frame.
986 This is irrelevant under OS X, but might be needed under GNUstep,
987 depending on the window manager used. Note, this is not a standard
988 frame parameter-setter; it is called directly from x-create-frame.
989 -------------------------------------------------------------------------- */
990{
991 Lisp_Object icon_x, icon_y;
992 struct ns_display_info *dpyinfo = check_ns_display_info (Qnil);
993
994 f->output_data.ns->icon_top = Qnil;
995 f->output_data.ns->icon_left = Qnil;
996
997 /* Set the position of the icon. */
998 icon_x = x_get_arg (dpyinfo, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
999 icon_y = x_get_arg (dpyinfo, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
1000 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
1001 {
1002 CHECK_NUMBER (icon_x);
1003 CHECK_NUMBER (icon_y);
1004 f->output_data.ns->icon_top = icon_y;
1005 f->output_data.ns->icon_left = icon_x;
1006 }
1007 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
1008 error ("Both left and top icon corners of icon must be specified");
1009}
1010
1011
1012/* 23 Note: commented out ns_... entries are no longer used in 23.
1013 commented out x_... entries have not been implemented yet.
1014 see frame.c for template, also where all generic OK functions are impl */
1015frame_parm_handler ns_frame_parm_handlers[] =
1016{
1017 x_set_autoraise, /* generic OK */
1018 x_set_autolower, /* generic OK */
1019 ns_set_background_color,
1020 0, /* x_set_border_color, may be impossible under NS */
1021 0, /* x_set_border_width, may be impossible under NS */
1022 ns_set_cursor_color,
1023 ns_set_cursor_type,
1024 x_set_font, /* generic OK */
1025 ns_set_foreground_color,
1026 ns_set_icon_name,
1027 ns_set_icon_type,
1028 x_set_internal_border_width, /* generic OK */
1029 ns_set_menu_bar_lines,
1030 ns_set_mouse_color,
1031 ns_explicitly_set_name,
1032 x_set_scroll_bar_width, /* generic OK */
1033 ns_set_title,
1034 x_set_unsplittable, /* generic OK */
1035 x_set_vertical_scroll_bars, /* generic OK */
1036 x_set_visibility, /* generic OK */
1037 ns_set_tool_bar_lines,
1038 0, /* x_set_scroll_bar_foreground, will ignore (not possible on NS) */
1039 0, /* x_set_scroll_bar_background, will ignore (not possible on NS) */
1040 x_set_screen_gamma, /* generic OK */
1041 x_set_line_spacing, /* generic OK, sets f->extra_line_spacing to int */
1042 x_set_fringe_width, /* generic OK */
1043 x_set_fringe_width, /* generic OK */
1044 0, /* x_set_wait_for_wm, will ignore */
1045 0, /* x_set_fullscreen will ignore */
1046 x_set_font_backend /* generic OK */
1047};
1048
1049
1050DEFUN ("x-create-frame", Fns_create_frame, Sns_create_frame,
1051 1, 1, 0,
1052 "Make a new NS window, which is called a \"frame\" in Emacs terms.\n\
1053Return an Emacs frame object representing the X window.\n\
1054ALIST is an alist of frame parameters.\n\
1055If the parameters specify that the frame should not have a minibuffer,\n\
1056and do not specify a specific minibuffer window to use,\n\
1057then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
1058be shared by the new frame.")
1059 (parms)
1060 Lisp_Object parms;
1061{
1062 static int desc_ctr = 1;
1063 struct frame *f;
1064 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1065 Lisp_Object frame, tem;
1066 Lisp_Object name;
1067 int minibuffer_only = 0;
1068 int count = specpdl_ptr - specpdl;
1069 Lisp_Object display;
1070 struct ns_display_info *dpyinfo = NULL;
1071 Lisp_Object parent;
1072 struct kboard *kb;
1073 Lisp_Object tfont, tfontsize;
1074 int window_prompting = 0;
1075 int width, height;
1076
1077 check_ns ();
1078
1079 display = x_get_arg (dpyinfo, parms, Qterminal, 0, 0, RES_TYPE_STRING);
1080 if (EQ (display, Qunbound))
1081 display = Qnil;
1082 dpyinfo = check_ns_display_info (display);
1083
1084 if (!dpyinfo->terminal->name)
1085 error ("Terminal is not live, can't create new frames on it");
1086
1087 kb = dpyinfo->terminal->kboard;
1088
1089 name = x_get_arg (dpyinfo, parms, Qname, 0, 0, RES_TYPE_STRING);
1090 if (!STRINGP (name)
1091 && ! EQ (name, Qunbound)
1092 && ! NILP (name))
1093 error ("Invalid frame name--not a string or nil");
1094
1095 if (STRINGP (name))
1096 Vx_resource_name = name;
1097
1098 parent = x_get_arg (dpyinfo, parms, Qparent_id, 0, 0, RES_TYPE_NUMBER);
1099 if (EQ (parent, Qunbound))
1100 parent = Qnil;
1101 if (! NILP (parent))
1102 CHECK_NUMBER (parent);
1103
1104 frame = Qnil;
1105 GCPRO4 (parms, parent, name, frame);
1106
1107 tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer",
1108 RES_TYPE_SYMBOL);
1109 if (EQ (tem, Qnone) || NILP (tem))
1110 {
1111 f = make_frame_without_minibuffer (Qnil, kb, display);
1112 }
1113 else if (EQ (tem, Qonly))
1114 {
1115 f = make_minibuffer_frame ();
1116 minibuffer_only = 1;
1117 }
1118 else if (WINDOWP (tem))
1119 {
1120 f = make_frame_without_minibuffer (tem, kb, display);
1121 }
1122 else
1123 {
1124 f = make_frame (1);
1125 }
1126
1127 /* Set the name; the functions to which we pass f expect the name to
1128 be set. */
1129 if (EQ (name, Qunbound) || NILP (name) || (XTYPE (name) != Lisp_String))
1130 {
1131 f->name =
1132 build_string ([[[NSProcessInfo processInfo] processName] UTF8String]);
1133 f->explicit_name =0;
1134 }
1135 else
1136 {
1137 f->name = name;
1138 f->explicit_name = 1;
1139 specbind (Qx_resource_name, name);
1140 }
1141
1142 XSETFRAME (frame, f);
1143 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
1144
1145 f->terminal = dpyinfo->terminal;
1146 f->terminal->reference_count++;
1147
1148 f->output_method = output_ns;
1149 f->output_data.ns = (struct ns_output *)xmalloc (sizeof *(f->output_data.ns));
1150 bzero (f->output_data.ns, sizeof (*(f->output_data.ns)));
1151
1152 FRAME_FONTSET (f) = -1;
1153
1154 /* record_unwind_protect (unwind_create_frame, frame); safety; maybe later? */
1155
1156 f->icon_name = x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title",
1157 RES_TYPE_STRING);
1158 if (EQ (f->icon_name, Qunbound) || (XTYPE (f->icon_name) != Lisp_String))
1159 f->icon_name = Qnil;
1160
1161 FRAME_NS_DISPLAY_INFO (f) = dpyinfo;
1162
1163 f->output_data.ns->window_desc = desc_ctr++;
1164 if (!NILP (parent))
1165 {
1166 f->output_data.ns->parent_desc = (Window) XFASTINT (parent);
1167 f->output_data.ns->explicit_parent = 1;
1168 }
1169 else
1170 {
1171 f->output_data.ns->parent_desc = FRAME_NS_DISPLAY_INFO (f)->root_window;
1172 f->output_data.ns->explicit_parent = 0;
1173 }
1174
1175 f->resx = dpyinfo->resx;
1176 f->resy = dpyinfo->resy;
1177
1178 BLOCK_INPUT;
1179 register_font_driver (&nsfont_driver, f);
1180 x_default_parameter (f, parms, Qfont_backend, Qnil,
1181 "fontBackend", "FontBackend", RES_TYPE_STRING);
1182
1183 {
1184 /* use for default font name */
1185 id font = [NSFont userFixedPitchFontOfSize: -1.0]; /* default */
1186 tfontsize = x_default_parameter (f, parms, Qfontsize,
1187 make_number (0 /*(int)[font pointSize]*/),
1188 "fontSize", "FontSize", RES_TYPE_NUMBER);
1189 tfont = x_default_parameter (f, parms, Qfont,
1190 build_string ([[font fontName] UTF8String]),
1191 "font", "Font", RES_TYPE_STRING);
1192 }
1193 UNBLOCK_INPUT;
1194
1195 x_default_parameter (f, parms, Qborder_width, make_number (0),
1196 "borderwidth", "BorderWidth", RES_TYPE_NUMBER);
1197 x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
1198 "internalBorderWidth", "InternalBorderWidth",
1199 RES_TYPE_NUMBER);
1200
1201 /* default scrollbars on right on Mac */
1202 {
1203 Lisp_Object spos =
1204#ifdef NS_IMPL_GNUSTEP
1205 Qt;
1206#else
1207 Qright;
1208#endif
1209 x_default_parameter (f, parms, Qvertical_scroll_bars, spos,
1210 "verticalScrollBars", "VerticalScrollBars",
1211 RES_TYPE_SYMBOL);
1212 }
1213 x_default_parameter (f, parms, Qforeground_color, build_string ("Black"),
1214 "foreground", "Foreground", RES_TYPE_STRING);
1215 x_default_parameter (f, parms, Qbackground_color, build_string ("White"),
1216 "background", "Background", RES_TYPE_STRING);
1217 x_default_parameter (f, parms, Qcursor_color, build_string ("grey"),
1218 "cursorColor", "CursorColor", RES_TYPE_STRING);
1219 /*PENDING: not suppported yet in NS */
1220 x_default_parameter (f, parms, Qline_spacing, Qnil,
1221 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
1222 x_default_parameter (f, parms, Qleft_fringe, Qnil,
1223 "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
1224 x_default_parameter (f, parms, Qright_fringe, Qnil,
1225 "rightFringe", "RightFringe", RES_TYPE_NUMBER);
1226 /* end PENDING */
1227
1228 init_frame_faces (f);
1229
1230 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (0), "menuBar",
1231 "menuBar", RES_TYPE_NUMBER);
1232 x_default_parameter (f, parms, Qtool_bar_lines, make_number (0), "toolBar",
1233 "toolBar", RES_TYPE_NUMBER);
1234 x_default_parameter (f, parms, Qbuffer_predicate, Qnil, "bufferPredicate",
1235 "BufferPredicate", RES_TYPE_SYMBOL);
1236 x_default_parameter (f, parms, Qtitle, Qnil, "title", "Title",
1237 RES_TYPE_STRING);
1238
1239/*PENDING: other terms seem to get away w/o this complexity.. */
1240 if (NILP (Fassq (Qwidth, parms)))
1241 {
1242 Lisp_Object value =
1243 x_get_arg (dpyinfo, parms, Qwidth, "width", "Width", RES_TYPE_NUMBER);
1244 if (! EQ (value, Qunbound))
1245 parms = Fcons (Fcons (Qwidth, value), parms);
1246 }
1247 if (NILP (Fassq (Qheight, parms)))
1248 {
1249 Lisp_Object value =
1250 x_get_arg (dpyinfo, parms, Qheight, "height", "Height",
1251 RES_TYPE_NUMBER);
1252 if (! EQ (value, Qunbound))
1253 parms = Fcons (Fcons (Qheight, value), parms);
1254 }
1255 if (NILP (Fassq (Qleft, parms)))
1256 {
1257 Lisp_Object value =
1258 x_get_arg (dpyinfo, parms, Qleft, "left", "Left", RES_TYPE_NUMBER);
1259 if (! EQ (value, Qunbound))
1260 parms = Fcons (Fcons (Qleft, value), parms);
1261 }
1262 if (NILP (Fassq (Qtop, parms)))
1263 {
1264 Lisp_Object value =
1265 x_get_arg (dpyinfo, parms, Qtop, "top", "Top", RES_TYPE_NUMBER);
1266 if (! EQ (value, Qunbound))
1267 parms = Fcons (Fcons (Qtop, value), parms);
1268 }
1269
1270 window_prompting = x_figure_window_size (f, parms, 1);
1271
1272 tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
1273 f->no_split = minibuffer_only || (!EQ (tem, Qunbound) && !EQ (tem, Qnil));
1274
1275 /* NOTE: on other terms, this is done in set_mouse_color, however this
1276 was not getting called under NS */
1277 f->output_data.ns->text_cursor = [NSCursor IBeamCursor];
1278 f->output_data.ns->nontext_cursor = [NSCursor arrowCursor];
1279 f->output_data.ns->modeline_cursor = [NSCursor pointingHandCursor];
1280 f->output_data.ns->hand_cursor = [NSCursor pointingHandCursor];
1281 f->output_data.ns->hourglass_cursor = [NSCursor disappearingItemCursor];
1282 f->output_data.ns->horizontal_drag_cursor = [NSCursor resizeLeftRightCursor];
1283 FRAME_NS_DISPLAY_INFO (f)->vertical_scroll_bar_cursor =
1284 [NSCursor arrowCursor];
1285 f->output_data.ns->current_pointer = f->output_data.ns->text_cursor;
1286
1287 [[EmacsView alloc] initFrameFromEmacs: f];
1288
1289 ns_icon (f, parms);
1290
1291 /* It is now ok to make the frame official even if we get an error below.
1292 The frame needs to be on Vframe_list or making it visible won't work. */
1293 Vframe_list = Fcons (frame, Vframe_list);
1294 /*FRAME_NS_DISPLAY_INFO (f)->reference_count++; */
1295
1296 x_default_parameter (f, parms, Qcursor_type, Qbox, "cursorType", "CursorType",
1297 RES_TYPE_SYMBOL);
1298 x_default_parameter (f, parms, Qscroll_bar_width, Qnil, "scrollBarWidth",
1299 "ScrollBarWidth", RES_TYPE_NUMBER);
1300 x_default_parameter (f, parms, Qicon_type, Qnil, "bitmapIcon", "BitmapIcon",
1301 RES_TYPE_SYMBOL);
1302 x_default_parameter (f, parms, Qauto_raise, Qnil, "autoRaise", "AutoRaise",
1303 RES_TYPE_BOOLEAN);
1304 x_default_parameter (f, parms, Qauto_lower, Qnil, "autoLower", "AutoLower",
1305 RES_TYPE_BOOLEAN);
1306 x_default_parameter (f, parms, Qbuffered, Qt, "buffered", "Buffered",
1307 RES_TYPE_BOOLEAN);
1308
1309 width = FRAME_COLS (f);
1310 height = FRAME_LINES (f);
1311
1312 SET_FRAME_COLS (f, 0);
1313 FRAME_LINES (f) = 0;
1314 change_frame_size (f, height, width, 1, 0, 0);
1315
1316 if (! f->output_data.ns->explicit_parent)
1317 {
1318 tem = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, RES_TYPE_BOOLEAN);
1319 if (EQ (tem, Qunbound))
1320 tem = Qnil;
1321
1322 x_set_visibility (f, tem, Qnil);
1323 if (EQ (tem, Qt))
1324 [[FRAME_NS_VIEW (f) window] makeKeyWindow];
1325 }
1326
1327 if (FRAME_HAS_MINIBUF_P (f)
1328 && (!FRAMEP (kb->Vdefault_minibuffer_frame)
1329 || !FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame))))
1330 kb->Vdefault_minibuffer_frame = frame;
1331
1332 /* All remaining specified parameters, which have not been "used"
1333 by x_get_arg and friends, now go in the misc. alist of the frame. */
1334 for (tem = parms; CONSP (tem); tem = XCDR (tem))
1335 if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
1336 f->param_alist = Fcons (XCAR (tem), f->param_alist);
1337
1338 UNGCPRO;
1339 Vwindow_list = Qnil;
1340
1341 return unbind_to (count, frame);
1342}
1343
1344
1345/* ==========================================================================
1346
1347 Lisp definitions
1348
1349 ========================================================================== */
1350
1351DEFUN ("ns-focus-frame", Fns_focus_frame, Sns_focus_frame, 1, 1, 0,
1352 doc: /* Set the input focus to FRAME.
1353FRAME nil means use the selected frame. */)
1354 (frame)
1355 Lisp_Object frame;
1356{
1357 struct frame *f = check_ns_frame (frame);
1358 struct ns_display_info *dpyinfo = FRAME_NS_DISPLAY_INFO (f);
1359
1360 if (dpyinfo->ns_focus_frame != f)
1361 {
1362 EmacsView *view = FRAME_NS_VIEW (f);
1363 BLOCK_INPUT;
1364 [[view window] makeKeyAndOrderFront: view];
1365 UNBLOCK_INPUT;
1366 }
1367
1368 return Qnil;
1369}
1370
1371
1372DEFUN ("ns-popup-prefs-panel", Fns_popup_prefs_panel, Sns_popup_prefs_panel,
1373 0, 0, "", "Pop up the preferences panel.")
1374 ()
1375{
1376 check_ns ();
1377 [(EmacsApp *)NSApp showPreferencesWindow: NSApp];
1378 return Qnil;
1379}
1380
1381
1382DEFUN ("ns-popup-font-panel", Fns_popup_font_panel, Sns_popup_font_panel,
1383 0, 1, "", "Pop up the font panel.")
1384 (frame)
1385 Lisp_Object frame;
1386{
1387 id fm;
1388 struct frame *f;
1389
1390 check_ns ();
1391 fm = [NSFontManager new];
1392 if (NILP (frame))
1393 f = SELECTED_FRAME ();
1394 else
1395 {
1396 CHECK_FRAME (frame);
1397 f = XFRAME (frame);
1398 }
1399
1400 [fm setSelectedFont: ((struct nsfont_info *)f->output_data.ns->font)->nsfont
1401 isMultiple: NO];
1402 [fm orderFrontFontPanel: NSApp];
1403 return Qnil;
1404}
1405
1406
1407DEFUN ("ns-popup-color-panel", Fns_popup_color_panel, Sns_popup_color_panel,
1408 0, 1, "", "Pop up the color panel.")
1409 (frame)
1410 Lisp_Object frame;
1411{
1412 struct frame *f;
1413
1414 check_ns ();
1415 if (NILP (frame))
1416 f = SELECTED_FRAME ();
1417 else
1418 {
1419 CHECK_FRAME (frame);
1420 f = XFRAME (frame);
1421 }
1422
1423 [NSApp orderFrontColorPanel: NSApp];
1424 return Qnil;
1425}
1426
1427
1428DEFUN ("ns-read-file-name", Fns_read_file_name, Sns_read_file_name, 1, 4, 0,
1429 "As read-file-name except that NS panels are used for querying, and\n\
1430args are slightly different. Nil returned if no selection made.\n\
1431Set ISLOAD non-nil if file being read for a save.")
1432 (prompt, dir, isLoad, init)
1433 Lisp_Object prompt, dir, isLoad, init;
1434{
1435 static id fileDelegate = nil;
1436 int ret;
1437 id panel;
1438 NSString *fname;
1439
1440 NSString *promptS = NILP (prompt) || !STRINGP (prompt) ? nil :
1441 [NSString stringWithUTF8String: XSTRING (prompt)->data];
1442 NSString *dirS = NILP (dir) || !STRINGP (dir) ?
1443 [NSString stringWithUTF8String: XSTRING (current_buffer->directory)->data] :
1444 [NSString stringWithUTF8String: XSTRING (dir)->data];
1445 NSString *initS = NILP (init) || !STRINGP (init) ? nil :
1446 [NSString stringWithUTF8String: XSTRING (init)->data];
1447
1448 check_ns ();
1449
1450 if (fileDelegate == nil)
1451 fileDelegate = [EmacsFileDelegate new];
1452
1453 [NSCursor setHiddenUntilMouseMoves: NO];
1454
1455 if ([dirS characterAtIndex: 0] == '~')
1456 dirS = [dirS stringByExpandingTildeInPath];
1457
1458 panel = NILP (isLoad) ?
1459 [EmacsSavePanel savePanel] : [EmacsOpenPanel openPanel];
1460
1461 [panel setTitle: promptS];
1462
1463 /* Puma (10.1) does not have */
1464 if ([panel respondsToSelector: @selector (setAllowsOtherFileTypes:)])
1465 [panel setAllowsOtherFileTypes: YES];
1466
1467 [panel setTreatsFilePackagesAsDirectories: YES];
1468 [panel setDelegate: fileDelegate];
1469
1470 panelOK = 0;
1471 if (NILP (isLoad))
1472 {
1473 ret = [panel runModalForDirectory: dirS file: initS];
1474 }
1475 else
1476 {
1477 [panel setCanChooseDirectories: YES];
1478 ret = [panel runModalForDirectory: dirS file: initS types: nil];
1479 }
1480
1481 ret = (ret = NSOKButton) || panelOK;
1482
1483 fname = [panel filename];
1484
1485 [[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow];
1486
1487 return ret ? build_string ([fname UTF8String]) : Qnil;
1488}
1489
1490
1491DEFUN ("ns-get-resource", Fns_get_resource, Sns_get_resource, 2, 2, 0,
1492 "Return the value of the property NAME of OWNER from the defaults database.\n\
1493If OWNER is nil, Emacs is assumed.")
1494 (owner, name)
1495 Lisp_Object owner, name;
1496{
1497 const char *value;
1498
1499 check_ns ();
1500 if (NILP (owner))
1501 owner = build_string
1502 ([[[NSProcessInfo processInfo] processName] UTF8String]);
1503 /* CHECK_STRING (owner); this should be just "Emacs" */
1504 CHECK_STRING (name);
1505/*fprintf (stderr, "ns-get-resource checking resource '%s'\n", SDATA (name)); */
1506
1507 value =[[[NSUserDefaults standardUserDefaults]
1508 objectForKey: [NSString stringWithUTF8String: XSTRING (name)->data]]
1509 UTF8String];
1510
1511 if (value)
1512 return build_string (value);
1513/*fprintf (stderr, "Nothing found for NS resource '%s'.\n", XSTRING (name)->data); */
1514 return Qnil;
1515}
1516
1517
1518DEFUN ("ns-set-resource", Fns_set_resource, Sns_set_resource, 3, 3, 0,
1519 "Set property NAME of OWNER to VALUE, from the defaults database.\n\
1520If OWNER is nil, Emacs is assumed.\n\
1521If VALUE is nil, the default is removed.")
1522 (owner, name, value)
1523 Lisp_Object owner, name, value;
1524{
1525 check_ns ();
1526 if (NILP (owner))
1527 owner =
1528 build_string ([[[NSProcessInfo processInfo] processName] UTF8String]);
1529 CHECK_STRING (owner);
1530 CHECK_STRING (name);
1531 if (NILP (value))
1532 {
1533 [[NSUserDefaults standardUserDefaults] removeObjectForKey:
1534 [NSString stringWithUTF8String: XSTRING (name)->data]];
1535 }
1536 else
1537 {
1538 CHECK_STRING (value);
1539 [[NSUserDefaults standardUserDefaults] setObject:
1540 [NSString stringWithUTF8String: XSTRING (value)->data]
1541 forKey: [NSString stringWithUTF8String:
1542 XSTRING (name)->data]];
1543 }
1544
1545 return Qnil;
1546}
1547
1548
1549DEFUN ("ns-set-alpha", Fns_set_alpha, Sns_set_alpha, 2, 2, 0,
1550 "Return a color same as given with alpha set to given value\n\
1551from 0 to 1, where 1 is fully opaque.")
1552 (color, alpha)
1553 Lisp_Object color;
1554 Lisp_Object alpha;
1555{
1556 NSColor *col;
1557 float a;
1558
1559 CHECK_STRING (color);
1560 CHECK_NUMBER_OR_FLOAT (alpha);
1561
1562 if (ns_lisp_to_color (color, &col))
1563 error ("Unknown color.");
1564
1565 a = XFLOATINT (alpha);
1566 if (a < 0.0 || a > 1.0)
1567 error ("Alpha value should be between 0 and 1 inclusive.");
1568
1569 col = [col colorWithAlphaComponent: a];
1570 return ns_color_to_lisp (col);
1571}
1572
1573
1574DEFUN ("ns-server-max-request-size", Fns_server_max_request_size,
1575 Sns_server_max_request_size,
1576 0, 1, 0,
1577 "This function is only present for completeness. It does not return\n\
1578a usable result for NS windows.")
1579 (display)
1580 Lisp_Object display;
1581{
1582 check_ns ();
1583 /* This function has no real equivalent under NeXTstep. Return nil to
1584 indicate this. */
1585 return Qnil;
1586}
1587
1588
1589DEFUN ("ns-server-vendor", Fns_server_vendor, Sns_server_vendor, 0, 1, 0,
1590 "Returns the vendor ID string of the NS server of display DISPLAY.\n\
1591The optional argument DISPLAY specifies which display to ask about.\n\
1592DISPLAY should be either a frame or a display name (a string).\n\
1593If omitted or nil, that stands for the selected frame's display.")
1594 (display)
1595 Lisp_Object display;
1596{
1597 check_ns ();
1598#ifdef NS_IMPL_GNUSTEP
1599 return build_string ("GNU");
1600#else
1601 return build_string ("Apple");
1602#endif
1603}
1604
1605
1606DEFUN ("ns-server-version", Fns_server_version, Sns_server_version, 0, 1, 0,
1607 "Returns the version number of the NS release of display DISPLAY.\n\
1608See also the function `ns-server-vendor'.\n\n\
1609The optional argument DISPLAY specifies which display to ask about.\n\
1610DISPLAY should be either a frame or a display name (a string).\n\
1611If omitted or nil, that stands for the selected frame's display.")
1612 (display)
1613 Lisp_Object display;
1614{
1615 /*PENDING: return GUI version on GNUSTEP, ?? on OS X */
1616 return build_string ("1.0");
1617}
1618
1619
1620DEFUN ("ns-display-screens", Fns_display_screens, Sns_display_screens, 0, 1, 0,
1621 "Returns the number of screens on the NS server of display DISPLAY.\n\
1622The optional argument DISPLAY specifies which display to ask about.\n\
1623DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\
1624If omitted or nil, that stands for the selected frame's display.")
1625 (display)
1626 Lisp_Object display;
1627{
1628 int num;
1629
1630 check_ns ();
1631 num = [[NSScreen screens] count];
1632
1633 return (num != 0) ? make_number (num) : Qnil;
1634}
1635
1636
1637DEFUN ("ns-display-mm-height", Fns_display_mm_height, Sns_display_mm_height,
1638 0, 1, 0,
1639 "Returns the height in millimeters of the NS display DISPLAY.\n\
1640The optional argument DISPLAY specifies which display to ask about.\n\
1641DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\
1642If omitted or nil, that stands for the selected frame's display.")
1643 (display)
1644 Lisp_Object display;
1645{
1646 check_ns ();
1647 return make_number ((int)
1648 ([ns_get_screen (display) frame].size.height/(92.0/25.4)));
1649}
1650
1651
1652DEFUN ("ns-display-mm-width", Fns_display_mm_width, Sns_display_mm_width,
1653 0, 1, 0,
1654 "Returns the width in millimeters of the NS display DISPLAY.\n\
1655The optional argument DISPLAY specifies which display to ask about.\n\
1656DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\
1657If omitted or nil, that stands for the selected frame's display.")
1658 (display)
1659 Lisp_Object display;
1660{
1661 check_ns ();
1662 return make_number ((int)
1663 ([ns_get_screen (display) frame].size.width/(92.0/25.4)));
1664}
1665
1666
1667DEFUN ("ns-display-backing-store", Fns_display_backing_store,
1668 Sns_display_backing_store, 0, 1, 0,
1669 "Returns an indication of whether NS display DISPLAY does backing store.\n\
1670The value may be `buffered', `retained', or `non-retained'.\n\
1671The optional argument DISPLAY specifies which display to ask about.\n\
1672DISPLAY should be either a frame, display name (a string), or terminal ID.\n\
1673If omitted or nil, that stands for the selected frame's display.\n\
1674Under NS, this may differ for each frame.")
1675 (display)
1676 Lisp_Object display;
1677{
1678 check_ns ();
1679 switch ([ns_get_window (display) backingType])
1680 {
1681 case NSBackingStoreBuffered:
1682 return intern ("buffered");
1683 case NSBackingStoreRetained:
1684 return intern ("retained");
1685 case NSBackingStoreNonretained:
1686 return intern ("non-retained");
1687 default:
1688 error ("Strange value for backingType parameter of frame");
1689 }
1690 return Qnil; /* not reached, shut compiler up */
1691}
1692
1693
1694DEFUN ("ns-display-visual-class", Fns_display_visual_class,
1695 Sns_display_visual_class, 0, 1, 0,
1696 "Returns the visual class of the NS display DISPLAY.\n\
1697The value is one of the symbols `static-gray', `gray-scale',\n\
1698`static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
1699The optional argument DISPLAY specifies which display to ask about.\n\
1700DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\
1701If omitted or nil, that stands for the selected frame's display.")
1702 (display)
1703 Lisp_Object display;
1704{
1705 NSWindowDepth depth;
1706 check_ns ();
1707 depth = [ns_get_screen (display) depth];
1708
1709 if ( depth == NSBestDepth (NSCalibratedWhiteColorSpace, 2, 2, YES, NULL))
1710 return intern ("static-gray");
1711 else if (depth == NSBestDepth (NSCalibratedWhiteColorSpace, 8, 8, YES, NULL))
1712 return intern ("gray-scale");
1713 else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 8, YES, NULL))
1714 return intern ("pseudo-color");
1715 else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 4, 12, NO, NULL))
1716 return intern ("true-color");
1717 else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 24, NO, NULL))
1718 return intern ("direct-color");
1719 else
1720 /* color mgmt as far as we do it is really handled by NS itself anyway */
1721 return intern ("direct-color");
1722}
1723
1724
1725DEFUN ("ns-display-save-under", Fns_display_save_under,
1726 Sns_display_save_under, 0, 1, 0,
1727 "Returns t if the NS display DISPLAY supports the save-under feature.\n\
1728The optional argument DISPLAY specifies which display to ask about.\n\
1729DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\
1730If omitted or nil, that stands for the selected frame's display.\n\
1731Under NS, this may differ for each frame.")
1732 (display)
1733 Lisp_Object display;
1734{
1735 check_ns ();
1736 switch ([ns_get_window (display) backingType])
1737 {
1738 case NSBackingStoreBuffered:
1739 return Qt;
1740
1741 case NSBackingStoreRetained:
1742 case NSBackingStoreNonretained:
1743 return Qnil;
1744
1745 default:
1746 error ("Strange value for backingType parameter of frame");
1747 }
1748 return Qnil; /* not reached, shut compiler up */
1749}
1750
1751
1752DEFUN ("ns-open-connection", Fns_open_connection, Sns_open_connection,
1753 1, 3, 0, "Open a connection to a NS server.\n\
1754DISPLAY is the name of the display to connect to.\n\
1755Optional arguments XRM-STRING and MUST-SUCCEED are currently ignored.")
1756 (display, resource_string, must_succeed)
1757 Lisp_Object display, resource_string, must_succeed;
1758{
1759 struct ns_display_info *dpyinfo;
1760
1761 CHECK_STRING (display);
1762
1763 nxatoms_of_nsselect ();
1764 dpyinfo = ns_term_init (display);
1765 if (dpyinfo == 0)
1766 {
1767 if (!NILP (must_succeed))
1768 fatal ("OpenStep on %s not responding.\n",
1769 XSTRING (display)->data);
1770 else
1771 error ("OpenStep on %s not responding.\n",
1772 XSTRING (display)->data);
1773 }
1774
1775 /* Register our external input/output types, used for determining
1776 applicable services and also drag/drop eligibility. */
1777 ns_send_types = [[NSArray arrayWithObject: NSStringPboardType] retain];
1778 ns_return_types = [[NSArray arrayWithObject: NSStringPboardType] retain];
1779 ns_drag_types = [[NSArray arrayWithObjects:
1780 NSStringPboardType,
1781 NSTabularTextPboardType,
1782 NSFilenamesPboardType,
1783 NSURLPboardType,
1784 NSColorPboardType,
1785 NSFontPboardType, nil] retain];
1786
1787 return Qnil;
1788}
1789
1790
1791DEFUN ("ns-close-connection", Fns_close_connection, Sns_close_connection,
1792 1, 1, 0, "Close the connection to the current NS server.\n\
1793The second argument DISPLAY is currently ignored, but nil would stand for\n\
1794the selected frame's display.")
1795 (display)
1796 Lisp_Object display;
1797{
1798 check_ns ();
1799#ifdef NS_IMPL_COCOA
1800 PSFlush ();
1801#endif
1802 /*ns_delete_terminal (dpyinfo->terminal); */
1803 [NSApp terminate: NSApp];
1804 return Qnil;
1805}
1806
1807
1808DEFUN ("ns-display-list", Fns_display_list, Sns_display_list, 0, 0, 0,
1809 "Return the list of display names that Emacs has connections to.")
1810 ()
1811{
1812 Lisp_Object tail, result;
1813
1814 result = Qnil;
1815 for (tail = ns_display_name_list; CONSP (tail); tail = XCDR (tail))
1816 result = Fcons (XCAR (XCAR (tail)), result);
1817
1818 return result;
1819}
1820
1821
1822DEFUN ("ns-hide-others", Fns_hide_others, Sns_hide_others,
1823 0, 0, 0, "Hides all applications other than emacs.")
1824 ()
1825{
1826 check_ns ();
1827 [NSApp hideOtherApplications: NSApp];
1828 return Qnil;
1829}
1830
1831DEFUN ("ns-hide-emacs", Fns_hide_emacs, Sns_hide_emacs,
1832 1, 1, 0, "If ON is non-nil, the entire emacs application is hidden.\n\
1833Otherwise if emacs is hidden, it is unhidden.\n\
1834If ON is equal to 'activate, emacs is unhidden and becomes\n\
1835the active application.")
1836 (on)
1837 Lisp_Object on;
1838{
1839 check_ns ();
1840 if (EQ (on, intern ("activate")))
1841 {
1842 [NSApp unhide: NSApp];
1843 [NSApp activateIgnoringOtherApps: YES];
1844 }
1845 else if (NILP (on))
1846 [NSApp unhide: NSApp];
1847 else
1848 [NSApp hide: NSApp];
1849 return Qnil;
1850}
1851
1852
1853DEFUN ("ns-emacs-info-panel", Fns_emacs_info_panel, Sns_emacs_info_panel,
1854 0, 0, 0, "Shows the 'Info' or 'About' panel for Emacs.")
1855 ()
1856{
1857 check_ns ();
1858 [NSApp orderFrontStandardAboutPanel: nil];
1859 return Qnil;
1860}
1861
1862
1863DEFUN ("x-list-fonts", Fns_list_fonts, Sns_list_fonts, 1, 4, 0,
1864 "Return a list of the names of available fonts matching PATTERN.\n\
1865If optional arguments FACE and FRAME are specified, return only fonts\n\
1866the same size as FACE on FRAME.\n\
1867If optional argument MAX is specified, return at most MAX matches.\n\
1868\n\
1869PATTERN is a regular expression; FACE is a face name - a symbol.\n\
1870\n\
1871The return value is a list of strings, suitable as arguments to\n\
1872set-face-font.\n\
1873\n\
1874The font names are _NOT_ X names.")
1875 (pattern, face, frame, max)
1876 Lisp_Object pattern, face, frame, max;
1877{
1878 Lisp_Object flist, olist = Qnil, tem;
1879 struct frame *f;
1880 int maxnames;
1881
1882 /* We can't simply call check_x_frame because this function may be
1883 called before any frame is created. */
1884 if (NILP (frame))
1885 f = SELECTED_FRAME ();
1886 else
1887 {
1888 CHECK_LIVE_FRAME (frame);
1889 f = XFRAME (frame);
1890 }
1891 if (! FRAME_WINDOW_P (f))
1892 {
1893 /* Perhaps we have not yet created any frame. */
1894 f = NULL;
1895 }
1896
1897 if (NILP (max))
1898 maxnames = 4;
1899 else
1900 {
1901 CHECK_NATNUM (max);
1902 maxnames = XFASTINT (max);
1903 }
1904
1905 /* get XLFD names */
1906 flist = ns_list_fonts (f, pattern, 0, maxnames);
1907
1908 /* convert list into regular names */
1909 for (tem = flist; CONSP (tem); tem = XCDR (tem))
1910 {
1911 Lisp_Object fname = XCAR (tem);
1912 olist = Fcons (build_string (ns_xlfd_to_fontname (XSTRING (fname)->data)),
1913 olist);
1914 }
1915
1916 return olist;
1917}
1918
1919
1920DEFUN ("ns-font-name", Fns_font_name, Sns_font_name, 1, 1, 0,
1921 "Determine font postscript or family name from a font name string or\n\
1922XLFD string. If string contains fontset' and not 'fontset-startup' it is\n\
1923left alone.")
1924 (name)
1925 Lisp_Object name;
1926{
1927 char *nm;
1928 CHECK_STRING (name);
1929 nm = SDATA (name);
1930
1931 if (nm[0] != '-')
1932 return name;
1933 if (strstr (nm, "fontset") && !strstr (nm, "fontset-startup"))
1934 return name;
1935
1936 return build_string (ns_xlfd_to_fontname (SDATA (name)));
1937}
1938
1939
1940DEFUN ("ns-list-colors", Fns_list_colors, Sns_list_colors, 0, 1, 0,
1941 "Return a list of all available colors.\n\
1942The optional argument FRAME is currently ignored.")
1943 (frame)
1944 Lisp_Object frame;
1945{
1946 Lisp_Object list = Qnil;
1947 NSEnumerator *colorlists;
1948 NSColorList *clist;
1949
1950 if (!NILP (frame))
1951 {
1952 CHECK_FRAME (frame);
1953 if (! FRAME_NS_P (XFRAME (frame)))
1954 error ("non-NS frame used in `ns-list-colors'");
1955 }
1956
1957 BLOCK_INPUT;
1958
1959 colorlists = [[NSColorList availableColorLists] objectEnumerator];
1960 while (clist = [colorlists nextObject])
1961 {
1962 if ([[clist name] length] < 7 ||
1963 [[clist name] rangeOfString: @"PANTONE"].location == 0)
1964 {
1965 NSEnumerator *cnames = [[clist allKeys] reverseObjectEnumerator];
1966 NSString *cname;
1967 while (cname = [cnames nextObject])
1968 list = Fcons (build_string ([cname UTF8String]), list);
1969/* for (i = [[clist allKeys] count] - 1; i >= 0; i--)
1970 list = Fcons (build_string ([[[clist allKeys] objectAtIndex: i]
1971 UTF8String]), list); */
1972 }
1973 }
1974
1975 UNBLOCK_INPUT;
1976
1977 return list;
1978}
1979
1980
1981DEFUN ("ns-list-services", Fns_list_services, Sns_list_services, 0, 0, 0,
1982 "List NS services by querying NSApp.")
1983 ()
1984{
1985 Lisp_Object ret = Qnil;
1986 NSMenu *svcs;
1987 id delegate;
1988
1989 check_ns ();
1990 svcs = [[NSMenu alloc] initWithTitle: @"Services"];
1991 [NSApp setServicesMenu: svcs]; /* this and next rebuild on <10.4 */
1992 [NSApp registerServicesMenuSendTypes: ns_send_types
1993 returnTypes: ns_return_types];
1994
1995/* On Tiger, services menu updating was made lazier (waits for user to
1996 actually click on the menu), so we have to force things along: */
1997#ifdef NS_IMPL_COCOA
1998 if (NSAppKitVersionNumber >= 744.0)
1999 {
2000 delegate = [svcs delegate];
2001 if (delegate != nil)
2002 {
2003 if ([delegate respondsToSelector: @selector (menuNeedsUpdate:)])
2004 [delegate menuNeedsUpdate: svcs];
2005 if ([delegate respondsToSelector:
2006 @selector (menu:updateItem:atIndex:shouldCancel:)])
2007 {
2008 int i, len = [delegate numberOfItemsInMenu: svcs];
2009 for (i =0; i<len; i++)
2010 [svcs addItemWithTitle: @"" action: NULL keyEquivalent: @""];
2011 for (i =0; i<len; i++)
2012 if (![delegate menu: svcs
2013 updateItem: (NSMenuItem *)[svcs itemAtIndex: i]
2014 atIndex: i shouldCancel: NO])
2015 break;
2016 }
2017 }
2018 }
2019#endif
2020
2021 [svcs setAutoenablesItems: NO];
2022#ifdef NS_IMPL_COCOA
2023 [svcs update]; /* on OS X, converts from '/' structure */
2024#endif
2025
2026 ret = interpret_services_menu (svcs, Qnil, ret);
2027 return ret;
2028}
2029
2030
2031DEFUN ("ns-perform-service", Fns_perform_service, Sns_perform_service,
2032 2, 2, 0, "Perform NS SERVICE on SEND which is either a string or nil.\n\
2033Returns result of service as string or nil if no result.")
2034 (service, send)
2035 Lisp_Object service, send;
2036{
2037 id pb;
2038 NSString *svcName;
2039 char *utfStr;
2040 int len;
2041
2042 CHECK_STRING (service);
2043 check_ns ();
2044
2045 utfStr = XSTRING (service)->data;
2046 svcName = [NSString stringWithUTF8String: utfStr];
2047
2048 pb =[NSPasteboard pasteboardWithUniqueName];
2049 ns_string_to_pasteboard (pb, send);
2050
2051 if (NSPerformService (svcName, pb) == NO)
2052 Fsignal (Qquit, Fcons (build_string ("service not available"), Qnil));
2053
2054 if ([[pb types] count] == 0)
2055 return build_string ("");
2056 return ns_string_from_pasteboard (pb);
2057}
2058
2059
2060DEFUN ("ns-convert-utf8-nfd-to-nfc", Fns_convert_utf8_nfd_to_nfc,
2061 Sns_convert_utf8_nfd_to_nfc, 1, 1, 0,
2062 "Composes character sequences in UTF-8 normal form NFD string STR to produce a normal (composed normal form NFC) string.")
2063 (str)
2064 Lisp_Object str;
2065{
2066 NSString *utfStr;
2067
2068 CHECK_STRING (str);
2069 utfStr = [[NSString stringWithUTF8String: XSTRING (str)->data]
2070 precomposedStringWithCanonicalMapping];
2071 return build_string ([utfStr UTF8String]);
2072}
2073
2074
2075/* ==========================================================================
2076
2077 Miscellaneous functions not called through hooks
2078
2079 ========================================================================== */
2080
2081
2082/* 23: call in image.c */
2083FRAME_PTR
2084check_x_frame (Lisp_Object frame)
2085{
2086 return check_ns_frame (frame);
2087}
2088
2089/* 23: added, due to call in frame.c */
2090struct ns_display_info *
2091check_x_display_info (Lisp_Object frame)
2092{
2093 return check_ns_display_info (frame);
2094}
2095
2096
2097/* 23: new function; we don't have much in the way of flexibility though */
2098void
2099x_set_scroll_bar_default_width (f)
2100 struct frame *f;
2101{
2102 int wid = FRAME_COLUMN_WIDTH (f);
2103 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = NS_SCROLL_BAR_WIDTH_DEFAULT;
2104 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) +
2105 wid - 1) / wid;
2106}
2107
2108
2109/* 23: terms now impl this instead of x-get-resource directly */
2110const char *
2111x_get_string_resource (XrmDatabase rdb, char *name, char *class)
2112{
2113 /* remove appname prefix; PENDING: allow for !="Emacs" */
2114 char *toCheck = class + (!strncmp (class, "Emacs.", 6) ? 6 : 0);
2115 const char *res;
2116 check_ns ();
2117
2118 /* Support emacs-20-style face resources for backwards compatibility */
2119 if (!strncmp (toCheck, "Face", 4))
2120 toCheck = name + (!strncmp (name, "emacs.", 6) ? 6 : 0);
2121
2122/*fprintf (stderr, "Checking '%s'\n", toCheck); */
2123
2124 res = [[[NSUserDefaults standardUserDefaults] objectForKey:
2125 [NSString stringWithUTF8String: toCheck]] UTF8String];
2126 return !res ? NULL :
2127 (!strncasecmp (res, "YES", 3) ? "true" :
2128 (!strncasecmp (res, "NO", 2) ? "false" : res));
2129}
2130
2131
2132Lisp_Object
2133x_get_focus_frame (struct frame *frame)
2134{
2135 struct ns_display_info *dpyinfo = FRAME_NS_DISPLAY_INFO (frame);
2136 Lisp_Object nsfocus;
2137
2138 if (!dpyinfo->ns_focus_frame)
2139 return Qnil;
2140
2141 XSETFRAME (nsfocus, dpyinfo->ns_focus_frame);
2142 return nsfocus;
2143}
2144
2145
2146int
2147x_pixel_width (struct frame *f)
2148{
2149 return FRAME_PIXEL_WIDTH (f);
2150}
2151
2152
2153int
2154x_pixel_height (struct frame *f)
2155{
2156 return FRAME_PIXEL_HEIGHT (f);
2157}
2158
2159
2160int
2161x_char_width (struct frame *f)
2162{
2163 return FRAME_COLUMN_WIDTH (f);
2164}
2165
2166
2167int
2168x_char_height (struct frame *f)
2169{
2170 return FRAME_LINE_HEIGHT (f);
2171}
2172
2173
2174int
2175x_screen_planes (struct frame *f)
2176{
2177 return FRAME_NS_DISPLAY_INFO (f)->n_planes;
2178}
2179
2180
2181void
2182x_sync (Lisp_Object frame)
2183{
2184 /* XXX Not implemented XXX */
2185 return;
2186}
2187
2188
2189
2190/* ==========================================================================
2191
2192 Lisp definitions that, for whatever reason, we can't alias as 'ns-XXX'.
2193
2194 ========================================================================== */
2195
2196
2197DEFUN ("xw-color-defined-p", Fns_color_defined_p, Sns_color_defined_p, 1, 2, 0,
2198 "Return t if the current NS display supports the color named COLOR.\n\
2199The optional argument FRAME is currently ignored.")
2200 (color, frame)
2201 Lisp_Object color, frame;
2202{
2203 NSColor * col;
2204 check_ns ();
2205 return ns_lisp_to_color (color, &col) ? Qnil : Qt;
2206}
2207
2208
2209DEFUN ("xw-color-values", Fns_color_values, Sns_color_values, 1, 2, 0,
2210 "Return a description of the color named COLOR.\n\
2211The value is a list of integer RGBA values--(RED GREEN BLUE ALPHA).\n\
2212These values appear to range from 0 to 65280; white is (65280 65280 65280 0).\n\
2213The optional argument FRAME is currently ignored.")
2214 (color, frame)
2215 Lisp_Object color, frame;
2216{
2217 NSColor * col;
2218 float red, green, blue, alpha;
2219 Lisp_Object rgba[4];
2220
2221 check_ns ();
2222 CHECK_STRING (color);
2223
2224 if (ns_lisp_to_color (color, &col))
2225 return Qnil;
2226
2227 [[col colorUsingColorSpaceName: NSCalibratedRGBColorSpace]
2228 getRed: &red green: &green blue: &blue alpha: &alpha];
2229 rgba[0] = make_number (lrint (red*65280));
2230 rgba[1] = make_number (lrint (green*65280));
2231 rgba[2] = make_number (lrint (blue*65280));
2232 rgba[3] = make_number (lrint (alpha*65280));
2233
2234 return Flist (4, rgba);
2235}
2236
2237
2238DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
2239 "Return t if the NS display supports color.\n\
2240The optional argument DISPLAY specifies which display to ask about.\n\
2241DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\
2242If omitted or nil, that stands for the selected frame's display.")
2243 (display)
2244 Lisp_Object display;
2245{
2246 NSWindowDepth depth;
2247 NSString *colorSpace;
2248 check_ns ();
2249 depth = [ns_get_screen (display) depth];
2250 colorSpace = NSColorSpaceFromDepth (depth);
2251
2252 return [colorSpace isEqualToString: NSDeviceWhiteColorSpace]
2253 || [colorSpace isEqualToString: NSCalibratedWhiteColorSpace]
2254 ? Qnil : Qt;
2255}
2256
2257
2258DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p,
2259 Sx_display_grayscale_p, 0, 1, 0,
2260 "Return t if the NS display supports shades of gray.\n\
2261Note that color displays do support shades of gray.\n\
2262The optional argument DISPLAY specifies which display to ask about.\n\
2263DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\
2264If omitted or nil, that stands for the selected frame's display.")
2265 (display)
2266 Lisp_Object display;
2267{
2268 NSWindowDepth depth;
2269 check_ns ();
2270 depth = [ns_get_screen (display) depth];
2271
2272 return NSBitsPerPixelFromDepth (depth) > 1 ? Qt : Qnil;
2273}
2274
2275
2276DEFUN ("x-display-pixel-width", Fns_display_pixel_width, Sns_display_pixel_width,
2277 0, 1, 0,
2278 "Returns the width in pixels of the NS display DISPLAY.\n\
2279The optional argument DISPLAY specifies which display to ask about.\n\
2280DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\
2281If omitted or nil, that stands for the selected frame's display.")
2282 (display)
2283 Lisp_Object display;
2284{
2285 check_ns ();
2286 return make_number ((int) [ns_get_screen (display) frame].size.width);
2287}
2288
2289
2290DEFUN ("x-display-pixel-height", Fns_display_pixel_height,
2291 Sns_display_pixel_height, 0, 1, 0,
2292 "Returns the height in pixels of the NS display DISPLAY.\n\
2293The optional argument DISPLAY specifies which display to ask about.\n\
2294DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\
2295If omitted or nil, that stands for the selected frame's display.")
2296 (display)
2297 Lisp_Object display;
2298{
2299 check_ns ();
2300 return make_number ((int) [ns_get_screen (display) frame].size.height);
2301}
2302
2303DEFUN ("display-usable-bounds", Fns_display_usable_bounds,
2304 Sns_display_usable_bounds, 0, 1, 0,
2305 "Returns a list of integers in form (left top width height) describing the \
2306usable screen area excluding reserved areas such as the Mac menu and doc, or \
2307the Windows task bar.\n \
2308The optional argument DISPLAY specifies which display to ask about.\n\
2309DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\
2310If omitted or nil, that stands for the selected frame's display.")
2311 (display)
2312 Lisp_Object display;
2313{
2314 int top;
2315 NSRect vScreen;
2316
2317 check_ns ();
2318 vScreen = [ns_get_screen (display) visibleFrame];
2319 top = vScreen.origin.y == 0.0 ?
2320 (int) [ns_get_screen (display) frame].size.height - vScreen.size.height : 0;
2321
2322 return list4 (make_number ((int) vScreen.origin.x),
2323 make_number (top),
2324 make_number ((int) vScreen.size.width),
2325 make_number ((int) vScreen.size.height));
2326}
2327
2328
2329DEFUN ("x-display-planes", Fx_display_planes, Sns_display_planes,
2330 0, 1, 0,
2331 "Returns the number of bitplanes of the NS display DISPLAY.\n\
2332The optional argument DISPLAY specifies which display to ask about.\n\
2333DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\
2334If omitted or nil, that stands for the selected frame's display.")
2335 (display)
2336 Lisp_Object display;
2337{
2338 check_ns ();
2339 return make_number
2340 (NSBitsPerSampleFromDepth ([ns_get_screen (display) depth]));
2341}
2342
2343
2344DEFUN ("x-display-color-cells", Fns_display_color_cells,
2345 Sns_display_color_cells, 0, 1, 0,
2346 "Returns the number of color cells of the NS display DISPLAY.\n\
2347The optional argument DISPLAY specifies which display to ask about.\n\
2348DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\
2349If omitted or nil, that stands for the selected frame's display.")
2350 (display)
2351 Lisp_Object display;
2352{
2353 check_ns ();
2354 struct ns_display_info *dpyinfo = check_ns_display_info (display);
2355
2356 /* We force 24+ bit depths to 24-bit to prevent an overflow. */
2357 return make_number (1 << min (dpyinfo->n_planes, 24));
2358}
2359
2360
2361/* Unused dummy def needed for compatibility. */
2362Lisp_Object tip_frame;
2363
2364/*PENDING: move to xdisp or similar */
2365static void
2366compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y)
2367 struct frame *f;
2368 Lisp_Object parms, dx, dy;
2369 int width, height;
2370 int *root_x, *root_y;
2371{
2372 Lisp_Object left, top;
2373 EmacsView *view = FRAME_NS_VIEW (f);
2374 NSPoint pt;
2375
2376 /* Start with user-specified or mouse position. */
2377 left = Fcdr (Fassq (Qleft, parms));
2378 if (INTEGERP (left))
2379 pt.x = XINT (left);
2380 else
2381 pt.x = last_mouse_motion_position.x;
2382 top = Fcdr (Fassq (Qtop, parms));
2383 if (INTEGERP (top))
2384 pt.y = XINT (top);
2385 else
2386 pt.y = last_mouse_motion_position.y;
2387
2388 /* Convert to screen coordinates */
2389 pt = [view convertPoint: pt toView: nil];
2390 pt = [[view window] convertBaseToScreen: pt];
2391
2392 /* Ensure in bounds. (Note, screen origin = lower left.) */
2393 if (pt.x + XINT (dx) <= 0)
2394 *root_x = 0; /* Can happen for negative dx */
2395 else if (pt.x + XINT (dx) + width <= FRAME_NS_DISPLAY_INFO (f)->width)
2396 /* It fits to the right of the pointer. */
2397 *root_x = pt.x + XINT (dx);
2398 else if (width + XINT (dx) <= pt.x)
2399 /* It fits to the left of the pointer. */
2400 *root_x = pt.x - width - XINT (dx);
2401 else
2402 /* Put it left justified on the screen -- it ought to fit that way. */
2403 *root_x = 0;
2404
2405 if (pt.y - XINT (dy) - height >= 0)
2406 /* It fits below the pointer. */
2407 *root_y = pt.y - height - XINT (dy);
2408 else if (pt.y + XINT (dy) + height <= FRAME_NS_DISPLAY_INFO (f)->height)
2409 /* It fits above the pointer */
2410 *root_y = pt.y + XINT (dy);
2411 else
2412 /* Put it on the top. */
2413 *root_y = FRAME_NS_DISPLAY_INFO (f)->height - height;
2414}
2415
2416
2417DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
2418 doc: /* Show STRING in a "tooltip" window on frame FRAME.
2419A tooltip window is a small window displaying a string.
2420
2421FRAME nil or omitted means use the selected frame.
2422
2423PARMS is an optional list of frame parameters which can be used to
2424change the tooltip's appearance.
2425
2426Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
2427means use the default timeout of 5 seconds.
2428
2429If the list of frame parameters PARMS contains a `left' parameter,
2430the tooltip is displayed at that x-position. Otherwise it is
2431displayed at the mouse position, with offset DX added (default is 5 if
2432DX isn't specified). Likewise for the y-position; if a `top' frame
2433parameter is specified, it determines the y-position of the tooltip
2434window, otherwise it is displayed at the mouse position, with offset
2435DY added (default is -10).
2436
2437A tooltip's maximum size is specified by `x-max-tooltip-size'.
2438Text larger than the specified size is clipped. */)
2439 (string, frame, parms, timeout, dx, dy)
2440 Lisp_Object string, frame, parms, timeout, dx, dy;
2441{
2442 int root_x, root_y;
2443 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2444 int count = SPECPDL_INDEX ();
2445 struct frame *f;
2446 char *str;
2447 NSSize size;
2448
2449 specbind (Qinhibit_redisplay, Qt);
2450
2451 GCPRO4 (string, parms, frame, timeout);
2452
2453 CHECK_STRING (string);
2454 str = XSTRING (string)->data;
2455 f = check_x_frame (frame);
2456 if (NILP (timeout))
2457 timeout = make_number (5);
2458 else
2459 CHECK_NATNUM (timeout);
2460
2461 if (NILP (dx))
2462 dx = make_number (5);
2463 else
2464 CHECK_NUMBER (dx);
2465
2466 if (NILP (dy))
2467 dy = make_number (-10);
2468 else
2469 CHECK_NUMBER (dy);
2470
2471 BLOCK_INPUT;
2472 if (ns_tooltip == nil)
2473 ns_tooltip = [[EmacsTooltip alloc] init];
2474 else
2475 Fx_hide_tip ();
2476
2477 [ns_tooltip setText: str];
2478 size = [ns_tooltip frame].size;
2479
2480 /* Move the tooltip window where the mouse pointer is. Resize and
2481 show it. */
2482 compute_tip_xy (f, parms, dx, dy, (int)size.width, (int)size.height,
2483 &root_x, &root_y);
2484
2485 [ns_tooltip showAtX: root_x Y: root_y for: XINT (timeout)];
2486 UNBLOCK_INPUT;
2487
2488 UNGCPRO;
2489 return unbind_to (count, Qnil);
2490}
2491
2492
2493DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
2494 doc: /* Hide the current tooltip window, if there is any.
2495Value is t if tooltip was open, nil otherwise. */)
2496 ()
2497{
2498 if (ns_tooltip == nil || ![ns_tooltip isActive])
2499 return Qnil;
2500 [ns_tooltip hide];
2501 return Qt;
2502}
2503
2504
2505/* ==========================================================================
2506
2507 Lisp interface declaration
2508
2509 ========================================================================== */
2510
2511
2512void
2513syms_of_nsfns ()
2514{
2515 int i;
2516
2517 Qns_frame_parameter = intern ("ns-frame-parameter");
2518 staticpro (&Qns_frame_parameter);
2519 Qnone = intern ("none");
2520 staticpro (&Qnone);
2521 Qbuffered = intern ("bufferd");
2522 staticpro (&Qbuffered);
2523 Qfontsize = intern ("fontsize");
2524 staticpro (&Qfontsize);
2525
2526 DEFVAR_LISP ("ns-icon-type-alist", &Vns_icon_type_alist,
2527 "Alist of elements (REGEXP . IMAGE) for images of icons associated to\n\
2528frames. If the title of a frame matches REGEXP, then IMAGE.tiff is\n\
2529selected as the image of the icon representing the frame when it's\n\
2530miniaturized. If an element is t, then Emacs tries to select an icon\n\
2531based on the filetype of the visited file.\n\
2532\n\
2533The images have to be installed in a folder called English.lproj in the\n\
2534Emacs.app folder. You have to restart Emacs after installing new icons.\n\
2535\n\
2536Example: Install an icon Gnus.tiff and execute the following code\n\
2537\n\
2538 (setq ns-icon-type-alist\n\
2539 (append ns-icon-type-alist\n\
2540 '((\"^\\\\*\\\\(Group\\\\*$\\\\|Summary \\\\|Article\\\\*$\\\\)\"\n\
2541 . \"Gnus\"))))\n\
2542\n\
2543When you miniaturize a Group, Summary or Article frame, Gnus.tiff will\n\
2544be used as the image of the icon representing the frame.");
2545 Vns_icon_type_alist = Fcons (Qt, Qnil);
2546
2547 defsubr (&Sns_read_file_name);
2548 defsubr (&Sns_get_resource);
2549 defsubr (&Sns_set_resource);
2550 defsubr (&Sxw_display_color_p); /* this and next called directly by C code */
2551 defsubr (&Sx_display_grayscale_p);
2552 defsubr (&Sns_list_fonts);
2553 defsubr (&Sns_font_name);
2554 defsubr (&Sns_list_colors);
2555 defsubr (&Sns_color_defined_p);
2556 defsubr (&Sns_color_values);
2557 defsubr (&Sns_server_max_request_size);
2558 defsubr (&Sns_server_vendor);
2559 defsubr (&Sns_server_version);
2560 defsubr (&Sns_display_pixel_width);
2561 defsubr (&Sns_display_pixel_height);
2562 defsubr (&Sns_display_usable_bounds);
2563 defsubr (&Sns_display_mm_width);
2564 defsubr (&Sns_display_mm_height);
2565 defsubr (&Sns_display_screens);
2566 defsubr (&Sns_display_planes);
2567 defsubr (&Sns_display_color_cells);
2568 defsubr (&Sns_display_visual_class);
2569 defsubr (&Sns_display_backing_store);
2570 defsubr (&Sns_display_save_under);
2571 defsubr (&Sns_create_frame);
2572 defsubr (&Sns_set_alpha);
2573 defsubr (&Sns_open_connection);
2574 defsubr (&Sns_close_connection);
2575 defsubr (&Sns_display_list);
2576
2577 defsubr (&Sns_hide_others);
2578 defsubr (&Sns_hide_emacs);
2579 defsubr (&Sns_emacs_info_panel);
2580 defsubr (&Sns_list_services);
2581 defsubr (&Sns_perform_service);
2582 defsubr (&Sns_convert_utf8_nfd_to_nfc);
2583 defsubr (&Sns_focus_frame);
2584 defsubr (&Sns_popup_prefs_panel);
2585 defsubr (&Sns_popup_font_panel);
2586 defsubr (&Sns_popup_color_panel);
2587
2588 defsubr (&Sx_show_tip);
2589 defsubr (&Sx_hide_tip);
2590
2591 /* used only in fontset.c */
2592 check_window_system_func = check_ns;
2593
2594}
2595
2596
2597
2598/* ==========================================================================
2599
2600 Class implementations
2601
2602 ========================================================================== */
2603
2604
2605@implementation EmacsSavePanel
2606#ifdef NS_IMPL_COCOA
2607/* --------------------------------------------------------------------------
2608 These are overridden to intercept on OS X: ending panel restarts NSApp
2609 event loop if it is stopped. Not sure if this is correct behavior,
2610 perhaps should check if running and if so send an appdefined.
2611 -------------------------------------------------------------------------- */
2612- (void) ok: (id)sender
2613{
2614 [super ok: sender];
2615 panelOK = 1;
2616 [NSApp stop: self];
2617}
2618- (void) cancel: (id)sender
2619{
2620 [super cancel: sender];
2621 [NSApp stop: self];
2622}
2623#endif
2624@end
2625
2626
2627@implementation EmacsOpenPanel
2628#ifdef NS_IMPL_COCOA
2629/* --------------------------------------------------------------------------
2630 These are overridden to intercept on OS X: ending panel restarts NSApp
2631 event loop if it is stopped. Not sure if this is correct behavior,
2632 perhaps should check if running and if so send an appdefined.
2633 -------------------------------------------------------------------------- */
2634- (void) ok: (id)sender
2635{
2636 [super ok: sender];
2637 panelOK = 1;
2638 [NSApp stop: self];
2639}
2640- (void) cancel: (id)sender
2641{
2642 [super cancel: sender];
2643 [NSApp stop: self];
2644}
2645#endif
2646@end
2647
2648
2649@implementation EmacsFileDelegate
2650/* --------------------------------------------------------------------------
2651 Delegate methods for Open/Save panels
2652 -------------------------------------------------------------------------- */
2653- (BOOL)panel: (id)sender isValidFilename: (NSString *)filename
2654{
2655 return YES;
2656}
2657- (BOOL)panel: (id)sender shouldShowFilename: (NSString *)filename
2658{
2659 return YES;
2660}
2661- (NSString *)panel: (id)sender userEnteredFilename: (NSString *)filename
2662 confirmed: (BOOL)okFlag
2663{
2664 return filename;
2665}
2666@end
2667
2668#endif
generated by cgit v1.2.1 (git 2.18.0) at 2026-02-17 04:26:46 +0000