HCoop / bpt / emacs.git / blame
| Commit | Line | Data |
|---|---|---|
| dfcb7df2 | 1 | ;;; mac-win.el --- parse switches controlling interface with Mac window system -*-coding: iso-2022-7bit;-*- |
| 1a578e9b | 2 | |
| f2e3589a | 3 | ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, |
| d7a0267c | 4 | ;; 2005, 2006, 2007 Free Software Foundation, Inc. |
| 1a578e9b | 5 | |
| e0f712ba | 6 | ;; Author: Andrew Choi <akochoi@mac.com> |
| 74e2abe2 | 7 | ;; Keywords: terminals |
| 1a578e9b AC |
8 | |
| 9 | ;; This file is part of GNU Emacs. | |
| 10 | ||
| 11 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
| 12 | ;; it under the terms of the GNU General Public License as published by | |
| 5a9dffec | 13 | ;; the Free Software Foundation; either version 3, or (at your option) |
| 1a578e9b AC |
14 | ;; any later version. |
| 15 | ||
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 19 | ;; GNU General Public License for more details. | |
| 20 | ||
| 21 | ;; You should have received a copy of the GNU General Public License | |
| 22 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
| 4fc5845f LK |
23 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
| 24 | ;; Boston, MA 02110-1301, USA. | |
| 1a578e9b | 25 | |
| e8af40ee PJ |
26 | ;;; Commentary: |
| 27 | ||
| 74e2abe2 ST |
28 | ;; Mac-win.el: this file is loaded from ../lisp/startup.el when it recognizes |
| 29 | ;; that Mac windows are to be used. Command line switches are parsed and those | |
| 30 | ;; pertaining to Mac are processed and removed from the command line. The | |
| 31 | ;; Mac display is opened and hooks are set for popping up the initial window. | |
| 1a578e9b | 32 | |
| 74e2abe2 ST |
33 | ;; startup.el will then examine startup files, and eventually call the hooks |
| 34 | ;; which create the first window(s). | |
| 1a578e9b | 35 | |
| 74e2abe2 ST |
36 | ;;; Code: |
| 37 | \f | |
| 38 | ;; These are the standard X switches from the Xt Initialize.c file of | |
| 39 | ;; Release 4. | |
| 1a578e9b | 40 | |
| 74e2abe2 | 41 | ;; Command line Resource Manager string |
| 1a578e9b | 42 | |
| 74e2abe2 ST |
43 | ;; +rv *reverseVideo |
| 44 | ;; +synchronous *synchronous | |
| 45 | ;; -background *background | |
| 46 | ;; -bd *borderColor | |
| 47 | ;; -bg *background | |
| 48 | ;; -bordercolor *borderColor | |
| 49 | ;; -borderwidth .borderWidth | |
| 50 | ;; -bw .borderWidth | |
| 51 | ;; -display .display | |
| 52 | ;; -fg *foreground | |
| 53 | ;; -fn *font | |
| 54 | ;; -font *font | |
| 55 | ;; -foreground *foreground | |
| 56 | ;; -geometry .geometry | |
| 74e2abe2 ST |
57 | ;; -iconic .iconic |
| 58 | ;; -name .name | |
| 59 | ;; -reverse *reverseVideo | |
| 60 | ;; -rv *reverseVideo | |
| 61 | ;; -selectionTimeout .selectionTimeout | |
| 62 | ;; -synchronous *synchronous | |
| 63 | ;; -xrm | |
| 1a578e9b | 64 | |
| 74e2abe2 ST |
65 | ;; An alist of X options and the function which handles them. See |
| 66 | ;; ../startup.el. | |
| 1a578e9b | 67 | |
| 80ca7302 DN |
68 | ;; (if (not (eq window-system 'mac)) |
| 69 | ;; (error "%s: Loading mac-win.el but not compiled for Mac" (invocation-name))) | |
| 1a578e9b | 70 | |
| 74e2abe2 ST |
71 | (require 'frame) |
| 72 | (require 'mouse) | |
| fa05f6ac | 73 | (require 'scroll-bar) |
| 74e2abe2 | 74 | (require 'faces) |
| 853065b6 | 75 | (require 'select) |
| 74e2abe2 ST |
76 | (require 'menu-bar) |
| 77 | (require 'fontset) | |
| 590bc75d | 78 | (require 'dnd) |
| fa05f6ac | 79 | |
| 26238072 | 80 | (defvar mac-charset-info-alist) |
| b905e809 | 81 | (defvar mac-service-selection) |
| 26238072 | 82 | (defvar mac-system-script-code) |
| ea1f6051 | 83 | (defvar mac-apple-event-map) |
| 527ba7f4 | 84 | (defvar mac-font-panel-mode) |
| dc34c597 | 85 | (defvar mac-ts-active-input-overlay) |
| 74e2abe2 | 86 | (defvar x-invocation-args) |
| 73e6adaa DN |
87 | (declare-function mac-code-convert-string "mac.c") |
| 88 | (declare-function mac-coerce-ae-data "mac.c") | |
| 89 | (declare-function mac-resume-apple-event "macselect.c") | |
| 90 | (declare-function mac-font-panel-mode "macfns.c") | |
| 91 | (declare-function mac-atsu-font-face-attributes "macfns.c") | |
| 92 | (declare-function mac-ae-set-reply-parameter "macselect.c") | |
| 93 | (declare-function mac-clear-font-name-table "macfns.c") | |
| 1a578e9b | 94 | |
| 74e2abe2 | 95 | (defvar x-command-line-resources nil) |
| 1a578e9b | 96 | |
| 74e2abe2 ST |
97 | ;; Handler for switches of the form "-switch value" or "-switch". |
| 98 | (defun x-handle-switch (switch) | |
| 99 | (let ((aelt (assoc switch command-line-x-option-alist))) | |
| 100 | (if aelt | |
| 101 | (let ((param (nth 3 aelt)) | |
| 102 | (value (nth 4 aelt))) | |
| 103 | (if value | |
| 104 | (setq default-frame-alist | |
| 105 | (cons (cons param value) | |
| 106 | default-frame-alist)) | |
| 107 | (setq default-frame-alist | |
| 108 | (cons (cons param | |
| 109 | (car x-invocation-args)) | |
| 110 | default-frame-alist) | |
| 111 | x-invocation-args (cdr x-invocation-args))))))) | |
| 1a578e9b | 112 | |
| 74e2abe2 ST |
113 | ;; Handler for switches of the form "-switch n" |
| 114 | (defun x-handle-numeric-switch (switch) | |
| 115 | (let ((aelt (assoc switch command-line-x-option-alist))) | |
| 116 | (if aelt | |
| 117 | (let ((param (nth 3 aelt))) | |
| 118 | (setq default-frame-alist | |
| 119 | (cons (cons param | |
| 027a4b6b | 120 | (string-to-number (car x-invocation-args))) |
| 74e2abe2 ST |
121 | default-frame-alist) |
| 122 | x-invocation-args | |
| 123 | (cdr x-invocation-args)))))) | |
| 1a578e9b | 124 | |
| 74e2abe2 ST |
125 | ;; Handle options that apply to initial frame only |
| 126 | (defun x-handle-initial-switch (switch) | |
| 127 | (let ((aelt (assoc switch command-line-x-option-alist))) | |
| 128 | (if aelt | |
| 129 | (let ((param (nth 3 aelt)) | |
| 130 | (value (nth 4 aelt))) | |
| 131 | (if value | |
| 132 | (setq initial-frame-alist | |
| 133 | (cons (cons param value) | |
| 134 | initial-frame-alist)) | |
| 135 | (setq initial-frame-alist | |
| 136 | (cons (cons param | |
| 137 | (car x-invocation-args)) | |
| 138 | initial-frame-alist) | |
| 139 | x-invocation-args (cdr x-invocation-args))))))) | |
| 1a578e9b | 140 | |
| 74e2abe2 ST |
141 | ;; Make -iconic apply only to the initial frame! |
| 142 | (defun x-handle-iconic (switch) | |
| 143 | (setq initial-frame-alist | |
| 144 | (cons '(visibility . icon) initial-frame-alist))) | |
| 2ca75b42 | 145 | |
| 74e2abe2 ST |
146 | ;; Handle the -xrm option. |
| 147 | (defun x-handle-xrm-switch (switch) | |
| 148 | (unless (consp x-invocation-args) | |
| 149 | (error "%s: missing argument to `%s' option" (invocation-name) switch)) | |
| 150 | (setq x-command-line-resources | |
| 151 | (if (null x-command-line-resources) | |
| 152 | (car x-invocation-args) | |
| 153 | (concat x-command-line-resources "\n" (car x-invocation-args)))) | |
| 154 | (setq x-invocation-args (cdr x-invocation-args))) | |
| 1a578e9b | 155 | |
| 74e2abe2 ST |
156 | ;; Handle the geometry option |
| 157 | (defun x-handle-geometry (switch) | |
| 158 | (let* ((geo (x-parse-geometry (car x-invocation-args))) | |
| 159 | (left (assq 'left geo)) | |
| 160 | (top (assq 'top geo)) | |
| 161 | (height (assq 'height geo)) | |
| 162 | (width (assq 'width geo))) | |
| 163 | (if (or height width) | |
| 164 | (setq default-frame-alist | |
| 165 | (append default-frame-alist | |
| 166 | '((user-size . t)) | |
| 167 | (if height (list height)) | |
| 168 | (if width (list width))) | |
| 169 | initial-frame-alist | |
| 170 | (append initial-frame-alist | |
| 171 | '((user-size . t)) | |
| 172 | (if height (list height)) | |
| 173 | (if width (list width))))) | |
| 174 | (if (or left top) | |
| 175 | (setq initial-frame-alist | |
| 176 | (append initial-frame-alist | |
| 177 | '((user-position . t)) | |
| 178 | (if left (list left)) | |
| 179 | (if top (list top))))) | |
| 180 | (setq x-invocation-args (cdr x-invocation-args)))) | |
| 1a578e9b | 181 | |
| 74e2abe2 ST |
182 | ;; Handle the -name option. Set the variable x-resource-name |
| 183 | ;; to the option's operand; set the name of | |
| 184 | ;; the initial frame, too. | |
| 185 | (defun x-handle-name-switch (switch) | |
| 186 | (or (consp x-invocation-args) | |
| 187 | (error "%s: missing argument to `%s' option" (invocation-name) switch)) | |
| 188 | (setq x-resource-name (car x-invocation-args) | |
| 189 | x-invocation-args (cdr x-invocation-args)) | |
| 190 | (setq initial-frame-alist (cons (cons 'name x-resource-name) | |
| 191 | initial-frame-alist))) | |
| 1a578e9b | 192 | |
| 74e2abe2 ST |
193 | (defvar x-display-name nil |
| 194 | "The display name specifying server and frame.") | |
| 1a578e9b | 195 | |
| 74e2abe2 ST |
196 | (defun x-handle-display (switch) |
| 197 | (setq x-display-name (car x-invocation-args) | |
| 198 | x-invocation-args (cdr x-invocation-args))) | |
| 1a578e9b | 199 | |
| 74e2abe2 ST |
200 | (defun x-handle-args (args) |
| 201 | "Process the X-related command line options in ARGS. | |
| 202 | This is done before the user's startup file is loaded. They are copied to | |
| 203 | `x-invocation-args', from which the X-related things are extracted, first | |
| 204 | the switch (e.g., \"-fg\") in the following code, and possible values | |
| 205 | \(e.g., \"black\") in the option handler code (e.g., x-handle-switch). | |
| 206 | This function returns ARGS minus the arguments that have been processed." | |
| 207 | ;; We use ARGS to accumulate the args that we don't handle here, to return. | |
| 208 | (setq x-invocation-args args | |
| 209 | args nil) | |
| 210 | (while (and x-invocation-args | |
| 211 | (not (equal (car x-invocation-args) "--"))) | |
| 212 | (let* ((this-switch (car x-invocation-args)) | |
| 213 | (orig-this-switch this-switch) | |
| 214 | completion argval aelt handler) | |
| 215 | (setq x-invocation-args (cdr x-invocation-args)) | |
| 216 | ;; Check for long options with attached arguments | |
| 217 | ;; and separate out the attached option argument into argval. | |
| 218 | (if (string-match "^--[^=]*=" this-switch) | |
| 219 | (setq argval (substring this-switch (match-end 0)) | |
| 220 | this-switch (substring this-switch 0 (1- (match-end 0))))) | |
| 221 | ;; Complete names of long options. | |
| 222 | (if (string-match "^--" this-switch) | |
| 223 | (progn | |
| 224 | (setq completion (try-completion this-switch command-line-x-option-alist)) | |
| 225 | (if (eq completion t) | |
| 226 | ;; Exact match for long option. | |
| 227 | nil | |
| 228 | (if (stringp completion) | |
| 229 | (let ((elt (assoc completion command-line-x-option-alist))) | |
| 230 | ;; Check for abbreviated long option. | |
| 231 | (or elt | |
| 232 | (error "Option `%s' is ambiguous" this-switch)) | |
| 233 | (setq this-switch completion)))))) | |
| 234 | (setq aelt (assoc this-switch command-line-x-option-alist)) | |
| 235 | (if aelt (setq handler (nth 2 aelt))) | |
| 236 | (if handler | |
| 237 | (if argval | |
| 238 | (let ((x-invocation-args | |
| 239 | (cons argval x-invocation-args))) | |
| 240 | (funcall handler this-switch)) | |
| 241 | (funcall handler this-switch)) | |
| 242 | (setq args (cons orig-this-switch args))))) | |
| 243 | (nconc (nreverse args) x-invocation-args)) | |
| af6e9e85 YM |
244 | |
| 245 | \f | |
| 246 | ;; | |
| 247 | ;; Standard Mac cursor shapes | |
| 248 | ;; | |
| 249 | ||
| 250 | (defconst mac-pointer-arrow 0) | |
| 251 | (defconst mac-pointer-copy-arrow 1) | |
| 252 | (defconst mac-pointer-alias-arrow 2) | |
| 253 | (defconst mac-pointer-contextual-menu-arrow 3) | |
| 254 | (defconst mac-pointer-I-beam 4) | |
| 255 | (defconst mac-pointer-cross 5) | |
| 256 | (defconst mac-pointer-plus 6) | |
| 257 | (defconst mac-pointer-watch 7) | |
| 258 | (defconst mac-pointer-closed-hand 8) | |
| 259 | (defconst mac-pointer-open-hand 9) | |
| 260 | (defconst mac-pointer-pointing-hand 10) | |
| 261 | (defconst mac-pointer-counting-up-hand 11) | |
| 262 | (defconst mac-pointer-counting-down-hand 12) | |
| 263 | (defconst mac-pointer-counting-up-and-down-hand 13) | |
| 264 | (defconst mac-pointer-spinning 14) | |
| 265 | (defconst mac-pointer-resize-left 15) | |
| 266 | (defconst mac-pointer-resize-right 16) | |
| 267 | (defconst mac-pointer-resize-left-right 17) | |
| 268 | ;; Mac OS X 10.2 and later | |
| 269 | (defconst mac-pointer-not-allowed 18) | |
| 270 | ;; Mac OS X 10.3 and later | |
| 271 | (defconst mac-pointer-resize-up 19) | |
| 272 | (defconst mac-pointer-resize-down 20) | |
| 273 | (defconst mac-pointer-resize-up-down 21) | |
| 274 | (defconst mac-pointer-poof 22) | |
| 275 | ||
| 276 | ;; | |
| 277 | ;; Standard X cursor shapes that have Mac counterparts | |
| 278 | ;; | |
| 279 | ||
| 280 | (defconst x-pointer-left-ptr mac-pointer-arrow) | |
| 281 | (defconst x-pointer-xterm mac-pointer-I-beam) | |
| 282 | (defconst x-pointer-crosshair mac-pointer-cross) | |
| 283 | (defconst x-pointer-plus mac-pointer-plus) | |
| 284 | (defconst x-pointer-watch mac-pointer-watch) | |
| 285 | (defconst x-pointer-hand2 mac-pointer-pointing-hand) | |
| 286 | (defconst x-pointer-left-side mac-pointer-resize-left) | |
| 287 | (defconst x-pointer-right-side mac-pointer-resize-right) | |
| 288 | (defconst x-pointer-sb-h-double-arrow mac-pointer-resize-left-right) | |
| 289 | (defconst x-pointer-top-side mac-pointer-resize-up) | |
| 290 | (defconst x-pointer-bottom-side mac-pointer-resize-down) | |
| 291 | (defconst x-pointer-sb-v-double-arrow mac-pointer-resize-up-down) | |
| 292 | ||
| 74e2abe2 ST |
293 | \f |
| 294 | ;; | |
| 295 | ;; Available colors | |
| 296 | ;; | |
| 1a578e9b AC |
297 | |
| 298 | (defvar x-colors '("LightGreen" | |
| 299 | "light green" | |
| 300 | "DarkRed" | |
| 301 | "dark red" | |
| 302 | "DarkMagenta" | |
| 303 | "dark magenta" | |
| 304 | "DarkCyan" | |
| 305 | "dark cyan" | |
| 306 | "DarkBlue" | |
| 307 | "dark blue" | |
| 308 | "DarkGray" | |
| 309 | "dark gray" | |
| 310 | "DarkGrey" | |
| 311 | "dark grey" | |
| 312 | "grey100" | |
| 313 | "gray100" | |
| 314 | "grey99" | |
| 315 | "gray99" | |
| 316 | "grey98" | |
| 317 | "gray98" | |
| 318 | "grey97" | |
| 319 | "gray97" | |
| 320 | "grey96" | |
| 321 | "gray96" | |
| 322 | "grey95" | |
| 323 | "gray95" | |
| 324 | "grey94" | |
| 325 | "gray94" | |
| 326 | "grey93" | |
| 327 | "gray93" | |
| 328 | "grey92" | |
| 329 | "gray92" | |
| 330 | "grey91" | |
| 331 | "gray91" | |
| 332 | "grey90" | |
| 333 | "gray90" | |
| 334 | "grey89" | |
| 335 | "gray89" | |
| 336 | "grey88" | |
| 337 | "gray88" | |
| 338 | "grey87" | |
| 339 | "gray87" | |
| 340 | "grey86" | |
| 341 | "gray86" | |
| 342 | "grey85" | |
| 343 | "gray85" | |
| 344 | "grey84" | |
| 345 | "gray84" | |
| 346 | "grey83" | |
| 347 | "gray83" | |
| 348 | "grey82" | |
| 349 | "gray82" | |
| 350 | "grey81" | |
| 351 | "gray81" | |
| 352 | "grey80" | |
| 353 | "gray80" | |
| 354 | "grey79" | |
| 355 | "gray79" | |
| 356 | "grey78" | |
| 357 | "gray78" | |
| 358 | "grey77" | |
| 359 | "gray77" | |
| 360 | "grey76" | |
| 361 | "gray76" | |
| 362 | "grey75" | |
| 363 | "gray75" | |
| 364 | "grey74" | |
| 365 | "gray74" | |
| 366 | "grey73" | |
| 367 | "gray73" | |
| 368 | "grey72" | |
| 369 | "gray72" | |
| 370 | "grey71" | |
| 371 | "gray71" | |
| 372 | "grey70" | |
| 373 | "gray70" | |
| 374 | "grey69" | |
| 375 | "gray69" | |
| 376 | "grey68" | |
| 377 | "gray68" | |
| 378 | "grey67" | |
| 379 | "gray67" | |
| 380 | "grey66" | |
| 381 | "gray66" | |
| 382 | "grey65" | |
| 383 | "gray65" | |
| 384 | "grey64" | |
| 385 | "gray64" | |
| 386 | "grey63" | |
| 387 | "gray63" | |
| 388 | "grey62" | |
| 389 | "gray62" | |
| 390 | "grey61" | |
| 391 | "gray61" | |
| 392 | "grey60" | |
| 393 | "gray60" | |
| 394 | "grey59" | |
| 395 | "gray59" | |
| 396 | "grey58" | |
| 397 | "gray58" | |
| 398 | "grey57" | |
| 399 | "gray57" | |
| 400 | "grey56" | |
| 401 | "gray56" | |
| 402 | "grey55" | |
| 403 | "gray55" | |
| 404 | "grey54" | |
| 405 | "gray54" | |
| 406 | "grey53" | |
| 407 | "gray53" | |
| 408 | "grey52" | |
| 409 | "gray52" | |
| 410 | "grey51" | |
| 411 | "gray51" | |
| 412 | "grey50" | |
| 413 | "gray50" | |
| 414 | "grey49" | |
| 415 | "gray49" | |
| 416 | "grey48" | |
| 417 | "gray48" | |
| 418 | "grey47" | |
| 419 | "gray47" | |
| 420 | "grey46" | |
| 421 | "gray46" | |
| 422 | "grey45" | |
| 423 | "gray45" | |
| 424 | "grey44" | |
| 425 | "gray44" | |
| 426 | "grey43" | |
| 427 | "gray43" | |
| 428 | "grey42" | |
| 429 | "gray42" | |
| 430 | "grey41" | |
| 431 | "gray41" | |
| 432 | "grey40" | |
| 433 | "gray40" | |
| 434 | "grey39" | |
| 435 | "gray39" | |
| 436 | "grey38" | |
| 437 | "gray38" | |
| 438 | "grey37" | |
| 439 | "gray37" | |
| 440 | "grey36" | |
| 441 | "gray36" | |
| 442 | "grey35" | |
| 443 | "gray35" | |
| 444 | "grey34" | |
| 445 | "gray34" | |
| 446 | "grey33" | |
| 447 | "gray33" | |
| 448 | "grey32" | |
| 449 | "gray32" | |
| 450 | "grey31" | |
| 451 | "gray31" | |
| 452 | "grey30" | |
| 453 | "gray30" | |
| 454 | "grey29" | |
| 455 | "gray29" | |
| 456 | "grey28" | |
| 457 | "gray28" | |
| 458 | "grey27" | |
| 459 | "gray27" | |
| 460 | "grey26" | |
| 461 | "gray26" | |
| 462 | "grey25" | |
| 463 | "gray25" | |
| 464 | "grey24" | |
| 465 | "gray24" | |
| 466 | "grey23" | |
| 467 | "gray23" | |
| 468 | "grey22" | |
| 469 | "gray22" | |
| 470 | "grey21" | |
| 471 | "gray21" | |
| 472 | "grey20" | |
| 473 | "gray20" | |
| 474 | "grey19" | |
| 475 | "gray19" | |
| 476 | "grey18" | |
| 477 | "gray18" | |
| 478 | "grey17" | |
| 479 | "gray17" | |
| 480 | "grey16" | |
| 481 | "gray16" | |
| 482 | "grey15" | |
| 483 | "gray15" | |
| 484 | "grey14" | |
| 485 | "gray14" | |
| 486 | "grey13" | |
| 487 | "gray13" | |
| 488 | "grey12" | |
| 489 | "gray12" | |
| 490 | "grey11" | |
| 491 | "gray11" | |
| 492 | "grey10" | |
| 493 | "gray10" | |
| 494 | "grey9" | |
| 495 | "gray9" | |
| 496 | "grey8" | |
| 497 | "gray8" | |
| 498 | "grey7" | |
| 499 | "gray7" | |
| 500 | "grey6" | |
| 501 | "gray6" | |
| 502 | "grey5" | |
| 503 | "gray5" | |
| 504 | "grey4" | |
| 505 | "gray4" | |
| 506 | "grey3" | |
| 507 | "gray3" | |
| 508 | "grey2" | |
| 509 | "gray2" | |
| 510 | "grey1" | |
| 511 | "gray1" | |
| 512 | "grey0" | |
| 513 | "gray0" | |
| 514 | "thistle4" | |
| 515 | "thistle3" | |
| 516 | "thistle2" | |
| 517 | "thistle1" | |
| 518 | "MediumPurple4" | |
| 519 | "MediumPurple3" | |
| 520 | "MediumPurple2" | |
| 521 | "MediumPurple1" | |
| 522 | "purple4" | |
| 523 | "purple3" | |
| 524 | "purple2" | |
| 525 | "purple1" | |
| 526 | "DarkOrchid4" | |
| 527 | "DarkOrchid3" | |
| 528 | "DarkOrchid2" | |
| 529 | "DarkOrchid1" | |
| 530 | "MediumOrchid4" | |
| 531 | "MediumOrchid3" | |
| 532 | "MediumOrchid2" | |
| 533 | "MediumOrchid1" | |
| 534 | "plum4" | |
| 535 | "plum3" | |
| 536 | "plum2" | |
| 537 | "plum1" | |
| 538 | "orchid4" | |
| 539 | "orchid3" | |
| 540 | "orchid2" | |
| 541 | "orchid1" | |
| 542 | "magenta4" | |
| 543 | "magenta3" | |
| 544 | "magenta2" | |
| 545 | "magenta1" | |
| 546 | "VioletRed4" | |
| 547 | "VioletRed3" | |
| 548 | "VioletRed2" | |
| 549 | "VioletRed1" | |
| 550 | "maroon4" | |
| 551 | "maroon3" | |
| 552 | "maroon2" | |
| 553 | "maroon1" | |
| 554 | "PaleVioletRed4" | |
| 555 | "PaleVioletRed3" | |
| 556 | "PaleVioletRed2" | |
| 557 | "PaleVioletRed1" | |
| 558 | "LightPink4" | |
| 559 | "LightPink3" | |
| 560 | "LightPink2" | |
| 561 | "LightPink1" | |
| 562 | "pink4" | |
| 563 | "pink3" | |
| 564 | "pink2" | |
| 565 | "pink1" | |
| 566 | "HotPink4" | |
| 567 | "HotPink3" | |
| 568 | "HotPink2" | |
| 569 | "HotPink1" | |
| 570 | "DeepPink4" | |
| 571 | "DeepPink3" | |
| 572 | "DeepPink2" | |
| 573 | "DeepPink1" | |
| 574 | "red4" | |
| 575 | "red3" | |
| 576 | "red2" | |
| 577 | "red1" | |
| 578 | "OrangeRed4" | |
| 579 | "OrangeRed3" | |
| 580 | "OrangeRed2" | |
| 581 | "OrangeRed1" | |
| 582 | "tomato4" | |
| 583 | "tomato3" | |
| 584 | "tomato2" | |
| 585 | "tomato1" | |
| 586 | "coral4" | |
| 587 | "coral3" | |
| 588 | "coral2" | |
| 589 | "coral1" | |
| 590 | "DarkOrange4" | |
| 591 | "DarkOrange3" | |
| 592 | "DarkOrange2" | |
| 593 | "DarkOrange1" | |
| 594 | "orange4" | |
| 595 | "orange3" | |
| 596 | "orange2" | |
| 597 | "orange1" | |
| 598 | "LightSalmon4" | |
| 599 | "LightSalmon3" | |
| 600 | "LightSalmon2" | |
| 601 | "LightSalmon1" | |
| 602 | "salmon4" | |
| 603 | "salmon3" | |
| 604 | "salmon2" | |
| 605 | "salmon1" | |
| 606 | "brown4" | |
| 607 | "brown3" | |
| 608 | "brown2" | |
| 609 | "brown1" | |
| 610 | "firebrick4" | |
| 611 | "firebrick3" | |
| 612 | "firebrick2" | |
| 613 | "firebrick1" | |
| 614 | "chocolate4" | |
| 615 | "chocolate3" | |
| 616 | "chocolate2" | |
| 617 | "chocolate1" | |
| 618 | "tan4" | |
| 619 | "tan3" | |
| 620 | "tan2" | |
| 621 | "tan1" | |
| 622 | "wheat4" | |
| 623 | "wheat3" | |
| 624 | "wheat2" | |
| 625 | "wheat1" | |
| 626 | "burlywood4" | |
| 627 | "burlywood3" | |
| 628 | "burlywood2" | |
| 629 | "burlywood1" | |
| 630 | "sienna4" | |
| 631 | "sienna3" | |
| 632 | "sienna2" | |
| 633 | "sienna1" | |
| 634 | "IndianRed4" | |
| 635 | "IndianRed3" | |
| 636 | "IndianRed2" | |
| 637 | "IndianRed1" | |
| 638 | "RosyBrown4" | |
| 639 | "RosyBrown3" | |
| 640 | "RosyBrown2" | |
| 641 | "RosyBrown1" | |
| 642 | "DarkGoldenrod4" | |
| 643 | "DarkGoldenrod3" | |
| 644 | "DarkGoldenrod2" | |
| 645 | "DarkGoldenrod1" | |
| 646 | "goldenrod4" | |
| 647 | "goldenrod3" | |
| 648 | "goldenrod2" | |
| 649 | "goldenrod1" | |
| 650 | "gold4" | |
| 651 | "gold3" | |
| 652 | "gold2" | |
| 653 | "gold1" | |
| 654 | "yellow4" | |
| 655 | "yellow3" | |
| 656 | "yellow2" | |
| 657 | "yellow1" | |
| 658 | "LightYellow4" | |
| 659 | "LightYellow3" | |
| 660 | "LightYellow2" | |
| 661 | "LightYellow1" | |
| 662 | "LightGoldenrod4" | |
| 663 | "LightGoldenrod3" | |
| 664 | "LightGoldenrod2" | |
| 665 | "LightGoldenrod1" | |
| 666 | "khaki4" | |
| 667 | "khaki3" | |
| 668 | "khaki2" | |
| 669 | "khaki1" | |
| 670 | "DarkOliveGreen4" | |
| 671 | "DarkOliveGreen3" | |
| 672 | "DarkOliveGreen2" | |
| 673 | "DarkOliveGreen1" | |
| 674 | "OliveDrab4" | |
| 675 | "OliveDrab3" | |
| 676 | "OliveDrab2" | |
| 677 | "OliveDrab1" | |
| 678 | "chartreuse4" | |
| 679 | "chartreuse3" | |
| 680 | "chartreuse2" | |
| 681 | "chartreuse1" | |
| 682 | "green4" | |
| 683 | "green3" | |
| 684 | "green2" | |
| 685 | "green1" | |
| 686 | "SpringGreen4" | |
| 687 | "SpringGreen3" | |
| 688 | "SpringGreen2" | |
| 689 | "SpringGreen1" | |
| 690 | "PaleGreen4" | |
| 691 | "PaleGreen3" | |
| 692 | "PaleGreen2" | |
| 693 | "PaleGreen1" | |
| 694 | "SeaGreen4" | |
| 695 | "SeaGreen3" | |
| 696 | "SeaGreen2" | |
| 697 | "SeaGreen1" | |
| 698 | "DarkSeaGreen4" | |
| 699 | "DarkSeaGreen3" | |
| 700 | "DarkSeaGreen2" | |
| 701 | "DarkSeaGreen1" | |
| 702 | "aquamarine4" | |
| 703 | "aquamarine3" | |
| 704 | "aquamarine2" | |
| 705 | "aquamarine1" | |
| 706 | "DarkSlateGray4" | |
| 707 | "DarkSlateGray3" | |
| 708 | "DarkSlateGray2" | |
| 709 | "DarkSlateGray1" | |
| 710 | "cyan4" | |
| 711 | "cyan3" | |
| 712 | "cyan2" | |
| 713 | "cyan1" | |
| 714 | "turquoise4" | |
| 715 | "turquoise3" | |
| 716 | "turquoise2" | |
| 717 | "turquoise1" | |
| 718 | "CadetBlue4" | |
| 719 | "CadetBlue3" | |
| 720 | "CadetBlue2" | |
| 721 | "CadetBlue1" | |
| 722 | "PaleTurquoise4" | |
| 723 | "PaleTurquoise3" | |
| 724 | "PaleTurquoise2" | |
| 725 | "PaleTurquoise1" | |
| 726 | "LightCyan4" | |
| 727 | "LightCyan3" | |
| 728 | "LightCyan2" | |
| 729 | "LightCyan1" | |
| 730 | "LightBlue4" | |
| 731 | "LightBlue3" | |
| 732 | "LightBlue2" | |
| 733 | "LightBlue1" | |
| 734 | "LightSteelBlue4" | |
| 735 | "LightSteelBlue3" | |
| 736 | "LightSteelBlue2" | |
| 737 | "LightSteelBlue1" | |
| 738 | "SlateGray4" | |
| 739 | "SlateGray3" | |
| 740 | "SlateGray2" | |
| 741 | "SlateGray1" | |
| 742 | "LightSkyBlue4" | |
| 743 | "LightSkyBlue3" | |
| 744 | "LightSkyBlue2" | |
| 745 | "LightSkyBlue1" | |
| 746 | "SkyBlue4" | |
| 747 | "SkyBlue3" | |
| 748 | "SkyBlue2" | |
| 749 | "SkyBlue1" | |
| 750 | "DeepSkyBlue4" | |
| 751 | "DeepSkyBlue3" | |
| 752 | "DeepSkyBlue2" | |
| 753 | "DeepSkyBlue1" | |
| 754 | "SteelBlue4" | |
| 755 | "SteelBlue3" | |
| 756 | "SteelBlue2" | |
| 757 | "SteelBlue1" | |
| 758 | "DodgerBlue4" | |
| 759 | "DodgerBlue3" | |
| 760 | "DodgerBlue2" | |
| 761 | "DodgerBlue1" | |
| 762 | "blue4" | |
| 763 | "blue3" | |
| 764 | "blue2" | |
| 765 | "blue1" | |
| 766 | "RoyalBlue4" | |
| 767 | "RoyalBlue3" | |
| 768 | "RoyalBlue2" | |
| 769 | "RoyalBlue1" | |
| 770 | "SlateBlue4" | |
| 771 | "SlateBlue3" | |
| 772 | "SlateBlue2" | |
| 773 | "SlateBlue1" | |
| 774 | "azure4" | |
| 775 | "azure3" | |
| 776 | "azure2" | |
| 777 | "azure1" | |
| 778 | "MistyRose4" | |
| 779 | "MistyRose3" | |
| 780 | "MistyRose2" | |
| 781 | "MistyRose1" | |
| 782 | "LavenderBlush4" | |
| 783 | "LavenderBlush3" | |
| 784 | "LavenderBlush2" | |
| 785 | "LavenderBlush1" | |
| 786 | "honeydew4" | |
| 787 | "honeydew3" | |
| 788 | "honeydew2" | |
| 789 | "honeydew1" | |
| 790 | "ivory4" | |
| 791 | "ivory3" | |
| 792 | "ivory2" | |
| 793 | "ivory1" | |
| 794 | "cornsilk4" | |
| 795 | "cornsilk3" | |
| 796 | "cornsilk2" | |
| 797 | "cornsilk1" | |
| 798 | "LemonChiffon4" | |
| 799 | "LemonChiffon3" | |
| 800 | "LemonChiffon2" | |
| 801 | "LemonChiffon1" | |
| 802 | "NavajoWhite4" | |
| 803 | "NavajoWhite3" | |
| 804 | "NavajoWhite2" | |
| 805 | "NavajoWhite1" | |
| 806 | "PeachPuff4" | |
| 807 | "PeachPuff3" | |
| 808 | "PeachPuff2" | |
| 809 | "PeachPuff1" | |
| 810 | "bisque4" | |
| 811 | "bisque3" | |
| 812 | "bisque2" | |
| 813 | "bisque1" | |
| 814 | "AntiqueWhite4" | |
| 815 | "AntiqueWhite3" | |
| 816 | "AntiqueWhite2" | |
| 817 | "AntiqueWhite1" | |
| 818 | "seashell4" | |
| 819 | "seashell3" | |
| 820 | "seashell2" | |
| 821 | "seashell1" | |
| 822 | "snow4" | |
| 823 | "snow3" | |
| 824 | "snow2" | |
| 825 | "snow1" | |
| 826 | "thistle" | |
| 827 | "MediumPurple" | |
| 828 | "medium purple" | |
| 829 | "purple" | |
| 830 | "BlueViolet" | |
| 831 | "blue violet" | |
| 832 | "DarkViolet" | |
| 833 | "dark violet" | |
| 834 | "DarkOrchid" | |
| 835 | "dark orchid" | |
| 836 | "MediumOrchid" | |
| 837 | "medium orchid" | |
| 838 | "orchid" | |
| 839 | "plum" | |
| 840 | "violet" | |
| 841 | "magenta" | |
| 842 | "VioletRed" | |
| 843 | "violet red" | |
| 844 | "MediumVioletRed" | |
| 845 | "medium violet red" | |
| 846 | "maroon" | |
| 847 | "PaleVioletRed" | |
| 848 | "pale violet red" | |
| 849 | "LightPink" | |
| 850 | "light pink" | |
| 851 | "pink" | |
| 852 | "DeepPink" | |
| 853 | "deep pink" | |
| 854 | "HotPink" | |
| 855 | "hot pink" | |
| 856 | "red" | |
| 857 | "OrangeRed" | |
| 858 | "orange red" | |
| 859 | "tomato" | |
| 860 | "LightCoral" | |
| 861 | "light coral" | |
| 862 | "coral" | |
| 863 | "DarkOrange" | |
| 864 | "dark orange" | |
| 865 | "orange" | |
| 866 | "LightSalmon" | |
| 867 | "light salmon" | |
| 868 | "salmon" | |
| 869 | "DarkSalmon" | |
| 870 | "dark salmon" | |
| 871 | "brown" | |
| 872 | "firebrick" | |
| 873 | "chocolate" | |
| 874 | "tan" | |
| 875 | "SandyBrown" | |
| 876 | "sandy brown" | |
| 877 | "wheat" | |
| 878 | "beige" | |
| 879 | "burlywood" | |
| 880 | "peru" | |
| 881 | "sienna" | |
| 882 | "SaddleBrown" | |
| 883 | "saddle brown" | |
| 884 | "IndianRed" | |
| 885 | "indian red" | |
| 886 | "RosyBrown" | |
| 887 | "rosy brown" | |
| 888 | "DarkGoldenrod" | |
| 889 | "dark goldenrod" | |
| 890 | "goldenrod" | |
| 891 | "LightGoldenrod" | |
| 892 | "light goldenrod" | |
| 893 | "gold" | |
| 894 | "yellow" | |
| 895 | "LightYellow" | |
| 896 | "light yellow" | |
| 897 | "LightGoldenrodYellow" | |
| 898 | "light goldenrod yellow" | |
| 899 | "PaleGoldenrod" | |
| 900 | "pale goldenrod" | |
| 901 | "khaki" | |
| 902 | "DarkKhaki" | |
| 903 | "dark khaki" | |
| 904 | "OliveDrab" | |
| 905 | "olive drab" | |
| 906 | "ForestGreen" | |
| 907 | "forest green" | |
| 908 | "YellowGreen" | |
| 909 | "yellow green" | |
| 910 | "LimeGreen" | |
| 911 | "lime green" | |
| 912 | "GreenYellow" | |
| 913 | "green yellow" | |
| 914 | "MediumSpringGreen" | |
| 915 | "medium spring green" | |
| 916 | "chartreuse" | |
| 917 | "green" | |
| 918 | "LawnGreen" | |
| 919 | "lawn green" | |
| 920 | "SpringGreen" | |
| 921 | "spring green" | |
| 922 | "PaleGreen" | |
| 923 | "pale green" | |
| 924 | "LightSeaGreen" | |
| 925 | "light sea green" | |
| 926 | "MediumSeaGreen" | |
| 927 | "medium sea green" | |
| 928 | "SeaGreen" | |
| 929 | "sea green" | |
| 930 | "DarkSeaGreen" | |
| 931 | "dark sea green" | |
| 932 | "DarkOliveGreen" | |
| 933 | "dark olive green" | |
| 934 | "DarkGreen" | |
| 935 | "dark green" | |
| 936 | "aquamarine" | |
| 937 | "MediumAquamarine" | |
| 938 | "medium aquamarine" | |
| 939 | "CadetBlue" | |
| 940 | "cadet blue" | |
| 941 | "LightCyan" | |
| 942 | "light cyan" | |
| 943 | "cyan" | |
| 944 | "turquoise" | |
| 945 | "MediumTurquoise" | |
| 946 | "medium turquoise" | |
| 947 | "DarkTurquoise" | |
| 948 | "dark turquoise" | |
| 949 | "PaleTurquoise" | |
| 950 | "pale turquoise" | |
| 951 | "PowderBlue" | |
| 952 | "powder blue" | |
| 953 | "LightBlue" | |
| 954 | "light blue" | |
| 955 | "LightSteelBlue" | |
| 956 | "light steel blue" | |
| 957 | "SteelBlue" | |
| 958 | "steel blue" | |
| 959 | "LightSkyBlue" | |
| 960 | "light sky blue" | |
| 961 | "SkyBlue" | |
| 962 | "sky blue" | |
| 963 | "DeepSkyBlue" | |
| 964 | "deep sky blue" | |
| 965 | "DodgerBlue" | |
| 966 | "dodger blue" | |
| 967 | "blue" | |
| 968 | "RoyalBlue" | |
| 969 | "royal blue" | |
| 970 | "MediumBlue" | |
| 971 | "medium blue" | |
| 972 | "LightSlateBlue" | |
| 973 | "light slate blue" | |
| 974 | "MediumSlateBlue" | |
| 975 | "medium slate blue" | |
| 976 | "SlateBlue" | |
| 977 | "slate blue" | |
| 978 | "DarkSlateBlue" | |
| 979 | "dark slate blue" | |
| 980 | "CornflowerBlue" | |
| 981 | "cornflower blue" | |
| 982 | "NavyBlue" | |
| 983 | "navy blue" | |
| 984 | "navy" | |
| 985 | "MidnightBlue" | |
| 986 | "midnight blue" | |
| 987 | "LightGray" | |
| 988 | "light gray" | |
| 989 | "LightGrey" | |
| 990 | "light grey" | |
| 991 | "grey" | |
| 992 | "gray" | |
| 993 | "LightSlateGrey" | |
| 994 | "light slate grey" | |
| 995 | "LightSlateGray" | |
| 996 | "light slate gray" | |
| 997 | "SlateGrey" | |
| 998 | "slate grey" | |
| 999 | "SlateGray" | |
| 1000 | "slate gray" | |
| 1001 | "DimGrey" | |
| 1002 | "dim grey" | |
| 1003 | "DimGray" | |
| 1004 | "dim gray" | |
| 1005 | "DarkSlateGrey" | |
| 1006 | "dark slate grey" | |
| 1007 | "DarkSlateGray" | |
| 1008 | "dark slate gray" | |
| 1009 | "black" | |
| 1010 | "white" | |
| 1011 | "MistyRose" | |
| 1012 | "misty rose" | |
| 1013 | "LavenderBlush" | |
| 1014 | "lavender blush" | |
| 1015 | "lavender" | |
| 1016 | "AliceBlue" | |
| 1017 | "alice blue" | |
| 1018 | "azure" | |
| 1019 | "MintCream" | |
| 1020 | "mint cream" | |
| 1021 | "honeydew" | |
| 1022 | "seashell" | |
| 1023 | "LemonChiffon" | |
| 1024 | "lemon chiffon" | |
| 1025 | "ivory" | |
| 1026 | "cornsilk" | |
| 1027 | "moccasin" | |
| 1028 | "NavajoWhite" | |
| 1029 | "navajo white" | |
| 1030 | "PeachPuff" | |
| 1031 | "peach puff" | |
| 1032 | "bisque" | |
| 1033 | "BlanchedAlmond" | |
| 1034 | "blanched almond" | |
| 1035 | "PapayaWhip" | |
| 1036 | "papaya whip" | |
| 1037 | "AntiqueWhite" | |
| 1038 | "antique white" | |
| 1039 | "linen" | |
| 1040 | "OldLace" | |
| 1041 | "old lace" | |
| 1042 | "FloralWhite" | |
| 1043 | "floral white" | |
| 1044 | "gainsboro" | |
| 1045 | "WhiteSmoke" | |
| 1046 | "white smoke" | |
| 1047 | "GhostWhite" | |
| 1048 | "ghost white" | |
| 1049 | "snow") | |
| 74e2abe2 | 1050 | "The list of X colors from the `rgb.txt' file. |
| 1a578e9b AC |
1051 | XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp") |
| 1052 | ||
| 74e2abe2 ST |
1053 | (defun xw-defined-colors (&optional frame) |
| 1054 | "Internal function called by `defined-colors', which see." | |
| 1055 | (or frame (setq frame (selected-frame))) | |
| 1056 | (let ((all-colors x-colors) | |
| 1057 | (this-color nil) | |
| 1058 | (defined-colors nil)) | |
| 1059 | (while all-colors | |
| 1060 | (setq this-color (car all-colors) | |
| 1061 | all-colors (cdr all-colors)) | |
| 1062 | (and (color-supported-p this-color frame t) | |
| 1063 | (setq defined-colors (cons this-color defined-colors)))) | |
| 1064 | defined-colors)) | |
| 1065 | \f | |
| 1066 | ;;;; Function keys | |
| 1067 | ||
| caf49fb0 DN |
1068 | (defun x-setup-function-keys (frame) |
| 1069 | "Setup Function Keys for mac." | |
| 202c09a8 DN |
1070 | ;; Don't do this twice on the same display, or it would break |
| 1071 | ;; normal-erase-is-backspace-mode. | |
| 1072 | (unless (terminal-parameter frame 'x-setup-function-keys) | |
| 1073 | (with-selected-frame frame | |
| 1074 | ;; Map certain keypad keys into ASCII characters | |
| 1075 | ;; that people usually expect. | |
| 1076 | (define-key local-function-key-map [backspace] [?\d]) | |
| 1077 | (define-key local-function-key-map [delete] [?\d]) | |
| 1078 | (define-key local-function-key-map [tab] [?\t]) | |
| 1079 | (define-key local-function-key-map [linefeed] [?\n]) | |
| 1080 | (define-key local-function-key-map [clear] [?\C-l]) | |
| 1081 | (define-key local-function-key-map [return] [?\C-m]) | |
| 1082 | (define-key local-function-key-map [escape] [?\e]) | |
| 1083 | (define-key local-function-key-map [M-backspace] [?\M-\d]) | |
| 1084 | (define-key local-function-key-map [M-delete] [?\M-\d]) | |
| 1085 | (define-key local-function-key-map [M-tab] [?\M-\t]) | |
| 1086 | (define-key local-function-key-map [M-linefeed] [?\M-\n]) | |
| 1087 | (define-key local-function-key-map [M-clear] [?\M-\C-l]) | |
| 1088 | (define-key local-function-key-map [M-return] [?\M-\C-m]) | |
| 1089 | (define-key local-function-key-map [M-escape] [?\M-\e]) | |
| 1090 | (substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame | |
| 1091 | local-function-key-map global-map)) | |
| 798ae196 | 1092 | (set-terminal-parameter frame 'x-setup-function-keys t))) |
| 74e2abe2 ST |
1093 | |
| 1094 | ;; These tell read-char how to convert | |
| 1095 | ;; these special chars to ASCII. | |
| 2c75eddf | 1096 | (put 'backspace 'ascii-character ?\d) |
| 9b3c108b YM |
1097 | (put 'delete 'ascii-character ?\d) |
| 1098 | (put 'tab 'ascii-character ?\t) | |
| 1099 | (put 'linefeed 'ascii-character ?\n) | |
| 1100 | (put 'clear 'ascii-character ?\C-l) | |
| 1101 | (put 'return 'ascii-character ?\C-m) | |
| 74e2abe2 ST |
1102 | (put 'escape 'ascii-character ?\e) |
| 1103 | ||
| d8dabccc YM |
1104 | ;; Modifier name `ctrl' is an alias of `control'. |
| 1105 | (put 'ctrl 'modifier-value (get 'control 'modifier-value)) | |
| 1106 | ||
| 74e2abe2 | 1107 | \f |
| 9bf2510a | 1108 | ;;;; Script codes and coding systems |
| 92a607bd YM |
1109 | (defconst mac-script-code-coding-systems |
| 1110 | '((0 . mac-roman) ; smRoman | |
| 1111 | (1 . japanese-shift-jis) ; smJapanese | |
| 1112 | (2 . chinese-big5) ; smTradChinese | |
| 1113 | (3 . korean-iso-8bit) ; smKorean | |
| 1114 | (7 . mac-cyrillic) ; smCyrillic | |
| 1115 | (25 . chinese-iso-8bit) ; smSimpChinese | |
| 1116 | (29 . mac-centraleurroman) ; smCentralEuroRoman | |
| 1117 | ) | |
| 1118 | "Alist of Mac script codes vs Emacs coding systems.") | |
| 74e2abe2 | 1119 | |
| dfcb7df2 | 1120 | (defun mac-add-charset-info (xlfd-charset mac-text-encoding) |
| 1c245bb7 YM |
1121 | "Add a character set to display with Mac fonts. |
| 1122 | Create an entry in `mac-charset-info-alist'. | |
| dfcb7df2 YM |
1123 | XLFD-CHARSET is a string which will appear in the XLFD font name |
| 1124 | to identify the character set. MAC-TEXT-ENCODING is the | |
| 1125 | correspoinding TextEncodingBase value." | |
| 1126 | (add-to-list 'mac-charset-info-alist | |
| 1127 | (list xlfd-charset mac-text-encoding | |
| 1128 | (cdr (assq mac-text-encoding | |
| 1129 | mac-script-code-coding-systems))))) | |
| 1130 | ||
| 1131 | (setq mac-charset-info-alist nil) | |
| 1132 | (mac-add-charset-info "mac-roman" 0) | |
| 1133 | (mac-add-charset-info "jisx0208.1983-sjis" 1) | |
| 1134 | (mac-add-charset-info "jisx0201.1976-0" 1) | |
| 1135 | (mac-add-charset-info "big5-0" 2) | |
| 1136 | (mac-add-charset-info "ksc5601.1989-0" 3) | |
| 1137 | (mac-add-charset-info "mac-cyrillic" 7) | |
| 1138 | (mac-add-charset-info "gb2312.1980-0" 25) | |
| 1139 | (mac-add-charset-info "mac-centraleurroman" 29) | |
| 1140 | (mac-add-charset-info "mac-symbol" 33) | |
| 1141 | (mac-add-charset-info "adobe-fontspecific" 33) ; for X-Symbol | |
| 1142 | (mac-add-charset-info "mac-dingbats" 34) | |
| 8de786ae | 1143 | (mac-add-charset-info "iso10646-1" 126) ; for ATSUI |
| dfcb7df2 | 1144 | |
| 6e53dc95 YM |
1145 | (cp-make-coding-system |
| 1146 | mac-centraleurroman | |
| 1147 | [?\\e,AD\e(B ?\\e$,1 \e(B ?\\e$,1 !\e(B ?\\e,AI\e(B ?\\e$,1 $\e(B ?\\e,AV\e(B ?\\e,A\\e(B ?\\e,Aa\e(B ?\\e$,1 %\e(B ?\\e$,1 ,\e(B ?\\e,Ad\e(B ?\\e$,1 -\e(B ?\\e$,1 &\e(B ?\\e$,1 '\e(B ?\\e,Ai\e(B ?\\e$,1!9\e(B | |
| 1148 | ?\\e$,1!:\e(B ?\\e$,1 .\e(B ?\\e,Am\e(B ?\\e$,1 /\e(B ?\\e$,1 2\e(B ?\\e$,1 3\e(B ?\\e$,1 6\e(B ?\\e,As\e(B ?\\e$,1 7\e(B ?\\e,At\e(B ?\\e,Av\e(B ?\\e,Au\e(B ?\\e,Az\e(B ?\\e$,1 :\e(B ?\\e$,1 ;\e(B ?\\e,A|\e(B | |
| 1149 | ?\\e$,1s \e(B ?\\e,A0\e(B ?\\e$,1 8\e(B ?\\e,A#\e(B ?\\e,A'\e(B ?\\e$,1s"\e(B ?\\e,A6\e(B ?\\e,A_\e(B ?\\e,A.\e(B ?\\e,A)\e(B ?\\e$,1ub\e(B ?\\e$,1 9\e(B ?\\e,A(\e(B ?\\e$,1y \e(B ?\\e$,1 C\e(B ?\\e$,1 N\e(B | |
| 1150 | ?\\e$,1 O\e(B ?\\e$,1 J\e(B ?\\e$,1y$\e(B ?\\e$,1y%\e(B ?\\e$,1 K\e(B ?\\e$,1 V\e(B ?\\e$,1x"\e(B ?\\e$,1x1\e(B ?\\e$,1 b\e(B ?\\e$,1 [\e(B ?\\e$,1 \\e(B ?\\e$,1 ]\e(B ?\\e$,1 ^\e(B ?\\e$,1 Y\e(B ?\\e$,1 Z\e(B ?\\e$,1 e\e(B | |
| 1151 | ?\\e$,1 f\e(B ?\\e$,1 c\e(B ?\\e,A,\e(B ?\\e$,1x:\e(B ?\\e$,1 d\e(B ?\\e$,1 g\e(B ?\\e$,1x&\e(B ?\\e,A+\e(B ?\\e,A;\e(B ?\\e$,1s&\e(B ?\\e,A \e(B ?\\e$,1 h\e(B ?\\e$,1 p\e(B ?\\e,AU\e(B ?\\e$,1 q\e(B ?\\e$,1 l\e(B | |
| 1152 | ?\\e$,1rs\e(B ?\\e$,1rt\e(B ?\\e$,1r|\e(B ?\\e$,1r}\e(B ?\\e$,1rx\e(B ?\\e$,1ry\e(B ?\\e,Aw\e(B ?\\e$,2"*\e(B ?\\e$,1 m\e(B ?\\e$,1 t\e(B ?\\e$,1 u\e(B ?\\e$,1 x\e(B ?\\e$,1s9\e(B ?\\e$,1s:\e(B ?\\e$,1 y\e(B ?\\e$,1 v\e(B | |
| 1153 | ?\\e$,1 w\e(B ?\\e$,1! \e(B ?\\e$,1rz\e(B ?\\e$,1r~\e(B ?\\e$,1!!\e(B ?\\e$,1 z\e(B ?\\e$,1 {\e(B ?\\e,AA\e(B ?\\e$,1!$\e(B ?\\e$,1!%\e(B ?\\e,AM\e(B ?\\e$,1!=\e(B ?\\e$,1!>\e(B ?\\e$,1!*\e(B ?\\e,AS\e(B ?\\e,AT\e(B | |
| 1154 | ?\\e$,1!+\e(B ?\\e$,1!.\e(B ?\\e,AZ\e(B ?\\e$,1!/\e(B ?\\e$,1!0\e(B ?\\e$,1!1\e(B ?\\e$,1!2\e(B ?\\e$,1!3\e(B ?\\e,A]\e(B ?\\e,A}\e(B ?\\e$,1 W\e(B ?\\e$,1!;\e(B ?\\e$,1 a\e(B ?\\e$,1!<\e(B ?\\e$,1 B\e(B ?\\e$,1$g\e(B] | |
| 1155 | "Mac Central European Roman Encoding (MIME:x-mac-centraleurroman).") | |
| 1156 | (coding-system-put 'mac-centraleurroman 'mime-charset 'x-mac-centraleurroman) | |
| 1157 | ||
| 1158 | (cp-make-coding-system | |
| 1159 | mac-cyrillic | |
| 1160 | [?\\e$,1(0\e(B ?\\e$,1(1\e(B ?\\e$,1(2\e(B ?\\e$,1(3\e(B ?\\e$,1(4\e(B ?\\e$,1(5\e(B ?\\e$,1(6\e(B ?\\e$,1(7\e(B ?\\e$,1(8\e(B ?\\e$,1(9\e(B ?\\e$,1(:\e(B ?\\e$,1(;\e(B ?\\e$,1(<\e(B ?\\e$,1(=\e(B ?\\e$,1(>\e(B ?\\e$,1(?\e(B | |
| 1161 | ?\\e$,1(@\e(B ?\\e$,1(A\e(B ?\\e$,1(B\e(B ?\\e$,1(C\e(B ?\\e$,1(D\e(B ?\\e$,1(E\e(B ?\\e$,1(F\e(B ?\\e$,1(G\e(B ?\\e$,1(H\e(B ?\\e$,1(I\e(B ?\\e$,1(J\e(B ?\\e$,1(K\e(B ?\\e$,1(L\e(B ?\\e$,1(M\e(B ?\\e$,1(N\e(B ?\\e$,1(O\e(B | |
| 1162 | ?\\e$,1s \e(B ?\\e,A0\e(B ?\\e$,1)P\e(B ?\\e,A#\e(B ?\\e,A'\e(B ?\\e$,1s"\e(B ?\\e,A6\e(B ?\\e$,1(&\e(B ?\\e,A.\e(B ?\\e,A)\e(B ?\\e$,1ub\e(B ?\\e$,1("\e(B ?\\e$,1(r\e(B ?\\e$,1y \e(B ?\\e$,1(#\e(B ?\\e$,1(s\e(B | |
| 1163 | ?\\e$,1x>\e(B ?\\e,A1\e(B ?\\e$,1y$\e(B ?\\e$,1y%\e(B ?\\e$,1(v\e(B ?\\e,A5\e(B ?\\e$,1)Q\e(B ?\\e$,1((\e(B ?\\e$,1($\e(B ?\\e$,1(t\e(B ?\\e$,1('\e(B ?\\e$,1(w\e(B ?\\e$,1()\e(B ?\\e$,1(y\e(B ?\\e$,1(*\e(B ?\\e$,1(z\e(B | |
| 1164 | ?\\e$,1(x\e(B ?\\e$,1(%\e(B ?\\e,A,\e(B ?\\e$,1x:\e(B ?\\e$,1!R\e(B ?\\e$,1xh\e(B ?\\e$,1x&\e(B ?\\e,A+\e(B ?\\e,A;\e(B ?\\e$,1s&\e(B ?\\e,A \e(B ?\\e$,1(+\e(B ?\\e$,1({\e(B ?\\e$,1(,\e(B ?\\e$,1(|\e(B ?\\e$,1(u\e(B | |
| 1165 | ?\\e$,1rs\e(B ?\\e$,1rt\e(B ?\\e$,1r|\e(B ?\\e$,1r}\e(B ?\\e$,1rx\e(B ?\\e$,1ry\e(B ?\\e,Aw\e(B ?\\e$,1r~\e(B ?\\e$,1(.\e(B ?\\e$,1(~\e(B ?\\e$,1(/\e(B ?\\e$,1(\7f\e(B ?\\e$,1uV\e(B ?\\e$,1(!\e(B ?\\e$,1(q\e(B ?\\e$,1(o\e(B | |
| 1166 | ?\\e$,1(P\e(B ?\\e$,1(Q\e(B ?\\e$,1(R\e(B ?\\e$,1(S\e(B ?\\e$,1(T\e(B ?\\e$,1(U\e(B ?\\e$,1(V\e(B ?\\e$,1(W\e(B ?\\e$,1(X\e(B ?\\e$,1(Y\e(B ?\\e$,1(Z\e(B ?\\e$,1([\e(B ?\\e$,1(\\e(B ?\\e$,1(]\e(B ?\\e$,1(^\e(B ?\\e$,1(_\e(B | |
| 1167 | ?\\e$,1(`\e(B ?\\e$,1(a\e(B ?\\e$,1(b\e(B ?\\e$,1(c\e(B ?\\e$,1(d\e(B ?\\e$,1(e\e(B ?\\e$,1(f\e(B ?\\e$,1(g\e(B ?\\e$,1(h\e(B ?\\e$,1(i\e(B ?\\e$,1(j\e(B ?\\e$,1(k\e(B ?\\e$,1(l\e(B ?\\e$,1(m\e(B ?\\e$,1(n\e(B ?\\e$,1tL\e(B] | |
| 1168 | "Mac Cyrillic Encoding (MIME:x-mac-cyrillic).") | |
| 1169 | (coding-system-put 'mac-cyrillic 'mime-charset 'x-mac-cyrillic) | |
| 1170 | ||
| 1171 | (let | |
| 1172 | ((encoding-vector | |
| 1173 | (vconcat | |
| 1174 | (make-vector 32 nil) | |
| 1175 | ;; mac-symbol (32..126) -> emacs-mule mapping | |
| 1176 | [?\ ?\! ?\\e$,1x \e(B ?\# ?\\e$,1x#\e(B ?\% ?\& ?\\e$,1x-\e(B ?\( ?\) ?\\e$,1x7\e(B ?\+ ?\, ?\\e$,1x2\e(B ?\. ?\/ | |
| 1177 | ?\0 ?\1 ?\2 ?\3 ?\4 ?\5 ?\6 ?\7 ?\8 ?\9 ?\: ?\; ?\< ?\= ?\> ?\? | |
| 1178 | ?\\e$,1xe\e(B ?\\e$,1&q\e(B ?\\e$,1&r\e(B ?\\e$,1''\e(B ?\\e$,1&t\e(B ?\\e$,1&u\e(B ?\\e$,1'&\e(B ?\\e$,1&s\e(B ?\\e$,1&w\e(B ?\\e$,1&y\e(B ?\\e$,1'Q\e(B ?\\e$,1&z\e(B ?\\e$,1&{\e(B ?\\e$,1&|\e(B ?\\e$,1&}\e(B ?\\e$,1&\7f\e(B | |
| 1179 | ?\\e$,1' \e(B ?\\e$,1&x\e(B ?\\e$,1'!\e(B ?\\e$,1'#\e(B ?\\e$,1'$\e(B ?\\e$,1'%\e(B ?\\e$,1'B\e(B ?\\e$,1')\e(B ?\\e$,1&~\e(B ?\\e$,1'(\e(B ?\\e$,1&v\e(B ?\[ ?\\e$,1xT\e(B ?\] ?\\e$,1ye\e(B ?\_ | |
| 1180 | ?\\e$,3bE\e(B ?\\e$,1'1\e(B ?\\e$,1'2\e(B ?\\e$,1'G\e(B ?\\e$,1'4\e(B ?\\e$,1'5\e(B ?\\e$,1'F\e(B ?\\e$,1'3\e(B ?\\e$,1'7\e(B ?\\e$,1'9\e(B ?\\e$,1'U\e(B ?\\e$,1':\e(B ?\\e$,1';\e(B ?\\e$,1'<\e(B ?\\e$,1'=\e(B ?\\e$,1'?\e(B | |
| 1181 | ?\\e$,1'@\e(B ?\\e$,1'8\e(B ?\\e$,1'A\e(B ?\\e$,1'C\e(B ?\\e$,1'D\e(B ?\\e$,1'E\e(B ?\\e$,1'V\e(B ?\\e$,1'I\e(B ?\\e$,1'>\e(B ?\\e$,1'H\e(B ?\\e$,1'6\e(B ?\{ ?\| ?\} ?\\e$,1x\\e(B] | |
| 1182 | (make-vector (- 160 127) nil) | |
| 1183 | ;; mac-symbol (160..254) -> emacs-mule mapping | |
| 1184 | ;; Mapping of the following characters are changed from the | |
| 1185 | ;; original one: | |
| 1186 | ;; 0xE2 0x00AE+0xF87F -> 0x00AE # REGISTERED SIGN, alternate: sans serif | |
| 1187 | ;; 0xE3 0x00A9+0xF87F -> 0x00A9 # COPYRIGHT SIGN, alternate: sans serif | |
| 1188 | ;; 0xE4 0x2122+0xF87F -> 0x2122 # TRADE MARK SIGN, alternate: sans serif | |
| 1189 | [?\\e$,1tL\e(B ?\\e$,1'R\e(B ?\\e$,1s2\e(B ?\\e$,1y$\e(B ?\\e$,1sD\e(B ?\\e$,1x>\e(B ?\\e$,1!R\e(B ?\\e$,2#c\e(B ?\\e$,2#f\e(B ?\\e$,2#e\e(B ?\\e$,2#`\e(B ?\\e$,1vt\e(B ?\\e$,1vp\e(B ?\\e$,1vq\e(B ?\\e$,1vr\e(B ?\\e$,1vs\e(B | |
| 1190 | ?\\e,A0\e(B ?\\e,A1\e(B ?\\e$,1s3\e(B ?\\e$,1y%\e(B ?\\e,AW\e(B ?\\e$,1x=\e(B ?\\e$,1x"\e(B ?\\e$,1s"\e(B ?\\e,Aw\e(B ?\\e$,1y \e(B ?\\e$,1y!\e(B ?\\e$,1xh\e(B ?\\e$,1s&\e(B ?\\e$,1|p\e(B ?\\e$,1|O\e(B ?\\e$,1w5\e(B | |
| 1191 | ?\\e$,1uu\e(B ?\\e$,1uQ\e(B ?\\e$,1u\\e(B ?\\e$,1uX\e(B ?\\e$,1yW\e(B ?\\e$,1yU\e(B ?\\e$,1x%\e(B ?\\e$,1xI\e(B ?\\e$,1xJ\e(B ?\\e$,1yC\e(B ?\\e$,1yG\e(B ?\\e$,1yD\e(B ?\\e$,1yB\e(B ?\\e$,1yF\e(B ?\\e$,1x(\e(B ?\\e$,1x)\e(B | |
| 1192 | ?\\e$,1x@\e(B ?\\e$,1x'\e(B ?\\e,A.\e(B ?\\e,A)\e(B ?\\e$,1ub\e(B ?\\e$,1x/\e(B ?\\e$,1x:\e(B ?\\e$,1z%\e(B ?\\e,A,\e(B ?\\e$,1xG\e(B ?\\e$,1xH\e(B ?\\e$,1wT\e(B ?\\e$,1wP\e(B ?\\e$,1wQ\e(B ?\\e$,1wR\e(B ?\\e$,1wS\e(B | |
| 1193 | ?\\e$,2"*\e(B ?\\e$,2=H\e(B ?\\e,A.\e(B ?\\e,A)\e(B ?\\e$,1ub\e(B ?\\e$,1x1\e(B ?\\e$,1|;\e(B ?\\e$,1|<\e(B ?\\e$,1|=\e(B ?\\e$,1|A\e(B ?\\e$,1|B\e(B ?\\e$,1|C\e(B ?\\e$,1|G\e(B ?\\e$,1|H\e(B ?\\e$,1|I\e(B ?\\e$,1|J\e(B | |
| 1194 | ?\\e$,3b_\e(B ?\\e$,2=I\e(B ?\\e$,1xK\e(B ?\\e$,1{ \e(B ?\\e$,1|N\e(B ?\\e$,1{!\e(B ?\\e$,1|>\e(B ?\\e$,1|?\e(B ?\\e$,1|@\e(B ?\\e$,1|D\e(B ?\\e$,1|E\e(B ?\\e$,1|F\e(B ?\\e$,1|K\e(B ?\\e$,1|L\e(B ?\\e$,1|M\e(B | |
| 1195 | nil])) | |
| 1196 | translation-table) | |
| 1197 | (setq translation-table | |
| 1198 | (make-translation-table-from-vector encoding-vector)) | |
| 1199 | ;; (define-translation-table 'mac-symbol-decoder translation-table) | |
| 1200 | (define-translation-table 'mac-symbol-encoder | |
| 1201 | (char-table-extra-slot translation-table 0))) | |
| 1202 | ||
| 1203 | (let | |
| 1204 | ((encoding-vector | |
| 1205 | (vconcat | |
| 1206 | (make-vector 32 nil) | |
| 1207 | ;; mac-dingbats (32..126) -> emacs-mule mapping | |
| 1208 | [?\ ?\\e$,2%A\e(B ?\\e$,2%B\e(B ?\\e$,2%C\e(B ?\\e$,2%D\e(B ?\\e$,2"n\e(B ?\\e$,2%F\e(B ?\\e$,2%G\e(B ?\\e$,2%H\e(B ?\\e$,2%I\e(B ?\\e$,2"{\e(B ?\\e$,2"~\e(B ?\\e$,2%L\e(B ?\\e$,2%M\e(B ?\\e$,2%N\e(B ?\\e$,2%O\e(B | |
| 1209 | ?\\e$,2%P\e(B ?\\e$,2%Q\e(B ?\\e$,2%R\e(B ?\\e$,2%S\e(B ?\\e$,2%T\e(B ?\\e$,2%U\e(B ?\\e$,2%V\e(B ?\\e$,2%W\e(B ?\\e$,2%X\e(B ?\\e$,2%Y\e(B ?\\e$,2%Z\e(B ?\\e$,2%[\e(B ?\\e$,2%\\e(B ?\\e$,2%]\e(B ?\\e$,2%^\e(B ?\\e$,2%_\e(B | |
| 1210 | ?\\e$,2%`\e(B ?\\e$,2%a\e(B ?\\e$,2%b\e(B ?\\e$,2%c\e(B ?\\e$,2%d\e(B ?\\e$,2%e\e(B ?\\e$,2%f\e(B ?\\e$,2%g\e(B ?\\e$,2"e\e(B ?\\e$,2%i\e(B ?\\e$,2%j\e(B ?\\e$,2%k\e(B ?\\e$,2%l\e(B ?\\e$,2%m\e(B ?\\e$,2%n\e(B ?\\e$,2%o\e(B | |
| 1211 | ?\\e$,2%p\e(B ?\\e$,2%q\e(B ?\\e$,2%r\e(B ?\\e$,2%s\e(B ?\\e$,2%t\e(B ?\\e$,2%u\e(B ?\\e$,2%v\e(B ?\\e$,2%w\e(B ?\\e$,2%x\e(B ?\\e$,2%y\e(B ?\\e$,2%z\e(B ?\\e$,2%{\e(B ?\\e$,2%|\e(B ?\\e$,2%}\e(B ?\\e$,2%~\e(B ?\\e$,2%\7f\e(B | |
| 1212 | ?\\e$,2& \e(B ?\\e$,2&!\e(B ?\\e$,2&"\e(B ?\\e$,2&#\e(B ?\\e$,2&$\e(B ?\\e$,2&%\e(B ?\\e$,2&&\e(B ?\\e$,2&'\e(B ?\\e$,2&(\e(B ?\\e$,2&)\e(B ?\\e$,2&*\e(B ?\\e$,2&+\e(B ?\\e$,2"/\e(B ?\\e$,2&-\e(B ?\\e$,2!`\e(B ?\\e$,2&/\e(B | |
| 1213 | ?\\e$,2&0\e(B ?\\e$,2&1\e(B ?\\e$,2&2\e(B ?\\e$,2!r\e(B ?\\e$,2!|\e(B ?\\e$,2"&\e(B ?\\e$,2&6\e(B ?\\e$,2"7\e(B ?\\e$,2&8\e(B ?\\e$,2&9\e(B ?\\e$,2&:\e(B ?\\e$,2&;\e(B ?\\e$,2&<\e(B ?\\e$,2&=\e(B ?\\e$,2&>\e(B | |
| 1214 | nil | |
| 1215 | ;; mac-dingbats (128..141) -> emacs-mule mapping | |
| 1216 | ?\\e$,2&H\e(B ?\\e$,2&I\e(B ?\\e$,2&J\e(B ?\\e$,2&K\e(B ?\\e$,2&L\e(B ?\\e$,2&M\e(B ?\\e$,2&N\e(B ?\\e$,2&O\e(B ?\\e$,2&P\e(B ?\\e$,2&Q\e(B ?\\e$,2&R\e(B ?\\e$,2&S\e(B ?\\e$,2&T\e(B ?\\e$,2&U\e(B] | |
| 1217 | (make-vector (- 161 142) nil) | |
| 1218 | ;; mac-dingbats (161..239) -> emacs-mule mapping | |
| 1219 | [?\\e$,2&A\e(B ?\\e$,2&B\e(B ?\\e$,2&C\e(B ?\\e$,2&D\e(B ?\\e$,2&E\e(B ?\\e$,2&F\e(B ?\\e$,2&G\e(B ?\\e$,2#c\e(B ?\\e$,2#f\e(B ?\\e$,2#e\e(B ?\\e$,2#`\e(B ?\\e$,1~@\e(B ?\\e$,1~A\e(B ?\\e$,1~B\e(B ?\\e$,1~C\e(B | |
| 1220 | ?\\e$,1~D\e(B ?\\e$,1~E\e(B ?\\e$,1~F\e(B ?\\e$,1~G\e(B ?\\e$,1~H\e(B ?\\e$,1~I\e(B ?\\e$,2&V\e(B ?\\e$,2&W\e(B ?\\e$,2&X\e(B ?\\e$,2&Y\e(B ?\\e$,2&Z\e(B ?\\e$,2&[\e(B ?\\e$,2&\\e(B ?\\e$,2&]\e(B ?\\e$,2&^\e(B ?\\e$,2&_\e(B | |
| 1221 | ?\\e$,2&`\e(B ?\\e$,2&a\e(B ?\\e$,2&b\e(B ?\\e$,2&c\e(B ?\\e$,2&d\e(B ?\\e$,2&e\e(B ?\\e$,2&f\e(B ?\\e$,2&g\e(B ?\\e$,2&h\e(B ?\\e$,2&i\e(B ?\\e$,2&j\e(B ?\\e$,2&k\e(B ?\\e$,2&l\e(B ?\\e$,2&m\e(B ?\\e$,2&n\e(B ?\\e$,2&o\e(B | |
| 1222 | ?\\e$,2&p\e(B ?\\e$,2&q\e(B ?\\e$,2&r\e(B ?\\e$,2&s\e(B ?\\e$,2&t\e(B ?\\e$,1vr\e(B ?\\e$,1vt\e(B ?\\e$,1vu\e(B ?\\e$,2&x\e(B ?\\e$,2&y\e(B ?\\e$,2&z\e(B ?\\e$,2&{\e(B ?\\e$,2&|\e(B ?\\e$,2&}\e(B ?\\e$,2&~\e(B ?\\e$,2&\7f\e(B | |
| 1223 | ?\\e$,2' \e(B ?\\e$,2'!\e(B ?\\e$,2'"\e(B ?\\e$,2'#\e(B ?\\e$,2'$\e(B ?\\e$,2'%\e(B ?\\e$,2'&\e(B ?\\e$,2''\e(B ?\\e$,2'(\e(B ?\\e$,2')\e(B ?\\e$,2'*\e(B ?\\e$,2'+\e(B ?\\e$,2',\e(B ?\\e$,2'-\e(B ?\\e$,2'.\e(B ?\\e$,2'/\e(B | |
| 1224 | nil | |
| 1225 | ;; mac-dingbats (241..254) -> emacs-mule mapping | |
| 1226 | ?\\e$,2'1\e(B ?\\e$,2'2\e(B ?\\e$,2'3\e(B ?\\e$,2'4\e(B ?\\e$,2'5\e(B ?\\e$,2'6\e(B ?\\e$,2'7\e(B ?\\e$,2'8\e(B ?\\e$,2'9\e(B ?\\e$,2':\e(B ?\\e$,2';\e(B ?\\e$,2'<\e(B ?\\e$,2'=\e(B ?\\e$,2'>\e(B | |
| 1227 | nil])) | |
| 1228 | translation-table) | |
| 1229 | (setq translation-table | |
| 1230 | (make-translation-table-from-vector encoding-vector)) | |
| 1231 | ;; (define-translation-table 'mac-dingbats-decoder translation-table) | |
| 1232 | (define-translation-table 'mac-dingbats-encoder | |
| 1233 | (char-table-extra-slot translation-table 0))) | |
| 1234 | ||
| 1235 | (defconst mac-system-coding-system | |
| 1236 | (let ((base (or (cdr (assq mac-system-script-code | |
| 1237 | mac-script-code-coding-systems)) | |
| 1238 | 'mac-roman))) | |
| 1239 | (if (eq system-type 'darwin) | |
| 1240 | base | |
| 1241 | (coding-system-change-eol-conversion base 'mac))) | |
| 1242 | "Coding system derived from the system script code.") | |
| 1243 | ||
| 1244 | (set-selection-coding-system mac-system-coding-system) | |
| 1245 | ||
| 9bf2510a | 1246 | \f |
| 92a607bd YM |
1247 | ;;;; Keyboard layout/language change events |
| 1248 | (defun mac-handle-language-change (event) | |
| 62ffc232 | 1249 | "Set keyboard coding system to what is specified in EVENT." |
| 92a607bd YM |
1250 | (interactive "e") |
| 1251 | (let ((coding-system | |
| 1252 | (cdr (assq (car (cadr event)) mac-script-code-coding-systems)))) | |
| 1253 | (set-keyboard-coding-system (or coding-system 'mac-roman)) | |
| 1254 | ;; MacJapanese maps reverse solidus to ?\x80. | |
| 1255 | (if (eq coding-system 'japanese-shift-jis) | |
| ac09dc1e | 1256 | (define-key key-translation-map [?\x80] "\\")))) |
| 74e2abe2 | 1257 | |
| 92a607bd | 1258 | (define-key special-event-map [language-change] 'mac-handle-language-change) |
| 6e53dc95 YM |
1259 | |
| 1260 | \f | |
| 1261 | ;;;; Conversion between common flavors and Lisp string. | |
| 1262 | ||
| 05d3aeb0 YM |
1263 | (defconst mac-text-encoding-ascii #x600 |
| 1264 | "ASCII text encoding.") | |
| 1265 | ||
| 6e53dc95 YM |
1266 | (defconst mac-text-encoding-mac-japanese-basic-variant #x20001 |
| 1267 | "MacJapanese text encoding without Apple double-byte extensions.") | |
| 1268 | ||
| 1269 | (defun mac-utxt-to-string (data &optional coding-system) | |
| 1270 | (or coding-system (setq coding-system mac-system-coding-system)) | |
| 1271 | (let* ((encoding | |
| 1272 | (and (eq system-type 'darwin) | |
| 1273 | (eq (coding-system-base coding-system) 'japanese-shift-jis) | |
| 1274 | mac-text-encoding-mac-japanese-basic-variant)) | |
| 1275 | (str (and (fboundp 'mac-code-convert-string) | |
| 1276 | (mac-code-convert-string data nil | |
| 1277 | (or encoding coding-system))))) | |
| 1278 | (when str | |
| 1279 | (setq str (decode-coding-string str coding-system)) | |
| 527ba7f4 | 1280 | (if (eq encoding mac-text-encoding-mac-japanese-basic-variant) |
| 6e53dc95 YM |
1281 | ;; Does it contain Apple one-byte extensions other than |
| 1282 | ;; reverse solidus? | |
| 1283 | (if (string-match "[\xa0\xfd-\xff]" str) | |
| 1284 | (setq str nil) | |
| e834108f | 1285 | ;; ASCII-only? |
| 05d3aeb0 | 1286 | (unless (mac-code-convert-string data nil mac-text-encoding-ascii) |
| e834108f YM |
1287 | (subst-char-in-string ?\x5c ?\\e(J\\e(B str t) |
| 1288 | (subst-char-in-string ?\x80 ?\\ str t))))) | |
| 6e53dc95 YM |
1289 | (or str |
| 1290 | (decode-coding-string data | |
| 1291 | (if (eq (byteorder) ?B) 'utf-16be 'utf-16le))))) | |
| 1292 | ||
| 1293 | (defun mac-string-to-utxt (string &optional coding-system) | |
| 1294 | (or coding-system (setq coding-system mac-system-coding-system)) | |
| 1295 | (let (data encoding) | |
| 1296 | (when (and (fboundp 'mac-code-convert-string) | |
| 1297 | (memq (coding-system-base coding-system) | |
| 1298 | (find-coding-systems-string string))) | |
| 1299 | (setq coding-system | |
| 1300 | (coding-system-change-eol-conversion coding-system 'mac)) | |
| 762ce89d YM |
1301 | (let ((str string)) |
| 1302 | (when (and (eq system-type 'darwin) | |
| 1303 | (eq coding-system 'japanese-shift-jis-mac)) | |
| 1304 | (setq encoding mac-text-encoding-mac-japanese-basic-variant) | |
| 1305 | (setq str (subst-char-in-string ?\\ ?\x80 str)) | |
| 1306 | (subst-char-in-string ?\\e(J\\e(B ?\x5c str t) | |
| 1307 | ;; ASCII-only? | |
| 1308 | (if (string-match "\\`[\x00-\x7f]*\\'" str) | |
| 1309 | (setq str nil))) | |
| 1310 | (and str | |
| 1311 | (setq data (mac-code-convert-string | |
| 1312 | (encode-coding-string str coding-system) | |
| 1313 | (or encoding coding-system) nil))))) | |
| 6e53dc95 YM |
1314 | (or data (encode-coding-string string (if (eq (byteorder) ?B) |
| 1315 | 'utf-16be-mac | |
| 1316 | 'utf-16le-mac))))) | |
| 1317 | ||
| 1318 | (defun mac-TEXT-to-string (data &optional coding-system) | |
| 1319 | (or coding-system (setq coding-system mac-system-coding-system)) | |
| 1320 | (prog1 (setq data (decode-coding-string data coding-system)) | |
| 1321 | (when (eq (coding-system-base coding-system) 'japanese-shift-jis) | |
| 1322 | ;; (subst-char-in-string ?\x5c ?\\e(J\\e(B data t) | |
| 1323 | (subst-char-in-string ?\x80 ?\\ data t)))) | |
| 1324 | ||
| 1325 | (defun mac-string-to-TEXT (string &optional coding-system) | |
| 1326 | (or coding-system (setq coding-system mac-system-coding-system)) | |
| 1327 | (let ((encodables (find-coding-systems-string string)) | |
| 1328 | (rest mac-script-code-coding-systems)) | |
| 1329 | (unless (memq (coding-system-base coding-system) encodables) | |
| 1330 | (while (and rest (not (memq (cdar rest) encodables))) | |
| 1331 | (setq rest (cdr rest))) | |
| 1332 | (if rest | |
| 1333 | (setq coding-system (cdar rest))))) | |
| 1334 | (setq coding-system | |
| 1335 | (coding-system-change-eol-conversion coding-system 'mac)) | |
| 1336 | (when (eq coding-system 'japanese-shift-jis-mac) | |
| 1337 | ;; (setq string (subst-char-in-string ?\\ ?\x80 string)) | |
| 1338 | (setq string (subst-char-in-string ?\\e(J\\e(B ?\x5c string))) | |
| 1339 | (encode-coding-string string coding-system)) | |
| 1340 | ||
| 1341 | (defun mac-furl-to-string (data) | |
| 1342 | ;; Remove a trailing nul character. | |
| 1343 | (let ((len (length data))) | |
| 1344 | (if (and (> len 0) (= (aref data (1- len)) ?\0)) | |
| 1345 | (substring data 0 (1- len)) | |
| 1346 | data))) | |
| 1347 | ||
| 1348 | (defun mac-TIFF-to-string (data &optional text) | |
| 1349 | (prog1 (or text (setq text (copy-sequence " "))) | |
| 1350 | (put-text-property 0 (length text) 'display (create-image data 'tiff t) | |
| 1351 | text))) | |
| 74e2abe2 | 1352 | \f |
| ea1f6051 | 1353 | ;;;; Selections |
| 853065b6 | 1354 | |
| 853065b6 YM |
1355 | ;;; We keep track of the last text selected here, so we can check the |
| 1356 | ;;; current selection against it, and avoid passing back our own text | |
| 1357 | ;;; from x-get-selection-value. | |
| 1358 | (defvar x-last-selected-text-clipboard nil | |
| 1359 | "The value of the CLIPBOARD selection last time we selected or | |
| 1360 | pasted text.") | |
| 1361 | (defvar x-last-selected-text-primary nil | |
| 1362 | "The value of the PRIMARY X selection last time we selected or | |
| 1363 | pasted text.") | |
| 1364 | ||
| 1365 | (defcustom x-select-enable-clipboard t | |
| 1366 | "*Non-nil means cutting and pasting uses the clipboard. | |
| 1367 | This is in addition to the primary selection." | |
| 1368 | :type 'boolean | |
| 1369 | :group 'killing) | |
| 1370 | ||
| 1371 | ;;; Make TEXT, a string, the primary X selection. | |
| 1372 | (defun x-select-text (text &optional push) | |
| 1373 | (x-set-selection 'PRIMARY text) | |
| 1374 | (setq x-last-selected-text-primary text) | |
| 2f13e358 YM |
1375 | (if (not x-select-enable-clipboard) |
| 1376 | (setq x-last-selected-text-clipboard nil) | |
| 853065b6 YM |
1377 | (x-set-selection 'CLIPBOARD text) |
| 1378 | (setq x-last-selected-text-clipboard text)) | |
| 1379 | ) | |
| 1380 | ||
| 1381 | (defun x-get-selection (&optional type data-type) | |
| 1382 | "Return the value of a selection. | |
| 1383 | The argument TYPE (default `PRIMARY') says which selection, | |
| 1384 | and the argument DATA-TYPE (default `STRING') says | |
| 1385 | how to convert the data. | |
| 1386 | ||
| 1387 | TYPE may be any symbol \(but nil stands for `PRIMARY'). However, | |
| 1388 | only a few symbols are commonly used. They conventionally have | |
| 1389 | all upper-case names. The most often used ones, in addition to | |
| 1390 | `PRIMARY', are `SECONDARY' and `CLIPBOARD'. | |
| 1391 | ||
| 1392 | DATA-TYPE is usually `STRING', but can also be one of the symbols | |
| 1393 | in `selection-converter-alist', which see." | |
| 1394 | (let ((data (x-get-selection-internal (or type 'PRIMARY) | |
| 1395 | (or data-type 'STRING))) | |
| 1396 | (coding (or next-selection-coding-system | |
| 1397 | selection-coding-system))) | |
| 1398 | (when (and (stringp data) | |
| 1399 | (setq data-type (get-text-property 0 'foreign-selection data))) | |
| 1400 | (cond ((eq data-type 'public.utf16-plain-text) | |
| 6e53dc95 | 1401 | (setq data (mac-utxt-to-string data coding))) |
| 853065b6 | 1402 | ((eq data-type 'com.apple.traditional-mac-plain-text) |
| 6e53dc95 | 1403 | (setq data (mac-TEXT-to-string data coding))) |
| 2f13e358 | 1404 | ((eq data-type 'public.file-url) |
| 6e53dc95 | 1405 | (setq data (mac-furl-to-string data)))) |
| 853065b6 YM |
1406 | (put-text-property 0 (length data) 'foreign-selection data-type data)) |
| 1407 | data)) | |
| 1408 | ||
| 1409 | (defun x-selection-value (type) | |
| 2f13e358 YM |
1410 | (let ((data-types '(public.utf16-plain-text |
| 1411 | com.apple.traditional-mac-plain-text | |
| 1412 | public.file-url)) | |
| 1413 | text tiff-image) | |
| 1414 | (while (and (null text) data-types) | |
| 1415 | (setq text (condition-case nil | |
| 1416 | (x-get-selection type (car data-types)) | |
| 1417 | (error nil))) | |
| 1418 | (setq data-types (cdr data-types))) | |
| 853065b6 YM |
1419 | (if text |
| 1420 | (remove-text-properties 0 (length text) '(foreign-selection nil) text)) | |
| 1421 | (setq tiff-image (condition-case nil | |
| 1422 | (x-get-selection type 'public.tiff) | |
| 1423 | (error nil))) | |
| 1424 | (when tiff-image | |
| 1425 | (remove-text-properties 0 (length tiff-image) | |
| 1426 | '(foreign-selection nil) tiff-image) | |
| 6e53dc95 | 1427 | (setq text (mac-TIFF-to-string tiff-image text))) |
| 853065b6 YM |
1428 | text)) |
| 1429 | ||
| 1430 | ;;; Return the value of the current selection. | |
| 1431 | ;;; Treat empty strings as if they were unset. | |
| 1432 | ;;; If this function is called twice and finds the same text, | |
| 1433 | ;;; it returns nil the second time. This is so that a single | |
| 1434 | ;;; selection won't be added to the kill ring over and over. | |
| 1435 | (defun x-get-selection-value () | |
| 1436 | (let (clip-text primary-text) | |
| 2f13e358 YM |
1437 | (if (not x-select-enable-clipboard) |
| 1438 | (setq x-last-selected-text-clipboard nil) | |
| 853065b6 YM |
1439 | (setq clip-text (x-selection-value 'CLIPBOARD)) |
| 1440 | (if (string= clip-text "") (setq clip-text nil)) | |
| 1441 | ||
| 1442 | ;; Check the CLIPBOARD selection for 'newness', is it different | |
| 1443 | ;; from what we remebered them to be last time we did a | |
| 1444 | ;; cut/paste operation. | |
| 1445 | (setq clip-text | |
| 1446 | (cond;; check clipboard | |
| 1447 | ((or (not clip-text) (string= clip-text "")) | |
| 1448 | (setq x-last-selected-text-clipboard nil)) | |
| 1449 | ((eq clip-text x-last-selected-text-clipboard) nil) | |
| 1450 | ((string= clip-text x-last-selected-text-clipboard) | |
| 1451 | ;; Record the newer string, | |
| 1452 | ;; so subsequent calls can use the `eq' test. | |
| 1453 | (setq x-last-selected-text-clipboard clip-text) | |
| 1454 | nil) | |
| 1455 | (t | |
| 1456 | (setq x-last-selected-text-clipboard clip-text)))) | |
| 1457 | ) | |
| 1458 | ||
| 1459 | (setq primary-text (x-selection-value 'PRIMARY)) | |
| 1460 | ;; Check the PRIMARY selection for 'newness', is it different | |
| 1461 | ;; from what we remebered them to be last time we did a | |
| 1462 | ;; cut/paste operation. | |
| 1463 | (setq primary-text | |
| 1464 | (cond;; check primary selection | |
| 1465 | ((or (not primary-text) (string= primary-text "")) | |
| 1466 | (setq x-last-selected-text-primary nil)) | |
| 1467 | ((eq primary-text x-last-selected-text-primary) nil) | |
| 1468 | ((string= primary-text x-last-selected-text-primary) | |
| 1469 | ;; Record the newer string, | |
| 1470 | ;; so subsequent calls can use the `eq' test. | |
| 1471 | (setq x-last-selected-text-primary primary-text) | |
| 1472 | nil) | |
| 1473 | (t | |
| 1474 | (setq x-last-selected-text-primary primary-text)))) | |
| 1475 | ||
| 1476 | ;; As we have done one selection, clear this now. | |
| 1477 | (setq next-selection-coding-system nil) | |
| 1478 | ||
| 1479 | ;; At this point we have recorded the current values for the | |
| 1480 | ;; selection from clipboard (if we are supposed to) and primary, | |
| 1481 | ;; So return the first one that has changed (which is the first | |
| 1482 | ;; non-null one). | |
| 1483 | (or clip-text primary-text) | |
| 1484 | )) | |
| 1485 | ||
| 1486 | (put 'CLIPBOARD 'mac-scrap-name "com.apple.scrap.clipboard") | |
| 2f13e358 YM |
1487 | (when (eq system-type 'darwin) |
| 1488 | (put 'FIND 'mac-scrap-name "com.apple.scrap.find") | |
| 1489 | (put 'PRIMARY 'mac-scrap-name | |
| 1490 | (format "org.gnu.Emacs.%d.selection.PRIMARY" (emacs-pid)))) | |
| 853065b6 YM |
1491 | (put 'com.apple.traditional-mac-plain-text 'mac-ostype "TEXT") |
| 1492 | (put 'public.utf16-plain-text 'mac-ostype "utxt") | |
| 1493 | (put 'public.tiff 'mac-ostype "TIFF") | |
| 2f13e358 | 1494 | (put 'public.file-url 'mac-ostype "furl") |
| 853065b6 YM |
1495 | |
| 1496 | (defun mac-select-convert-to-string (selection type value) | |
| 1497 | (let ((str (cdr (xselect-convert-to-string selection nil value))) | |
| 6e53dc95 | 1498 | (coding (or next-selection-coding-system selection-coding-system))) |
| 853065b6 YM |
1499 | (when str |
| 1500 | ;; If TYPE is nil, this is a local request, thus return STR as | |
| 1501 | ;; is. Otherwise, encode STR. | |
| 1502 | (if (not type) | |
| 1503 | str | |
| 1504 | (let ((inhibit-read-only t)) | |
| 1505 | (remove-text-properties 0 (length str) '(composition nil) str) | |
| 1506 | (cond | |
| 1507 | ((eq type 'public.utf16-plain-text) | |
| 6e53dc95 | 1508 | (setq str (mac-string-to-utxt str coding))) |
| 853065b6 | 1509 | ((eq type 'com.apple.traditional-mac-plain-text) |
| 6e53dc95 | 1510 | (setq str (mac-string-to-TEXT str coding))) |
| 853065b6 YM |
1511 | (t |
| 1512 | (error "Unknown selection type: %S" type)) | |
| 1513 | ))) | |
| 1514 | ||
| 1515 | (setq next-selection-coding-system nil) | |
| 1516 | (cons type str)))) | |
| 1517 | ||
| 2f13e358 YM |
1518 | (defun mac-select-convert-to-file-url (selection type value) |
| 1519 | (let ((filename (xselect-convert-to-filename selection type value)) | |
| 1520 | (coding (or file-name-coding-system default-file-name-coding-system))) | |
| 1521 | (if (and filename coding) | |
| 1522 | (setq filename (encode-coding-string filename coding))) | |
| 1523 | (and filename | |
| 1524 | (concat "file://localhost" | |
| 1525 | (mapconcat 'url-hexify-string | |
| 1526 | (split-string filename "/") "/"))))) | |
| 1527 | ||
| 853065b6 YM |
1528 | (setq selection-converter-alist |
| 1529 | (nconc | |
| 1530 | '((public.utf16-plain-text . mac-select-convert-to-string) | |
| 1531 | (com.apple.traditional-mac-plain-text . mac-select-convert-to-string) | |
| 1532 | ;; This is not enabled by default because the `Import Image' | |
| 1533 | ;; menu makes Emacs crash or hang for unknown reasons. | |
| 1534 | ;; (public.tiff . nil) | |
| 2f13e358 | 1535 | (public.file-url . mac-select-convert-to-file-url) |
| 853065b6 YM |
1536 | ) |
| 1537 | selection-converter-alist)) | |
| ea1f6051 YM |
1538 | \f |
| 1539 | ;;;; Apple events, HICommand events, and Services menu | |
| 1540 | ||
| 1541 | ;;; Event classes | |
| 1542 | (put 'core-event 'mac-apple-event-class "aevt") ; kCoreEventClass | |
| 1543 | (put 'internet-event 'mac-apple-event-class "GURL") ; kAEInternetEventClass | |
| 1544 | ||
| a149e872 | 1545 | ;;; Event IDs |
| ea1f6051 | 1546 | ;; kCoreEventClass |
| dbcdba77 YM |
1547 | (put 'open-application 'mac-apple-event-id "oapp") ; kAEOpenApplication |
| 1548 | (put 'reopen-application 'mac-apple-event-id "rapp") ; kAEReopenApplication | |
| 1549 | (put 'open-documents 'mac-apple-event-id "odoc") ; kAEOpenDocuments | |
| 1550 | (put 'print-documents 'mac-apple-event-id "pdoc") ; kAEPrintDocuments | |
| 1551 | (put 'open-contents 'mac-apple-event-id "ocon") ; kAEOpenContents | |
| 1552 | (put 'quit-application 'mac-apple-event-id "quit") ; kAEQuitApplication | |
| 1553 | (put 'application-died 'mac-apple-event-id "obit") ; kAEApplicationDied | |
| 1554 | (put 'show-preferences 'mac-apple-event-id "pref") ; kAEShowPreferences | |
| 1555 | (put 'autosave-now 'mac-apple-event-id "asav") ; kAEAutosaveNow | |
| ea1f6051 | 1556 | ;; kAEInternetEventClass |
| dbcdba77 | 1557 | (put 'get-url 'mac-apple-event-id "GURL") ; kAEGetURL |
| 4442ec0d | 1558 | ;; Converted HI command events |
| dbcdba77 YM |
1559 | (put 'about 'mac-apple-event-id "abou") ; kHICommandAbout |
| 1560 | (put 'show-hide-font-panel 'mac-apple-event-id "shfp") ; kHICommandShowHideFontPanel | |
| ea1f6051 YM |
1561 | |
| 1562 | (defmacro mac-event-spec (event) | |
| 1563 | `(nth 1 ,event)) | |
| 1564 | ||
| 1565 | (defmacro mac-event-ae (event) | |
| 1566 | `(nth 2 ,event)) | |
| 1567 | ||
| 1568 | (defun mac-ae-parameter (ae &optional keyword type) | |
| 1569 | (or keyword (setq keyword "----")) ;; Direct object. | |
| 1570 | (if (not (and (consp ae) (equal (car ae) "aevt"))) | |
| 1571 | (error "Not an Apple event: %S" ae) | |
| 1572 | (let ((type-data (cdr (assoc keyword (cdr ae)))) | |
| 1573 | data) | |
| a149e872 | 1574 | (when (and type type-data (not (equal type (car type-data)))) |
| ea1f6051 YM |
1575 | (setq data (mac-coerce-ae-data (car type-data) (cdr type-data) type)) |
| 1576 | (setq type-data (if data (cons type data) nil))) | |
| 1577 | type-data))) | |
| 1578 | ||
| 1579 | (defun mac-ae-list (ae &optional keyword type) | |
| 1580 | (or keyword (setq keyword "----")) ;; Direct object. | |
| a149e872 | 1581 | (let ((desc (mac-ae-parameter ae keyword "list"))) |
| ea1f6051 YM |
1582 | (cond ((null desc) |
| 1583 | nil) | |
| 1584 | ((not (equal (car desc) "list")) | |
| 1585 | (error "Parameter for \"%s\" is not a list" keyword)) | |
| 1586 | (t | |
| 1587 | (if (null type) | |
| 1588 | (cdr desc) | |
| 1589 | (mapcar | |
| 1590 | (lambda (type-data) | |
| 1591 | (mac-coerce-ae-data (car type-data) (cdr type-data) type)) | |
| 1592 | (cdr desc))))))) | |
| 1593 | ||
| dc34c597 YM |
1594 | (defun mac-ae-number (ae keyword) |
| 1595 | (let ((type-data (mac-ae-parameter ae keyword)) | |
| 1596 | str) | |
| 1597 | (if (and type-data | |
| 1598 | (setq str (mac-coerce-ae-data (car type-data) | |
| 1599 | (cdr type-data) "TEXT"))) | |
| e5a4ac9d YM |
1600 | (let ((num (string-to-number str))) |
| 1601 | ;; Mac OS Classic may return "0e+0" as the coerced value for | |
| 1602 | ;; the type "magn" and the data "\000\000\000\000". | |
| 1603 | (if (= num 0.0) 0 num)) | |
| dc34c597 YM |
1604 | nil))) |
| 1605 | ||
| ea1f6051 YM |
1606 | (defun mac-bytes-to-integer (bytes &optional from to) |
| 1607 | (or from (setq from 0)) | |
| 1608 | (or to (setq to (length bytes))) | |
| 1609 | (let* ((len (- to from)) | |
| 1610 | (extended-sign-len (- (1+ (ceiling (log most-positive-fixnum 2))) | |
| 1611 | (* 8 len))) | |
| 1612 | (result 0)) | |
| 1613 | (dotimes (i len) | |
| 1614 | (setq result (logior (lsh result 8) | |
| 1615 | (aref bytes (+ from (if (eq (byteorder) ?B) i | |
| 1616 | (- len i 1))))))) | |
| 1617 | (if (> extended-sign-len 0) | |
| 1618 | (ash (lsh result extended-sign-len) (- extended-sign-len)) | |
| 1619 | result))) | |
| 1620 | ||
| 1621 | (defun mac-ae-selection-range (ae) | |
| 1622 | ;; #pragma options align=mac68k | |
| 1623 | ;; typedef struct SelectionRange { | |
| 1624 | ;; short unused1; // 0 (not used) | |
| 1625 | ;; short lineNum; // line to select (<0 to specify range) | |
| 1626 | ;; long startRange; // start of selection range (if line < 0) | |
| 1627 | ;; long endRange; // end of selection range (if line < 0) | |
| 1628 | ;; long unused2; // 0 (not used) | |
| 1629 | ;; long theDate; // modification date/time | |
| 1630 | ;; } SelectionRange; | |
| 1631 | ;; #pragma options align=reset | |
| 1632 | (let ((range-bytes (cdr (mac-ae-parameter ae "kpos" "TEXT")))) | |
| 1633 | (and range-bytes | |
| 1634 | (list (mac-bytes-to-integer range-bytes 2 4) | |
| 1635 | (mac-bytes-to-integer range-bytes 4 8) | |
| 1636 | (mac-bytes-to-integer range-bytes 8 12) | |
| 1637 | (mac-bytes-to-integer range-bytes 16 20))))) | |
| 1638 | ||
| 1639 | ;; On Mac OS X 10.4 and later, the `open-document' event contains an | |
| 1640 | ;; optional parameter keyAESearchText from the Spotlight search. | |
| 1641 | (defun mac-ae-text-for-search (ae) | |
| 1642 | (let ((utf8-text (cdr (mac-ae-parameter ae "stxt" "utf8")))) | |
| 1643 | (and utf8-text | |
| 1644 | (decode-coding-string utf8-text 'utf-8)))) | |
| 1645 | ||
| dc34c597 YM |
1646 | (defun mac-ae-text (ae) |
| 1647 | (or (cdr (mac-ae-parameter ae nil "TEXT")) | |
| 1648 | (error "No text in Apple event."))) | |
| 1649 | ||
| 1650 | (defun mac-ae-frame (ae &optional keyword type) | |
| 1651 | (let ((bytes (cdr (mac-ae-parameter ae keyword type)))) | |
| 1652 | (if (or (null bytes) (/= (length bytes) 4)) | |
| 1653 | (error "No window reference in Apple event.") | |
| 1654 | (let ((window-id (mac-coerce-ae-data "long" bytes "TEXT")) | |
| 1655 | (rest (frame-list)) | |
| 1656 | frame) | |
| 1657 | (while (and (null frame) rest) | |
| 1658 | (if (string= (frame-parameter (car rest) 'window-id) window-id) | |
| 1659 | (setq frame (car rest))) | |
| 1660 | (setq rest (cdr rest))) | |
| 1661 | frame)))) | |
| 1662 | ||
| 1663 | (defun mac-ae-script-language (ae keyword) | |
| 1664 | ;; struct WritingCode { | |
| 1665 | ;; ScriptCode theScriptCode; | |
| 1666 | ;; LangCode theLangCode; | |
| 1667 | ;; }; | |
| 1668 | (let ((bytes (cdr (mac-ae-parameter ae keyword "intl")))) | |
| 1669 | (and bytes | |
| 1670 | (cons (mac-bytes-to-integer bytes 0 2) | |
| 1671 | (mac-bytes-to-integer bytes 2 4))))) | |
| 1672 | ||
| 1673 | (defun mac-bytes-to-text-range (bytes &optional from to) | |
| 1674 | ;; struct TextRange { | |
| 1675 | ;; long fStart; | |
| 1676 | ;; long fEnd; | |
| 1677 | ;; short fHiliteStyle; | |
| 1678 | ;; }; | |
| 1679 | (or from (setq from 0)) | |
| 1680 | (or to (setq to (length bytes))) | |
| 1681 | (and (= (- to from) (+ 4 4 2)) | |
| 1682 | (list (mac-bytes-to-integer bytes from (+ from 4)) | |
| 1683 | (mac-bytes-to-integer bytes (+ from 4) (+ from 8)) | |
| 1684 | (mac-bytes-to-integer bytes (+ from 8) to)))) | |
| 1685 | ||
| 1686 | (defun mac-ae-text-range-array (ae keyword) | |
| 1687 | ;; struct TextRangeArray { | |
| 1688 | ;; short fNumOfRanges; | |
| 1689 | ;; TextRange fRange[1]; | |
| 1690 | ;; }; | |
| 1691 | (let* ((bytes (cdr (mac-ae-parameter ae keyword "tray"))) | |
| 1692 | (len (length bytes)) | |
| 1693 | nranges result) | |
| 1694 | (when (and bytes (>= len 2) | |
| 1695 | (progn | |
| 1696 | (setq nranges (mac-bytes-to-integer bytes 0 2)) | |
| 1697 | (= len (+ 2 (* nranges 10))))) | |
| 1698 | (setq result (make-vector nranges nil)) | |
| 1699 | (dotimes (i nranges) | |
| 1700 | (aset result i | |
| 1701 | (mac-bytes-to-text-range bytes (+ (* i 10) 2) | |
| 1702 | (+ (* i 10) 12))))) | |
| 1703 | result)) | |
| 1704 | ||
| 1879b65c YM |
1705 | (defconst mac-keyboard-modifier-mask-alist |
| 1706 | (mapcar | |
| 1707 | (lambda (modifier-bit) | |
| 1708 | (cons (car modifier-bit) (lsh 1 (cdr modifier-bit)))) | |
| 1709 | '((command . 8) ; cmdKeyBit | |
| 1710 | (shift . 9) ; shiftKeyBit | |
| 1711 | (option . 11) ; optionKeyBit | |
| 1712 | (control . 12) ; controlKeyBit | |
| 1713 | (function . 17))) ; kEventKeyModifierFnBit | |
| 1714 | "Alist of Mac keyboard modifier symbols vs masks.") | |
| 1715 | ||
| 1716 | (defun mac-ae-keyboard-modifiers (ae) | |
| 1717 | (let ((modifiers-value (mac-ae-number ae "kmod")) | |
| 1718 | modifiers) | |
| 1719 | (if modifiers-value | |
| 1720 | (dolist (modifier-mask mac-keyboard-modifier-mask-alist) | |
| 1721 | (if (/= (logand modifiers-value (cdr modifier-mask)) 0) | |
| 1722 | (setq modifiers (cons (car modifier-mask) modifiers))))) | |
| 1723 | modifiers)) | |
| 1724 | ||
| b16f162d YM |
1725 | (defun mac-ae-reopen-application (event) |
| 1726 | "Show some frame in response to the Apple event EVENT. | |
| 1727 | The frame to be shown is chosen from visible or iconified frames | |
| 1728 | if possible. If there's no such frame, a new frame is created." | |
| 1729 | (interactive "e") | |
| 1730 | (unless (frame-visible-p (selected-frame)) | |
| 1731 | (let ((frame (or (car (visible-frame-list)) | |
| 1732 | (car (filtered-frame-list 'frame-visible-p))))) | |
| 1733 | (if frame | |
| 1734 | (select-frame frame) | |
| 1735 | (switch-to-buffer-other-frame "*scratch*")))) | |
| 1736 | (select-frame-set-input-focus (selected-frame))) | |
| 1737 | ||
| ea1f6051 | 1738 | (defun mac-ae-open-documents (event) |
| 62ffc232 | 1739 | "Open the documents specified by the Apple event EVENT." |
| ea1f6051 YM |
1740 | (interactive "e") |
| 1741 | (let ((ae (mac-event-ae event))) | |
| 1742 | (dolist (file-name (mac-ae-list ae nil 'undecoded-file-name)) | |
| 1743 | (if file-name | |
| fc0a69d1 YM |
1744 | (dnd-open-local-file |
| 1745 | (concat "file://" | |
| 1746 | (mapconcat 'url-hexify-string | |
| 1747 | (split-string file-name "/") "/")) nil))) | |
| ea1f6051 YM |
1748 | (let ((selection-range (mac-ae-selection-range ae)) |
| 1749 | (search-text (mac-ae-text-for-search ae))) | |
| 1750 | (cond (selection-range | |
| 1751 | (let ((line (car selection-range)) | |
| 1752 | (start (cadr selection-range)) | |
| 1753 | (end (nth 2 selection-range))) | |
| 1754 | (if (> line 0) | |
| 1755 | (goto-line line) | |
| 1756 | (if (and (> start 0) (> end 0)) | |
| 1757 | (progn (set-mark start) | |
| 1758 | (goto-char end)))))) | |
| 1759 | ((stringp search-text) | |
| 1760 | (re-search-forward | |
| 1761 | (mapconcat 'regexp-quote (split-string search-text) "\\|") | |
| 1762 | nil t))))) | |
| fc36394b | 1763 | (select-frame-set-input-focus (selected-frame))) |
| ea1f6051 | 1764 | |
| 025a24b5 YM |
1765 | (defun mac-ae-quit-application (event) |
| 1766 | "Quit the application Emacs with the Apple event EVENT." | |
| 1767 | (interactive "e") | |
| 1768 | (let ((ae (mac-event-ae event))) | |
| 1769 | (unwind-protect | |
| 1770 | (save-buffers-kill-emacs) | |
| 1771 | ;; Reaches here if the user has canceled the quit. | |
| 1772 | (mac-resume-apple-event ae -128)))) ; userCanceledErr | |
| 1773 | ||
| ea1f6051 | 1774 | (defun mac-ae-get-url (event) |
| 62ffc232 YM |
1775 | "Open the URL specified by the Apple event EVENT. |
| 1776 | Currently the `mailto' scheme is supported." | |
| ea1f6051 YM |
1777 | (interactive "e") |
| 1778 | (let* ((ae (mac-event-ae event)) | |
| 1779 | (parsed-url (url-generic-parse-url (mac-ae-text ae)))) | |
| 1780 | (if (string= (url-type parsed-url) "mailto") | |
| e5a4ac9d YM |
1781 | (progn |
| 1782 | (url-mailto parsed-url) | |
| 1783 | (select-frame-set-input-focus (selected-frame))) | |
| dc47c824 | 1784 | (mac-resume-apple-event ae t)))) |
| ea1f6051 | 1785 | |
| 2f1fd484 YM |
1786 | (setq mac-apple-event-map (make-sparse-keymap)) |
| 1787 | ||
| ea1f6051 YM |
1788 | ;; Received when Emacs is launched without associated documents. |
| 1789 | ;; Accept it as an Apple event, but no Emacs event is generated so as | |
| 1790 | ;; not to erase the splash screen. | |
| 1791 | (define-key mac-apple-event-map [core-event open-application] 0) | |
| 1792 | ||
| 1793 | ;; Received when a dock or application icon is clicked and Emacs is | |
| b16f162d YM |
1794 | ;; already running. |
| 1795 | (define-key mac-apple-event-map [core-event reopen-application] | |
| 1796 | 'mac-ae-reopen-application) | |
| ea1f6051 YM |
1797 | |
| 1798 | (define-key mac-apple-event-map [core-event open-documents] | |
| 1799 | 'mac-ae-open-documents) | |
| 1800 | (define-key mac-apple-event-map [core-event show-preferences] 'customize) | |
| 1801 | (define-key mac-apple-event-map [core-event quit-application] | |
| 025a24b5 | 1802 | 'mac-ae-quit-application) |
| ea1f6051 YM |
1803 | |
| 1804 | (define-key mac-apple-event-map [internet-event get-url] 'mac-ae-get-url) | |
| 1805 | ||
| 254aafa8 | 1806 | (define-key mac-apple-event-map [hi-command about] 'about-emacs) |
| 853065b6 | 1807 | |
| 527ba7f4 YM |
1808 | ;;; Converted Carbon Events |
| 1809 | (defun mac-handle-toolbar-switch-mode (event) | |
| 1810 | "Toggle visibility of tool-bars in response to EVENT. | |
| 1811 | With no keyboard modifiers, it toggles the visibility of the | |
| 1812 | frame where the tool-bar toggle button was pressed. With some | |
| 8a2e0b2a | 1813 | modifiers, it changes the global tool-bar visibility setting." |
| 527ba7f4 | 1814 | (interactive "e") |
| 1879b65c YM |
1815 | (let ((ae (mac-event-ae event))) |
| 1816 | (if (mac-ae-keyboard-modifiers ae) | |
| 527ba7f4 | 1817 | ;; Globally toggle tool-bar-mode if some modifier key is pressed. |
| 8a2e0b2a | 1818 | (tool-bar-mode 'toggle) |
| dc34c597 | 1819 | (let ((frame (mac-ae-frame ae))) |
| 527ba7f4 YM |
1820 | (set-frame-parameter frame 'tool-bar-lines |
| 1821 | (if (= (frame-parameter frame 'tool-bar-lines) 0) | |
| 1822 | 1 0)))))) | |
| 1823 | ||
| 1824 | ;; kEventClassWindow/kEventWindowToolbarSwitchMode | |
| 1825 | (define-key mac-apple-event-map [window toolbar-switch-mode] | |
| 1826 | 'mac-handle-toolbar-switch-mode) | |
| 1827 | ||
| 1828 | ;;; Font panel | |
| e5a4ac9d | 1829 | (when (fboundp 'mac-set-font-panel-visible-p) |
| 527ba7f4 YM |
1830 | |
| 1831 | (define-minor-mode mac-font-panel-mode | |
| 1832 | "Toggle use of the font panel. | |
| b905e809 | 1833 | With numeric ARG, display the font panel if and only if ARG is positive." |
| 527ba7f4 YM |
1834 | :init-value nil |
| 1835 | :global t | |
| 1836 | :group 'mac | |
| e5a4ac9d | 1837 | (mac-set-font-panel-visible-p mac-font-panel-mode)) |
| 527ba7f4 YM |
1838 | |
| 1839 | (defun mac-handle-font-panel-closed (event) | |
| 1840 | "Update internal status in response to font panel closed EVENT." | |
| 1841 | (interactive "e") | |
| 1842 | ;; Synchronize with the minor mode variable. | |
| 1843 | (mac-font-panel-mode 0)) | |
| 1844 | ||
| 1845 | (defun mac-handle-font-selection (event) | |
| 1846 | "Change default face attributes according to font selection EVENT." | |
| 1847 | (interactive "e") | |
| 1848 | (let* ((ae (mac-event-ae event)) | |
| dc34c597 | 1849 | (fm-font-size (mac-ae-number ae "fmsz")) |
| f9b6d85f | 1850 | (atsu-font-id (mac-ae-number ae "auid")) |
| 5fecafe7 YM |
1851 | (attribute-values (and atsu-font-id |
| 1852 | (mac-atsu-font-face-attributes atsu-font-id)))) | |
| 527ba7f4 YM |
1853 | (if fm-font-size |
| 1854 | (setq attribute-values | |
| dc34c597 | 1855 | `(:height ,(* 10 fm-font-size) ,@attribute-values))) |
| 527ba7f4 YM |
1856 | (apply 'set-face-attribute 'default (selected-frame) attribute-values))) |
| 1857 | ||
| 1858 | ;; kEventClassFont/kEventFontPanelClosed | |
| 1859 | (define-key mac-apple-event-map [font panel-closed] | |
| 1860 | 'mac-handle-font-panel-closed) | |
| 1861 | ;; kEventClassFont/kEventFontSelection | |
| 1862 | (define-key mac-apple-event-map [font selection] 'mac-handle-font-selection) | |
| dbcdba77 YM |
1863 | (define-key mac-apple-event-map [hi-command show-hide-font-panel] |
| 1864 | 'mac-font-panel-mode) | |
| 527ba7f4 YM |
1865 | |
| 1866 | (define-key-after menu-bar-showhide-menu [mac-font-panel-mode] | |
| 1867 | (menu-bar-make-mm-toggle mac-font-panel-mode | |
| 1868 | "Font Panel" | |
| 1869 | "Show the font panel as a floating dialog") | |
| 1870 | 'showhide-speedbar) | |
| 1871 | ||
| e5a4ac9d | 1872 | ) ;; (fboundp 'mac-set-font-panel-visible-p) |
| 527ba7f4 | 1873 | |
| dc34c597 YM |
1874 | ;;; Text Services |
| 1875 | (defvar mac-ts-active-input-buf "" | |
| 1876 | "Byte sequence of the current Mac TSM active input area.") | |
| 1877 | (defvar mac-ts-update-active-input-area-seqno 0 | |
| 1878 | "Number of processed update-active-input-area events.") | |
| 1879 | (setq mac-ts-active-input-overlay (make-overlay 0 0)) | |
| 1880 | ||
| 1881 | (defface mac-ts-caret-position | |
| 1882 | '((t :inverse-video t)) | |
| 1883 | "Face for caret position in Mac TSM active input area. | |
| f9b6d85f YM |
1884 | This is used when the active input area is displayed either in |
| 1885 | the echo area or in a buffer where the cursor is not displayed." | |
| dc34c597 YM |
1886 | :group 'mac) |
| 1887 | ||
| 1888 | (defface mac-ts-raw-text | |
| 1889 | '((t :underline t)) | |
| 1890 | "Face for raw text in Mac TSM active input area." | |
| 1891 | :group 'mac) | |
| 1892 | ||
| 1893 | (defface mac-ts-selected-raw-text | |
| 1894 | '((t :underline t)) | |
| 1895 | "Face for selected raw text in Mac TSM active input area." | |
| 1896 | :group 'mac) | |
| 1897 | ||
| 1898 | (defface mac-ts-converted-text | |
| 1899 | '((((background dark)) :underline "gray20") | |
| 1900 | (t :underline "gray80")) | |
| 1901 | "Face for converted text in Mac TSM active input area." | |
| 1902 | :group 'mac) | |
| 1903 | ||
| 1904 | (defface mac-ts-selected-converted-text | |
| 1905 | '((t :underline t)) | |
| 1906 | "Face for selected converted text in Mac TSM active input area." | |
| 1907 | :group 'mac) | |
| 1908 | ||
| 1909 | (defface mac-ts-block-fill-text | |
| 1910 | '((t :underline t)) | |
| 1911 | "Face for block fill text in Mac TSM active input area." | |
| 1912 | :group 'mac) | |
| 1913 | ||
| 1914 | (defface mac-ts-outline-text | |
| 1915 | '((t :underline t)) | |
| 1916 | "Face for outline text in Mac TSM active input area." | |
| 1917 | :group 'mac) | |
| 1918 | ||
| 1919 | (defface mac-ts-selected-text | |
| 1920 | '((t :underline t)) | |
| 1921 | "Face for selected text in Mac TSM active input area." | |
| 1922 | :group 'mac) | |
| 1923 | ||
| 1924 | (defface mac-ts-no-hilite | |
| 1925 | '((t :inherit default)) | |
| 1926 | "Face for no hilite in Mac TSM active input area." | |
| 1927 | :group 'mac) | |
| 1928 | ||
| 1929 | (defconst mac-ts-hilite-style-faces | |
| 1930 | '((2 . mac-ts-raw-text) ; kTSMHiliteRawText | |
| 1931 | (3 . mac-ts-selected-raw-text) ; kTSMHiliteSelectedRawText | |
| 1932 | (4 . mac-ts-converted-text) ; kTSMHiliteConvertedText | |
| 1933 | (5 . mac-ts-selected-converted-text) ; kTSMHiliteSelectedConvertedText | |
| 1934 | (6 . mac-ts-block-fill-text) ; kTSMHiliteBlockFillText | |
| 1935 | (7 . mac-ts-outline-text) ; kTSMHiliteOutlineText | |
| 1936 | (8 . mac-ts-selected-text) ; kTSMHiliteSelectedText | |
| 1937 | (9 . mac-ts-no-hilite)) ; kTSMHiliteNoHilite | |
| 1938 | "Alist of Mac TSM hilite style vs Emacs face.") | |
| 1939 | ||
| 1940 | (defun mac-ts-update-active-input-buf (text fix-len hilite-rng update-rng) | |
| 1941 | (let ((buf-len (length mac-ts-active-input-buf)) | |
| 1942 | confirmed) | |
| 1943 | (if (or (null update-rng) | |
| 1944 | (/= (% (length update-rng) 2) 0)) | |
| 1945 | ;; The parameter is missing (or in a bad format). The | |
| 1946 | ;; existing inline input session is completely replaced with | |
| 1947 | ;; the new text. | |
| 1948 | (setq mac-ts-active-input-buf text) | |
| 1949 | ;; Otherwise, the current subtext specified by the (2*j)-th | |
| 1950 | ;; range is replaced with the new subtext specified by the | |
| 1951 | ;; (2*j+1)-th range. | |
| 1952 | (let ((tail buf-len) | |
| 1953 | (i (length update-rng)) | |
| 1954 | segments rng) | |
| 1955 | (while (> i 0) | |
| 1956 | (setq i (- i 2)) | |
| 1957 | (setq rng (aref update-rng i)) | |
| 1958 | (if (and (<= 0 (cadr rng)) (< (cadr rng) tail) | |
| 1959 | (<= tail buf-len)) | |
| 1960 | (setq segments | |
| 1961 | (cons (substring mac-ts-active-input-buf (cadr rng) tail) | |
| 1962 | segments))) | |
| 1963 | (setq tail (car rng)) | |
| 1964 | (setq rng (aref update-rng (1+ i))) | |
| 1965 | (if (and (<= 0 (car rng)) (< (car rng) (cadr rng)) | |
| 1966 | (<= (cadr rng) (length text))) | |
| 1967 | (setq segments | |
| 1968 | (cons (substring text (car rng) (cadr rng)) | |
| 1969 | segments)))) | |
| 1970 | (if (and (< 0 tail) (<= tail buf-len)) | |
| 1971 | (setq segments | |
| 1972 | (cons (substring mac-ts-active-input-buf 0 tail) | |
| 1973 | segments))) | |
| 1974 | (setq mac-ts-active-input-buf (apply 'concat segments)))) | |
| 1975 | (setq buf-len (length mac-ts-active-input-buf)) | |
| 1976 | ;; Confirm (a part of) inline input session. | |
| 1977 | (cond ((< fix-len 0) | |
| 1978 | ;; Entire inline session is being confirmed. | |
| 1979 | (setq confirmed mac-ts-active-input-buf) | |
| 1980 | (setq mac-ts-active-input-buf "")) | |
| 1981 | ((= fix-len 0) | |
| 1982 | ;; None of the text is being confirmed (yet). | |
| 1983 | (setq confirmed "")) | |
| 1984 | (t | |
| 1985 | (if (> fix-len buf-len) | |
| 1986 | (setq fix-len buf-len)) | |
| 1987 | (setq confirmed (substring mac-ts-active-input-buf 0 fix-len)) | |
| 1988 | (setq mac-ts-active-input-buf | |
| 1989 | (substring mac-ts-active-input-buf fix-len)))) | |
| 1990 | (setq buf-len (length mac-ts-active-input-buf)) | |
| 1991 | ;; Update highlighting and the caret position in the new inline | |
| 1992 | ;; input session. | |
| 1993 | (remove-text-properties 0 buf-len '(cursor nil) mac-ts-active-input-buf) | |
| 1994 | (mapc (lambda (rng) | |
| 1995 | (cond ((and (= (nth 2 rng) 1) ; kTSMHiliteCaretPosition | |
| 1996 | (<= 0 (car rng)) (< (car rng) buf-len)) | |
| 1997 | (put-text-property (car rng) buf-len | |
| 1998 | 'cursor t mac-ts-active-input-buf)) | |
| 1999 | ((and (<= 0 (car rng)) (< (car rng) (cadr rng)) | |
| 2000 | (<= (cadr rng) buf-len)) | |
| 2001 | (put-text-property (car rng) (cadr rng) 'face | |
| 2002 | (cdr (assq (nth 2 rng) | |
| 2003 | mac-ts-hilite-style-faces)) | |
| 2004 | mac-ts-active-input-buf)))) | |
| 2005 | hilite-rng) | |
| 2006 | confirmed)) | |
| 2007 | ||
| 2008 | (defun mac-split-string-by-property-change (string) | |
| 2009 | (let ((tail (length string)) | |
| 2010 | head result) | |
| 2011 | (unless (= tail 0) | |
| 2012 | (while (setq head (previous-property-change tail string) | |
| 2013 | result (cons (substring string (or head 0) tail) result) | |
| 2014 | tail head))) | |
| 2015 | result)) | |
| 2016 | ||
| 2017 | (defun mac-replace-untranslated-utf-8-chars (string &optional to-string) | |
| 2018 | (or to-string (setq to-string "\e$,3u=\e(B")) | |
| 2019 | (mapconcat | |
| 2020 | (lambda (str) | |
| 2021 | (if (get-text-property 0 'untranslated-utf-8 str) to-string str)) | |
| 2022 | (mac-split-string-by-property-change string) | |
| 2023 | "")) | |
| 2024 | ||
| 40cacec2 YM |
2025 | (defun mac-keyboard-translate-char (ch) |
| 2026 | (if (and (char-valid-p ch) | |
| 2027 | (or (char-table-p keyboard-translate-table) | |
| 2028 | (and (or (stringp keyboard-translate-table) | |
| 2029 | (vectorp keyboard-translate-table)) | |
| 2030 | (> (length keyboard-translate-table) ch)))) | |
| 2031 | (or (aref keyboard-translate-table ch) ch) | |
| 2032 | ch)) | |
| 2033 | ||
| 2034 | (defun mac-unread-string (string) | |
| 2035 | ;; Unread characters and insert them in a keyboard macro being | |
| 2036 | ;; defined. | |
| 2037 | (apply 'isearch-unread | |
| 2038 | (mapcar 'mac-keyboard-translate-char | |
| 2039 | (mac-replace-untranslated-utf-8-chars string)))) | |
| 2040 | ||
| dc34c597 YM |
2041 | (defun mac-ts-update-active-input-area (event) |
| 2042 | "Update Mac TSM active input area according to EVENT. | |
| 2043 | The confirmed text is converted to Emacs input events and pushed | |
| 2044 | into `unread-command-events'. The unconfirmed text is displayed | |
| 2045 | either in the current buffer or in the echo area." | |
| 2046 | (interactive "e") | |
| 2047 | (let* ((ae (mac-event-ae event)) | |
| f9b6d85f YM |
2048 | (type-text (mac-ae-parameter ae "tstx")) |
| 2049 | (text (or (cdr type-text) "")) | |
| 2050 | (decode-fun (if (equal (car type-text) "TEXT") | |
| 2051 | 'mac-TEXT-to-string 'mac-utxt-to-string)) | |
| dc34c597 YM |
2052 | (script-language (mac-ae-script-language ae "tssl")) |
| 2053 | (coding (or (cdr (assq (car script-language) | |
| 2054 | mac-script-code-coding-systems)) | |
| 2055 | 'mac-roman)) | |
| 05d3aeb0 | 2056 | (fix-len (mac-ae-number ae "tsfx")) |
| dc34c597 YM |
2057 | ;; Optional parameters |
| 2058 | (hilite-rng (mac-ae-text-range-array ae "tshi")) | |
| 2059 | (update-rng (mac-ae-text-range-array ae "tsup")) | |
| 2060 | ;;(pin-rng (mac-bytes-to-text-range (cdr (mac-ae-parameter ae "tspn" "txrn")))) | |
| 2061 | ;;(clause-offsets (cdr (mac-ae-parameter ae "tscl" "ofay"))) | |
| 2062 | (seqno (mac-ae-number ae "tsSn")) | |
| 2063 | confirmed) | |
| 2064 | (unless (= seqno mac-ts-update-active-input-area-seqno) | |
| 2065 | ;; Reset internal states if sequence number is out of sync. | |
| 2066 | (setq mac-ts-active-input-buf "")) | |
| 2067 | (setq confirmed | |
| 2068 | (mac-ts-update-active-input-buf text fix-len hilite-rng update-rng)) | |
| 2069 | (let ((use-echo-area | |
| 2070 | (or isearch-mode | |
| 2071 | (and cursor-in-echo-area (current-message)) | |
| 2072 | ;; Overlay strings are not shown in some cases. | |
| dc34c597 | 2073 | (get-char-property (point) 'invisible) |
| f9b6d85f YM |
2074 | (and (not (bobp)) |
| 2075 | (or (and (get-char-property (point) 'display) | |
| 2076 | (eq (get-char-property (1- (point)) 'display) | |
| 2077 | (get-char-property (point) 'display))) | |
| 2078 | (and (get-char-property (point) 'composition) | |
| 2079 | (eq (get-char-property (1- (point)) 'composition) | |
| 2080 | (get-char-property (point) 'composition))))))) | |
| dc34c597 YM |
2081 | active-input-string caret-seen) |
| 2082 | ;; Decode the active input area text with inheriting faces and | |
| 2083 | ;; the caret position. | |
| 2084 | (setq active-input-string | |
| 2085 | (mapconcat | |
| 2086 | (lambda (str) | |
| f9b6d85f | 2087 | (let ((decoded (funcall decode-fun str coding))) |
| dc34c597 YM |
2088 | (put-text-property 0 (length decoded) 'face |
| 2089 | (get-text-property 0 'face str) decoded) | |
| 2090 | (when (and (not caret-seen) | |
| 2091 | (get-text-property 0 'cursor str)) | |
| 2092 | (setq caret-seen t) | |
| f9b6d85f | 2093 | (if (or use-echo-area (null cursor-type)) |
| dc34c597 YM |
2094 | (put-text-property 0 1 'face 'mac-ts-caret-position |
| 2095 | decoded) | |
| 2096 | (put-text-property 0 1 'cursor t decoded))) | |
| 2097 | decoded)) | |
| 2098 | (mac-split-string-by-property-change mac-ts-active-input-buf) | |
| 2099 | "")) | |
| 2100 | (put-text-property 0 (length active-input-string) | |
| 2101 | 'mac-ts-active-input-string t active-input-string) | |
| 2102 | (if use-echo-area | |
| 05d3aeb0 YM |
2103 | (let ((msg (current-message)) |
| 2104 | message-log-max) | |
| 2105 | (if (and msg | |
| dc34c597 YM |
2106 | ;; Don't get confused by previously displayed |
| 2107 | ;; `active-input-string'. | |
| 2108 | (null (get-text-property 0 'mac-ts-active-input-string | |
| 05d3aeb0 YM |
2109 | msg))) |
| 2110 | (setq msg (propertize msg 'display | |
| 2111 | (concat msg active-input-string))) | |
| dc34c597 YM |
2112 | (setq msg active-input-string)) |
| 2113 | (message "%s" msg) | |
| 2114 | (overlay-put mac-ts-active-input-overlay 'before-string nil)) | |
| 2115 | (move-overlay mac-ts-active-input-overlay | |
| 2116 | (point) (point) (current-buffer)) | |
| 2117 | (overlay-put mac-ts-active-input-overlay 'before-string | |
| 2118 | active-input-string)) | |
| 40cacec2 | 2119 | (mac-unread-string (funcall decode-fun confirmed coding))) |
| dc34c597 YM |
2120 | ;; The event is successfully processed. Sync the sequence number. |
| 2121 | (setq mac-ts-update-active-input-area-seqno (1+ seqno)))) | |
| 2122 | ||
| 2123 | (defun mac-ts-unicode-for-key-event (event) | |
| 2124 | "Convert Unicode key EVENT to Emacs key events and unread them." | |
| 2125 | (interactive "e") | |
| 2126 | (let* ((ae (mac-event-ae event)) | |
| 2127 | (text (cdr (mac-ae-parameter ae "tstx" "utxt"))) | |
| 2128 | (script-language (mac-ae-script-language ae "tssl")) | |
| 2129 | (coding (or (cdr (assq (car script-language) | |
| 2130 | mac-script-code-coding-systems)) | |
| 2131 | 'mac-roman))) | |
| 59c58fea YM |
2132 | (if text |
| 2133 | (mac-unread-string (mac-utxt-to-string text coding))))) | |
| dc34c597 YM |
2134 | |
| 2135 | ;; kEventClassTextInput/kEventTextInputUpdateActiveInputArea | |
| 2136 | (define-key mac-apple-event-map [text-input update-active-input-area] | |
| 2137 | 'mac-ts-update-active-input-area) | |
| 2138 | ;; kEventClassTextInput/kEventTextInputUnicodeForKeyEvent | |
| 2139 | (define-key mac-apple-event-map [text-input unicode-for-key-event] | |
| 2140 | 'mac-ts-unicode-for-key-event) | |
| 2141 | ||
| 527ba7f4 | 2142 | ;;; Services |
| b905e809 | 2143 | (defun mac-service-open-file () |
| 62ffc232 | 2144 | "Open the file specified by the selection value for Services." |
| 853065b6 | 2145 | (interactive) |
| b905e809 | 2146 | (find-file-existing (x-selection-value mac-service-selection))) |
| 853065b6 | 2147 | |
| b905e809 | 2148 | (defun mac-service-open-selection () |
| 62ffc232 | 2149 | "Create a new buffer containing the selection value for Services." |
| 853065b6 YM |
2150 | (interactive) |
| 2151 | (switch-to-buffer (generate-new-buffer "*untitled*")) | |
| b905e809 | 2152 | (insert (x-selection-value mac-service-selection)) |
| 853065b6 YM |
2153 | (sit-for 0) |
| 2154 | (save-buffer) ; It pops up the save dialog. | |
| 2155 | ) | |
| 2156 | ||
| b905e809 | 2157 | (defun mac-service-mail-selection () |
| 62ffc232 | 2158 | "Prepare a mail buffer containing the selection value for Services." |
| b007e01c YM |
2159 | (interactive) |
| 2160 | (compose-mail) | |
| 2161 | (rfc822-goto-eoh) | |
| 2162 | (forward-line 1) | |
| b905e809 | 2163 | (insert (x-selection-value mac-service-selection) "\n")) |
| b007e01c | 2164 | |
| b905e809 | 2165 | (defun mac-service-mail-to () |
| 62ffc232 | 2166 | "Prepare a mail buffer to be sent to the selection value for Services." |
| b007e01c | 2167 | (interactive) |
| b905e809 | 2168 | (compose-mail (x-selection-value mac-service-selection))) |
| b007e01c | 2169 | |
| b905e809 | 2170 | (defun mac-service-insert-text () |
| 62ffc232 | 2171 | "Insert the selection value for Services." |
| 853065b6 | 2172 | (interactive) |
| b905e809 | 2173 | (let ((text (x-selection-value mac-service-selection))) |
| 853065b6 YM |
2174 | (if (not buffer-read-only) |
| 2175 | (insert text) | |
| 2176 | (kill-new text) | |
| 2177 | (message | |
| 2178 | (substitute-command-keys | |
| 2179 | "The text from the Services menu can be accessed with \\[yank]"))))) | |
| 2180 | ||
| b905e809 YM |
2181 | ;; kEventClassService/kEventServicePaste |
| 2182 | (define-key mac-apple-event-map [service paste] 'mac-service-insert-text) | |
| 2183 | ;; kEventClassService/kEventServicePerform | |
| 2184 | (define-key mac-apple-event-map [service perform open-file] | |
| 2185 | 'mac-service-open-file) | |
| 2186 | (define-key mac-apple-event-map [service perform open-selection] | |
| 2187 | 'mac-service-open-selection) | |
| 2188 | (define-key mac-apple-event-map [service perform mail-selection] | |
| 2189 | 'mac-service-mail-selection) | |
| 2190 | (define-key mac-apple-event-map [service perform mail-to] | |
| 2191 | 'mac-service-mail-to) | |
| ea1f6051 YM |
2192 | |
| 2193 | (defun mac-dispatch-apple-event (event) | |
| 62ffc232 | 2194 | "Dispatch EVENT according to the keymap `mac-apple-event-map'." |
| ea1f6051 YM |
2195 | (interactive "e") |
| 2196 | (let* ((binding (lookup-key mac-apple-event-map (mac-event-spec event))) | |
| dc47c824 YM |
2197 | (ae (mac-event-ae event)) |
| 2198 | (service-message (and (keymapp binding) | |
| 2199 | (cdr (mac-ae-parameter ae "svmg"))))) | |
| ea1f6051 YM |
2200 | (when service-message |
| 2201 | (setq service-message | |
| 2202 | (intern (decode-coding-string service-message 'utf-8))) | |
| 2203 | (setq binding (lookup-key binding (vector service-message)))) | |
| a149e872 YM |
2204 | ;; Replace (cadr event) with a dummy position so that event-start |
| 2205 | ;; returns it. | |
| 2206 | (setcar (cdr event) (list (selected-window) (point) '(0 . 0) 0)) | |
| dc47c824 | 2207 | (if (null (mac-ae-parameter ae 'emacs-suspension-id)) |
| dc34c597 | 2208 | (command-execute binding nil (vector event) t) |
| dc47c824 YM |
2209 | (condition-case err |
| 2210 | (progn | |
| dc34c597 | 2211 | (command-execute binding nil (vector event) t) |
| dc47c824 YM |
2212 | (mac-resume-apple-event ae)) |
| 2213 | (error | |
| 2214 | (mac-ae-set-reply-parameter ae "errs" | |
| 2215 | (cons "TEXT" (error-message-string err))) | |
| 2216 | (mac-resume-apple-event ae -10000)))))) ; errAEEventFailed | |
| ea1f6051 | 2217 | |
| dc34c597 | 2218 | (define-key special-event-map [mac-apple-event] 'mac-dispatch-apple-event) |
| ea1f6051 YM |
2219 | |
| 2220 | ;; Processing of Apple events are deferred at the startup time. For | |
| 2221 | ;; example, files dropped onto the Emacs application icon can only be | |
| 2222 | ;; processed when the initial frame has been created: this is where | |
| 2223 | ;; the files should be opened. | |
| 2224 | (add-hook 'after-init-hook 'mac-process-deferred-apple-events) | |
| 6e53dc95 | 2225 | |
| dc47c824 YM |
2226 | (run-with-idle-timer 5 t 'mac-cleanup-expired-apple-events) |
| 2227 | ||
| 6e53dc95 YM |
2228 | \f |
| 2229 | ;;;; Drag and drop | |
| 2230 | ||
| 2231 | (defcustom mac-dnd-types-alist | |
| 2232 | '(("furl" . mac-dnd-handle-furl) | |
| 2233 | ("hfs " . mac-dnd-handle-hfs) | |
| 2234 | ("utxt" . mac-dnd-insert-utxt) | |
| 2235 | ("TEXT" . mac-dnd-insert-TEXT) | |
| 2236 | ("TIFF" . mac-dnd-insert-TIFF)) | |
| 2237 | "Which function to call to handle a drop of that type. | |
| 2238 | The function takes three arguments, WINDOW, ACTION and DATA. | |
| ef9f9fb5 | 2239 | WINDOW is where the drop occurred, ACTION is always `private' on |
| 6e53dc95 YM |
2240 | Mac. DATA is the drop data. Unlike the x-dnd counterpart, the |
| 2241 | return value of the function is not significant. | |
| 2242 | ||
| 2243 | See also `mac-dnd-known-types'." | |
| 2244 | :version "22.1" | |
| 2245 | :type 'alist | |
| 2246 | :group 'mac) | |
| 2247 | ||
| 2248 | (defun mac-dnd-handle-furl (window action data) | |
| 2249 | (dnd-handle-one-url window action (mac-furl-to-string data))) | |
| 2250 | ||
| 2251 | (defun mac-dnd-handle-hfs (window action data) | |
| 2252 | ;; struct HFSFlavor { | |
| 2253 | ;; OSType fileType; | |
| 2254 | ;; OSType fileCreator; | |
| 2255 | ;; UInt16 fdFlags; | |
| 2256 | ;; FSSpec fileSpec; | |
| 2257 | ;; }; | |
| 2258 | (let* ((file-name (mac-coerce-ae-data "fss " (substring data 10) | |
| 2259 | 'undecoded-file-name)) | |
| 2260 | (url (concat "file://" | |
| 2261 | (mapconcat 'url-hexify-string | |
| 2262 | (split-string file-name "/") "/")))) | |
| 2263 | (dnd-handle-one-url window action url))) | |
| 2264 | ||
| 2265 | (defun mac-dnd-insert-utxt (window action data) | |
| 2266 | (dnd-insert-text window action (mac-utxt-to-string data))) | |
| 2267 | ||
| 2268 | (defun mac-dnd-insert-TEXT (window action data) | |
| 2269 | (dnd-insert-text window action (mac-TEXT-to-string data))) | |
| 2270 | ||
| 2271 | (defun mac-dnd-insert-TIFF (window action data) | |
| 2272 | (dnd-insert-text window action (mac-TIFF-to-string data))) | |
| 2273 | ||
| 1879b65c YM |
2274 | (defun mac-dnd-drop-data (event frame window data type &optional action) |
| 2275 | (or action (setq action 'private)) | |
| 6e53dc95 YM |
2276 | (let* ((type-info (assoc type mac-dnd-types-alist)) |
| 2277 | (handler (cdr type-info)) | |
| 6e53dc95 YM |
2278 | (w (posn-window (event-start event)))) |
| 2279 | (when handler | |
| 2dde79d8 | 2280 | (if (and (window-live-p w) |
| 6e53dc95 YM |
2281 | (not (window-minibuffer-p w)) |
| 2282 | (not (window-dedicated-p w))) | |
| 2283 | ;; If dropping in an ordinary window which we could use, | |
| 2284 | ;; let dnd-open-file-other-window specify what to do. | |
| 2285 | (progn | |
| 4442ec0d YM |
2286 | (when (not mouse-yank-at-point) |
| 2287 | (goto-char (posn-point (event-start event)))) | |
| 6e53dc95 YM |
2288 | (funcall handler window action data)) |
| 2289 | ;; If we can't display the file here, | |
| 2290 | ;; make a new window for it. | |
| 2291 | (let ((dnd-open-file-other-window t)) | |
| 2292 | (select-frame frame) | |
| 2293 | (funcall handler window action data)))))) | |
| 2294 | ||
| 2295 | (defun mac-dnd-handle-drag-n-drop-event (event) | |
| 2296 | "Receive drag and drop events." | |
| 2297 | (interactive "e") | |
| 1879b65c YM |
2298 | (let ((window (posn-window (event-start event))) |
| 2299 | (ae (mac-event-ae event)) | |
| 2300 | action) | |
| 6e53dc95 | 2301 | (when (windowp window) (select-window window)) |
| 1879b65c YM |
2302 | (if (memq 'option (mac-ae-keyboard-modifiers ae)) |
| 2303 | (setq action 'copy)) | |
| 2304 | (dolist (item (mac-ae-list ae)) | |
| 6e53dc95 YM |
2305 | (if (not (equal (car item) "null")) |
| 2306 | (mac-dnd-drop-data event (selected-frame) window | |
| e5a4ac9d | 2307 | (cdr item) (car item) action))))) |
| 74e2abe2 | 2308 | \f |
| 74e2abe2 ST |
2309 | (defvar mac-font-encoder-list |
| 2310 | '(("mac-roman" mac-roman-encoder | |
| 2311 | ccl-encode-mac-roman-font "%s") | |
| 92a607bd | 2312 | ("mac-centraleurroman" encode-mac-centraleurroman |
| 74e2abe2 | 2313 | ccl-encode-mac-centraleurroman-font "%s ce") |
| 92a607bd | 2314 | ("mac-cyrillic" encode-mac-cyrillic |
| dfcb7df2 YM |
2315 | ccl-encode-mac-cyrillic-font "%s cy") |
| 2316 | ("mac-symbol" mac-symbol-encoder | |
| 2317 | ccl-encode-mac-symbol-font "symbol") | |
| 2318 | ("mac-dingbats" mac-dingbats-encoder | |
| 2319 | ccl-encode-mac-dingbats-font "zapf dingbats"))) | |
| 74e2abe2 ST |
2320 | |
| 2321 | (let ((encoder-list | |
| 2322 | (mapcar (lambda (lst) (nth 1 lst)) mac-font-encoder-list)) | |
| 2323 | (charset-list | |
| 2324 | '(latin-iso8859-2 | |
| 2325 | latin-iso8859-3 latin-iso8859-4 | |
| 2326 | cyrillic-iso8859-5 greek-iso8859-7 hebrew-iso8859-8 | |
| 2327 | latin-iso8859-9 latin-iso8859-14 latin-iso8859-15))) | |
| 2328 | (dolist (encoder encoder-list) | |
| 2329 | (let ((table (get encoder 'translation-table))) | |
| 2330 | (dolist (charset charset-list) | |
| 2331 | (dotimes (i 96) | |
| 2332 | (let* ((c (make-char charset (+ i 32))) | |
| 2333 | (mu (aref ucs-mule-to-mule-unicode c)) | |
| 2334 | (mac-encoded (and mu (aref table mu)))) | |
| 2335 | (if mac-encoded | |
| 2336 | (aset table c mac-encoded)))))))) | |
| 2337 | ||
| 852f7e6b YM |
2338 | ;; We assume none of official dim2 charsets (0x90..0x99) are encoded |
| 2339 | ;; to these fonts. | |
| 2340 | ||
| 92a607bd YM |
2341 | (define-ccl-program ccl-encode-mac-roman-font |
| 2342 | `(0 | |
| 852f7e6b YM |
2343 | (if (r0 <= ?\xef) |
| 2344 | (translate-character mac-roman-encoder r0 r1) | |
| 2345 | ((r1 <<= 7) | |
| 2346 | (r1 |= r2) | |
| 2347 | (translate-character mac-roman-encoder r0 r1)))) | |
| 92a607bd YM |
2348 | "CCL program for Mac Roman font") |
| 2349 | ||
| 74e2abe2 ST |
2350 | (define-ccl-program ccl-encode-mac-centraleurroman-font |
| 2351 | `(0 | |
| 852f7e6b YM |
2352 | (if (r0 <= ?\xef) |
| 2353 | (translate-character encode-mac-centraleurroman r0 r1) | |
| 2354 | ((r1 <<= 7) | |
| 2355 | (r1 |= r2) | |
| 2356 | (translate-character encode-mac-centraleurroman r0 r1)))) | |
| 74e2abe2 ST |
2357 | "CCL program for Mac Central European Roman font") |
| 2358 | ||
| 2359 | (define-ccl-program ccl-encode-mac-cyrillic-font | |
| 2360 | `(0 | |
| 852f7e6b YM |
2361 | (if (r0 <= ?\xef) |
| 2362 | (translate-character encode-mac-cyrillic r0 r1) | |
| 2363 | ((r1 <<= 7) | |
| 2364 | (r1 |= r2) | |
| 2365 | (translate-character encode-mac-cyrillic r0 r1)))) | |
| 74e2abe2 ST |
2366 | "CCL program for Mac Cyrillic font") |
| 2367 | ||
| dfcb7df2 YM |
2368 | (define-ccl-program ccl-encode-mac-symbol-font |
| 2369 | `(0 | |
| 852f7e6b YM |
2370 | (if (r0 <= ?\xef) |
| 2371 | (translate-character mac-symbol-encoder r0 r1) | |
| 2372 | ((r1 <<= 7) | |
| 2373 | (r1 |= r2) | |
| 2374 | (translate-character mac-symbol-encoder r0 r1)))) | |
| dfcb7df2 YM |
2375 | "CCL program for Mac Symbol font") |
| 2376 | ||
| 2377 | (define-ccl-program ccl-encode-mac-dingbats-font | |
| 2378 | `(0 | |
| 852f7e6b YM |
2379 | (if (r0 <= ?\xef) |
| 2380 | (translate-character mac-dingbats-encoder r0 r1) | |
| 2381 | ((r1 <<= 7) | |
| 2382 | (r1 |= r2) | |
| 2383 | (translate-character mac-dingbats-encoder r0 r1)))) | |
| dfcb7df2 YM |
2384 | "CCL program for Mac Dingbats font") |
| 2385 | ||
| 74e2abe2 ST |
2386 | |
| 2387 | (setq font-ccl-encoder-alist | |
| 2388 | (nconc | |
| 2389 | (mapcar (lambda (lst) (cons (nth 0 lst) (nth 2 lst))) | |
| 2390 | mac-font-encoder-list) | |
| 2391 | font-ccl-encoder-alist)) | |
| 2392 | ||
| 852f7e6b YM |
2393 | (defconst mac-char-fontspec-list |
| 2394 | ;; Directly operate on a char-table instead of a fontset so that it | |
| 2395 | ;; may not create a dummy fontset. | |
| 2396 | (let ((template (make-char-table 'fontset))) | |
| 2397 | (dolist | |
| 2398 | (font-encoder | |
| 2399 | (nreverse | |
| 2400 | (mapcar (lambda (lst) | |
| 2401 | (cons (cons (nth 3 lst) (nth 0 lst)) (nth 1 lst))) | |
| 2402 | mac-font-encoder-list))) | |
| 2403 | (let ((font (car font-encoder)) | |
| 2404 | (encoder (cdr font-encoder))) | |
| 2405 | (map-char-table | |
| 2406 | (lambda (key val) | |
| 2407 | (or (null val) | |
| 2408 | (generic-char-p key) | |
| 2409 | (memq (char-charset key) | |
| 2410 | '(ascii eight-bit-control eight-bit-graphic)) | |
| 2411 | (aset template key font))) | |
| 2412 | (get encoder 'translation-table)))) | |
| 2413 | ||
| 2414 | ;; Like fontset-info, but extend a range only if its "to" part is | |
| 2415 | ;; the predecessor of the current char. | |
| 2416 | (let* ((last '((0 nil))) | |
| 2417 | (accumulator last) | |
| 2418 | last-char-or-range last-char last-elt) | |
| 2419 | (map-char-table | |
| 2420 | (lambda (char elt) | |
| 2421 | (when elt | |
| 2422 | (setq last-char-or-range (car (car last)) | |
| 2423 | last-char (if (consp last-char-or-range) | |
| 2424 | (cdr last-char-or-range) | |
| 2425 | last-char-or-range) | |
| 2426 | last-elt (cdr (car last))) | |
| 2427 | (if (and (eq elt last-elt) | |
| 2428 | (= char (1+ last-char)) | |
| 2429 | (eq (char-charset char) (char-charset last-char))) | |
| 2430 | (if (consp last-char-or-range) | |
| 2431 | (setcdr last-char-or-range char) | |
| 2432 | (setcar (car last) (cons last-char char))) | |
| 2433 | (setcdr last (list (cons char elt))) | |
| 2434 | (setq last (cdr last))))) | |
| 2435 | template) | |
| 2436 | (cdr accumulator)))) | |
| 2437 | ||
| 74e2abe2 | 2438 | (defun fontset-add-mac-fonts (fontset &optional base-family) |
| 852f7e6b YM |
2439 | "Add font-specs for Mac fonts to FONTSET. |
| 2440 | The added font-specs are determined by BASE-FAMILY and the value | |
| 2441 | of `mac-char-fontspec-list', which is a list | |
| 2442 | of (CHARACTER-OR-RANGE . (FAMILY-FORMAT . REGISTRY)). If | |
| 2443 | BASE-FAMILY is nil, the font family in the added font-specs is | |
| 2444 | also nil. If BASE-FAMILY is a string, `%s' in FAMILY-FORMAT is | |
| 2445 | replaced with the string. Otherwise, `%s' in FAMILY-FORMAT is | |
| 2446 | replaced with the ASCII font family name in FONTSET." | |
| 74e2abe2 | 2447 | (if base-family |
| 852f7e6b YM |
2448 | (if (stringp base-family) |
| 2449 | (setq base-family (downcase base-family)) | |
| 2450 | (let ((ascii-font (fontset-font fontset (charset-id 'ascii)))) | |
| 2451 | (if ascii-font | |
| 2452 | (setq base-family | |
| 2453 | (aref (x-decompose-font-name | |
| 2454 | (downcase (x-resolve-font-name ascii-font))) | |
| 2455 | xlfd-regexp-family-subnum)))))) | |
| 2456 | (let (fontspec-cache fontspec) | |
| 2457 | (dolist (char-fontspec mac-char-fontspec-list) | |
| 2458 | (setq fontspec (cdr (assq (cdr char-fontspec) fontspec-cache))) | |
| 2459 | (when (null fontspec) | |
| 2460 | (setq fontspec | |
| 2461 | (cons (and base-family | |
| 2462 | (format (car (cdr char-fontspec)) base-family)) | |
| 2463 | (cdr (cdr char-fontspec)))) | |
| 2464 | (setq fontspec-cache (cons (cons (cdr char-fontspec) fontspec) | |
| 2465 | fontspec-cache))) | |
| 2466 | (set-fontset-font fontset (car char-fontspec) fontspec)))) | |
| 853065b6 | 2467 | |
| 74e2abe2 ST |
2468 | (defun create-fontset-from-mac-roman-font (font &optional resolved-font |
| 2469 | fontset-name) | |
| 2470 | "Create a fontset from a Mac roman font FONT. | |
| 2471 | ||
| 2472 | Optional 1st arg RESOLVED-FONT is a resolved name of FONT. If | |
| 2473 | omitted, `x-resolve-font-name' is called to get the resolved name. At | |
| 2474 | this time, if FONT is not available, error is signaled. | |
| 2475 | ||
| 2476 | Optional 2nd arg FONTSET-NAME is a string to be used in | |
| 2477 | `<CHARSET_ENCODING>' fields of a new fontset name. If it is omitted, | |
| 2478 | an appropriate name is generated automatically. | |
| 2479 | ||
| 2480 | It returns a name of the created fontset." | |
| 2481 | (let ((fontset | |
| 2482 | (create-fontset-from-ascii-font font resolved-font fontset-name))) | |
| 852f7e6b | 2483 | (fontset-add-mac-fonts fontset t) |
| 74e2abe2 ST |
2484 | fontset)) |
| 2485 | ||
| caf49fb0 DN |
2486 | (defun x-win-suspend-error () |
| 2487 | (error "Suspending an Emacs running under Mac makes no sense")) | |
| 2488 | ||
| 2489 | (defalias 'x-cut-buffer-or-selection-value 'x-get-selection-value) | |
| 2490 | ||
| 2491 | (defvar mac-initialized nil | |
| 2492 | "Non-nil if the w32 window system has been initialized.") | |
| 2493 | ||
| 2494 | (defun mac-initialize-window-system () | |
| 2495 | "Initialize Emacs for Mac GUI frames." | |
| 2496 | ||
| 2497 | ;;; Do the actual Windows setup here; the above code just defines | |
| 2498 | ;;; functions and variables that we use now. | |
| 2499 | ||
| 2500 | (setq command-line-args (x-handle-args command-line-args)) | |
| 2501 | ||
| 2502 | ;;; Make sure we have a valid resource name. | |
| 2503 | (or (stringp x-resource-name) | |
| 2504 | (let (i) | |
| 2505 | (setq x-resource-name (invocation-name)) | |
| 2506 | ||
| 2507 | ;; Change any . or * characters in x-resource-name to hyphens, | |
| 2508 | ;; so as not to choke when we use it in X resource queries. | |
| 2509 | (while (setq i (string-match "[.*]" x-resource-name)) | |
| 2510 | (aset x-resource-name i ?-)))) | |
| 2511 | ||
| 2512 | (if (x-display-list) | |
| 2513 | ;; On Mac OS 8/9, Most coding systems used in code conversion for | |
| 2514 | ;; font names are not ready at the time when the terminal frame is | |
| 2515 | ;; created. So we reconstruct font name table for the initial | |
| 2516 | ;; frame. | |
| 2517 | (mac-clear-font-name-table) | |
| 2518 | (x-open-connection "Mac" | |
| 2519 | x-command-line-resources | |
| 2520 | ;; Exit Emacs with fatal error if this fails. | |
| 2521 | t)) | |
| 2522 | ||
| 2523 | (add-hook 'suspend-hook 'x-win-suspend-error) | |
| 2524 | ||
| 2525 | ;;; Arrange for the kill and yank functions to set and check the clipboard. | |
| 2526 | (setq interprogram-cut-function 'x-select-text) | |
| 2527 | (setq interprogram-paste-function 'x-get-selection-value) | |
| 2528 | ||
| 2529 | ||
| 2530 | ||
| 2531 | ||
| 2532 | ;;; Turn off window-splitting optimization; Mac is usually fast enough | |
| 2533 | ;;; that this is only annoying. | |
| 2534 | (setq split-window-keep-point t) | |
| 2535 | ||
| 2536 | ;; Don't show the frame name; that's redundant. | |
| 2537 | (setq-default mode-line-frame-identification " ") | |
| 2538 | ||
| 2539 | ;; Turn on support for mouse wheels. | |
| 2540 | (mouse-wheel-mode 1) | |
| 2541 | ||
| 2542 | ||
| 2543 | ;; Enable CLIPBOARD copy/paste through menu bar commands. | |
| 2544 | (menu-bar-enable-clipboard) | |
| 2545 | ||
| 2546 | ||
| 2547 | ;; Initiate drag and drop | |
| 2548 | ||
| 2549 | (define-key special-event-map [drag-n-drop] 'mac-dnd-handle-drag-n-drop-event) | |
| 2550 | ||
| 2551 | \f | |
| 2552 | ;;;; Non-toolkit Scroll bars | |
| 2553 | ||
| 2554 | (unless x-toolkit-scroll-bars | |
| 2555 | ||
| 2556 | ;; for debugging | |
| 2557 | ;; (defun mac-handle-scroll-bar-event (event) (interactive "e") (princ event)) | |
| 2558 | ||
| 2559 | ;;(global-set-key [vertical-scroll-bar mouse-1] 'mac-handle-scroll-bar-event) | |
| 2560 | ||
| 2561 | (global-set-key | |
| 2562 | [vertical-scroll-bar down-mouse-1] | |
| 2563 | 'mac-handle-scroll-bar-event) | |
| 2564 | ||
| 2565 | (global-unset-key [vertical-scroll-bar drag-mouse-1]) | |
| 2566 | (global-unset-key [vertical-scroll-bar mouse-1]) | |
| 2567 | ||
| 0f49150e YM |
2568 | ;; Adjust Courier font specifications in x-fixed-font-alist. |
| 2569 | (let ((courier-fonts (assoc "Courier" x-fixed-font-alist))) | |
| 2570 | (if courier-fonts | |
| 2571 | (dolist (label-fonts (cdr courier-fonts)) | |
| 2572 | (setcdr label-fonts | |
| 2573 | (mapcar | |
| 2574 | (lambda (font) | |
| 2575 | (if (string-match "\\`-adobe-courier-\\([^-]*\\)-\\(.\\)-\\(.*\\)-iso8859-1\\'" font) | |
| 2576 | (replace-match | |
| 2577 | (if (string= (match-string 2 font) "o") | |
| 2578 | "-*-courier-\\1-i-\\3-*-*" | |
| 2579 | "-*-courier-\\1-\\2-\\3-*-*") | |
| 2580 | t nil font) | |
| 2581 | font)) | |
| 2582 | (cdr label-fonts)))))) | |
| 2583 | ||
| 74e2abe2 ST |
2584 | ;; Setup the default fontset. |
| 2585 | (setup-default-fontset) | |
| 5fecafe7 | 2586 | (cond ((x-list-fonts "*-iso10646-1" nil nil 1) |
| 8de786ae YM |
2587 | ;; Use ATSUI (if available) for the following charsets. |
| 2588 | (dolist | |
| 2589 | (charset '(latin-iso8859-1 | |
| 2590 | latin-iso8859-2 latin-iso8859-3 latin-iso8859-4 | |
| 2591 | thai-tis620 greek-iso8859-7 arabic-iso8859-6 | |
| 2592 | hebrew-iso8859-8 cyrillic-iso8859-5 | |
| 2593 | latin-iso8859-9 latin-iso8859-15 latin-iso8859-14 | |
| 2594 | japanese-jisx0212 chinese-sisheng ipa | |
| 2595 | vietnamese-viscii-lower vietnamese-viscii-upper | |
| 2596 | lao ethiopic tibetan)) | |
| 2597 | (set-fontset-font nil charset '(nil . "iso10646-1")))) | |
| 5fecafe7 | 2598 | ((null (x-list-fonts "*-iso8859-1" nil nil 1)) |
| 8de786ae YM |
2599 | ;; Add Mac-encoding fonts unless ETL fonts are installed. |
| 2600 | (fontset-add-mac-fonts "fontset-default"))) | |
| 74e2abe2 ST |
2601 | |
| 2602 | ;; Create a fontset that uses mac-roman font. With this fontset, | |
| 2603 | ;; characters decoded from mac-roman encoding (ascii, latin-iso8859-1, | |
| 2604 | ;; and mule-unicode-xxxx-yyyy) are displayed by a mac-roman font. | |
| 2605 | (create-fontset-from-fontset-spec | |
| 2f8efa69 | 2606 | "-etl-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-standard, |
| 74e2abe2 | 2607 | ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman") |
| 2f8efa69 | 2608 | (fontset-add-mac-fonts "fontset-standard" t) |
| 74e2abe2 ST |
2609 | |
| 2610 | ;; Create fontset specified in X resources "Fontset-N" (N is 0, 1, ...). | |
| 2611 | (create-fontset-from-x-resource) | |
| 2612 | ||
| 2613 | ;; Try to create a fontset from a font specification which comes | |
| 2614 | ;; from initial-frame-alist, default-frame-alist, or X resource. | |
| 2615 | ;; A font specification in command line argument (i.e. -fn XXXX) | |
| 2616 | ;; should be already in default-frame-alist as a `font' | |
| 2617 | ;; parameter. However, any font specifications in site-start | |
| 2618 | ;; library, user's init file (.emacs), and default.el are not | |
| 2619 | ;; yet handled here. | |
| 2620 | ||
| 2621 | (let ((font (or (cdr (assq 'font initial-frame-alist)) | |
| 2622 | (cdr (assq 'font default-frame-alist)) | |
| 2623 | (x-get-resource "font" "Font"))) | |
| 2624 | xlfd-fields resolved-name) | |
| 2625 | (if (and font | |
| 2626 | (not (query-fontset font)) | |
| 2627 | (setq resolved-name (x-resolve-font-name font)) | |
| 2628 | (setq xlfd-fields (x-decompose-font-name font))) | |
| 2629 | (if (string= "fontset" (aref xlfd-fields xlfd-regexp-registry-subnum)) | |
| 2630 | (new-fontset font (x-complement-fontset-spec xlfd-fields nil)) | |
| 2631 | ;; Create a fontset from FONT. The fontset name is | |
| 2632 | ;; generated from FONT. | |
| 3bc062ea YM |
2633 | (if (and (string= "mac" (aref xlfd-fields xlfd-regexp-registry-subnum)) |
| 2634 | (string= "roman" (aref xlfd-fields xlfd-regexp-encoding-subnum))) | |
| 2635 | (create-fontset-from-mac-roman-font font resolved-name "startup") | |
| 2636 | (create-fontset-from-ascii-font font resolved-name "startup"))))) | |
| 74e2abe2 ST |
2637 | |
| 2638 | ;; Apply a geometry resource to the initial frame. Put it at the end | |
| 2639 | ;; of the alist, so that anything specified on the command line takes | |
| 2640 | ;; precedence. | |
| 2641 | (let* ((res-geometry (x-get-resource "geometry" "Geometry")) | |
| 2642 | parsed) | |
| 2643 | (if res-geometry | |
| 2644 | (progn | |
| 2645 | (setq parsed (x-parse-geometry res-geometry)) | |
| 2646 | ;; If the resource specifies a position, | |
| 2647 | ;; call the position and size "user-specified". | |
| 2648 | (if (or (assq 'top parsed) (assq 'left parsed)) | |
| 2649 | (setq parsed (cons '(user-position . t) | |
| 2650 | (cons '(user-size . t) parsed)))) | |
| 2651 | ;; All geometry parms apply to the initial frame. | |
| 2652 | (setq initial-frame-alist (append initial-frame-alist parsed)) | |
| 045b1908 YM |
2653 | ;; The size parms apply to all frames. Don't set it if there are |
| 2654 | ;; sizes there already (from command line). | |
| 2655 | (if (and (assq 'height parsed) | |
| 2656 | (not (assq 'height default-frame-alist))) | |
| 74e2abe2 ST |
2657 | (setq default-frame-alist |
| 2658 | (cons (cons 'height (cdr (assq 'height parsed))) | |
| 2659 | default-frame-alist))) | |
| 045b1908 YM |
2660 | (if (and (assq 'width parsed) |
| 2661 | (not (assq 'width default-frame-alist))) | |
| 74e2abe2 ST |
2662 | (setq default-frame-alist |
| 2663 | (cons (cons 'width (cdr (assq 'width parsed))) | |
| 2664 | default-frame-alist)))))) | |
| 2665 | ||
| 2666 | ;; Check the reverseVideo resource. | |
| 2667 | (let ((case-fold-search t)) | |
| 2668 | (let ((rv (x-get-resource "reverseVideo" "ReverseVideo"))) | |
| 2669 | (if (and rv | |
| 2670 | (string-match "^\\(true\\|yes\\|on\\)$" rv)) | |
| 2671 | (setq default-frame-alist | |
| 2672 | (cons '(reverse . t) default-frame-alist))))) | |
| 2673 | ||
| 80ca7302 DN |
2674 | (setq mac-initialized t))) |
| 2675 | ||
| 74e2abe2 ST |
2676 | (defun mac-handle-scroll-bar-event (event) |
| 2677 | "Handle scroll bar EVENT to emulate Mac Toolbox style scrolling." | |
| 2678 | (interactive "e") | |
| 2679 | (let* ((position (event-start event)) | |
| 2680 | (window (nth 0 position)) | |
| 2681 | (bar-part (nth 4 position))) | |
| 2682 | (select-window window) | |
| 2683 | (cond | |
| 2684 | ((eq bar-part 'up) | |
| 2685 | (goto-char (window-start window)) | |
| 2686 | (mac-scroll-down-line)) | |
| 2687 | ((eq bar-part 'above-handle) | |
| 2688 | (mac-scroll-down)) | |
| 2689 | ((eq bar-part 'handle) | |
| 2690 | (scroll-bar-drag event)) | |
| 2691 | ((eq bar-part 'below-handle) | |
| 2692 | (mac-scroll-up)) | |
| 2693 | ((eq bar-part 'down) | |
| 2694 | (goto-char (window-start window)) | |
| 2695 | (mac-scroll-up-line))))) | |
| 2696 | ||
| 2697 | (defun mac-scroll-ignore-events () | |
| 2698 | ;; Ignore confusing non-mouse events | |
| 2699 | (while (not (memq (car-safe (read-event)) | |
| 2700 | '(mouse-1 double-mouse-1 triple-mouse-1))) nil)) | |
| 2701 | ||
| 2702 | (defun mac-scroll-down () | |
| 2703 | (track-mouse | |
| 2704 | (mac-scroll-ignore-events) | |
| 2705 | (scroll-down))) | |
| 2706 | ||
| 2707 | (defun mac-scroll-down-line () | |
| 2708 | (track-mouse | |
| 2709 | (mac-scroll-ignore-events) | |
| 2710 | (scroll-down 1))) | |
| 2711 | ||
| 2712 | (defun mac-scroll-up () | |
| 2713 | (track-mouse | |
| 2714 | (mac-scroll-ignore-events) | |
| 2715 | (scroll-up))) | |
| 2716 | ||
| 2717 | (defun mac-scroll-up-line () | |
| 2718 | (track-mouse | |
| 2719 | (mac-scroll-ignore-events) | |
| 2720 | (scroll-up 1))) | |
| 2721 | ||
| 6e53dc95 | 2722 | |
| 74e2abe2 ST |
2723 | \f |
| 2724 | ;;;; Others | |
| 2725 | ||
| 2726 | (unless (eq system-type 'darwin) | |
| 2727 | ;; This variable specifies the Unix program to call (as a process) to | |
| 2c75eddf | 2728 | ;; determine the amount of free space on a file system (defaults to |
| 74e2abe2 ST |
2729 | ;; df). If it is not set to nil, ls-lisp will not work correctly |
| 2730 | ;; unless an external application df is implemented on the Mac. | |
| 2731 | (setq directory-free-space-program nil) | |
| 2732 | ||
| 2733 | ;; Set this so that Emacs calls subprocesses with "sh" as shell to | |
| 2734 | ;; expand filenames Note no subprocess for the shell is actually | |
| 2735 | ;; started (see run_mac_command in sysdep.c). | |
| 2c75eddf SM |
2736 | (setq shell-file-name "sh") |
| 2737 | ||
| 9bf2510a YM |
2738 | ;; Some system variables are encoded with the system script code. |
| 2739 | (dolist (v '(system-name | |
| 2740 | emacs-build-system ; Mac OS 9 version cannot dump | |
| 2741 | user-login-name user-real-login-name user-full-name)) | |
| 2742 | (set v (decode-coding-string (symbol-value v) mac-system-coding-system)))) | |
| 74e2abe2 | 2743 | |
| 0d83c94d YM |
2744 | ;; Now the default directory is changed to the user's home directory |
| 2745 | ;; in emacs.c if invoked from the WindowServer (with -psn_* option). | |
| 2746 | ;; (if (string= default-directory "/") | |
| 2747 | ;; (cd "~")) | |
| 74e2abe2 | 2748 | |
| a15252fd ST |
2749 | ;; Darwin 6- pty breakage is now controlled from the C code so that |
| 2750 | ;; it applies to all builds on darwin. See s/darwin.h PTY_ITERATION. | |
| 2751 | ;; (setq process-connection-type t) | |
| 74e2abe2 ST |
2752 | |
| 2753 | ;; Assume that fonts are always scalable on the Mac. This sometimes | |
| 2754 | ;; results in characters with jagged edges. However, without it, | |
| 2755 | ;; fonts with both truetype and bitmap representations but no italic | |
| 2756 | ;; or bold bitmap versions will not display these variants correctly. | |
| 2757 | (setq scalable-fonts-allowed t) | |
| 2758 | ||
| 80ca7302 DN |
2759 | (add-to-list 'handle-args-function-alist '(mac . x-handle-args)) |
| 2760 | (add-to-list 'frame-creation-function-alist '(mac . x-create-frame-with-faces)) | |
| 2761 | (add-to-list 'window-system-initialization-alist '(mac . mac-initialize-window-system)) | |
| 2762 | ||
| 2763 | (provide 'mac-win) | |
| 2764 | ||
| 2c75eddf | 2765 | ;; arch-tag: 71dfcd14-cde8-4d66-b05c-85ec94fb23a6 |
| 1a578e9b | 2766 | ;;; mac-win.el ends here |