[bpt/emacs.git] / lisp / term / x-win.el

;; Parse switches controlling how Emacs interfaces with X window system.
;; Copyright (C) 1990 Free Software Foundation, Inc.

;; This file is part of GNU Emacs.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.  Refer to the GNU Emacs General Public
;; License for full details.

;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License.   A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities.  It should be in a
;; file named COPYING.  Among other things, the copyright notice
;; and this notice must be preserved on all copies.


;; X-win.el:  this file is loaded from ../lisp/startup.el when it recognizes
;; that X windows are to be used.  Command line switches are parsed and those
;; pertaining to X are processed and removed from the command line.  The
;; X 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).
\f
;; 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
;; -iconic		.iconic
;; -name		.name
;; -reverse		*reverseVideo
;; -rv			*reverseVideo
;; -selectionTimeout    .selectionTimeout
;; -synchronous		*synchronous
;; -title		.title
;; -xrm

;; An alist of X options and the function which handles them.  See
;; ../startup.el.

(if (not (eq window-system 'x))
    (error "Loading x-win.el but not compiled for X"))
	 
;; This is a temporary work-around while we the separate keymap
;; stuff isn't yet fixed.  These variables aren't used anymore,
;; but the lisp code wants them to exist.  -JimB
(setq global-mouse-map (make-sparse-keymap))
(setq global-function-map (make-sparse-keymap))

(require 'x-mouse)
(require 'screen)

(setq command-switch-alist
      (append '(("-bw" .	x-handle-numeric-switch)
		("-d" .		x-handle-display)
		("-display" .	x-handle-display)
		("-name" .	x-handle-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-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)
		("-ib" .	x-handle-switch)
		("-iconic" .	x-handle-switch)
		("-cr" .	x-handle-switch)
		("-vb" .	x-handle-switch)
		("-hb" .	x-handle-switch)
		("-bd" .	x-handle-switch))
	      command-switch-alist))

(defconst x-switch-definitions
  '(("-name" name)
    ("-T" name)
    ("-r" lose)
    ("-rv" lose)
    ("-reverse" lose)
    ("-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)
    ("-ib" icon-type t)
    ("-iconic" iconic-startup t)
    ("-vb" vertical-scroll-bar t)
    ("-hb" horizontal-scroll-bar 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-screen-alist
		  (cons (cons (nth 1 aelt) (nth 2 aelt))
			default-screen-alist))
	  (setq default-screen-alist
		(cons (cons (nth 1 aelt)
			    (car x-invocation-args))
		      default-screen-alist)
		x-invocation-args (cdr x-invocation-args))))))

;; 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-screen-alist
	      (cons (cons (nth 1 aelt)
			  (string-to-int (car x-invocation-args)))
		    default-screen-alist)
	      x-invocation-args
	      (cdr x-invocation-args)))))

;; Handle the geometry option
(defun x-handle-geometry (switch)
  (setq initial-screen-alist (append initial-screen-alist
				     (x-geometry (car x-invocation-args)))
	x-invocation-args (cdr x-invocation-args)))

(defvar x-display-name nil
  "The X display name specifying server and X screen.")

(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)
  "Here the X-related command line options in ARGS are processed,
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."
  (setq x-invocation-args args
	args nil)
  (while x-invocation-args
    (let* ((this-switch (car x-invocation-args))
	   (aelt (assoc this-switch command-switch-alist)))
      (setq x-invocation-args (cdr x-invocation-args))
      (if aelt
	  (funcall (cdr aelt) this-switch)
	(setq args (cons this-switch args)))))
  (setq args (nreverse args)))


\f
;;
;; Standard X cursor shapes, courtesy of Mr. Fox, who wanted ALL of them.
;;

