Mercurial > hg > xemacs-beta
comparison lisp/term/win32-win.el @ 428:3ecd8885ac67 r21-2-22
Import from CVS: tag r21-2-22
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 11:28:15 +0200 |
| parents | 376386a54a3c |
| children |
comparison
equal
deleted
inserted
replaced
| 427:0a0253eac470 | 428:3ecd8885ac67 |
|---|---|
| 1 ;;; win32-win.el --- parse switches controlling interface with win32 | |
| 2 ;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. | |
| 3 | |
| 4 ;; Author: Kevin Gallo | |
| 5 ;; Keywords: terminals | |
| 6 | |
| 7 ;;; This file is part of GNU Emacs. | |
| 8 ;;; | |
| 9 ;;; GNU Emacs is free software; you can redistribute it and/or modify | |
| 10 ;;; it under the terms of the GNU General Public License as published by | |
| 11 ;;; the Free Software Foundation; either version 2, or (at your option) | |
| 12 ;;; any later version. | |
| 13 ;;; | |
| 14 ;;; GNU Emacs is distributed in the hope that it will be useful, | |
| 15 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 17 ;;; GNU General Public License for more details. | |
| 18 ;;; | |
| 19 ;;; You should have received a copy of the GNU General Public License | |
| 20 ;;; along with GNU Emacs; see the file COPYING. If not, write to | |
| 21 ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
| 22 | |
| 23 ;;; Commentary: | |
| 24 | |
| 25 ;; win32-win.el: this file is loaded from ../lisp/startup.el when it recognizes | |
| 26 ;; that win32 windows are to be used. Command line switches are parsed and those | |
| 27 ;; pertaining to win32 are processed and removed from the command line. The | |
| 28 ;; win32 display is opened and hooks are set for popping up the initial window. | |
| 29 | |
| 30 ;; startup.el will then examine startup files, and eventually call the hooks | |
| 31 ;; which create the first window (s). | |
| 32 | |
| 33 ;;; Code: | |
| 34 | |
| 35 | |
| 36 ;; These are the standard X switches from the Xt Initialize.c file of | |
| 37 ;; Release 4. | |
| 38 | |
| 39 ;; Command line Resource Manager string | |
| 40 | |
| 41 ;; +rv *reverseVideo | |
| 42 ;; +synchronous *synchronous | |
| 43 ;; -background *background | |
| 44 ;; -bd *borderColor | |
| 45 ;; -bg *background | |
| 46 ;; -bordercolor *borderColor | |
| 47 ;; -borderwidth .borderWidth | |
| 48 ;; -bw .borderWidth | |
| 49 ;; -display .display | |
| 50 ;; -fg *foreground | |
| 51 ;; -fn *font | |
| 52 ;; -font *font | |
| 53 ;; -foreground *foreground | |
| 54 ;; -geometry .geometry | |
| 55 ;; -i .iconType | |
| 56 ;; -itype .iconType | |
| 57 ;; -iconic .iconic | |
| 58 ;; -name .name | |
| 59 ;; -reverse *reverseVideo | |
| 60 ;; -rv *reverseVideo | |
| 61 ;; -selectionTimeout .selectionTimeout | |
| 62 ;; -synchronous *synchronous | |
| 63 ;; -xrm | |
| 64 | |
| 65 ;; An alist of X options and the function which handles them. See | |
| 66 ;; ../startup.el. | |
| 67 | |
| 68 (if (not (eq (console-type) 'win32)) | |
| 69 (error "%s: Loading win32-win.el but not compiled for win32" (invocation-name))) | |
| 70 | |
| 71 (defvar x-invocation-args) | |
| 72 | |
| 73 (defvar x-command-line-resources nil) | |
| 74 | |
| 75 (defconst x-option-alist | |
| 76 '(("-bw" . x-handle-numeric-switch) | |
| 77 ("-d" . x-handle-display) | |
| 78 ("-display" . x-handle-display) | |
| 79 ("-name" . x-handle-name-rn-switch) | |
| 80 ("-rn" . x-handle-name-rn-switch) | |
| 81 ("-T" . x-handle-switch) | |
| 82 ("-r" . x-handle-switch) | |
| 83 ("-rv" . x-handle-switch) | |
| 84 ("-reverse" . x-handle-switch) | |
| 85 ("-fn" . x-handle-switch) | |
| 86 ("-font" . x-handle-switch) | |
| 87 ("-ib" . x-handle-numeric-switch) | |
| 88 ("-g" . x-handle-geometry) | |
| 89 ("-geometry" . x-handle-geometry) | |
| 90 ("-fg" . x-handle-switch) | |
| 91 ("-foreground". x-handle-switch) | |
| 92 ("-bg" . x-handle-switch) | |
| 93 ("-background". x-handle-switch) | |
| 94 ("-ms" . x-handle-switch) | |
| 95 ("-itype" . x-handle-switch) | |
| 96 ("-i" . x-handle-switch) | |
| 97 ("-iconic" . x-handle-iconic) | |
| 98 ("-xrm" . x-handle-xrm-switch) | |
| 99 ("-cr" . x-handle-switch) | |
| 100 ("-vb" . x-handle-switch) | |
| 101 ("-hb" . x-handle-switch) | |
| 102 ("-bd" . x-handle-switch))) | |
| 103 | |
| 104 (defconst x-long-option-alist | |
| 105 '(("--border-width" . "-bw") | |
| 106 ("--display" . "-d") | |
| 107 ("--name" . "-name") | |
| 108 ("--title" . "-T") | |
| 109 ("--reverse-video" . "-reverse") | |
| 110 ("--font" . "-font") | |
| 111 ("--internal-border" . "-ib") | |
| 112 ("--geometry" . "-geometry") | |
| 113 ("--foreground-color" . "-fg") | |
| 114 ("--background-color" . "-bg") | |
| 115 ("--mouse-color" . "-ms") | |
| 116 ("--icon-type" . "-itype") | |
| 117 ("--iconic" . "-iconic") | |
| 118 ("--xrm" . "-xrm") | |
| 119 ("--cursor-color" . "-cr") | |
| 120 ("--vertical-scroll-bars" . "-vb") | |
| 121 ("--border-color" . "-bd"))) | |
| 122 | |
| 123 (defconst x-switch-definitions | |
| 124 '(("-name" name) | |
| 125 ("-T" name) | |
| 126 ("-r" reverse t) | |
| 127 ("-rv" reverse t) | |
| 128 ("-reverse" reverse t) | |
| 129 ("-fn" font) | |
| 130 ("-font" font) | |
| 131 ("-ib" internal-border-width) | |
| 132 ("-fg" foreground-color) | |
| 133 ("-foreground" foreground-color) | |
| 134 ("-bg" background-color) | |
| 135 ("-background" background-color) | |
| 136 ("-ms" mouse-color) | |
| 137 ("-cr" cursor-color) | |
| 138 ("-itype" icon-type t) | |
| 139 ("-i" icon-type t) | |
| 140 ("-vb" vertical-scroll-bars t) | |
| 141 ("-hb" horizontal-scroll-bars t) | |
| 142 ("-bd" border-color) | |
| 143 ("-bw" border-width))) | |
| 144 | |
| 145 ;; Handler for switches of the form "-switch value" or "-switch". | |
| 146 (defun x-handle-switch (switch) | |
| 147 (let ((aelt (assoc switch x-switch-definitions))) | |
| 148 (if aelt | |
| 149 (if (nth 2 aelt) | |
| 150 (setq default-frame-alist | |
| 151 (cons (cons (nth 1 aelt) (nth 2 aelt)) | |
| 152 default-frame-alist)) | |
| 153 (setq default-frame-alist | |
| 154 (cons (cons (nth 1 aelt) | |
| 155 (car x-invocation-args)) | |
| 156 default-frame-alist) | |
| 157 x-invocation-args (cdr x-invocation-args)))))) | |
| 158 | |
| 159 ;; Make -iconic apply only to the initial frame! | |
| 160 (defun x-handle-iconic (switch) | |
| 161 (setq initial-frame-alist | |
| 162 (cons '(visibility . icon) initial-frame-alist))) | |
| 163 | |
| 164 ;; Handler for switches of the form "-switch n" | |
| 165 (defun x-handle-numeric-switch (switch) | |
| 166 (let ((aelt (assoc switch x-switch-definitions))) | |
| 167 (if aelt | |
| 168 (setq default-frame-alist | |
| 169 (cons (cons (nth 1 aelt) | |
| 170 (string-to-int (car x-invocation-args))) | |
| 171 default-frame-alist) | |
| 172 x-invocation-args | |
| 173 (cdr x-invocation-args))))) | |
| 174 | |
| 175 ;; Handle the -xrm option. | |
| 176 (defun x-handle-xrm-switch (switch) | |
| 177 (or (consp x-invocation-args) | |
| 178 (error "%s: missing argument to `%s' option" (invocation-name) switch)) | |
| 179 (setq x-command-line-resources (car x-invocation-args)) | |
| 180 (setq x-invocation-args (cdr x-invocation-args))) | |
| 181 | |
| 182 ;; Handle the geometry option | |
| 183 (defun x-handle-geometry (switch) | |
| 184 (let ((geo (x-parse-geometry (car x-invocation-args)))) | |
| 185 (setq initial-frame-alist | |
| 186 (append initial-frame-alist | |
| 187 (if (or (assq 'left geo) (assq 'top geo)) | |
| 188 '((user-position . t))) | |
| 189 (if (or (assq 'height geo) (assq 'width geo)) | |
| 190 '((user-size . t))) | |
| 191 geo) | |
| 192 x-invocation-args (cdr x-invocation-args)))) | |
| 193 | |
| 194 ;; Handle the -name and -rn options. Set the variable x-resource-name | |
| 195 ;; to the option's operand; if the switch was `-name', set the name of | |
| 196 ;; the initial frame, too. | |
| 197 (defun x-handle-name-rn-switch (switch) | |
| 198 (or (consp x-invocation-args) | |
| 199 (error "%s: missing argument to `%s' option" (invocation-name) switch)) | |
| 200 (setq x-resource-name (car x-invocation-args) | |
| 201 x-invocation-args (cdr x-invocation-args)) | |
| 202 (if (string= switch "-name") | |
| 203 (setq initial-frame-alist (cons (cons 'name x-resource-name) | |
| 204 initial-frame-alist)))) | |
| 205 | |
| 206 (defvar x-display-name nil | |
| 207 "The display name specifying server and frame.") | |
| 208 | |
| 209 (defun x-handle-display (switch) | |
| 210 (setq x-display-name (car x-invocation-args) | |
| 211 x-invocation-args (cdr x-invocation-args))) | |
| 212 | |
| 213 (defvar x-invocation-args nil) | |
| 214 | |
| 215 (defun x-handle-args (args) | |
| 216 "Process the X-related command line options in ARGS. | |
| 217 This is done before the user's startup file is loaded. They are copied to | |
| 218 x-invocation args from which the X-related things are extracted, first | |
| 219 the switch (e.g., \"-fg\") in the following code, and possible values | |
| 220 \(e.g., \"black\") in the option handler code (e.g., x-handle-switch). | |
| 221 This returns ARGS with the arguments that have been processed removed." | |
| 222 (message "%s" args) | |
| 223 (setq x-invocation-args args | |
| 224 args nil) | |
| 225 (while x-invocation-args | |
| 226 (let* ((this-switch (car x-invocation-args)) | |
| 227 (orig-this-switch this-switch) | |
| 228 completion argval aelt) | |
| 229 (setq x-invocation-args (cdr x-invocation-args)) | |
| 230 ;; Check for long options with attached arguments | |
| 231 ;; and separate out the attached option argument into argval. | |
| 232 (if (string-match "^--[^=]*=" this-switch) | |
| 233 (setq argval (substring this-switch (match-end 0)) | |
| 234 this-switch (substring this-switch 0 (1- (match-end 0))))) | |
| 235 (setq completion (try-completion this-switch x-long-option-alist)) | |
| 236 (if (eq completion t) | |
| 237 ;; Exact match for long option. | |
| 238 (setq this-switch (cdr (assoc this-switch x-long-option-alist))) | |
| 239 (if (stringp completion) | |
| 240 (let ((elt (assoc completion x-long-option-alist))) | |
| 241 ;; Check for abbreviated long option. | |
| 242 (or elt | |
| 243 (error "Option `%s' is ambiguous" this-switch)) | |
| 244 (setq this-switch (cdr elt))) | |
| 245 ;; Check for a short option. | |
| 246 (setq argval nil this-switch orig-this-switch))) | |
| 247 (setq aelt (assoc this-switch x-option-alist)) | |
| 248 (if aelt | |
| 249 (if argval | |
| 250 (let ((x-invocation-args | |
| 251 (cons argval x-invocation-args))) | |
| 252 (funcall (cdr aelt) this-switch)) | |
| 253 (funcall (cdr aelt) this-switch)) | |
| 254 (setq args (cons this-switch args))))) | |
| 255 (setq args (nreverse args))) | |
| 256 | |
| 257 | |
| 258 | |
| 259 ;; | |
| 260 ;; Available colors | |
| 261 ;; | |
| 262 | |
| 263 (defvar x-colors '("aquamarine" | |
| 264 "Aquamarine" | |
| 265 "medium aquamarine" | |
| 266 "MediumAquamarine" | |
| 267 "black" | |
| 268 "Black" | |
| 269 "blue" | |
| 270 "Blue" | |
| 271 "cadet blue" | |
| 272 "CadetBlue" | |
| 273 "cornflower blue" | |
| 274 "CornflowerBlue" | |
| 275 "dark slate blue" | |
| 276 "DarkSlateBlue" | |
| 277 "light blue" | |
| 278 "LightBlue" | |
| 279 "light steel blue" | |
| 280 "LightSteelBlue" | |
| 281 "medium blue" | |
| 282 "MediumBlue" | |
| 283 "medium slate blue" | |
| 284 "MediumSlateBlue" | |
| 285 "midnight blue" | |
| 286 "MidnightBlue" | |
| 287 "navy blue" | |
| 288 "NavyBlue" | |
| 289 "navy" | |
| 290 "Navy" | |
| 291 "sky blue" | |
| 292 "SkyBlue" | |
| 293 "slate blue" | |
| 294 "SlateBlue" | |
| 295 "steel blue" | |
| 296 "SteelBlue" | |
| 297 "coral" | |
| 298 "Coral" | |
| 299 "cyan" | |
| 300 "Cyan" | |
| 301 "firebrick" | |
| 302 "Firebrick" | |
| 303 "brown" | |
| 304 "Brown" | |
| 305 "gold" | |
| 306 "Gold" | |
| 307 "goldenrod" | |
| 308 "Goldenrod" | |
| 309 "green" | |
| 310 "Green" | |
| 311 "dark green" | |
| 312 "DarkGreen" | |
| 313 "dark olive green" | |
| 314 "DarkOliveGreen" | |
| 315 "forest green" | |
| 316 "ForestGreen" | |
| 317 "lime green" | |
| 318 "LimeGreen" | |
| 319 "medium sea green" | |
| 320 "MediumSeaGreen" | |
| 321 "medium spring green" | |
| 322 "MediumSpringGreen" | |
| 323 "pale green" | |
| 324 "PaleGreen" | |
| 325 "sea green" | |
| 326 "SeaGreen" | |
| 327 "spring green" | |
| 328 "SpringGreen" | |
| 329 "yellow green" | |
| 330 "YellowGreen" | |
| 331 "dark slate grey" | |
| 332 "DarkSlateGrey" | |
| 333 "dark slate gray" | |
| 334 "DarkSlateGray" | |
| 335 "dim grey" | |
| 336 "DimGrey" | |
| 337 "dim gray" | |
| 338 "DimGray" | |
| 339 "light grey" | |
| 340 "LightGrey" | |
| 341 "light gray" | |
| 342 "LightGray" | |
| 343 "gray" | |
| 344 "grey" | |
| 345 "Gray" | |
| 346 "Grey" | |
| 347 "khaki" | |
| 348 "Khaki" | |
| 349 "magenta" | |
| 350 "Magenta" | |
| 351 "maroon" | |
| 352 "Maroon" | |
| 353 "orange" | |
| 354 "Orange" | |
| 355 "orchid" | |
| 356 "Orchid" | |
| 357 "dark orchid" | |
| 358 "DarkOrchid" | |
| 359 "medium orchid" | |
| 360 "MediumOrchid" | |
| 361 "pink" | |
| 362 "Pink" | |
| 363 "plum" | |
| 364 "Plum" | |
| 365 "red" | |
| 366 "Red" | |
| 367 "indian red" | |
| 368 "IndianRed" | |
| 369 "medium violet red" | |
| 370 "MediumVioletRed" | |
| 371 "orange red" | |
| 372 "OrangeRed" | |
| 373 "violet red" | |
| 374 "VioletRed" | |
| 375 "salmon" | |
| 376 "Salmon" | |
| 377 "sienna" | |
| 378 "Sienna" | |
| 379 "tan" | |
| 380 "Tan" | |
| 381 "thistle" | |
| 382 "Thistle" | |
| 383 "turquoise" | |
| 384 "Turquoise" | |
| 385 "dark turquoise" | |
| 386 "DarkTurquoise" | |
| 387 "medium turquoise" | |
| 388 "MediumTurquoise" | |
| 389 "violet" | |
| 390 "Violet" | |
| 391 "blue violet" | |
| 392 "BlueViolet" | |
| 393 "wheat" | |
| 394 "Wheat" | |
| 395 "white" | |
| 396 "White" | |
| 397 "yellow" | |
| 398 "Yellow" | |
| 399 "green yellow" | |
| 400 "GreenYellow") | |
| 401 "The full list of X colors from the `rgb.text' file.") | |
| 402 | |
| 403 (defun x-defined-colors (&optional frame) | |
| 404 "Return a list of colors supported for a particular frame. | |
| 405 The argument FRAME specifies which frame to try. | |
| 406 The value may be different for frames on different X displays." | |
| 407 (or frame (setq frame (selected-frame))) | |
| 408 (let ((all-colors x-colors) | |
| 409 (this-color nil) | |
| 410 (defined-colors nil)) | |
| 411 (while all-colors | |
| 412 (setq this-color (car all-colors) | |
| 413 all-colors (cdr all-colors)) | |
| 414 (and (face-color-supported-p frame this-color t) | |
| 415 (setq defined-colors (cons this-color defined-colors)))) | |
| 416 defined-colors)) | |
| 417 | |
| 418 ;;;; Function keys | |
| 419 | |
| 420 (defun iconify-or-deiconify-frame () | |
| 421 "Iconify the selected frame, or deiconify if it's currently an icon." | |
| 422 (interactive) | |
| 423 (if (eq (cdr (assq 'visibility (frame-parameters))) t) | |
| 424 (iconify-frame) | |
| 425 (make-frame-visible))) | |
| 426 | |
| 427 (substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame | |
| 428 global-map) | |
| 429 | |
| 430 ;; Map certain keypad keys into ASCII characters | |
| 431 ;; that people usually expect. | |
| 432 (define-key function-key-map [backspace] [127]) | |
| 433 (define-key function-key-map [delete] [127]) | |
| 434 (define-key function-key-map [tab] [?\t]) | |
| 435 (define-key function-key-map [linefeed] [?\n]) | |
| 436 (define-key function-key-map [clear] [11]) | |
| 437 (define-key function-key-map [return] [13]) | |
| 438 (define-key function-key-map [escape] [?\e]) | |
| 439 (define-key function-key-map [M-backspace] [?\M-\d]) | |
| 440 (define-key function-key-map [M-delete] [?\M-\d]) | |
| 441 (define-key function-key-map [M-tab] [?\M-\t]) | |
| 442 (define-key function-key-map [M-linefeed] [?\M-\n]) | |
| 443 (define-key function-key-map [M-clear] [?\M-\013]) | |
| 444 (define-key function-key-map [M-return] [?\M-\015]) | |
| 445 (define-key function-key-map [M-escape] [?\M-\e]) | |
| 446 | |
| 447 ;; These tell read-char how to convert | |
| 448 ;; these special chars to ASCII. | |
| 449 (put 'backspace 'ascii-character 127) | |
| 450 (put 'delete 'ascii-character 127) | |
| 451 (put 'tab 'ascii-character ?\t) | |
| 452 (put 'linefeed 'ascii-character ?\n) | |
| 453 (put 'clear 'ascii-character 12) | |
| 454 (put 'return 'ascii-character 13) | |
| 455 (put 'escape 'ascii-character ?\e) | |
| 456 | |
| 457 | |
| 458 ;;;; Selections and cut buffers | |
| 459 | |
| 460 ;;; We keep track of the last text selected here, so we can check the | |
| 461 ;;; current selection against it, and avoid passing back our own text | |
| 462 ;;; from x-cut-buffer-or-selection-value. | |
| 463 (defvar x-last-selected-text nil) | |
| 464 | |
| 465 ;;; It is said that overlarge strings are slow to put into the cut buffer. | |
| 466 ;;; Note this value is overridden below. | |
| 467 (defvar x-cut-buffer-max 20000 | |
| 468 "Max number of characters to put in the cut buffer.") | |
| 469 | |
| 470 (defvar x-select-enable-clipboard t | |
| 471 "Non-nil means cutting and pasting uses the clipboard. | |
| 472 This is in addition to the primary selection.") | |
| 473 | |
| 474 (defun x-select-text (text &optional push) | |
| 475 (if x-select-enable-clipboard | |
| 476 (win32-set-clipboard-data text))) | |
| 477 | |
| 478 ;;; Return the value of the current selection. | |
| 479 ;;; Consult the selection, then the cut buffer. Treat empty strings | |
| 480 ;;; as if they were unset. | |
| 481 (defun x-get-selection-value () | |
| 482 (if x-select-enable-clipboard | |
| 483 (let (text) | |
| 484 ;; Don't die if x-get-selection signals an error. | |
| 485 (condition-case c | |
| 486 (setq text (win32-get-clipboard-data)) | |
| 487 (error (message "win32-get-clipboard-data:%s" c))) | |
| 488 (if (string= text "") (setq text nil)) | |
| 489 text))) | |
| 490 | |
| 491 ;;; Do the actual Windows setup here; the above code just defines | |
| 492 ;;; functions and variables that we use now. | |
| 493 | |
| 494 (setq command-line-args (x-handle-args command-line-args)) | |
| 495 | |
| 496 ;;; Make sure we have a valid resource name. | |
| 497 (or (stringp x-resource-name) | |
| 498 (let (i) | |
| 499 (setq x-resource-name (invocation-name)) | |
| 500 | |
| 501 ;; Change any . or * characters in x-resource-name to hyphens, | |
| 502 ;; so as not to choke when we use it in X resource queries. | |
| 503 (while (setq i (string-match "[.*]" x-resource-name)) | |
| 504 (aset x-resource-name i ?-)))) | |
| 505 | |
| 506 ;; For the benefit of older Emacses (19.27 and earlier) that are sharing | |
| 507 ;; the same lisp directory, don't pass the third argument unless we seem | |
| 508 ;; to have the multi-display support. | |
| 509 (if (fboundp 'x-close-connection) | |
| 510 (x-open-connection "" | |
| 511 x-command-line-resources | |
| 512 ;; Exit Emacs with fatal error if this fails. | |
| 513 t) | |
| 514 (x-open-connection "" | |
| 515 x-command-line-resources)) | |
| 516 | |
| 517 (setq frame-creation-function 'x-create-frame-with-faces) | |
| 518 | |
| 519 (setq x-cut-buffer-max (min (- (/ (x-server-max-request-size) 2) 100) | |
| 520 x-cut-buffer-max)) | |
| 521 | |
| 522 ;; Win32 expects the menu bar cut and paste commands to use the clipboard. | |
| 523 ;; This has ,? to match both on Sunos and on Solaris. | |
| 524 (menu-bar-enable-clipboard) | |
| 525 | |
| 526 ;; Apply a geometry resource to the initial frame. Put it at the end | |
| 527 ;; of the alist, so that anything specified on the command line takes | |
| 528 ;; precedence. | |
| 529 (let* ((res-geometry (x-get-resource "geometry" "Geometry")) | |
| 530 parsed) | |
| 531 (if res-geometry | |
| 532 (progn | |
| 533 (setq parsed (x-parse-geometry res-geometry)) | |
| 534 ;; If the resource specifies a position, | |
| 535 ;; call the position and size "user-specified". | |
| 536 (if (or (assq 'top parsed) (assq 'left parsed)) | |
| 537 (setq parsed (cons '(user-position . t) | |
| 538 (cons '(user-size . t) parsed)))) | |
| 539 ;; All geometry parms apply to the initial frame. | |
| 540 (setq initial-frame-alist (append initial-frame-alist parsed)) | |
| 541 ;; The size parms apply to all frames. | |
| 542 (if (assq 'height parsed) | |
| 543 (setq default-frame-alist | |
| 544 (cons (cons 'height (cdr (assq 'height parsed))) | |
| 545 default-frame-alist))) | |
| 546 (if (assq 'width parsed) | |
| 547 (setq default-frame-alist | |
| 548 (cons (cons 'width (cdr (assq 'width parsed))) | |
| 549 default-frame-alist)))))) | |
| 550 | |
| 551 ;; Check the reverseVideo resource. | |
| 552 (let ((case-fold-search t)) | |
| 553 (let ((rv (x-get-resource "reverseVideo" "ReverseVideo"))) | |
| 554 (if (and rv | |
| 555 (string-match "^\\(true\\|yes\\|on\\)$" rv)) | |
| 556 (setq default-frame-alist | |
| 557 (cons '(reverse . t) default-frame-alist))))) | |
| 558 | |
| 559 ;; Set x-selection-timeout, measured in milliseconds. | |
| 560 (let ((res-selection-timeout | |
| 561 (x-get-resource "selectionTimeout" "SelectionTimeout"))) | |
| 562 (setq x-selection-timeout 20000) | |
| 563 (if res-selection-timeout | |
| 564 (setq x-selection-timeout (string-to-number res-selection-timeout)))) | |
| 565 | |
| 566 (defun x-win-suspend-error () | |
| 567 (error "Suspending an emacs running under Win32 makes no sense")) | |
| 568 (add-hook 'suspend-hook 'x-win-suspend-error) | |
| 569 | |
| 570 ;;; Arrange for the kill and yank functions to set and check the clipboard. | |
| 571 (setq interprogram-cut-function 'x-select-text) | |
| 572 (setq interprogram-paste-function 'x-get-selection-value) | |
| 573 | |
| 574 ;;; Turn off window-splitting optimization; win32 is usually fast enough | |
| 575 ;;; that this is only annoying. | |
| 576 (setq split-window-keep-point t) | |
| 577 | |
| 578 ;; Don't show the frame name; that's redundant. | |
| 579 (setq-default mode-line-buffer-identification '("Emacs: %12b")) | |
| 580 | |
| 581 ;;; Set to a system sound if you want a fancy bell. | |
| 582 (set-message-beep 'ok) | |
| 583 | |
| 584 ;; Remap some functions to call win32 common dialogs | |
| 585 | |
| 586 (defun internal-face-interactive (what &optional bool) | |
| 587 (let* ((fn (intern (concat "face-" what))) | |
| 588 (prompt (concat "Set " what " of face")) | |
| 589 (face (read-face-name (concat prompt ": "))) | |
| 590 (default (if (fboundp fn) | |
| 591 (or (funcall fn face (selected-frame)) | |
| 592 (funcall fn 'default (selected-frame))))) | |
| 593 (fn-win (intern (concat (symbol-name window-system) "-select-" what))) | |
| 594 (value | |
| 595 (if (fboundp fn-win) | |
| 596 (funcall fn-win) | |
| 597 (if bool | |
| 598 (y-or-n-p (concat "Should face " (symbol-name face) | |
| 599 " be " bool "? ")) | |
| 600 (read-string (concat prompt " " (symbol-name face) " to: ") | |
| 601 default))))) | |
| 602 (list face (if (equal value "") nil value)))) | |
| 603 | |
| 604 ;; Redefine the font selection to use the Win32 dialog | |
| 605 | |
| 606 (defun mouse-set-font (&rest fonts) | |
| 607 (interactive) | |
| 608 (set-default-font (win32-select-font))) | |
| 609 | |
| 610 ;;; win32-win.el ends here |