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

   1 ;;; mac-win.el --- parse switches controlling interface with Mac window system -*-coding: iso-2022-7bit;-*-
   2
   3 ;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
   4 ;;   2005 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 \f
  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 ;; -i                   .iconType
  58 ;; -itype               .iconType
  59 ;; -iconic              .iconic
  60 ;; -name                .name
  61 ;; -reverse             *reverseVideo
  62 ;; -rv                  *reverseVideo
  63 ;; -selectionTimeout    .selectionTimeout
  64 ;; -synchronous         *synchronous
  65 ;; -xrm
  66
  67 ;; An alist of X options and the function which handles them.  See
  68 ;; ../startup.el.
  69
  70 (if (not (eq window-system 'mac))
  71     (error "%s: Loading mac-win.el but not compiled for Mac" (invocation-name)))
  72
  73 (require 'frame)
  74 (require 'mouse)
  75 (require 'scroll-bar)
  76 (require 'faces)
  77 (require 'select)
  78 (require 'menu-bar)
  79 (require 'fontset)
  80 (require 'dnd)
  81
  82 (defvar mac-charset-info-alist)
  83 (defvar mac-services-selection)
  84 (defvar mac-system-script-code)
  85 (defvar x-invocation-args)
  86
  87 (defvar x-command-line-resources nil)
  88
  89 ;; Handler for switches of the form "-switch value" or "-switch".
  90 (defun x-handle-switch (switch)
  91   (let ((aelt (assoc switch command-line-x-option-alist)))
  92     (if aelt
  93         (let ((param (nth 3 aelt))
  94               (value (nth 4 aelt)))
  95           (if value
  96               (setq default-frame-alist
  97                     (cons (cons param value)
  98                           default-frame-alist))
  99             (setq default-frame-alist
 100                   (cons (cons param
 101                               (car x-invocation-args))
 102                         default-frame-alist)
 103                   x-invocation-args (cdr x-invocation-args)))))))
 104
 105 ;; Handler for switches of the form "-switch n"
 106 (defun x-handle-numeric-switch (switch)
 107   (let ((aelt (assoc switch command-line-x-option-alist)))
 108     (if aelt
 109         (let ((param (nth 3 aelt)))
 110           (setq default-frame-alist
 111                 (cons (cons param
 112                             (string-to-number (car x-invocation-args)))
 113                       default-frame-alist)
 114                 x-invocation-args
 115                 (cdr x-invocation-args))))))
 116
 117 ;; Handle options that apply to initial frame only
 118 (defun x-handle-initial-switch (switch)
 119   (let ((aelt (assoc switch command-line-x-option-alist)))
 120     (if aelt
 121         (let ((param (nth 3 aelt))
 122               (value (nth 4 aelt)))
 123           (if value
 124               (setq initial-frame-alist
 125                     (cons (cons param value)
 126                           initial-frame-alist))
 127             (setq initial-frame-alist
 128                   (cons (cons param
 129                               (car x-invocation-args))
 130                         initial-frame-alist)
 131                   x-invocation-args (cdr x-invocation-args)))))))
 132
 133 ;; Make -iconic apply only to the initial frame!
 134 (defun x-handle-iconic (switch)
 135   (setq initial-frame-alist
 136         (cons '(visibility . icon) initial-frame-alist)))
 137
 138 ;; Handle the -xrm option.
 139 (defun x-handle-xrm-switch (switch)
 140   (unless (consp x-invocation-args)
 141     (error "%s: missing argument to `%s' option" (invocation-name) switch))
 142   (setq x-command-line-resources
 143         (if (null x-command-line-resources)
 144             (car x-invocation-args)
 145           (concat x-command-line-resources "\n" (car x-invocation-args))))
 146   (setq x-invocation-args (cdr x-invocation-args)))
 147
 148 ;; Handle the geometry option
 149 (defun x-handle-geometry (switch)
 150   (let* ((geo (x-parse-geometry (car x-invocation-args)))
 151          (left (assq 'left geo))
 152          (top (assq 'top geo))
 153          (height (assq 'height geo))
 154          (width (assq 'width geo)))
 155     (if (or height width)
 156         (setq default-frame-alist
 157               (append default-frame-alist
 158                       '((user-size . t))
 159                       (if height (list height))
 160                       (if width (list width)))
 161               initial-frame-alist
 162               (append initial-frame-alist
 163                       '((user-size . t))
 164                       (if height (list height))
 165                       (if width (list width)))))
 166     (if (or left top)
 167         (setq initial-frame-alist
 168               (append initial-frame-alist
 169                       '((user-position . t))
 170                       (if left (list left))
 171                       (if top (list top)))))
 172     (setq x-invocation-args (cdr x-invocation-args))))
 173
 174 ;; Handle the -name option.  Set the variable x-resource-name
 175 ;; to the option's operand; set the name of
 176 ;; the initial frame, too.
 177 (defun x-handle-name-switch (switch)
 178   (or (consp x-invocation-args)
 179       (error "%s: missing argument to `%s' option" (invocation-name) switch))
 180   (setq x-resource-name (car x-invocation-args)
 181         x-invocation-args (cdr x-invocation-args))
 182   (setq initial-frame-alist (cons (cons 'name x-resource-name)
 183                                   initial-frame-alist)))
 184
 185 (defvar x-display-name nil
 186   "The display name specifying server and frame.")
 187
 188 (defun x-handle-display (switch)
 189   (setq x-display-name (car x-invocation-args)
 190         x-invocation-args (cdr x-invocation-args)))
 191
 192 (defun x-handle-args (args)
 193   "Process the X-related command line options in ARGS.
 194 This is done before the user's startup file is loaded.  They are copied to
 195 `x-invocation-args', from which the X-related things are extracted, first
 196 the switch (e.g., \"-fg\") in the following code, and possible values
 197 \(e.g., \"black\") in the option handler code (e.g., x-handle-switch).
 198 This function returns ARGS minus the arguments that have been processed."
 199   ;; We use ARGS to accumulate the args that we don't handle here, to return.
 200   (setq x-invocation-args args
 201         args nil)
 202   (while (and x-invocation-args
 203               (not (equal (car x-invocation-args) "--")))
 204     (let* ((this-switch (car x-invocation-args))
 205            (orig-this-switch this-switch)
 206            completion argval aelt handler)
 207       (setq x-invocation-args (cdr x-invocation-args))
 208       ;; Check for long options with attached arguments
 209       ;; and separate out the attached option argument into argval.
 210       (if (string-match "^--[^=]*=" this-switch)
 211           (setq argval (substring this-switch (match-end 0))
 212                 this-switch (substring this-switch 0 (1- (match-end 0)))))
 213       ;; Complete names of long options.
 214       (if (string-match "^--" this-switch)
 215           (progn
 216             (setq completion (try-completion this-switch command-line-x-option-alist))
 217             (if (eq completion t)
 218                 ;; Exact match for long option.
 219                 nil
 220               (if (stringp completion)
 221                   (let ((elt (assoc completion command-line-x-option-alist)))
 222                     ;; Check for abbreviated long option.
 223                     (or elt
 224                         (error "Option `%s' is ambiguous" this-switch))
 225                     (setq this-switch completion))))))
 226       (setq aelt (assoc this-switch command-line-x-option-alist))
 227       (if aelt (setq handler (nth 2 aelt)))
 228       (if handler
 229           (if argval
 230               (let ((x-invocation-args
 231                      (cons argval x-invocation-args)))
 232                 (funcall handler this-switch))
 233             (funcall handler this-switch))
 234         (setq args (cons orig-this-switch args)))))
 235   (nconc (nreverse args) x-invocation-args))
 236
 237 \f
 238 ;;
 239 ;; Standard Mac cursor shapes
 240 ;;
 241
 242 (defconst mac-pointer-arrow 0)
 243 (defconst mac-pointer-copy-arrow 1)
 244 (defconst mac-pointer-alias-arrow 2)
 245 (defconst mac-pointer-contextual-menu-arrow 3)
 246 (defconst mac-pointer-I-beam 4)
 247 (defconst mac-pointer-cross 5)
 248 (defconst mac-pointer-plus 6)
 249 (defconst mac-pointer-watch 7)
 250 (defconst mac-pointer-closed-hand 8)
 251 (defconst mac-pointer-open-hand 9)
 252 (defconst mac-pointer-pointing-hand 10)
 253 (defconst mac-pointer-counting-up-hand 11)
 254 (defconst mac-pointer-counting-down-hand 12)
 255 (defconst mac-pointer-counting-up-and-down-hand 13)
 256 (defconst mac-pointer-spinning 14)
 257 (defconst mac-pointer-resize-left 15)
 258 (defconst mac-pointer-resize-right 16)
 259 (defconst mac-pointer-resize-left-right 17)
 260 ;; Mac OS X 10.2 and later
 261 (defconst mac-pointer-not-allowed 18)
 262 ;; Mac OS X 10.3 and later
 263 (defconst mac-pointer-resize-up 19)
 264 (defconst mac-pointer-resize-down 20)
 265 (defconst mac-pointer-resize-up-down 21)
 266 (defconst mac-pointer-poof 22)
 267
 268 ;;
 269 ;; Standard X cursor shapes that have Mac counterparts
 270 ;;
 271
 272 (defconst x-pointer-left-ptr mac-pointer-arrow)
 273 (defconst x-pointer-xterm mac-pointer-I-beam)
 274 (defconst x-pointer-crosshair mac-pointer-cross)
 275 (defconst x-pointer-plus mac-pointer-plus)
 276 (defconst x-pointer-watch mac-pointer-watch)
 277 (defconst x-pointer-hand2 mac-pointer-pointing-hand)
 278 (defconst x-pointer-left-side mac-pointer-resize-left)
 279 (defconst x-pointer-right-side mac-pointer-resize-right)
 280 (defconst x-pointer-sb-h-double-arrow mac-pointer-resize-left-right)
 281 (defconst x-pointer-top-side mac-pointer-resize-up)
 282 (defconst x-pointer-bottom-side mac-pointer-resize-down)
 283 (defconst x-pointer-sb-v-double-arrow mac-pointer-resize-up-down)
 284
 285 \f
 286 ;;
 287 ;; Available colors
 288 ;;
 289
 290 (defvar x-colors '("LightGreen"
 291                    "light green"
 292                    "DarkRed"
 293                    "dark red"
 294                    "DarkMagenta"
 295                    "dark magenta"
 296                    "DarkCyan"
 297                    "dark cyan"
 298                    "DarkBlue"
 299                    "dark blue"
 300                    "DarkGray"
 301                    "dark gray"
 302                    "DarkGrey"
 303                    "dark grey"
 304                    "grey100"
 305                    "gray100"
 306                    "grey99"
 307                    "gray99"
 308                    "grey98"
 309                    "gray98"
 310                    "grey97"
 311                    "gray97"
 312                    "grey96"
 313                    "gray96"
 314                    "grey95"
 315                    "gray95"
 316                    "grey94"
 317                    "gray94"
 318                    "grey93"
 319                    "gray93"
 320                    "grey92"
 321                    "gray92"
 322                    "grey91"
 323                    "gray91"
 324                    "grey90"
 325                    "gray90"
 326                    "grey89"
 327                    "gray89"
 328                    "grey88"
 329                    "gray88"
 330                    "grey87"
 331                    "gray87"
 332                    "grey86"
 333                    "gray86"
 334                    "grey85"
 335                    "gray85"
 336                    "grey84"
 337                    "gray84"
 338                    "grey83"
 339                    "gray83"
 340                    "grey82"
 341                    "gray82"
 342                    "grey81"
 343                    "gray81"
 344                    "grey80"
 345                    "gray80"
 346                    "grey79"
 347                    "gray79"
 348                    "grey78"
 349                    "gray78"
 350                    "grey77"
 351                    "gray77"
 352                    "grey76"
 353                    "gray76"
 354                    "grey75"
 355                    "gray75"
 356                    "grey74"
 357                    "gray74"
 358                    "grey73"
 359                    "gray73"
 360                    "grey72"
 361                    "gray72"
 362                    "grey71"
 363                    "gray71"
 364                    "grey70"
 365                    "gray70"
 366                    "grey69"
 367                    "gray69"
 368                    "grey68"
 369                    "gray68"
 370                    "grey67"
 371                    "gray67"
 372                    "grey66"
 373                    "gray66"
 374                    "grey65"
 375                    "gray65"
 376                    "grey64"
 377                    "gray64"
 378                    "grey63"
 379                    "gray63"
 380                    "grey62"
 381                    "gray62"
 382                    "grey61"
 383                    "gray61"
 384                    "grey60"
 385                    "gray60"
 386                    "grey59"
 387                    "gray59"
 388                    "grey58"
 389                    "gray58"
 390                    "grey57"
 391                    "gray57"
 392                    "grey56"
 393                    "gray56"
 394                    "grey55"
 395                    "gray55"
 396                    "grey54"
 397                    "gray54"
 398                    "grey53"
 399                    "gray53"
 400                    "grey52"
 401                    "gray52"
 402                    "grey51"
 403                    "gray51"
 404                    "grey50"
 405                    "gray50"
 406                    "grey49"
 407                    "gray49"
 408                    "grey48"
 409                    "gray48"
 410                    "grey47"
 411                    "gray47"
 412                    "grey46"
 413                    "gray46"
 414                    "grey45"
 415                    "gray45"
 416                    "grey44"
 417                    "gray44"
 418                    "grey43"
 419                    "gray43"
 420                    "grey42"
 421                    "gray42"
 422                    "grey41"
 423                    "gray41"
 424                    "grey40"
 425                    "gray40"
 426                    "grey39"
 427                    "gray39"
 428                    "grey38"
 429                    "gray38"
 430                    "grey37"
 431                    "gray37"
 432                    "grey36"
 433                    "gray36"
 434                    "grey35"
 435                    "gray35"
 436                    "grey34"
 437                    "gray34"
 438                    "grey33"
 439                    "gray33"
 440                    "grey32"
 441                    "gray32"
 442                    "grey31"
 443                    "gray31"
 444                    "grey30"
 445                    "gray30"
 446                    "grey29"
 447                    "gray29"
 448                    "grey28"
 449                    "gray28"
 450                    "grey27"
 451                    "gray27"
 452                    "grey26"
 453                    "gray26"
 454                    "grey25"
 455                    "gray25"
 456                    "grey24"
 457                    "gray24"
 458                    "grey23"
 459                    "gray23"
 460                    "grey22"
 461                    "gray22"
 462                    "grey21"
 463                    "gray21"
 464                    "grey20"
 465                    "gray20"
 466                    "grey19"
 467                    "gray19"
 468                    "grey18"
 469                    "gray18"
 470                    "grey17"
 471                    "gray17"
 472                    "grey16"
 473                    "gray16"
 474                    "grey15"
 475                    "gray15"
 476                    "grey14"
 477                    "gray14"
 478                    "grey13"
 479                    "gray13"
 480                    "grey12"
 481                    "gray12"
 482                    "grey11"
 483                    "gray11"
 484                    "grey10"
 485                    "gray10"
 486                    "grey9"
 487                    "gray9"
 488                    "grey8"
 489                    "gray8"
 490                    "grey7"
 491                    "gray7"
 492                    "grey6"
 493                    "gray6"
 494                    "grey5"
 495                    "gray5"
 496                    "grey4"
 497                    "gray4"
 498                    "grey3"
 499                    "gray3"
 500                    "grey2"
 501                    "gray2"
 502                    "grey1"
 503                    "gray1"
 504                    "grey0"
 505                    "gray0"
 506                    "thistle4"
 507                    "thistle3"
 508                    "thistle2"
 509                    "thistle1"
 510                    "MediumPurple4"
 511                    "MediumPurple3"
 512                    "MediumPurple2"
 513                    "MediumPurple1"
 514                    "purple4"
 515                    "purple3"
 516                    "purple2"
 517                    "purple1"
 518                    "DarkOrchid4"
 519                    "DarkOrchid3"
 520                    "DarkOrchid2"
 521                    "DarkOrchid1"
 522                    "MediumOrchid4"
 523                    "MediumOrchid3"
 524                    "MediumOrchid2"
 525                    "MediumOrchid1"
 526                    "plum4"
 527                    "plum3"
 528                    "plum2"
 529                    "plum1"
 530                    "orchid4"
 531                    "orchid3"
 532                    "orchid2"
 533                    "orchid1"
 534                    "magenta4"
 535                    "magenta3"
 536                    "magenta2"
 537                    "magenta1"
 538                    "VioletRed4"
 539                    "VioletRed3"
 540                    "VioletRed2"
 541                    "VioletRed1"
 542                    "maroon4"
 543                    "maroon3"
 544                    "maroon2"
 545                    "maroon1"
 546                    "PaleVioletRed4"
 547                    "PaleVioletRed3"
 548                    "PaleVioletRed2"
 549                    "PaleVioletRed1"
 550                    "LightPink4"
 551                    "LightPink3"
 552                    "LightPink2"
 553                    "LightPink1"
 554                    "pink4"
 555                    "pink3"
 556                    "pink2"
 557                    "pink1"
 558                    "HotPink4"
 559                    "HotPink3"
 560                    "HotPink2"
 561                    "HotPink1"
 562                    "DeepPink4"
 563                    "DeepPink3"
 564                    "DeepPink2"
 565                    "DeepPink1"
 566                    "red4"
 567                    "red3"
 568                    "red2"
 569                    "red1"
 570                    "OrangeRed4"
 571                    "OrangeRed3"
 572                    "OrangeRed2"
 573                    "OrangeRed1"
 574                    "tomato4"
 575                    "tomato3"
 576                    "tomato2"
 577                    "tomato1"
 578                    "coral4"
 579                    "coral3"
 580                    "coral2"
 581                    "coral1"
 582                    "DarkOrange4"
 583                    "DarkOrange3"
 584                    "DarkOrange2"
 585                    "DarkOrange1"
 586                    "orange4"
 587                    "orange3"
 588                    "orange2"
 589                    "orange1"
 590                    "LightSalmon4"
 591                    "LightSalmon3"
 592                    "LightSalmon2"
 593                    "LightSalmon1"
 594                    "salmon4"
 595                    "salmon3"
 596                    "salmon2"
 597                    "salmon1"
 598                    "brown4"
 599                    "brown3"
 600                    "brown2"
 601                    "brown1"
 602                    "firebrick4"
 603                    "firebrick3"
 604                    "firebrick2"
 605                    "firebrick1"
 606                    "chocolate4"
 607                    "chocolate3"
 608                    "chocolate2"
 609                    "chocolate1"
 610                    "tan4"
 611                    "tan3"
 612                    "tan2"
 613                    "tan1"
 614                    "wheat4"
 615                    "wheat3"
 616                    "wheat2"
 617                    "wheat1"
 618                    "burlywood4"
 619                    "burlywood3"
 620                    "burlywood2"
 621                    "burlywood1"
 622                    "sienna4"
 623                    "sienna3"
 624                    "sienna2"
 625                    "sienna1"
 626                    "IndianRed4"
 627                    "IndianRed3"
 628                    "IndianRed2"
 629                    "IndianRed1"
 630                    "RosyBrown4"
 631                    "RosyBrown3"
 632                    "RosyBrown2"
 633                    "RosyBrown1"
 634                    "DarkGoldenrod4"
 635                    "DarkGoldenrod3"
 636                    "DarkGoldenrod2"
 637                    "DarkGoldenrod1"
 638                    "goldenrod4"
 639                    "goldenrod3"
 640                    "goldenrod2"
 641                    "goldenrod1"
 642                    "gold4"
 643                    "gold3"
 644                    "gold2"
 645                    "gold1"
 646                    "yellow4"
 647                    "yellow3"
 648                    "yellow2"
 649                    "yellow1"
 650                    "LightYellow4"
 651                    "LightYellow3"
 652                    "LightYellow2"
 653                    "LightYellow1"
 654                    "LightGoldenrod4"
 655                    "LightGoldenrod3"
 656                    "LightGoldenrod2"
 657                    "LightGoldenrod1"
 658                    "khaki4"
 659                    "khaki3"
 660                    "khaki2"
 661                    "khaki1"
 662                    "DarkOliveGreen4"
 663                    "DarkOliveGreen3"
 664                    "DarkOliveGreen2"
 665                    "DarkOliveGreen1"
 666                    "OliveDrab4"
 667                    "OliveDrab3"
 668                    "OliveDrab2"
 669                    "OliveDrab1"
 670                    "chartreuse4"
 671                    "chartreuse3"
 672                    "chartreuse2"
 673                    "chartreuse1"
 674                    "green4"
 675                    "green3"
 676                    "green2"
 677                    "green1"
 678                    "SpringGreen4"
 679                    "SpringGreen3"
 680                    "SpringGreen2"
 681                    "SpringGreen1"
 682                    "PaleGreen4"
 683                    "PaleGreen3"
 684                    "PaleGreen2"
 685                    "PaleGreen1"
 686                    "SeaGreen4"
 687                    "SeaGreen3"
 688                    "SeaGreen2"
 689                    "SeaGreen1"
 690                    "DarkSeaGreen4"
 691                    "DarkSeaGreen3"
 692                    "DarkSeaGreen2"
 693                    "DarkSeaGreen1"
 694                    "aquamarine4"
 695                    "aquamarine3"
 696                    "aquamarine2"
 697                    "aquamarine1"
 698                    "DarkSlateGray4"
 699                    "DarkSlateGray3"
 700                    "DarkSlateGray2"
 701                    "DarkSlateGray1"
 702                    "cyan4"
 703                    "cyan3"
 704                    "cyan2"
 705                    "cyan1"
 706                    "turquoise4"
 707                    "turquoise3"
 708                    "turquoise2"
 709                    "turquoise1"
 710                    "CadetBlue4"
 711                    "CadetBlue3"
 712                    "CadetBlue2"
 713                    "CadetBlue1"
 714                    "PaleTurquoise4"
 715                    "PaleTurquoise3"
 716                    "PaleTurquoise2"
 717                    "PaleTurquoise1"
 718                    "LightCyan4"
 719                    "LightCyan3"
 720                    "LightCyan2"
 721                    "LightCyan1"
 722                    "LightBlue4"
 723                    "LightBlue3"
 724                    "LightBlue2"
 725                    "LightBlue1"
 726                    "LightSteelBlue4"
 727                    "LightSteelBlue3"
 728                    "LightSteelBlue2"
 729                    "LightSteelBlue1"
 730                    "SlateGray4"
 731                    "SlateGray3"
 732                    "SlateGray2"
 733                    "SlateGray1"
 734                    "LightSkyBlue4"
 735                    "LightSkyBlue3"
 736                    "LightSkyBlue2"
 737                    "LightSkyBlue1"
 738                    "SkyBlue4"
 739                    "SkyBlue3"
 740                    "SkyBlue2"
 741                    "SkyBlue1"
 742                    "DeepSkyBlue4"
 743                    "DeepSkyBlue3"
 744                    "DeepSkyBlue2"
 745                    "DeepSkyBlue1"
 746                    "SteelBlue4"
 747                    "SteelBlue3"
 748                    "SteelBlue2"
 749                    "SteelBlue1"
 750                    "DodgerBlue4"
 751                    "DodgerBlue3"
 752                    "DodgerBlue2"
 753                    "DodgerBlue1"
 754                    "blue4"
 755                    "blue3"
 756                    "blue2"
 757                    "blue1"
 758                    "RoyalBlue4"
 759                    "RoyalBlue3"
 760                    "RoyalBlue2"
 761                    "RoyalBlue1"
 762                    "SlateBlue4"
 763                    "SlateBlue3"
 764                    "SlateBlue2"
 765                    "SlateBlue1"
 766                    "azure4"
 767                    "azure3"
 768                    "azure2"
 769                    "azure1"
 770                    "MistyRose4"
 771                    "MistyRose3"
 772                    "MistyRose2"
 773                    "MistyRose1"
 774                    "LavenderBlush4"
 775                    "LavenderBlush3"
 776                    "LavenderBlush2"
 777                    "LavenderBlush1"
 778                    "honeydew4"
 779                    "honeydew3"
 780                    "honeydew2"
 781                    "honeydew1"
 782                    "ivory4"
 783                    "ivory3"
 784                    "ivory2"
 785                    "ivory1"
 786                    "cornsilk4"
 787                    "cornsilk3"
 788                    "cornsilk2"
 789                    "cornsilk1"
 790                    "LemonChiffon4"
 791                    "LemonChiffon3"
 792                    "LemonChiffon2"
 793                    "LemonChiffon1"
 794                    "NavajoWhite4"
 795                    "NavajoWhite3"
 796                    "NavajoWhite2"
 797                    "NavajoWhite1"
 798                    "PeachPuff4"
 799                    "PeachPuff3"
 800                    "PeachPuff2"
 801                    "PeachPuff1"
 802                    "bisque4"
 803                    "bisque3"
 804                    "bisque2"
 805                    "bisque1"
 806                    "AntiqueWhite4"
 807                    "AntiqueWhite3"
 808                    "AntiqueWhite2"
 809                    "AntiqueWhite1"
 810                    "seashell4"
 811                    "seashell3"
 812                    "seashell2"
 813                    "seashell1"
 814                    "snow4"
 815                    "snow3"
 816                    "snow2"
 817                    "snow1"
 818                    "thistle"
 819                    "MediumPurple"
 820                    "medium purple"
 821                    "purple"
 822                    "BlueViolet"
 823                    "blue violet"
 824                    "DarkViolet"
 825                    "dark violet"
 826                    "DarkOrchid"
 827                    "dark orchid"
 828                    "MediumOrchid"
 829                    "medium orchid"
 830                    "orchid"
 831                    "plum"
 832                    "violet"
 833                    "magenta"
 834                    "VioletRed"
 835                    "violet red"
 836                    "MediumVioletRed"
 837                    "medium violet red"
 838                    "maroon"
 839                    "PaleVioletRed"
 840                    "pale violet red"
 841                    "LightPink"
 842                    "light pink"
 843                    "pink"
 844                    "DeepPink"
 845                    "deep pink"
 846                    "HotPink"
 847                    "hot pink"
 848                    "red"
 849                    "OrangeRed"
 850                    "orange red"
 851                    "tomato"
 852                    "LightCoral"
 853                    "light coral"
 854                    "coral"
 855                    "DarkOrange"
 856                    "dark orange"
 857                    "orange"
 858                    "LightSalmon"
 859                    "light salmon"
 860                    "salmon"
 861                    "DarkSalmon"
 862                    "dark salmon"
 863                    "brown"
 864                    "firebrick"
 865                    "chocolate"
 866                    "tan"
 867                    "SandyBrown"
 868                    "sandy brown"
 869                    "wheat"
 870                    "beige"
 871                    "burlywood"
 872                    "peru"
 873                    "sienna"
 874                    "SaddleBrown"
 875                    "saddle brown"
 876                    "IndianRed"
 877                    "indian red"
 878                    "RosyBrown"
 879                    "rosy brown"
 880                    "DarkGoldenrod"
 881                    "dark goldenrod"
 882                    "goldenrod"
 883                    "LightGoldenrod"
 884                    "light goldenrod"
 885                    "gold"
 886                    "yellow"
 887                    "LightYellow"
 888                    "light yellow"
 889                    "LightGoldenrodYellow"
 890                    "light goldenrod yellow"
 891                    "PaleGoldenrod"
 892                    "pale goldenrod"
 893                    "khaki"
 894                    "DarkKhaki"
 895                    "dark khaki"
 896                    "OliveDrab"
 897                    "olive drab"
 898                    "ForestGreen"
 899                    "forest green"
 900                    "YellowGreen"
 901                    "yellow green"
 902                    "LimeGreen"
 903                    "lime green"
 904                    "GreenYellow"
 905                    "green yellow"
 906                    "MediumSpringGreen"
 907                    "medium spring green"
 908                    "chartreuse"
 909                    "green"
 910                    "LawnGreen"
 911                    "lawn green"
 912                    "SpringGreen"
 913                    "spring green"
 914                    "PaleGreen"
 915                    "pale green"
 916                    "LightSeaGreen"
 917                    "light sea green"
 918                    "MediumSeaGreen"
 919                    "medium sea green"
 920                    "SeaGreen"
 921                    "sea green"
 922                    "DarkSeaGreen"
 923                    "dark sea green"
 924                    "DarkOliveGreen"
 925                    "dark olive green"
 926                    "DarkGreen"
 927                    "dark green"
 928                    "aquamarine"
 929                    "MediumAquamarine"
 930                    "medium aquamarine"
 931                    "CadetBlue"
 932                    "cadet blue"
 933                    "LightCyan"
 934                    "light cyan"
 935                    "cyan"
 936                    "turquoise"
 937                    "MediumTurquoise"
 938                    "medium turquoise"
 939                    "DarkTurquoise"
 940                    "dark turquoise"
 941                    "PaleTurquoise"
 942                    "pale turquoise"
 943                    "PowderBlue"
 944                    "powder blue"
 945                    "LightBlue"
 946                    "light blue"
 947                    "LightSteelBlue"
 948                    "light steel blue"
 949                    "SteelBlue"
 950                    "steel blue"
 951                    "LightSkyBlue"
 952                    "light sky blue"
 953                    "SkyBlue"
 954                    "sky blue"
 955                    "DeepSkyBlue"
 956                    "deep sky blue"
 957                    "DodgerBlue"
 958                    "dodger blue"
 959                    "blue"
 960                    "RoyalBlue"
 961                    "royal blue"
 962                    "MediumBlue"
 963                    "medium blue"
 964                    "LightSlateBlue"
 965                    "light slate blue"
 966                    "MediumSlateBlue"
 967                    "medium slate blue"
 968                    "SlateBlue"
 969                    "slate blue"
 970                    "DarkSlateBlue"
 971                    "dark slate blue"
 972                    "CornflowerBlue"
 973                    "cornflower blue"
 974                    "NavyBlue"
 975                    "navy blue"
 976                    "navy"
 977                    "MidnightBlue"
 978                    "midnight blue"
 979                    "LightGray"
 980                    "light gray"
 981                    "LightGrey"
 982                    "light grey"
 983                    "grey"
 984                    "gray"
 985                    "LightSlateGrey"
 986                    "light slate grey"
 987                    "LightSlateGray"
 988                    "light slate gray"
 989                    "SlateGrey"
 990                    "slate grey"
 991                    "SlateGray"
 992                    "slate gray"
 993                    "DimGrey"
 994                    "dim grey"
 995                    "DimGray"
 996                    "dim gray"
 997                    "DarkSlateGrey"
 998                    "dark slate grey"
 999                    "DarkSlateGray"
1000                    "dark slate gray"
1001                    "black"
1002                    "white"
1003                    "MistyRose"
1004                    "misty rose"
1005                    "LavenderBlush"
1006                    "lavender blush"
1007                    "lavender"
1008                    "AliceBlue"
1009                    "alice blue"
1010                    "azure"
1011                    "MintCream"
1012                    "mint cream"
1013                    "honeydew"
1014                    "seashell"
1015                    "LemonChiffon"
1016                    "lemon chiffon"
1017                    "ivory"
1018                    "cornsilk"
1019                    "moccasin"
1020                    "NavajoWhite"
1021                    "navajo white"
1022                    "PeachPuff"
1023                    "peach puff"
1024                    "bisque"
1025                    "BlanchedAlmond"
1026                    "blanched almond"
1027                    "PapayaWhip"
1028                    "papaya whip"
1029                    "AntiqueWhite"
1030                    "antique white"
1031                    "linen"
1032                    "OldLace"
1033                    "old lace"
1034                    "FloralWhite"
1035                    "floral white"
1036                    "gainsboro"
1037                    "WhiteSmoke"
1038                    "white smoke"
1039                    "GhostWhite"
1040                    "ghost white"
1041                    "snow")
1042   "The list of X colors from the `rgb.txt' file.
1043 XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp")
1044
1045 (defun xw-defined-colors (&optional frame)
1046   "Internal function called by `defined-colors', which see."
1047   (or frame (setq frame (selected-frame)))
1048   (let ((all-colors x-colors)
1049         (this-color nil)
1050         (defined-colors nil))
1051     (while all-colors
1052       (setq this-color (car all-colors)
1053             all-colors (cdr all-colors))
1054       (and (color-supported-p this-color frame t)
1055            (setq defined-colors (cons this-color defined-colors))))
1056     defined-colors))
1057 \f
1058 ;;;; Function keys
1059
1060 (substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame
1061                            global-map)
1062
1063 ;; Map certain keypad keys into ASCII characters
1064 ;; that people usually expect.
1065 (let ((m (terminal-local-value 'local-function-key-map nil)))
1066   (define-key m [backspace] [?\d])
1067   (define-key m [delete] [?\d])
1068   (define-key m [tab] [?\t])
1069   (define-key m [linefeed] [?\n])
1070   (define-key m [clear] [?\C-l])
1071   (define-key m [return] [?\C-m])
1072   (define-key m [escape] [?\e])
1073   (define-key m [M-backspace] [?\M-\d])
1074   (define-key m [M-delete] [?\M-\d])
1075   (define-key m [M-tab] [?\M-\t])
1076   (define-key m [M-linefeed] [?\M-\n])
1077   (define-key m [M-clear] [?\M-\C-l])
1078   (define-key m [M-return] [?\M-\C-m])
1079   (define-key m [M-escape] [?\M-\e]))
1080
1081 ;; These tell read-char how to convert
1082 ;; these special chars to ASCII.
1083 (put 'backspace 'ascii-character ?\d)
1084 (put 'delete 'ascii-character ?\d)
1085 (put 'tab 'ascii-character ?\t)
1086 (put 'linefeed 'ascii-character ?\n)
1087 (put 'clear 'ascii-character ?\C-l)
1088 (put 'return 'ascii-character ?\C-m)
1089 (put 'escape 'ascii-character ?\e)
1090
1091 \f
1092 ;;;; Script codes and coding systems
1093 (defconst mac-script-code-coding-systems
1094   '((0 . mac-roman)                     ; smRoman
1095     (1 . japanese-shift-jis)            ; smJapanese
1096     (2 . chinese-big5)                  ; smTradChinese
1097     (3 . korean-iso-8bit)               ; smKorean
1098     (7 . mac-cyrillic)                  ; smCyrillic
1099     (25 . chinese-iso-8bit)             ; smSimpChinese
1100     (29 . mac-centraleurroman)          ; smCentralEuroRoman
1101     )
1102   "Alist of Mac script codes vs Emacs coding systems.")
1103
1104 (defconst mac-system-coding-system
1105   (let ((base (or (cdr (assq mac-system-script-code
1106                              mac-script-code-coding-systems))
1107                   'mac-roman)))
1108     (if (eq system-type 'darwin)
1109         base
1110       (coding-system-change-eol-conversion base 'mac)))
1111   "Coding system derived from the system script code.")
1112
1113 (defun mac-add-charset-info (xlfd-charset mac-text-encoding)
1114   "Function to add character sets to display with Mac fonts.
1115 Creates entries in `mac-charset-info-alist'.
1116 XLFD-CHARSET is a string which will appear in the XLFD font name
1117 to identify the character set.  MAC-TEXT-ENCODING is the
1118 correspoinding TextEncodingBase value."
1119   (add-to-list 'mac-charset-info-alist
1120                (list xlfd-charset mac-text-encoding
1121                      (cdr (assq mac-text-encoding
1122                                 mac-script-code-coding-systems)))))
1123
1124 (setq mac-charset-info-alist nil)
1125 (mac-add-charset-info "mac-roman" 0)
1126 (mac-add-charset-info "jisx0208.1983-sjis" 1)
1127 (mac-add-charset-info "jisx0201.1976-0" 1)
1128 (mac-add-charset-info "big5-0" 2)
1129 (mac-add-charset-info "ksc5601.1989-0" 3)
1130 (mac-add-charset-info "mac-cyrillic" 7)
1131 (mac-add-charset-info "gb2312.1980-0" 25)
1132 (mac-add-charset-info "mac-centraleurroman" 29)
1133 (mac-add-charset-info "mac-symbol" 33)
1134 (mac-add-charset-info "adobe-fontspecific" 33) ; for X-Symbol
1135 (mac-add-charset-info "mac-dingbats" 34)
1136
1137 \f
1138 ;;;; Keyboard layout/language change events
1139 (defun mac-handle-language-change (event)
1140   (interactive "e")
1141   (let ((coding-system
1142          (cdr (assq (car (cadr event)) mac-script-code-coding-systems))))
1143     (set-keyboard-coding-system (or coding-system 'mac-roman))
1144     ;; MacJapanese maps reverse solidus to ?\x80.
1145     (if (eq coding-system 'japanese-shift-jis)
1146         (define-key key-translation-map [?\x80] "\\"))))
1147
1148 (define-key special-event-map [language-change] 'mac-handle-language-change)
1149 \f
1150 ;;;; Selections and Services menu
1151
1152 ;; Setup to use the Mac clipboard.
1153 (set-selection-coding-system mac-system-coding-system)
1154
1155 ;;; We keep track of the last text selected here, so we can check the
1156 ;;; current selection against it, and avoid passing back our own text
1157 ;;; from x-get-selection-value.
1158 (defvar x-last-selected-text-clipboard nil
1159   "The value of the CLIPBOARD selection last time we selected or
1160 pasted text.")
1161 (defvar x-last-selected-text-primary nil
1162   "The value of the PRIMARY X selection last time we selected or
1163 pasted text.")
1164
1165 (defcustom x-select-enable-clipboard t
1166   "*Non-nil means cutting and pasting uses the clipboard.
1167 This is in addition to the primary selection."
1168   :type 'boolean
1169   :group 'killing)
1170
1171 ;;; Make TEXT, a string, the primary X selection.
1172 (defun x-select-text (text &optional push)
1173   (x-set-selection 'PRIMARY text)
1174   (setq x-last-selected-text-primary text)
1175   (if (not x-select-enable-clipboard)
1176       (setq x-last-selected-text-clipboard nil)
1177     (x-set-selection 'CLIPBOARD text)
1178     (setq x-last-selected-text-clipboard text))
1179   )
1180
1181 (defun x-get-selection (&optional type data-type)
1182   "Return the value of a selection.
1183 The argument TYPE (default `PRIMARY') says which selection,
1184 and the argument DATA-TYPE (default `STRING') says
1185 how to convert the data.
1186
1187 TYPE may be any symbol \(but nil stands for `PRIMARY').  However,
1188 only a few symbols are commonly used.  They conventionally have
1189 all upper-case names.  The most often used ones, in addition to
1190 `PRIMARY', are `SECONDARY' and `CLIPBOARD'.
1191
1192 DATA-TYPE is usually `STRING', but can also be one of the symbols
1193 in `selection-converter-alist', which see."
1194   (let ((data (x-get-selection-internal (or type 'PRIMARY)
1195                                         (or data-type 'STRING)))
1196         (coding (or next-selection-coding-system
1197                     selection-coding-system)))
1198     (when (and (stringp data)
1199                (setq data-type (get-text-property 0 'foreign-selection data)))
1200       (cond ((eq data-type 'public.utf16-plain-text)
1201              (let ((encoded (and (fboundp 'mac-code-convert-string)
1202                                  (mac-code-convert-string data
1203                                                           'utf-16 coding))))
1204                (if encoded
1205                    (let ((coding-save last-coding-system-used))
1206                      (setq data (decode-coding-string encoded coding))
1207                      (setq last-coding-system-used coding-save))
1208                  (setq data
1209                        (decode-coding-string data 'utf-16)))))
1210             ((eq data-type 'com.apple.traditional-mac-plain-text)
1211              (setq data (decode-coding-string data coding)))
1212             ((eq data-type 'public.file-url)
1213              (setq data (decode-coding-string data 'utf-8))
1214              ;; Remove a trailing nul character.
1215              (let ((len (length data)))
1216                (if (and (> len 0) (= (aref data (1- len)) ?\0))
1217                    (setq data (substring data 0 (1- len)))))))
1218       (put-text-property 0 (length data) 'foreign-selection data-type data))
1219     data))
1220
1221 (defun x-selection-value (type)
1222   (let ((data-types '(public.utf16-plain-text
1223                       com.apple.traditional-mac-plain-text
1224                       public.file-url))
1225         text tiff-image)
1226     (while (and (null text) data-types)
1227       (setq text (condition-case nil
1228                      (x-get-selection type (car data-types))
1229                    (error nil)))
1230       (setq data-types (cdr data-types)))
1231     (if text
1232         (remove-text-properties 0 (length text) '(foreign-selection nil) text))
1233     (setq tiff-image (condition-case nil
1234                          (x-get-selection type 'public.tiff)
1235                        (error nil)))
1236     (when tiff-image
1237       (remove-text-properties 0 (length tiff-image)
1238                               '(foreign-selection nil) tiff-image)
1239       (setq tiff-image (create-image tiff-image 'tiff t))
1240       (or text (setq text " "))
1241       (put-text-property 0 (length text) 'display tiff-image text))
1242     text))
1243
1244 ;;; Return the value of the current selection.
1245 ;;; Treat empty strings as if they were unset.
1246 ;;; If this function is called twice and finds the same text,
1247 ;;; it returns nil the second time.  This is so that a single
1248 ;;; selection won't be added to the kill ring over and over.
1249 (defun x-get-selection-value ()
1250   (let (clip-text primary-text)
1251     (if (not x-select-enable-clipboard)
1252         (setq x-last-selected-text-clipboard nil)
1253       (setq clip-text (x-selection-value 'CLIPBOARD))
1254       (if (string= clip-text "") (setq clip-text nil))
1255
1256       ;; Check the CLIPBOARD selection for 'newness', is it different
1257       ;; from what we remebered them to be last time we did a
1258       ;; cut/paste operation.
1259       (setq clip-text
1260             (cond;; check clipboard
1261              ((or (not clip-text) (string= clip-text ""))
1262               (setq x-last-selected-text-clipboard nil))
1263              ((eq      clip-text x-last-selected-text-clipboard) nil)
1264              ((string= clip-text x-last-selected-text-clipboard)
1265               ;; Record the newer string,
1266               ;; so subsequent calls can use the `eq' test.
1267               (setq x-last-selected-text-clipboard clip-text)
1268               nil)
1269              (t
1270               (setq x-last-selected-text-clipboard clip-text))))
1271       )
1272
1273     (setq primary-text (x-selection-value 'PRIMARY))
1274     ;; Check the PRIMARY selection for 'newness', is it different
1275     ;; from what we remebered them to be last time we did a
1276     ;; cut/paste operation.
1277     (setq primary-text
1278           (cond;; check primary selection
1279            ((or (not primary-text) (string= primary-text ""))
1280             (setq x-last-selected-text-primary nil))
1281            ((eq      primary-text x-last-selected-text-primary) nil)
1282            ((string= primary-text x-last-selected-text-primary)
1283             ;; Record the newer string,
1284             ;; so subsequent calls can use the `eq' test.
1285             (setq x-last-selected-text-primary primary-text)
1286             nil)
1287            (t
1288             (setq x-last-selected-text-primary primary-text))))
1289
1290     ;; As we have done one selection, clear this now.
1291     (setq next-selection-coding-system nil)
1292
1293     ;; At this point we have recorded the current values for the
1294     ;; selection from clipboard (if we are supposed to) and primary,
1295     ;; So return the first one that has changed (which is the first
1296     ;; non-null one).
1297     (or clip-text primary-text)
1298     ))
1299
1300 (put 'CLIPBOARD 'mac-scrap-name "com.apple.scrap.clipboard")
1301 (when (eq system-type 'darwin)
1302   (put 'FIND 'mac-scrap-name "com.apple.scrap.find")
1303   (put 'PRIMARY 'mac-scrap-name
1304        (format "org.gnu.Emacs.%d.selection.PRIMARY" (emacs-pid))))
1305 (put 'com.apple.traditional-mac-plain-text 'mac-ostype "TEXT")
1306 (put 'public.utf16-plain-text 'mac-ostype "utxt")
1307 (put 'public.tiff 'mac-ostype "TIFF")
1308 (put 'public.file-url 'mac-ostype "furl")
1309
1310 (defun mac-select-convert-to-string (selection type value)
1311   (let ((str (cdr (xselect-convert-to-string selection nil value)))
1312         coding)
1313     (setq coding (or next-selection-coding-system selection-coding-system))
1314     (if coding
1315         (setq coding (coding-system-base coding))
1316       (setq coding 'raw-text))
1317     (when str
1318       ;; If TYPE is nil, this is a local request, thus return STR as
1319       ;; is.  Otherwise, encode STR.
1320       (if (not type)
1321           str
1322         (let ((inhibit-read-only t))
1323           (remove-text-properties 0 (length str) '(composition nil) str)
1324           (cond
1325            ((eq type 'public.utf16-plain-text)
1326             (let (s)
1327               (when (and (fboundp 'mac-code-convert-string)
1328                          (memq coding (find-coding-systems-string str)))
1329                 (setq coding (coding-system-change-eol-conversion coding 'mac))
1330                 (setq s (mac-code-convert-string
1331                          (encode-coding-string str coding)
1332                          coding 'utf-16)))
1333               (setq str (or s (encode-coding-string str 'utf-16-mac)))))
1334            ((eq type 'com.apple.traditional-mac-plain-text)
1335             (let ((encodables (find-coding-systems-string str))
1336                   (rest mac-script-code-coding-systems))
1337               (unless (memq coding encodables)
1338                 (while (and rest (not (memq (cdar rest) encodables)))
1339                   (setq rest (cdr rest)))
1340                 (if rest
1341                     (setq coding (cdar rest)))))
1342             (setq coding (coding-system-change-eol-conversion coding 'mac))
1343             (setq str (encode-coding-string str coding)))
1344            (t
1345             (error "Unknown selection type: %S" type))
1346            )))
1347
1348       (setq next-selection-coding-system nil)
1349       (cons type str))))
1350
1351 (defun mac-select-convert-to-file-url (selection type value)
1352   (let ((filename (xselect-convert-to-filename selection type value))
1353         (coding (or file-name-coding-system default-file-name-coding-system)))
1354     (if (and filename coding)
1355         (setq filename (encode-coding-string filename coding)))
1356     (and filename
1357          (concat "file://localhost"
1358                  (mapconcat 'url-hexify-string
1359                             (split-string filename "/") "/")))))
1360
1361 (setq selection-converter-alist
1362       (nconc
1363        '((public.utf16-plain-text . mac-select-convert-to-string)
1364          (com.apple.traditional-mac-plain-text . mac-select-convert-to-string)
1365          ;; This is not enabled by default because the `Import Image'
1366          ;; menu makes Emacs crash or hang for unknown reasons.
1367          ;; (public.tiff . nil)
1368          (public.file-url . mac-select-convert-to-file-url)
1369          )
1370        selection-converter-alist))
1371
1372 (defun mac-services-open-file ()
1373   (interactive)
1374   (find-file-existing (x-selection-value mac-services-selection)))
1375
1376 (defun mac-services-open-selection ()
1377   (interactive)
1378   (switch-to-buffer (generate-new-buffer "*untitled*"))
1379   (insert (x-selection-value mac-services-selection))
1380   (sit-for 0)
1381   (save-buffer) ; It pops up the save dialog.
1382   )
1383
1384 (defun mac-services-mail-selection ()
1385   (interactive)
1386   (compose-mail)
1387   (rfc822-goto-eoh)
1388   (forward-line 1)
1389   (insert (x-selection-value mac-services-selection) "\n"))
1390
1391 (defun mac-services-mail-to ()
1392   (interactive)
1393   (compose-mail (x-selection-value mac-services-selection)))
1394
1395 (defun mac-services-insert-text ()
1396   (interactive)
1397   (let ((text (x-selection-value mac-services-selection)))
1398     (if (not buffer-read-only)
1399         (insert text)
1400       (kill-new text)
1401       (message
1402        (substitute-command-keys
1403         "The text from the Services menu can be accessed with \\[yank]")))))
1404
1405 (defvar mac-application-menu-map (make-sparse-keymap))
1406 (define-key mac-application-menu-map [quit] 'save-buffers-kill-emacs)
1407 (define-key mac-application-menu-map [services perform open-file]
1408   'mac-services-open-file)
1409 (define-key mac-application-menu-map [services perform open-selection]
1410   'mac-services-open-selection)
1411 (define-key mac-application-menu-map [services perform mail-selection]
1412   'mac-services-mail-selection)
1413 (define-key mac-application-menu-map [services perform mail-to]
1414   'mac-services-mail-to)
1415 (define-key mac-application-menu-map [services paste]
1416   'mac-services-insert-text)
1417 (define-key mac-application-menu-map [preferences] 'customize)
1418 (define-key mac-application-menu-map [about] 'display-splash-screen)
1419 (global-set-key [menu-bar application] mac-application-menu-map)
1420 \f
1421 ;;; Do the actual Windows setup here; the above code just defines
1422 ;;; functions and variables that we use now.
1423
1424 (setq command-line-args (x-handle-args command-line-args))
1425
1426 ;;; Make sure we have a valid resource name.
1427 (or (stringp x-resource-name)
1428     (let (i)
1429       (setq x-resource-name (invocation-name))
1430
1431       ;; Change any . or * characters in x-resource-name to hyphens,
1432       ;; so as not to choke when we use it in X resource queries.
1433       (while (setq i (string-match "[.*]" x-resource-name))
1434         (aset x-resource-name i ?-))))
1435
1436 (if (x-display-list)
1437     ;; On Mac OS 8/9, Most coding systems used in code conversion for
1438     ;; font names are not ready at the time when the terminal frame is
1439     ;; created.  So we reconstruct font name table for the initial
1440     ;; frame.
1441     (mac-clear-font-name-table)
1442   (x-open-connection "Mac"
1443                      x-command-line-resources
1444                      ;; Exit Emacs with fatal error if this fails.
1445                      t))
1446
1447 (setq frame-creation-function 'x-create-frame-with-faces)
1448
1449 (cp-make-coding-system
1450  mac-centraleurroman
1451  [?\\e,AD\e(B ?\\e$,1  \e(B ?\\e$,1 !\e(B ?\\e,AI\e(B ?\\e$,1 $\e(B ?\\e,AV\e(B ?\\e,A\\e(B ?\\e,Aa\e(B ?\\e$,1 %\e(B ?\\e$,1 ,\e(B ?\\e,Ad\e(B ?\\e$,1 -\e(B ?\\e$,1 &\e(B ?\\e$,1 '\e(B ?\\e,Ai\e(B ?\\e$,1!9\e(B
1452   ?\\e$,1!:\e(B ?\\e$,1 .\e(B ?\\e,Am\e(B ?\\e$,1 /\e(B ?\\e$,1 2\e(B ?\\e$,1 3\e(B ?\\e$,1 6\e(B ?\\e,As\e(B ?\\e$,1 7\e(B ?\\e,At\e(B ?\\e,Av\e(B ?\\e,Au\e(B ?\\e,Az\e(B ?\\e$,1 :\e(B ?\\e$,1 ;\e(B ?\\e,A|\e(B
1453   ?\\e$,1s \e(B ?\\e,A0\e(B ?\\e$,1 8\e(B ?\\e,A#\e(B ?\\e,A'\e(B ?\\e$,1s"\e(B ?\\e,A6\e(B ?\\e,A_\e(B ?\\e,A.\e(B ?\\e,A)\e(B ?\\e$,1ub\e(B ?\\e$,1 9\e(B ?\\e,A(\e(B ?\\e$,1y \e(B ?\\e$,1 C\e(B ?\\e$,1 N\e(B
1454   ?\\e$,1 O\e(B ?\\e$,1 J\e(B ?\\e$,1y$\e(B ?\\e$,1y%\e(B ?\\e$,1 K\e(B ?\\e$,1 V\e(B ?\\e$,1x"\e(B ?\\e$,1x1\e(B ?\\e$,1 b\e(B ?\\e$,1 [\e(B ?\\e$,1 \\e(B ?\\e$,1 ]\e(B ?\\e$,1 ^\e(B ?\\e$,1 Y\e(B ?\\e$,1 Z\e(B ?\\e$,1 e\e(B
1455   ?\\e$,1 f\e(B ?\\e$,1 c\e(B ?\\e,A,\e(B ?\\e$,1x:\e(B ?\\e$,1 d\e(B ?\\e$,1 g\e(B ?\\e$,1x&\e(B ?\\e,A+\e(B ?\\e,A;\e(B ?\\e$,1s&\e(B ?\\e,A \e(B ?\\e$,1 h\e(B ?\\e$,1 p\e(B ?\\e,AU\e(B ?\\e$,1 q\e(B ?\\e$,1 l\e(B
1456   ?\\e$,1rs\e(B ?\\e$,1rt\e(B ?\\e$,1r|\e(B ?\\e$,1r}\e(B ?\\e$,1rx\e(B ?\\e$,1ry\e(B ?\\e,Aw\e(B ?\\e$,2"*\e(B ?\\e$,1 m\e(B ?\\e$,1 t\e(B ?\\e$,1 u\e(B ?\\e$,1 x\e(B ?\\e$,1s9\e(B ?\\e$,1s:\e(B ?\\e$,1 y\e(B ?\\e$,1 v\e(B
1457   ?\\e$,1 w\e(B ?\\e$,1! \e(B ?\\e$,1rz\e(B ?\\e$,1r~\e(B ?\\e$,1!!\e(B ?\\e$,1 z\e(B ?\\e$,1 {\e(B ?\\e,AA\e(B ?\\e$,1!$\e(B ?\\e$,1!%\e(B ?\\e,AM\e(B ?\\e$,1!=\e(B ?\\e$,1!>\e(B ?\\e$,1!*\e(B ?\\e,AS\e(B ?\\e,AT\e(B
1458   ?\\e$,1!+\e(B ?\\e$,1!.\e(B ?\\e,AZ\e(B ?\\e$,1!/\e(B ?\\e$,1!0\e(B ?\\e$,1!1\e(B ?\\e$,1!2\e(B ?\\e$,1!3\e(B ?\\e,A]\e(B ?\\e,A}\e(B ?\\e$,1 W\e(B ?\\e$,1!;\e(B ?\\e$,1 a\e(B ?\\e$,1!<\e(B ?\\e$,1 B\e(B ?\\e$,1$g\e(B]
1459  "Mac Central European Roman Encoding (MIME:x-mac-centraleurroman).")
1460 (coding-system-put 'mac-centraleurroman 'mime-charset 'x-mac-centraleurroman)
1461
1462 (cp-make-coding-system
1463  mac-cyrillic
1464  [?\\e$,1(0\e(B ?\\e$,1(1\e(B ?\\e$,1(2\e(B ?\\e$,1(3\e(B ?\\e$,1(4\e(B ?\\e$,1(5\e(B ?\\e$,1(6\e(B ?\\e$,1(7\e(B ?\\e$,1(8\e(B ?\\e$,1(9\e(B ?\\e$,1(:\e(B ?\\e$,1(;\e(B ?\\e$,1(<\e(B ?\\e$,1(=\e(B ?\\e$,1(>\e(B ?\\e$,1(?\e(B
1465   ?\\e$,1(@\e(B ?\\e$,1(A\e(B ?\\e$,1(B\e(B ?\\e$,1(C\e(B ?\\e$,1(D\e(B ?\\e$,1(E\e(B ?\\e$,1(F\e(B ?\\e$,1(G\e(B ?\\e$,1(H\e(B ?\\e$,1(I\e(B ?\\e$,1(J\e(B ?\\e$,1(K\e(B ?\\e$,1(L\e(B ?\\e$,1(M\e(B ?\\e$,1(N\e(B ?\\e$,1(O\e(B
1466   ?\\e$,1s \e(B ?\\e,A0\e(B ?\\e$,1)P\e(B ?\\e,A#\e(B ?\\e,A'\e(B ?\\e$,1s"\e(B ?\\e,A6\e(B ?\\e$,1(&\e(B ?\\e,A.\e(B ?\\e,A)\e(B ?\\e$,1ub\e(B ?\\e$,1("\e(B ?\\e$,1(r\e(B ?\\e$,1y \e(B ?\\e$,1(#\e(B ?\\e$,1(s\e(B
1467   ?\\e$,1x>\e(B ?\\e,A1\e(B ?\\e$,1y$\e(B ?\\e$,1y%\e(B ?\\e$,1(v\e(B ?\\e,A5\e(B ?\\e$,1)Q\e(B ?\\e$,1((\e(B ?\\e$,1($\e(B ?\\e$,1(t\e(B ?\\e$,1('\e(B ?\\e$,1(w\e(B ?\\e$,1()\e(B ?\\e$,1(y\e(B ?\\e$,1(*\e(B ?\\e$,1(z\e(B
1468   ?\\e$,1(x\e(B ?\\e$,1(%\e(B ?\\e,A,\e(B ?\\e$,1x:\e(B ?\\e$,1!R\e(B ?\\e$,1xh\e(B ?\\e$,1x&\e(B ?\\e,A+\e(B ?\\e,A;\e(B ?\\e$,1s&\e(B ?\\e,A \e(B ?\\e$,1(+\e(B ?\\e$,1({\e(B ?\\e$,1(,\e(B ?\\e$,1(|\e(B ?\\e$,1(u\e(B
1469   ?\\e$,1rs\e(B ?\\e$,1rt\e(B ?\\e$,1r|\e(B ?\\e$,1r}\e(B ?\\e$,1rx\e(B ?\\e$,1ry\e(B ?\\e,Aw\e(B ?\\e$,1r~\e(B ?\\e$,1(.\e(B ?\\e$,1(~\e(B ?\\e$,1(/\e(B ?\\e$,1(\7f\e(B ?\\e$,1uV\e(B ?\\e$,1(!\e(B ?\\e$,1(q\e(B ?\\e$,1(o\e(B
1470   ?\\e$,1(P\e(B ?\\e$,1(Q\e(B ?\\e$,1(R\e(B ?\\e$,1(S\e(B ?\\e$,1(T\e(B ?\\e$,1(U\e(B ?\\e$,1(V\e(B ?\\e$,1(W\e(B ?\\e$,1(X\e(B ?\\e$,1(Y\e(B ?\\e$,1(Z\e(B ?\\e$,1([\e(B ?\\e$,1(\\e(B ?\\e$,1(]\e(B ?\\e$,1(^\e(B ?\\e$,1(_\e(B
1471   ?\\e$,1(`\e(B ?\\e$,1(a\e(B ?\\e$,1(b\e(B ?\\e$,1(c\e(B ?\\e$,1(d\e(B ?\\e$,1(e\e(B ?\\e$,1(f\e(B ?\\e$,1(g\e(B ?\\e$,1(h\e(B ?\\e$,1(i\e(B ?\\e$,1(j\e(B ?\\e$,1(k\e(B ?\\e$,1(l\e(B ?\\e$,1(m\e(B ?\\e$,1(n\e(B ?\\e$,1tL\e(B]
1472  "Mac Cyrillic Encoding (MIME:x-mac-cyrillic).")
1473 (coding-system-put 'mac-cyrillic 'mime-charset 'x-mac-cyrillic)
1474
1475 (let
1476     ((encoding-vector
1477       (vconcat
1478        (make-vector 32 nil)
1479        ;; mac-symbol (32..126) -> emacs-mule mapping
1480        [?\  ?\! ?\\e$,1x \e(B ?\# ?\\e$,1x#\e(B ?\% ?\& ?\\e$,1x-\e(B ?\( ?\) ?\\e$,1x7\e(B ?\+ ?\, ?\\e$,1x2\e(B ?\. ?\/
1481         ?\0 ?\1 ?\2 ?\3 ?\4 ?\5 ?\6 ?\7 ?\8 ?\9 ?\: ?\; ?\< ?\= ?\> ?\?
1482         ?\\e$,1xe\e(B ?\\e$,1&q\e(B ?\\e$,1&r\e(B ?\\e$,1''\e(B ?\\e$,1&t\e(B ?\\e$,1&u\e(B ?\\e$,1'&\e(B ?\\e$,1&s\e(B ?\\e$,1&w\e(B ?\\e$,1&y\e(B ?\\e$,1'Q\e(B ?\\e$,1&z\e(B ?\\e$,1&{\e(B ?\\e$,1&|\e(B ?\\e$,1&}\e(B ?\\e$,1&\7f\e(B
1483         ?\\e$,1' \e(B ?\\e$,1&x\e(B ?\\e$,1'!\e(B ?\\e$,1'#\e(B ?\\e$,1'$\e(B ?\\e$,1'%\e(B ?\\e$,1'B\e(B ?\\e$,1')\e(B ?\\e$,1&~\e(B ?\\e$,1'(\e(B ?\\e$,1&v\e(B ?\[ ?\\e$,1xT\e(B ?\] ?\\e$,1ye\e(B ?\_
1484         ?\\e$,3bE\e(B ?\\e$,1'1\e(B ?\\e$,1'2\e(B ?\\e$,1'G\e(B ?\\e$,1'4\e(B ?\\e$,1'5\e(B ?\\e$,1'F\e(B ?\\e$,1'3\e(B ?\\e$,1'7\e(B ?\\e$,1'9\e(B ?\\e$,1'U\e(B ?\\e$,1':\e(B ?\\e$,1';\e(B ?\\e$,1'<\e(B ?\\e$,1'=\e(B ?\\e$,1'?\e(B
1485         ?\\e$,1'@\e(B ?\\e$,1'8\e(B ?\\e$,1'A\e(B ?\\e$,1'C\e(B ?\\e$,1'D\e(B ?\\e$,1'E\e(B ?\\e$,1'V\e(B ?\\e$,1'I\e(B ?\\e$,1'>\e(B ?\\e$,1'H\e(B ?\\e$,1'6\e(B ?\{ ?\| ?\} ?\\e$,1x\\e(B]
1486        (make-vector (- 160 127) nil)
1487        ;; mac-symbol (160..254) -> emacs-mule mapping
1488        ;; Mapping of the following characters are changed from the
1489        ;; original one:
1490        ;; 0xE2  0x00AE+0xF87F -> 0x00AE # REGISTERED SIGN, alternate: sans serif
1491        ;; 0xE3  0x00A9+0xF87F -> 0x00A9 # COPYRIGHT SIGN, alternate: sans serif
1492        ;; 0xE4  0x2122+0xF87F -> 0x2122 # TRADE MARK SIGN, alternate: sans serif
1493        [?\\e$,1tL\e(B ?\\e$,1'R\e(B ?\\e$,1s2\e(B ?\\e$,1y$\e(B ?\\e$,1sD\e(B ?\\e$,1x>\e(B ?\\e$,1!R\e(B ?\\e$,2#c\e(B ?\\e$,2#f\e(B ?\\e$,2#e\e(B ?\\e$,2#`\e(B ?\\e$,1vt\e(B ?\\e$,1vp\e(B ?\\e$,1vq\e(B ?\\e$,1vr\e(B ?\\e$,1vs\e(B
1494         ?\\e,A0\e(B ?\\e,A1\e(B ?\\e$,1s3\e(B ?\\e$,1y%\e(B ?\\e,AW\e(B ?\\e$,1x=\e(B ?\\e$,1x"\e(B ?\\e$,1s"\e(B ?\\e,Aw\e(B ?\\e$,1y \e(B ?\\e$,1y!\e(B ?\\e$,1xh\e(B ?\\e$,1s&\e(B ?\\e$,1|p\e(B ?\\e$,1|O\e(B ?\\e$,1w5\e(B
1495         ?\\e$,1uu\e(B ?\\e$,1uQ\e(B ?\\e$,1u\\e(B ?\\e$,1uX\e(B ?\\e$,1yW\e(B ?\\e$,1yU\e(B ?\\e$,1x%\e(B ?\\e$,1xI\e(B ?\\e$,1xJ\e(B ?\\e$,1yC\e(B ?\\e$,1yG\e(B ?\\e$,1yD\e(B ?\\e$,1yB\e(B ?\\e$,1yF\e(B ?\\e$,1x(\e(B ?\\e$,1x)\e(B
1496         ?\\e$,1x@\e(B ?\\e$,1x'\e(B ?\\e,A.\e(B ?\\e,A)\e(B ?\\e$,1ub\e(B ?\\e$,1x/\e(B ?\\e$,1x:\e(B ?\\e$,1z%\e(B ?\\e,A,\e(B ?\\e$,1xG\e(B ?\\e$,1xH\e(B ?\\e$,1wT\e(B ?\\e$,1wP\e(B ?\\e$,1wQ\e(B ?\\e$,1wR\e(B ?\\e$,1wS\e(B
1497         ?\\e$,2"*\e(B ?\\e$,2=H\e(B ?\\e,A.\e(B ?\\e,A)\e(B ?\\e$,1ub\e(B ?\\e$,1x1\e(B ?\\e$,1|;\e(B ?\\e$,1|<\e(B ?\\e$,1|=\e(B ?\\e$,1|A\e(B ?\\e$,1|B\e(B ?\\e$,1|C\e(B ?\\e$,1|G\e(B ?\\e$,1|H\e(B ?\\e$,1|I\e(B ?\\e$,1|J\e(B
1498         ?\\e$,3b_\e(B ?\\e$,2=I\e(B ?\\e$,1xK\e(B ?\\e$,1{ \e(B ?\\e$,1|N\e(B ?\\e$,1{!\e(B ?\\e$,1|>\e(B ?\\e$,1|?\e(B ?\\e$,1|@\e(B ?\\e$,1|D\e(B ?\\e$,1|E\e(B ?\\e$,1|F\e(B ?\\e$,1|K\e(B ?\\e$,1|L\e(B ?\\e$,1|M\e(B
1499         nil]))
1500      translation-table)
1501   (setq translation-table
1502         (make-translation-table-from-vector encoding-vector))
1503 ;;  (define-translation-table 'mac-symbol-decoder translation-table)
1504   (define-translation-table 'mac-symbol-encoder
1505     (char-table-extra-slot translation-table 0)))
1506
1507 (let
1508     ((encoding-vector
1509       (vconcat
1510        (make-vector 32 nil)
1511        ;; mac-dingbats (32..126) -> emacs-mule mapping
1512        [?\  ?\\e$,2%A\e(B ?\\e$,2%B\e(B ?\\e$,2%C\e(B ?\\e$,2%D\e(B ?\\e$,2"n\e(B ?\\e$,2%F\e(B ?\\e$,2%G\e(B ?\\e$,2%H\e(B ?\\e$,2%I\e(B ?\\e$,2"{\e(B ?\\e$,2"~\e(B ?\\e$,2%L\e(B ?\\e$,2%M\e(B ?\\e$,2%N\e(B ?\\e$,2%O\e(B
1513         ?\\e$,2%P\e(B ?\\e$,2%Q\e(B ?\\e$,2%R\e(B ?\\e$,2%S\e(B ?\\e$,2%T\e(B ?\\e$,2%U\e(B ?\\e$,2%V\e(B ?\\e$,2%W\e(B ?\\e$,2%X\e(B ?\\e$,2%Y\e(B ?\\e$,2%Z\e(B ?\\e$,2%[\e(B ?\\e$,2%\\e(B ?\\e$,2%]\e(B ?\\e$,2%^\e(B ?\\e$,2%_\e(B
1514         ?\\e$,2%`\e(B ?\\e$,2%a\e(B ?\\e$,2%b\e(B ?\\e$,2%c\e(B ?\\e$,2%d\e(B ?\\e$,2%e\e(B ?\\e$,2%f\e(B ?\\e$,2%g\e(B ?\\e$,2"e\e(B ?\\e$,2%i\e(B ?\\e$,2%j\e(B ?\\e$,2%k\e(B ?\\e$,2%l\e(B ?\\e$,2%m\e(B ?\\e$,2%n\e(B ?\\e$,2%o\e(B
1515         ?\\e$,2%p\e(B ?\\e$,2%q\e(B ?\\e$,2%r\e(B ?\\e$,2%s\e(B ?\\e$,2%t\e(B ?\\e$,2%u\e(B ?\\e$,2%v\e(B ?\\e$,2%w\e(B ?\\e$,2%x\e(B ?\\e$,2%y\e(B ?\\e$,2%z\e(B ?\\e$,2%{\e(B ?\\e$,2%|\e(B ?\\e$,2%}\e(B ?\\e$,2%~\e(B ?\\e$,2%\7f\e(B
1516         ?\\e$,2& \e(B ?\\e$,2&!\e(B ?\\e$,2&"\e(B ?\\e$,2&#\e(B ?\\e$,2&$\e(B ?\\e$,2&%\e(B ?\\e$,2&&\e(B ?\\e$,2&'\e(B ?\\e$,2&(\e(B ?\\e$,2&)\e(B ?\\e$,2&*\e(B ?\\e$,2&+\e(B ?\\e$,2"/\e(B ?\\e$,2&-\e(B ?\\e$,2!`\e(B ?\\e$,2&/\e(B
1517         ?\\e$,2&0\e(B ?\\e$,2&1\e(B ?\\e$,2&2\e(B ?\\e$,2!r\e(B ?\\e$,2!|\e(B ?\\e$,2"&\e(B ?\\e$,2&6\e(B ?\\e$,2"7\e(B ?\\e$,2&8\e(B ?\\e$,2&9\e(B ?\\e$,2&:\e(B ?\\e$,2&;\e(B ?\\e$,2&<\e(B ?\\e$,2&=\e(B ?\\e$,2&>\e(B
1518        nil
1519        ;; mac-dingbats (128..141) -> emacs-mule mapping
1520        ?\\e$,2&H\e(B ?\\e$,2&I\e(B ?\\e$,2&J\e(B ?\\e$,2&K\e(B ?\\e$,2&L\e(B ?\\e$,2&M\e(B ?\\e$,2&N\e(B ?\\e$,2&O\e(B ?\\e$,2&P\e(B ?\\e$,2&Q\e(B ?\\e$,2&R\e(B ?\\e$,2&S\e(B ?\\e$,2&T\e(B ?\\e$,2&U\e(B]
1521        (make-vector (- 161 142) nil)
1522        ;; mac-dingbats (161..239) -> emacs-mule mapping
1523        [?\\e$,2&A\e(B ?\\e$,2&B\e(B ?\\e$,2&C\e(B ?\\e$,2&D\e(B ?\\e$,2&E\e(B ?\\e$,2&F\e(B ?\\e$,2&G\e(B ?\\e$,2#c\e(B ?\\e$,2#f\e(B ?\\e$,2#e\e(B ?\\e$,2#`\e(B ?\\e$,1~@\e(B ?\\e$,1~A\e(B ?\\e$,1~B\e(B ?\\e$,1~C\e(B
1524         ?\\e$,1~D\e(B ?\\e$,1~E\e(B ?\\e$,1~F\e(B ?\\e$,1~G\e(B ?\\e$,1~H\e(B ?\\e$,1~I\e(B ?\\e$,2&V\e(B ?\\e$,2&W\e(B ?\\e$,2&X\e(B ?\\e$,2&Y\e(B ?\\e$,2&Z\e(B ?\\e$,2&[\e(B ?\\e$,2&\\e(B ?\\e$,2&]\e(B ?\\e$,2&^\e(B ?\\e$,2&_\e(B
1525         ?\\e$,2&`\e(B ?\\e$,2&a\e(B ?\\e$,2&b\e(B ?\\e$,2&c\e(B ?\\e$,2&d\e(B ?\\e$,2&e\e(B ?\\e$,2&f\e(B ?\\e$,2&g\e(B ?\\e$,2&h\e(B ?\\e$,2&i\e(B ?\\e$,2&j\e(B ?\\e$,2&k\e(B ?\\e$,2&l\e(B ?\\e$,2&m\e(B ?\\e$,2&n\e(B ?\\e$,2&o\e(B
1526         ?\\e$,2&p\e(B ?\\e$,2&q\e(B ?\\e$,2&r\e(B ?\\e$,2&s\e(B ?\\e$,2&t\e(B ?\\e$,1vr\e(B ?\\e$,1vt\e(B ?\\e$,1vu\e(B ?\\e$,2&x\e(B ?\\e$,2&y\e(B ?\\e$,2&z\e(B ?\\e$,2&{\e(B ?\\e$,2&|\e(B ?\\e$,2&}\e(B ?\\e$,2&~\e(B ?\\e$,2&\7f\e(B
1527         ?\\e$,2' \e(B ?\\e$,2'!\e(B ?\\e$,2'"\e(B ?\\e$,2'#\e(B ?\\e$,2'$\e(B ?\\e$,2'%\e(B ?\\e$,2'&\e(B ?\\e$,2''\e(B ?\\e$,2'(\e(B ?\\e$,2')\e(B ?\\e$,2'*\e(B ?\\e$,2'+\e(B ?\\e$,2',\e(B ?\\e$,2'-\e(B ?\\e$,2'.\e(B ?\\e$,2'/\e(B
1528         nil
1529        ;; mac-dingbats (241..254) -> emacs-mule mapping
1530         ?\\e$,2'1\e(B ?\\e$,2'2\e(B ?\\e$,2'3\e(B ?\\e$,2'4\e(B ?\\e$,2'5\e(B ?\\e$,2'6\e(B ?\\e$,2'7\e(B ?\\e$,2'8\e(B ?\\e$,2'9\e(B ?\\e$,2':\e(B ?\\e$,2';\e(B ?\\e$,2'<\e(B ?\\e$,2'=\e(B ?\\e$,2'>\e(B
1531         nil]))
1532      translation-table)
1533   (setq translation-table
1534         (make-translation-table-from-vector encoding-vector))
1535 ;;  (define-translation-table 'mac-dingbats-decoder translation-table)
1536   (define-translation-table 'mac-dingbats-encoder
1537     (char-table-extra-slot translation-table 0)))
1538
1539 (defvar mac-font-encoder-list
1540   '(("mac-roman" mac-roman-encoder
1541      ccl-encode-mac-roman-font "%s")
1542     ("mac-centraleurroman" encode-mac-centraleurroman
1543      ccl-encode-mac-centraleurroman-font "%s ce")
1544     ("mac-cyrillic" encode-mac-cyrillic
1545      ccl-encode-mac-cyrillic-font "%s cy")
1546     ("mac-symbol" mac-symbol-encoder
1547      ccl-encode-mac-symbol-font "symbol")
1548     ("mac-dingbats" mac-dingbats-encoder
1549      ccl-encode-mac-dingbats-font "zapf dingbats")))
1550
1551 (let ((encoder-list
1552        (mapcar (lambda (lst) (nth 1 lst)) mac-font-encoder-list))
1553       (charset-list
1554        '(latin-iso8859-2
1555          latin-iso8859-3 latin-iso8859-4
1556          cyrillic-iso8859-5 greek-iso8859-7 hebrew-iso8859-8
1557          latin-iso8859-9 latin-iso8859-14 latin-iso8859-15)))
1558   (dolist (encoder encoder-list)
1559     (let ((table (get encoder 'translation-table)))
1560       (dolist (charset charset-list)
1561         (dotimes (i 96)
1562           (let* ((c (make-char charset (+ i 32)))
1563                  (mu (aref ucs-mule-to-mule-unicode c))
1564                  (mac-encoded (and mu (aref table mu))))
1565             (if mac-encoded
1566                 (aset table c mac-encoded))))))))
1567
1568 ;; We assume none of official dim2 charsets (0x90..0x99) are encoded
1569 ;; to these fonts.
1570
1571 (define-ccl-program ccl-encode-mac-roman-font
1572   `(0
1573     (if (r0 <= ?\xef)
1574         (translate-character mac-roman-encoder r0 r1)
1575       ((r1 <<= 7)
1576        (r1 |= r2)
1577        (translate-character mac-roman-encoder r0 r1))))
1578   "CCL program for Mac Roman font")
1579
1580 (define-ccl-program ccl-encode-mac-centraleurroman-font
1581   `(0
1582     (if (r0 <= ?\xef)
1583         (translate-character encode-mac-centraleurroman r0 r1)
1584       ((r1 <<= 7)
1585        (r1 |= r2)
1586        (translate-character encode-mac-centraleurroman r0 r1))))
1587   "CCL program for Mac Central European Roman font")
1588
1589 (define-ccl-program ccl-encode-mac-cyrillic-font
1590   `(0
1591     (if (r0 <= ?\xef)
1592         (translate-character encode-mac-cyrillic r0 r1)
1593       ((r1 <<= 7)
1594        (r1 |= r2)
1595        (translate-character encode-mac-cyrillic r0 r1))))
1596   "CCL program for Mac Cyrillic font")
1597
1598 (define-ccl-program ccl-encode-mac-symbol-font
1599   `(0
1600     (if (r0 <= ?\xef)
1601         (translate-character mac-symbol-encoder r0 r1)
1602       ((r1 <<= 7)
1603        (r1 |= r2)
1604        (translate-character mac-symbol-encoder r0 r1))))
1605   "CCL program for Mac Symbol font")
1606
1607 (define-ccl-program ccl-encode-mac-dingbats-font
1608   `(0
1609     (if (r0 <= ?\xef)
1610         (translate-character mac-dingbats-encoder r0 r1)
1611       ((r1 <<= 7)
1612        (r1 |= r2)
1613        (translate-character mac-dingbats-encoder r0 r1))))
1614   "CCL program for Mac Dingbats font")
1615
1616
1617 (setq font-ccl-encoder-alist
1618       (nconc
1619        (mapcar (lambda (lst) (cons (nth 0 lst) (nth 2 lst)))
1620                mac-font-encoder-list)
1621        font-ccl-encoder-alist))
1622
1623 (defconst mac-char-fontspec-list
1624   ;; Directly operate on a char-table instead of a fontset so that it
1625   ;; may not create a dummy fontset.
1626   (let ((template (make-char-table 'fontset)))
1627     (dolist
1628         (font-encoder
1629          (nreverse
1630           (mapcar (lambda (lst)
1631                     (cons (cons (nth 3 lst) (nth 0 lst)) (nth 1 lst)))
1632                   mac-font-encoder-list)))
1633       (let ((font (car font-encoder))
1634             (encoder (cdr font-encoder)))
1635         (map-char-table
1636          (lambda (key val)
1637            (or (null val)
1638                (generic-char-p key)
1639                (memq (char-charset key)
1640                      '(ascii eight-bit-control eight-bit-graphic))
1641                (aset template key font)))
1642          (get encoder 'translation-table))))
1643
1644     ;; Like fontset-info, but extend a range only if its "to" part is
1645     ;; the predecessor of the current char.
1646     (let* ((last '((0 nil)))
1647            (accumulator last)
1648            last-char-or-range last-char last-elt)
1649       (map-char-table
1650        (lambda (char elt)
1651          (when elt
1652            (setq last-char-or-range (car (car last))
1653                  last-char (if (consp last-char-or-range)
1654                                (cdr last-char-or-range)
1655                              last-char-or-range)
1656                  last-elt (cdr (car last)))
1657            (if (and (eq elt last-elt)
1658                     (= char (1+ last-char))
1659                     (eq (char-charset char) (char-charset last-char)))
1660                (if (consp last-char-or-range)
1661                    (setcdr last-char-or-range char)
1662                  (setcar (car last) (cons last-char char)))
1663              (setcdr last (list (cons char elt)))
1664              (setq last (cdr last)))))
1665        template)
1666       (cdr accumulator))))
1667
1668 (defun fontset-add-mac-fonts (fontset &optional base-family)
1669   "Add font-specs for Mac fonts to FONTSET.
1670 The added font-specs are determined by BASE-FAMILY and the value
1671 of `mac-char-fontspec-list', which is a list
1672 of (CHARACTER-OR-RANGE . (FAMILY-FORMAT . REGISTRY)).  If
1673 BASE-FAMILY is nil, the font family in the added font-specs is
1674 also nil.  If BASE-FAMILY is a string, `%s' in FAMILY-FORMAT is
1675 replaced with the string.  Otherwise, `%s' in FAMILY-FORMAT is
1676 replaced with the ASCII font family name in FONTSET."
1677   (if base-family
1678       (if (stringp base-family)
1679           (setq base-family (downcase base-family))
1680         (let ((ascii-font (fontset-font fontset (charset-id 'ascii))))
1681           (if ascii-font
1682               (setq base-family
1683                     (aref (x-decompose-font-name
1684                            (downcase (x-resolve-font-name ascii-font)))
1685                           xlfd-regexp-family-subnum))))))
1686   (let (fontspec-cache fontspec)
1687     (dolist (char-fontspec mac-char-fontspec-list)
1688       (setq fontspec (cdr (assq (cdr char-fontspec) fontspec-cache)))
1689       (when (null fontspec)
1690         (setq fontspec
1691               (cons (and base-family
1692                          (format (car (cdr char-fontspec)) base-family))
1693                     (cdr (cdr char-fontspec))))
1694         (setq fontspec-cache (cons (cons (cdr char-fontspec) fontspec)
1695                                    fontspec-cache)))
1696       (set-fontset-font fontset (car char-fontspec) fontspec))))
1697
1698 (defun create-fontset-from-mac-roman-font (font &optional resolved-font
1699                                                 fontset-name)
1700   "Create a fontset from a Mac roman font FONT.
1701
1702 Optional 1st arg RESOLVED-FONT is a resolved name of FONT.  If
1703 omitted, `x-resolve-font-name' is called to get the resolved name.  At
1704 this time, if FONT is not available, error is signaled.
1705
1706 Optional 2nd arg FONTSET-NAME is a string to be used in
1707 `<CHARSET_ENCODING>' fields of a new fontset name.  If it is omitted,
1708 an appropriate name is generated automatically.
1709
1710 It returns a name of the created fontset."
1711   (let ((fontset
1712          (create-fontset-from-ascii-font font resolved-font fontset-name)))
1713     (fontset-add-mac-fonts fontset t)
1714     fontset))
1715
1716 ;; Setup the default fontset.
1717 (setup-default-fontset)
1718 ;; Add Mac-encoding fonts unless ETL fonts are installed.
1719 (unless (x-list-fonts "*-iso8859-1")
1720   (fontset-add-mac-fonts "fontset-default"))
1721
1722 ;; Create a fontset that uses mac-roman font.  With this fontset,
1723 ;; characters decoded from mac-roman encoding (ascii, latin-iso8859-1,
1724 ;; and mule-unicode-xxxx-yyyy) are displayed by a mac-roman font.
1725 (create-fontset-from-fontset-spec
1726  "-etl-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-mac,
1727 ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman")
1728 (fontset-add-mac-fonts "fontset-mac" t)
1729
1730 ;; Create fontset specified in X resources "Fontset-N" (N is 0, 1, ...).
1731 (create-fontset-from-x-resource)
1732
1733 ;; Try to create a fontset from a font specification which comes
1734 ;; from initial-frame-alist, default-frame-alist, or X resource.
1735 ;; A font specification in command line argument (i.e. -fn XXXX)
1736 ;; should be already in default-frame-alist as a `font'
1737 ;; parameter.  However, any font specifications in site-start
1738 ;; library, user's init file (.emacs), and default.el are not
1739 ;; yet handled here.
1740
1741 (let ((font (or (cdr (assq 'font initial-frame-alist))
1742                 (cdr (assq 'font default-frame-alist))
1743                 (x-get-resource "font" "Font")))
1744       xlfd-fields resolved-name)
1745   (if (and font
1746            (not (query-fontset font))
1747            (setq resolved-name (x-resolve-font-name font))
1748            (setq xlfd-fields (x-decompose-font-name font)))
1749       (if (string= "fontset" (aref xlfd-fields xlfd-regexp-registry-subnum))
1750           (new-fontset font (x-complement-fontset-spec xlfd-fields nil))
1751         ;; Create a fontset from FONT.  The fontset name is
1752         ;; generated from FONT.
1753         (if (and (string= "mac" (aref xlfd-fields xlfd-regexp-registry-subnum))
1754                  (string= "roman" (aref xlfd-fields xlfd-regexp-encoding-subnum)))
1755             (create-fontset-from-mac-roman-font font resolved-name "startup")
1756           (create-fontset-from-ascii-font font resolved-name "startup")))))
1757
1758 ;; Apply a geometry resource to the initial frame.  Put it at the end
1759 ;; of the alist, so that anything specified on the command line takes
1760 ;; precedence.
1761 (let* ((res-geometry (x-get-resource "geometry" "Geometry"))
1762        parsed)
1763   (if res-geometry
1764       (progn
1765         (setq parsed (x-parse-geometry res-geometry))
1766         ;; If the resource specifies a position,
1767         ;; call the position and size "user-specified".
1768         (if (or (assq 'top parsed) (assq 'left parsed))
1769             (setq parsed (cons '(user-position . t)
1770                                (cons '(user-size . t) parsed))))
1771         ;; All geometry parms apply to the initial frame.
1772         (setq initial-frame-alist (append initial-frame-alist parsed))
1773         ;; The size parms apply to all frames.
1774         (if (assq 'height parsed)
1775             (setq default-frame-alist
1776                   (cons (cons 'height (cdr (assq 'height parsed)))
1777                         default-frame-alist)))
1778         (if (assq 'width parsed)
1779             (setq default-frame-alist
1780                   (cons (cons 'width (cdr (assq 'width parsed)))
1781                         default-frame-alist))))))
1782
1783 ;; Check the reverseVideo resource.
1784 (let ((case-fold-search t))
1785   (let ((rv (x-get-resource "reverseVideo" "ReverseVideo")))
1786     (if (and rv
1787              (string-match "^\\(true\\|yes\\|on\\)$" rv))
1788         (setq default-frame-alist
1789               (cons '(reverse . t) default-frame-alist)))))
1790
1791 (defun x-win-suspend-error ()
1792   (error "Suspending an Emacs running under Mac makes no sense"))
1793 (add-hook 'suspend-hook 'x-win-suspend-error)
1794
1795 ;;; Arrange for the kill and yank functions to set and check the clipboard.
1796 (setq interprogram-cut-function 'x-select-text)
1797 (setq interprogram-paste-function 'x-get-selection-value)
1798
1799 (defalias 'x-cut-buffer-or-selection-value 'x-get-selection-value)
1800
1801 ;;; Turn off window-splitting optimization; Mac is usually fast enough
1802 ;;; that this is only annoying.
1803 (setq split-window-keep-point t)
1804
1805 ;; Don't show the frame name; that's redundant.
1806 (setq-default mode-line-frame-identification "  ")
1807
1808 ;; Turn on support for mouse wheels.
1809 (mouse-wheel-mode 1)
1810
1811
1812 ;; Enable CLIPBOARD copy/paste through menu bar commands.
1813 (menu-bar-enable-clipboard)
1814
1815 (defun mac-drag-n-drop (event)
1816   "Edit the files listed in the drag-n-drop EVENT.
1817 Switch to a buffer editing the last file dropped."
1818   (interactive "e")
1819   ;; Make sure the drop target has positive co-ords
1820   ;; before setting the selected frame - otherwise it
1821   ;; won't work.  <skx@tardis.ed.ac.uk>
1822   (let* ((window (posn-window (event-start event)))
1823          (coords (posn-x-y (event-start event)))
1824          (x (car coords))
1825          (y (cdr coords)))
1826     (if (and (> x 0) (> y 0))
1827         (set-frame-selected-window nil window))
1828     (mapcar (lambda (file-name)
1829               (if (listp file-name)
1830                   (let ((line (car file-name))
1831                         (start (car (cdr file-name)))
1832                         (end (car (cdr (cdr file-name)))))
1833                     (if (> line 0)
1834                         (goto-line line)
1835                       (if (and (> start 0) (> end 0))
1836                           (progn (set-mark start)
1837                                  (goto-char end)))))
1838                 (dnd-handle-one-url window 'private
1839                                     (concat "file:" file-name))))
1840             (car (cdr (cdr event)))))
1841   (raise-frame))
1842
1843 (global-set-key [drag-n-drop] 'mac-drag-n-drop)
1844
1845 ;; By checking whether the variable mac-ready-for-drag-n-drop has been
1846 ;; defined, the event loop in macterm.c can be informed that it can
1847 ;; now receive Finder drag and drop events.  Files dropped onto the
1848 ;; Emacs application icon can only be processed when the initial frame
1849 ;; has been created: this is where the files should be opened.
1850 (add-hook 'after-init-hook
1851           '(lambda ()
1852              (defvar mac-ready-for-drag-n-drop t)))
1853 \f
1854 ;;;; Non-toolkit Scroll bars
1855
1856 (unless x-toolkit-scroll-bars
1857
1858 ;; for debugging
1859 ;; (defun mac-handle-scroll-bar-event (event) (interactive "e") (princ event))
1860
1861 ;;(global-set-key [vertical-scroll-bar mouse-1] 'mac-handle-scroll-bar-event)
1862
1863 (global-set-key
1864  [vertical-scroll-bar down-mouse-1]
1865  'mac-handle-scroll-bar-event)
1866
1867 (global-unset-key [vertical-scroll-bar drag-mouse-1])
1868 (global-unset-key [vertical-scroll-bar mouse-1])
1869
1870 (defun mac-handle-scroll-bar-event (event)
1871   "Handle scroll bar EVENT to emulate Mac Toolbox style scrolling."
1872   (interactive "e")
1873   (let* ((position (event-start event))
1874          (window (nth 0 position))
1875          (bar-part (nth 4 position)))
1876     (select-window window)
1877     (cond
1878      ((eq bar-part 'up)
1879       (goto-char (window-start window))
1880       (mac-scroll-down-line))
1881      ((eq bar-part 'above-handle)
1882       (mac-scroll-down))
1883      ((eq bar-part 'handle)
1884       (scroll-bar-drag event))
1885      ((eq bar-part 'below-handle)
1886       (mac-scroll-up))
1887      ((eq bar-part 'down)
1888       (goto-char (window-start window))
1889       (mac-scroll-up-line)))))
1890
1891 (defun mac-scroll-ignore-events ()
1892   ;; Ignore confusing non-mouse events
1893   (while (not (memq (car-safe (read-event))
1894                     '(mouse-1 double-mouse-1 triple-mouse-1))) nil))
1895
1896 (defun mac-scroll-down ()
1897   (track-mouse
1898     (mac-scroll-ignore-events)
1899     (scroll-down)))
1900
1901 (defun mac-scroll-down-line ()
1902   (track-mouse
1903     (mac-scroll-ignore-events)
1904     (scroll-down 1)))
1905
1906 (defun mac-scroll-up ()
1907   (track-mouse
1908     (mac-scroll-ignore-events)
1909     (scroll-up)))
1910
1911 (defun mac-scroll-up-line ()
1912   (track-mouse
1913     (mac-scroll-ignore-events)
1914     (scroll-up 1)))
1915
1916 )
1917 \f
1918 ;;;; Others
1919
1920 (unless (eq system-type 'darwin)
1921   ;; This variable specifies the Unix program to call (as a process) to
1922   ;; determine the amount of free space on a file system (defaults to
1923   ;; df).  If it is not set to nil, ls-lisp will not work correctly
1924   ;; unless an external application df is implemented on the Mac.
1925   (setq directory-free-space-program nil)
1926
1927   ;; Set this so that Emacs calls subprocesses with "sh" as shell to
1928   ;; expand filenames Note no subprocess for the shell is actually
1929   ;; started (see run_mac_command in sysdep.c).
1930   (setq shell-file-name "sh")
1931
1932   ;; Some system variables are encoded with the system script code.
1933   (dolist (v '(system-name
1934                emacs-build-system       ; Mac OS 9 version cannot dump
1935                user-login-name user-real-login-name user-full-name))
1936     (set v (decode-coding-string (symbol-value v) mac-system-coding-system))))
1937
1938 ;; If Emacs is started from the Finder, change the default directory
1939 ;; to the user's home directory.
1940 (if (string= default-directory "/")
1941     (cd "~"))
1942
1943 ;; Darwin 6- pty breakage is now controlled from the C code so that
1944 ;; it applies to all builds on darwin.  See s/darwin.h PTY_ITERATION.
1945 ;; (setq process-connection-type t)
1946
1947 ;; Assume that fonts are always scalable on the Mac.  This sometimes
1948 ;; results in characters with jagged edges.  However, without it,
1949 ;; fonts with both truetype and bitmap representations but no italic
1950 ;; or bold bitmap versions will not display these variants correctly.
1951 (setq scalable-fonts-allowed t)
1952
1953 ;; arch-tag: 71dfcd14-cde8-4d66-b05c-85ec94fb23a6
1954 ;;; mac-win.el ends here