1 ;;; mac-win.el --- parse switches controlling interface with Mac window system
3 ;; Copyright (C) 1999, 2000, 2002, 2003, 2004 Free Software Foundation, Inc.
5 ;; Author: Andrew Choi <akochoi@mac.com>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
27 ;; Mac-win.el: this file is loaded from ../lisp/startup.el when it recognizes
28 ;; that Mac windows are to be used. Command line switches are parsed and those
29 ;; pertaining to Mac are processed and removed from the command line. The
30 ;; Mac display is opened and hooks are set for popping up the initial window.
32 ;; startup.el will then examine startup files, and eventually call the hooks
33 ;; which create the first window(s).
37 ;; These are the standard X switches from the Xt Initialize.c file of
40 ;; Command line Resource Manager string
43 ;; +synchronous *synchronous
44 ;; -background *background
47 ;; -bordercolor *borderColor
48 ;; -borderwidth .borderWidth
54 ;; -foreground *foreground
55 ;; -geometry .geometry
60 ;; -reverse *reverseVideo
62 ;; -selectionTimeout .selectionTimeout
63 ;; -synchronous *synchronous
66 ;; An alist of X options and the function which handles them. See
69 (if (not (eq window-system
'mac
))
70 (error "%s: Loading mac-win.el but not compiled for Mac" (invocation-name)))
81 (defvar x-invocation-args
)
83 (defvar x-command-line-resources nil
)
85 ;; Handler for switches of the form "-switch value" or "-switch".
86 (defun x-handle-switch (switch)
87 (let ((aelt (assoc switch command-line-x-option-alist
)))
89 (let ((param (nth 3 aelt
))
92 (setq default-frame-alist
93 (cons (cons param value
)
95 (setq default-frame-alist
97 (car x-invocation-args
))
99 x-invocation-args
(cdr x-invocation-args
)))))))
101 ;; Handler for switches of the form "-switch n"
102 (defun x-handle-numeric-switch (switch)
103 (let ((aelt (assoc switch command-line-x-option-alist
)))
105 (let ((param (nth 3 aelt
)))
106 (setq default-frame-alist
108 (string-to-int (car x-invocation-args
)))
111 (cdr x-invocation-args
))))))
113 ;; Handle options that apply to initial frame only
114 (defun x-handle-initial-switch (switch)
115 (let ((aelt (assoc switch command-line-x-option-alist
)))
117 (let ((param (nth 3 aelt
))
118 (value (nth 4 aelt
)))
120 (setq initial-frame-alist
121 (cons (cons param value
)
122 initial-frame-alist
))
123 (setq initial-frame-alist
125 (car x-invocation-args
))
127 x-invocation-args
(cdr x-invocation-args
)))))))
129 ;; Make -iconic apply only to the initial frame!
130 (defun x-handle-iconic (switch)
131 (setq initial-frame-alist
132 (cons '(visibility . icon
) initial-frame-alist
)))
134 ;; Handle the -xrm option.
135 (defun x-handle-xrm-switch (switch)
136 (unless (consp x-invocation-args
)
137 (error "%s: missing argument to `%s' option" (invocation-name) switch
))
138 (setq x-command-line-resources
139 (if (null x-command-line-resources
)
140 (car x-invocation-args
)
141 (concat x-command-line-resources
"\n" (car x-invocation-args
))))
142 (setq x-invocation-args
(cdr x-invocation-args
)))
144 ;; Handle the geometry option
145 (defun x-handle-geometry (switch)
146 (let* ((geo (x-parse-geometry (car x-invocation-args
)))
147 (left (assq 'left geo
))
148 (top (assq 'top geo
))
149 (height (assq 'height geo
))
150 (width (assq 'width geo
)))
151 (if (or height width
)
152 (setq default-frame-alist
153 (append default-frame-alist
155 (if height
(list height
))
156 (if width
(list width
)))
158 (append initial-frame-alist
160 (if height
(list height
))
161 (if width
(list width
)))))
163 (setq initial-frame-alist
164 (append initial-frame-alist
165 '((user-position . t
))
166 (if left
(list left
))
167 (if top
(list top
)))))
168 (setq x-invocation-args
(cdr x-invocation-args
))))
170 ;; Handle the -name option. Set the variable x-resource-name
171 ;; to the option's operand; set the name of
172 ;; the initial frame, too.
173 (defun x-handle-name-switch (switch)
174 (or (consp x-invocation-args
)
175 (error "%s: missing argument to `%s' option" (invocation-name) switch
))
176 (setq x-resource-name
(car x-invocation-args
)
177 x-invocation-args
(cdr x-invocation-args
))
178 (setq initial-frame-alist
(cons (cons 'name x-resource-name
)
179 initial-frame-alist
)))
181 (defvar x-display-name nil
182 "The display name specifying server and frame.")
184 (defun x-handle-display (switch)
185 (setq x-display-name
(car x-invocation-args
)
186 x-invocation-args
(cdr x-invocation-args
)))
188 (defun x-handle-args (args)
189 "Process the X-related command line options in ARGS.
190 This is done before the user's startup file is loaded. They are copied to
191 `x-invocation-args', from which the X-related things are extracted, first
192 the switch (e.g., \"-fg\") in the following code, and possible values
193 \(e.g., \"black\") in the option handler code (e.g., x-handle-switch).
194 This function returns ARGS minus the arguments that have been processed."
195 ;; We use ARGS to accumulate the args that we don't handle here, to return.
196 (setq x-invocation-args args
198 (while (and x-invocation-args
199 (not (equal (car x-invocation-args
) "--")))
200 (let* ((this-switch (car x-invocation-args
))
201 (orig-this-switch this-switch
)
202 completion argval aelt handler
)
203 (setq x-invocation-args
(cdr x-invocation-args
))
204 ;; Check for long options with attached arguments
205 ;; and separate out the attached option argument into argval.
206 (if (string-match "^--[^=]*=" this-switch
)
207 (setq argval
(substring this-switch
(match-end 0))
208 this-switch
(substring this-switch
0 (1- (match-end 0)))))
209 ;; Complete names of long options.
210 (if (string-match "^--" this-switch
)
212 (setq completion
(try-completion this-switch command-line-x-option-alist
))
213 (if (eq completion t
)
214 ;; Exact match for long option.
216 (if (stringp completion
)
217 (let ((elt (assoc completion command-line-x-option-alist
)))
218 ;; Check for abbreviated long option.
220 (error "Option `%s' is ambiguous" this-switch
))
221 (setq this-switch completion
))))))
222 (setq aelt
(assoc this-switch command-line-x-option-alist
))
223 (if aelt
(setq handler
(nth 2 aelt
)))
226 (let ((x-invocation-args
227 (cons argval x-invocation-args
)))
228 (funcall handler this-switch
))
229 (funcall handler this-switch
))
230 (setq args
(cons orig-this-switch args
)))))
231 (nconc (nreverse args
) x-invocation-args
))
237 (defvar x-colors
'("LightGreen"
836 "LightGoldenrodYellow"
837 "light goldenrod yellow"
854 "medium spring green"
989 "The list of X colors from the `rgb.txt' file.
990 XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp")
992 (defun xw-defined-colors (&optional frame
)
993 "Internal function called by `defined-colors', which see."
994 (or frame
(setq frame
(selected-frame)))
995 (let ((all-colors x-colors
)
997 (defined-colors nil
))
999 (setq this-color
(car all-colors
)
1000 all-colors
(cdr all-colors
))
1001 (and (color-supported-p this-color frame t
)
1002 (setq defined-colors
(cons this-color defined-colors
))))
1007 (substitute-key-definition 'suspend-emacs
'iconify-or-deiconify-frame
1010 ;; Map certain keypad keys into ASCII characters
1011 ;; that people usually expect.
1012 (define-key function-key-map
[return] [?\C-m])
1013 (define-key function-key-map [M-return] [?\M-\C-m])
1014 (define-key function-key-map [tab] [?\t])
1015 (define-key function-key-map [M-tab] [?\M-\t])
1016 (define-key function-key-map [backspace] [127])
1017 (define-key function-key-map [M-backspace] [?\M-\d])
1018 (define-key function-key-map [escape] [?\e])
1019 (define-key function-key-map [M-escape] [?\M-\e])
1021 ;; These tell read-char how to convert
1022 ;; these special chars to ASCII.
1023 (put 'return 'ascii-character 13)
1024 (put 'tab 'ascii-character ?\t)
1025 (put 'backspace 'ascii-character 127)
1026 (put 'escape 'ascii-character ?\e)
1031 ;; Define constant values to be set to mac-keyboard-text-encoding
1032 (defconst kTextEncodingMacRoman 0)
1033 (defconst kTextEncodingISOLatin1 513 "0x201")
1034 (defconst kTextEncodingISOLatin2 514 "0x202")
1037 ;;;; Selections and cut buffers
1039 ;; Setup to use the Mac clipboard. The functions mac-cut-function and
1040 ;; mac-paste-function are defined in mac.c.
1041 (set-selection-coding-system 'compound-text-mac)
1043 (setq interprogram-cut-function
1046 (encode-coding-string str selection-coding-system t) push)))
1048 (setq interprogram-paste-function
1050 (let ((clipboard (mac-paste-function)))
1052 (decode-coding-string clipboard selection-coding-system t)))))
1055 ;;; Do the actual Windows setup here; the above code just defines
1056 ;;; functions and variables that we use now.
1058 (setq command-line-args (x-handle-args command-line-args))
1060 ;;; Make sure we have a valid resource name.
1061 (or (stringp x-resource-name)
1063 (setq x-resource-name (invocation-name))
1065 ;; Change any . or * characters in x-resource-name to hyphens,
1066 ;; so as not to choke when we use it in X resource queries.
1067 (while (setq i (string-match "[.*]" x-resource-name))
1068 (aset x-resource-name i ?-))))
1070 (if (x-display-list)
1071 ;; On Mac OS 8/9, Most coding systems used in code conversion for
1072 ;; font names are not ready at the time when the terminal frame is
1073 ;; created. So we reconstruct font name table for the initial
1075 (mac-clear-font-name-table)
1076 (x-open-connection "Mac"
1077 x-command-line-resources
1078 ;; Exit Emacs with fatal error if this fails.
1081 (setq frame-creation-function 'x-create-frame-with-faces)
1083 (define-ccl-program ccl-encode-mac-roman-font
1085 (if (r0 != ,(charset-id 'ascii))
1087 (translate-character mac-roman-encoder r0 r1)
1090 (translate-character mac-roman-encoder r0 r1)))))
1091 "CCL program for Mac Roman font")
1094 ((encoding-vector (make-vector 256 nil))
1096 (vec ;; mac-centraleurroman (128..255) -> UCS mapping
1097 [ #x00C4 ;; 128:LATIN CAPITAL LETTER A WITH DIAERESIS
1098 #x0100 ;; 129:LATIN CAPITAL LETTER A WITH MACRON
1099 #x0101 ;; 130:LATIN SMALL LETTER A WITH MACRON
1100 #x00C9 ;; 131:LATIN CAPITAL LETTER E WITH ACUTE
1101 #x0104 ;; 132:LATIN CAPITAL LETTER A WITH OGONEK
1102 #x00D6 ;; 133:LATIN CAPITAL LETTER O WITH DIAERESIS
1103 #x00DC ;; 134:LATIN CAPITAL LETTER U WITH DIAERESIS
1104 #x00E1 ;; 135:LATIN SMALL LETTER A WITH ACUTE
1105 #x0105 ;; 136:LATIN SMALL LETTER A WITH OGONEK
1106 #x010C ;; 137:LATIN CAPITAL LETTER C WITH CARON
1107 #x00E4 ;; 138:LATIN SMALL LETTER A WITH DIAERESIS
1108 #x010D ;; 139:LATIN SMALL LETTER C WITH CARON
1109 #x0106 ;; 140:LATIN CAPITAL LETTER C WITH ACUTE
1110 #x0107 ;; 141:LATIN SMALL LETTER C WITH ACUTE
1111 #x00E9 ;; 142:LATIN SMALL LETTER E WITH ACUTE
1112 #x0179 ;; 143:LATIN CAPITAL LETTER Z WITH ACUTE
1113 #x017A ;; 144:LATIN SMALL LETTER Z WITH ACUTE
1114 #x010E ;; 145:LATIN CAPITAL LETTER D WITH CARON
1115 #x00ED ;; 146:LATIN SMALL LETTER I WITH ACUTE
1116 #x010F ;; 147:LATIN SMALL LETTER D WITH CARON
1117 #x0112 ;; 148:LATIN CAPITAL LETTER E WITH MACRON
1118 #x0113 ;; 149:LATIN SMALL LETTER E WITH MACRON
1119 #x0116 ;; 150:LATIN CAPITAL LETTER E WITH DOT ABOVE
1120 #x00F3 ;; 151:LATIN SMALL LETTER O WITH ACUTE
1121 #x0117 ;; 152:LATIN SMALL LETTER E WITH DOT ABOVE
1122 #x00F4 ;; 153:LATIN SMALL LETTER O WITH CIRCUMFLEX
1123 #x00F6 ;; 154:LATIN SMALL LETTER O WITH DIAERESIS
1124 #x00F5 ;; 155:LATIN SMALL LETTER O WITH TILDE
1125 #x00FA ;; 156:LATIN SMALL LETTER U WITH ACUTE
1126 #x011A ;; 157:LATIN CAPITAL LETTER E WITH CARON
1127 #x011B ;; 158:LATIN SMALL LETTER E WITH CARON
1128 #x00FC ;; 159:LATIN SMALL LETTER U WITH DIAERESIS
1129 #x2020 ;; 160:DAGGER
1130 #x00B0 ;; 161:DEGREE SIGN
1131 #x0118 ;; 162:LATIN CAPITAL LETTER E WITH OGONEK
1132 #x00A3 ;; 163:POUND SIGN
1133 #x00A7 ;; 164:SECTION SIGN
1134 #x2022 ;; 165:BULLET
1135 #x00B6 ;; 166:PILCROW SIGN
1136 #x00DF ;; 167:LATIN SMALL LETTER SHARP S
1137 #x00AE ;; 168:REGISTERED SIGN
1138 #x00A9 ;; 169:COPYRIGHT SIGN
1139 #x2122 ;; 170:TRADE MARK SIGN
1140 #x0119 ;; 171:LATIN SMALL LETTER E WITH OGONEK
1141 #x00A8 ;; 172:DIAERESIS
1142 #x2260 ;; 173:NOT EQUAL TO
1143 #x0123 ;; 174:LATIN SMALL LETTER G WITH CEDILLA
1144 #x012E ;; 175:LATIN CAPITAL LETTER I WITH OGONEK
1145 #x012F ;; 176:LATIN SMALL LETTER I WITH OGONEK
1146 #x012A ;; 177:LATIN CAPITAL LETTER I WITH MACRON
1147 #x2264 ;; 178:LESS-THAN OR EQUAL TO
1148 #x2265 ;; 179:GREATER-THAN OR EQUAL TO
1149 #x012B ;; 180:LATIN SMALL LETTER I WITH MACRON
1150 #x0136 ;; 181:LATIN CAPITAL LETTER K WITH CEDILLA
1151 #x2202 ;; 182:PARTIAL DIFFERENTIAL
1152 #x2211 ;; 183:N-ARY SUMMATION
1153 #x0142 ;; 184:LATIN SMALL LETTER L WITH STROKE
1154 #x013B ;; 185:LATIN CAPITAL LETTER L WITH CEDILLA
1155 #x013C ;; 186:LATIN SMALL LETTER L WITH CEDILLA
1156 #x013D ;; 187:LATIN CAPITAL LETTER L WITH CARON
1157 #x013E ;; 188:LATIN SMALL LETTER L WITH CARON
1158 #x0139 ;; 189:LATIN CAPITAL LETTER L WITH ACUTE
1159 #x013A ;; 190:LATIN SMALL LETTER L WITH ACUTE
1160 #x0145 ;; 191:LATIN CAPITAL LETTER N WITH CEDILLA
1161 #x0146 ;; 192:LATIN SMALL LETTER N WITH CEDILLA
1162 #x0143 ;; 193:LATIN CAPITAL LETTER N WITH ACUTE
1163 #x00AC ;; 194:NOT SIGN
1164 #x221A ;; 195:SQUARE ROOT
1165 #x0144 ;; 196:LATIN SMALL LETTER N WITH ACUTE
1166 #x0147 ;; 197:LATIN CAPITAL LETTER N WITH CARON
1167 #x2206 ;; 198:INCREMENT
1168 #x00AB ;; 199:LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
1169 #x00BB ;; 200:RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
1170 #x2026 ;; 201:HORIZONTAL ELLIPSIS
1171 #x00A0 ;; 202:NO-BREAK SPACE
1172 #x0148 ;; 203:LATIN SMALL LETTER N WITH CARON
1173 #x0150 ;; 204:LATIN CAPITAL LETTER O WITH DOUBLE ACUTE
1174 #x00D5 ;; 205:LATIN CAPITAL LETTER O WITH TILDE
1175 #x0151 ;; 206:LATIN SMALL LETTER O WITH DOUBLE ACUTE
1176 #x014C ;; 207:LATIN CAPITAL LETTER O WITH MACRON
1177 #x2013 ;; 208:EN DASH
1178 #x2014 ;; 209:EM DASH
1179 #x201C ;; 210:LEFT DOUBLE QUOTATION MARK
1180 #x201D ;; 211:RIGHT DOUBLE QUOTATION MARK
1181 #x2018 ;; 212:LEFT SINGLE QUOTATION MARK
1182 #x2019 ;; 213:RIGHT SINGLE QUOTATION MARK
1183 #x00F7 ;; 214:DIVISION SIGN
1184 #x25CA ;; 215:LOZENGE
1185 #x014D ;; 216:LATIN SMALL LETTER O WITH MACRON
1186 #x0154 ;; 217:LATIN CAPITAL LETTER R WITH ACUTE
1187 #x0155 ;; 218:LATIN SMALL LETTER R WITH ACUTE
1188 #x0158 ;; 219:LATIN CAPITAL LETTER R WITH CARON
1189 #x2039 ;; 220:SINGLE LEFT-POINTING ANGLE QUOTATION MARK
1190 #x203A ;; 221:SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
1191 #x0159 ;; 222:LATIN SMALL LETTER R WITH CARON
1192 #x0156 ;; 223:LATIN CAPITAL LETTER R WITH CEDILLA
1193 #x0157 ;; 224:LATIN SMALL LETTER R WITH CEDILLA
1194 #x0160 ;; 225:LATIN CAPITAL LETTER S WITH CARON
1195 #x201A ;; 226:SINGLE LOW-9 QUOTATION MARK
1196 #x201E ;; 227:DOUBLE LOW-9 QUOTATION MARK
1197 #x0161 ;; 228:LATIN SMALL LETTER S WITH CARON
1198 #x015A ;; 229:LATIN CAPITAL LETTER S WITH ACUTE
1199 #x015B ;; 230:LATIN SMALL LETTER S WITH ACUTE
1200 #x00C1 ;; 231:LATIN CAPITAL LETTER A WITH ACUTE
1201 #x0164 ;; 232:LATIN CAPITAL LETTER T WITH CARON
1202 #x0165 ;; 233:LATIN SMALL LETTER T WITH CARON
1203 #x00CD ;; 234:LATIN CAPITAL LETTER I WITH ACUTE
1204 #x017D ;; 235:LATIN CAPITAL LETTER Z WITH CARON
1205 #x017E ;; 236:LATIN SMALL LETTER Z WITH CARON
1206 #x016A ;; 237:LATIN CAPITAL LETTER U WITH MACRON
1207 #x00D3 ;; 238:LATIN CAPITAL LETTER O WITH ACUTE
1208 #x00D4 ;; 239:LATIN CAPITAL LETTER O WITH CIRCUMFLEX
1209 #x016B ;; 240:LATIN SMALL LETTER U WITH MACRON
1210 #x016E ;; 241:LATIN CAPITAL LETTER U WITH RING ABOVE
1211 #x00DA ;; 242:LATIN CAPITAL LETTER U WITH ACUTE
1212 #x016F ;; 243:LATIN SMALL LETTER U WITH RING ABOVE
1213 #x0170 ;; 244:LATIN CAPITAL LETTER U WITH DOUBLE ACUTE
1214 #x0171 ;; 245:LATIN SMALL LETTER U WITH DOUBLE ACUTE
1215 #x0172 ;; 246:LATIN CAPITAL LETTER U WITH OGONEK
1216 #x0173 ;; 247:LATIN SMALL LETTER U WITH OGONEK
1217 #x00DD ;; 248:LATIN CAPITAL LETTER Y WITH ACUTE
1218 #x00FD ;; 249:LATIN SMALL LETTER Y WITH ACUTE
1219 #x0137 ;; 250:LATIN SMALL LETTER K WITH CEDILLA
1220 #x017B ;; 251:LATIN CAPITAL LETTER Z WITH DOT ABOVE
1221 #x0141 ;; 252:LATIN CAPITAL LETTER L WITH STROKE
1222 #x017C ;; 253:LATIN SMALL LETTER Z WITH DOT ABOVE
1223 #x0122 ;; 254:LATIN CAPITAL LETTER G WITH CEDILLA
1228 (aset encoding-vector i i)
1231 (aset encoding-vector i
1232 (decode-char 'ucs (aref vec (- i 128))))
1234 (setq translation-table
1235 (make-translation-table-from-vector encoding-vector))
1236 ;; (define-translation-table 'mac-centraleurroman-decoder translation-table)
1237 (define-translation-table 'mac-centraleurroman-encoder
1238 (char-table-extra-slot translation-table 0)))
1241 ((encoding-vector (make-vector 256 nil))
1243 (vec ;; mac-cyrillic (128..255) -> UCS mapping
1244 [ #x0410 ;; 128:CYRILLIC CAPITAL LETTER A
1245 #x0411 ;; 129:CYRILLIC CAPITAL LETTER BE
1246 #x0412 ;; 130:CYRILLIC CAPITAL LETTER VE
1247 #x0413 ;; 131:CYRILLIC CAPITAL LETTER GHE
1248 #x0414 ;; 132:CYRILLIC CAPITAL LETTER DE
1249 #x0415 ;; 133:CYRILLIC CAPITAL LETTER IE
1250 #x0416 ;; 134:CYRILLIC CAPITAL LETTER ZHE
1251 #x0417 ;; 135:CYRILLIC CAPITAL LETTER ZE
1252 #x0418 ;; 136:CYRILLIC CAPITAL LETTER I
1253 #x0419 ;; 137:CYRILLIC CAPITAL LETTER SHORT I
1254 #x041A ;; 138:CYRILLIC CAPITAL LETTER KA
1255 #x041B ;; 139:CYRILLIC CAPITAL LETTER EL
1256 #x041C ;; 140:CYRILLIC CAPITAL LETTER EM
1257 #x041D ;; 141:CYRILLIC CAPITAL LETTER EN
1258 #x041E ;; 142:CYRILLIC CAPITAL LETTER O
1259 #x041F ;; 143:CYRILLIC CAPITAL LETTER PE
1260 #x0420 ;; 144:CYRILLIC CAPITAL LETTER ER
1261 #x0421 ;; 145:CYRILLIC CAPITAL LETTER ES
1262 #x0422 ;; 146:CYRILLIC CAPITAL LETTER TE
1263 #x0423 ;; 147:CYRILLIC CAPITAL LETTER U
1264 #x0424 ;; 148:CYRILLIC CAPITAL LETTER EF
1265 #x0425 ;; 149:CYRILLIC CAPITAL LETTER HA
1266 #x0426 ;; 150:CYRILLIC CAPITAL LETTER TSE
1267 #x0427 ;; 151:CYRILLIC CAPITAL LETTER CHE
1268 #x0428 ;; 152:CYRILLIC CAPITAL LETTER SHA
1269 #x0429 ;; 153:CYRILLIC CAPITAL LETTER SHCHA
1270 #x042A ;; 154:CYRILLIC CAPITAL LETTER HARD SIGN
1271 #x042B ;; 155:CYRILLIC CAPITAL LETTER YERU
1272 #x042C ;; 156:CYRILLIC CAPITAL LETTER SOFT SIGN
1273 #x042D ;; 157:CYRILLIC CAPITAL LETTER E
1274 #x042E ;; 158:CYRILLIC CAPITAL LETTER YU
1275 #x042F ;; 159:CYRILLIC CAPITAL LETTER YA
1276 #x2020 ;; 160:DAGGER
1277 #x00B0 ;; 161:DEGREE SIGN
1278 #x0490 ;; 162:CYRILLIC CAPITAL LETTER GHE WITH UPTURN
1279 #x00A3 ;; 163:POUND SIGN
1280 #x00A7 ;; 164:SECTION SIGN
1281 #x2022 ;; 165:BULLET
1282 #x00B6 ;; 166:PILCROW SIGN
1283 #x0406 ;; 167:CYRILLIC CAPITAL LETTER BYELORUSSIAN-UKRAINIAN I
1284 #x00AE ;; 168:REGISTERED SIGN
1285 #x00A9 ;; 169:COPYRIGHT SIGN
1286 #x2122 ;; 170:TRADE MARK SIGN
1287 #x0402 ;; 171:CYRILLIC CAPITAL LETTER DJE
1288 #x0452 ;; 172:CYRILLIC SMALL LETTER DJE
1289 #x2260 ;; 173:NOT EQUAL TO
1290 #x0403 ;; 174:CYRILLIC CAPITAL LETTER GJE
1291 #x0453 ;; 175:CYRILLIC SMALL LETTER GJE
1292 #x221E ;; 176:INFINITY
1293 #x00B1 ;; 177:PLUS-MINUS SIGN
1294 #x2264 ;; 178:LESS-THAN OR EQUAL TO
1295 #x2265 ;; 179:GREATER-THAN OR EQUAL TO
1296 #x0456 ;; 180:CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN I
1297 #x00B5 ;; 181:MICRO SIGN
1298 #x0491 ;; 182:CYRILLIC SMALL LETTER GHE WITH UPTURN
1299 #x0408 ;; 183:CYRILLIC CAPITAL LETTER JE
1300 #x0404 ;; 184:CYRILLIC CAPITAL LETTER UKRAINIAN IE
1301 #x0454 ;; 185:CYRILLIC SMALL LETTER UKRAINIAN IE
1302 #x0407 ;; 186:CYRILLIC CAPITAL LETTER YI
1303 #x0457 ;; 187:CYRILLIC SMALL LETTER YI
1304 #x0409 ;; 188:CYRILLIC CAPITAL LETTER LJE
1305 #x0459 ;; 189:CYRILLIC SMALL LETTER LJE
1306 #x040A ;; 190:CYRILLIC CAPITAL LETTER NJE
1307 #x045A ;; 191:CYRILLIC SMALL LETTER NJE
1308 #x0458 ;; 192:CYRILLIC SMALL LETTER JE
1309 #x0405 ;; 193:CYRILLIC CAPITAL LETTER DZE
1310 #x00AC ;; 194:NOT SIGN
1311 #x221A ;; 195:SQUARE ROOT
1312 #x0192 ;; 196:LATIN SMALL LETTER F WITH HOOK
1313 #x2248 ;; 197:ALMOST EQUAL TO
1314 #x2206 ;; 198:INCREMENT
1315 #x00AB ;; 199:LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
1316 #x00BB ;; 200:RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
1317 #x2026 ;; 201:HORIZONTAL ELLIPSIS
1318 #x00A0 ;; 202:NO-BREAK SPACE
1319 #x040B ;; 203:CYRILLIC CAPITAL LETTER TSHE
1320 #x045B ;; 204:CYRILLIC SMALL LETTER TSHE
1321 #x040C ;; 205:CYRILLIC CAPITAL LETTER KJE
1322 #x045C ;; 206:CYRILLIC SMALL LETTER KJE
1323 #x0455 ;; 207:CYRILLIC SMALL LETTER DZE
1324 #x2013 ;; 208:EN DASH
1325 #x2014 ;; 209:EM DASH
1326 #x201C ;; 210:LEFT DOUBLE QUOTATION MARK
1327 #x201D ;; 211:RIGHT DOUBLE QUOTATION MARK
1328 #x2018 ;; 212:LEFT SINGLE QUOTATION MARK
1329 #x2019 ;; 213:RIGHT SINGLE QUOTATION MARK
1330 #x00F7 ;; 214:DIVISION SIGN
1331 #x201E ;; 215:DOUBLE LOW-9 QUOTATION MARK
1332 #x040E ;; 216:CYRILLIC CAPITAL LETTER SHORT U
1333 #x045E ;; 217:CYRILLIC SMALL LETTER SHORT U
1334 #x040F ;; 218:CYRILLIC CAPITAL LETTER DZHE
1335 #x045F ;; 219:CYRILLIC SMALL LETTER DZHE
1336 #x2116 ;; 220:NUMERO SIGN
1337 #x0401 ;; 221:CYRILLIC CAPITAL LETTER IO
1338 #x0451 ;; 222:CYRILLIC SMALL LETTER IO
1339 #x044F ;; 223:CYRILLIC SMALL LETTER YA
1340 #x0430 ;; 224:CYRILLIC SMALL LETTER A
1341 #x0431 ;; 225:CYRILLIC SMALL LETTER BE
1342 #x0432 ;; 226:CYRILLIC SMALL LETTER VE
1343 #x0433 ;; 227:CYRILLIC SMALL LETTER GHE
1344 #x0434 ;; 228:CYRILLIC SMALL LETTER DE
1345 #x0435 ;; 229:CYRILLIC SMALL LETTER IE
1346 #x0436 ;; 230:CYRILLIC SMALL LETTER ZHE
1347 #x0437 ;; 231:CYRILLIC SMALL LETTER ZE
1348 #x0438 ;; 232:CYRILLIC SMALL LETTER I
1349 #x0439 ;; 233:CYRILLIC SMALL LETTER SHORT I
1350 #x043A ;; 234:CYRILLIC SMALL LETTER KA
1351 #x043B ;; 235:CYRILLIC SMALL LETTER EL
1352 #x043C ;; 236:CYRILLIC SMALL LETTER EM
1353 #x043D ;; 237:CYRILLIC SMALL LETTER EN
1354 #x043E ;; 238:CYRILLIC SMALL LETTER O
1355 #x043F ;; 239:CYRILLIC SMALL LETTER PE
1356 #x0440 ;; 240:CYRILLIC SMALL LETTER ER
1357 #x0441 ;; 241:CYRILLIC SMALL LETTER ES
1358 #x0442 ;; 242:CYRILLIC SMALL LETTER TE
1359 #x0443 ;; 243:CYRILLIC SMALL LETTER U
1360 #x0444 ;; 244:CYRILLIC SMALL LETTER EF
1361 #x0445 ;; 245:CYRILLIC SMALL LETTER HA
1362 #x0446 ;; 246:CYRILLIC SMALL LETTER TSE
1363 #x0447 ;; 247:CYRILLIC SMALL LETTER CHE
1364 #x0448 ;; 248:CYRILLIC SMALL LETTER SHA
1365 #x0449 ;; 249:CYRILLIC SMALL LETTER SHCHA
1366 #x044A ;; 250:CYRILLIC SMALL LETTER HARD SIGN
1367 #x044B ;; 251:CYRILLIC SMALL LETTER YERU
1368 #x044C ;; 252:CYRILLIC SMALL LETTER SOFT SIGN
1369 #x044D ;; 253:CYRILLIC SMALL LETTER E
1370 #x044E ;; 254:CYRILLIC SMALL LETTER YU
1371 #x20AC ;; 255:EURO SIGN
1375 (aset encoding-vector i i)
1378 (aset encoding-vector i
1379 (decode-char 'ucs (aref vec (- i 128))))
1381 (setq translation-table
1382 (make-translation-table-from-vector encoding-vector))
1383 ;; (define-translation-table 'mac-cyrillic-decoder translation-table)
1384 (define-translation-table 'mac-cyrillic-encoder
1385 (char-table-extra-slot translation-table 0)))
1387 (defvar mac-font-encoder-list
1388 '(("mac-roman" mac-roman-encoder
1389 ccl-encode-mac-roman-font "%s")
1390 ("mac-centraleurroman" mac-centraleurroman-encoder
1391 ccl-encode-mac-centraleurroman-font "%s ce")
1392 ("mac-cyrillic" mac-cyrillic-encoder
1393 ccl-encode-mac-cyrillic-font "%s cy")))
1396 (mapcar (lambda (lst) (nth 1 lst)) mac-font-encoder-list))
1399 latin-iso8859-3 latin-iso8859-4
1400 cyrillic-iso8859-5 greek-iso8859-7 hebrew-iso8859-8
1401 latin-iso8859-9 latin-iso8859-14 latin-iso8859-15)))
1402 (dolist (encoder encoder-list)
1403 (let ((table (get encoder 'translation-table)))
1404 (dolist (charset charset-list)
1406 (let* ((c (make-char charset (+ i 32)))
1407 (mu (aref ucs-mule-to-mule-unicode c))
1408 (mac-encoded (and mu (aref table mu))))
1410 (aset table c mac-encoded))))))))
1412 (define-ccl-program ccl-encode-mac-centraleurroman-font
1414 (if (r0 != ,(charset-id 'ascii))
1416 (translate-character mac-centraleurroman-encoder r0 r1)
1419 (translate-character mac-centraleurroman-encoder r0 r1)))))
1420 "CCL program for Mac Central European Roman font")
1422 (define-ccl-program ccl-encode-mac-cyrillic-font
1424 (if (r0 != ,(charset-id 'ascii))
1426 (translate-character mac-cyrillic-encoder r0 r1)
1429 (translate-character mac-cyrillic-encoder r0 r1)))))
1430 "CCL program for Mac Cyrillic font")
1433 (setq font-ccl-encoder-alist
1435 (mapcar (lambda (lst) (cons (nth 0 lst) (nth 2 lst)))
1436 mac-font-encoder-list)
1437 font-ccl-encoder-alist))
1439 (defun fontset-add-mac-fonts (fontset &optional base-family)
1441 (setq base-family (downcase base-family))
1443 (downcase (x-resolve-font-name
1444 (fontset-font fontset (charset-id 'ascii))))))
1445 (setq base-family (aref (x-decompose-font-name ascii-font)
1446 xlfd-regexp-family-subnum))))
1447 ;; (if (not (string-match "^fontset-" fontset))
1449 ;; (concat "fontset-" (aref (x-decompose-font-name fontset)
1450 ;; xlfd-regexp-encoding-subnum))))
1454 (mapcar (lambda (lst)
1455 (cons (cons (format (nth 3 lst) base-family) (nth 0 lst))
1457 mac-font-encoder-list)))
1458 (let ((font (car font-encoder))
1459 (encoder (cdr font-encoder)))
1463 (generic-char-p key)
1464 (memq (char-charset key)
1465 '(ascii eight-bit-control eight-bit-graphic))
1466 (set-fontset-font fontset key font)))
1467 (get encoder 'translation-table)))))
1469 (defun create-fontset-from-mac-roman-font (font &optional resolved-font
1471 "Create a fontset from a Mac roman font FONT.
1473 Optional 1st arg RESOLVED-FONT is a resolved name of FONT. If
1474 omitted, `x-resolve-font-name' is called to get the resolved name. At
1475 this time, if FONT is not available, error is signaled.
1477 Optional 2nd arg FONTSET-NAME is a string to be used in
1478 `<CHARSET_ENCODING>' fields of a new fontset name. If it is omitted,
1479 an appropriate name is generated automatically.
1481 It returns a name of the created fontset."
1483 (create-fontset-from-ascii-font font resolved-font fontset-name)))
1484 (fontset-add-mac-fonts fontset)
1487 ;; Setup the default fontset.
1488 (setup-default-fontset)
1490 ;; Create a fontset that uses mac-roman font. With this fontset,
1491 ;; characters decoded from mac-roman encoding (ascii, latin-iso8859-1,
1492 ;; and mule-unicode-xxxx-yyyy) are displayed by a mac-roman font.
1493 (create-fontset-from-fontset-spec
1494 "-etl-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-mac,
1495 ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman")
1496 (fontset-add-mac-fonts "fontset-mac")
1498 ;; Create fontset specified in X resources "Fontset-N" (N is 0, 1, ...).
1499 (create-fontset-from-x-resource)
1501 ;; Try to create a fontset from a font specification which comes
1502 ;; from initial-frame-alist, default-frame-alist, or X resource.
1503 ;; A font specification in command line argument (i.e. -fn XXXX)
1504 ;; should be already in default-frame-alist as a `font'
1505 ;; parameter. However, any font specifications in site-start
1506 ;; library, user's init file (.emacs), and default.el are not
1507 ;; yet handled here.
1509 (let ((font (or (cdr (assq 'font initial-frame-alist))
1510 (cdr (assq 'font default-frame-alist))
1511 (x-get-resource "font" "Font")))
1512 xlfd-fields resolved-name)
1514 (not (query-fontset font))
1515 (setq resolved-name (x-resolve-font-name font))
1516 (setq xlfd-fields (x-decompose-font-name font)))
1517 (if (string= "fontset" (aref xlfd-fields xlfd-regexp-registry-subnum))
1518 (new-fontset font (x-complement-fontset-spec xlfd-fields nil))
1519 ;; Create a fontset from FONT. The fontset name is
1520 ;; generated from FONT.
1521 (create-fontset-from-ascii-font font resolved-name "startup"))))
1523 ;; Apply a geometry resource to the initial frame. Put it at the end
1524 ;; of the alist, so that anything specified on the command line takes
1526 (let* ((res-geometry (x-get-resource "geometry" "Geometry"))
1530 (setq parsed (x-parse-geometry res-geometry))
1531 ;; If the resource specifies a position,
1532 ;; call the position and size "user-specified".
1533 (if (or (assq 'top parsed) (assq 'left parsed))
1534 (setq parsed (cons '(user-position . t)
1535 (cons '(user-size . t) parsed))))
1536 ;; All geometry parms apply to the initial frame.
1537 (setq initial-frame-alist (append initial-frame-alist parsed))
1538 ;; The size parms apply to all frames.
1539 (if (assq 'height parsed)
1540 (setq default-frame-alist
1541 (cons (cons 'height (cdr (assq 'height parsed)))
1542 default-frame-alist)))
1543 (if (assq 'width parsed)
1544 (setq default-frame-alist
1545 (cons (cons 'width (cdr (assq 'width parsed)))
1546 default-frame-alist))))))
1548 ;; Check the reverseVideo resource.
1549 (let ((case-fold-search t))
1550 (let ((rv (x-get-resource "reverseVideo" "ReverseVideo")))
1552 (string-match "^\\(true\\|yes\\|on\\)$" rv))
1553 (setq default-frame-alist
1554 (cons '(reverse . t) default-frame-alist)))))
1556 (defun x-win-suspend-error ()
1557 (error "Suspending an Emacs running under Mac makes no sense"))
1558 (add-hook 'suspend-hook 'x-win-suspend-error)
1560 ;; Don't show the frame name; that's redundant.
1561 (setq-default mode-line-frame-identification " ")
1563 ;; Turn on support for mouse wheels.
1564 (mouse-wheel-mode 1)
1566 (defun mac-drag-n-drop (event)
1567 "Edit the files listed in the drag-n-drop EVENT.
1568 Switch to a buffer editing the last file dropped."
1570 ;; Make sure the drop target has positive co-ords
1571 ;; before setting the selected frame - otherwise it
1572 ;; won't work. <skx@tardis.ed.ac.uk>
1573 (let* ((window (posn-window (event-start event)))
1574 (coords (posn-x-y (event-start event)))
1577 (if (and (> x 0) (> y 0))
1578 (set-frame-selected-window nil window))
1579 (mapcar (lambda (file-name)
1580 (if (listp file-name)
1581 (let ((line (car file-name))
1582 (start (car (cdr file-name)))
1583 (end (car (cdr (cdr file-name)))))
1586 (if (and (> start 0) (> end 0))
1587 (progn (set-mark start)
1589 (x-dnd-handle-one-url window 'private
1590 (concat "file:" file-name))))
1591 (car (cdr (cdr event)))))
1594 (global-set-key [drag-n-drop] 'mac-drag-n-drop)
1596 ;; By checking whether the variable mac-ready-for-drag-n-drop has been
1597 ;; defined, the event loop in macterm.c can be informed that it can
1598 ;; now receive Finder drag and drop events. Files dropped onto the
1599 ;; Emacs application icon can only be processed when the initial frame
1600 ;; has been created: this is where the files should be opened.
1601 (add-hook 'after-init-hook
1603 (defvar mac-ready-for-drag-n-drop t)))
1608 ;; (defun mac-handle-scroll-bar-event (event) (interactive "e") (princ event))
1610 ;;(global-set-key [vertical-scroll-bar mouse-1] 'mac-handle-scroll-bar-event)
1613 [vertical-scroll-bar down-mouse-1]
1614 'mac-handle-scroll-bar-event)
1616 (global-unset-key [vertical-scroll-bar drag-mouse-1])
1617 (global-unset-key [vertical-scroll-bar mouse-1])
1619 (defun mac-handle-scroll-bar-event (event)
1620 "Handle scroll bar EVENT to emulate Mac Toolbox style scrolling."
1622 (let* ((position (event-start event))
1623 (window (nth 0 position))
1624 (bar-part (nth 4 position)))
1625 (select-window window)
1628 (goto-char (window-start window))
1629 (mac-scroll-down-line))
1630 ((eq bar-part 'above-handle)
1632 ((eq bar-part 'handle)
1633 (scroll-bar-drag event))
1634 ((eq bar-part 'below-handle)
1636 ((eq bar-part 'down)
1637 (goto-char (window-start window))
1638 (mac-scroll-up-line)))))
1640 (defun mac-scroll-ignore-events ()
1641 ;; Ignore confusing non-mouse events
1642 (while (not (memq (car-safe (read-event))
1643 '(mouse-1 double-mouse-1 triple-mouse-1))) nil))
1645 (defun mac-scroll-down ()
1647 (mac-scroll-ignore-events)
1650 (defun mac-scroll-down-line ()
1652 (mac-scroll-ignore-events)
1655 (defun mac-scroll-up ()
1657 (mac-scroll-ignore-events)
1660 (defun mac-scroll-up-line ()
1662 (mac-scroll-ignore-events)
1668 (unless (eq system-type 'darwin)
1669 ;; This variable specifies the Unix program to call (as a process) to
1670 ;; deteremine the amount of free space on a file system (defaults to
1671 ;; df). If it is not set to nil, ls-lisp will not work correctly
1672 ;; unless an external application df is implemented on the Mac.
1673 (setq directory-free-space-program nil)
1675 ;; Set this so that Emacs calls subprocesses with "sh" as shell to
1676 ;; expand filenames Note no subprocess for the shell is actually
1677 ;; started (see run_mac_command in sysdep.c).
1678 (setq shell-file-name "sh"))
1680 ;; X Window emulation in macterm.c is not complete enough to start a
1681 ;; frame without a minibuffer properly. Call this to tell ediff
1682 ;; library to use a single frame.
1683 ; (ediff-toggle-multiframe)
1685 (if (eq system-type 'darwin)
1686 ;; On Darwin filenames are encoded in UTF-8
1687 (setq file-name-coding-system 'utf-8)
1688 ;; To display filenames in Chinese or Japanese, replace mac-roman with
1690 (setq file-name-coding-system 'mac-roman))
1692 ;; If Emacs is started from the Finder, change the default directory
1693 ;; to the user's home directory.
1694 (if (string= default-directory "/")
1697 ;; Tell Emacs to use pipes instead of pty's for processes because the
1698 ;; latter sometimes lose characters. Pty support is compiled in since
1699 ;; ange-ftp will not work without it.
1700 (setq process-connection-type nil)
1702 ;; Assume that fonts are always scalable on the Mac. This sometimes
1703 ;; results in characters with jagged edges. However, without it,
1704 ;; fonts with both truetype and bitmap representations but no italic
1705 ;; or bold bitmap versions will not display these variants correctly.
1706 (setq scalable-fonts-allowed t)
1708 ;; (prefer-coding-system 'mac-roman)
1710 ;;; arch-tag: 71dfcd14-cde8-4d66-b05c-85ec94fb23a6
1711 ;;; mac-win.el ends here