# HG changeset patch # User ben # Date 992933272 0 # Node ID 5af4f6f788c444c9518b27b2cc924f311cb5ca0a # Parent 8d7292eb4a18f30f883174bf48f3aed3eaa08d3a [xemacs-hg @ 2001-06-19 06:47:52 by ben] removed obsolete pc-win/win32-win diff -r 8d7292eb4a18 -r 5af4f6f788c4 lisp/term/pc-win.el --- a/lisp/term/pc-win.el Tue Jun 19 01:35:38 2001 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,204 +0,0 @@ -;; pc-win.el -- setup support for `PC windows' (whatever that is). - -;; Copyright (C) 1994 Free Software Foundation, Inc. - -;; Author: Morten Welinder -;; Version: 1,00 - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -;; --------------------------------------------------------------------------- -(load "term/internal" nil t) - -;; Color translation -- doesn't really need to be fast - -(defvar msdos-color-aliases - '(("purple" . "magenta") - ("firebrick" . "red") ; ? - ("pink" . "lightred") - ("royalblue" . "blue") - ("cadetblue" . "blue") - ("forestgreen" . "green") - ("darkolivegreen" . "green") - ("darkgoldenrod" . "brown") - ("goldenrod" . "yellow") - ("grey40" . "darkgray") - ("rosybrown" . "brown") - ("blue" . "lightblue") ;; from here: for Enriched Text - ("darkslategray" . "darkgray") - ("orange" . "brown") - ("light blue" . "lightblue") ;; from here: for cpp-highlight - ("light cyan" . "lightcyan") - ("light yellow" . "yellow") - ("light pink" . "lightred") - ("pale green" . "lightgreen") - ("beige" . "brown") - ("medium purple" . "magenta") - ("turquoise" . "lightgreen") - ("violet" . "magenta")) - "List of alternate names for colors.") - -(defun msdos-color-translate (name) - (setq name (downcase name)) - (let* ((len (length name)) - (val (cdr (assoc name - '(("black" . 0) - ("blue" . 1) - ("green" . 2) - ("cyan" . 3) - ("red" . 4) - ("magenta" . 5) - ("brown" . 6) - ("lightgray" . 7) ("light gray" . 7) - ("darkgray" . 8) ("dark gray" . 8) - ("lightblue" . 9) - ("lightgreen" . 10) - ("lightcyan" . 11) - ("lightred" . 12) - ("lightmagenta" . 13) - ("yellow" . 14) - ("white" . 15))))) - (try)) - (or val - (and (setq try (cdr (assoc name msdos-color-aliases))) - (msdos-color-translate try)) - (and (> len 5) - (string= "light" (substring name 0 4)) - (setq try (msdos-color-translate (substring name 5))) - (logior try 8)) - (and (> len 6) - (string= "light " (substring name 0 5)) - (setq try (msdos-color-translate (substring name 6))) - (logior try 8)) - (and (> len 4) - (string= "dark" (substring name 0 3)) - (msdos-color-translate (substring name 4))) - (and (> len 5) - (string= "dark " (substring name 0 4)) - (msdos-color-translate (substring name 5)))))) -;; --------------------------------------------------------------------------- -;; We want to delay setting frame parameters until the faces are setup -(defvar default-frame-alist nil) - -(defun msdos-face-setup () - (modify-frame-parameters (selected-frame) default-frame-alist) - - (set-face-foreground 'bold "yellow") - (set-face-foreground 'italic "red") - (set-face-foreground 'bold-italic "lightred") - (set-face-foreground 'underline "white") - (set-face-background 'region "green") - - (make-face 'msdos-menu-active-face) - (make-face 'msdos-menu-passive-face) - (make-face 'msdos-menu-select-face) - (set-face-foreground 'msdos-menu-active-face "white") - (set-face-foreground 'msdos-menu-passive-face "lightgray") - (set-face-background 'msdos-menu-active-face "blue") - (set-face-background 'msdos-menu-passive-face "blue") - (set-face-background 'msdos-menu-select-face "red")) - -;; We have only one font, so... -(add-hook 'before-init-hook 'msdos-face-setup) -;; --------------------------------------------------------------------------- -;; More or less useful imitations of certain X-functions. A lot of the -;; values returned are questionable, but usually only the form of the -;; returned value matters. Also, by the way, recall that `ignore' is -;; a useful function for returning 'nil regardless of argument. - -;; From src/xfns.c -(defun x-display-color-p (&optional display) 't) -(fset 'focus-frame 'ignore) -(fset 'unfocus-frame 'ignore) -(defun x-list-fonts (pattern &optional face frame) (list "default")) -(defun x-color-defined-p (color) (numberp (msdos-color-translate color))) -(defun x-display-pixel-width (&optional frame) (* 8 (frame-width frame))) -(defun x-display-pixel-height (&optional frame) (* 8 (frame-height frame))) -(defun x-display-planes (&optional frame) 4) ; 3 for background, actually -(defun x-display-color-cells (&optional frame) 16) ; ??? -(defun x-server-max-request-size (&optional frame) 1000000) ; ??? -(defun x-server-vendor (&optional frame) t "GNU") -(defun x-server-version (&optional frame) '(1 0 0)) -(defun x-display-screens (&optional frame) 1) -(defun x-display-mm-height (&optional frame) 200) ; Guess the size of my -(defun x-display-mm-width (&optional frame) 253) ; monitor, MW... -(defun x-display-backing-store (&optional frame) 'not-useful) -(defun x-display-visual-class (&optional frame) 'static-color) -(fset 'x-display-save-under 'ignore) -(fset 'x-get-resource 'ignore) - -;; From lisp/term/x-win.el -(setq x-display-name "pc") -(setq split-window-keep-point t) - -;; From lisp/select.el -(defun x-get-selection (&rest rest) "") -(fset 'x-set-selection 'ignore) - -;; From lisp/faces.el: we only have one font, so always return -;; it, no matter which variety they've asked for. -(defun x-frob-font-slant (font which) - font) - -;; From lisp/frame.el -(fset 'set-default-font 'ignore) -(fset 'set-mouse-color 'ignore) ; We cannot, I think. -(fset 'set-cursor-color 'ignore) ; Hardware determined by char under. -(fset 'set-border-color 'ignore) ; Not useful. -(fset 'auto-raise-mode 'ignore) -(fset 'auto-lower-mode 'ignore) -(defun set-background-color (color-name) - "Set the background color of the selected frame to COLOR. -When called interactively, prompt for the name of the color to use." - (interactive "sColor: ") - (modify-frame-parameters (selected-frame) - (list (cons 'background-color color-name)))) -(defun set-foreground-color (color-name) - "Set the foreground color of the selected frame to COLOR. -When called interactively, prompt for the name of the color to use." - (interactive "sColor: ") - (modify-frame-parameters (selected-frame) - (list (cons 'foreground-color color-name)))) -;; --------------------------------------------------------------------------- -;; Handle the X-like command line parameters "-fg" and "-bg" -(defun msdos-handle-args (args) - (let ((rest nil)) - (while args - (let ((this (car args))) - (setq args (cdr args)) - (cond ((or (string= this "-fg") (string= this "-foreground")) - (if args - (setq default-frame-alist - (cons (cons 'foreground-color (car args)) - default-frame-alist) - args (cdr args)))) - ((or (string= this "-bg") (string= this "-background")) - (if args - (setq default-frame-alist - (cons (cons 'background-color (car args)) - default-frame-alist) - args (cdr args)))) - (t (setq rest (cons this rest)))))) - (nreverse rest))) - -(setq command-line-args (msdos-handle-args command-line-args)) -;; --------------------------------------------------------------------------- -;; XEmacs always has faces -;;(require 'faces) -(if (msdos-mouse-p) - (progn - (require 'menu-bar) - (menu-bar-mode t))) diff -r 8d7292eb4a18 -r 5af4f6f788c4 lisp/term/win32-win.el --- a/lisp/term/win32-win.el Tue Jun 19 01:35:38 2001 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,610 +0,0 @@ -;;; win32-win.el --- parse switches controlling interface with win32 -;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. - -;; Author: Kevin Gallo -;; Keywords: terminals - -;;; This file is part of GNU Emacs. -;;; -;;; GNU Emacs is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your option) -;;; any later version. -;;; -;;; GNU Emacs is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to -;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. - -;;; Commentary: - -;; win32-win.el: this file is loaded from ../lisp/startup.el when it recognizes -;; that win32 windows are to be used. Command line switches are parsed and those -;; pertaining to win32 are processed and removed from the command line. The -;; win32 display is opened and hooks are set for popping up the initial window. - -;; startup.el will then examine startup files, and eventually call the hooks -;; which create the first window (s). - -;;; Code: - - -;; These are the standard X switches from the Xt Initialize.c file of -;; Release 4. - -;; Command line Resource Manager string - -;; +rv *reverseVideo -;; +synchronous *synchronous -;; -background *background -;; -bd *borderColor -;; -bg *background -;; -bordercolor *borderColor -;; -borderwidth .borderWidth -;; -bw .borderWidth -;; -display .display -;; -fg *foreground -;; -fn *font -;; -font *font -;; -foreground *foreground -;; -geometry .geometry -;; -i .iconType -;; -itype .iconType -;; -iconic .iconic -;; -name .name -;; -reverse *reverseVideo -;; -rv *reverseVideo -;; -selectionTimeout .selectionTimeout -;; -synchronous *synchronous -;; -xrm - -;; An alist of X options and the function which handles them. See -;; ../startup.el. - -(if (not (eq (console-type) 'win32)) - (error "%s: Loading win32-win.el but not compiled for win32" (invocation-name))) - -(defvar x-invocation-args) - -(defvar x-command-line-resources nil) - -(defconst x-option-alist - '(("-bw" . x-handle-numeric-switch) - ("-d" . x-handle-display) - ("-display" . x-handle-display) - ("-name" . x-handle-name-rn-switch) - ("-rn" . x-handle-name-rn-switch) - ("-T" . x-handle-switch) - ("-r" . x-handle-switch) - ("-rv" . x-handle-switch) - ("-reverse" . x-handle-switch) - ("-fn" . x-handle-switch) - ("-font" . x-handle-switch) - ("-ib" . x-handle-numeric-switch) - ("-g" . x-handle-geometry) - ("-geometry" . x-handle-geometry) - ("-fg" . x-handle-switch) - ("-foreground". x-handle-switch) - ("-bg" . x-handle-switch) - ("-background". x-handle-switch) - ("-ms" . x-handle-switch) - ("-itype" . x-handle-switch) - ("-i" . x-handle-switch) - ("-iconic" . x-handle-iconic) - ("-xrm" . x-handle-xrm-switch) - ("-cr" . x-handle-switch) - ("-vb" . x-handle-switch) - ("-hb" . x-handle-switch) - ("-bd" . x-handle-switch))) - -(defconst x-long-option-alist - '(("--border-width" . "-bw") - ("--display" . "-d") - ("--name" . "-name") - ("--title" . "-T") - ("--reverse-video" . "-reverse") - ("--font" . "-font") - ("--internal-border" . "-ib") - ("--geometry" . "-geometry") - ("--foreground-color" . "-fg") - ("--background-color" . "-bg") - ("--mouse-color" . "-ms") - ("--icon-type" . "-itype") - ("--iconic" . "-iconic") - ("--xrm" . "-xrm") - ("--cursor-color" . "-cr") - ("--vertical-scroll-bars" . "-vb") - ("--border-color" . "-bd"))) - -(defconst x-switch-definitions - '(("-name" name) - ("-T" name) - ("-r" reverse t) - ("-rv" reverse t) - ("-reverse" reverse t) - ("-fn" font) - ("-font" font) - ("-ib" internal-border-width) - ("-fg" foreground-color) - ("-foreground" foreground-color) - ("-bg" background-color) - ("-background" background-color) - ("-ms" mouse-color) - ("-cr" cursor-color) - ("-itype" icon-type t) - ("-i" icon-type t) - ("-vb" vertical-scroll-bars t) - ("-hb" horizontal-scroll-bars t) - ("-bd" border-color) - ("-bw" border-width))) - -;; Handler for switches of the form "-switch value" or "-switch". -(defun x-handle-switch (switch) - (let ((aelt (assoc switch x-switch-definitions))) - (if aelt - (if (nth 2 aelt) - (setq default-frame-alist - (cons (cons (nth 1 aelt) (nth 2 aelt)) - default-frame-alist)) - (setq default-frame-alist - (cons (cons (nth 1 aelt) - (car x-invocation-args)) - default-frame-alist) - x-invocation-args (cdr x-invocation-args)))))) - -;; Make -iconic apply only to the initial frame! -(defun x-handle-iconic (switch) - (setq initial-frame-alist - (cons '(visibility . icon) initial-frame-alist))) - -;; Handler for switches of the form "-switch n" -(defun x-handle-numeric-switch (switch) - (let ((aelt (assoc switch x-switch-definitions))) - (if aelt - (setq default-frame-alist - (cons (cons (nth 1 aelt) - (string-to-int (car x-invocation-args))) - default-frame-alist) - x-invocation-args - (cdr x-invocation-args))))) - -;; Handle the -xrm option. -(defun x-handle-xrm-switch (switch) - (or (consp x-invocation-args) - (error "%s: missing argument to `%s' option" (invocation-name) switch)) - (setq x-command-line-resources (car x-invocation-args)) - (setq x-invocation-args (cdr x-invocation-args))) - -;; Handle the geometry option -(defun x-handle-geometry (switch) - (let ((geo (x-parse-geometry (car x-invocation-args)))) - (setq initial-frame-alist - (append initial-frame-alist - (if (or (assq 'left geo) (assq 'top geo)) - '((user-position . t))) - (if (or (assq 'height geo) (assq 'width geo)) - '((user-size . t))) - geo) - x-invocation-args (cdr x-invocation-args)))) - -;; Handle the -name and -rn options. Set the variable x-resource-name -;; to the option's operand; if the switch was `-name', set the name of -;; the initial frame, too. -(defun x-handle-name-rn-switch (switch) - (or (consp x-invocation-args) - (error "%s: missing argument to `%s' option" (invocation-name) switch)) - (setq x-resource-name (car x-invocation-args) - x-invocation-args (cdr x-invocation-args)) - (if (string= switch "-name") - (setq initial-frame-alist (cons (cons 'name x-resource-name) - initial-frame-alist)))) - -(defvar x-display-name nil - "The display name specifying server and frame.") - -(defun x-handle-display (switch) - (setq x-display-name (car x-invocation-args) - x-invocation-args (cdr x-invocation-args))) - -(defvar x-invocation-args nil) - -(defun x-handle-args (args) - "Process the X-related command line options in ARGS. -This is done before the user's startup file is loaded. They are copied to -x-invocation args from which the X-related things are extracted, first -the switch (e.g., \"-fg\") in the following code, and possible values -\(e.g., \"black\") in the option handler code (e.g., x-handle-switch). -This returns ARGS with the arguments that have been processed removed." - (message "%s" args) - (setq x-invocation-args args - args nil) - (while x-invocation-args - (let* ((this-switch (car x-invocation-args)) - (orig-this-switch this-switch) - completion argval aelt) - (setq x-invocation-args (cdr x-invocation-args)) - ;; Check for long options with attached arguments - ;; and separate out the attached option argument into argval. - (if (string-match "^--[^=]*=" this-switch) - (setq argval (substring this-switch (match-end 0)) - this-switch (substring this-switch 0 (1- (match-end 0))))) - (setq completion (try-completion this-switch x-long-option-alist)) - (if (eq completion t) - ;; Exact match for long option. - (setq this-switch (cdr (assoc this-switch x-long-option-alist))) - (if (stringp completion) - (let ((elt (assoc completion x-long-option-alist))) - ;; Check for abbreviated long option. - (or elt - (error "Option `%s' is ambiguous" this-switch)) - (setq this-switch (cdr elt))) - ;; Check for a short option. - (setq argval nil this-switch orig-this-switch))) - (setq aelt (assoc this-switch x-option-alist)) - (if aelt - (if argval - (let ((x-invocation-args - (cons argval x-invocation-args))) - (funcall (cdr aelt) this-switch)) - (funcall (cdr aelt) this-switch)) - (setq args (cons this-switch args))))) - (setq args (nreverse args))) - - - -;; -;; Available colors -;; - -(defvar x-colors '("aquamarine" - "Aquamarine" - "medium aquamarine" - "MediumAquamarine" - "black" - "Black" - "blue" - "Blue" - "cadet blue" - "CadetBlue" - "cornflower blue" - "CornflowerBlue" - "dark slate blue" - "DarkSlateBlue" - "light blue" - "LightBlue" - "light steel blue" - "LightSteelBlue" - "medium blue" - "MediumBlue" - "medium slate blue" - "MediumSlateBlue" - "midnight blue" - "MidnightBlue" - "navy blue" - "NavyBlue" - "navy" - "Navy" - "sky blue" - "SkyBlue" - "slate blue" - "SlateBlue" - "steel blue" - "SteelBlue" - "coral" - "Coral" - "cyan" - "Cyan" - "firebrick" - "Firebrick" - "brown" - "Brown" - "gold" - "Gold" - "goldenrod" - "Goldenrod" - "green" - "Green" - "dark green" - "DarkGreen" - "dark olive green" - "DarkOliveGreen" - "forest green" - "ForestGreen" - "lime green" - "LimeGreen" - "medium sea green" - "MediumSeaGreen" - "medium spring green" - "MediumSpringGreen" - "pale green" - "PaleGreen" - "sea green" - "SeaGreen" - "spring green" - "SpringGreen" - "yellow green" - "YellowGreen" - "dark slate grey" - "DarkSlateGrey" - "dark slate gray" - "DarkSlateGray" - "dim grey" - "DimGrey" - "dim gray" - "DimGray" - "light grey" - "LightGrey" - "light gray" - "LightGray" - "gray" - "grey" - "Gray" - "Grey" - "khaki" - "Khaki" - "magenta" - "Magenta" - "maroon" - "Maroon" - "orange" - "Orange" - "orchid" - "Orchid" - "dark orchid" - "DarkOrchid" - "medium orchid" - "MediumOrchid" - "pink" - "Pink" - "plum" - "Plum" - "red" - "Red" - "indian red" - "IndianRed" - "medium violet red" - "MediumVioletRed" - "orange red" - "OrangeRed" - "violet red" - "VioletRed" - "salmon" - "Salmon" - "sienna" - "Sienna" - "tan" - "Tan" - "thistle" - "Thistle" - "turquoise" - "Turquoise" - "dark turquoise" - "DarkTurquoise" - "medium turquoise" - "MediumTurquoise" - "violet" - "Violet" - "blue violet" - "BlueViolet" - "wheat" - "Wheat" - "white" - "White" - "yellow" - "Yellow" - "green yellow" - "GreenYellow") - "The full list of X colors from the `rgb.text' file.") - -(defun x-defined-colors (&optional frame) - "Return a list of colors supported for a particular frame. -The argument FRAME specifies which frame to try. -The value may be different for frames on different X displays." - (or frame (setq frame (selected-frame))) - (let ((all-colors x-colors) - (this-color nil) - (defined-colors nil)) - (while all-colors - (setq this-color (car all-colors) - all-colors (cdr all-colors)) - (and (face-color-supported-p frame this-color t) - (setq defined-colors (cons this-color defined-colors)))) - defined-colors)) - -;;;; Function keys - -(defun iconify-or-deiconify-frame () - "Iconify the selected frame, or deiconify if it's currently an icon." - (interactive) - (if (eq (cdr (assq 'visibility (frame-parameters))) t) - (iconify-frame) - (make-frame-visible))) - -(substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame - global-map) - -;; Map certain keypad keys into ASCII characters -;; that people usually expect. -(define-key function-key-map [backspace] [127]) -(define-key function-key-map [delete] [127]) -(define-key function-key-map [tab] [?\t]) -(define-key function-key-map [linefeed] [?\n]) -(define-key function-key-map [clear] [11]) -(define-key function-key-map [return] [13]) -(define-key function-key-map [escape] [?\e]) -(define-key function-key-map [M-backspace] [?\M-\d]) -(define-key function-key-map [M-delete] [?\M-\d]) -(define-key function-key-map [M-tab] [?\M-\t]) -(define-key function-key-map [M-linefeed] [?\M-\n]) -(define-key function-key-map [M-clear] [?\M-\013]) -(define-key function-key-map [M-return] [?\M-\015]) -(define-key function-key-map [M-escape] [?\M-\e]) - -;; These tell read-char how to convert -;; these special chars to ASCII. -(put 'backspace 'ascii-character 127) -(put 'delete 'ascii-character 127) -(put 'tab 'ascii-character ?\t) -(put 'linefeed 'ascii-character ?\n) -(put 'clear 'ascii-character 12) -(put 'return 'ascii-character 13) -(put 'escape 'ascii-character ?\e) - - -;;;; Selections and cut buffers - -;;; We keep track of the last text selected here, so we can check the -;;; current selection against it, and avoid passing back our own text -;;; from x-cut-buffer-or-selection-value. -(defvar x-last-selected-text nil) - -;;; It is said that overlarge strings are slow to put into the cut buffer. -;;; Note this value is overridden below. -(defvar x-cut-buffer-max 20000 - "Max number of characters to put in the cut buffer.") - -(defvar x-select-enable-clipboard t - "Non-nil means cutting and pasting uses the clipboard. -This is in addition to the primary selection.") - -(defun x-select-text (text &optional push) - (if x-select-enable-clipboard - (win32-set-clipboard-data text))) - -;;; Return the value of the current selection. -;;; Consult the selection, then the cut buffer. Treat empty strings -;;; as if they were unset. -(defun x-get-selection-value () - (if x-select-enable-clipboard - (let (text) - ;; Don't die if x-get-selection signals an error. - (condition-case c - (setq text (win32-get-clipboard-data)) - (error (message "win32-get-clipboard-data:%s" c))) - (if (string= text "") (setq text nil)) - text))) - -;;; Do the actual Windows setup here; the above code just defines -;;; functions and variables that we use now. - -(setq command-line-args (x-handle-args command-line-args)) - -;;; Make sure we have a valid resource name. -(or (stringp x-resource-name) - (let (i) - (setq x-resource-name (invocation-name)) - - ;; Change any . or * characters in x-resource-name to hyphens, - ;; so as not to choke when we use it in X resource queries. - (while (setq i (string-match "[.*]" x-resource-name)) - (aset x-resource-name i ?-)))) - -;; For the benefit of older Emacses (19.27 and earlier) that are sharing -;; the same lisp directory, don't pass the third argument unless we seem -;; to have the multi-display support. -(if (fboundp 'x-close-connection) - (x-open-connection "" - x-command-line-resources - ;; Exit Emacs with fatal error if this fails. - t) - (x-open-connection "" - x-command-line-resources)) - -(setq frame-creation-function 'x-create-frame-with-faces) - -(setq x-cut-buffer-max (min (- (/ (x-server-max-request-size) 2) 100) - x-cut-buffer-max)) - -;; Win32 expects the menu bar cut and paste commands to use the clipboard. -;; This has ,? to match both on Sunos and on Solaris. -(menu-bar-enable-clipboard) - -;; Apply a geometry resource to the initial frame. Put it at the end -;; of the alist, so that anything specified on the command line takes -;; precedence. -(let* ((res-geometry (x-get-resource "geometry" "Geometry")) - parsed) - (if res-geometry - (progn - (setq parsed (x-parse-geometry res-geometry)) - ;; If the resource specifies a position, - ;; call the position and size "user-specified". - (if (or (assq 'top parsed) (assq 'left parsed)) - (setq parsed (cons '(user-position . t) - (cons '(user-size . t) parsed)))) - ;; All geometry parms apply to the initial frame. - (setq initial-frame-alist (append initial-frame-alist parsed)) - ;; The size parms apply to all frames. - (if (assq 'height parsed) - (setq default-frame-alist - (cons (cons 'height (cdr (assq 'height parsed))) - default-frame-alist))) - (if (assq 'width parsed) - (setq default-frame-alist - (cons (cons 'width (cdr (assq 'width parsed))) - default-frame-alist)))))) - -;; Check the reverseVideo resource. -(let ((case-fold-search t)) - (let ((rv (x-get-resource "reverseVideo" "ReverseVideo"))) - (if (and rv - (string-match "^\\(true\\|yes\\|on\\)$" rv)) - (setq default-frame-alist - (cons '(reverse . t) default-frame-alist))))) - -;; Set x-selection-timeout, measured in milliseconds. -(let ((res-selection-timeout - (x-get-resource "selectionTimeout" "SelectionTimeout"))) - (setq x-selection-timeout 20000) - (if res-selection-timeout - (setq x-selection-timeout (string-to-number res-selection-timeout)))) - -(defun x-win-suspend-error () - (error "Suspending an emacs running under Win32 makes no sense")) -(add-hook 'suspend-hook 'x-win-suspend-error) - -;;; Arrange for the kill and yank functions to set and check the clipboard. -(setq interprogram-cut-function 'x-select-text) -(setq interprogram-paste-function 'x-get-selection-value) - -;;; Turn off window-splitting optimization; win32 is usually fast enough -;;; that this is only annoying. -(setq split-window-keep-point t) - -;; Don't show the frame name; that's redundant. -(setq-default mode-line-buffer-identification '("Emacs: %12b")) - -;;; Set to a system sound if you want a fancy bell. -(set-message-beep 'ok) - -;; Remap some functions to call win32 common dialogs - -(defun internal-face-interactive (what &optional bool) - (let* ((fn (intern (concat "face-" what))) - (prompt (concat "Set " what " of face")) - (face (read-face-name (concat prompt ": "))) - (default (if (fboundp fn) - (or (funcall fn face (selected-frame)) - (funcall fn 'default (selected-frame))))) - (fn-win (intern (concat (symbol-name window-system) "-select-" what))) - (value - (if (fboundp fn-win) - (funcall fn-win) - (if bool - (y-or-n-p (concat "Should face " (symbol-name face) - " be " bool "? ")) - (read-string (concat prompt " " (symbol-name face) " to: ") - default))))) - (list face (if (equal value "") nil value)))) - -;; Redefine the font selection to use the Win32 dialog - -(defun mouse-set-font (&rest fonts) - (interactive) - (set-default-font (win32-select-font))) - -;;; win32-win.el ends here