code.delx.au - gnu-emacs/blob - lisp/term/mac-win.el

   1 ;;; mac-win.el --- parse switches controlling interface with Mac window system
   2
   3 ;; Copyright (C) 1999, 2000, 2002, 2003, 2004  Free Software Foundation, Inc.
   4
   5 ;; Author: Andrew Choi <akochoi@mac.com>
   6 ;; Keywords: terminals
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; Mac-win.el:  this file is loaded from ../lisp/startup.el when it recognizes
  28 ;; that Mac windows are to be used.  Command line switches are parsed and those
  29 ;; pertaining to Mac are processed and removed from the command line.  The
  30 ;; Mac display is opened and hooks are set for popping up the initial window.
  31
  32 ;; startup.el will then examine startup files, and eventually call the hooks
  33 ;; which create the first window(s).
  34
  35 ;;; Code:
  36 \f
  37 ;; These are the standard X switches from the Xt Initialize.c file of
  38 ;; Release 4.
  39
  40 ;; Command line         Resource Manager string
  41
  42 ;; +rv                  *reverseVideo
  43 ;; +synchronous         *synchronous
  44 ;; -background          *background
  45 ;; -bd                  *borderColor
  46 ;; -bg                  *background
  47 ;; -bordercolor         *borderColor
  48 ;; -borderwidth         .borderWidth
  49 ;; -bw                  .borderWidth
  50 ;; -display             .display
  51 ;; -fg                  *foreground
  52 ;; -fn                  *font
  53 ;; -font                *font
  54 ;; -foreground          *foreground
  55 ;; -geometry            .geometry
  56 ;; -i                   .iconType
  57 ;; -itype               .iconType
  58 ;; -iconic              .iconic
  59 ;; -name                .name
  60 ;; -reverse             *reverseVideo
  61 ;; -rv                  *reverseVideo
  62 ;; -selectionTimeout    .selectionTimeout
  63 ;; -synchronous         *synchronous
  64 ;; -xrm
  65
  66 ;; An alist of X options and the function which handles them.  See
  67 ;; ../startup.el.
  68
  69 (if (not (eq window-system 'mac))
  70     (error "%s: Loading mac-win.el but not compiled for Mac" (invocation-name)))
  71
  72 (require 'frame)
  73 (require 'mouse)
  74 (require 'scroll-bar)
  75 (require 'faces)
  76 ;;(require 'select)
  77 (require 'menu-bar)
  78 (require 'fontset)
  79 ;;(require 'x-dnd)
  80
  81 (defvar x-invocation-args)
  82
  83 (defvar x-command-line-resources nil)
  84
  85 ;; Handler for switches of the form "-switch value" or "-switch".
  86 (defun x-handle-switch (switch)
  87   (let ((aelt (assoc switch command-line-x-option-alist)))
  88     (if aelt
  89         (let ((param (nth 3 aelt))
  90               (value (nth 4 aelt)))
  91           (if value
  92               (setq default-frame-alist
  93                     (cons (cons param value)
  94                           default-frame-alist))
  95             (setq default-frame-alist
  96                   (cons (cons param
  97                               (car x-invocation-args))
  98                         default-frame-alist)
  99                   x-invocation-args (cdr x-invocation-args)))))))
 100
 101 ;; Handler for switches of the form "-switch n"
 102 (defun x-handle-numeric-switch (switch)
 103   (let ((aelt (assoc switch command-line-x-option-alist)))
 104     (if aelt
 105         (let ((param (nth 3 aelt)))
 106           (setq default-frame-alist
 107                 (cons (cons param
 108                             (string-to-int (car x-invocation-args)))
 109                       default-frame-alist)
 110                 x-invocation-args
 111                 (cdr x-invocation-args))))))
 112
 113 ;; Handle options that apply to initial frame only
 114 (defun x-handle-initial-switch (switch)
 115   (let ((aelt (assoc switch command-line-x-option-alist)))
 116     (if aelt
 117         (let ((param (nth 3 aelt))
 118               (value (nth 4 aelt)))
 119           (if value
 120               (setq initial-frame-alist
 121                     (cons (cons param value)
 122                           initial-frame-alist))
 123             (setq initial-frame-alist
 124                   (cons (cons param
 125                               (car x-invocation-args))
 126                         initial-frame-alist)
 127                   x-invocation-args (cdr x-invocation-args)))))))
 128
 129 ;; Make -iconic apply only to the initial frame!
 130 (defun x-handle-iconic (switch)
 131   (setq initial-frame-alist
 132         (cons '(visibility . icon) initial-frame-alist)))
 133
 134 ;; Handle the -xrm option.
 135 (defun x-handle-xrm-switch (switch)
 136   (unless (consp x-invocation-args)
 137     (error "%s: missing argument to `%s' option" (invocation-name) switch))
 138   (setq x-command-line-resources
 139         (if (null x-command-line-resources)
 140             (car x-invocation-args)
 141           (concat x-command-line-resources "\n" (car x-invocation-args))))
 142   (setq x-invocation-args (cdr x-invocation-args)))
 143
 144 ;; Handle the geometry option
 145 (defun x-handle-geometry (switch)
 146   (let* ((geo (x-parse-geometry (car x-invocation-args)))
 147          (left (assq 'left geo))
 148          (top (assq 'top geo))
 149          (height (assq 'height geo))
 150          (width (assq 'width geo)))
 151     (if (or height width)
 152         (setq default-frame-alist
 153               (append default-frame-alist
 154                       '((user-size . t))
 155                       (if height (list height))
 156                       (if width (list width)))
 157               initial-frame-alist
 158               (append initial-frame-alist
 159                       '((user-size . t))
 160                       (if height (list height))
 161                       (if width (list width)))))
 162     (if (or left top)
 163         (setq initial-frame-alist
 164               (append initial-frame-alist
 165                       '((user-position . t))
 166                       (if left (list left))
 167                       (if top (list top)))))
 168     (setq x-invocation-args (cdr x-invocation-args))))
 169
 170 ;; Handle the -name option.  Set the variable x-resource-name
 171 ;; to the option's operand; set the name of
 172 ;; the initial frame, too.
 173 (defun x-handle-name-switch (switch)
 174   (or (consp x-invocation-args)
 175       (error "%s: missing argument to `%s' option" (invocation-name) switch))
 176   (setq x-resource-name (car x-invocation-args)
 177         x-invocation-args (cdr x-invocation-args))
 178   (setq initial-frame-alist (cons (cons 'name x-resource-name)
 179                                   initial-frame-alist)))
 180
 181 (defvar x-display-name nil
 182   "The display name specifying server and frame.")
 183
 184 (defun x-handle-display (switch)
 185   (setq x-display-name (car x-invocation-args)
 186         x-invocation-args (cdr x-invocation-args)))
 187
 188 (defun x-handle-args (args)
 189   "Process the X-related command line options in ARGS.
 190 This is done before the user's startup file is loaded.  They are copied to
 191 `x-invocation-args', from which the X-related things are extracted, first
 192 the switch (e.g., \"-fg\") in the following code, and possible values
 193 \(e.g., \"black\") in the option handler code (e.g., x-handle-switch).
 194 This function returns ARGS minus the arguments that have been processed."
 195   ;; We use ARGS to accumulate the args that we don't handle here, to return.
 196   (setq x-invocation-args args
 197         args nil)
 198   (while (and x-invocation-args
 199               (not (equal (car x-invocation-args) "--")))
 200     (let* ((this-switch (car x-invocation-args))
 201            (orig-this-switch this-switch)
 202            completion argval aelt handler)
 203       (setq x-invocation-args (cdr x-invocation-args))
 204       ;; Check for long options with attached arguments
 205       ;; and separate out the attached option argument into argval.
 206       (if (string-match "^--[^=]*=" this-switch)
 207           (setq argval (substring this-switch (match-end 0))
 208                 this-switch (substring this-switch 0 (1- (match-end 0)))))
 209       ;; Complete names of long options.
 210       (if (string-match "^--" this-switch)
 211           (progn
 212             (setq completion (try-completion this-switch command-line-x-option-alist))
 213             (if (eq completion t)
 214                 ;; Exact match for long option.
 215                 nil
 216               (if (stringp completion)
 217                   (let ((elt (assoc completion command-line-x-option-alist)))
 218                     ;; Check for abbreviated long option.
 219                     (or elt
 220                         (error "Option `%s' is ambiguous" this-switch))
 221                     (setq this-switch completion))))))
 222       (setq aelt (assoc this-switch command-line-x-option-alist))
 223       (if aelt (setq handler (nth 2 aelt)))
 224       (if handler
 225           (if argval
 226               (let ((x-invocation-args
 227                      (cons argval x-invocation-args)))
 228                 (funcall handler this-switch))
 229             (funcall handler this-switch))
 230         (setq args (cons orig-this-switch args)))))
 231   (nconc (nreverse args) x-invocation-args))
 232 \f
 233 ;;
 234 ;; Available colors
 235 ;;
 236
 237 (defvar x-colors '("LightGreen"
 238                    "light green"
 239                    "DarkRed"
 240                    "dark red"
 241                    "DarkMagenta"
 242                    "dark magenta"
 243                    "DarkCyan"
 244                    "dark cyan"
 245                    "DarkBlue"
 246                    "dark blue"
 247                    "DarkGray"
 248                    "dark gray"
 249                    "DarkGrey"
 250                    "dark grey"
 251                    "grey100"
 252                    "gray100"
 253                    "grey99"
 254                    "gray99"
 255                    "grey98"
 256                    "gray98"
 257                    "grey97"
 258                    "gray97"
 259                    "grey96"
 260                    "gray96"
 261                    "grey95"
 262                    "gray95"
 263                    "grey94"
 264                    "gray94"
 265                    "grey93"
 266                    "gray93"
 267                    "grey92"
 268                    "gray92"
 269                    "grey91"
 270                    "gray91"
 271                    "grey90"
 272                    "gray90"
 273                    "grey89"
 274                    "gray89"
 275                    "grey88"
 276                    "gray88"
 277                    "grey87"
 278                    "gray87"
 279                    "grey86"
 280                    "gray86"
 281                    "grey85"
 282                    "gray85"
 283                    "grey84"
 284                    "gray84"
 285                    "grey83"
 286                    "gray83"
 287                    "grey82"
 288                    "gray82"
 289                    "grey81"
 290                    "gray81"
 291                    "grey80"
 292                    "gray80"
 293                    "grey79"
 294                    "gray79"
 295                    "grey78"
 296                    "gray78"
 297                    "grey77"
 298                    "gray77"
 299                    "grey76"
 300                    "gray76"
 301                    "grey75"
 302                    "gray75"
 303                    "grey74"
 304                    "gray74"
 305                    "grey73"
 306                    "gray73"
 307                    "grey72"
 308                    "gray72"
 309                    "grey71"
 310                    "gray71"
 311                    "grey70"
 312                    "gray70"
 313                    "grey69"
 314                    "gray69"
 315                    "grey68"
 316                    "gray68"
 317                    "grey67"
 318                    "gray67"
 319                    "grey66"
 320                    "gray66"
 321                    "grey65"
 322                    "gray65"
 323                    "grey64"
 324                    "gray64"
 325                    "grey63"
 326                    "gray63"
 327                    "grey62"
 328                    "gray62"
 329                    "grey61"
 330                    "gray61"
 331                    "grey60"
 332                    "gray60"
 333                    "grey59"
 334                    "gray59"
 335                    "grey58"
 336                    "gray58"
 337                    "grey57"
 338                    "gray57"
 339                    "grey56"
 340                    "gray56"
 341                    "grey55"
 342                    "gray55"
 343                    "grey54"
 344                    "gray54"
 345                    "grey53"
 346                    "gray53"
 347                    "grey52"
 348                    "gray52"
 349                    "grey51"
 350                    "gray51"
 351                    "grey50"
 352                    "gray50"
 353                    "grey49"
 354                    "gray49"
 355                    "grey48"
 356                    "gray48"
 357                    "grey47"
 358                    "gray47"
 359                    "grey46"
 360                    "gray46"
 361                    "grey45"
 362                    "gray45"
 363                    "grey44"
 364                    "gray44"
 365                    "grey43"
 366                    "gray43"
 367                    "grey42"
 368                    "gray42"
 369                    "grey41"
 370                    "gray41"
 371                    "grey40"
 372                    "gray40"
 373                    "grey39"
 374                    "gray39"
 375                    "grey38"
 376                    "gray38"
 377                    "grey37"
 378                    "gray37"
 379                    "grey36"
 380                    "gray36"
 381                    "grey35"
 382                    "gray35"
 383                    "grey34"
 384                    "gray34"
 385                    "grey33"
 386                    "gray33"
 387                    "grey32"
 388                    "gray32"
 389                    "grey31"
 390                    "gray31"
 391                    "grey30"
 392                    "gray30"
 393                    "grey29"
 394                    "gray29"
 395                    "grey28"
 396                    "gray28"
 397                    "grey27"
 398                    "gray27"
 399                    "grey26"
 400                    "gray26"
 401                    "grey25"
 402                    "gray25"
 403                    "grey24"
 404                    "gray24"
 405                    "grey23"
 406                    "gray23"
 407                    "grey22"
 408                    "gray22"
 409                    "grey21"
 410                    "gray21"
 411                    "grey20"
 412                    "gray20"
 413                    "grey19"
 414                    "gray19"
 415                    "grey18"
 416                    "gray18"
 417                    "grey17"
 418                    "gray17"
 419                    "grey16"
 420                    "gray16"
 421                    "grey15"
 422                    "gray15"
 423                    "grey14"
 424                    "gray14"
 425                    "grey13"
 426                    "gray13"
 427                    "grey12"
 428                    "gray12"
 429                    "grey11"
 430                    "gray11"
 431                    "grey10"
 432                    "gray10"
 433                    "grey9"
 434                    "gray9"
 435                    "grey8"
 436                    "gray8"
 437                    "grey7"
 438                    "gray7"
 439                    "grey6"
 440                    "gray6"
 441                    "grey5"
 442                    "gray5"
 443                    "grey4"
 444                    "gray4"
 445                    "grey3"
 446                    "gray3"
 447                    "grey2"
 448                    "gray2"
 449                    "grey1"
 450                    "gray1"
 451                    "grey0"
 452                    "gray0"
 453                    "thistle4"
 454                    "thistle3"
 455                    "thistle2"
 456                    "thistle1"
 457                    "MediumPurple4"
 458                    "MediumPurple3"
 459                    "MediumPurple2"
 460                    "MediumPurple1"
 461                    "purple4"
 462                    "purple3"
 463                    "purple2"
 464                    "purple1"
 465                    "DarkOrchid4"
 466                    "DarkOrchid3"
 467                    "DarkOrchid2"
 468                    "DarkOrchid1"
 469                    "MediumOrchid4"
 470                    "MediumOrchid3"
 471                    "MediumOrchid2"
 472                    "MediumOrchid1"
 473                    "plum4"
 474                    "plum3"
 475                    "plum2"
 476                    "plum1"
 477                    "orchid4"
 478                    "orchid3"
 479                    "orchid2"
 480                    "orchid1"
 481                    "magenta4"
 482                    "magenta3"
 483                    "magenta2"
 484                    "magenta1"
 485                    "VioletRed4"
 486                    "VioletRed3"
 487                    "VioletRed2"
 488                    "VioletRed1"
 489                    "maroon4"
 490                    "maroon3"
 491                    "maroon2"
 492                    "maroon1"
 493                    "PaleVioletRed4"
 494                    "PaleVioletRed3"
 495                    "PaleVioletRed2"
 496                    "PaleVioletRed1"
 497                    "LightPink4"
 498                    "LightPink3"
 499                    "LightPink2"
 500                    "LightPink1"
 501                    "pink4"
 502                    "pink3"
 503                    "pink2"
 504                    "pink1"
 505                    "HotPink4"
 506                    "HotPink3"
 507                    "HotPink2"
 508                    "HotPink1"
 509                    "DeepPink4"
 510                    "DeepPink3"
 511                    "DeepPink2"
 512                    "DeepPink1"
 513                    "red4"
 514                    "red3"
 515                    "red2"
 516                    "red1"
 517                    "OrangeRed4"
 518                    "OrangeRed3"
 519                    "OrangeRed2"
 520                    "OrangeRed1"
 521                    "tomato4"
 522                    "tomato3"
 523                    "tomato2"
 524                    "tomato1"
 525                    "coral4"
 526                    "coral3"
 527                    "coral2"
 528                    "coral1"
 529                    "DarkOrange4"
 530                    "DarkOrange3"
 531                    "DarkOrange2"
 532                    "DarkOrange1"
 533                    "orange4"
 534                    "orange3"
 535                    "orange2"
 536                    "orange1"
 537                    "LightSalmon4"
 538                    "LightSalmon3"
 539                    "LightSalmon2"
 540                    "LightSalmon1"
 541                    "salmon4"
 542                    "salmon3"
 543                    "salmon2"
 544                    "salmon1"
 545                    "brown4"
 546                    "brown3"
 547                    "brown2"
 548                    "brown1"
 549                    "firebrick4"
 550                    "firebrick3"
 551                    "firebrick2"
 552                    "firebrick1"
 553                    "chocolate4"
 554                    "chocolate3"
 555                    "chocolate2"
 556                    "chocolate1"
 557                    "tan4"
 558                    "tan3"
 559                    "tan2"
 560                    "tan1"
 561                    "wheat4"
 562                    "wheat3"
 563                    "wheat2"
 564                    "wheat1"
 565                    "burlywood4"
 566                    "burlywood3"
 567                    "burlywood2"
 568                    "burlywood1"
 569                    "sienna4"
 570                    "sienna3"
 571                    "sienna2"
 572                    "sienna1"
 573                    "IndianRed4"
 574                    "IndianRed3"
 575                    "IndianRed2"
 576                    "IndianRed1"
 577                    "RosyBrown4"
 578                    "RosyBrown3"
 579                    "RosyBrown2"
 580                    "RosyBrown1"
 581                    "DarkGoldenrod4"
 582                    "DarkGoldenrod3"
 583                    "DarkGoldenrod2"
 584                    "DarkGoldenrod1"
 585                    "goldenrod4"
 586                    "goldenrod3"
 587                    "goldenrod2"
 588                    "goldenrod1"
 589                    "gold4"
 590                    "gold3"
 591                    "gold2"
 592                    "gold1"
 593                    "yellow4"
 594                    "yellow3"
 595                    "yellow2"
 596                    "yellow1"
 597                    "LightYellow4"
 598                    "LightYellow3"
 599                    "LightYellow2"
 600                    "LightYellow1"
 601                    "LightGoldenrod4"
 602                    "LightGoldenrod3"
 603                    "LightGoldenrod2"
 604                    "LightGoldenrod1"
 605                    "khaki4"
 606                    "khaki3"
 607                    "khaki2"
 608                    "khaki1"
 609                    "DarkOliveGreen4"
 610                    "DarkOliveGreen3"
 611                    "DarkOliveGreen2"
 612                    "DarkOliveGreen1"
 613                    "OliveDrab4"
 614                    "OliveDrab3"
 615                    "OliveDrab2"
 616                    "OliveDrab1"
 617                    "chartreuse4"
 618                    "chartreuse3"
 619                    "chartreuse2"
 620                    "chartreuse1"
 621                    "green4"
 622                    "green3"
 623                    "green2"
 624                    "green1"
 625                    "SpringGreen4"
 626                    "SpringGreen3"
 627                    "SpringGreen2"
 628                    "SpringGreen1"
 629                    "PaleGreen4"
 630                    "PaleGreen3"
 631                    "PaleGreen2"
 632                    "PaleGreen1"
 633                    "SeaGreen4"
 634                    "SeaGreen3"
 635                    "SeaGreen2"
 636                    "SeaGreen1"
 637                    "DarkSeaGreen4"
 638                    "DarkSeaGreen3"
 639                    "DarkSeaGreen2"
 640                    "DarkSeaGreen1"
 641                    "aquamarine4"
 642                    "aquamarine3"
 643                    "aquamarine2"
 644                    "aquamarine1"
 645                    "DarkSlateGray4"
 646                    "DarkSlateGray3"
 647                    "DarkSlateGray2"
 648                    "DarkSlateGray1"
 649                    "cyan4"
 650                    "cyan3"
 651                    "cyan2"
 652                    "cyan1"
 653                    "turquoise4"
 654                    "turquoise3"
 655                    "turquoise2"
 656                    "turquoise1"
 657                    "CadetBlue4"
 658                    "CadetBlue3"
 659                    "CadetBlue2"
 660                    "CadetBlue1"
 661                    "PaleTurquoise4"
 662                    "PaleTurquoise3"
 663                    "PaleTurquoise2"
 664                    "PaleTurquoise1"
 665                    "LightCyan4"
 666                    "LightCyan3"
 667                    "LightCyan2"
 668                    "LightCyan1"
 669                    "LightBlue4"
 670                    "LightBlue3"
 671                    "LightBlue2"
 672                    "LightBlue1"
 673                    "LightSteelBlue4"
 674                    "LightSteelBlue3"
 675                    "LightSteelBlue2"
 676                    "LightSteelBlue1"
 677                    "SlateGray4"
 678                    "SlateGray3"
 679                    "SlateGray2"
 680                    "SlateGray1"
 681                    "LightSkyBlue4"
 682                    "LightSkyBlue3"
 683                    "LightSkyBlue2"
 684                    "LightSkyBlue1"
 685                    "SkyBlue4"
 686                    "SkyBlue3"
 687                    "SkyBlue2"
 688                    "SkyBlue1"
 689                    "DeepSkyBlue4"
 690                    "DeepSkyBlue3"
 691                    "DeepSkyBlue2"
 692                    "DeepSkyBlue1"
 693                    "SteelBlue4"
 694                    "SteelBlue3"
 695                    "SteelBlue2"
 696                    "SteelBlue1"
 697                    "DodgerBlue4"
 698                    "DodgerBlue3"
 699                    "DodgerBlue2"
 700                    "DodgerBlue1"
 701                    "blue4"
 702                    "blue3"
 703                    "blue2"
 704                    "blue1"
 705                    "RoyalBlue4"
 706                    "RoyalBlue3"
 707                    "RoyalBlue2"
 708                    "RoyalBlue1"
 709                    "SlateBlue4"
 710                    "SlateBlue3"
 711                    "SlateBlue2"
 712                    "SlateBlue1"
 713                    "azure4"
 714                    "azure3"
 715                    "azure2"
 716                    "azure1"
 717                    "MistyRose4"
 718                    "MistyRose3"
 719                    "MistyRose2"
 720                    "MistyRose1"
 721                    "LavenderBlush4"
 722                    "LavenderBlush3"
 723                    "LavenderBlush2"
 724                    "LavenderBlush1"
 725                    "honeydew4"
 726                    "honeydew3"
 727                    "honeydew2"
 728                    "honeydew1"
 729                    "ivory4"
 730                    "ivory3"
 731                    "ivory2"
 732                    "ivory1"
 733                    "cornsilk4"
 734                    "cornsilk3"
 735                    "cornsilk2"
 736                    "cornsilk1"
 737                    "LemonChiffon4"
 738                    "LemonChiffon3"
 739                    "LemonChiffon2"
 740                    "LemonChiffon1"
 741                    "NavajoWhite4"
 742                    "NavajoWhite3"
 743                    "NavajoWhite2"
 744                    "NavajoWhite1"
 745                    "PeachPuff4"
 746                    "PeachPuff3"
 747                    "PeachPuff2"
 748                    "PeachPuff1"
 749                    "bisque4"
 750                    "bisque3"
 751                    "bisque2"
 752                    "bisque1"
 753                    "AntiqueWhite4"
 754                    "AntiqueWhite3"
 755                    "AntiqueWhite2"
 756                    "AntiqueWhite1"
 757                    "seashell4"
 758                    "seashell3"
 759                    "seashell2"
 760                    "seashell1"
 761                    "snow4"
 762                    "snow3"
 763                    "snow2"
 764                    "snow1"
 765                    "thistle"
 766                    "MediumPurple"
 767                    "medium purple"
 768                    "purple"
 769                    "BlueViolet"
 770                    "blue violet"
 771                    "DarkViolet"
 772                    "dark violet"
 773                    "DarkOrchid"
 774                    "dark orchid"
 775                    "MediumOrchid"
 776                    "medium orchid"
 777                    "orchid"
 778                    "plum"
 779                    "violet"
 780                    "magenta"
 781                    "VioletRed"
 782                    "violet red"
 783                    "MediumVioletRed"
 784                    "medium violet red"
 785                    "maroon"
 786                    "PaleVioletRed"
 787                    "pale violet red"
 788                    "LightPink"
 789                    "light pink"
 790                    "pink"
 791                    "DeepPink"
 792                    "deep pink"
 793                    "HotPink"
 794                    "hot pink"
 795                    "red"
 796                    "OrangeRed"
 797                    "orange red"
 798                    "tomato"
 799                    "LightCoral"
 800                    "light coral"
 801                    "coral"
 802                    "DarkOrange"
 803                    "dark orange"
 804                    "orange"
 805                    "LightSalmon"
 806                    "light salmon"
 807                    "salmon"
 808                    "DarkSalmon"
 809                    "dark salmon"
 810                    "brown"
 811                    "firebrick"
 812                    "chocolate"
 813                    "tan"
 814                    "SandyBrown"
 815                    "sandy brown"
 816                    "wheat"
 817                    "beige"
 818                    "burlywood"
 819                    "peru"
 820                    "sienna"
 821                    "SaddleBrown"
 822                    "saddle brown"
 823                    "IndianRed"
 824                    "indian red"
 825                    "RosyBrown"
 826                    "rosy brown"
 827                    "DarkGoldenrod"
 828                    "dark goldenrod"
 829                    "goldenrod"
 830                    "LightGoldenrod"
 831                    "light goldenrod"
 832                    "gold"
 833                    "yellow"
 834                    "LightYellow"
 835                    "light yellow"
 836                    "LightGoldenrodYellow"
 837                    "light goldenrod yellow"
 838                    "PaleGoldenrod"
 839                    "pale goldenrod"
 840                    "khaki"
 841                    "DarkKhaki"
 842                    "dark khaki"
 843                    "OliveDrab"
 844                    "olive drab"
 845                    "ForestGreen"
 846                    "forest green"
 847                    "YellowGreen"
 848                    "yellow green"
 849                    "LimeGreen"
 850                    "lime green"
 851                    "GreenYellow"
 852                    "green yellow"
 853                    "MediumSpringGreen"
 854                    "medium spring green"
 855                    "chartreuse"
 856                    "green"
 857                    "LawnGreen"
 858                    "lawn green"
 859                    "SpringGreen"
 860                    "spring green"
 861                    "PaleGreen"
 862                    "pale green"
 863                    "LightSeaGreen"
 864                    "light sea green"
 865                    "MediumSeaGreen"
 866                    "medium sea green"
 867                    "SeaGreen"
 868                    "sea green"
 869                    "DarkSeaGreen"
 870                    "dark sea green"
 871                    "DarkOliveGreen"
 872                    "dark olive green"
 873                    "DarkGreen"
 874                    "dark green"
 875                    "aquamarine"
 876                    "MediumAquamarine"
 877                    "medium aquamarine"
 878                    "CadetBlue"
 879                    "cadet blue"
 880                    "LightCyan"
 881                    "light cyan"
 882                    "cyan"
 883                    "turquoise"
 884                    "MediumTurquoise"
 885                    "medium turquoise"
 886                    "DarkTurquoise"
 887                    "dark turquoise"
 888                    "PaleTurquoise"
 889                    "pale turquoise"
 890                    "PowderBlue"
 891                    "powder blue"
 892                    "LightBlue"
 893                    "light blue"
 894                    "LightSteelBlue"
 895                    "light steel blue"
 896                    "SteelBlue"
 897                    "steel blue"
 898                    "LightSkyBlue"
 899                    "light sky blue"
 900                    "SkyBlue"
 901                    "sky blue"
 902                    "DeepSkyBlue"
 903                    "deep sky blue"
 904                    "DodgerBlue"
 905                    "dodger blue"
 906                    "blue"
 907                    "RoyalBlue"
 908                    "royal blue"
 909                    "MediumBlue"
 910                    "medium blue"
 911                    "LightSlateBlue"
 912                    "light slate blue"
 913                    "MediumSlateBlue"
 914                    "medium slate blue"
 915                    "SlateBlue"
 916                    "slate blue"
 917                    "DarkSlateBlue"
 918                    "dark slate blue"
 919                    "CornflowerBlue"
 920                    "cornflower blue"
 921                    "NavyBlue"
 922                    "navy blue"
 923                    "navy"
 924                    "MidnightBlue"
 925                    "midnight blue"
 926                    "LightGray"
 927                    "light gray"
 928                    "LightGrey"
 929                    "light grey"
 930                    "grey"
 931                    "gray"
 932                    "LightSlateGrey"
 933                    "light slate grey"
 934                    "LightSlateGray"
 935                    "light slate gray"
 936                    "SlateGrey"
 937                    "slate grey"
 938                    "SlateGray"
 939                    "slate gray"
 940                    "DimGrey"
 941                    "dim grey"
 942                    "DimGray"
 943                    "dim gray"
 944                    "DarkSlateGrey"
 945                    "dark slate grey"
 946                    "DarkSlateGray"
 947                    "dark slate gray"
 948                    "black"
 949                    "white"
 950                    "MistyRose"
 951                    "misty rose"
 952                    "LavenderBlush"
 953                    "lavender blush"
 954                    "lavender"
 955                    "AliceBlue"
 956                    "alice blue"
 957                    "azure"
 958                    "MintCream"
 959                    "mint cream"
 960                    "honeydew"
 961                    "seashell"
 962                    "LemonChiffon"
 963                    "lemon chiffon"
 964                    "ivory"
 965                    "cornsilk"
 966                    "moccasin"
 967                    "NavajoWhite"
 968                    "navajo white"
 969                    "PeachPuff"
 970                    "peach puff"
 971                    "bisque"
 972                    "BlanchedAlmond"
 973                    "blanched almond"
 974                    "PapayaWhip"
 975                    "papaya whip"
 976                    "AntiqueWhite"
 977                    "antique white"
 978                    "linen"
 979                    "OldLace"
 980                    "old lace"
 981                    "FloralWhite"
 982                    "floral white"
 983                    "gainsboro"
 984                    "WhiteSmoke"
 985                    "white smoke"
 986                    "GhostWhite"
 987                    "ghost white"
 988                    "snow")
 989   "The list of X colors from the `rgb.txt' file.
 990 XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp")
 991
 992 (defun xw-defined-colors (&optional frame)
 993   "Internal function called by `defined-colors', which see."
 994   (or frame (setq frame (selected-frame)))
 995   (let ((all-colors x-colors)
 996         (this-color nil)
 997         (defined-colors nil))
 998     (while all-colors
 999       (setq this-color (car all-colors)
1000             all-colors (cdr all-colors))
1001       (and (color-supported-p this-color frame t)
1002            (setq defined-colors (cons this-color defined-colors))))
1003     defined-colors))
1004 \f
1005 ;;;; Function keys
1006
1007 (substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame
1008                            global-map)
1009
1010 ;; Map certain keypad keys into ASCII characters
1011 ;; that people usually expect.
1012 (define-key function-key-map [return] [?\C-m])
1013 (define-key function-key-map [M-return] [?\M-\C-m])
1014 (define-key function-key-map [tab] [?\t])
1015 (define-key function-key-map [M-tab] [?\M-\t])
1016 (define-key function-key-map [backspace] [127])
1017 (define-key function-key-map [M-backspace] [?\M-\d])
1018 (define-key function-key-map [escape] [?\e])
1019 (define-key function-key-map [M-escape] [?\M-\e])
1020
1021 ;; These tell read-char how to convert
1022 ;; these special chars to ASCII.
1023 (put 'return 'ascii-character 13)
1024 (put 'tab 'ascii-character ?\t)
1025 (put 'backspace 'ascii-character 127)
1026 (put 'escape 'ascii-character ?\e)
1027
1028 \f
1029 ;;;; Keysyms
1030
1031 ;; Define constant values to be set to mac-keyboard-text-encoding
1032 (defconst kTextEncodingMacRoman 0)
1033 (defconst kTextEncodingISOLatin1 513 "0x201")
1034 (defconst kTextEncodingISOLatin2 514 "0x202")
1035
1036 \f
1037 ;;;; Selections and cut buffers
1038
1039 ;; Setup to use the Mac clipboard.  The functions mac-cut-function and
1040 ;; mac-paste-function are defined in mac.c.
1041 (set-selection-coding-system 'compound-text-mac)
1042
1043 (setq interprogram-cut-function
1044       '(lambda (str push)
1045          (mac-cut-function
1046           (encode-coding-string str selection-coding-system t) push)))
1047
1048 (setq interprogram-paste-function
1049       '(lambda ()
1050          (let ((clipboard (mac-paste-function)))
1051            (if clipboard
1052                (decode-coding-string clipboard selection-coding-system t)))))
1053
1054 \f
1055 ;;; Do the actual Windows setup here; the above code just defines
1056 ;;; functions and variables that we use now.
1057
1058 (setq command-line-args (x-handle-args command-line-args))
1059
1060 ;;; Make sure we have a valid resource name.
1061 (or (stringp x-resource-name)
1062     (let (i)
1063       (setq x-resource-name (invocation-name))
1064
1065       ;; Change any . or * characters in x-resource-name to hyphens,
1066       ;; so as not to choke when we use it in X resource queries.
1067       (while (setq i (string-match "[.*]" x-resource-name))
1068         (aset x-resource-name i ?-))))
1069
1070 (if (x-display-list)
1071     ;; On Mac OS 8/9, Most coding systems used in code conversion for
1072     ;; font names are not ready at the time when the terminal frame is
1073     ;; created.  So we reconstruct font name table for the initial
1074     ;; frame.
1075     (mac-clear-font-name-table)
1076   (x-open-connection "Mac"
1077                      x-command-line-resources
1078                      ;; Exit Emacs with fatal error if this fails.
1079                      t))
1080
1081 (setq frame-creation-function 'x-create-frame-with-faces)
1082
1083 (define-ccl-program ccl-encode-mac-roman-font
1084   `(0
1085     (if (r0 != ,(charset-id 'ascii))
1086         (if (r0 <= ?\x8f)
1087             (translate-character mac-roman-encoder r0 r1)
1088           ((r1 <<= 7)
1089            (r1 |= r2)
1090            (translate-character mac-roman-encoder r0 r1)))))
1091   "CCL program for Mac Roman font")
1092
1093 (let
1094     ((encoding-vector (make-vector 256 nil))
1095      (i 0)
1096      (vec       ;; mac-centraleurroman (128..255) -> UCS mapping
1097       [ #x00C4  ;; 128:LATIN CAPITAL LETTER A WITH DIAERESIS
1098         #x0100  ;; 129:LATIN CAPITAL LETTER A WITH MACRON
1099         #x0101  ;; 130:LATIN SMALL LETTER A WITH MACRON
1100         #x00C9  ;; 131:LATIN CAPITAL LETTER E WITH ACUTE
1101         #x0104  ;; 132:LATIN CAPITAL LETTER A WITH OGONEK
1102         #x00D6  ;; 133:LATIN CAPITAL LETTER O WITH DIAERESIS
1103         #x00DC  ;; 134:LATIN CAPITAL LETTER U WITH DIAERESIS
1104         #x00E1  ;; 135:LATIN SMALL LETTER A WITH ACUTE
1105         #x0105  ;; 136:LATIN SMALL LETTER A WITH OGONEK
1106         #x010C  ;; 137:LATIN CAPITAL LETTER C WITH CARON
1107         #x00E4  ;; 138:LATIN SMALL LETTER A WITH DIAERESIS
1108         #x010D  ;; 139:LATIN SMALL LETTER C WITH CARON
1109         #x0106  ;; 140:LATIN CAPITAL LETTER C WITH ACUTE
1110         #x0107  ;; 141:LATIN SMALL LETTER C WITH ACUTE
1111         #x00E9  ;; 142:LATIN SMALL LETTER E WITH ACUTE
1112         #x0179  ;; 143:LATIN CAPITAL LETTER Z WITH ACUTE
1113         #x017A  ;; 144:LATIN SMALL LETTER Z WITH ACUTE
1114         #x010E  ;; 145:LATIN CAPITAL LETTER D WITH CARON
1115         #x00ED  ;; 146:LATIN SMALL LETTER I WITH ACUTE
1116         #x010F  ;; 147:LATIN SMALL LETTER D WITH CARON
1117         #x0112  ;; 148:LATIN CAPITAL LETTER E WITH MACRON
1118         #x0113  ;; 149:LATIN SMALL LETTER E WITH MACRON
1119         #x0116  ;; 150:LATIN CAPITAL LETTER E WITH DOT ABOVE
1120         #x00F3  ;; 151:LATIN SMALL LETTER O WITH ACUTE
1121         #x0117  ;; 152:LATIN SMALL LETTER E WITH DOT ABOVE
1122         #x00F4  ;; 153:LATIN SMALL LETTER O WITH CIRCUMFLEX
1123         #x00F6  ;; 154:LATIN SMALL LETTER O WITH DIAERESIS
1124         #x00F5  ;; 155:LATIN SMALL LETTER O WITH TILDE
1125         #x00FA  ;; 156:LATIN SMALL LETTER U WITH ACUTE
1126         #x011A  ;; 157:LATIN CAPITAL LETTER E WITH CARON
1127         #x011B  ;; 158:LATIN SMALL LETTER E WITH CARON
1128         #x00FC  ;; 159:LATIN SMALL LETTER U WITH DIAERESIS
1129         #x2020  ;; 160:DAGGER
1130         #x00B0  ;; 161:DEGREE SIGN
1131         #x0118  ;; 162:LATIN CAPITAL LETTER E WITH OGONEK
1132         #x00A3  ;; 163:POUND SIGN
1133         #x00A7  ;; 164:SECTION SIGN
1134         #x2022  ;; 165:BULLET
1135         #x00B6  ;; 166:PILCROW SIGN
1136         #x00DF  ;; 167:LATIN SMALL LETTER SHARP S
1137         #x00AE  ;; 168:REGISTERED SIGN
1138         #x00A9  ;; 169:COPYRIGHT SIGN
1139         #x2122  ;; 170:TRADE MARK SIGN
1140         #x0119  ;; 171:LATIN SMALL LETTER E WITH OGONEK
1141         #x00A8  ;; 172:DIAERESIS
1142         #x2260  ;; 173:NOT EQUAL TO
1143         #x0123  ;; 174:LATIN SMALL LETTER G WITH CEDILLA
1144         #x012E  ;; 175:LATIN CAPITAL LETTER I WITH OGONEK
1145         #x012F  ;; 176:LATIN SMALL LETTER I WITH OGONEK
1146         #x012A  ;; 177:LATIN CAPITAL LETTER I WITH MACRON
1147         #x2264  ;; 178:LESS-THAN OR EQUAL TO
1148         #x2265  ;; 179:GREATER-THAN OR EQUAL TO
1149         #x012B  ;; 180:LATIN SMALL LETTER I WITH MACRON
1150         #x0136  ;; 181:LATIN CAPITAL LETTER K WITH CEDILLA
1151         #x2202  ;; 182:PARTIAL DIFFERENTIAL
1152         #x2211  ;; 183:N-ARY SUMMATION
1153         #x0142  ;; 184:LATIN SMALL LETTER L WITH STROKE
1154         #x013B  ;; 185:LATIN CAPITAL LETTER L WITH CEDILLA
1155         #x013C  ;; 186:LATIN SMALL LETTER L WITH CEDILLA
1156         #x013D  ;; 187:LATIN CAPITAL LETTER L WITH CARON
1157         #x013E  ;; 188:LATIN SMALL LETTER L WITH CARON
1158         #x0139  ;; 189:LATIN CAPITAL LETTER L WITH ACUTE
1159         #x013A  ;; 190:LATIN SMALL LETTER L WITH ACUTE
1160         #x0145  ;; 191:LATIN CAPITAL LETTER N WITH CEDILLA
1161         #x0146  ;; 192:LATIN SMALL LETTER N WITH CEDILLA
1162         #x0143  ;; 193:LATIN CAPITAL LETTER N WITH ACUTE
1163         #x00AC  ;; 194:NOT SIGN
1164         #x221A  ;; 195:SQUARE ROOT
1165         #x0144  ;; 196:LATIN SMALL LETTER N WITH ACUTE
1166         #x0147  ;; 197:LATIN CAPITAL LETTER N WITH CARON
1167         #x2206  ;; 198:INCREMENT
1168         #x00AB  ;; 199:LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
1169         #x00BB  ;; 200:RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
1170         #x2026  ;; 201:HORIZONTAL ELLIPSIS
1171         #x00A0  ;; 202:NO-BREAK SPACE
1172         #x0148  ;; 203:LATIN SMALL LETTER N WITH CARON
1173         #x0150  ;; 204:LATIN CAPITAL LETTER O WITH DOUBLE ACUTE
1174         #x00D5  ;; 205:LATIN CAPITAL LETTER O WITH TILDE
1175         #x0151  ;; 206:LATIN SMALL LETTER O WITH DOUBLE ACUTE
1176         #x014C  ;; 207:LATIN CAPITAL LETTER O WITH MACRON
1177         #x2013  ;; 208:EN DASH
1178         #x2014  ;; 209:EM DASH
1179         #x201C  ;; 210:LEFT DOUBLE QUOTATION MARK
1180         #x201D  ;; 211:RIGHT DOUBLE QUOTATION MARK
1181         #x2018  ;; 212:LEFT SINGLE QUOTATION MARK
1182         #x2019  ;; 213:RIGHT SINGLE QUOTATION MARK
1183         #x00F7  ;; 214:DIVISION SIGN
1184         #x25CA  ;; 215:LOZENGE
1185         #x014D  ;; 216:LATIN SMALL LETTER O WITH MACRON
1186         #x0154  ;; 217:LATIN CAPITAL LETTER R WITH ACUTE
1187         #x0155  ;; 218:LATIN SMALL LETTER R WITH ACUTE
1188         #x0158  ;; 219:LATIN CAPITAL LETTER R WITH CARON
1189         #x2039  ;; 220:SINGLE LEFT-POINTING ANGLE QUOTATION MARK
1190         #x203A  ;; 221:SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
1191         #x0159  ;; 222:LATIN SMALL LETTER R WITH CARON
1192         #x0156  ;; 223:LATIN CAPITAL LETTER R WITH CEDILLA
1193         #x0157  ;; 224:LATIN SMALL LETTER R WITH CEDILLA
1194         #x0160  ;; 225:LATIN CAPITAL LETTER S WITH CARON
1195         #x201A  ;; 226:SINGLE LOW-9 QUOTATION MARK
1196         #x201E  ;; 227:DOUBLE LOW-9 QUOTATION MARK
1197         #x0161  ;; 228:LATIN SMALL LETTER S WITH CARON
1198         #x015A  ;; 229:LATIN CAPITAL LETTER S WITH ACUTE
1199         #x015B  ;; 230:LATIN SMALL LETTER S WITH ACUTE
1200         #x00C1  ;; 231:LATIN CAPITAL LETTER A WITH ACUTE
1201         #x0164  ;; 232:LATIN CAPITAL LETTER T WITH CARON
1202         #x0165  ;; 233:LATIN SMALL LETTER T WITH CARON
1203         #x00CD  ;; 234:LATIN CAPITAL LETTER I WITH ACUTE
1204         #x017D  ;; 235:LATIN CAPITAL LETTER Z WITH CARON
1205         #x017E  ;; 236:LATIN SMALL LETTER Z WITH CARON
1206         #x016A  ;; 237:LATIN CAPITAL LETTER U WITH MACRON
1207         #x00D3  ;; 238:LATIN CAPITAL LETTER O WITH ACUTE
1208         #x00D4  ;; 239:LATIN CAPITAL LETTER O WITH CIRCUMFLEX
1209         #x016B  ;; 240:LATIN SMALL LETTER U WITH MACRON
1210         #x016E  ;; 241:LATIN CAPITAL LETTER U WITH RING ABOVE
1211         #x00DA  ;; 242:LATIN CAPITAL LETTER U WITH ACUTE
1212         #x016F  ;; 243:LATIN SMALL LETTER U WITH RING ABOVE
1213         #x0170  ;; 244:LATIN CAPITAL LETTER U WITH DOUBLE ACUTE
1214         #x0171  ;; 245:LATIN SMALL LETTER U WITH DOUBLE ACUTE
1215         #x0172  ;; 246:LATIN CAPITAL LETTER U WITH OGONEK
1216         #x0173  ;; 247:LATIN SMALL LETTER U WITH OGONEK
1217         #x00DD  ;; 248:LATIN CAPITAL LETTER Y WITH ACUTE
1218         #x00FD  ;; 249:LATIN SMALL LETTER Y WITH ACUTE
1219         #x0137  ;; 250:LATIN SMALL LETTER K WITH CEDILLA
1220         #x017B  ;; 251:LATIN CAPITAL LETTER Z WITH DOT ABOVE
1221         #x0141  ;; 252:LATIN CAPITAL LETTER L WITH STROKE
1222         #x017C  ;; 253:LATIN SMALL LETTER Z WITH DOT ABOVE
1223         #x0122  ;; 254:LATIN CAPITAL LETTER G WITH CEDILLA
1224         #x02C7  ;; 255:CARON
1225         ])
1226      translation-table)
1227   (while (< i 128)
1228     (aset encoding-vector i i)
1229     (setq i (1+ i)))
1230   (while (< i 256)
1231     (aset encoding-vector i
1232           (decode-char 'ucs (aref vec (- i 128))))
1233     (setq i (1+ i)))
1234   (setq translation-table
1235         (make-translation-table-from-vector encoding-vector))
1236 ;;  (define-translation-table 'mac-centraleurroman-decoder translation-table)
1237   (define-translation-table 'mac-centraleurroman-encoder
1238     (char-table-extra-slot translation-table 0)))
1239
1240 (let
1241     ((encoding-vector (make-vector 256 nil))
1242      (i 0)
1243      (vec       ;; mac-cyrillic (128..255) -> UCS mapping
1244       [ #x0410  ;; 128:CYRILLIC CAPITAL LETTER A
1245         #x0411  ;; 129:CYRILLIC CAPITAL LETTER BE
1246         #x0412  ;; 130:CYRILLIC CAPITAL LETTER VE
1247         #x0413  ;; 131:CYRILLIC CAPITAL LETTER GHE
1248         #x0414  ;; 132:CYRILLIC CAPITAL LETTER DE
1249         #x0415  ;; 133:CYRILLIC CAPITAL LETTER IE
1250         #x0416  ;; 134:CYRILLIC CAPITAL LETTER ZHE
1251         #x0417  ;; 135:CYRILLIC CAPITAL LETTER ZE
1252         #x0418  ;; 136:CYRILLIC CAPITAL LETTER I
1253         #x0419  ;; 137:CYRILLIC CAPITAL LETTER SHORT I
1254         #x041A  ;; 138:CYRILLIC CAPITAL LETTER KA
1255         #x041B  ;; 139:CYRILLIC CAPITAL LETTER EL
1256         #x041C  ;; 140:CYRILLIC CAPITAL LETTER EM
1257         #x041D  ;; 141:CYRILLIC CAPITAL LETTER EN
1258         #x041E  ;; 142:CYRILLIC CAPITAL LETTER O
1259         #x041F  ;; 143:CYRILLIC CAPITAL LETTER PE
1260         #x0420  ;; 144:CYRILLIC CAPITAL LETTER ER
1261         #x0421  ;; 145:CYRILLIC CAPITAL LETTER ES
1262         #x0422  ;; 146:CYRILLIC CAPITAL LETTER TE
1263         #x0423  ;; 147:CYRILLIC CAPITAL LETTER U
1264         #x0424  ;; 148:CYRILLIC CAPITAL LETTER EF
1265         #x0425  ;; 149:CYRILLIC CAPITAL LETTER HA
1266         #x0426  ;; 150:CYRILLIC CAPITAL LETTER TSE
1267         #x0427  ;; 151:CYRILLIC CAPITAL LETTER CHE
1268         #x0428  ;; 152:CYRILLIC CAPITAL LETTER SHA
1269         #x0429  ;; 153:CYRILLIC CAPITAL LETTER SHCHA
1270         #x042A  ;; 154:CYRILLIC CAPITAL LETTER HARD SIGN
1271         #x042B  ;; 155:CYRILLIC CAPITAL LETTER YERU
1272         #x042C  ;; 156:CYRILLIC CAPITAL LETTER SOFT SIGN
1273         #x042D  ;; 157:CYRILLIC CAPITAL LETTER E
1274         #x042E  ;; 158:CYRILLIC CAPITAL LETTER YU
1275         #x042F  ;; 159:CYRILLIC CAPITAL LETTER YA
1276         #x2020  ;; 160:DAGGER
1277         #x00B0  ;; 161:DEGREE SIGN
1278         #x0490  ;; 162:CYRILLIC CAPITAL LETTER GHE WITH UPTURN
1279         #x00A3  ;; 163:POUND SIGN
1280         #x00A7  ;; 164:SECTION SIGN
1281         #x2022  ;; 165:BULLET
1282         #x00B6  ;; 166:PILCROW SIGN
1283         #x0406  ;; 167:CYRILLIC CAPITAL LETTER BYELORUSSIAN-UKRAINIAN I
1284         #x00AE  ;; 168:REGISTERED SIGN
1285         #x00A9  ;; 169:COPYRIGHT SIGN
1286         #x2122  ;; 170:TRADE MARK SIGN
1287         #x0402  ;; 171:CYRILLIC CAPITAL LETTER DJE
1288         #x0452  ;; 172:CYRILLIC SMALL LETTER DJE
1289         #x2260  ;; 173:NOT EQUAL TO
1290         #x0403  ;; 174:CYRILLIC CAPITAL LETTER GJE
1291         #x0453  ;; 175:CYRILLIC SMALL LETTER GJE
1292         #x221E  ;; 176:INFINITY
1293         #x00B1  ;; 177:PLUS-MINUS SIGN
1294         #x2264  ;; 178:LESS-THAN OR EQUAL TO
1295         #x2265  ;; 179:GREATER-THAN OR EQUAL TO
1296         #x0456  ;; 180:CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN I
1297         #x00B5  ;; 181:MICRO SIGN
1298         #x0491  ;; 182:CYRILLIC SMALL LETTER GHE WITH UPTURN
1299         #x0408  ;; 183:CYRILLIC CAPITAL LETTER JE
1300         #x0404  ;; 184:CYRILLIC CAPITAL LETTER UKRAINIAN IE
1301         #x0454  ;; 185:CYRILLIC SMALL LETTER UKRAINIAN IE
1302         #x0407  ;; 186:CYRILLIC CAPITAL LETTER YI
1303         #x0457  ;; 187:CYRILLIC SMALL LETTER YI
1304         #x0409  ;; 188:CYRILLIC CAPITAL LETTER LJE
1305         #x0459  ;; 189:CYRILLIC SMALL LETTER LJE
1306         #x040A  ;; 190:CYRILLIC CAPITAL LETTER NJE
1307         #x045A  ;; 191:CYRILLIC SMALL LETTER NJE
1308         #x0458  ;; 192:CYRILLIC SMALL LETTER JE
1309         #x0405  ;; 193:CYRILLIC CAPITAL LETTER DZE
1310         #x00AC  ;; 194:NOT SIGN
1311         #x221A  ;; 195:SQUARE ROOT
1312         #x0192  ;; 196:LATIN SMALL LETTER F WITH HOOK
1313         #x2248  ;; 197:ALMOST EQUAL TO
1314         #x2206  ;; 198:INCREMENT
1315         #x00AB  ;; 199:LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
1316         #x00BB  ;; 200:RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
1317         #x2026  ;; 201:HORIZONTAL ELLIPSIS
1318         #x00A0  ;; 202:NO-BREAK SPACE
1319         #x040B  ;; 203:CYRILLIC CAPITAL LETTER TSHE
1320         #x045B  ;; 204:CYRILLIC SMALL LETTER TSHE
1321         #x040C  ;; 205:CYRILLIC CAPITAL LETTER KJE
1322         #x045C  ;; 206:CYRILLIC SMALL LETTER KJE
1323         #x0455  ;; 207:CYRILLIC SMALL LETTER DZE
1324         #x2013  ;; 208:EN DASH
1325         #x2014  ;; 209:EM DASH
1326         #x201C  ;; 210:LEFT DOUBLE QUOTATION MARK
1327         #x201D  ;; 211:RIGHT DOUBLE QUOTATION MARK
1328         #x2018  ;; 212:LEFT SINGLE QUOTATION MARK
1329         #x2019  ;; 213:RIGHT SINGLE QUOTATION MARK
1330         #x00F7  ;; 214:DIVISION SIGN
1331         #x201E  ;; 215:DOUBLE LOW-9 QUOTATION MARK
1332         #x040E  ;; 216:CYRILLIC CAPITAL LETTER SHORT U
1333         #x045E  ;; 217:CYRILLIC SMALL LETTER SHORT U
1334         #x040F  ;; 218:CYRILLIC CAPITAL LETTER DZHE
1335         #x045F  ;; 219:CYRILLIC SMALL LETTER DZHE
1336         #x2116  ;; 220:NUMERO SIGN
1337         #x0401  ;; 221:CYRILLIC CAPITAL LETTER IO
1338         #x0451  ;; 222:CYRILLIC SMALL LETTER IO
1339         #x044F  ;; 223:CYRILLIC SMALL LETTER YA
1340         #x0430  ;; 224:CYRILLIC SMALL LETTER A
1341         #x0431  ;; 225:CYRILLIC SMALL LETTER BE
1342         #x0432  ;; 226:CYRILLIC SMALL LETTER VE
1343         #x0433  ;; 227:CYRILLIC SMALL LETTER GHE
1344         #x0434  ;; 228:CYRILLIC SMALL LETTER DE
1345         #x0435  ;; 229:CYRILLIC SMALL LETTER IE
1346         #x0436  ;; 230:CYRILLIC SMALL LETTER ZHE
1347         #x0437  ;; 231:CYRILLIC SMALL LETTER ZE
1348         #x0438  ;; 232:CYRILLIC SMALL LETTER I
1349         #x0439  ;; 233:CYRILLIC SMALL LETTER SHORT I
1350         #x043A  ;; 234:CYRILLIC SMALL LETTER KA
1351         #x043B  ;; 235:CYRILLIC SMALL LETTER EL
1352         #x043C  ;; 236:CYRILLIC SMALL LETTER EM
1353         #x043D  ;; 237:CYRILLIC SMALL LETTER EN
1354         #x043E  ;; 238:CYRILLIC SMALL LETTER O
1355         #x043F  ;; 239:CYRILLIC SMALL LETTER PE
1356         #x0440  ;; 240:CYRILLIC SMALL LETTER ER
1357         #x0441  ;; 241:CYRILLIC SMALL LETTER ES
1358         #x0442  ;; 242:CYRILLIC SMALL LETTER TE
1359         #x0443  ;; 243:CYRILLIC SMALL LETTER U
1360         #x0444  ;; 244:CYRILLIC SMALL LETTER EF
1361         #x0445  ;; 245:CYRILLIC SMALL LETTER HA
1362         #x0446  ;; 246:CYRILLIC SMALL LETTER TSE
1363         #x0447  ;; 247:CYRILLIC SMALL LETTER CHE
1364         #x0448  ;; 248:CYRILLIC SMALL LETTER SHA
1365         #x0449  ;; 249:CYRILLIC SMALL LETTER SHCHA
1366         #x044A  ;; 250:CYRILLIC SMALL LETTER HARD SIGN
1367         #x044B  ;; 251:CYRILLIC SMALL LETTER YERU
1368         #x044C  ;; 252:CYRILLIC SMALL LETTER SOFT SIGN
1369         #x044D  ;; 253:CYRILLIC SMALL LETTER E
1370         #x044E  ;; 254:CYRILLIC SMALL LETTER YU
1371         #x20AC  ;; 255:EURO SIGN
1372         ])
1373      translation-table)
1374   (while (< i 128)
1375     (aset encoding-vector i i)
1376     (setq i (1+ i)))
1377   (while (< i 256)
1378     (aset encoding-vector i
1379           (decode-char 'ucs (aref vec (- i 128))))
1380     (setq i (1+ i)))
1381   (setq translation-table
1382         (make-translation-table-from-vector encoding-vector))
1383 ;;  (define-translation-table 'mac-cyrillic-decoder translation-table)
1384   (define-translation-table 'mac-cyrillic-encoder
1385     (char-table-extra-slot translation-table 0)))
1386
1387 (defvar mac-font-encoder-list
1388   '(("mac-roman" mac-roman-encoder
1389      ccl-encode-mac-roman-font "%s")
1390     ("mac-centraleurroman" mac-centraleurroman-encoder
1391      ccl-encode-mac-centraleurroman-font "%s ce")
1392     ("mac-cyrillic" mac-cyrillic-encoder
1393      ccl-encode-mac-cyrillic-font "%s cy")))
1394
1395 (let ((encoder-list
1396        (mapcar (lambda (lst) (nth 1 lst)) mac-font-encoder-list))
1397       (charset-list
1398        '(latin-iso8859-2
1399          latin-iso8859-3 latin-iso8859-4
1400          cyrillic-iso8859-5 greek-iso8859-7 hebrew-iso8859-8
1401          latin-iso8859-9 latin-iso8859-14 latin-iso8859-15)))
1402   (dolist (encoder encoder-list)
1403     (let ((table (get encoder 'translation-table)))
1404       (dolist (charset charset-list)
1405         (dotimes (i 96)
1406           (let* ((c (make-char charset (+ i 32)))
1407                  (mu (aref ucs-mule-to-mule-unicode c))
1408                  (mac-encoded (and mu (aref table mu))))
1409             (if mac-encoded
1410                 (aset table c mac-encoded))))))))
1411
1412 (define-ccl-program ccl-encode-mac-centraleurroman-font
1413   `(0
1414     (if (r0 != ,(charset-id 'ascii))
1415         (if (r0 <= ?\x8f)
1416             (translate-character mac-centraleurroman-encoder r0 r1)
1417           ((r1 <<= 7)
1418            (r1 |= r2)
1419            (translate-character mac-centraleurroman-encoder r0 r1)))))
1420   "CCL program for Mac Central European Roman font")
1421
1422 (define-ccl-program ccl-encode-mac-cyrillic-font
1423   `(0
1424     (if (r0 != ,(charset-id 'ascii))
1425         (if (r0 <= ?\x8f)
1426             (translate-character mac-cyrillic-encoder r0 r1)
1427           ((r1 <<= 7)
1428            (r1 |= r2)
1429            (translate-character mac-cyrillic-encoder r0 r1)))))
1430   "CCL program for Mac Cyrillic font")
1431
1432
1433 (setq font-ccl-encoder-alist
1434       (nconc
1435        (mapcar (lambda (lst) (cons (nth 0 lst) (nth 2 lst)))
1436                mac-font-encoder-list)
1437        font-ccl-encoder-alist))
1438
1439 (defun fontset-add-mac-fonts (fontset &optional base-family)
1440   (if base-family
1441       (setq base-family (downcase base-family))
1442     (let ((ascii-font
1443            (downcase (x-resolve-font-name
1444                       (fontset-font fontset (charset-id 'ascii))))))
1445       (setq base-family (aref (x-decompose-font-name ascii-font)
1446                               xlfd-regexp-family-subnum))))
1447 ;;  (if (not (string-match "^fontset-" fontset))
1448 ;;      (setq fontset
1449 ;;          (concat "fontset-" (aref (x-decompose-font-name fontset)
1450 ;;                                   xlfd-regexp-encoding-subnum))))
1451   (dolist
1452       (font-encoder
1453        (nreverse
1454         (mapcar (lambda (lst)
1455                   (cons (cons (format (nth 3 lst) base-family) (nth 0 lst))
1456                         (nth 1 lst)))
1457                 mac-font-encoder-list)))
1458     (let ((font (car font-encoder))
1459           (encoder (cdr font-encoder)))
1460       (map-char-table
1461        (lambda (key val)
1462          (or (null val)
1463              (generic-char-p key)
1464              (memq (char-charset key)
1465                    '(ascii eight-bit-control eight-bit-graphic))
1466              (set-fontset-font fontset key font)))
1467        (get encoder 'translation-table)))))
1468
1469 (defun create-fontset-from-mac-roman-font (font &optional resolved-font
1470                                                 fontset-name)
1471   "Create a fontset from a Mac roman font FONT.
1472
1473 Optional 1st arg RESOLVED-FONT is a resolved name of FONT.  If
1474 omitted, `x-resolve-font-name' is called to get the resolved name.  At
1475 this time, if FONT is not available, error is signaled.
1476
1477 Optional 2nd arg FONTSET-NAME is a string to be used in
1478 `<CHARSET_ENCODING>' fields of a new fontset name.  If it is omitted,
1479 an appropriate name is generated automatically.
1480
1481 It returns a name of the created fontset."
1482   (let ((fontset
1483          (create-fontset-from-ascii-font font resolved-font fontset-name)))
1484     (fontset-add-mac-fonts fontset)
1485     fontset))
1486
1487 ;; Setup the default fontset.
1488 (setup-default-fontset)
1489
1490 ;; Create a fontset that uses mac-roman font.  With this fontset,
1491 ;; characters decoded from mac-roman encoding (ascii, latin-iso8859-1,
1492 ;; and mule-unicode-xxxx-yyyy) are displayed by a mac-roman font.
1493 (create-fontset-from-fontset-spec
1494  "-etl-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-mac,
1495 ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman")
1496 (fontset-add-mac-fonts "fontset-mac")
1497
1498 ;; Create fontset specified in X resources "Fontset-N" (N is 0, 1, ...).
1499 (create-fontset-from-x-resource)
1500
1501 ;; Try to create a fontset from a font specification which comes
1502 ;; from initial-frame-alist, default-frame-alist, or X resource.
1503 ;; A font specification in command line argument (i.e. -fn XXXX)
1504 ;; should be already in default-frame-alist as a `font'
1505 ;; parameter.  However, any font specifications in site-start
1506 ;; library, user's init file (.emacs), and default.el are not
1507 ;; yet handled here.
1508
1509 (let ((font (or (cdr (assq 'font initial-frame-alist))
1510                 (cdr (assq 'font default-frame-alist))
1511                 (x-get-resource "font" "Font")))
1512       xlfd-fields resolved-name)
1513   (if (and font
1514            (not (query-fontset font))
1515            (setq resolved-name (x-resolve-font-name font))
1516            (setq xlfd-fields (x-decompose-font-name font)))
1517       (if (string= "fontset" (aref xlfd-fields xlfd-regexp-registry-subnum))
1518           (new-fontset font (x-complement-fontset-spec xlfd-fields nil))
1519         ;; Create a fontset from FONT.  The fontset name is
1520         ;; generated from FONT.
1521         (create-fontset-from-ascii-font font resolved-name "startup"))))
1522
1523 ;; Apply a geometry resource to the initial frame.  Put it at the end
1524 ;; of the alist, so that anything specified on the command line takes
1525 ;; precedence.
1526 (let* ((res-geometry (x-get-resource "geometry" "Geometry"))
1527        parsed)
1528   (if res-geometry
1529       (progn
1530         (setq parsed (x-parse-geometry res-geometry))
1531         ;; If the resource specifies a position,
1532         ;; call the position and size "user-specified".
1533         (if (or (assq 'top parsed) (assq 'left parsed))
1534             (setq parsed (cons '(user-position . t)
1535                                (cons '(user-size . t) parsed))))
1536         ;; All geometry parms apply to the initial frame.
1537         (setq initial-frame-alist (append initial-frame-alist parsed))
1538         ;; The size parms apply to all frames.
1539         (if (assq 'height parsed)
1540             (setq default-frame-alist
1541                   (cons (cons 'height (cdr (assq 'height parsed)))
1542                         default-frame-alist)))
1543         (if (assq 'width parsed)
1544             (setq default-frame-alist
1545                   (cons (cons 'width (cdr (assq 'width parsed)))
1546                         default-frame-alist))))))
1547
1548 ;; Check the reverseVideo resource.
1549 (let ((case-fold-search t))
1550   (let ((rv (x-get-resource "reverseVideo" "ReverseVideo")))
1551     (if (and rv
1552              (string-match "^\\(true\\|yes\\|on\\)$" rv))
1553         (setq default-frame-alist
1554               (cons '(reverse . t) default-frame-alist)))))
1555
1556 (defun x-win-suspend-error ()
1557   (error "Suspending an Emacs running under Mac makes no sense"))
1558 (add-hook 'suspend-hook 'x-win-suspend-error)
1559
1560 ;; Don't show the frame name; that's redundant.
1561 (setq-default mode-line-frame-identification "  ")
1562
1563 ;; Turn on support for mouse wheels.
1564 (mouse-wheel-mode 1)
1565
1566 (defun mac-drag-n-drop (event)
1567   "Edit the files listed in the drag-n-drop event.\n\
1568 Switch to a buffer editing the last file dropped."
1569   (interactive "e")
1570   (save-excursion
1571     ;; Make sure the drop target has positive co-ords
1572     ;; before setting the selected frame - otherwise it
1573     ;; won't work.  <skx@tardis.ed.ac.uk>
1574     (let* ((window (posn-window (event-start event)))
1575            (coords (posn-x-y (event-start event)))
1576            (x (car coords))
1577            (y (cdr coords)))
1578       (if (and (> x 0) (> y 0))
1579           (set-frame-selected-window nil window))
1580       (mapcar
1581        '(lambda (file)
1582           (find-file
1583            (decode-coding-string
1584             file
1585             (or file-name-coding-system
1586                 default-file-name-coding-system))))
1587        (car (cdr (cdr event)))))
1588   (raise-frame)
1589   (recenter)))
1590
1591 (global-set-key [drag-n-drop] 'mac-drag-n-drop)
1592
1593 ;; By checking whether the variable mac-ready-for-drag-n-drop has been
1594 ;; defined, the event loop in macterm.c can be informed that it can
1595 ;; now receive Finder drag and drop events.  Files dropped onto the
1596 ;; Emacs application icon can only be processed when the initial frame
1597 ;; has been created: this is where the files should be opened.
1598 (add-hook 'after-init-hook
1599           '(lambda ()
1600              (defvar mac-ready-for-drag-n-drop t)))
1601 \f
1602 ;;;; Scroll bars
1603
1604 ;; for debugging
1605 ;; (defun mac-handle-scroll-bar-event (event) (interactive "e") (princ event))
1606
1607 ;;(global-set-key [vertical-scroll-bar mouse-1] 'mac-handle-scroll-bar-event)
1608
1609 (global-set-key
1610  [vertical-scroll-bar down-mouse-1]
1611  'mac-handle-scroll-bar-event)
1612
1613 (global-unset-key [vertical-scroll-bar drag-mouse-1])
1614 (global-unset-key [vertical-scroll-bar mouse-1])
1615
1616 (defun mac-handle-scroll-bar-event (event)
1617   "Handle scroll bar EVENT to emulate Mac Toolbox style scrolling."
1618   (interactive "e")
1619   (let* ((position (event-start event))
1620          (window (nth 0 position))
1621          (bar-part (nth 4 position)))
1622     (select-window window)
1623     (cond
1624      ((eq bar-part 'up)
1625       (goto-char (window-start window))
1626       (mac-scroll-down-line))
1627      ((eq bar-part 'above-handle)
1628       (mac-scroll-down))
1629      ((eq bar-part 'handle)
1630       (scroll-bar-drag event))
1631      ((eq bar-part 'below-handle)
1632       (mac-scroll-up))
1633      ((eq bar-part 'down)
1634       (goto-char (window-start window))
1635       (mac-scroll-up-line)))))
1636
1637 (defun mac-scroll-ignore-events ()
1638   ;; Ignore confusing non-mouse events
1639   (while (not (memq (car-safe (read-event))
1640                     '(mouse-1 double-mouse-1 triple-mouse-1))) nil))
1641
1642 (defun mac-scroll-down ()
1643   (track-mouse
1644     (mac-scroll-ignore-events)
1645     (scroll-down)))
1646
1647 (defun mac-scroll-down-line ()
1648   (track-mouse
1649     (mac-scroll-ignore-events)
1650     (scroll-down 1)))
1651
1652 (defun mac-scroll-up ()
1653   (track-mouse
1654     (mac-scroll-ignore-events)
1655     (scroll-up)))
1656
1657 (defun mac-scroll-up-line ()
1658   (track-mouse
1659     (mac-scroll-ignore-events)
1660     (scroll-up 1)))
1661
1662 \f
1663 ;;;; Others
1664
1665 (unless (eq system-type 'darwin)
1666   ;; This variable specifies the Unix program to call (as a process) to
1667   ;; deteremine the amount of free space on a file system (defaults to
1668   ;; df).  If it is not set to nil, ls-lisp will not work correctly
1669   ;; unless an external application df is implemented on the Mac.
1670   (setq directory-free-space-program nil)
1671
1672   ;; Set this so that Emacs calls subprocesses with "sh" as shell to
1673   ;; expand filenames Note no subprocess for the shell is actually
1674   ;; started (see run_mac_command in sysdep.c).
1675   (setq shell-file-name "sh"))
1676
1677 ;; X Window emulation in macterm.c is not complete enough to start a
1678 ;; frame without a minibuffer properly.  Call this to tell ediff
1679 ;; library to use a single frame.
1680 ; (ediff-toggle-multiframe)
1681
1682 (if (eq system-type 'darwin)
1683     ;; On Darwin filenames are encoded in UTF-8
1684     (setq file-name-coding-system 'utf-8)
1685   ;; To display filenames in Chinese or Japanese, replace mac-roman with
1686   ;; big5 or sjis
1687   (setq file-name-coding-system 'mac-roman))
1688
1689 ;; If Emacs is started from the Finder, change the default directory
1690 ;; to the user's home directory.
1691 (if (string= default-directory "/")
1692     (cd "~"))
1693
1694 ;; Tell Emacs to use pipes instead of pty's for processes because the
1695 ;; latter sometimes lose characters.  Pty support is compiled in since
1696 ;; ange-ftp will not work without it.
1697 (setq process-connection-type nil)
1698
1699 ;; Assume that fonts are always scalable on the Mac.  This sometimes
1700 ;; results in characters with jagged edges.  However, without it,
1701 ;; fonts with both truetype and bitmap representations but no italic
1702 ;; or bold bitmap versions will not display these variants correctly.
1703 (setq scalable-fonts-allowed t)
1704
1705 ;; (prefer-coding-system 'mac-roman)
1706
1707 ;;; arch-tag: 71dfcd14-cde8-4d66-b05c-85ec94fb23a6
1708 ;;; mac-win.el ends here