]> code.delx.au - gnu-emacs/blob - lisp/term/mac-win.el
Use create-fontset-from-mac-roman-font to create the startup fontset
[gnu-emacs] / lisp / term / mac-win.el
1 ;;; mac-win.el --- parse switches controlling interface with Mac window system
2
3 ;; Copyright (C) 1999, 2000, 2002, 2003, 2004, 2005
4 ;; Free Software Foundation, Inc.
5
6 ;; Author: Andrew Choi <akochoi@mac.com>
7 ;; Keywords: terminals
8
9 ;; This file is part of GNU Emacs.
10
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; any later version.
15
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
20
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
25
26 ;;; Commentary:
27
28 ;; Mac-win.el: this file is loaded from ../lisp/startup.el when it recognizes
29 ;; that Mac windows are to be used. Command line switches are parsed and those
30 ;; pertaining to Mac are processed and removed from the command line. The
31 ;; Mac display is opened and hooks are set for popping up the initial window.
32
33 ;; startup.el will then examine startup files, and eventually call the hooks
34 ;; which create the first window(s).
35
36 ;;; Code:
37 \f
38 ;; These are the standard X switches from the Xt Initialize.c file of
39 ;; Release 4.
40
41 ;; Command line Resource Manager string
42
43 ;; +rv *reverseVideo
44 ;; +synchronous *synchronous
45 ;; -background *background
46 ;; -bd *borderColor
47 ;; -bg *background
48 ;; -bordercolor *borderColor
49 ;; -borderwidth .borderWidth
50 ;; -bw .borderWidth
51 ;; -display .display
52 ;; -fg *foreground
53 ;; -fn *font
54 ;; -font *font
55 ;; -foreground *foreground
56 ;; -geometry .geometry
57 ;; -i .iconType
58 ;; -itype .iconType
59 ;; -iconic .iconic
60 ;; -name .name
61 ;; -reverse *reverseVideo
62 ;; -rv *reverseVideo
63 ;; -selectionTimeout .selectionTimeout
64 ;; -synchronous *synchronous
65 ;; -xrm
66
67 ;; An alist of X options and the function which handles them. See
68 ;; ../startup.el.
69
70 (if (not (eq window-system 'mac))
71 (error "%s: Loading mac-win.el but not compiled for Mac" (invocation-name)))
72
73 (require 'frame)
74 (require 'mouse)
75 (require 'scroll-bar)
76 (require 'faces)
77 ;;(require 'select)
78 (require 'menu-bar)
79 (require 'fontset)
80 (require 'x-dnd)
81
82 (defvar x-invocation-args)
83
84 (defvar x-command-line-resources nil)
85
86 ;; Handler for switches of the form "-switch value" or "-switch".
87 (defun x-handle-switch (switch)
88 (let ((aelt (assoc switch command-line-x-option-alist)))
89 (if aelt
90 (let ((param (nth 3 aelt))
91 (value (nth 4 aelt)))
92 (if value
93 (setq default-frame-alist
94 (cons (cons param value)
95 default-frame-alist))
96 (setq default-frame-alist
97 (cons (cons param
98 (car x-invocation-args))
99 default-frame-alist)
100 x-invocation-args (cdr x-invocation-args)))))))
101
102 ;; Handler for switches of the form "-switch n"
103 (defun x-handle-numeric-switch (switch)
104 (let ((aelt (assoc switch command-line-x-option-alist)))
105 (if aelt
106 (let ((param (nth 3 aelt)))
107 (setq default-frame-alist
108 (cons (cons param
109 (string-to-int (car x-invocation-args)))
110 default-frame-alist)
111 x-invocation-args
112 (cdr x-invocation-args))))))
113
114 ;; Handle options that apply to initial frame only
115 (defun x-handle-initial-switch (switch)
116 (let ((aelt (assoc switch command-line-x-option-alist)))
117 (if aelt
118 (let ((param (nth 3 aelt))
119 (value (nth 4 aelt)))
120 (if value
121 (setq initial-frame-alist
122 (cons (cons param value)
123 initial-frame-alist))
124 (setq initial-frame-alist
125 (cons (cons param
126 (car x-invocation-args))
127 initial-frame-alist)
128 x-invocation-args (cdr x-invocation-args)))))))
129
130 ;; Make -iconic apply only to the initial frame!
131 (defun x-handle-iconic (switch)
132 (setq initial-frame-alist
133 (cons '(visibility . icon) initial-frame-alist)))
134
135 ;; Handle the -xrm option.
136 (defun x-handle-xrm-switch (switch)
137 (unless (consp x-invocation-args)
138 (error "%s: missing argument to `%s' option" (invocation-name) switch))
139 (setq x-command-line-resources
140 (if (null x-command-line-resources)
141 (car x-invocation-args)
142 (concat x-command-line-resources "\n" (car x-invocation-args))))
143 (setq x-invocation-args (cdr x-invocation-args)))
144
145 ;; Handle the geometry option
146 (defun x-handle-geometry (switch)
147 (let* ((geo (x-parse-geometry (car x-invocation-args)))
148 (left (assq 'left geo))
149 (top (assq 'top geo))
150 (height (assq 'height geo))
151 (width (assq 'width geo)))
152 (if (or height width)
153 (setq default-frame-alist
154 (append default-frame-alist
155 '((user-size . t))
156 (if height (list height))
157 (if width (list width)))
158 initial-frame-alist
159 (append initial-frame-alist
160 '((user-size . t))
161 (if height (list height))
162 (if width (list width)))))
163 (if (or left top)
164 (setq initial-frame-alist
165 (append initial-frame-alist
166 '((user-position . t))
167 (if left (list left))
168 (if top (list top)))))
169 (setq x-invocation-args (cdr x-invocation-args))))
170
171 ;; Handle the -name option. Set the variable x-resource-name
172 ;; to the option's operand; set the name of
173 ;; the initial frame, too.
174 (defun x-handle-name-switch (switch)
175 (or (consp x-invocation-args)
176 (error "%s: missing argument to `%s' option" (invocation-name) switch))
177 (setq x-resource-name (car x-invocation-args)
178 x-invocation-args (cdr x-invocation-args))
179 (setq initial-frame-alist (cons (cons 'name x-resource-name)
180 initial-frame-alist)))
181
182 (defvar x-display-name nil
183 "The display name specifying server and frame.")
184
185 (defun x-handle-display (switch)
186 (setq x-display-name (car x-invocation-args)
187 x-invocation-args (cdr x-invocation-args)))
188
189 (defun x-handle-args (args)
190 "Process the X-related command line options in ARGS.
191 This is done before the user's startup file is loaded. They are copied to
192 `x-invocation-args', from which the X-related things are extracted, first
193 the switch (e.g., \"-fg\") in the following code, and possible values
194 \(e.g., \"black\") in the option handler code (e.g., x-handle-switch).
195 This function returns ARGS minus the arguments that have been processed."
196 ;; We use ARGS to accumulate the args that we don't handle here, to return.
197 (setq x-invocation-args args
198 args nil)
199 (while (and x-invocation-args
200 (not (equal (car x-invocation-args) "--")))
201 (let* ((this-switch (car x-invocation-args))
202 (orig-this-switch this-switch)
203 completion argval aelt handler)
204 (setq x-invocation-args (cdr x-invocation-args))
205 ;; Check for long options with attached arguments
206 ;; and separate out the attached option argument into argval.
207 (if (string-match "^--[^=]*=" this-switch)
208 (setq argval (substring this-switch (match-end 0))
209 this-switch (substring this-switch 0 (1- (match-end 0)))))
210 ;; Complete names of long options.
211 (if (string-match "^--" this-switch)
212 (progn
213 (setq completion (try-completion this-switch command-line-x-option-alist))
214 (if (eq completion t)
215 ;; Exact match for long option.
216 nil
217 (if (stringp completion)
218 (let ((elt (assoc completion command-line-x-option-alist)))
219 ;; Check for abbreviated long option.
220 (or elt
221 (error "Option `%s' is ambiguous" this-switch))
222 (setq this-switch completion))))))
223 (setq aelt (assoc this-switch command-line-x-option-alist))
224 (if aelt (setq handler (nth 2 aelt)))
225 (if handler
226 (if argval
227 (let ((x-invocation-args
228 (cons argval x-invocation-args)))
229 (funcall handler this-switch))
230 (funcall handler this-switch))
231 (setq args (cons orig-this-switch args)))))
232 (nconc (nreverse args) x-invocation-args))
233
234 \f
235 ;;
236 ;; Standard Mac cursor shapes
237 ;;
238
239 (defconst mac-pointer-arrow 0)
240 (defconst mac-pointer-copy-arrow 1)
241 (defconst mac-pointer-alias-arrow 2)
242 (defconst mac-pointer-contextual-menu-arrow 3)
243 (defconst mac-pointer-I-beam 4)
244 (defconst mac-pointer-cross 5)
245 (defconst mac-pointer-plus 6)
246 (defconst mac-pointer-watch 7)
247 (defconst mac-pointer-closed-hand 8)
248 (defconst mac-pointer-open-hand 9)
249 (defconst mac-pointer-pointing-hand 10)
250 (defconst mac-pointer-counting-up-hand 11)
251 (defconst mac-pointer-counting-down-hand 12)
252 (defconst mac-pointer-counting-up-and-down-hand 13)
253 (defconst mac-pointer-spinning 14)
254 (defconst mac-pointer-resize-left 15)
255 (defconst mac-pointer-resize-right 16)
256 (defconst mac-pointer-resize-left-right 17)
257 ;; Mac OS X 10.2 and later
258 (defconst mac-pointer-not-allowed 18)
259 ;; Mac OS X 10.3 and later
260 (defconst mac-pointer-resize-up 19)
261 (defconst mac-pointer-resize-down 20)
262 (defconst mac-pointer-resize-up-down 21)
263 (defconst mac-pointer-poof 22)
264
265 ;;
266 ;; Standard X cursor shapes that have Mac counterparts
267 ;;
268
269 (defconst x-pointer-left-ptr mac-pointer-arrow)
270 (defconst x-pointer-xterm mac-pointer-I-beam)
271 (defconst x-pointer-crosshair mac-pointer-cross)
272 (defconst x-pointer-plus mac-pointer-plus)
273 (defconst x-pointer-watch mac-pointer-watch)
274 (defconst x-pointer-hand2 mac-pointer-pointing-hand)
275 (defconst x-pointer-left-side mac-pointer-resize-left)
276 (defconst x-pointer-right-side mac-pointer-resize-right)
277 (defconst x-pointer-sb-h-double-arrow mac-pointer-resize-left-right)
278 (defconst x-pointer-top-side mac-pointer-resize-up)
279 (defconst x-pointer-bottom-side mac-pointer-resize-down)
280 (defconst x-pointer-sb-v-double-arrow mac-pointer-resize-up-down)
281
282 \f
283 ;;
284 ;; Available colors
285 ;;
286
287 (defvar x-colors '("LightGreen"
288 "light green"
289 "DarkRed"
290 "dark red"
291 "DarkMagenta"
292 "dark magenta"
293 "DarkCyan"
294 "dark cyan"
295 "DarkBlue"
296 "dark blue"
297 "DarkGray"
298 "dark gray"
299 "DarkGrey"
300 "dark grey"
301 "grey100"
302 "gray100"
303 "grey99"
304 "gray99"
305 "grey98"
306 "gray98"
307 "grey97"
308 "gray97"
309 "grey96"
310 "gray96"
311 "grey95"
312 "gray95"
313 "grey94"
314 "gray94"
315 "grey93"
316 "gray93"
317 "grey92"
318 "gray92"
319 "grey91"
320 "gray91"
321 "grey90"
322 "gray90"
323 "grey89"
324 "gray89"
325 "grey88"
326 "gray88"
327 "grey87"
328 "gray87"
329 "grey86"
330 "gray86"
331 "grey85"
332 "gray85"
333 "grey84"
334 "gray84"
335 "grey83"
336 "gray83"
337 "grey82"
338 "gray82"
339 "grey81"
340 "gray81"
341 "grey80"
342 "gray80"
343 "grey79"
344 "gray79"
345 "grey78"
346 "gray78"
347 "grey77"
348 "gray77"
349 "grey76"
350 "gray76"
351 "grey75"
352 "gray75"
353 "grey74"
354 "gray74"
355 "grey73"
356 "gray73"
357 "grey72"
358 "gray72"
359 "grey71"
360 "gray71"
361 "grey70"
362 "gray70"
363 "grey69"
364 "gray69"
365 "grey68"
366 "gray68"
367 "grey67"
368 "gray67"
369 "grey66"
370 "gray66"
371 "grey65"
372 "gray65"
373 "grey64"
374 "gray64"
375 "grey63"
376 "gray63"
377 "grey62"
378 "gray62"
379 "grey61"
380 "gray61"
381 "grey60"
382 "gray60"
383 "grey59"
384 "gray59"
385 "grey58"
386 "gray58"
387 "grey57"
388 "gray57"
389 "grey56"
390 "gray56"
391 "grey55"
392 "gray55"
393 "grey54"
394 "gray54"
395 "grey53"
396 "gray53"
397 "grey52"
398 "gray52"
399 "grey51"
400 "gray51"
401 "grey50"
402 "gray50"
403 "grey49"
404 "gray49"
405 "grey48"
406 "gray48"
407 "grey47"
408 "gray47"
409 "grey46"
410 "gray46"
411 "grey45"
412 "gray45"
413 "grey44"
414 "gray44"
415 "grey43"
416 "gray43"
417 "grey42"
418 "gray42"
419 "grey41"
420 "gray41"
421 "grey40"
422 "gray40"
423 "grey39"
424 "gray39"
425 "grey38"
426 "gray38"
427 "grey37"
428 "gray37"
429 "grey36"
430 "gray36"
431 "grey35"
432 "gray35"
433 "grey34"
434 "gray34"
435 "grey33"
436 "gray33"
437 "grey32"
438 "gray32"
439 "grey31"
440 "gray31"
441 "grey30"
442 "gray30"
443 "grey29"
444 "gray29"
445 "grey28"
446 "gray28"
447 "grey27"
448 "gray27"
449 "grey26"
450 "gray26"
451 "grey25"
452 "gray25"
453 "grey24"
454 "gray24"
455 "grey23"
456 "gray23"
457 "grey22"
458 "gray22"
459 "grey21"
460 "gray21"
461 "grey20"
462 "gray20"
463 "grey19"
464 "gray19"
465 "grey18"
466 "gray18"
467 "grey17"
468 "gray17"
469 "grey16"
470 "gray16"
471 "grey15"
472 "gray15"
473 "grey14"
474 "gray14"
475 "grey13"
476 "gray13"
477 "grey12"
478 "gray12"
479 "grey11"
480 "gray11"
481 "grey10"
482 "gray10"
483 "grey9"
484 "gray9"
485 "grey8"
486 "gray8"
487 "grey7"
488 "gray7"
489 "grey6"
490 "gray6"
491 "grey5"
492 "gray5"
493 "grey4"
494 "gray4"
495 "grey3"
496 "gray3"
497 "grey2"
498 "gray2"
499 "grey1"
500 "gray1"
501 "grey0"
502 "gray0"
503 "thistle4"
504 "thistle3"
505 "thistle2"
506 "thistle1"
507 "MediumPurple4"
508 "MediumPurple3"
509 "MediumPurple2"
510 "MediumPurple1"
511 "purple4"
512 "purple3"
513 "purple2"
514 "purple1"
515 "DarkOrchid4"
516 "DarkOrchid3"
517 "DarkOrchid2"
518 "DarkOrchid1"
519 "MediumOrchid4"
520 "MediumOrchid3"
521 "MediumOrchid2"
522 "MediumOrchid1"
523 "plum4"
524 "plum3"
525 "plum2"
526 "plum1"
527 "orchid4"
528 "orchid3"
529 "orchid2"
530 "orchid1"
531 "magenta4"
532 "magenta3"
533 "magenta2"
534 "magenta1"
535 "VioletRed4"
536 "VioletRed3"
537 "VioletRed2"
538 "VioletRed1"
539 "maroon4"
540 "maroon3"
541 "maroon2"
542 "maroon1"
543 "PaleVioletRed4"
544 "PaleVioletRed3"
545 "PaleVioletRed2"
546 "PaleVioletRed1"
547 "LightPink4"
548 "LightPink3"
549 "LightPink2"
550 "LightPink1"
551 "pink4"
552 "pink3"
553 "pink2"
554 "pink1"
555 "HotPink4"
556 "HotPink3"
557 "HotPink2"
558 "HotPink1"
559 "DeepPink4"
560 "DeepPink3"
561 "DeepPink2"
562 "DeepPink1"
563 "red4"
564 "red3"
565 "red2"
566 "red1"
567 "OrangeRed4"
568 "OrangeRed3"
569 "OrangeRed2"
570 "OrangeRed1"
571 "tomato4"
572 "tomato3"
573 "tomato2"
574 "tomato1"
575 "coral4"
576 "coral3"
577 "coral2"
578 "coral1"
579 "DarkOrange4"
580 "DarkOrange3"
581 "DarkOrange2"
582 "DarkOrange1"
583 "orange4"
584 "orange3"
585 "orange2"
586 "orange1"
587 "LightSalmon4"
588 "LightSalmon3"
589 "LightSalmon2"
590 "LightSalmon1"
591 "salmon4"
592 "salmon3"
593 "salmon2"
594 "salmon1"
595 "brown4"
596 "brown3"
597 "brown2"
598 "brown1"
599 "firebrick4"
600 "firebrick3"
601 "firebrick2"
602 "firebrick1"
603 "chocolate4"
604 "chocolate3"
605 "chocolate2"
606 "chocolate1"
607 "tan4"
608 "tan3"
609 "tan2"
610 "tan1"
611 "wheat4"
612 "wheat3"
613 "wheat2"
614 "wheat1"
615 "burlywood4"
616 "burlywood3"
617 "burlywood2"
618 "burlywood1"
619 "sienna4"
620 "sienna3"
621 "sienna2"
622 "sienna1"
623 "IndianRed4"
624 "IndianRed3"
625 "IndianRed2"
626 "IndianRed1"
627 "RosyBrown4"
628 "RosyBrown3"
629 "RosyBrown2"
630 "RosyBrown1"
631 "DarkGoldenrod4"
632 "DarkGoldenrod3"
633 "DarkGoldenrod2"
634 "DarkGoldenrod1"
635 "goldenrod4"
636 "goldenrod3"
637 "goldenrod2"
638 "goldenrod1"
639 "gold4"
640 "gold3"
641 "gold2"
642 "gold1"
643 "yellow4"
644 "yellow3"
645 "yellow2"
646 "yellow1"
647 "LightYellow4"
648 "LightYellow3"
649 "LightYellow2"
650 "LightYellow1"
651 "LightGoldenrod4"
652 "LightGoldenrod3"
653 "LightGoldenrod2"
654 "LightGoldenrod1"
655 "khaki4"
656 "khaki3"
657 "khaki2"
658 "khaki1"
659 "DarkOliveGreen4"
660 "DarkOliveGreen3"
661 "DarkOliveGreen2"
662 "DarkOliveGreen1"
663 "OliveDrab4"
664 "OliveDrab3"
665 "OliveDrab2"
666 "OliveDrab1"
667 "chartreuse4"
668 "chartreuse3"
669 "chartreuse2"
670 "chartreuse1"
671 "green4"
672 "green3"
673 "green2"
674 "green1"
675 "SpringGreen4"
676 "SpringGreen3"
677 "SpringGreen2"
678 "SpringGreen1"
679 "PaleGreen4"
680 "PaleGreen3"
681 "PaleGreen2"
682 "PaleGreen1"
683 "SeaGreen4"
684 "SeaGreen3"
685 "SeaGreen2"
686 "SeaGreen1"
687 "DarkSeaGreen4"
688 "DarkSeaGreen3"
689 "DarkSeaGreen2"
690 "DarkSeaGreen1"
691 "aquamarine4"
692 "aquamarine3"
693 "aquamarine2"
694 "aquamarine1"
695 "DarkSlateGray4"
696 "DarkSlateGray3"
697 "DarkSlateGray2"
698 "DarkSlateGray1"
699 "cyan4"
700 "cyan3"
701 "cyan2"
702 "cyan1"
703 "turquoise4"
704 "turquoise3"
705 "turquoise2"
706 "turquoise1"
707 "CadetBlue4"
708 "CadetBlue3"
709 "CadetBlue2"
710 "CadetBlue1"
711 "PaleTurquoise4"
712 "PaleTurquoise3"
713 "PaleTurquoise2"
714 "PaleTurquoise1"
715 "LightCyan4"
716 "LightCyan3"
717 "LightCyan2"
718 "LightCyan1"
719 "LightBlue4"
720 "LightBlue3"
721 "LightBlue2"
722 "LightBlue1"
723 "LightSteelBlue4"
724 "LightSteelBlue3"
725 "LightSteelBlue2"
726 "LightSteelBlue1"
727 "SlateGray4"
728 "SlateGray3"
729 "SlateGray2"
730 "SlateGray1"
731 "LightSkyBlue4"
732 "LightSkyBlue3"
733 "LightSkyBlue2"
734 "LightSkyBlue1"
735 "SkyBlue4"
736 "SkyBlue3"
737 "SkyBlue2"
738 "SkyBlue1"
739 "DeepSkyBlue4"
740 "DeepSkyBlue3"
741 "DeepSkyBlue2"
742 "DeepSkyBlue1"
743 "SteelBlue4"
744 "SteelBlue3"
745 "SteelBlue2"
746 "SteelBlue1"
747 "DodgerBlue4"
748 "DodgerBlue3"
749 "DodgerBlue2"
750 "DodgerBlue1"
751 "blue4"
752 "blue3"
753 "blue2"
754 "blue1"
755 "RoyalBlue4"
756 "RoyalBlue3"
757 "RoyalBlue2"
758 "RoyalBlue1"
759 "SlateBlue4"
760 "SlateBlue3"
761 "SlateBlue2"
762 "SlateBlue1"
763 "azure4"
764 "azure3"
765 "azure2"
766 "azure1"
767 "MistyRose4"
768 "MistyRose3"
769 "MistyRose2"
770 "MistyRose1"
771 "LavenderBlush4"
772 "LavenderBlush3"
773 "LavenderBlush2"
774 "LavenderBlush1"
775 "honeydew4"
776 "honeydew3"
777 "honeydew2"
778 "honeydew1"
779 "ivory4"
780 "ivory3"
781 "ivory2"
782 "ivory1"
783 "cornsilk4"
784 "cornsilk3"
785 "cornsilk2"
786 "cornsilk1"
787 "LemonChiffon4"
788 "LemonChiffon3"
789 "LemonChiffon2"
790 "LemonChiffon1"
791 "NavajoWhite4"
792 "NavajoWhite3"
793 "NavajoWhite2"
794 "NavajoWhite1"
795 "PeachPuff4"
796 "PeachPuff3"
797 "PeachPuff2"
798 "PeachPuff1"
799 "bisque4"
800 "bisque3"
801 "bisque2"
802 "bisque1"
803 "AntiqueWhite4"
804 "AntiqueWhite3"
805 "AntiqueWhite2"
806 "AntiqueWhite1"
807 "seashell4"
808 "seashell3"
809 "seashell2"
810 "seashell1"
811 "snow4"
812 "snow3"
813 "snow2"
814 "snow1"
815 "thistle"
816 "MediumPurple"
817 "medium purple"
818 "purple"
819 "BlueViolet"
820 "blue violet"
821 "DarkViolet"
822 "dark violet"
823 "DarkOrchid"
824 "dark orchid"
825 "MediumOrchid"
826 "medium orchid"
827 "orchid"
828 "plum"
829 "violet"
830 "magenta"
831 "VioletRed"
832 "violet red"
833 "MediumVioletRed"
834 "medium violet red"
835 "maroon"
836 "PaleVioletRed"
837 "pale violet red"
838 "LightPink"
839 "light pink"
840 "pink"
841 "DeepPink"
842 "deep pink"
843 "HotPink"
844 "hot pink"
845 "red"
846 "OrangeRed"
847 "orange red"
848 "tomato"
849 "LightCoral"
850 "light coral"
851 "coral"
852 "DarkOrange"
853 "dark orange"
854 "orange"
855 "LightSalmon"
856 "light salmon"
857 "salmon"
858 "DarkSalmon"
859 "dark salmon"
860 "brown"
861 "firebrick"
862 "chocolate"
863 "tan"
864 "SandyBrown"
865 "sandy brown"
866 "wheat"
867 "beige"
868 "burlywood"
869 "peru"
870 "sienna"
871 "SaddleBrown"
872 "saddle brown"
873 "IndianRed"
874 "indian red"
875 "RosyBrown"
876 "rosy brown"
877 "DarkGoldenrod"
878 "dark goldenrod"
879 "goldenrod"
880 "LightGoldenrod"
881 "light goldenrod"
882 "gold"
883 "yellow"
884 "LightYellow"
885 "light yellow"
886 "LightGoldenrodYellow"
887 "light goldenrod yellow"
888 "PaleGoldenrod"
889 "pale goldenrod"
890 "khaki"
891 "DarkKhaki"
892 "dark khaki"
893 "OliveDrab"
894 "olive drab"
895 "ForestGreen"
896 "forest green"
897 "YellowGreen"
898 "yellow green"
899 "LimeGreen"
900 "lime green"
901 "GreenYellow"
902 "green yellow"
903 "MediumSpringGreen"
904 "medium spring green"
905 "chartreuse"
906 "green"
907 "LawnGreen"
908 "lawn green"
909 "SpringGreen"
910 "spring green"
911 "PaleGreen"
912 "pale green"
913 "LightSeaGreen"
914 "light sea green"
915 "MediumSeaGreen"
916 "medium sea green"
917 "SeaGreen"
918 "sea green"
919 "DarkSeaGreen"
920 "dark sea green"
921 "DarkOliveGreen"
922 "dark olive green"
923 "DarkGreen"
924 "dark green"
925 "aquamarine"
926 "MediumAquamarine"
927 "medium aquamarine"
928 "CadetBlue"
929 "cadet blue"
930 "LightCyan"
931 "light cyan"
932 "cyan"
933 "turquoise"
934 "MediumTurquoise"
935 "medium turquoise"
936 "DarkTurquoise"
937 "dark turquoise"
938 "PaleTurquoise"
939 "pale turquoise"
940 "PowderBlue"
941 "powder blue"
942 "LightBlue"
943 "light blue"
944 "LightSteelBlue"
945 "light steel blue"
946 "SteelBlue"
947 "steel blue"
948 "LightSkyBlue"
949 "light sky blue"
950 "SkyBlue"
951 "sky blue"
952 "DeepSkyBlue"
953 "deep sky blue"
954 "DodgerBlue"
955 "dodger blue"
956 "blue"
957 "RoyalBlue"
958 "royal blue"
959 "MediumBlue"
960 "medium blue"
961 "LightSlateBlue"
962 "light slate blue"
963 "MediumSlateBlue"
964 "medium slate blue"
965 "SlateBlue"
966 "slate blue"
967 "DarkSlateBlue"
968 "dark slate blue"
969 "CornflowerBlue"
970 "cornflower blue"
971 "NavyBlue"
972 "navy blue"
973 "navy"
974 "MidnightBlue"
975 "midnight blue"
976 "LightGray"
977 "light gray"
978 "LightGrey"
979 "light grey"
980 "grey"
981 "gray"
982 "LightSlateGrey"
983 "light slate grey"
984 "LightSlateGray"
985 "light slate gray"
986 "SlateGrey"
987 "slate grey"
988 "SlateGray"
989 "slate gray"
990 "DimGrey"
991 "dim grey"
992 "DimGray"
993 "dim gray"
994 "DarkSlateGrey"
995 "dark slate grey"
996 "DarkSlateGray"
997 "dark slate gray"
998 "black"
999 "white"
1000 "MistyRose"
1001 "misty rose"
1002 "LavenderBlush"
1003 "lavender blush"
1004 "lavender"
1005 "AliceBlue"
1006 "alice blue"
1007 "azure"
1008 "MintCream"
1009 "mint cream"
1010 "honeydew"
1011 "seashell"
1012 "LemonChiffon"
1013 "lemon chiffon"
1014 "ivory"
1015 "cornsilk"
1016 "moccasin"
1017 "NavajoWhite"
1018 "navajo white"
1019 "PeachPuff"
1020 "peach puff"
1021 "bisque"
1022 "BlanchedAlmond"
1023 "blanched almond"
1024 "PapayaWhip"
1025 "papaya whip"
1026 "AntiqueWhite"
1027 "antique white"
1028 "linen"
1029 "OldLace"
1030 "old lace"
1031 "FloralWhite"
1032 "floral white"
1033 "gainsboro"
1034 "WhiteSmoke"
1035 "white smoke"
1036 "GhostWhite"
1037 "ghost white"
1038 "snow")
1039 "The list of X colors from the `rgb.txt' file.
1040 XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp")
1041
1042 (defun xw-defined-colors (&optional frame)
1043 "Internal function called by `defined-colors', which see."
1044 (or frame (setq frame (selected-frame)))
1045 (let ((all-colors x-colors)
1046 (this-color nil)
1047 (defined-colors nil))
1048 (while all-colors
1049 (setq this-color (car all-colors)
1050 all-colors (cdr all-colors))
1051 (and (color-supported-p this-color frame t)
1052 (setq defined-colors (cons this-color defined-colors))))
1053 defined-colors))
1054 \f
1055 ;;;; Function keys
1056
1057 (substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame
1058 global-map)
1059
1060 ;; Map certain keypad keys into ASCII characters
1061 ;; that people usually expect.
1062 (define-key function-key-map [backspace] [?\d])
1063 (define-key function-key-map [delete] [?\d])
1064 (define-key function-key-map [tab] [?\t])
1065 (define-key function-key-map [linefeed] [?\n])
1066 (define-key function-key-map [clear] [?\C-l])
1067 (define-key function-key-map [return] [?\C-m])
1068 (define-key function-key-map [escape] [?\e])
1069 (define-key function-key-map [M-backspace] [?\M-\d])
1070 (define-key function-key-map [M-delete] [?\M-\d])
1071 (define-key function-key-map [M-tab] [?\M-\t])
1072 (define-key function-key-map [M-linefeed] [?\M-\n])
1073 (define-key function-key-map [M-clear] [?\M-\C-l])
1074 (define-key function-key-map [M-return] [?\M-\C-m])
1075 (define-key function-key-map [M-escape] [?\M-\e])
1076
1077 ;; These tell read-char how to convert
1078 ;; these special chars to ASCII.
1079 (put 'backspace 'ascii-character ?\d)
1080 (put 'delete 'ascii-character ?\d)
1081 (put 'tab 'ascii-character ?\t)
1082 (put 'linefeed 'ascii-character ?\n)
1083 (put 'clear 'ascii-character ?\C-l)
1084 (put 'return 'ascii-character ?\C-m)
1085 (put 'escape 'ascii-character ?\e)
1086
1087 \f
1088 ;;;; Keysyms
1089
1090 ;; Define constant values to be set to mac-keyboard-text-encoding
1091 (defconst kTextEncodingMacRoman 0)
1092 (defconst kTextEncodingISOLatin1 513 "0x201")
1093 (defconst kTextEncodingISOLatin2 514 "0x202")
1094
1095 \f
1096 ;;;; Selections and cut buffers
1097
1098 ;; Setup to use the Mac clipboard. The functions mac-cut-function and
1099 ;; mac-paste-function are defined in mac.c.
1100 (set-selection-coding-system 'compound-text-mac)
1101
1102 (setq interprogram-cut-function
1103 '(lambda (str push)
1104 (mac-cut-function
1105 (encode-coding-string str selection-coding-system t) push)))
1106
1107 (setq interprogram-paste-function
1108 '(lambda ()
1109 (let ((clipboard (mac-paste-function)))
1110 (if clipboard
1111 (decode-coding-string clipboard selection-coding-system t)))))
1112
1113 \f
1114 ;;; Do the actual Windows setup here; the above code just defines
1115 ;;; functions and variables that we use now.
1116
1117 (setq command-line-args (x-handle-args command-line-args))
1118
1119 ;;; Make sure we have a valid resource name.
1120 (or (stringp x-resource-name)
1121 (let (i)
1122 (setq x-resource-name (invocation-name))
1123
1124 ;; Change any . or * characters in x-resource-name to hyphens,
1125 ;; so as not to choke when we use it in X resource queries.
1126 (while (setq i (string-match "[.*]" x-resource-name))
1127 (aset x-resource-name i ?-))))
1128
1129 (if (x-display-list)
1130 ;; On Mac OS 8/9, Most coding systems used in code conversion for
1131 ;; font names are not ready at the time when the terminal frame is
1132 ;; created. So we reconstruct font name table for the initial
1133 ;; frame.
1134 (mac-clear-font-name-table)
1135 (x-open-connection "Mac"
1136 x-command-line-resources
1137 ;; Exit Emacs with fatal error if this fails.
1138 t))
1139
1140 (setq frame-creation-function 'x-create-frame-with-faces)
1141
1142 (define-ccl-program ccl-encode-mac-roman-font
1143 `(0
1144 (if (r0 != ,(charset-id 'ascii))
1145 (if (r0 <= ?\x8f)
1146 (translate-character mac-roman-encoder r0 r1)
1147 ((r1 <<= 7)
1148 (r1 |= r2)
1149 (translate-character mac-roman-encoder r0 r1)))))
1150 "CCL program for Mac Roman font")
1151
1152 (let
1153 ((encoding-vector (make-vector 256 nil))
1154 (i 0)
1155 (vec ;; mac-centraleurroman (128..255) -> UCS mapping
1156 [ #x00C4 ;; 128:LATIN CAPITAL LETTER A WITH DIAERESIS
1157 #x0100 ;; 129:LATIN CAPITAL LETTER A WITH MACRON
1158 #x0101 ;; 130:LATIN SMALL LETTER A WITH MACRON
1159 #x00C9 ;; 131:LATIN CAPITAL LETTER E WITH ACUTE
1160 #x0104 ;; 132:LATIN CAPITAL LETTER A WITH OGONEK
1161 #x00D6 ;; 133:LATIN CAPITAL LETTER O WITH DIAERESIS
1162 #x00DC ;; 134:LATIN CAPITAL LETTER U WITH DIAERESIS
1163 #x00E1 ;; 135:LATIN SMALL LETTER A WITH ACUTE
1164 #x0105 ;; 136:LATIN SMALL LETTER A WITH OGONEK
1165 #x010C ;; 137:LATIN CAPITAL LETTER C WITH CARON
1166 #x00E4 ;; 138:LATIN SMALL LETTER A WITH DIAERESIS
1167 #x010D ;; 139:LATIN SMALL LETTER C WITH CARON
1168 #x0106 ;; 140:LATIN CAPITAL LETTER C WITH ACUTE
1169 #x0107 ;; 141:LATIN SMALL LETTER C WITH ACUTE
1170 #x00E9 ;; 142:LATIN SMALL LETTER E WITH ACUTE
1171 #x0179 ;; 143:LATIN CAPITAL LETTER Z WITH ACUTE
1172 #x017A ;; 144:LATIN SMALL LETTER Z WITH ACUTE
1173 #x010E ;; 145:LATIN CAPITAL LETTER D WITH CARON
1174 #x00ED ;; 146:LATIN SMALL LETTER I WITH ACUTE
1175 #x010F ;; 147:LATIN SMALL LETTER D WITH CARON
1176 #x0112 ;; 148:LATIN CAPITAL LETTER E WITH MACRON
1177 #x0113 ;; 149:LATIN SMALL LETTER E WITH MACRON
1178 #x0116 ;; 150:LATIN CAPITAL LETTER E WITH DOT ABOVE
1179 #x00F3 ;; 151:LATIN SMALL LETTER O WITH ACUTE
1180 #x0117 ;; 152:LATIN SMALL LETTER E WITH DOT ABOVE
1181 #x00F4 ;; 153:LATIN SMALL LETTER O WITH CIRCUMFLEX
1182 #x00F6 ;; 154:LATIN SMALL LETTER O WITH DIAERESIS
1183 #x00F5 ;; 155:LATIN SMALL LETTER O WITH TILDE
1184 #x00FA ;; 156:LATIN SMALL LETTER U WITH ACUTE
1185 #x011A ;; 157:LATIN CAPITAL LETTER E WITH CARON
1186 #x011B ;; 158:LATIN SMALL LETTER E WITH CARON
1187 #x00FC ;; 159:LATIN SMALL LETTER U WITH DIAERESIS
1188 #x2020 ;; 160:DAGGER
1189 #x00B0 ;; 161:DEGREE SIGN
1190 #x0118 ;; 162:LATIN CAPITAL LETTER E WITH OGONEK
1191 #x00A3 ;; 163:POUND SIGN
1192 #x00A7 ;; 164:SECTION SIGN
1193 #x2022 ;; 165:BULLET
1194 #x00B6 ;; 166:PILCROW SIGN
1195 #x00DF ;; 167:LATIN SMALL LETTER SHARP S
1196 #x00AE ;; 168:REGISTERED SIGN
1197 #x00A9 ;; 169:COPYRIGHT SIGN
1198 #x2122 ;; 170:TRADE MARK SIGN
1199 #x0119 ;; 171:LATIN SMALL LETTER E WITH OGONEK
1200 #x00A8 ;; 172:DIAERESIS
1201 #x2260 ;; 173:NOT EQUAL TO
1202 #x0123 ;; 174:LATIN SMALL LETTER G WITH CEDILLA
1203 #x012E ;; 175:LATIN CAPITAL LETTER I WITH OGONEK
1204 #x012F ;; 176:LATIN SMALL LETTER I WITH OGONEK
1205 #x012A ;; 177:LATIN CAPITAL LETTER I WITH MACRON
1206 #x2264 ;; 178:LESS-THAN OR EQUAL TO
1207 #x2265 ;; 179:GREATER-THAN OR EQUAL TO
1208 #x012B ;; 180:LATIN SMALL LETTER I WITH MACRON
1209 #x0136 ;; 181:LATIN CAPITAL LETTER K WITH CEDILLA
1210 #x2202 ;; 182:PARTIAL DIFFERENTIAL
1211 #x2211 ;; 183:N-ARY SUMMATION
1212 #x0142 ;; 184:LATIN SMALL LETTER L WITH STROKE
1213 #x013B ;; 185:LATIN CAPITAL LETTER L WITH CEDILLA
1214 #x013C ;; 186:LATIN SMALL LETTER L WITH CEDILLA
1215 #x013D ;; 187:LATIN CAPITAL LETTER L WITH CARON
1216 #x013E ;; 188:LATIN SMALL LETTER L WITH CARON
1217 #x0139 ;; 189:LATIN CAPITAL LETTER L WITH ACUTE
1218 #x013A ;; 190:LATIN SMALL LETTER L WITH ACUTE
1219 #x0145 ;; 191:LATIN CAPITAL LETTER N WITH CEDILLA
1220 #x0146 ;; 192:LATIN SMALL LETTER N WITH CEDILLA
1221 #x0143 ;; 193:LATIN CAPITAL LETTER N WITH ACUTE
1222 #x00AC ;; 194:NOT SIGN
1223 #x221A ;; 195:SQUARE ROOT
1224 #x0144 ;; 196:LATIN SMALL LETTER N WITH ACUTE
1225 #x0147 ;; 197:LATIN CAPITAL LETTER N WITH CARON
1226 #x2206 ;; 198:INCREMENT
1227 #x00AB ;; 199:LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
1228 #x00BB ;; 200:RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
1229 #x2026 ;; 201:HORIZONTAL ELLIPSIS
1230 #x00A0 ;; 202:NO-BREAK SPACE
1231 #x0148 ;; 203:LATIN SMALL LETTER N WITH CARON
1232 #x0150 ;; 204:LATIN CAPITAL LETTER O WITH DOUBLE ACUTE
1233 #x00D5 ;; 205:LATIN CAPITAL LETTER O WITH TILDE
1234 #x0151 ;; 206:LATIN SMALL LETTER O WITH DOUBLE ACUTE
1235 #x014C ;; 207:LATIN CAPITAL LETTER O WITH MACRON
1236 #x2013 ;; 208:EN DASH
1237 #x2014 ;; 209:EM DASH
1238 #x201C ;; 210:LEFT DOUBLE QUOTATION MARK
1239 #x201D ;; 211:RIGHT DOUBLE QUOTATION MARK
1240 #x2018 ;; 212:LEFT SINGLE QUOTATION MARK
1241 #x2019 ;; 213:RIGHT SINGLE QUOTATION MARK
1242 #x00F7 ;; 214:DIVISION SIGN
1243 #x25CA ;; 215:LOZENGE
1244 #x014D ;; 216:LATIN SMALL LETTER O WITH MACRON
1245 #x0154 ;; 217:LATIN CAPITAL LETTER R WITH ACUTE
1246 #x0155 ;; 218:LATIN SMALL LETTER R WITH ACUTE
1247 #x0158 ;; 219:LATIN CAPITAL LETTER R WITH CARON
1248 #x2039 ;; 220:SINGLE LEFT-POINTING ANGLE QUOTATION MARK
1249 #x203A ;; 221:SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
1250 #x0159 ;; 222:LATIN SMALL LETTER R WITH CARON
1251 #x0156 ;; 223:LATIN CAPITAL LETTER R WITH CEDILLA
1252 #x0157 ;; 224:LATIN SMALL LETTER R WITH CEDILLA
1253 #x0160 ;; 225:LATIN CAPITAL LETTER S WITH CARON
1254 #x201A ;; 226:SINGLE LOW-9 QUOTATION MARK
1255 #x201E ;; 227:DOUBLE LOW-9 QUOTATION MARK
1256 #x0161 ;; 228:LATIN SMALL LETTER S WITH CARON
1257 #x015A ;; 229:LATIN CAPITAL LETTER S WITH ACUTE
1258 #x015B ;; 230:LATIN SMALL LETTER S WITH ACUTE
1259 #x00C1 ;; 231:LATIN CAPITAL LETTER A WITH ACUTE
1260 #x0164 ;; 232:LATIN CAPITAL LETTER T WITH CARON
1261 #x0165 ;; 233:LATIN SMALL LETTER T WITH CARON
1262 #x00CD ;; 234:LATIN CAPITAL LETTER I WITH ACUTE
1263 #x017D ;; 235:LATIN CAPITAL LETTER Z WITH CARON
1264 #x017E ;; 236:LATIN SMALL LETTER Z WITH CARON
1265 #x016A ;; 237:LATIN CAPITAL LETTER U WITH MACRON
1266 #x00D3 ;; 238:LATIN CAPITAL LETTER O WITH ACUTE
1267 #x00D4 ;; 239:LATIN CAPITAL LETTER O WITH CIRCUMFLEX
1268 #x016B ;; 240:LATIN SMALL LETTER U WITH MACRON
1269 #x016E ;; 241:LATIN CAPITAL LETTER U WITH RING ABOVE
1270 #x00DA ;; 242:LATIN CAPITAL LETTER U WITH ACUTE
1271 #x016F ;; 243:LATIN SMALL LETTER U WITH RING ABOVE
1272 #x0170 ;; 244:LATIN CAPITAL LETTER U WITH DOUBLE ACUTE
1273 #x0171 ;; 245:LATIN SMALL LETTER U WITH DOUBLE ACUTE
1274 #x0172 ;; 246:LATIN CAPITAL LETTER U WITH OGONEK
1275 #x0173 ;; 247:LATIN SMALL LETTER U WITH OGONEK
1276 #x00DD ;; 248:LATIN CAPITAL LETTER Y WITH ACUTE
1277 #x00FD ;; 249:LATIN SMALL LETTER Y WITH ACUTE
1278 #x0137 ;; 250:LATIN SMALL LETTER K WITH CEDILLA
1279 #x017B ;; 251:LATIN CAPITAL LETTER Z WITH DOT ABOVE
1280 #x0141 ;; 252:LATIN CAPITAL LETTER L WITH STROKE
1281 #x017C ;; 253:LATIN SMALL LETTER Z WITH DOT ABOVE
1282 #x0122 ;; 254:LATIN CAPITAL LETTER G WITH CEDILLA
1283 #x02C7 ;; 255:CARON
1284 ])
1285 translation-table)
1286 (while (< i 128)
1287 (aset encoding-vector i i)
1288 (setq i (1+ i)))
1289 (while (< i 256)
1290 (aset encoding-vector i
1291 (decode-char 'ucs (aref vec (- i 128))))
1292 (setq i (1+ i)))
1293 (setq translation-table
1294 (make-translation-table-from-vector encoding-vector))
1295 ;; (define-translation-table 'mac-centraleurroman-decoder translation-table)
1296 (define-translation-table 'mac-centraleurroman-encoder
1297 (char-table-extra-slot translation-table 0)))
1298
1299 (let
1300 ((encoding-vector (make-vector 256 nil))
1301 (i 0)
1302 (vec ;; mac-cyrillic (128..255) -> UCS mapping
1303 [ #x0410 ;; 128:CYRILLIC CAPITAL LETTER A
1304 #x0411 ;; 129:CYRILLIC CAPITAL LETTER BE
1305 #x0412 ;; 130:CYRILLIC CAPITAL LETTER VE
1306 #x0413 ;; 131:CYRILLIC CAPITAL LETTER GHE
1307 #x0414 ;; 132:CYRILLIC CAPITAL LETTER DE
1308 #x0415 ;; 133:CYRILLIC CAPITAL LETTER IE
1309 #x0416 ;; 134:CYRILLIC CAPITAL LETTER ZHE
1310 #x0417 ;; 135:CYRILLIC CAPITAL LETTER ZE
1311 #x0418 ;; 136:CYRILLIC CAPITAL LETTER I
1312 #x0419 ;; 137:CYRILLIC CAPITAL LETTER SHORT I
1313 #x041A ;; 138:CYRILLIC CAPITAL LETTER KA
1314 #x041B ;; 139:CYRILLIC CAPITAL LETTER EL
1315 #x041C ;; 140:CYRILLIC CAPITAL LETTER EM
1316 #x041D ;; 141:CYRILLIC CAPITAL LETTER EN
1317 #x041E ;; 142:CYRILLIC CAPITAL LETTER O
1318 #x041F ;; 143:CYRILLIC CAPITAL LETTER PE
1319 #x0420 ;; 144:CYRILLIC CAPITAL LETTER ER
1320 #x0421 ;; 145:CYRILLIC CAPITAL LETTER ES
1321 #x0422 ;; 146:CYRILLIC CAPITAL LETTER TE
1322 #x0423 ;; 147:CYRILLIC CAPITAL LETTER U
1323 #x0424 ;; 148:CYRILLIC CAPITAL LETTER EF
1324 #x0425 ;; 149:CYRILLIC CAPITAL LETTER HA
1325 #x0426 ;; 150:CYRILLIC CAPITAL LETTER TSE
1326 #x0427 ;; 151:CYRILLIC CAPITAL LETTER CHE
1327 #x0428 ;; 152:CYRILLIC CAPITAL LETTER SHA
1328 #x0429 ;; 153:CYRILLIC CAPITAL LETTER SHCHA
1329 #x042A ;; 154:CYRILLIC CAPITAL LETTER HARD SIGN
1330 #x042B ;; 155:CYRILLIC CAPITAL LETTER YERU
1331 #x042C ;; 156:CYRILLIC CAPITAL LETTER SOFT SIGN
1332 #x042D ;; 157:CYRILLIC CAPITAL LETTER E
1333 #x042E ;; 158:CYRILLIC CAPITAL LETTER YU
1334 #x042F ;; 159:CYRILLIC CAPITAL LETTER YA
1335 #x2020 ;; 160:DAGGER
1336 #x00B0 ;; 161:DEGREE SIGN
1337 #x0490 ;; 162:CYRILLIC CAPITAL LETTER GHE WITH UPTURN
1338 #x00A3 ;; 163:POUND SIGN
1339 #x00A7 ;; 164:SECTION SIGN
1340 #x2022 ;; 165:BULLET
1341 #x00B6 ;; 166:PILCROW SIGN
1342 #x0406 ;; 167:CYRILLIC CAPITAL LETTER BYELORUSSIAN-UKRAINIAN I
1343 #x00AE ;; 168:REGISTERED SIGN
1344 #x00A9 ;; 169:COPYRIGHT SIGN
1345 #x2122 ;; 170:TRADE MARK SIGN
1346 #x0402 ;; 171:CYRILLIC CAPITAL LETTER DJE
1347 #x0452 ;; 172:CYRILLIC SMALL LETTER DJE
1348 #x2260 ;; 173:NOT EQUAL TO
1349 #x0403 ;; 174:CYRILLIC CAPITAL LETTER GJE
1350 #x0453 ;; 175:CYRILLIC SMALL LETTER GJE
1351 #x221E ;; 176:INFINITY
1352 #x00B1 ;; 177:PLUS-MINUS SIGN
1353 #x2264 ;; 178:LESS-THAN OR EQUAL TO
1354 #x2265 ;; 179:GREATER-THAN OR EQUAL TO
1355 #x0456 ;; 180:CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN I
1356 #x00B5 ;; 181:MICRO SIGN
1357 #x0491 ;; 182:CYRILLIC SMALL LETTER GHE WITH UPTURN
1358 #x0408 ;; 183:CYRILLIC CAPITAL LETTER JE
1359 #x0404 ;; 184:CYRILLIC CAPITAL LETTER UKRAINIAN IE
1360 #x0454 ;; 185:CYRILLIC SMALL LETTER UKRAINIAN IE
1361 #x0407 ;; 186:CYRILLIC CAPITAL LETTER YI
1362 #x0457 ;; 187:CYRILLIC SMALL LETTER YI
1363 #x0409 ;; 188:CYRILLIC CAPITAL LETTER LJE
1364 #x0459 ;; 189:CYRILLIC SMALL LETTER LJE
1365 #x040A ;; 190:CYRILLIC CAPITAL LETTER NJE
1366 #x045A ;; 191:CYRILLIC SMALL LETTER NJE
1367 #x0458 ;; 192:CYRILLIC SMALL LETTER JE
1368 #x0405 ;; 193:CYRILLIC CAPITAL LETTER DZE
1369 #x00AC ;; 194:NOT SIGN
1370 #x221A ;; 195:SQUARE ROOT
1371 #x0192 ;; 196:LATIN SMALL LETTER F WITH HOOK
1372 #x2248 ;; 197:ALMOST EQUAL TO
1373 #x2206 ;; 198:INCREMENT
1374 #x00AB ;; 199:LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
1375 #x00BB ;; 200:RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
1376 #x2026 ;; 201:HORIZONTAL ELLIPSIS
1377 #x00A0 ;; 202:NO-BREAK SPACE
1378 #x040B ;; 203:CYRILLIC CAPITAL LETTER TSHE
1379 #x045B ;; 204:CYRILLIC SMALL LETTER TSHE
1380 #x040C ;; 205:CYRILLIC CAPITAL LETTER KJE
1381 #x045C ;; 206:CYRILLIC SMALL LETTER KJE
1382 #x0455 ;; 207:CYRILLIC SMALL LETTER DZE
1383 #x2013 ;; 208:EN DASH
1384 #x2014 ;; 209:EM DASH
1385 #x201C ;; 210:LEFT DOUBLE QUOTATION MARK
1386 #x201D ;; 211:RIGHT DOUBLE QUOTATION MARK
1387 #x2018 ;; 212:LEFT SINGLE QUOTATION MARK
1388 #x2019 ;; 213:RIGHT SINGLE QUOTATION MARK
1389 #x00F7 ;; 214:DIVISION SIGN
1390 #x201E ;; 215:DOUBLE LOW-9 QUOTATION MARK
1391 #x040E ;; 216:CYRILLIC CAPITAL LETTER SHORT U
1392 #x045E ;; 217:CYRILLIC SMALL LETTER SHORT U
1393 #x040F ;; 218:CYRILLIC CAPITAL LETTER DZHE
1394 #x045F ;; 219:CYRILLIC SMALL LETTER DZHE
1395 #x2116 ;; 220:NUMERO SIGN
1396 #x0401 ;; 221:CYRILLIC CAPITAL LETTER IO
1397 #x0451 ;; 222:CYRILLIC SMALL LETTER IO
1398 #x044F ;; 223:CYRILLIC SMALL LETTER YA
1399 #x0430 ;; 224:CYRILLIC SMALL LETTER A
1400 #x0431 ;; 225:CYRILLIC SMALL LETTER BE
1401 #x0432 ;; 226:CYRILLIC SMALL LETTER VE
1402 #x0433 ;; 227:CYRILLIC SMALL LETTER GHE
1403 #x0434 ;; 228:CYRILLIC SMALL LETTER DE
1404 #x0435 ;; 229:CYRILLIC SMALL LETTER IE
1405 #x0436 ;; 230:CYRILLIC SMALL LETTER ZHE
1406 #x0437 ;; 231:CYRILLIC SMALL LETTER ZE
1407 #x0438 ;; 232:CYRILLIC SMALL LETTER I
1408 #x0439 ;; 233:CYRILLIC SMALL LETTER SHORT I
1409 #x043A ;; 234:CYRILLIC SMALL LETTER KA
1410 #x043B ;; 235:CYRILLIC SMALL LETTER EL
1411 #x043C ;; 236:CYRILLIC SMALL LETTER EM
1412 #x043D ;; 237:CYRILLIC SMALL LETTER EN
1413 #x043E ;; 238:CYRILLIC SMALL LETTER O
1414 #x043F ;; 239:CYRILLIC SMALL LETTER PE
1415 #x0440 ;; 240:CYRILLIC SMALL LETTER ER
1416 #x0441 ;; 241:CYRILLIC SMALL LETTER ES
1417 #x0442 ;; 242:CYRILLIC SMALL LETTER TE
1418 #x0443 ;; 243:CYRILLIC SMALL LETTER U
1419 #x0444 ;; 244:CYRILLIC SMALL LETTER EF
1420 #x0445 ;; 245:CYRILLIC SMALL LETTER HA
1421 #x0446 ;; 246:CYRILLIC SMALL LETTER TSE
1422 #x0447 ;; 247:CYRILLIC SMALL LETTER CHE
1423 #x0448 ;; 248:CYRILLIC SMALL LETTER SHA
1424 #x0449 ;; 249:CYRILLIC SMALL LETTER SHCHA
1425 #x044A ;; 250:CYRILLIC SMALL LETTER HARD SIGN
1426 #x044B ;; 251:CYRILLIC SMALL LETTER YERU
1427 #x044C ;; 252:CYRILLIC SMALL LETTER SOFT SIGN
1428 #x044D ;; 253:CYRILLIC SMALL LETTER E
1429 #x044E ;; 254:CYRILLIC SMALL LETTER YU
1430 #x20AC ;; 255:EURO SIGN
1431 ])
1432 translation-table)
1433 (while (< i 128)
1434 (aset encoding-vector i i)
1435 (setq i (1+ i)))
1436 (while (< i 256)
1437 (aset encoding-vector i
1438 (decode-char 'ucs (aref vec (- i 128))))
1439 (setq i (1+ i)))
1440 (setq translation-table
1441 (make-translation-table-from-vector encoding-vector))
1442 ;; (define-translation-table 'mac-cyrillic-decoder translation-table)
1443 (define-translation-table 'mac-cyrillic-encoder
1444 (char-table-extra-slot translation-table 0)))
1445
1446 (defvar mac-font-encoder-list
1447 '(("mac-roman" mac-roman-encoder
1448 ccl-encode-mac-roman-font "%s")
1449 ("mac-centraleurroman" mac-centraleurroman-encoder
1450 ccl-encode-mac-centraleurroman-font "%s ce")
1451 ("mac-cyrillic" mac-cyrillic-encoder
1452 ccl-encode-mac-cyrillic-font "%s cy")))
1453
1454 (let ((encoder-list
1455 (mapcar (lambda (lst) (nth 1 lst)) mac-font-encoder-list))
1456 (charset-list
1457 '(latin-iso8859-2
1458 latin-iso8859-3 latin-iso8859-4
1459 cyrillic-iso8859-5 greek-iso8859-7 hebrew-iso8859-8
1460 latin-iso8859-9 latin-iso8859-14 latin-iso8859-15)))
1461 (dolist (encoder encoder-list)
1462 (let ((table (get encoder 'translation-table)))
1463 (dolist (charset charset-list)
1464 (dotimes (i 96)
1465 (let* ((c (make-char charset (+ i 32)))
1466 (mu (aref ucs-mule-to-mule-unicode c))
1467 (mac-encoded (and mu (aref table mu))))
1468 (if mac-encoded
1469 (aset table c mac-encoded))))))))
1470
1471 (define-ccl-program ccl-encode-mac-centraleurroman-font
1472 `(0
1473 (if (r0 != ,(charset-id 'ascii))
1474 (if (r0 <= ?\x8f)
1475 (translate-character mac-centraleurroman-encoder r0 r1)
1476 ((r1 <<= 7)
1477 (r1 |= r2)
1478 (translate-character mac-centraleurroman-encoder r0 r1)))))
1479 "CCL program for Mac Central European Roman font")
1480
1481 (define-ccl-program ccl-encode-mac-cyrillic-font
1482 `(0
1483 (if (r0 != ,(charset-id 'ascii))
1484 (if (r0 <= ?\x8f)
1485 (translate-character mac-cyrillic-encoder r0 r1)
1486 ((r1 <<= 7)
1487 (r1 |= r2)
1488 (translate-character mac-cyrillic-encoder r0 r1)))))
1489 "CCL program for Mac Cyrillic font")
1490
1491
1492 (setq font-ccl-encoder-alist
1493 (nconc
1494 (mapcar (lambda (lst) (cons (nth 0 lst) (nth 2 lst)))
1495 mac-font-encoder-list)
1496 font-ccl-encoder-alist))
1497
1498 (defun fontset-add-mac-fonts (fontset &optional base-family)
1499 (if base-family
1500 (setq base-family (downcase base-family))
1501 (let ((ascii-font
1502 (downcase (x-resolve-font-name
1503 (fontset-font fontset (charset-id 'ascii))))))
1504 (setq base-family (aref (x-decompose-font-name ascii-font)
1505 xlfd-regexp-family-subnum))))
1506 ;; (if (not (string-match "^fontset-" fontset))
1507 ;; (setq fontset
1508 ;; (concat "fontset-" (aref (x-decompose-font-name fontset)
1509 ;; xlfd-regexp-encoding-subnum))))
1510 (dolist
1511 (font-encoder
1512 (nreverse
1513 (mapcar (lambda (lst)
1514 (cons (cons (format (nth 3 lst) base-family) (nth 0 lst))
1515 (nth 1 lst)))
1516 mac-font-encoder-list)))
1517 (let ((font (car font-encoder))
1518 (encoder (cdr font-encoder)))
1519 (map-char-table
1520 (lambda (key val)
1521 (or (null val)
1522 (generic-char-p key)
1523 (memq (char-charset key)
1524 '(ascii eight-bit-control eight-bit-graphic))
1525 (set-fontset-font fontset key font)))
1526 (get encoder 'translation-table)))))
1527
1528 (defun create-fontset-from-mac-roman-font (font &optional resolved-font
1529 fontset-name)
1530 "Create a fontset from a Mac roman font FONT.
1531
1532 Optional 1st arg RESOLVED-FONT is a resolved name of FONT. If
1533 omitted, `x-resolve-font-name' is called to get the resolved name. At
1534 this time, if FONT is not available, error is signaled.
1535
1536 Optional 2nd arg FONTSET-NAME is a string to be used in
1537 `<CHARSET_ENCODING>' fields of a new fontset name. If it is omitted,
1538 an appropriate name is generated automatically.
1539
1540 It returns a name of the created fontset."
1541 (let ((fontset
1542 (create-fontset-from-ascii-font font resolved-font fontset-name)))
1543 (fontset-add-mac-fonts fontset)
1544 fontset))
1545
1546 ;; Setup the default fontset.
1547 (setup-default-fontset)
1548
1549 ;; Create a fontset that uses mac-roman font. With this fontset,
1550 ;; characters decoded from mac-roman encoding (ascii, latin-iso8859-1,
1551 ;; and mule-unicode-xxxx-yyyy) are displayed by a mac-roman font.
1552 (create-fontset-from-fontset-spec
1553 "-etl-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-mac,
1554 ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman")
1555 (fontset-add-mac-fonts "fontset-mac")
1556
1557 ;; Create fontset specified in X resources "Fontset-N" (N is 0, 1, ...).
1558 (create-fontset-from-x-resource)
1559
1560 ;; Try to create a fontset from a font specification which comes
1561 ;; from initial-frame-alist, default-frame-alist, or X resource.
1562 ;; A font specification in command line argument (i.e. -fn XXXX)
1563 ;; should be already in default-frame-alist as a `font'
1564 ;; parameter. However, any font specifications in site-start
1565 ;; library, user's init file (.emacs), and default.el are not
1566 ;; yet handled here.
1567
1568 (let ((font (or (cdr (assq 'font initial-frame-alist))
1569 (cdr (assq 'font default-frame-alist))
1570 (x-get-resource "font" "Font")))
1571 xlfd-fields resolved-name)
1572 (if (and font
1573 (not (query-fontset font))
1574 (setq resolved-name (x-resolve-font-name font))
1575 (setq xlfd-fields (x-decompose-font-name font)))
1576 (if (string= "fontset" (aref xlfd-fields xlfd-regexp-registry-subnum))
1577 (new-fontset font (x-complement-fontset-spec xlfd-fields nil))
1578 ;; Create a fontset from FONT. The fontset name is
1579 ;; generated from FONT.
1580 (if (and (string= "mac" (aref xlfd-fields xlfd-regexp-registry-subnum))
1581 (string= "roman" (aref xlfd-fields xlfd-regexp-encoding-subnum)))
1582 (create-fontset-from-mac-roman-font font resolved-name "startup")
1583 (create-fontset-from-ascii-font font resolved-name "startup")))))
1584
1585 ;; Apply a geometry resource to the initial frame. Put it at the end
1586 ;; of the alist, so that anything specified on the command line takes
1587 ;; precedence.
1588 (let* ((res-geometry (x-get-resource "geometry" "Geometry"))
1589 parsed)
1590 (if res-geometry
1591 (progn
1592 (setq parsed (x-parse-geometry res-geometry))
1593 ;; If the resource specifies a position,
1594 ;; call the position and size "user-specified".
1595 (if (or (assq 'top parsed) (assq 'left parsed))
1596 (setq parsed (cons '(user-position . t)
1597 (cons '(user-size . t) parsed))))
1598 ;; All geometry parms apply to the initial frame.
1599 (setq initial-frame-alist (append initial-frame-alist parsed))
1600 ;; The size parms apply to all frames.
1601 (if (assq 'height parsed)
1602 (setq default-frame-alist
1603 (cons (cons 'height (cdr (assq 'height parsed)))
1604 default-frame-alist)))
1605 (if (assq 'width parsed)
1606 (setq default-frame-alist
1607 (cons (cons 'width (cdr (assq 'width parsed)))
1608 default-frame-alist))))))
1609
1610 ;; Check the reverseVideo resource.
1611 (let ((case-fold-search t))
1612 (let ((rv (x-get-resource "reverseVideo" "ReverseVideo")))
1613 (if (and rv
1614 (string-match "^\\(true\\|yes\\|on\\)$" rv))
1615 (setq default-frame-alist
1616 (cons '(reverse . t) default-frame-alist)))))
1617
1618 (defun x-win-suspend-error ()
1619 (error "Suspending an Emacs running under Mac makes no sense"))
1620 (add-hook 'suspend-hook 'x-win-suspend-error)
1621
1622 ;; Don't show the frame name; that's redundant.
1623 (setq-default mode-line-frame-identification " ")
1624
1625 ;; Turn on support for mouse wheels.
1626 (mouse-wheel-mode 1)
1627
1628 (defun mac-drag-n-drop (event)
1629 "Edit the files listed in the drag-n-drop EVENT.
1630 Switch to a buffer editing the last file dropped."
1631 (interactive "e")
1632 ;; Make sure the drop target has positive co-ords
1633 ;; before setting the selected frame - otherwise it
1634 ;; won't work. <skx@tardis.ed.ac.uk>
1635 (let* ((window (posn-window (event-start event)))
1636 (coords (posn-x-y (event-start event)))
1637 (x (car coords))
1638 (y (cdr coords)))
1639 (if (and (> x 0) (> y 0))
1640 (set-frame-selected-window nil window))
1641 (mapcar (lambda (file-name)
1642 (if (listp file-name)
1643 (let ((line (car file-name))
1644 (start (car (cdr file-name)))
1645 (end (car (cdr (cdr file-name)))))
1646 (if (> line 0)
1647 (goto-line line)
1648 (if (and (> start 0) (> end 0))
1649 (progn (set-mark start)
1650 (goto-char end)))))
1651 (x-dnd-handle-one-url window 'private
1652 (concat "file:" file-name))))
1653 (car (cdr (cdr event)))))
1654 (raise-frame))
1655
1656 (global-set-key [drag-n-drop] 'mac-drag-n-drop)
1657
1658 ;; By checking whether the variable mac-ready-for-drag-n-drop has been
1659 ;; defined, the event loop in macterm.c can be informed that it can
1660 ;; now receive Finder drag and drop events. Files dropped onto the
1661 ;; Emacs application icon can only be processed when the initial frame
1662 ;; has been created: this is where the files should be opened.
1663 (add-hook 'after-init-hook
1664 '(lambda ()
1665 (defvar mac-ready-for-drag-n-drop t)))
1666 \f
1667 ;;;; Scroll bars
1668
1669 ;; for debugging
1670 ;; (defun mac-handle-scroll-bar-event (event) (interactive "e") (princ event))
1671
1672 ;;(global-set-key [vertical-scroll-bar mouse-1] 'mac-handle-scroll-bar-event)
1673
1674 (global-set-key
1675 [vertical-scroll-bar down-mouse-1]
1676 'mac-handle-scroll-bar-event)
1677
1678 (global-unset-key [vertical-scroll-bar drag-mouse-1])
1679 (global-unset-key [vertical-scroll-bar mouse-1])
1680
1681 (defun mac-handle-scroll-bar-event (event)
1682 "Handle scroll bar EVENT to emulate Mac Toolbox style scrolling."
1683 (interactive "e")
1684 (let* ((position (event-start event))
1685 (window (nth 0 position))
1686 (bar-part (nth 4 position)))
1687 (select-window window)
1688 (cond
1689 ((eq bar-part 'up)
1690 (goto-char (window-start window))
1691 (mac-scroll-down-line))
1692 ((eq bar-part 'above-handle)
1693 (mac-scroll-down))
1694 ((eq bar-part 'handle)
1695 (scroll-bar-drag event))
1696 ((eq bar-part 'below-handle)
1697 (mac-scroll-up))
1698 ((eq bar-part 'down)
1699 (goto-char (window-start window))
1700 (mac-scroll-up-line)))))
1701
1702 (defun mac-scroll-ignore-events ()
1703 ;; Ignore confusing non-mouse events
1704 (while (not (memq (car-safe (read-event))
1705 '(mouse-1 double-mouse-1 triple-mouse-1))) nil))
1706
1707 (defun mac-scroll-down ()
1708 (track-mouse
1709 (mac-scroll-ignore-events)
1710 (scroll-down)))
1711
1712 (defun mac-scroll-down-line ()
1713 (track-mouse
1714 (mac-scroll-ignore-events)
1715 (scroll-down 1)))
1716
1717 (defun mac-scroll-up ()
1718 (track-mouse
1719 (mac-scroll-ignore-events)
1720 (scroll-up)))
1721
1722 (defun mac-scroll-up-line ()
1723 (track-mouse
1724 (mac-scroll-ignore-events)
1725 (scroll-up 1)))
1726
1727 \f
1728 ;;;; Others
1729
1730 (unless (eq system-type 'darwin)
1731 ;; This variable specifies the Unix program to call (as a process) to
1732 ;; determine the amount of free space on a file system (defaults to
1733 ;; df). If it is not set to nil, ls-lisp will not work correctly
1734 ;; unless an external application df is implemented on the Mac.
1735 (setq directory-free-space-program nil)
1736
1737 ;; Set this so that Emacs calls subprocesses with "sh" as shell to
1738 ;; expand filenames Note no subprocess for the shell is actually
1739 ;; started (see run_mac_command in sysdep.c).
1740 (setq shell-file-name "sh")
1741
1742 ;; To display filenames in Chinese or Japanese, replace mac-roman with
1743 ;; big5 or sjis
1744 (setq file-name-coding-system 'mac-roman))
1745
1746 ;; X Window emulation in macterm.c is not complete enough to start a
1747 ;; frame without a minibuffer properly. Call this to tell ediff
1748 ;; library to use a single frame.
1749 ; (ediff-toggle-multiframe)
1750
1751 ;; If Emacs is started from the Finder, change the default directory
1752 ;; to the user's home directory.
1753 (if (string= default-directory "/")
1754 (cd "~"))
1755
1756 ;; Darwin 6- pty breakage is now controlled from the C code so that
1757 ;; it applies to all builds on darwin. See s/darwin.h PTY_ITERATION.
1758 ;; (setq process-connection-type t)
1759
1760 ;; Assume that fonts are always scalable on the Mac. This sometimes
1761 ;; results in characters with jagged edges. However, without it,
1762 ;; fonts with both truetype and bitmap representations but no italic
1763 ;; or bold bitmap versions will not display these variants correctly.
1764 (setq scalable-fonts-allowed t)
1765
1766 ;; (prefer-coding-system 'mac-roman)
1767
1768 ;; arch-tag: 71dfcd14-cde8-4d66-b05c-85ec94fb23a6
1769 ;;; mac-win.el ends here