]> code.delx.au - gnu-emacs/blob - lisp/term/mac-win.el
delx.au / code / gnu-emacs / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
Don't set file-name-coding-system. Decode variables system-name,
[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 '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 ;;;; Script codes and coding systems
1089 (defconst mac-script-code-coding-systems
1090 '((0 . mac-roman) ; smRoman
1091 (1 . japanese-shift-jis) ; smJapanese
1092 (2 . chinese-big5) ; smTradChinese
1093 (3 . korean-iso-8bit) ; smKorean
1094 (7 . mac-cyrillic) ; smCyrillic
1095 (25 . chinese-iso-8bit) ; smSimpChinese
1096 (29 . mac-centraleurroman) ; smCentralEuroRoman
1097 )
1098 "Alist of Mac script codes vs Emacs coding systems.")
1099
1100 (defconst mac-system-coding-system
1101 (let ((base (or (cdr (assq mac-system-script-code
1102 mac-script-code-coding-systems))
1103 'mac-roman)))
1104 (if (eq system-type 'darwin)
1105 base
1106 (coding-system-change-eol-conversion base 'mac)))
1107 "Coding system derived from the system script code.")
1108 \f
1109 ;;;; Keyboard layout/language change events
1110 (defun mac-handle-language-change (event)
1111 (interactive "e")
1112 (let ((coding-system
1113 (cdr (assq (car (cadr event)) mac-script-code-coding-systems))))
1114 (set-keyboard-coding-system (or coding-system 'mac-roman))
1115 ;; MacJapanese maps reverse solidus to ?\x80.
1116 (if (eq coding-system 'japanese-shift-jis)
1117 (define-key key-translation-map [?\x80] "\\"))))
1118
1119 (define-key special-event-map [language-change] 'mac-handle-language-change)
1120 \f
1121 ;;;; Selections and cut buffers
1122
1123 ;; Setup to use the Mac clipboard. The functions mac-cut-function and
1124 ;; mac-paste-function are defined in mac.c.
1125 (set-selection-coding-system 'compound-text-mac)
1126
1127 (setq interprogram-cut-function
1128 '(lambda (str push)
1129 (mac-cut-function
1130 (encode-coding-string str selection-coding-system t) push)))
1131
1132 (setq interprogram-paste-function
1133 '(lambda ()
1134 (let ((clipboard (mac-paste-function)))
1135 (if clipboard
1136 (decode-coding-string clipboard selection-coding-system t)))))
1137
1138 \f
1139 ;;; Do the actual Windows setup here; the above code just defines
1140 ;;; functions and variables that we use now.
1141
1142 (setq command-line-args (x-handle-args command-line-args))
1143
1144 ;;; Make sure we have a valid resource name.
1145 (or (stringp x-resource-name)
1146 (let (i)
1147 (setq x-resource-name (invocation-name))
1148
1149 ;; Change any . or * characters in x-resource-name to hyphens,
1150 ;; so as not to choke when we use it in X resource queries.
1151 (while (setq i (string-match "[.*]" x-resource-name))
1152 (aset x-resource-name i ?-))))
1153
1154 (if (x-display-list)
1155 ;; On Mac OS 8/9, Most coding systems used in code conversion for
1156 ;; font names are not ready at the time when the terminal frame is
1157 ;; created. So we reconstruct font name table for the initial
1158 ;; frame.
1159 (mac-clear-font-name-table)
1160 (x-open-connection "Mac"
1161 x-command-line-resources
1162 ;; Exit Emacs with fatal error if this fails.
1163 t))
1164
1165 (setq frame-creation-function 'x-create-frame-with-faces)
1166
1167 (cp-make-coding-system
1168 mac-centraleurroman
1169 (apply
1170 'vector
1171 (mapcar
1172 (lambda (c) (decode-char 'ucs c))
1173 ;; mac-centraleurroman (128..255) -> UCS mapping
1174 [ #x00C4 ;; 128:LATIN CAPITAL LETTER A WITH DIAERESIS
1175 #x0100 ;; 129:LATIN CAPITAL LETTER A WITH MACRON
1176 #x0101 ;; 130:LATIN SMALL LETTER A WITH MACRON
1177 #x00C9 ;; 131:LATIN CAPITAL LETTER E WITH ACUTE
1178 #x0104 ;; 132:LATIN CAPITAL LETTER A WITH OGONEK
1179 #x00D6 ;; 133:LATIN CAPITAL LETTER O WITH DIAERESIS
1180 #x00DC ;; 134:LATIN CAPITAL LETTER U WITH DIAERESIS
1181 #x00E1 ;; 135:LATIN SMALL LETTER A WITH ACUTE
1182 #x0105 ;; 136:LATIN SMALL LETTER A WITH OGONEK
1183 #x010C ;; 137:LATIN CAPITAL LETTER C WITH CARON
1184 #x00E4 ;; 138:LATIN SMALL LETTER A WITH DIAERESIS
1185 #x010D ;; 139:LATIN SMALL LETTER C WITH CARON
1186 #x0106 ;; 140:LATIN CAPITAL LETTER C WITH ACUTE
1187 #x0107 ;; 141:LATIN SMALL LETTER C WITH ACUTE
1188 #x00E9 ;; 142:LATIN SMALL LETTER E WITH ACUTE
1189 #x0179 ;; 143:LATIN CAPITAL LETTER Z WITH ACUTE
1190 #x017A ;; 144:LATIN SMALL LETTER Z WITH ACUTE
1191 #x010E ;; 145:LATIN CAPITAL LETTER D WITH CARON
1192 #x00ED ;; 146:LATIN SMALL LETTER I WITH ACUTE
1193 #x010F ;; 147:LATIN SMALL LETTER D WITH CARON
1194 #x0112 ;; 148:LATIN CAPITAL LETTER E WITH MACRON
1195 #x0113 ;; 149:LATIN SMALL LETTER E WITH MACRON
1196 #x0116 ;; 150:LATIN CAPITAL LETTER E WITH DOT ABOVE
1197 #x00F3 ;; 151:LATIN SMALL LETTER O WITH ACUTE
1198 #x0117 ;; 152:LATIN SMALL LETTER E WITH DOT ABOVE
1199 #x00F4 ;; 153:LATIN SMALL LETTER O WITH CIRCUMFLEX
1200 #x00F6 ;; 154:LATIN SMALL LETTER O WITH DIAERESIS
1201 #x00F5 ;; 155:LATIN SMALL LETTER O WITH TILDE
1202 #x00FA ;; 156:LATIN SMALL LETTER U WITH ACUTE
1203 #x011A ;; 157:LATIN CAPITAL LETTER E WITH CARON
1204 #x011B ;; 158:LATIN SMALL LETTER E WITH CARON
1205 #x00FC ;; 159:LATIN SMALL LETTER U WITH DIAERESIS
1206 #x2020 ;; 160:DAGGER
1207 #x00B0 ;; 161:DEGREE SIGN
1208 #x0118 ;; 162:LATIN CAPITAL LETTER E WITH OGONEK
1209 #x00A3 ;; 163:POUND SIGN
1210 #x00A7 ;; 164:SECTION SIGN
1211 #x2022 ;; 165:BULLET
1212 #x00B6 ;; 166:PILCROW SIGN
1213 #x00DF ;; 167:LATIN SMALL LETTER SHARP S
1214 #x00AE ;; 168:REGISTERED SIGN
1215 #x00A9 ;; 169:COPYRIGHT SIGN
1216 #x2122 ;; 170:TRADE MARK SIGN
1217 #x0119 ;; 171:LATIN SMALL LETTER E WITH OGONEK
1218 #x00A8 ;; 172:DIAERESIS
1219 #x2260 ;; 173:NOT EQUAL TO
1220 #x0123 ;; 174:LATIN SMALL LETTER G WITH CEDILLA
1221 #x012E ;; 175:LATIN CAPITAL LETTER I WITH OGONEK
1222 #x012F ;; 176:LATIN SMALL LETTER I WITH OGONEK
1223 #x012A ;; 177:LATIN CAPITAL LETTER I WITH MACRON
1224 #x2264 ;; 178:LESS-THAN OR EQUAL TO
1225 #x2265 ;; 179:GREATER-THAN OR EQUAL TO
1226 #x012B ;; 180:LATIN SMALL LETTER I WITH MACRON
1227 #x0136 ;; 181:LATIN CAPITAL LETTER K WITH CEDILLA
1228 #x2202 ;; 182:PARTIAL DIFFERENTIAL
1229 #x2211 ;; 183:N-ARY SUMMATION
1230 #x0142 ;; 184:LATIN SMALL LETTER L WITH STROKE
1231 #x013B ;; 185:LATIN CAPITAL LETTER L WITH CEDILLA
1232 #x013C ;; 186:LATIN SMALL LETTER L WITH CEDILLA
1233 #x013D ;; 187:LATIN CAPITAL LETTER L WITH CARON
1234 #x013E ;; 188:LATIN SMALL LETTER L WITH CARON
1235 #x0139 ;; 189:LATIN CAPITAL LETTER L WITH ACUTE
1236 #x013A ;; 190:LATIN SMALL LETTER L WITH ACUTE
1237 #x0145 ;; 191:LATIN CAPITAL LETTER N WITH CEDILLA
1238 #x0146 ;; 192:LATIN SMALL LETTER N WITH CEDILLA
1239 #x0143 ;; 193:LATIN CAPITAL LETTER N WITH ACUTE
1240 #x00AC ;; 194:NOT SIGN
1241 #x221A ;; 195:SQUARE ROOT
1242 #x0144 ;; 196:LATIN SMALL LETTER N WITH ACUTE
1243 #x0147 ;; 197:LATIN CAPITAL LETTER N WITH CARON
1244 #x2206 ;; 198:INCREMENT
1245 #x00AB ;; 199:LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
1246 #x00BB ;; 200:RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
1247 #x2026 ;; 201:HORIZONTAL ELLIPSIS
1248 #x00A0 ;; 202:NO-BREAK SPACE
1249 #x0148 ;; 203:LATIN SMALL LETTER N WITH CARON
1250 #x0150 ;; 204:LATIN CAPITAL LETTER O WITH DOUBLE ACUTE
1251 #x00D5 ;; 205:LATIN CAPITAL LETTER O WITH TILDE
1252 #x0151 ;; 206:LATIN SMALL LETTER O WITH DOUBLE ACUTE
1253 #x014C ;; 207:LATIN CAPITAL LETTER O WITH MACRON
1254 #x2013 ;; 208:EN DASH
1255 #x2014 ;; 209:EM DASH
1256 #x201C ;; 210:LEFT DOUBLE QUOTATION MARK
1257 #x201D ;; 211:RIGHT DOUBLE QUOTATION MARK
1258 #x2018 ;; 212:LEFT SINGLE QUOTATION MARK
1259 #x2019 ;; 213:RIGHT SINGLE QUOTATION MARK
1260 #x00F7 ;; 214:DIVISION SIGN
1261 #x25CA ;; 215:LOZENGE
1262 #x014D ;; 216:LATIN SMALL LETTER O WITH MACRON
1263 #x0154 ;; 217:LATIN CAPITAL LETTER R WITH ACUTE
1264 #x0155 ;; 218:LATIN SMALL LETTER R WITH ACUTE
1265 #x0158 ;; 219:LATIN CAPITAL LETTER R WITH CARON
1266 #x2039 ;; 220:SINGLE LEFT-POINTING ANGLE QUOTATION MARK
1267 #x203A ;; 221:SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
1268 #x0159 ;; 222:LATIN SMALL LETTER R WITH CARON
1269 #x0156 ;; 223:LATIN CAPITAL LETTER R WITH CEDILLA
1270 #x0157 ;; 224:LATIN SMALL LETTER R WITH CEDILLA
1271 #x0160 ;; 225:LATIN CAPITAL LETTER S WITH CARON
1272 #x201A ;; 226:SINGLE LOW-9 QUOTATION MARK
1273 #x201E ;; 227:DOUBLE LOW-9 QUOTATION MARK
1274 #x0161 ;; 228:LATIN SMALL LETTER S WITH CARON
1275 #x015A ;; 229:LATIN CAPITAL LETTER S WITH ACUTE
1276 #x015B ;; 230:LATIN SMALL LETTER S WITH ACUTE
1277 #x00C1 ;; 231:LATIN CAPITAL LETTER A WITH ACUTE
1278 #x0164 ;; 232:LATIN CAPITAL LETTER T WITH CARON
1279 #x0165 ;; 233:LATIN SMALL LETTER T WITH CARON
1280 #x00CD ;; 234:LATIN CAPITAL LETTER I WITH ACUTE
1281 #x017D ;; 235:LATIN CAPITAL LETTER Z WITH CARON
1282 #x017E ;; 236:LATIN SMALL LETTER Z WITH CARON
1283 #x016A ;; 237:LATIN CAPITAL LETTER U WITH MACRON
1284 #x00D3 ;; 238:LATIN CAPITAL LETTER O WITH ACUTE
1285 #x00D4 ;; 239:LATIN CAPITAL LETTER O WITH CIRCUMFLEX
1286 #x016B ;; 240:LATIN SMALL LETTER U WITH MACRON
1287 #x016E ;; 241:LATIN CAPITAL LETTER U WITH RING ABOVE
1288 #x00DA ;; 242:LATIN CAPITAL LETTER U WITH ACUTE
1289 #x016F ;; 243:LATIN SMALL LETTER U WITH RING ABOVE
1290 #x0170 ;; 244:LATIN CAPITAL LETTER U WITH DOUBLE ACUTE
1291 #x0171 ;; 245:LATIN SMALL LETTER U WITH DOUBLE ACUTE
1292 #x0172 ;; 246:LATIN CAPITAL LETTER U WITH OGONEK
1293 #x0173 ;; 247:LATIN SMALL LETTER U WITH OGONEK
1294 #x00DD ;; 248:LATIN CAPITAL LETTER Y WITH ACUTE
1295 #x00FD ;; 249:LATIN SMALL LETTER Y WITH ACUTE
1296 #x0137 ;; 250:LATIN SMALL LETTER K WITH CEDILLA
1297 #x017B ;; 251:LATIN CAPITAL LETTER Z WITH DOT ABOVE
1298 #x0141 ;; 252:LATIN CAPITAL LETTER L WITH STROKE
1299 #x017C ;; 253:LATIN SMALL LETTER Z WITH DOT ABOVE
1300 #x0122 ;; 254:LATIN CAPITAL LETTER G WITH CEDILLA
1301 #x02C7 ;; 255:CARON
1302 ]))
1303 "Mac Central European Roman Encoding (MIME:x-mac-centraleurroman).")
1304 (coding-system-put 'mac-centraleurroman 'mime-charset 'x-mac-centraleurroman)
1305
1306 (cp-make-coding-system
1307 mac-cyrillic
1308 (apply
1309 'vector
1310 (mapcar
1311 (lambda (c) (decode-char 'ucs c))
1312 ;; mac-cyrillic (128..255) -> UCS mapping
1313 [ #x0410 ;; 128:CYRILLIC CAPITAL LETTER A
1314 #x0411 ;; 129:CYRILLIC CAPITAL LETTER BE
1315 #x0412 ;; 130:CYRILLIC CAPITAL LETTER VE
1316 #x0413 ;; 131:CYRILLIC CAPITAL LETTER GHE
1317 #x0414 ;; 132:CYRILLIC CAPITAL LETTER DE
1318 #x0415 ;; 133:CYRILLIC CAPITAL LETTER IE
1319 #x0416 ;; 134:CYRILLIC CAPITAL LETTER ZHE
1320 #x0417 ;; 135:CYRILLIC CAPITAL LETTER ZE
1321 #x0418 ;; 136:CYRILLIC CAPITAL LETTER I
1322 #x0419 ;; 137:CYRILLIC CAPITAL LETTER SHORT I
1323 #x041A ;; 138:CYRILLIC CAPITAL LETTER KA
1324 #x041B ;; 139:CYRILLIC CAPITAL LETTER EL
1325 #x041C ;; 140:CYRILLIC CAPITAL LETTER EM
1326 #x041D ;; 141:CYRILLIC CAPITAL LETTER EN
1327 #x041E ;; 142:CYRILLIC CAPITAL LETTER O
1328 #x041F ;; 143:CYRILLIC CAPITAL LETTER PE
1329 #x0420 ;; 144:CYRILLIC CAPITAL LETTER ER
1330 #x0421 ;; 145:CYRILLIC CAPITAL LETTER ES
1331 #x0422 ;; 146:CYRILLIC CAPITAL LETTER TE
1332 #x0423 ;; 147:CYRILLIC CAPITAL LETTER U
1333 #x0424 ;; 148:CYRILLIC CAPITAL LETTER EF
1334 #x0425 ;; 149:CYRILLIC CAPITAL LETTER HA
1335 #x0426 ;; 150:CYRILLIC CAPITAL LETTER TSE
1336 #x0427 ;; 151:CYRILLIC CAPITAL LETTER CHE
1337 #x0428 ;; 152:CYRILLIC CAPITAL LETTER SHA
1338 #x0429 ;; 153:CYRILLIC CAPITAL LETTER SHCHA
1339 #x042A ;; 154:CYRILLIC CAPITAL LETTER HARD SIGN
1340 #x042B ;; 155:CYRILLIC CAPITAL LETTER YERU
1341 #x042C ;; 156:CYRILLIC CAPITAL LETTER SOFT SIGN
1342 #x042D ;; 157:CYRILLIC CAPITAL LETTER E
1343 #x042E ;; 158:CYRILLIC CAPITAL LETTER YU
1344 #x042F ;; 159:CYRILLIC CAPITAL LETTER YA
1345 #x2020 ;; 160:DAGGER
1346 #x00B0 ;; 161:DEGREE SIGN
1347 #x0490 ;; 162:CYRILLIC CAPITAL LETTER GHE WITH UPTURN
1348 #x00A3 ;; 163:POUND SIGN
1349 #x00A7 ;; 164:SECTION SIGN
1350 #x2022 ;; 165:BULLET
1351 #x00B6 ;; 166:PILCROW SIGN
1352 #x0406 ;; 167:CYRILLIC CAPITAL LETTER BYELORUSSIAN-UKRAINIAN I
1353 #x00AE ;; 168:REGISTERED SIGN
1354 #x00A9 ;; 169:COPYRIGHT SIGN
1355 #x2122 ;; 170:TRADE MARK SIGN
1356 #x0402 ;; 171:CYRILLIC CAPITAL LETTER DJE
1357 #x0452 ;; 172:CYRILLIC SMALL LETTER DJE
1358 #x2260 ;; 173:NOT EQUAL TO
1359 #x0403 ;; 174:CYRILLIC CAPITAL LETTER GJE
1360 #x0453 ;; 175:CYRILLIC SMALL LETTER GJE
1361 #x221E ;; 176:INFINITY
1362 #x00B1 ;; 177:PLUS-MINUS SIGN
1363 #x2264 ;; 178:LESS-THAN OR EQUAL TO
1364 #x2265 ;; 179:GREATER-THAN OR EQUAL TO
1365 #x0456 ;; 180:CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN I
1366 #x00B5 ;; 181:MICRO SIGN
1367 #x0491 ;; 182:CYRILLIC SMALL LETTER GHE WITH UPTURN
1368 #x0408 ;; 183:CYRILLIC CAPITAL LETTER JE
1369 #x0404 ;; 184:CYRILLIC CAPITAL LETTER UKRAINIAN IE
1370 #x0454 ;; 185:CYRILLIC SMALL LETTER UKRAINIAN IE
1371 #x0407 ;; 186:CYRILLIC CAPITAL LETTER YI
1372 #x0457 ;; 187:CYRILLIC SMALL LETTER YI
1373 #x0409 ;; 188:CYRILLIC CAPITAL LETTER LJE
1374 #x0459 ;; 189:CYRILLIC SMALL LETTER LJE
1375 #x040A ;; 190:CYRILLIC CAPITAL LETTER NJE
1376 #x045A ;; 191:CYRILLIC SMALL LETTER NJE
1377 #x0458 ;; 192:CYRILLIC SMALL LETTER JE
1378 #x0405 ;; 193:CYRILLIC CAPITAL LETTER DZE
1379 #x00AC ;; 194:NOT SIGN
1380 #x221A ;; 195:SQUARE ROOT
1381 #x0192 ;; 196:LATIN SMALL LETTER F WITH HOOK
1382 #x2248 ;; 197:ALMOST EQUAL TO
1383 #x2206 ;; 198:INCREMENT
1384 #x00AB ;; 199:LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
1385 #x00BB ;; 200:RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
1386 #x2026 ;; 201:HORIZONTAL ELLIPSIS
1387 #x00A0 ;; 202:NO-BREAK SPACE
1388 #x040B ;; 203:CYRILLIC CAPITAL LETTER TSHE
1389 #x045B ;; 204:CYRILLIC SMALL LETTER TSHE
1390 #x040C ;; 205:CYRILLIC CAPITAL LETTER KJE
1391 #x045C ;; 206:CYRILLIC SMALL LETTER KJE
1392 #x0455 ;; 207:CYRILLIC SMALL LETTER DZE
1393 #x2013 ;; 208:EN DASH
1394 #x2014 ;; 209:EM DASH
1395 #x201C ;; 210:LEFT DOUBLE QUOTATION MARK
1396 #x201D ;; 211:RIGHT DOUBLE QUOTATION MARK
1397 #x2018 ;; 212:LEFT SINGLE QUOTATION MARK
1398 #x2019 ;; 213:RIGHT SINGLE QUOTATION MARK
1399 #x00F7 ;; 214:DIVISION SIGN
1400 #x201E ;; 215:DOUBLE LOW-9 QUOTATION MARK
1401 #x040E ;; 216:CYRILLIC CAPITAL LETTER SHORT U
1402 #x045E ;; 217:CYRILLIC SMALL LETTER SHORT U
1403 #x040F ;; 218:CYRILLIC CAPITAL LETTER DZHE
1404 #x045F ;; 219:CYRILLIC SMALL LETTER DZHE
1405 #x2116 ;; 220:NUMERO SIGN
1406 #x0401 ;; 221:CYRILLIC CAPITAL LETTER IO
1407 #x0451 ;; 222:CYRILLIC SMALL LETTER IO
1408 #x044F ;; 223:CYRILLIC SMALL LETTER YA
1409 #x0430 ;; 224:CYRILLIC SMALL LETTER A
1410 #x0431 ;; 225:CYRILLIC SMALL LETTER BE
1411 #x0432 ;; 226:CYRILLIC SMALL LETTER VE
1412 #x0433 ;; 227:CYRILLIC SMALL LETTER GHE
1413 #x0434 ;; 228:CYRILLIC SMALL LETTER DE
1414 #x0435 ;; 229:CYRILLIC SMALL LETTER IE
1415 #x0436 ;; 230:CYRILLIC SMALL LETTER ZHE
1416 #x0437 ;; 231:CYRILLIC SMALL LETTER ZE
1417 #x0438 ;; 232:CYRILLIC SMALL LETTER I
1418 #x0439 ;; 233:CYRILLIC SMALL LETTER SHORT I
1419 #x043A ;; 234:CYRILLIC SMALL LETTER KA
1420 #x043B ;; 235:CYRILLIC SMALL LETTER EL
1421 #x043C ;; 236:CYRILLIC SMALL LETTER EM
1422 #x043D ;; 237:CYRILLIC SMALL LETTER EN
1423 #x043E ;; 238:CYRILLIC SMALL LETTER O
1424 #x043F ;; 239:CYRILLIC SMALL LETTER PE
1425 #x0440 ;; 240:CYRILLIC SMALL LETTER ER
1426 #x0441 ;; 241:CYRILLIC SMALL LETTER ES
1427 #x0442 ;; 242:CYRILLIC SMALL LETTER TE
1428 #x0443 ;; 243:CYRILLIC SMALL LETTER U
1429 #x0444 ;; 244:CYRILLIC SMALL LETTER EF
1430 #x0445 ;; 245:CYRILLIC SMALL LETTER HA
1431 #x0446 ;; 246:CYRILLIC SMALL LETTER TSE
1432 #x0447 ;; 247:CYRILLIC SMALL LETTER CHE
1433 #x0448 ;; 248:CYRILLIC SMALL LETTER SHA
1434 #x0449 ;; 249:CYRILLIC SMALL LETTER SHCHA
1435 #x044A ;; 250:CYRILLIC SMALL LETTER HARD SIGN
1436 #x044B ;; 251:CYRILLIC SMALL LETTER YERU
1437 #x044C ;; 252:CYRILLIC SMALL LETTER SOFT SIGN
1438 #x044D ;; 253:CYRILLIC SMALL LETTER E
1439 #x044E ;; 254:CYRILLIC SMALL LETTER YU
1440 #x20AC ;; 255:EURO SIGN
1441 ]))
1442 "Mac Cyrillic Encoding (MIME:x-mac-cyrillic).")
1443 (coding-system-put 'mac-cyrillic 'mime-charset 'x-mac-cyrillic)
1444
1445 (defvar mac-font-encoder-list
1446 '(("mac-roman" mac-roman-encoder
1447 ccl-encode-mac-roman-font "%s")
1448 ("mac-centraleurroman" encode-mac-centraleurroman
1449 ccl-encode-mac-centraleurroman-font "%s ce")
1450 ("mac-cyrillic" encode-mac-cyrillic
1451 ccl-encode-mac-cyrillic-font "%s cy")))
1452
1453 (let ((encoder-list
1454 (mapcar (lambda (lst) (nth 1 lst)) mac-font-encoder-list))
1455 (charset-list
1456 '(latin-iso8859-2
1457 latin-iso8859-3 latin-iso8859-4
1458 cyrillic-iso8859-5 greek-iso8859-7 hebrew-iso8859-8
1459 latin-iso8859-9 latin-iso8859-14 latin-iso8859-15)))
1460 (dolist (encoder encoder-list)
1461 (let ((table (get encoder 'translation-table)))
1462 (dolist (charset charset-list)
1463 (dotimes (i 96)
1464 (let* ((c (make-char charset (+ i 32)))
1465 (mu (aref ucs-mule-to-mule-unicode c))
1466 (mac-encoded (and mu (aref table mu))))
1467 (if mac-encoded
1468 (aset table c mac-encoded))))))))
1469
1470 (define-ccl-program ccl-encode-mac-roman-font
1471 `(0
1472 (if (r0 != ,(charset-id 'ascii))
1473 (if (r0 <= ?\x8f)
1474 (translate-character mac-roman-encoder r0 r1)
1475 ((r1 <<= 7)
1476 (r1 |= r2)
1477 (translate-character mac-roman-encoder r0 r1)))))
1478 "CCL program for Mac Roman font")
1479
1480 (define-ccl-program ccl-encode-mac-centraleurroman-font
1481 `(0
1482 (if (r0 != ,(charset-id 'ascii))
1483 (if (r0 <= ?\x8f)
1484 (translate-character encode-mac-centraleurroman r0 r1)
1485 ((r1 <<= 7)
1486 (r1 |= r2)
1487 (translate-character encode-mac-centraleurroman r0 r1)))))
1488 "CCL program for Mac Central European Roman font")
1489
1490 (define-ccl-program ccl-encode-mac-cyrillic-font
1491 `(0
1492 (if (r0 != ,(charset-id 'ascii))
1493 (if (r0 <= ?\x8f)
1494 (translate-character encode-mac-cyrillic r0 r1)
1495 ((r1 <<= 7)
1496 (r1 |= r2)
1497 (translate-character encode-mac-cyrillic r0 r1)))))
1498 "CCL program for Mac Cyrillic font")
1499
1500
1501 (setq font-ccl-encoder-alist
1502 (nconc
1503 (mapcar (lambda (lst) (cons (nth 0 lst) (nth 2 lst)))
1504 mac-font-encoder-list)
1505 font-ccl-encoder-alist))
1506
1507 (defun fontset-add-mac-fonts (fontset &optional base-family)
1508 (if base-family
1509 (setq base-family (downcase base-family))
1510 (let ((ascii-font
1511 (downcase (x-resolve-font-name
1512 (fontset-font fontset (charset-id 'ascii))))))
1513 (setq base-family (aref (x-decompose-font-name ascii-font)
1514 xlfd-regexp-family-subnum))))
1515 ;; (if (not (string-match "^fontset-" fontset))
1516 ;; (setq fontset
1517 ;; (concat "fontset-" (aref (x-decompose-font-name fontset)
1518 ;; xlfd-regexp-encoding-subnum))))
1519 (dolist
1520 (font-encoder
1521 (nreverse
1522 (mapcar (lambda (lst)
1523 (cons (cons (format (nth 3 lst) base-family) (nth 0 lst))
1524 (nth 1 lst)))
1525 mac-font-encoder-list)))
1526 (let ((font (car font-encoder))
1527 (encoder (cdr font-encoder)))
1528 (map-char-table
1529 (lambda (key val)
1530 (or (null val)
1531 (generic-char-p key)
1532 (memq (char-charset key)
1533 '(ascii eight-bit-control eight-bit-graphic))
1534 (set-fontset-font fontset key font)))
1535 (get encoder 'translation-table)))))
1536
1537 (defun create-fontset-from-mac-roman-font (font &optional resolved-font
1538 fontset-name)
1539 "Create a fontset from a Mac roman font FONT.
1540
1541 Optional 1st arg RESOLVED-FONT is a resolved name of FONT. If
1542 omitted, `x-resolve-font-name' is called to get the resolved name. At
1543 this time, if FONT is not available, error is signaled.
1544
1545 Optional 2nd arg FONTSET-NAME is a string to be used in
1546 `<CHARSET_ENCODING>' fields of a new fontset name. If it is omitted,
1547 an appropriate name is generated automatically.
1548
1549 It returns a name of the created fontset."
1550 (let ((fontset
1551 (create-fontset-from-ascii-font font resolved-font fontset-name)))
1552 (fontset-add-mac-fonts fontset)
1553 fontset))
1554
1555 ;; Setup the default fontset.
1556 (setup-default-fontset)
1557
1558 ;; Create a fontset that uses mac-roman font. With this fontset,
1559 ;; characters decoded from mac-roman encoding (ascii, latin-iso8859-1,
1560 ;; and mule-unicode-xxxx-yyyy) are displayed by a mac-roman font.
1561 (create-fontset-from-fontset-spec
1562 "-etl-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-mac,
1563 ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman")
1564 (fontset-add-mac-fonts "fontset-mac")
1565
1566 ;; Create fontset specified in X resources "Fontset-N" (N is 0, 1, ...).
1567 (create-fontset-from-x-resource)
1568
1569 ;; Try to create a fontset from a font specification which comes
1570 ;; from initial-frame-alist, default-frame-alist, or X resource.
1571 ;; A font specification in command line argument (i.e. -fn XXXX)
1572 ;; should be already in default-frame-alist as a `font'
1573 ;; parameter. However, any font specifications in site-start
1574 ;; library, user's init file (.emacs), and default.el are not
1575 ;; yet handled here.
1576
1577 (let ((font (or (cdr (assq 'font initial-frame-alist))
1578 (cdr (assq 'font default-frame-alist))
1579 (x-get-resource "font" "Font")))
1580 xlfd-fields resolved-name)
1581 (if (and font
1582 (not (query-fontset font))
1583 (setq resolved-name (x-resolve-font-name font))
1584 (setq xlfd-fields (x-decompose-font-name font)))
1585 (if (string= "fontset" (aref xlfd-fields xlfd-regexp-registry-subnum))
1586 (new-fontset font (x-complement-fontset-spec xlfd-fields nil))
1587 ;; Create a fontset from FONT. The fontset name is
1588 ;; generated from FONT.
1589 (if (and (string= "mac" (aref xlfd-fields xlfd-regexp-registry-subnum))
1590 (string= "roman" (aref xlfd-fields xlfd-regexp-encoding-subnum)))
1591 (create-fontset-from-mac-roman-font font resolved-name "startup")
1592 (create-fontset-from-ascii-font font resolved-name "startup")))))
1593
1594 ;; Apply a geometry resource to the initial frame. Put it at the end
1595 ;; of the alist, so that anything specified on the command line takes
1596 ;; precedence.
1597 (let* ((res-geometry (x-get-resource "geometry" "Geometry"))
1598 parsed)
1599 (if res-geometry
1600 (progn
1601 (setq parsed (x-parse-geometry res-geometry))
1602 ;; If the resource specifies a position,
1603 ;; call the position and size "user-specified".
1604 (if (or (assq 'top parsed) (assq 'left parsed))
1605 (setq parsed (cons '(user-position . t)
1606 (cons '(user-size . t) parsed))))
1607 ;; All geometry parms apply to the initial frame.
1608 (setq initial-frame-alist (append initial-frame-alist parsed))
1609 ;; The size parms apply to all frames.
1610 (if (assq 'height parsed)
1611 (setq default-frame-alist
1612 (cons (cons 'height (cdr (assq 'height parsed)))
1613 default-frame-alist)))
1614 (if (assq 'width parsed)
1615 (setq default-frame-alist
1616 (cons (cons 'width (cdr (assq 'width parsed)))
1617 default-frame-alist))))))
1618
1619 ;; Check the reverseVideo resource.
1620 (let ((case-fold-search t))
1621 (let ((rv (x-get-resource "reverseVideo" "ReverseVideo")))
1622 (if (and rv
1623 (string-match "^\\(true\\|yes\\|on\\)$" rv))
1624 (setq default-frame-alist
1625 (cons '(reverse . t) default-frame-alist)))))
1626
1627 (defun x-win-suspend-error ()
1628 (error "Suspending an Emacs running under Mac makes no sense"))
1629 (add-hook 'suspend-hook 'x-win-suspend-error)
1630
1631 ;; Don't show the frame name; that's redundant.
1632 (setq-default mode-line-frame-identification " ")
1633
1634 ;; Turn on support for mouse wheels.
1635 (mouse-wheel-mode 1)
1636
1637 (defun mac-drag-n-drop (event)
1638 "Edit the files listed in the drag-n-drop EVENT.
1639 Switch to a buffer editing the last file dropped."
1640 (interactive "e")
1641 ;; Make sure the drop target has positive co-ords
1642 ;; before setting the selected frame - otherwise it
1643 ;; won't work. <skx@tardis.ed.ac.uk>
1644 (let* ((window (posn-window (event-start event)))
1645 (coords (posn-x-y (event-start event)))
1646 (x (car coords))
1647 (y (cdr coords)))
1648 (if (and (> x 0) (> y 0))
1649 (set-frame-selected-window nil window))
1650 (mapcar (lambda (file-name)
1651 (if (listp file-name)
1652 (let ((line (car file-name))
1653 (start (car (cdr file-name)))
1654 (end (car (cdr (cdr file-name)))))
1655 (if (> line 0)
1656 (goto-line line)
1657 (if (and (> start 0) (> end 0))
1658 (progn (set-mark start)
1659 (goto-char end)))))
1660 (dnd-handle-one-url window 'private
1661 (concat "file:" file-name))))
1662 (car (cdr (cdr event)))))
1663 (raise-frame))
1664
1665 (global-set-key [drag-n-drop] 'mac-drag-n-drop)
1666
1667 ;; By checking whether the variable mac-ready-for-drag-n-drop has been
1668 ;; defined, the event loop in macterm.c can be informed that it can
1669 ;; now receive Finder drag and drop events. Files dropped onto the
1670 ;; Emacs application icon can only be processed when the initial frame
1671 ;; has been created: this is where the files should be opened.
1672 (add-hook 'after-init-hook
1673 '(lambda ()
1674 (defvar mac-ready-for-drag-n-drop t)))
1675 \f
1676 ;;;; Scroll bars
1677
1678 ;; for debugging
1679 ;; (defun mac-handle-scroll-bar-event (event) (interactive "e") (princ event))
1680
1681 ;;(global-set-key [vertical-scroll-bar mouse-1] 'mac-handle-scroll-bar-event)
1682
1683 (global-set-key
1684 [vertical-scroll-bar down-mouse-1]
1685 'mac-handle-scroll-bar-event)
1686
1687 (global-unset-key [vertical-scroll-bar drag-mouse-1])
1688 (global-unset-key [vertical-scroll-bar mouse-1])
1689
1690 (defun mac-handle-scroll-bar-event (event)
1691 "Handle scroll bar EVENT to emulate Mac Toolbox style scrolling."
1692 (interactive "e")
1693 (let* ((position (event-start event))
1694 (window (nth 0 position))
1695 (bar-part (nth 4 position)))
1696 (select-window window)
1697 (cond
1698 ((eq bar-part 'up)
1699 (goto-char (window-start window))
1700 (mac-scroll-down-line))
1701 ((eq bar-part 'above-handle)
1702 (mac-scroll-down))
1703 ((eq bar-part 'handle)
1704 (scroll-bar-drag event))
1705 ((eq bar-part 'below-handle)
1706 (mac-scroll-up))
1707 ((eq bar-part 'down)
1708 (goto-char (window-start window))
1709 (mac-scroll-up-line)))))
1710
1711 (defun mac-scroll-ignore-events ()
1712 ;; Ignore confusing non-mouse events
1713 (while (not (memq (car-safe (read-event))
1714 '(mouse-1 double-mouse-1 triple-mouse-1))) nil))
1715
1716 (defun mac-scroll-down ()
1717 (track-mouse
1718 (mac-scroll-ignore-events)
1719 (scroll-down)))
1720
1721 (defun mac-scroll-down-line ()
1722 (track-mouse
1723 (mac-scroll-ignore-events)
1724 (scroll-down 1)))
1725
1726 (defun mac-scroll-up ()
1727 (track-mouse
1728 (mac-scroll-ignore-events)
1729 (scroll-up)))
1730
1731 (defun mac-scroll-up-line ()
1732 (track-mouse
1733 (mac-scroll-ignore-events)
1734 (scroll-up 1)))
1735
1736 \f
1737 ;;;; Others
1738
1739 (unless (eq system-type 'darwin)
1740 ;; This variable specifies the Unix program to call (as a process) to
1741 ;; determine the amount of free space on a file system (defaults to
1742 ;; df). If it is not set to nil, ls-lisp will not work correctly
1743 ;; unless an external application df is implemented on the Mac.
1744 (setq directory-free-space-program nil)
1745
1746 ;; Set this so that Emacs calls subprocesses with "sh" as shell to
1747 ;; expand filenames Note no subprocess for the shell is actually
1748 ;; started (see run_mac_command in sysdep.c).
1749 (setq shell-file-name "sh")
1750
1751 ;; Some system variables are encoded with the system script code.
1752 (dolist (v '(system-name
1753 emacs-build-system ; Mac OS 9 version cannot dump
1754 user-login-name user-real-login-name user-full-name))
1755 (set v (decode-coding-string (symbol-value v) mac-system-coding-system))))
1756
1757 ;; If Emacs is started from the Finder, change the default directory
1758 ;; to the user's home directory.
1759 (if (string= default-directory "/")
1760 (cd "~"))
1761
1762 ;; Darwin 6- pty breakage is now controlled from the C code so that
1763 ;; it applies to all builds on darwin. See s/darwin.h PTY_ITERATION.
1764 ;; (setq process-connection-type t)
1765
1766 ;; Assume that fonts are always scalable on the Mac. This sometimes
1767 ;; results in characters with jagged edges. However, without it,
1768 ;; fonts with both truetype and bitmap representations but no italic
1769 ;; or bold bitmap versions will not display these variants correctly.
1770 (setq scalable-fonts-allowed t)
1771
1772 ;; arch-tag: 71dfcd14-cde8-4d66-b05c-85ec94fb23a6
1773 ;;; mac-win.el ends here