aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorSteven Tamm2004-12-27 17:23:02 +0000
committerSteven Tamm2004-12-27 17:23:02 +0000
commit74e2abe26a974d64a1fe006dd99c061c91d71773 (patch)
treee24d49b535c8d00eed65dbfc741be28f7f334c8c
parente6973a25b62c21f94d84cb7e7d4082a1ee0d233e (diff)
downloademacs-74e2abe26a974d64a1fe006dd99c061c91d71773.tar.gz
emacs-74e2abe26a974d64a1fe006dd99c061c91d71773.zip
* term/mac-win.el: Sync with x-win.el. Rearrange the contents.
Call mac-clear-font-name-table if invoked on Mac OS 8/9. Call x-open-connection on Mac OS X.
Diffstat
-rw-r--r--lisp/ChangeLog6
-rw-r--r--lisp/term/mac-win.el1516
2 files changed, 911 insertions, 611 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 52f19eaf78b..f3f943a52a2 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
12004-12-27 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
2
3 * term/mac-win.el: Sync with x-win.el. Rearrange the contents.
4 Call mac-clear-font-name-table if invoked on Mac OS 8/9. Call
5 x-open-connection on Mac OS X.
6
12004-12-27 Richard M. Stallman <rms@gnu.org> 72004-12-27 Richard M. Stallman <rms@gnu.org>
2 8
3 * bookmark.el (bookmark-jump): Nice error if BOOKMARK is nil. 9 * bookmark.el (bookmark-jump): Nice error if BOOKMARK is nil.
diff --git a/lisp/term/mac-win.el b/lisp/term/mac-win.el
index 2b5c4d2a994..8cfce66c214 100644
--- a/lisp/term/mac-win.el
+++ b/lisp/term/mac-win.el
@@ -1,8 +1,9 @@
1;;; mac-win.el --- support for "Macintosh windows" 1;;; mac-win.el --- parse switches controlling interface with Mac window system
2 2
3;; Copyright (C) 1999, 2000, 2002, 2003 Free Software Foundation, Inc. 3;; Copyright (C) 1999, 2000, 2002, 2003, 2004 Free Software Foundation, Inc.
4 4
5;; Author: Andrew Choi <akochoi@mac.com> 5;; Author: Andrew Choi <akochoi@mac.com>
6;; Keywords: terminals
6 7
7;; This file is part of GNU Emacs. 8;; This file is part of GNU Emacs.
8 9
@@ -23,634 +24,212 @@
23 24
24;;; Commentary: 25;;; Commentary:
25 26
26;;; Code: 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.
27 31
28;; --------------------------------------------------------------------------- 32;; startup.el will then examine startup files, and eventually call the hooks
29;; We want to delay setting frame parameters until the faces are setup 33;; which create the first window(s).
30 34
31;; Mac can't handle ~ prefix in file names 35;;; Code:
32;(setq auto-save-list-file-prefix ".saves-") 36
37;; These are the standard X switches from the Xt Initialize.c file of
38;; Release 4.
33 39
34(setq frame-creation-function 'x-create-frame-with-faces) 40;; Command line Resource Manager string
35 41
36;; for debugging 42;; +rv *reverseVideo
37;; (defun mac-handle-scroll-bar-event (event) (interactive "e") (princ event)) 43;; +synchronous *synchronous
44;; -background *background
45;; -bd *borderColor
46;; -bg *background
47;; -bordercolor *borderColor
48;; -borderwidth .borderWidth
49;; -bw .borderWidth
50;; -display .display
51;; -fg *foreground
52;; -fn *font
53;; -font *font
54;; -foreground *foreground
55;; -geometry .geometry
56;; -i .iconType
57;; -itype .iconType
58;; -iconic .iconic
59;; -name .name
60;; -reverse *reverseVideo
61;; -rv *reverseVideo
62;; -selectionTimeout .selectionTimeout
63;; -synchronous *synchronous
64;; -xrm
38 65
39;;(global-set-key [vertical-scroll-bar mouse-1] 'mac-handle-scroll-bar-event) 66;; An alist of X options and the function which handles them. See
67;; ../startup.el.
40 68
41(global-set-key 69(if (not (eq window-system 'mac))
42 [vertical-scroll-bar down-mouse-1] 70 (error "%s: Loading mac-win.el but not compiled for Mac" (invocation-name)))
43 'mac-handle-scroll-bar-event)
44
45(global-unset-key [vertical-scroll-bar drag-mouse-1])
46(global-unset-key [vertical-scroll-bar mouse-1])
47 71
72(require 'frame)
73(require 'mouse)
48(require 'scroll-bar) 74(require 'scroll-bar)
75(require 'faces)
76;;(require 'select)
77(require 'menu-bar)
78(require 'fontset)
79;;(require 'x-dnd)
49 80
50(defun mac-handle-scroll-bar-event (event) 81(defvar x-invocation-args)
51 "Handle scroll bar EVENT to emulate Mac Toolbox style scrolling."
52 (interactive "e")
53 (let* ((position (event-start event))
54 (window (nth 0 position))
55 (bar-part (nth 4 position)))
56 (select-window window)
57 (cond
58 ((eq bar-part 'up)
59 (goto-char (window-start window))
60 (mac-scroll-down-line))
61 ((eq bar-part 'above-handle)
62 (mac-scroll-down))
63 ((eq bar-part 'handle)
64 (scroll-bar-drag event))
65 ((eq bar-part 'below-handle)
66 (mac-scroll-up))
67 ((eq bar-part 'down)
68 (goto-char (window-start window))
69 (mac-scroll-up-line)))))
70 82
71(defun mac-scroll-ignore-events () 83(defvar x-command-line-resources nil)
72 ;; Ignore confusing non-mouse events
73 (while (not (memq (car-safe (read-event))
74 '(mouse-1 double-mouse-1 triple-mouse-1))) nil))
75 84
76(defun mac-scroll-down () 85;; Handler for switches of the form "-switch value" or "-switch".
77 (track-mouse 86(defun x-handle-switch (switch)
78 (mac-scroll-ignore-events) 87 (let ((aelt (assoc switch command-line-x-option-alist)))
79 (scroll-down))) 88 (if aelt
89 (let ((param (nth 3 aelt))
90 (value (nth 4 aelt)))
91 (if value
92 (setq default-frame-alist
93 (cons (cons param value)
94 default-frame-alist))
95 (setq default-frame-alist
96 (cons (cons param
97 (car x-invocation-args))
98 default-frame-alist)
99 x-invocation-args (cdr x-invocation-args)))))))
80 100
81(defun mac-scroll-down-line () 101;; Handler for switches of the form "-switch n"
82 (track-mouse 102(defun x-handle-numeric-switch (switch)
83 (mac-scroll-ignore-events) 103 (let ((aelt (assoc switch command-line-x-option-alist)))
84 (scroll-down 1))) 104 (if aelt
105 (let ((param (nth 3 aelt)))
106 (setq default-frame-alist
107 (cons (cons param
108 (string-to-int (car x-invocation-args)))
109 default-frame-alist)
110 x-invocation-args
111 (cdr x-invocation-args))))))
85 112
86(defun mac-scroll-up () 113;; Handle options that apply to initial frame only
87 (track-mouse 114(defun x-handle-initial-switch (switch)
88 (mac-scroll-ignore-events) 115 (let ((aelt (assoc switch command-line-x-option-alist)))
89 (scroll-up))) 116 (if aelt
117 (let ((param (nth 3 aelt))
118 (value (nth 4 aelt)))
119 (if value
120 (setq initial-frame-alist
121 (cons (cons param value)
122 initial-frame-alist))
123 (setq initial-frame-alist
124 (cons (cons param
125 (car x-invocation-args))
126 initial-frame-alist)
127 x-invocation-args (cdr x-invocation-args)))))))
90 128
91(defun mac-scroll-up-line () 129;; Make -iconic apply only to the initial frame!
92 (track-mouse 130(defun x-handle-iconic (switch)
93 (mac-scroll-ignore-events) 131 (setq initial-frame-alist
94 (scroll-up 1))) 132 (cons '(visibility . icon) initial-frame-alist)))
95 133
96(defun xw-defined-colors (&optional frame) 134;; Handle the -xrm option.
97 "Internal function called by `defined-colors', which see." 135(defun x-handle-xrm-switch (switch)
98 (or frame (setq frame (selected-frame))) 136 (unless (consp x-invocation-args)
99 (let ((all-colors x-colors) 137 (error "%s: missing argument to `%s' option" (invocation-name) switch))
100 (this-color nil) 138 (setq x-command-line-resources
101 (defined-colors nil)) 139 (if (null x-command-line-resources)
102 (while all-colors 140 (car x-invocation-args)
103 (setq this-color (car all-colors) 141 (concat x-command-line-resources "\n" (car x-invocation-args))))
104 all-colors (cdr all-colors)) 142 (setq x-invocation-args (cdr x-invocation-args)))
105 (and (color-supported-p this-color frame t)
106 (setq defined-colors (cons this-color defined-colors))))
107 defined-colors))
108 143
109;; Don't have this yet. 144;; Handle the geometry option
110(fset 'x-get-resource 'ignore) 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
154 '((user-size . t))
155 (if height (list height))
156 (if width (list width)))
157 initial-frame-alist
158 (append initial-frame-alist
159 '((user-size . t))
160 (if height (list height))
161 (if width (list width)))))
162 (if (or left top)
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))))
111 169
112(unless (eq system-type 'darwin) 170;; Handle the -name option. Set the variable x-resource-name
113 ;; This variable specifies the Unix program to call (as a process) to 171;; to the option's operand; set the name of
114 ;; deteremine the amount of free space on a file system (defaults to 172;; the initial frame, too.
115 ;; df). If it is not set to nil, ls-lisp will not work correctly 173(defun x-handle-name-switch (switch)
116 ;; unless an external application df is implemented on the Mac. 174 (or (consp x-invocation-args)
117 (setq directory-free-space-program nil) 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)))
118 180
119 ;; Set this so that Emacs calls subprocesses with "sh" as shell to 181(defvar x-display-name nil
120 ;; expand filenames Note no subprocess for the shell is actually 182 "The display name specifying server and frame.")
121 ;; started (see run_mac_command in sysdep.c).
122 (setq shell-file-name "sh"))
123 183
124;; X Window emulation in macterm.c is not complete enough to start a 184(defun x-handle-display (switch)
125;; frame without a minibuffer properly. Call this to tell ediff 185 (setq x-display-name (car x-invocation-args)
126;; library to use a single frame. 186 x-invocation-args (cdr x-invocation-args)))
127; (ediff-toggle-multiframe)
128
129;; Setup to use the Mac clipboard. The functions mac-cut-function and
130;; mac-paste-function are defined in mac.c.
131(set-selection-coding-system 'compound-text-mac)
132
133(setq interprogram-cut-function
134 '(lambda (str push)
135 (mac-cut-function
136 (encode-coding-string str selection-coding-system t) push)))
137
138(setq interprogram-paste-function
139 '(lambda ()
140 (let ((clipboard (mac-paste-function)))
141 (if clipboard
142 (decode-coding-string clipboard selection-coding-system t)))))
143
144;; Don't show the frame name; that's redundant.
145(setq-default mode-line-frame-identification " ")
146
147(defun mac-drag-n-drop (event)
148 "Edit the files listed in the drag-n-drop event.\n\
149Switch to a buffer editing the last file dropped."
150 (interactive "e")
151 (save-excursion
152 ;; Make sure the drop target has positive co-ords
153 ;; before setting the selected frame - otherwise it
154 ;; won't work. <skx@tardis.ed.ac.uk>
155 (let* ((window (posn-window (event-start event)))
156 (coords (posn-x-y (event-start event)))
157 (x (car coords))
158 (y (cdr coords)))
159 (if (and (> x 0) (> y 0))
160 (set-frame-selected-window nil window))
161 (mapcar
162 '(lambda (file)
163 (find-file
164 (decode-coding-string
165 file
166 (or file-name-coding-system
167 default-file-name-coding-system))))
168 (car (cdr (cdr event)))))
169 (raise-frame)
170 (recenter)))
171
172(global-set-key [drag-n-drop] 'mac-drag-n-drop)
173
174;; By checking whether the variable mac-ready-for-drag-n-drop has been
175;; defined, the event loop in macterm.c can be informed that it can
176;; now receive Finder drag and drop events. Files dropped onto the
177;; Emacs application icon can only be processed when the initial frame
178;; has been created: this is where the files should be opened.
179(add-hook 'after-init-hook
180 '(lambda ()
181 (defvar mac-ready-for-drag-n-drop t)))
182
183; Define constant values to be set to mac-keyboard-text-encoding
184(defconst kTextEncodingMacRoman 0)
185(defconst kTextEncodingISOLatin1 513 "0x201")
186(defconst kTextEncodingISOLatin2 514 "0x202")
187
188
189(define-ccl-program ccl-encode-mac-roman-font
190 `(0
191 (if (r0 != ,(charset-id 'ascii))
192 (if (r0 <= ?\x8f)
193 (translate-character mac-roman-encoder r0 r1)
194 ((r1 <<= 7)
195 (r1 |= r2)
196 (translate-character mac-roman-encoder r0 r1)))))
197 "CCL program for Mac Roman font")
198
199(let
200 ((encoding-vector (make-vector 256 nil))
201 (i 0)
202 (vec ;; mac-centraleurroman (128..255) -> UCS mapping
203 [ #x00C4 ;; 128:LATIN CAPITAL LETTER A WITH DIAERESIS
204 #x0100 ;; 129:LATIN CAPITAL LETTER A WITH MACRON
205 #x0101 ;; 130:LATIN SMALL LETTER A WITH MACRON
206 #x00C9 ;; 131:LATIN CAPITAL LETTER E WITH ACUTE
207 #x0104 ;; 132:LATIN CAPITAL LETTER A WITH OGONEK
208 #x00D6 ;; 133:LATIN CAPITAL LETTER O WITH DIAERESIS
209 #x00DC ;; 134:LATIN CAPITAL LETTER U WITH DIAERESIS
210 #x00E1 ;; 135:LATIN SMALL LETTER A WITH ACUTE
211 #x0105 ;; 136:LATIN SMALL LETTER A WITH OGONEK
212 #x010C ;; 137:LATIN CAPITAL LETTER C WITH CARON
213 #x00E4 ;; 138:LATIN SMALL LETTER A WITH DIAERESIS
214 #x010D ;; 139:LATIN SMALL LETTER C WITH CARON
215 #x0106 ;; 140:LATIN CAPITAL LETTER C WITH ACUTE
216 #x0107 ;; 141:LATIN SMALL LETTER C WITH ACUTE
217 #x00E9 ;; 142:LATIN SMALL LETTER E WITH ACUTE
218 #x0179 ;; 143:LATIN CAPITAL LETTER Z WITH ACUTE
219 #x017A ;; 144:LATIN SMALL LETTER Z WITH ACUTE
220 #x010E ;; 145:LATIN CAPITAL LETTER D WITH CARON
221 #x00ED ;; 146:LATIN SMALL LETTER I WITH ACUTE
222 #x010F ;; 147:LATIN SMALL LETTER D WITH CARON
223 #x0112 ;; 148:LATIN CAPITAL LETTER E WITH MACRON
224 #x0113 ;; 149:LATIN SMALL LETTER E WITH MACRON
225 #x0116 ;; 150:LATIN CAPITAL LETTER E WITH DOT ABOVE
226 #x00F3 ;; 151:LATIN SMALL LETTER O WITH ACUTE
227 #x0117 ;; 152:LATIN SMALL LETTER E WITH DOT ABOVE
228 #x00F4 ;; 153:LATIN SMALL LETTER O WITH CIRCUMFLEX
229 #x00F6 ;; 154:LATIN SMALL LETTER O WITH DIAERESIS
230 #x00F5 ;; 155:LATIN SMALL LETTER O WITH TILDE
231 #x00FA ;; 156:LATIN SMALL LETTER U WITH ACUTE
232 #x011A ;; 157:LATIN CAPITAL LETTER E WITH CARON
233 #x011B ;; 158:LATIN SMALL LETTER E WITH CARON
234 #x00FC ;; 159:LATIN SMALL LETTER U WITH DIAERESIS
235 #x2020 ;; 160:DAGGER
236 #x00B0 ;; 161:DEGREE SIGN
237 #x0118 ;; 162:LATIN CAPITAL LETTER E WITH OGONEK
238 #x00A3 ;; 163:POUND SIGN
239 #x00A7 ;; 164:SECTION SIGN
240 #x2022 ;; 165:BULLET
241 #x00B6 ;; 166:PILCROW SIGN
242 #x00DF ;; 167:LATIN SMALL LETTER SHARP S
243 #x00AE ;; 168:REGISTERED SIGN
244 #x00A9 ;; 169:COPYRIGHT SIGN
245 #x2122 ;; 170:TRADE MARK SIGN
246 #x0119 ;; 171:LATIN SMALL LETTER E WITH OGONEK
247 #x00A8 ;; 172:DIAERESIS
248 #x2260 ;; 173:NOT EQUAL TO
249 #x0123 ;; 174:LATIN SMALL LETTER G WITH CEDILLA
250 #x012E ;; 175:LATIN CAPITAL LETTER I WITH OGONEK
251 #x012F ;; 176:LATIN SMALL LETTER I WITH OGONEK
252 #x012A ;; 177:LATIN CAPITAL LETTER I WITH MACRON
253 #x2264 ;; 178:LESS-THAN OR EQUAL TO
254 #x2265 ;; 179:GREATER-THAN OR EQUAL TO
255 #x012B ;; 180:LATIN SMALL LETTER I WITH MACRON
256 #x0136 ;; 181:LATIN CAPITAL LETTER K WITH CEDILLA
257 #x2202 ;; 182:PARTIAL DIFFERENTIAL
258 #x2211 ;; 183:N-ARY SUMMATION
259 #x0142 ;; 184:LATIN SMALL LETTER L WITH STROKE
260 #x013B ;; 185:LATIN CAPITAL LETTER L WITH CEDILLA
261 #x013C ;; 186:LATIN SMALL LETTER L WITH CEDILLA
262 #x013D ;; 187:LATIN CAPITAL LETTER L WITH CARON
263 #x013E ;; 188:LATIN SMALL LETTER L WITH CARON
264 #x0139 ;; 189:LATIN CAPITAL LETTER L WITH ACUTE
265 #x013A ;; 190:LATIN SMALL LETTER L WITH ACUTE
266 #x0145 ;; 191:LATIN CAPITAL LETTER N WITH CEDILLA
267 #x0146 ;; 192:LATIN SMALL LETTER N WITH CEDILLA
268 #x0143 ;; 193:LATIN CAPITAL LETTER N WITH ACUTE
269 #x00AC ;; 194:NOT SIGN
270 #x221A ;; 195:SQUARE ROOT
271 #x0144 ;; 196:LATIN SMALL LETTER N WITH ACUTE
272 #x0147 ;; 197:LATIN CAPITAL LETTER N WITH CARON
273 #x2206 ;; 198:INCREMENT
274 #x00AB ;; 199:LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
275 #x00BB ;; 200:RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
276 #x2026 ;; 201:HORIZONTAL ELLIPSIS
277 #x00A0 ;; 202:NO-BREAK SPACE
278 #x0148 ;; 203:LATIN SMALL LETTER N WITH CARON
279 #x0150 ;; 204:LATIN CAPITAL LETTER O WITH DOUBLE ACUTE
280 #x00D5 ;; 205:LATIN CAPITAL LETTER O WITH TILDE
281 #x0151 ;; 206:LATIN SMALL LETTER O WITH DOUBLE ACUTE
282 #x014C ;; 207:LATIN CAPITAL LETTER O WITH MACRON
283 #x2013 ;; 208:EN DASH
284 #x2014 ;; 209:EM DASH
285 #x201C ;; 210:LEFT DOUBLE QUOTATION MARK
286 #x201D ;; 211:RIGHT DOUBLE QUOTATION MARK
287 #x2018 ;; 212:LEFT SINGLE QUOTATION MARK
288 #x2019 ;; 213:RIGHT SINGLE QUOTATION MARK
289 #x00F7 ;; 214:DIVISION SIGN
290 #x25CA ;; 215:LOZENGE
291 #x014D ;; 216:LATIN SMALL LETTER O WITH MACRON
292 #x0154 ;; 217:LATIN CAPITAL LETTER R WITH ACUTE
293 #x0155 ;; 218:LATIN SMALL LETTER R WITH ACUTE
294 #x0158 ;; 219:LATIN CAPITAL LETTER R WITH CARON
295 #x2039 ;; 220:SINGLE LEFT-POINTING ANGLE QUOTATION MARK
296 #x203A ;; 221:SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
297 #x0159 ;; 222:LATIN SMALL LETTER R WITH CARON
298 #x0156 ;; 223:LATIN CAPITAL LETTER R WITH CEDILLA
299 #x0157 ;; 224:LATIN SMALL LETTER R WITH CEDILLA
300 #x0160 ;; 225:LATIN CAPITAL LETTER S WITH CARON
301 #x201A ;; 226:SINGLE LOW-9 QUOTATION MARK
302 #x201E ;; 227:DOUBLE LOW-9 QUOTATION MARK
303 #x0161 ;; 228:LATIN SMALL LETTER S WITH CARON
304 #x015A ;; 229:LATIN CAPITAL LETTER S WITH ACUTE
305 #x015B ;; 230:LATIN SMALL LETTER S WITH ACUTE
306 #x00C1 ;; 231:LATIN CAPITAL LETTER A WITH ACUTE
307 #x0164 ;; 232:LATIN CAPITAL LETTER T WITH CARON
308 #x0165 ;; 233:LATIN SMALL LETTER T WITH CARON
309 #x00CD ;; 234:LATIN CAPITAL LETTER I WITH ACUTE
310 #x017D ;; 235:LATIN CAPITAL LETTER Z WITH CARON
311 #x017E ;; 236:LATIN SMALL LETTER Z WITH CARON
312 #x016A ;; 237:LATIN CAPITAL LETTER U WITH MACRON
313 #x00D3 ;; 238:LATIN CAPITAL LETTER O WITH ACUTE
314 #x00D4 ;; 239:LATIN CAPITAL LETTER O WITH CIRCUMFLEX
315 #x016B ;; 240:LATIN SMALL LETTER U WITH MACRON
316 #x016E ;; 241:LATIN CAPITAL LETTER U WITH RING ABOVE
317 #x00DA ;; 242:LATIN CAPITAL LETTER U WITH ACUTE
318 #x016F ;; 243:LATIN SMALL LETTER U WITH RING ABOVE
319 #x0170 ;; 244:LATIN CAPITAL LETTER U WITH DOUBLE ACUTE
320 #x0171 ;; 245:LATIN SMALL LETTER U WITH DOUBLE ACUTE
321 #x0172 ;; 246:LATIN CAPITAL LETTER U WITH OGONEK
322 #x0173 ;; 247:LATIN SMALL LETTER U WITH OGONEK
323 #x00DD ;; 248:LATIN CAPITAL LETTER Y WITH ACUTE
324 #x00FD ;; 249:LATIN SMALL LETTER Y WITH ACUTE
325 #x0137 ;; 250:LATIN SMALL LETTER K WITH CEDILLA
326 #x017B ;; 251:LATIN CAPITAL LETTER Z WITH DOT ABOVE
327 #x0141 ;; 252:LATIN CAPITAL LETTER L WITH STROKE
328 #x017C ;; 253:LATIN SMALL LETTER Z WITH DOT ABOVE
329 #x0122 ;; 254:LATIN CAPITAL LETTER G WITH CEDILLA
330 #x02C7 ;; 255:CARON
331 ])
332 translation-table)
333 (while (< i 128)
334 (aset encoding-vector i i)
335 (setq i (1+ i)))
336 (while (< i 256)
337 (aset encoding-vector i
338 (decode-char 'ucs (aref vec (- i 128))))
339 (setq i (1+ i)))
340 (setq translation-table
341 (make-translation-table-from-vector encoding-vector))
342;; (define-translation-table 'mac-centraleurroman-decoder translation-table)
343 (define-translation-table 'mac-centraleurroman-encoder
344 (char-table-extra-slot translation-table 0)))
345
346(let
347 ((encoding-vector (make-vector 256 nil))
348 (i 0)
349 (vec ;; mac-cyrillic (128..255) -> UCS mapping
350 [ #x0410 ;; 128:CYRILLIC CAPITAL LETTER A
351 #x0411 ;; 129:CYRILLIC CAPITAL LETTER BE
352 #x0412 ;; 130:CYRILLIC CAPITAL LETTER VE
353 #x0413 ;; 131:CYRILLIC CAPITAL LETTER GHE
354 #x0414 ;; 132:CYRILLIC CAPITAL LETTER DE
355 #x0415 ;; 133:CYRILLIC CAPITAL LETTER IE
356 #x0416 ;; 134:CYRILLIC CAPITAL LETTER ZHE
357 #x0417 ;; 135:CYRILLIC CAPITAL LETTER ZE
358 #x0418 ;; 136:CYRILLIC CAPITAL LETTER I
359 #x0419 ;; 137:CYRILLIC CAPITAL LETTER SHORT I
360 #x041A ;; 138:CYRILLIC CAPITAL LETTER KA
361 #x041B ;; 139:CYRILLIC CAPITAL LETTER EL
362 #x041C ;; 140:CYRILLIC CAPITAL LETTER EM
363 #x041D ;; 141:CYRILLIC CAPITAL LETTER EN
364 #x041E ;; 142:CYRILLIC CAPITAL LETTER O
365 #x041F ;; 143:CYRILLIC CAPITAL LETTER PE
366 #x0420 ;; 144:CYRILLIC CAPITAL LETTER ER
367 #x0421 ;; 145:CYRILLIC CAPITAL LETTER ES
368 #x0422 ;; 146:CYRILLIC CAPITAL LETTER TE
369 #x0423 ;; 147:CYRILLIC CAPITAL LETTER U
370 #x0424 ;; 148:CYRILLIC CAPITAL LETTER EF
371 #x0425 ;; 149:CYRILLIC CAPITAL LETTER HA
372 #x0426 ;; 150:CYRILLIC CAPITAL LETTER TSE
373 #x0427 ;; 151:CYRILLIC CAPITAL LETTER CHE
374 #x0428 ;; 152:CYRILLIC CAPITAL LETTER SHA
375 #x0429 ;; 153:CYRILLIC CAPITAL LETTER SHCHA
376 #x042A ;; 154:CYRILLIC CAPITAL LETTER HARD SIGN
377 #x042B ;; 155:CYRILLIC CAPITAL LETTER YERU
378 #x042C ;; 156:CYRILLIC CAPITAL LETTER SOFT SIGN
379 #x042D ;; 157:CYRILLIC CAPITAL LETTER E
380 #x042E ;; 158:CYRILLIC CAPITAL LETTER YU
381 #x042F ;; 159:CYRILLIC CAPITAL LETTER YA
382 #x2020 ;; 160:DAGGER
383 #x00B0 ;; 161:DEGREE SIGN
384 #x0490 ;; 162:CYRILLIC CAPITAL LETTER GHE WITH UPTURN
385 #x00A3 ;; 163:POUND SIGN
386 #x00A7 ;; 164:SECTION SIGN
387 #x2022 ;; 165:BULLET
388 #x00B6 ;; 166:PILCROW SIGN
389 #x0406 ;; 167:CYRILLIC CAPITAL LETTER BYELORUSSIAN-UKRAINIAN I
390 #x00AE ;; 168:REGISTERED SIGN
391 #x00A9 ;; 169:COPYRIGHT SIGN
392 #x2122 ;; 170:TRADE MARK SIGN
393 #x0402 ;; 171:CYRILLIC CAPITAL LETTER DJE
394 #x0452 ;; 172:CYRILLIC SMALL LETTER DJE
395 #x2260 ;; 173:NOT EQUAL TO
396 #x0403 ;; 174:CYRILLIC CAPITAL LETTER GJE
397 #x0453 ;; 175:CYRILLIC SMALL LETTER GJE
398 #x221E ;; 176:INFINITY
399 #x00B1 ;; 177:PLUS-MINUS SIGN
400 #x2264 ;; 178:LESS-THAN OR EQUAL TO
401 #x2265 ;; 179:GREATER-THAN OR EQUAL TO
402 #x0456 ;; 180:CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN I
403 #x00B5 ;; 181:MICRO SIGN
404 #x0491 ;; 182:CYRILLIC SMALL LETTER GHE WITH UPTURN
405 #x0408 ;; 183:CYRILLIC CAPITAL LETTER JE
406 #x0404 ;; 184:CYRILLIC CAPITAL LETTER UKRAINIAN IE
407 #x0454 ;; 185:CYRILLIC SMALL LETTER UKRAINIAN IE
408 #x0407 ;; 186:CYRILLIC CAPITAL LETTER YI
409 #x0457 ;; 187:CYRILLIC SMALL LETTER YI
410 #x0409 ;; 188:CYRILLIC CAPITAL LETTER LJE
411 #x0459 ;; 189:CYRILLIC SMALL LETTER LJE
412 #x040A ;; 190:CYRILLIC CAPITAL LETTER NJE
413 #x045A ;; 191:CYRILLIC SMALL LETTER NJE
414 #x0458 ;; 192:CYRILLIC SMALL LETTER JE
415 #x0405 ;; 193:CYRILLIC CAPITAL LETTER DZE
416 #x00AC ;; 194:NOT SIGN
417 #x221A ;; 195:SQUARE ROOT
418 #x0192 ;; 196:LATIN SMALL LETTER F WITH HOOK
419 #x2248 ;; 197:ALMOST EQUAL TO
420 #x2206 ;; 198:INCREMENT
421 #x00AB ;; 199:LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
422 #x00BB ;; 200:RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
423 #x2026 ;; 201:HORIZONTAL ELLIPSIS
424 #x00A0 ;; 202:NO-BREAK SPACE
425 #x040B ;; 203:CYRILLIC CAPITAL LETTER TSHE
426 #x045B ;; 204:CYRILLIC SMALL LETTER TSHE
427 #x040C ;; 205:CYRILLIC CAPITAL LETTER KJE
428 #x045C ;; 206:CYRILLIC SMALL LETTER KJE
429 #x0455 ;; 207:CYRILLIC SMALL LETTER DZE
430 #x2013 ;; 208:EN DASH
431 #x2014 ;; 209:EM DASH
432 #x201C ;; 210:LEFT DOUBLE QUOTATION MARK
433 #x201D ;; 211:RIGHT DOUBLE QUOTATION MARK
434 #x2018 ;; 212:LEFT SINGLE QUOTATION MARK
435 #x2019 ;; 213:RIGHT SINGLE QUOTATION MARK
436 #x00F7 ;; 214:DIVISION SIGN
437 #x201E ;; 215:DOUBLE LOW-9 QUOTATION MARK
438 #x040E ;; 216:CYRILLIC CAPITAL LETTER SHORT U
439 #x045E ;; 217:CYRILLIC SMALL LETTER SHORT U
440 #x040F ;; 218:CYRILLIC CAPITAL LETTER DZHE
441 #x045F ;; 219:CYRILLIC SMALL LETTER DZHE
442 #x2116 ;; 220:NUMERO SIGN
443 #x0401 ;; 221:CYRILLIC CAPITAL LETTER IO
444 #x0451 ;; 222:CYRILLIC SMALL LETTER IO
445 #x044F ;; 223:CYRILLIC SMALL LETTER YA
446 #x0430 ;; 224:CYRILLIC SMALL LETTER A
447 #x0431 ;; 225:CYRILLIC SMALL LETTER BE
448 #x0432 ;; 226:CYRILLIC SMALL LETTER VE
449 #x0433 ;; 227:CYRILLIC SMALL LETTER GHE
450 #x0434 ;; 228:CYRILLIC SMALL LETTER DE
451 #x0435 ;; 229:CYRILLIC SMALL LETTER IE
452 #x0436 ;; 230:CYRILLIC SMALL LETTER ZHE
453 #x0437 ;; 231:CYRILLIC SMALL LETTER ZE
454 #x0438 ;; 232:CYRILLIC SMALL LETTER I
455 #x0439 ;; 233:CYRILLIC SMALL LETTER SHORT I
456 #x043A ;; 234:CYRILLIC SMALL LETTER KA
457 #x043B ;; 235:CYRILLIC SMALL LETTER EL
458 #x043C ;; 236:CYRILLIC SMALL LETTER EM
459 #x043D ;; 237:CYRILLIC SMALL LETTER EN
460 #x043E ;; 238:CYRILLIC SMALL LETTER O
461 #x043F ;; 239:CYRILLIC SMALL LETTER PE
462 #x0440 ;; 240:CYRILLIC SMALL LETTER ER
463 #x0441 ;; 241:CYRILLIC SMALL LETTER ES
464 #x0442 ;; 242:CYRILLIC SMALL LETTER TE
465 #x0443 ;; 243:CYRILLIC SMALL LETTER U
466 #x0444 ;; 244:CYRILLIC SMALL LETTER EF
467 #x0445 ;; 245:CYRILLIC SMALL LETTER HA
468 #x0446 ;; 246:CYRILLIC SMALL LETTER TSE
469 #x0447 ;; 247:CYRILLIC SMALL LETTER CHE
470 #x0448 ;; 248:CYRILLIC SMALL LETTER SHA
471 #x0449 ;; 249:CYRILLIC SMALL LETTER SHCHA
472 #x044A ;; 250:CYRILLIC SMALL LETTER HARD SIGN
473 #x044B ;; 251:CYRILLIC SMALL LETTER YERU
474 #x044C ;; 252:CYRILLIC SMALL LETTER SOFT SIGN
475 #x044D ;; 253:CYRILLIC SMALL LETTER E
476 #x044E ;; 254:CYRILLIC SMALL LETTER YU
477 #x20AC ;; 255:EURO SIGN
478 ])
479 translation-table)
480 (while (< i 128)
481 (aset encoding-vector i i)
482 (setq i (1+ i)))
483 (while (< i 256)
484 (aset encoding-vector i
485 (decode-char 'ucs (aref vec (- i 128))))
486 (setq i (1+ i)))
487 (setq translation-table
488 (make-translation-table-from-vector encoding-vector))
489;; (define-translation-table 'mac-cyrillic-decoder translation-table)
490 (define-translation-table 'mac-cyrillic-encoder
491 (char-table-extra-slot translation-table 0)))
492
493(defvar mac-font-encoder-list
494 '(("mac-roman" mac-roman-encoder
495 ccl-encode-mac-roman-font "%s")
496 ("mac-centraleurroman" mac-centraleurroman-encoder
497 ccl-encode-mac-centraleurroman-font "%s ce")
498 ("mac-cyrillic" mac-cyrillic-encoder
499 ccl-encode-mac-cyrillic-font "%s cy")))
500
501(let ((encoder-list
502 (mapcar (lambda (lst) (nth 1 lst)) mac-font-encoder-list))
503 (charset-list
504 '(latin-iso8859-2
505 latin-iso8859-3 latin-iso8859-4
506 cyrillic-iso8859-5 greek-iso8859-7 hebrew-iso8859-8
507 latin-iso8859-9 latin-iso8859-14 latin-iso8859-15)))
508 (dolist (encoder encoder-list)
509 (let ((table (get encoder 'translation-table)))
510 (dolist (charset charset-list)
511 (dotimes (i 96)
512 (let* ((c (make-char charset (+ i 32)))
513 (mu (aref ucs-mule-to-mule-unicode c))
514 (mac-encoded (and mu (aref table mu))))
515 (if mac-encoded
516 (aset table c mac-encoded))))))))
517
518(define-ccl-program ccl-encode-mac-centraleurroman-font
519 `(0
520 (if (r0 != ,(charset-id 'ascii))
521 (if (r0 <= ?\x8f)
522 (translate-character mac-centraleurroman-encoder r0 r1)
523 ((r1 <<= 7)
524 (r1 |= r2)
525 (translate-character mac-centraleurroman-encoder r0 r1)))))
526 "CCL program for Mac Central European Roman font")
527
528(define-ccl-program ccl-encode-mac-cyrillic-font
529 `(0
530 (if (r0 != ,(charset-id 'ascii))
531 (if (r0 <= ?\x8f)
532 (translate-character mac-cyrillic-encoder r0 r1)
533 ((r1 <<= 7)
534 (r1 |= r2)
535 (translate-character mac-cyrillic-encoder r0 r1)))))
536 "CCL program for Mac Cyrillic font")
537
538
539(setq font-ccl-encoder-alist
540 (nconc
541 (mapcar (lambda (lst) (cons (nth 0 lst) (nth 2 lst)))
542 mac-font-encoder-list)
543 font-ccl-encoder-alist))
544
545(defun fontset-add-mac-fonts (fontset &optional base-family)
546 (if base-family
547 (setq base-family (downcase base-family))
548 (let ((ascii-font
549 (downcase (x-resolve-font-name
550 (fontset-font fontset (charset-id 'ascii))))))
551 (setq base-family (aref (x-decompose-font-name ascii-font)
552 xlfd-regexp-family-subnum))))
553;; (if (not (string-match "^fontset-" fontset))
554;; (setq fontset
555;; (concat "fontset-" (aref (x-decompose-font-name fontset)
556;; xlfd-regexp-encoding-subnum))))
557 (dolist
558 (font-encoder
559 (nreverse
560 (mapcar (lambda (lst)
561 (cons (cons (format (nth 3 lst) base-family) (nth 0 lst))
562 (nth 1 lst)))
563 mac-font-encoder-list)))
564 (let ((font (car font-encoder))
565 (encoder (cdr font-encoder)))
566 (map-char-table
567 (lambda (key val)
568 (or (null val)
569 (generic-char-p key)
570 (memq (char-charset key)
571 '(ascii eight-bit-control eight-bit-graphic))
572 (set-fontset-font fontset key font)))
573 (get encoder 'translation-table)))))
574
575(defun create-fontset-from-mac-roman-font (font &optional resolved-font
576 fontset-name)
577 "Create a fontset from a Mac roman font FONT.
578
579Optional 1st arg RESOLVED-FONT is a resolved name of FONT. If
580omitted, `x-resolve-font-name' is called to get the resolved name. At
581this time, if FONT is not available, error is signaled.
582
583Optional 2nd arg FONTSET-NAME is a string to be used in
584`<CHARSET_ENCODING>' fields of a new fontset name. If it is omitted,
585an appropriate name is generated automatically.
586
587It returns a name of the created fontset."
588 (let ((fontset
589 (create-fontset-from-ascii-font font resolved-font fontset-name)))
590 (fontset-add-mac-fonts fontset)
591 fontset))
592
593;; Create a fontset that uses mac-roman font. With this fontset,
594;; characters decoded from mac-roman encoding (ascii, latin-iso8859-1,
595;; and mule-unicode-xxxx-yyyy) are displayed by a mac-roman font.
596
597(if (fboundp 'new-fontset)
598 (progn
599 (require 'fontset)
600 (setup-default-fontset)
601 (create-fontset-from-fontset-spec
602 "-etl-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-mac,
603ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman")
604 (fontset-add-mac-fonts "fontset-mac")))
605
606(if (eq system-type 'darwin)
607 ;; On Darwin filenames are encoded in UTF-8
608 (setq file-name-coding-system 'utf-8)
609 ;; To display filenames in Chinese or Japanese, replace mac-roman with
610 ;; big5 or sjis
611 (setq file-name-coding-system 'mac-roman))
612
613;; If Emacs is started from the Finder, change the default directory
614;; to the user's home directory.
615(if (string= default-directory "/")
616 (cd "~"))
617
618;; Tell Emacs to use pipes instead of pty's for processes because the
619;; latter sometimes lose characters. Pty support is compiled in since
620;; ange-ftp will not work without it.
621(setq process-connection-type nil)
622
623;; Assume that fonts are always scalable on the Mac. This sometimes
624;; results in characters with jagged edges. However, without it,
625;; fonts with both truetype and bitmap representations but no italic
626;; or bold bitmap versions will not display these variants correctly.
627(setq scalable-fonts-allowed t)
628
629;; Make suspend-emacs [C-z] collapse the current frame
630(substitute-key-definition 'suspend-emacs 'iconify-frame
631 global-map)
632
633;; Support mouse-wheel scrolling
634(mouse-wheel-mode 1)
635
636;; (prefer-coding-system 'mac-roman)
637
638;; Map certain keypad keys into ASCII characters that people usually expect
639(define-key function-key-map [return] [?\C-m])
640(define-key function-key-map [M-return] [?\M-\C-m])
641(define-key function-key-map [tab] [?\t])
642(define-key function-key-map [M-tab] [?\M-\t])
643(define-key function-key-map [backspace] [127])
644(define-key function-key-map [M-backspace] [?\M-\d])
645(define-key function-key-map [escape] [?\e])
646(define-key function-key-map [M-escape] [?\M-\e])
647
648;; Tell read-char how to convert special chars to ASCII
649(put 'return 'ascii-character 13)
650(put 'tab 'ascii-character ?\t)
651(put 'backspace 'ascii-character 127)
652(put 'escape 'ascii-character ?\e)
653 187
188(defun x-handle-args (args)
189 "Process the X-related command line options in ARGS.
190This 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
192the 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).
194This 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
197 args nil)
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)
211 (progn
212 (setq completion (try-completion this-switch command-line-x-option-alist))
213 (if (eq completion t)
214 ;; Exact match for long option.
215 nil
216 (if (stringp completion)
217 (let ((elt (assoc completion command-line-x-option-alist)))
218 ;; Check for abbreviated long option.
219 (or elt
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)))
224 (if handler
225 (if argval
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))
232
654;; 233;;
655;; Available colors 234;; Available colors
656;; 235;;
@@ -1407,8 +986,723 @@ ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman")
1407 "GhostWhite" 986 "GhostWhite"
1408 "ghost white" 987 "ghost white"
1409 "snow") 988 "snow")
1410 "The list of X colors from the `rgb.txt' file. 989 "The list of X colors from the `rgb.txt' file.
1411XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp") 990XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp")
1412 991
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)
996 (this-color nil)
997 (defined-colors nil))
998 (while all-colors
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))))
1003 defined-colors))
1004
1005;;;; Function keys
1006
1007(substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame
1008 global-map)
1009
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])
1020
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)
1027
1028
1029;;;; Keysyms
1030
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")
1035
1036
1037;;;; Selections and cut buffers
1038
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)
1042
1043(setq interprogram-cut-function
1044 '(lambda (str push)
1045 (mac-cut-function
1046 (encode-coding-string str selection-coding-system t) push)))
1047
1048(setq interprogram-paste-function
1049 '(lambda ()
1050 (let ((clipboard (mac-paste-function)))
1051 (if clipboard
1052 (decode-coding-string clipboard selection-coding-system t)))))
1053
1054
1055;;; Do the actual Windows setup here; the above code just defines
1056;;; functions and variables that we use now.
1057
1058(setq command-line-args (x-handle-args command-line-args))
1059
1060;;; Make sure we have a valid resource name.
1061(or (stringp x-resource-name)
1062 (let (i)
1063 (setq x-resource-name (invocation-name))
1064
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 ?-))))
1069
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
1074 ;; frame.
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.
1079 t))
1080
1081(setq frame-creation-function 'x-create-frame-with-faces)
1082
1083(define-ccl-program ccl-encode-mac-roman-font
1084 `(0
1085 (if (r0 != ,(charset-id 'ascii))
1086 (if (r0 <= ?\x8f)
1087 (translate-character mac-roman-encoder r0 r1)
1088 ((r1 <<= 7)
1089 (r1 |= r2)
1090 (translate-character mac-roman-encoder r0 r1)))))
1091 "CCL program for Mac Roman font")
1092
1093(let
1094 ((encoding-vector (make-vector 256 nil))
1095 (i 0)
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
1224 #x02C7 ;; 255:CARON
1225 ])
1226 translation-table)
1227 (while (< i 128)
1228 (aset encoding-vector i i)
1229 (setq i (1+ i)))
1230 (while (< i 256)
1231 (aset encoding-vector i
1232 (decode-char 'ucs (aref vec (- i 128))))
1233 (setq i (1+ i)))
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)))
1239
1240(let
1241 ((encoding-vector (make-vector 256 nil))
1242 (i 0)
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
1372 ])
1373 translation-table)
1374 (while (< i 128)
1375 (aset encoding-vector i i)
1376 (setq i (1+ i)))
1377 (while (< i 256)
1378 (aset encoding-vector i
1379 (decode-char 'ucs (aref vec (- i 128))))
1380 (setq i (1+ i)))
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)))
1386
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")))
1394
1395(let ((encoder-list
1396 (mapcar (lambda (lst) (nth 1 lst)) mac-font-encoder-list))
1397 (charset-list
1398 '(latin-iso8859-2
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)
1405 (dotimes (i 96)
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))))
1409 (if mac-encoded
1410 (aset table c mac-encoded))))))))
1411
1412(define-ccl-program ccl-encode-mac-centraleurroman-font
1413 `(0
1414 (if (r0 != ,(charset-id 'ascii))
1415 (if (r0 <= ?\x8f)
1416 (translate-character mac-centraleurroman-encoder r0 r1)
1417 ((r1 <<= 7)
1418 (r1 |= r2)
1419 (translate-character mac-centraleurroman-encoder r0 r1)))))
1420 "CCL program for Mac Central European Roman font")
1421
1422(define-ccl-program ccl-encode-mac-cyrillic-font
1423 `(0
1424 (if (r0 != ,(charset-id 'ascii))
1425 (if (r0 <= ?\x8f)
1426 (translate-character mac-cyrillic-encoder r0 r1)
1427 ((r1 <<= 7)
1428 (r1 |= r2)
1429 (translate-character mac-cyrillic-encoder r0 r1)))))
1430 "CCL program for Mac Cyrillic font")
1431
1432
1433(setq font-ccl-encoder-alist
1434 (nconc
1435 (mapcar (lambda (lst) (cons (nth 0 lst) (nth 2 lst)))
1436 mac-font-encoder-list)
1437 font-ccl-encoder-alist))
1438
1439(defun fontset-add-mac-fonts (fontset &optional base-family)
1440 (if base-family
1441 (setq base-family (downcase base-family))
1442 (let ((ascii-font
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))
1448;; (setq fontset
1449;; (concat "fontset-" (aref (x-decompose-font-name fontset)
1450;; xlfd-regexp-encoding-subnum))))
1451 (dolist
1452 (font-encoder
1453 (nreverse
1454 (mapcar (lambda (lst)
1455 (cons (cons (format (nth 3 lst) base-family) (nth 0 lst))
1456 (nth 1 lst)))
1457 mac-font-encoder-list)))
1458 (let ((font (car font-encoder))
1459 (encoder (cdr font-encoder)))
1460 (map-char-table
1461 (lambda (key val)
1462 (or (null val)
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)))))
1468
1469(defun create-fontset-from-mac-roman-font (font &optional resolved-font
1470 fontset-name)
1471 "Create a fontset from a Mac roman font FONT.
1472
1473Optional 1st arg RESOLVED-FONT is a resolved name of FONT. If
1474omitted, `x-resolve-font-name' is called to get the resolved name. At
1475this time, if FONT is not available, error is signaled.
1476
1477Optional 2nd arg FONTSET-NAME is a string to be used in
1478`<CHARSET_ENCODING>' fields of a new fontset name. If it is omitted,
1479an appropriate name is generated automatically.
1480
1481It returns a name of the created fontset."
1482 (let ((fontset
1483 (create-fontset-from-ascii-font font resolved-font fontset-name)))
1484 (fontset-add-mac-fonts fontset)
1485 fontset))
1486
1487;; Setup the default fontset.
1488(setup-default-fontset)
1489
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,
1495ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman")
1496(fontset-add-mac-fonts "fontset-mac")
1497
1498;; Create fontset specified in X resources "Fontset-N" (N is 0, 1, ...).
1499(create-fontset-from-x-resource)
1500
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.
1508
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)
1513 (if (and font
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"))))
1522
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
1525;; precedence.
1526(let* ((res-geometry (x-get-resource "geometry" "Geometry"))
1527 parsed)
1528 (if res-geometry
1529 (progn
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))))))
1547
1548;; Check the reverseVideo resource.
1549(let ((case-fold-search t))
1550 (let ((rv (x-get-resource "reverseVideo" "ReverseVideo")))
1551 (if (and rv
1552 (string-match "^\\(true\\|yes\\|on\\)$" rv))
1553 (setq default-frame-alist
1554 (cons '(reverse . t) default-frame-alist)))))
1555
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)
1559
1560;; Don't show the frame name; that's redundant.
1561(setq-default mode-line-frame-identification " ")
1562
1563;; Turn on support for mouse wheels.
1564(mouse-wheel-mode 1)
1565
1566(defun mac-drag-n-drop (event)
1567 "Edit the files listed in the drag-n-drop event.\n\
1568Switch to a buffer editing the last file dropped."
1569 (interactive "e")
1570 (save-excursion
1571 ;; Make sure the drop target has positive co-ords
1572 ;; before setting the selected frame - otherwise it
1573 ;; won't work. <skx@tardis.ed.ac.uk>
1574 (let* ((window (posn-window (event-start event)))
1575 (coords (posn-x-y (event-start event)))
1576 (x (car coords))
1577 (y (cdr coords)))
1578 (if (and (> x 0) (> y 0))
1579 (set-frame-selected-window nil window))
1580 (mapcar
1581 '(lambda (file)
1582 (find-file
1583 (decode-coding-string
1584 file
1585 (or file-name-coding-system
1586 default-file-name-coding-system))))
1587 (car (cdr (cdr event)))))
1588 (raise-frame)
1589 (recenter)))
1590
1591(global-set-key [drag-n-drop] 'mac-drag-n-drop)
1592
1593;; By checking whether the variable mac-ready-for-drag-n-drop has been
1594;; defined, the event loop in macterm.c can be informed that it can
1595;; now receive Finder drag and drop events. Files dropped onto the
1596;; Emacs application icon can only be processed when the initial frame
1597;; has been created: this is where the files should be opened.
1598(add-hook 'after-init-hook
1599 '(lambda ()
1600 (defvar mac-ready-for-drag-n-drop t)))
1601
1602;;;; Scroll bars
1603
1604;; for debugging
1605;; (defun mac-handle-scroll-bar-event (event) (interactive "e") (princ event))
1606
1607;;(global-set-key [vertical-scroll-bar mouse-1] 'mac-handle-scroll-bar-event)
1608
1609(global-set-key
1610 [vertical-scroll-bar down-mouse-1]
1611 'mac-handle-scroll-bar-event)
1612
1613(global-unset-key [vertical-scroll-bar drag-mouse-1])
1614(global-unset-key [vertical-scroll-bar mouse-1])
1615
1616(defun mac-handle-scroll-bar-event (event)
1617 "Handle scroll bar EVENT to emulate Mac Toolbox style scrolling."
1618 (interactive "e")
1619 (let* ((position (event-start event))
1620 (window (nth 0 position))
1621 (bar-part (nth 4 position)))
1622 (select-window window)
1623 (cond
1624 ((eq bar-part 'up)
1625 (goto-char (window-start window))
1626 (mac-scroll-down-line))
1627 ((eq bar-part 'above-handle)
1628 (mac-scroll-down))
1629 ((eq bar-part 'handle)
1630 (scroll-bar-drag event))
1631 ((eq bar-part 'below-handle)
1632 (mac-scroll-up))
1633 ((eq bar-part 'down)
1634 (goto-char (window-start window))
1635 (mac-scroll-up-line)))))
1636
1637(defun mac-scroll-ignore-events ()
1638 ;; Ignore confusing non-mouse events
1639 (while (not (memq (car-safe (read-event))
1640 '(mouse-1 double-mouse-1 triple-mouse-1))) nil))
1641
1642(defun mac-scroll-down ()
1643 (track-mouse
1644 (mac-scroll-ignore-events)
1645 (scroll-down)))
1646
1647(defun mac-scroll-down-line ()
1648 (track-mouse
1649 (mac-scroll-ignore-events)
1650 (scroll-down 1)))
1651
1652(defun mac-scroll-up ()
1653 (track-mouse
1654 (mac-scroll-ignore-events)
1655 (scroll-up)))
1656
1657(defun mac-scroll-up-line ()
1658 (track-mouse
1659 (mac-scroll-ignore-events)
1660 (scroll-up 1)))
1661
1662
1663;;;; Others
1664
1665(unless (eq system-type 'darwin)
1666 ;; This variable specifies the Unix program to call (as a process) to
1667 ;; deteremine the amount of free space on a file system (defaults to
1668 ;; df). If it is not set to nil, ls-lisp will not work correctly
1669 ;; unless an external application df is implemented on the Mac.
1670 (setq directory-free-space-program nil)
1671
1672 ;; Set this so that Emacs calls subprocesses with "sh" as shell to
1673 ;; expand filenames Note no subprocess for the shell is actually
1674 ;; started (see run_mac_command in sysdep.c).
1675 (setq shell-file-name "sh"))
1676
1677;; X Window emulation in macterm.c is not complete enough to start a
1678;; frame without a minibuffer properly. Call this to tell ediff
1679;; library to use a single frame.
1680; (ediff-toggle-multiframe)
1681
1682(if (eq system-type 'darwin)
1683 ;; On Darwin filenames are encoded in UTF-8
1684 (setq file-name-coding-system 'utf-8)
1685 ;; To display filenames in Chinese or Japanese, replace mac-roman with
1686 ;; big5 or sjis
1687 (setq file-name-coding-system 'mac-roman))
1688
1689;; If Emacs is started from the Finder, change the default directory
1690;; to the user's home directory.
1691(if (string= default-directory "/")
1692 (cd "~"))
1693
1694;; Tell Emacs to use pipes instead of pty's for processes because the
1695;; latter sometimes lose characters. Pty support is compiled in since
1696;; ange-ftp will not work without it.
1697(setq process-connection-type nil)
1698
1699;; Assume that fonts are always scalable on the Mac. This sometimes
1700;; results in characters with jagged edges. However, without it,
1701;; fonts with both truetype and bitmap representations but no italic
1702;; or bold bitmap versions will not display these variants correctly.
1703(setq scalable-fonts-allowed t)
1704
1705;; (prefer-coding-system 'mac-roman)
1706
1413;;; arch-tag: 71dfcd14-cde8-4d66-b05c-85ec94fb23a6 1707;;; arch-tag: 71dfcd14-cde8-4d66-b05c-85ec94fb23a6
1414;;; mac-win.el ends here 1708;;; mac-win.el ends here
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-22 00:46:55 +0000