(defconst x-pointer-X-cursor 0)
(defconst x-pointer-arrow 2)
(defconst x-pointer-based-arrow-down 4)
(defconst x-pointer-based-arrow-up 6)
(defconst x-pointer-boat 8)
(defconst x-pointer-bogosity 10)
(defconst x-pointer-bottom-left-corner 12)
(defconst x-pointer-bottom-right-corner 14)
(defconst x-pointer-bottom-side 16)
(defconst x-pointer-bottom-tee 18)
(defconst x-pointer-box-spiral 20)
(defconst x-pointer-center-ptr 22)
(defconst x-pointer-circle 24)
(defconst x-pointer-clock 26)
(defconst x-pointer-coffee-mug 28)
(defconst x-pointer-cross 30)
(defconst x-pointer-cross-reverse 32)
(defconst x-pointer-crosshair 34)
(defconst x-pointer-diamond-cross 36)
(defconst x-pointer-dot 38)
(defconst x-pointer-dotbox 40)
(defconst x-pointer-double-arrow 42)
(defconst x-pointer-draft-large 44)
(defconst x-pointer-draft-small 46)
(defconst x-pointer-draped-box 48)
(defconst x-pointer-exchange 50)
(defconst x-pointer-fleur 52)
(defconst x-pointer-gobbler 54)
(defconst x-pointer-gumby 56)
(defconst x-pointer-hand1 58)
(defconst x-pointer-hand2 60)
(defconst x-pointer-heart 62)
(defconst x-pointer-icon 64)
(defconst x-pointer-iron-cross 66)
(defconst x-pointer-left-ptr 68)
(defconst x-pointer-left-side 70)
(defconst x-pointer-left-tee 72)
(defconst x-pointer-leftbutton 74)
(defconst x-pointer-ll-angle 76)
(defconst x-pointer-lr-angle 78)
(defconst x-pointer-man 80)
(defconst x-pointer-middlebutton 82)
(defconst x-pointer-mouse 84)
(defconst x-pointer-pencil 86)
(defconst x-pointer-pirate 88)
(defconst x-pointer-plus 90)
(defconst x-pointer-question-arrow 92)
(defconst x-pointer-right-ptr 94)
(defconst x-pointer-right-side 96)
(defconst x-pointer-right-tee 98)
(defconst x-pointer-rightbutton 100)
(defconst x-pointer-rtl-logo 102)
(defconst x-pointer-sailboat 104)
(defconst x-pointer-sb-down-arrow 106)
(defconst x-pointer-sb-h-double-arrow 108)
(defconst x-pointer-sb-left-arrow 110)
(defconst x-pointer-sb-right-arrow 112)
(defconst x-pointer-sb-up-arrow 114)
(defconst x-pointer-sb-v-double-arrow 116)
(defconst x-pointer-shuttle 118)
(defconst x-pointer-sizing 120)
(defconst x-pointer-spider 122)
(defconst x-pointer-spraycan 124)
(defconst x-pointer-star 126)
(defconst x-pointer-target 128)
(defconst x-pointer-tcross 130)
(defconst x-pointer-top-left-arrow 132)
(defconst x-pointer-top-left-corner 134)
(defconst x-pointer-top-right-corner 136)
(defconst x-pointer-top-side 138)
(defconst x-pointer-top-tee 140)
(defconst x-pointer-trek 142)
(defconst x-pointer-ul-angle 144)
(defconst x-pointer-umbrella 146)
(defconst x-pointer-ur-angle 148)
(defconst x-pointer-watch 150)
(defconst x-pointer-xterm 152)
\f
;;
;; 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"
		   "medium goldenrod"
		   "MediumGoldenrod"
		   "green"
		   "Green"
		   "dark green"
		   "DarkGreen"
		   "dark olive green"
		   "DarkOliveGreen"
		   "forest green"
		   "ForestGreen"
		   "lime green"
		   "LimeGreen"
		   "medium forest green"
		   "MediumForestGreen"
		   "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 ()
  "Return a list of colors supported by the current X-Display."
  (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 (x-defined-color this-color)
	   (setq defined-colors (cons this-color defined-colors))))
    defined-colors))
\f
;;;; Function keys

