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