;;; Give some common function keys reasonable definitions.
(define-key global-map [home] 'beginning-of-line)
(define-key global-map [left] 'backward-char)
(define-key global-map [up] 'previous-line)
(define-key global-map [right] 'forward-char)
(define-key global-map [down] 'next-line)
(define-key global-map [prior] 'scroll-down)
(define-key global-map [next] 'scroll-up)
(define-key global-map [begin] 'beginning-of-buffer)
(define-key global-map [end] 'end-of-buffer)

\f
;;; Do the actual X 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))
(x-open-connection (or x-display-name
		       (setq x-display-name (getenv "DISPLAY"))))

;; xterm.c depends on using interrupt-driven input, but we don't want
;; the fcntls to apply to the terminal, so we do this after opening
;; the display.
(set-input-mode t nil t)

(setq screen-creation-function 'x-create-screen)
(setq suspend-hook
      '(lambda ()
	 (error "Suspending an emacs running under X makes no sense")))

;;; Turn off window-splitting optimization; X is usually fast enough
;;; that this is only annoying.
(setq split-window-keep-point t)
Commit	Line	Data
63f77899 JB	1	;; Parse switches controlling how Emacs interfaces with X window system.
	2	;; Copyright (C) 1990 Free Software Foundation, Inc.
	3
	4	;; This file is part of GNU Emacs.
	5
	6	;; GNU Emacs is distributed in the hope that it will be useful,
	7	;; but WITHOUT ANY WARRANTY. No author or distributor
	8	;; accepts responsibility to anyone for the consequences of using it
	9	;; or for whether it serves any particular purpose or works at all,
	10	;; unless he says so in writing. Refer to the GNU Emacs General Public
	11	;; License for full details.
	12
	13	;; Everyone is granted permission to copy, modify and redistribute
	14	;; GNU Emacs, but only under the conditions described in the
	15	;; GNU Emacs General Public License. A copy of this license is
	16	;; supposed to have been given to you along with GNU Emacs so you
	17	;; can know your rights and responsibilities. It should be in a
	18	;; file named COPYING. Among other things, the copyright notice
	19	;; and this notice must be preserved on all copies.
	20
	21
	22	;; X-win.el: this file is loaded from ../lisp/startup.el when it recognizes
	23	;; that X windows are to be used. Command line switches are parsed and those
	24	;; pertaining to X are processed and removed from the command line. The
	25	;; X display is opened and hooks are set for popping up the initial window.
	26
	27	;; startup.el will then examine startup files, and eventually call the hooks
	28	;; which create the first window (s).
	29	\f
	30	;; These are the standard X switches from the Xt Initialize.c file of
	31	;; Release 4.
	32
	33	;; Command line Resource Manager string
	34
	35	;; +rv *reverseVideo
	36	;; +synchronous *synchronous
	37	;; -background *background
	38	;; -bd *borderColor
	39	;; -bg *background
	40	;; -bordercolor *borderColor
	41	;; -borderwidth .borderWidth
	42	;; -bw .borderWidth
	43	;; -display .display
	44	;; -fg *foreground
	45	;; -fn *font
	46	;; -font *font
	47	;; -foreground *foreground
	48	;; -geometry .geometry
	49	;; -iconic .iconic
	50	;; -name .name
	51	;; -reverse *reverseVideo
	52	;; -rv *reverseVideo
	53	;; -selectionTimeout .selectionTimeout
	54	;; -synchronous *synchronous
	55	;; -title .title
	56	;; -xrm
	57
63f77899 JB	58	;; An alist of X options and the function which handles them. See
	59	;; ../startup.el.
	60
63c86e17 JB	61	(if (not (eq window-system 'x))
	62	(error "Loading x-win.el but not compiled for X"))
	63
f4ce8684 JB	64	;; This is a temporary work-around while we the separate keymap
	65	;; stuff isn't yet fixed. These variables aren't used anymore,
	66	;; but the lisp code wants them to exist. -JimB
	67	(setq global-mouse-map (make-sparse-keymap))
	68	(setq global-function-map (make-sparse-keymap))
	69
63c86e17 JB	70	(require 'x-mouse)
	71	(require 'screen)
	72
63f77899	73	(setq command-switch-alist
708c60f8	74	(append '(("-bw" . x-handle-numeric-switch)
63c86e17 JB	75	("-d" . x-handle-display)
	76	("-display" . x-handle-display)
	77	("-name" . x-handle-switch)
	78	("-T" . x-handle-switch)
	79	("-r" . x-handle-switch)
	80	("-rv" . x-handle-switch)
	81	("-reverse" . x-handle-switch)
	82	("-fn" . x-handle-switch)
	83	("-font" . x-handle-switch)
	84	("-ib" . x-handle-switch)
	85	("-g" . x-handle-geometry)
	86	("-geometry" . x-handle-geometry)
	87	("-fg" . x-handle-switch)
	88	("-foreground". x-handle-switch)
	89	("-bg" . x-handle-switch)
	90	("-background". x-handle-switch)
	91	("-ms" . x-handle-switch)
	92	("-ib" . x-handle-switch)
	93	("-iconic" . x-handle-switch)
	94	("-cr" . x-handle-switch)
	95	("-vb" . x-handle-switch)
	96	("-hb" . x-handle-switch)
	97	("-bd" . x-handle-switch))
63f77899 JB	98	command-switch-alist))
63f77899 JB	99
63f77899 JB	100	(defconst x-switch-definitions
	101	'(("-name" name)
	102	("-T" name)
	103	("-r" lose)
	104	("-rv" lose)
	105	("-reverse" lose)
	106	("-fn" font)
	107	("-font" font)
	108	("-ib" internal-border-width)
	109	("-fg" foreground-color)
	110	("-foreground" foreground-color)
	111	("-bg" background-color)
	112	("-background" background-color)
	113	("-ms" mouse-color)
	114	("-cr" cursor-color)
	115	("-ib" icon-type t)
	116	("-iconic" iconic-startup t)
	117	("-vb" vertical-scroll-bar t)
	118	("-hb" horizontal-scroll-bar t)
	119	("-bd" border-color)
	120	("-bw" border-width)))
	121
	122	;; Handler for switches of the form "-switch value" or "-switch".
	123	(defun x-handle-switch (switch)
	124	(let ((aelt (assoc switch x-switch-definitions)))
	125	(if aelt
	126	(if (nth 2 aelt)
4f0f077c	127	(setq default-screen-alist
63f77899	128	(cons (cons (nth 1 aelt) (nth 2 aelt))
4f0f077c JB	129	default-screen-alist))
4f0f077c JB	130	(setq default-screen-alist
63f77899 JB	131	(cons (cons (nth 1 aelt)
63f77899 JB	132	(car x-invocation-args))
4f0f077c	133	default-screen-alist)
63f77899 JB	134	x-invocation-args (cdr x-invocation-args))))))
	135
	136	;; Handler for switches of the form "-switch n"
	137	(defun x-handle-numeric-switch (switch)
	138	(let ((aelt (assoc switch x-switch-definitions)))
	139	(if aelt
4f0f077c	140	(setq default-screen-alist
63f77899 JB	141	(cons (cons (nth 1 aelt)
63f77899 JB	142	(string-to-int (car x-invocation-args)))
4f0f077c	143	default-screen-alist)
63f77899 JB	144	x-invocation-args
	145	(cdr x-invocation-args)))))
	146
	147	;; Handle the geometry option
	148	(defun x-handle-geometry (switch)
b54621ea	149	(setq initial-screen-alist (append initial-screen-alist
63f77899 JB	150	(x-geometry (car x-invocation-args)))
	151	x-invocation-args (cdr x-invocation-args)))
	152
63f77899 JB	153	(defvar x-display-name nil
	154	"The X display name specifying server and X screen.")
	155
	156	(defun x-handle-display (switch)
	157	(setq x-display-name (car x-invocation-args)
	158	x-invocation-args (cdr x-invocation-args)))
	159
63f77899 JB	160	(defvar x-invocation-args nil)
63f77899 JB	161
8769d648 JB	162	(defun x-handle-args (args)
	163	"Here the X-related command line options in ARGS are processed,
	164	before the user's startup file is loaded. They are copied to
	165	x-invocation args from which the X-related things are extracted, first
	166	the switch (e.g., \"-fg\") in the following code, and possible values
	167	(e.g., \"black\") in the option handler code (e.g., x-handle-switch).
	168	This returns ARGS with the arguments that have been processed removed."
63c86e17 JB	169	(setq x-invocation-args args
	170	args nil)
	171	(while x-invocation-args
	172	(let* ((this-switch (car x-invocation-args))
	173	(aelt (assoc this-switch command-switch-alist)))
	174	(setq x-invocation-args (cdr x-invocation-args))
	175	(if aelt
	176	(funcall (cdr aelt) this-switch)
	177	(setq args (cons this-switch args)))))
	178	(setq args (nreverse args)))
	179
b54621ea	180
63f77899 JB	181	\f
	182	;;
	183	;; Standard X cursor shapes, courtesy of Mr. Fox, who wanted ALL of them.
	184	;;
	185
	186	(defconst x-pointer-X-cursor 0)
	187	(defconst x-pointer-arrow 2)
	188	(defconst x-pointer-based-arrow-down 4)
	189	(defconst x-pointer-based-arrow-up 6)
	190	(defconst x-pointer-boat 8)
	191	(defconst x-pointer-bogosity 10)
	192	(defconst x-pointer-bottom-left-corner 12)
	193	(defconst x-pointer-bottom-right-corner 14)
	194	(defconst x-pointer-bottom-side 16)
	195	(defconst x-pointer-bottom-tee 18)
	196	(defconst x-pointer-box-spiral 20)
	197	(defconst x-pointer-center-ptr 22)
	198	(defconst x-pointer-circle 24)
	199	(defconst x-pointer-clock 26)
	200	(defconst x-pointer-coffee-mug 28)
	201	(defconst x-pointer-cross 30)
	202	(defconst x-pointer-cross-reverse 32)
	203	(defconst x-pointer-crosshair 34)
	204	(defconst x-pointer-diamond-cross 36)
	205	(defconst x-pointer-dot 38)
	206	(defconst x-pointer-dotbox 40)
	207	(defconst x-pointer-double-arrow 42)
	208	(defconst x-pointer-draft-large 44)
	209	(defconst x-pointer-draft-small 46)
	210	(defconst x-pointer-draped-box 48)
	211	(defconst x-pointer-exchange 50)
	212	(defconst x-pointer-fleur 52)
	213	(defconst x-pointer-gobbler 54)
	214	(defconst x-pointer-gumby 56)
	215	(defconst x-pointer-hand1 58)
	216	(defconst x-pointer-hand2 60)
	217	(defconst x-pointer-heart 62)
	218	(defconst x-pointer-icon 64)
	219	(defconst x-pointer-iron-cross 66)
	220	(defconst x-pointer-left-ptr 68)
	221	(defconst x-pointer-left-side 70)
	222	(defconst x-pointer-left-tee 72)
	223	(defconst x-pointer-leftbutton 74)
	224	(defconst x-pointer-ll-angle 76)
	225	(defconst x-pointer-lr-angle 78)
	226	(defconst x-pointer-man 80)
	227	(defconst x-pointer-middlebutton 82)
	228	(defconst x-pointer-mouse 84)
	229	(defconst x-pointer-pencil 86)
	230	(defconst x-pointer-pirate 88)
	231	(defconst x-pointer-plus 90)
	232	(defconst x-pointer-question-arrow 92)
	233	(defconst x-pointer-right-ptr 94)
	234	(defconst x-pointer-right-side 96)
	235	(defconst x-pointer-right-tee 98)
	236	(defconst x-pointer-rightbutton 100)
	237	(defconst x-pointer-rtl-logo 102)
	238	(defconst x-pointer-sailboat 104)
	239	(defconst x-pointer-sb-down-arrow 106)
	240	(defconst x-pointer-sb-h-double-arrow 108)
	241	(defconst x-pointer-sb-left-arrow 110)
	242	(defconst x-pointer-sb-right-arrow 112)
	243	(defconst x-pointer-sb-up-arrow 114)
	244	(defconst x-pointer-sb-v-double-arrow 116)
245	(defconst x-pointer-shuttle 118)
246	(defconst x-pointer-sizing 120)
247	(defconst x-pointer-spider 122)
248	(defconst x-pointer-spraycan 124)
249	(defconst x-pointer-star 126)
250	(defconst x-pointer-target 128)
251	(defconst x-pointer-tcross 130)
252	(defconst x-pointer-top-left-arrow 132)
253	(defconst x-pointer-top-left-corner 134)
254	(defconst x-pointer-top-right-corner 136)
255	(defconst x-pointer-top-side 138)
256	(defconst x-pointer-top-tee 140)
257	(defconst x-pointer-trek 142)
258	(defconst x-pointer-ul-angle 144)
259	(defconst x-pointer-umbrella 146)
260	(defconst x-pointer-ur-angle 148)
261	(defconst x-pointer-watch 150)
262	(defconst x-pointer-xterm 152)
263	\f
264	;;
265	;; Available colors
266	;;
267
268	(defvar x-colors '("aquamarine"
269	"Aquamarine"
270	"medium aquamarine"
271	"MediumAquamarine"
272	"black"
273	"Black"
274	"blue"
275	"Blue"
276	"cadet blue"
277	"CadetBlue"
278	"cornflower blue"
279	"CornflowerBlue"
280	"dark slate blue"
281	"DarkSlateBlue"
282	"light blue"
283	"LightBlue"
284	"light steel blue"
285	"LightSteelBlue"
286	"medium blue"
287	"MediumBlue"
288	"medium slate blue"
289	"MediumSlateBlue"
290	"midnight blue"
291	"MidnightBlue"
292	"navy blue"
293	"NavyBlue"
294	"navy"
295	"Navy"
296	"sky blue"
297	"SkyBlue"
298	"slate blue"
299	"SlateBlue"
300	"steel blue"
301	"SteelBlue"
302	"coral"
303	"Coral"
304	"cyan"
305	"Cyan"
306	"firebrick"
307	"Firebrick"
308	"brown"
309	"Brown"
310	"gold"
311	"Gold"
312	"goldenrod"
313	"Goldenrod"
314	"medium goldenrod"
315	"MediumGoldenrod"
316	"green"
317	"Green"
318	"dark green"
319	"DarkGreen"
320	"dark olive green"
321	"DarkOliveGreen"
322	"forest green"
323	"ForestGreen"
324	"lime green"
325	"LimeGreen"
326	"medium forest green"
327	"MediumForestGreen"
328	"medium sea green"
329	"MediumSeaGreen"
330	"medium spring green"
331	"MediumSpringGreen"
332	"pale green"
333	"PaleGreen"
334	"sea green"
335	"SeaGreen"
336	"spring green"
337	"SpringGreen"
338	"yellow green"
339	"YellowGreen"
340	"dark slate grey"
341	"DarkSlateGrey"
342	"dark slate gray"
343	"DarkSlateGray"
344	"dim grey"
345	"DimGrey"
346	"dim gray"
347	"DimGray"
348	"light grey"
349	"LightGrey"
350	"light gray"
351	"LightGray"
352	"gray"
353	"grey"
354	"Gray"
355	"Grey"
356	"khaki"
357	"Khaki"
358	"magenta"
359	"Magenta"
360	"maroon"
361	"Maroon"
362	"orange"
363	"Orange"
364	"orchid"
365	"Orchid"
366	"dark orchid"
367	"DarkOrchid"
368	"medium orchid"
369	"MediumOrchid"
370	"pink"
371	"Pink"
372	"plum"
373	"Plum"
374	"red"
375	"Red"
376	"indian red"
377	"IndianRed"
378	"medium violet red"
379	"MediumVioletRed"
380	"orange red"
381	"OrangeRed"
382	"violet red"
383	"VioletRed"
384	"salmon"
385	"Salmon"
386	"sienna"
387	"Sienna"
388	"tan"
389	"Tan"
390	"thistle"
391	"Thistle"
392	"turquoise"
393	"Turquoise"
394	"dark turquoise"
395	"DarkTurquoise"
396	"medium turquoise"
397	"MediumTurquoise"
398	"violet"
399	"Violet"
400	"blue violet"
401	"BlueViolet"
402	"wheat"
403	"Wheat"
404	"white"
405	"White"
406	"yellow"
407	"Yellow"
408	"green yellow"
409	"GreenYellow")
410	"The full list of X colors from the rgb.text file.")
411
412	(defun x-defined-colors ()
413	"Return a list of colors supported by the current X-Display."
414	(let ((all-colors x-colors)
415	(this-color nil)
416	(defined-colors nil))
417	(while all-colors
418	(setq this-color (car all-colors)
419	all-colors (cdr all-colors))
420	(and (x-defined-color this-color)
421	(setq defined-colors (cons this-color defined-colors))))
422	defined-colors))
63f77899	423	\f
98bf0c8d JB	424	;;;; Function keys
	425
	426	;;; Give some common function keys reasonable definitions.
	427	(define-key global-map [home] 'beginning-of-line)
	428	(define-key global-map [left] 'backward-char)
	429	(define-key global-map [up] 'previous-line)
	430	(define-key global-map [right] 'forward-char)
	431	(define-key global-map [down] 'next-line)
	432	(define-key global-map [prior] 'scroll-down)
	433	(define-key global-map [next] 'scroll-up)
	434	(define-key global-map [begin] 'beginning-of-buffer)
	435	(define-key global-map [end] 'end-of-buffer)
63c86e17	436
98bf0c8d	437	\f
b54621ea JB	438	;;; Do the actual X Windows setup here; the above code just defines
b54621ea JB	439	;;; functions and variables that we use now.
63c86e17	440
708c60f8	441	(setq command-line-args (x-handle-args command-line-args))
63c86e17 JB	442	(x-open-connection (or x-display-name
63c86e17 JB	443	(setq x-display-name (getenv "DISPLAY"))))
e9de784c JB	444
	445	;; xterm.c depends on using interrupt-driven input, but we don't want
	446	;; the fcntls to apply to the terminal, so we do this after opening
	447	;; the display.
	448	(set-input-mode t nil t)
	449
67dbf5b0	450	(setq screen-creation-function 'x-create-screen)
63c86e17 JB	451	(setq suspend-hook
	452	'(lambda ()
	453	(error "Suspending an emacs running under X makes no sense")))
	454
0cc6db57 JB	455	;;; Turn off window-splitting optimization; X is usually fast enough
	456	;;; that this is only annoying.
	457	(setq split-window-keep-point t)