;;; x-win.el --- parse relevant switches and set up for X -*-coding: iso-2022-7bit;-*-
-;; Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
+;; 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: FSF
;; Keywords: terminals, i18n
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, 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
;; 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, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; system and process X-specific command line parameters before
;; creating the first X frame.
-;; Note that contrary to previous Emacs versions, the act of loading
-;; this file should not have the side effect of initializing the
-;; window system or processing command line arguments (this file is
-;; now loaded in loadup.el). See the variables
-;; `handle-args-function-alist' and
+;; Beginning in Emacs 23, the act of loading this file should not have
+;; the side effect of initializing the window system or processing
+;; command line arguments (this file is now loaded in loadup.el). See
+;; the variables `handle-args-function-alist' and
;; `window-system-initialization-alist' for more details.
;; startup.el will then examine startup files, and eventually call the hooks
(defvar x-session-id)
(defvar x-session-previous-id)
-(defvar x-command-line-resources nil)
-
-;; Handler for switches of the form "-switch value" or "-switch".
-(defun x-handle-switch (switch)
- (let ((aelt (assoc switch command-line-x-option-alist)))
- (if aelt
- (let ((param (nth 3 aelt))
- (value (nth 4 aelt)))
- (if value
- (setq default-frame-alist
- (cons (cons param value)
- default-frame-alist))
- (setq default-frame-alist
- (cons (cons param
- (car x-invocation-args))
- default-frame-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 command-line-x-option-alist)))
- (if aelt
- (let ((param (nth 3 aelt)))
- (setq default-frame-alist
- (cons (cons param
- (string-to-number (car x-invocation-args)))
- default-frame-alist)
- x-invocation-args
- (cdr x-invocation-args))))))
-
-;; Handle options that apply to initial frame only
-(defun x-handle-initial-switch (switch)
- (let ((aelt (assoc switch command-line-x-option-alist)))
- (if aelt
- (let ((param (nth 3 aelt))
- (value (nth 4 aelt)))
- (if value
- (setq initial-frame-alist
- (cons (cons param value)
- initial-frame-alist))
- (setq initial-frame-alist
- (cons (cons param
- (car x-invocation-args))
- initial-frame-alist)
- x-invocation-args (cdr x-invocation-args)))))))
-
(defun x-handle-no-bitmap-icon (switch)
(setq default-frame-alist (cons '(icon-type) default-frame-alist)))
-;; Make -iconic apply only to the initial frame!
-(defun x-handle-iconic (switch)
- (setq initial-frame-alist
- (cons '(visibility . icon) initial-frame-alist)))
-
-;; Handle the -xrm option.
-(defun x-handle-xrm-switch (switch)
- (unless (consp x-invocation-args)
- (error "%s: missing argument to `%s' option" (invocation-name) switch))
- (setq x-command-line-resources
- (if (null x-command-line-resources)
- (car x-invocation-args)
- (concat x-command-line-resources "\n" (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)))
- (left (assq 'left geo))
- (top (assq 'top geo))
- (height (assq 'height geo))
- (width (assq 'width geo)))
- (if (or height width)
- (setq default-frame-alist
- (append default-frame-alist
- '((user-size . t))
- (if height (list height))
- (if width (list width)))
- initial-frame-alist
- (append initial-frame-alist
- '((user-size . t))
- (if height (list height))
- (if width (list width)))))
- (if (or left top)
- (setq initial-frame-alist
- (append initial-frame-alist
- '((user-position . t))
- (if left (list left))
- (if top (list top)))))
- (setq x-invocation-args (cdr x-invocation-args))))
-
-;; Handle the -name option. Set the variable x-resource-name
-;; to the option's operand; set the name of
-;; the initial frame, too.
-(defun x-handle-name-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))
- (setq initial-frame-alist (cons (cons 'name x-resource-name)
- initial-frame-alist)))
-
;; Handle the --parent-id option.
(defun x-handle-parent-id (switch)
(or (consp x-invocation-args)
initial-frame-alist)
x-invocation-args (cdr x-invocation-args)))
-(defvar x-display-name nil
- "The name of the X display on which Emacs was started.
-
-For the X display name of individual frames, see the `display'
-frame parameter.")
-
-(defun x-handle-display (switch)
- "Handle -display DISPLAY option."
- (setq x-display-name (car x-invocation-args)
- x-invocation-args (cdr x-invocation-args))
- ;; Make subshell programs see the same DISPLAY value Emacs really uses.
- ;; Note that this isn't completely correct, since Emacs can use
- ;; multiple displays. However, there is no way to tell an already
- ;; running subshell which display the user is currently typing on.
- (setenv "DISPLAY" x-display-name))
-
-(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 function returns ARGS minus the arguments that have been processed."
- ;; We use ARGS to accumulate the args that we don't handle here, to return.
- (setq x-invocation-args args
- args nil)
- (while (and x-invocation-args
- (not (equal (car x-invocation-args) "--")))
- (let* ((this-switch (car x-invocation-args))
- (orig-this-switch this-switch)
- completion argval aelt handler)
- (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)))))
- ;; Complete names of long options.
- (if (string-match "^--" this-switch)
- (progn
- (setq completion (try-completion this-switch command-line-x-option-alist))
- (if (eq completion t)
- ;; Exact match for long option.
- nil
- (if (stringp completion)
- (let ((elt (assoc completion command-line-x-option-alist)))
- ;; Check for abbreviated long option.
- (or elt
- (error "Option `%s' is ambiguous" this-switch))
- (setq this-switch completion))))))
- (setq aelt (assoc this-switch command-line-x-option-alist))
- (if aelt (setq handler (nth 2 aelt)))
- (if handler
- (if argval
- (let ((x-invocation-args
- (cons argval x-invocation-args)))
- (funcall handler this-switch))
- (funcall handler this-switch))
- (setq args (cons orig-this-switch args)))))
- (nconc (nreverse args) x-invocation-args))
-
;; Handle the --smid switch. This is used by the session manager
;; to give us back our session id we had on the previous run.
(defun x-handle-smid (switch)
down, this function is called. It calls the functions in the hook
`emacs-save-session-functions'. Functions are called with the current
buffer set to a temporary buffer. Functions should use `insert' to insert
-lisp code to save the session state. The buffer is saved
-in a file in the home directory of the user running Emacs. The file
-is evaluated when Emacs is restarted by the session manager.
+lisp code to save the session state. The buffer is saved in a file in the
+home directory of the user running Emacs. The file is evaluated when
+Emacs is restarted by the session manager.
If any of the functions returns non-nil, no more functions are called
and this function returns non-nil. This will inform the session manager
(defconst x-pointer-watch 150)
(defconst x-pointer-xterm 152)
(defconst x-pointer-invisible 255)
-\f
-;;
-;; Available colors
-;;
-(defvar x-colors '("LightGreen"
- "light green"
- "DarkRed"
- "dark red"
- "DarkMagenta"
- "dark magenta"
- "DarkCyan"
- "dark cyan"
- "DarkBlue"
- "dark blue"
- "DarkGray"
- "dark gray"
- "DarkGrey"
- "dark grey"
- "grey100"
- "gray100"
- "grey99"
- "gray99"
- "grey98"
- "gray98"
- "grey97"
- "gray97"
- "grey96"
- "gray96"
- "grey95"
- "gray95"
- "grey94"
- "gray94"
- "grey93"
- "gray93"
- "grey92"
- "gray92"
- "grey91"
- "gray91"
- "grey90"
- "gray90"
- "grey89"
- "gray89"
- "grey88"
- "gray88"
- "grey87"
- "gray87"
- "grey86"
- "gray86"
- "grey85"
- "gray85"
- "grey84"
- "gray84"
- "grey83"
- "gray83"
- "grey82"
- "gray82"
- "grey81"
- "gray81"
- "grey80"
- "gray80"
- "grey79"
- "gray79"
- "grey78"
- "gray78"
- "grey77"
- "gray77"
- "grey76"
- "gray76"
- "grey75"
- "gray75"
- "grey74"
- "gray74"
- "grey73"
- "gray73"
- "grey72"
- "gray72"
- "grey71"
- "gray71"
- "grey70"
- "gray70"
- "grey69"
- "gray69"
- "grey68"
- "gray68"
- "grey67"
- "gray67"
- "grey66"
- "gray66"
- "grey65"
- "gray65"
- "grey64"
- "gray64"
- "grey63"
- "gray63"
- "grey62"
- "gray62"
- "grey61"
- "gray61"
- "grey60"
- "gray60"
- "grey59"
- "gray59"
- "grey58"
- "gray58"
- "grey57"
- "gray57"
- "grey56"
- "gray56"
- "grey55"
- "gray55"
- "grey54"
- "gray54"
- "grey53"
- "gray53"
- "grey52"
- "gray52"
- "grey51"
- "gray51"
- "grey50"
- "gray50"
- "grey49"
- "gray49"
- "grey48"
- "gray48"
- "grey47"
- "gray47"
- "grey46"
- "gray46"
- "grey45"
- "gray45"
- "grey44"
- "gray44"
- "grey43"
- "gray43"
- "grey42"
- "gray42"
- "grey41"
- "gray41"
- "grey40"
- "gray40"
- "grey39"
- "gray39"
- "grey38"
- "gray38"
- "grey37"
- "gray37"
- "grey36"
- "gray36"
- "grey35"
- "gray35"
- "grey34"
- "gray34"
- "grey33"
- "gray33"
- "grey32"
- "gray32"
- "grey31"
- "gray31"
- "grey30"
- "gray30"
- "grey29"
- "gray29"
- "grey28"
- "gray28"
- "grey27"
- "gray27"
- "grey26"
- "gray26"
- "grey25"
- "gray25"
- "grey24"
- "gray24"
- "grey23"
- "gray23"
- "grey22"
- "gray22"
- "grey21"
- "gray21"
- "grey20"
- "gray20"
- "grey19"
- "gray19"
- "grey18"
- "gray18"
- "grey17"
- "gray17"
- "grey16"
- "gray16"
- "grey15"
- "gray15"
- "grey14"
- "gray14"
- "grey13"
- "gray13"
- "grey12"
- "gray12"
- "grey11"
- "gray11"
- "grey10"
- "gray10"
- "grey9"
- "gray9"
- "grey8"
- "gray8"
- "grey7"
- "gray7"
- "grey6"
- "gray6"
- "grey5"
- "gray5"
- "grey4"
- "gray4"
- "grey3"
- "gray3"
- "grey2"
- "gray2"
- "grey1"
- "gray1"
- "grey0"
- "gray0"
- "thistle4"
- "thistle3"
- "thistle2"
- "thistle1"
- "MediumPurple4"
- "MediumPurple3"
- "MediumPurple2"
- "MediumPurple1"
- "purple4"
- "purple3"
- "purple2"
- "purple1"
- "DarkOrchid4"
- "DarkOrchid3"
- "DarkOrchid2"
- "DarkOrchid1"
- "MediumOrchid4"
- "MediumOrchid3"
- "MediumOrchid2"
- "MediumOrchid1"
- "plum4"
- "plum3"
- "plum2"
- "plum1"
- "orchid4"
- "orchid3"
- "orchid2"
- "orchid1"
- "magenta4"
- "magenta3"
- "magenta2"
- "magenta1"
- "VioletRed4"
- "VioletRed3"
- "VioletRed2"
- "VioletRed1"
- "maroon4"
- "maroon3"
- "maroon2"
- "maroon1"
- "PaleVioletRed4"
- "PaleVioletRed3"
- "PaleVioletRed2"
- "PaleVioletRed1"
- "LightPink4"
- "LightPink3"
- "LightPink2"
- "LightPink1"
- "pink4"
- "pink3"
- "pink2"
- "pink1"
- "HotPink4"
- "HotPink3"
- "HotPink2"
- "HotPink1"
- "DeepPink4"
- "DeepPink3"
- "DeepPink2"
- "DeepPink1"
- "red4"
- "red3"
- "red2"
- "red1"
- "OrangeRed4"
- "OrangeRed3"
- "OrangeRed2"
- "OrangeRed1"
- "tomato4"
- "tomato3"
- "tomato2"
- "tomato1"
- "coral4"
- "coral3"
- "coral2"
- "coral1"
- "DarkOrange4"
- "DarkOrange3"
- "DarkOrange2"
- "DarkOrange1"
- "orange4"
- "orange3"
- "orange2"
- "orange1"
- "LightSalmon4"
- "LightSalmon3"
- "LightSalmon2"
- "LightSalmon1"
- "salmon4"
- "salmon3"
- "salmon2"
- "salmon1"
- "brown4"
- "brown3"
- "brown2"
- "brown1"
- "firebrick4"
- "firebrick3"
- "firebrick2"
- "firebrick1"
- "chocolate4"
- "chocolate3"
- "chocolate2"
- "chocolate1"
- "tan4"
- "tan3"
- "tan2"
- "tan1"
- "wheat4"
- "wheat3"
- "wheat2"
- "wheat1"
- "burlywood4"
- "burlywood3"
- "burlywood2"
- "burlywood1"
- "sienna4"
- "sienna3"
- "sienna2"
- "sienna1"
- "IndianRed4"
- "IndianRed3"
- "IndianRed2"
- "IndianRed1"
- "RosyBrown4"
- "RosyBrown3"
- "RosyBrown2"
- "RosyBrown1"
- "DarkGoldenrod4"
- "DarkGoldenrod3"
- "DarkGoldenrod2"
- "DarkGoldenrod1"
- "goldenrod4"
- "goldenrod3"
- "goldenrod2"
- "goldenrod1"
- "gold4"
- "gold3"
- "gold2"
- "gold1"
- "yellow4"
- "yellow3"
- "yellow2"
- "yellow1"
- "LightYellow4"
- "LightYellow3"
- "LightYellow2"
- "LightYellow1"
- "LightGoldenrod4"
- "LightGoldenrod3"
- "LightGoldenrod2"
- "LightGoldenrod1"
- "khaki4"
- "khaki3"
- "khaki2"
- "khaki1"
- "DarkOliveGreen4"
- "DarkOliveGreen3"
- "DarkOliveGreen2"
- "DarkOliveGreen1"
- "OliveDrab4"
- "OliveDrab3"
- "OliveDrab2"
- "OliveDrab1"
- "chartreuse4"
- "chartreuse3"
- "chartreuse2"
- "chartreuse1"
- "green4"
- "green3"
- "green2"
- "green1"
- "SpringGreen4"
- "SpringGreen3"
- "SpringGreen2"
- "SpringGreen1"
- "PaleGreen4"
- "PaleGreen3"
- "PaleGreen2"
- "PaleGreen1"
- "SeaGreen4"
- "SeaGreen3"
- "SeaGreen2"
- "SeaGreen1"
- "DarkSeaGreen4"
- "DarkSeaGreen3"
- "DarkSeaGreen2"
- "DarkSeaGreen1"
- "aquamarine4"
- "aquamarine3"
- "aquamarine2"
- "aquamarine1"
- "DarkSlateGray4"
- "DarkSlateGray3"
- "DarkSlateGray2"
- "DarkSlateGray1"
- "cyan4"
- "cyan3"
- "cyan2"
- "cyan1"
- "turquoise4"
- "turquoise3"
- "turquoise2"
- "turquoise1"
- "CadetBlue4"
- "CadetBlue3"
- "CadetBlue2"
- "CadetBlue1"
- "PaleTurquoise4"
- "PaleTurquoise3"
- "PaleTurquoise2"
- "PaleTurquoise1"
- "LightCyan4"
- "LightCyan3"
- "LightCyan2"
- "LightCyan1"
- "LightBlue4"
- "LightBlue3"
- "LightBlue2"
- "LightBlue1"
- "LightSteelBlue4"
- "LightSteelBlue3"
- "LightSteelBlue2"
- "LightSteelBlue1"
- "SlateGray4"
- "SlateGray3"
- "SlateGray2"
- "SlateGray1"
- "LightSkyBlue4"
- "LightSkyBlue3"
- "LightSkyBlue2"
- "LightSkyBlue1"
- "SkyBlue4"
- "SkyBlue3"
- "SkyBlue2"
- "SkyBlue1"
- "DeepSkyBlue4"
- "DeepSkyBlue3"
- "DeepSkyBlue2"
- "DeepSkyBlue1"
- "SteelBlue4"
- "SteelBlue3"
- "SteelBlue2"
- "SteelBlue1"
- "DodgerBlue4"
- "DodgerBlue3"
- "DodgerBlue2"
- "DodgerBlue1"
- "blue4"
- "blue3"
- "blue2"
- "blue1"
- "RoyalBlue4"
- "RoyalBlue3"
- "RoyalBlue2"
- "RoyalBlue1"
- "SlateBlue4"
- "SlateBlue3"
- "SlateBlue2"
- "SlateBlue1"
- "azure4"
- "azure3"
- "azure2"
- "azure1"
- "MistyRose4"
- "MistyRose3"
- "MistyRose2"
- "MistyRose1"
- "LavenderBlush4"
- "LavenderBlush3"
- "LavenderBlush2"
- "LavenderBlush1"
- "honeydew4"
- "honeydew3"
- "honeydew2"
- "honeydew1"
- "ivory4"
- "ivory3"
- "ivory2"
- "ivory1"
- "cornsilk4"
- "cornsilk3"
- "cornsilk2"
- "cornsilk1"
- "LemonChiffon4"
- "LemonChiffon3"
- "LemonChiffon2"
- "LemonChiffon1"
- "NavajoWhite4"
- "NavajoWhite3"
- "NavajoWhite2"
- "NavajoWhite1"
- "PeachPuff4"
- "PeachPuff3"
- "PeachPuff2"
- "PeachPuff1"
- "bisque4"
- "bisque3"
- "bisque2"
- "bisque1"
- "AntiqueWhite4"
- "AntiqueWhite3"
- "AntiqueWhite2"
- "AntiqueWhite1"
- "seashell4"
- "seashell3"
- "seashell2"
- "seashell1"
- "snow4"
- "snow3"
- "snow2"
- "snow1"
- "thistle"
- "MediumPurple"
- "medium purple"
- "purple"
- "BlueViolet"
- "blue violet"
- "DarkViolet"
- "dark violet"
- "DarkOrchid"
- "dark orchid"
- "MediumOrchid"
- "medium orchid"
- "orchid"
- "plum"
- "violet"
- "magenta"
- "VioletRed"
- "violet red"
- "MediumVioletRed"
- "medium violet red"
- "maroon"
- "PaleVioletRed"
- "pale violet red"
- "LightPink"
- "light pink"
- "pink"
- "DeepPink"
- "deep pink"
- "HotPink"
- "hot pink"
- "red"
- "OrangeRed"
- "orange red"
- "tomato"
- "LightCoral"
- "light coral"
- "coral"
- "DarkOrange"
- "dark orange"
- "orange"
- "LightSalmon"
- "light salmon"
- "salmon"
- "DarkSalmon"
- "dark salmon"
- "brown"
- "firebrick"
- "chocolate"
- "tan"
- "SandyBrown"
- "sandy brown"
- "wheat"
- "beige"
- "burlywood"
- "peru"
- "sienna"
- "SaddleBrown"
- "saddle brown"
- "IndianRed"
- "indian red"
- "RosyBrown"
- "rosy brown"
- "DarkGoldenrod"
- "dark goldenrod"
- "goldenrod"
- "LightGoldenrod"
- "light goldenrod"
- "gold"
- "yellow"
- "LightYellow"
- "light yellow"
- "LightGoldenrodYellow"
- "light goldenrod yellow"
- "PaleGoldenrod"
- "pale goldenrod"
- "khaki"
- "DarkKhaki"
- "dark khaki"
- "OliveDrab"
- "olive drab"
- "ForestGreen"
- "forest green"
- "YellowGreen"
- "yellow green"
- "LimeGreen"
- "lime green"
- "GreenYellow"
- "green yellow"
- "MediumSpringGreen"
- "medium spring green"
- "chartreuse"
- "green"
- "LawnGreen"
- "lawn green"
- "SpringGreen"
- "spring green"
- "PaleGreen"
- "pale green"
- "LightSeaGreen"
- "light sea green"
- "MediumSeaGreen"
- "medium sea green"
- "SeaGreen"
- "sea green"
- "DarkSeaGreen"
- "dark sea green"
- "DarkOliveGreen"
- "dark olive green"
- "DarkGreen"
- "dark green"
- "aquamarine"
- "MediumAquamarine"
- "medium aquamarine"
- "CadetBlue"
- "cadet blue"
- "LightCyan"
- "light cyan"
- "cyan"
- "turquoise"
- "MediumTurquoise"
- "medium turquoise"
- "DarkTurquoise"
- "dark turquoise"
- "PaleTurquoise"
- "pale turquoise"
- "PowderBlue"
- "powder blue"
- "LightBlue"
- "light blue"
- "LightSteelBlue"
- "light steel blue"
- "SteelBlue"
- "steel blue"
- "LightSkyBlue"
- "light sky blue"
- "SkyBlue"
- "sky blue"
- "DeepSkyBlue"
- "deep sky blue"
- "DodgerBlue"
- "dodger blue"
- "blue"
- "RoyalBlue"
- "royal blue"
- "MediumBlue"
- "medium blue"
- "LightSlateBlue"
- "light slate blue"
- "MediumSlateBlue"
- "medium slate blue"
- "SlateBlue"
- "slate blue"
- "DarkSlateBlue"
- "dark slate blue"
- "CornflowerBlue"
- "cornflower blue"
- "NavyBlue"
- "navy blue"
- "navy"
- "MidnightBlue"
- "midnight blue"
- "LightGray"
- "light gray"
- "LightGrey"
- "light grey"
- "grey"
- "gray"
- "LightSlateGrey"
- "light slate grey"
- "LightSlateGray"
- "light slate gray"
- "SlateGrey"
- "slate grey"
- "SlateGray"
- "slate gray"
- "DimGrey"
- "dim grey"
- "DimGray"
- "dim gray"
- "DarkSlateGrey"
- "dark slate grey"
- "DarkSlateGray"
- "dark slate gray"
- "black"
- "white"
- "MistyRose"
- "misty rose"
- "LavenderBlush"
- "lavender blush"
- "lavender"
- "AliceBlue"
- "alice blue"
- "azure"
- "MintCream"
- "mint cream"
- "honeydew"
- "seashell"
- "LemonChiffon"
- "lemon chiffon"
- "ivory"
- "cornsilk"
- "moccasin"
- "NavajoWhite"
- "navajo white"
- "PeachPuff"
- "peach puff"
- "bisque"
- "BlanchedAlmond"
- "blanched almond"
- "PapayaWhip"
- "papaya whip"
- "AntiqueWhite"
- "antique white"
- "linen"
- "OldLace"
- "old lace"
- "FloralWhite"
- "floral white"
- "gainsboro"
- "WhiteSmoke"
- "white smoke"
- "GhostWhite"
- "ghost white"
- "snow")
- "The list of X colors from the `rgb.txt' file.
-XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp")
+\f
+(defvar x-colors)
(defun xw-defined-colors (&optional frame)
- "Internal function called by `defined-colors', which see."
+ "Internal function called by `defined-colors'."
(or frame (setq frame (selected-frame)))
(let ((all-colors x-colors)
(this-color nil)
(defvar x-alternatives-map
(let ((map (make-sparse-keymap)))
;; Map certain keypad keys into ASCII characters that people usually expect.
- (define-key map [backspace] [127])
- (define-key map [delete] [127])
- (define-key map [tab] [?\t])
- (define-key map [linefeed] [?\n])
- (define-key map [clear] [?\C-l])
- (define-key map [return] [?\C-m])
- (define-key map [escape] [?\e])
(define-key map [M-backspace] [?\M-\d])
(define-key map [M-delete] [?\M-\d])
(define-key map [M-tab] [?\M-\t])
"Keymap of possible alternative meanings for some keys.")
(defun x-setup-function-keys (frame)
- "Set up `function-key-map' on FRAME for the X window system."
+ "Set up `function-key-map' on the graphical frame FRAME."
;; Don't do this twice on the same display, or it would break
;; normal-erase-is-backspace-mode.
(unless (terminal-parameter frame 'x-setup-function-keys)
(set-keymap-parent map (keymap-parent local-function-key-map))
(set-keymap-parent local-function-key-map map)))
(set-terminal-parameter frame 'x-setup-function-keys t)))
-
-;; 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)
-
\f
;;;; Keysyms
;; 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. We track all three
-;; seperately in case another X application only sets one of them
+;; separately in case another X application only sets one of them
;; (say the cut buffer) we aren't fooled by the PRIMARY or
;; CLIPBOARD selection staying the same.
(defvar x-last-selected-text-clipboard nil
"Max number of characters to put in the cut buffer.
It is said that overlarge strings are slow to put into the cut buffer.")
-(defcustom x-select-enable-clipboard nil
+(defcustom x-select-enable-clipboard t
"Non-nil means cutting and pasting uses the clipboard.
This is in addition to, but in preference to, the primary selection."
:type 'boolean
:group 'killing)
(defun x-select-text (text &optional push)
- "Make TEXT, a string, the primary X selection.
-Also, set the value of X cut buffer 0, for backward compatibility
-with older X applications.
-gildea@stop.mail-abuse.org says it's not desirable to put kills
-in the clipboard."
+ "Select TEXT, a string, according to the window system.
+
+On X, put TEXT in the primary X selection. For backward
+compatibility with older X applications, set the value of X cut
+buffer 0 as well, and if the optional argument PUSH is non-nil,
+rotate the cut buffers. If `x-select-enable-clipboard' is
+non-nil, copy the text to the X clipboard as well.
+
+On Windows, make TEXT the current selection. If
+`x-select-enable-clipboard' is non-nil, copy the text to the
+clipboard as well. The argument PUSH is ignored.
+
+On Nextstep, put TEXT in the pasteboard; PUSH is ignored."
;; With multi-tty, this function may be called from a tty frame.
(when (eq (framep (selected-frame)) 'x)
;; Don't send the cut buffer too much text.
")
;; Get a selection value of type TYPE by calling x-get-selection with
-;; an appropiate DATA-TYPE argument decided by `x-select-request-type'.
+;; an appropriate DATA-TYPE argument decided by `x-select-request-type'.
;; The return value is already decoded. If x-get-selection causes an
;; error, this function return nil.
(kill-new clipboard-text))
(yank)))
+(declare-function accelerate-menu "xmenu.c" (&optional frame) t)
+
(defun x-menu-bar-open (&optional frame)
- "Open the menu bar if `menu-bar-mode' is on. otherwise call `tmm-menubar'."
+ "Open the menu bar if `menu-bar-mode' is on, otherwise call `tmm-menubar'."
(interactive "i")
- (if menu-bar-mode (accelerate-menu frame)
+ (if (and menu-bar-mode
+ (fboundp 'accelerate-menu))
+ (accelerate-menu frame)
(tmm-menubar)))
\f
;;; Window system initialization.
(defun x-win-suspend-error ()
- (error "Suspending an Emacs running under X makes no sense"))
+ ;; Don't allow suspending if any of the frames are X frames.
+ (if (memq 'x (mapcar 'window-system (frame-list)))
+ (error "Cannot suspend Emacs while running under X")))
(defvar x-initialized nil
"Non-nil if the X window system has been initialized.")
+(declare-function x-open-connection "xfns.c"
+ (display &optional xrm-string must-succeed))
+(declare-function x-server-max-request-size "xfns.c" (&optional terminal))
+(declare-function x-get-resource "frame.c"
+ (attribute class &optional component subclass))
+(declare-function x-parse-geometry "frame.c" (string))
+(defvar x-resource-name)
+(defvar x-display-name)
+(defvar x-command-line-resources)
+
(defun x-initialize-window-system ()
"Initialize Emacs for X frames and open the first connection to an X server."
;; Make sure we have a valid resource name.
(setq x-cut-buffer-max (min (- (/ (x-server-max-request-size) 2) 100)
x-cut-buffer-max))
- ;; Setup the default fontset.
- (setup-default-fontset)
+ ;; Create the default fontset.
+ (create-default-fontset)
;; Create the standard fontset.
- (create-fontset-from-fontset-spec standard-fontset-spec t)
+ (condition-case err
+ (create-fontset-from-fontset-spec standard-fontset-spec t)
+ (error (display-warning
+ 'initialization
+ (format "Creation of the standard fontset failed: %s" err)
+ :error)))
;; Create fontset specified in X resources "Fontset-N" (N is 0, 1, ...).
(create-fontset-from-x-resource)
;; Don't let Emacs suspend under X.
(add-hook 'suspend-hook 'x-win-suspend-error)
+ ;; During initialization, we defer sending size hints to the window
+ ;; manager, because that can induce a race condition:
+ ;; http://lists.gnu.org/archive/html/emacs-devel/2008-10/msg00033.html
+ ;; Send the size hints once initialization is done.
+ (add-hook 'after-init-hook 'x-wm-set-size-hint)
+
;; Turn off window-splitting optimization; X is usually fast enough
;; that this is only annoying.
(setq split-window-keep-point t)
;; (if (featurep 'motif)
;; (global-set-key [f10] 'ignore))
- ;; Turn on support for mouse wheels.
- (mouse-wheel-mode 1)
-
;; Enable CLIPBOARD copy/paste through menu bar commands.
(menu-bar-enable-clipboard)
- ;; Override Paste so it looks at CLIPBOARD first.
- (define-key menu-bar-edit-menu [paste]
- (append '(menu-item "Paste" x-clipboard-yank
- :enable (not buffer-read-only)
- :help "Paste (yank) text most recently cut/copied")
- nil))
+ ;; ;; Override Paste so it looks at CLIPBOARD first.
+ ;; (define-key menu-bar-edit-menu [paste]
+ ;; (append '(menu-item "Paste" x-clipboard-yank
+ ;; :enable (not buffer-read-only)
+ ;; :help "Paste (yank) text most recently cut/copied")
+ ;; nil))
(setq x-initialized t))
(define-key special-event-map [drag-n-drop] 'x-dnd-handle-drag-n-drop-event)
(defcustom x-gtk-stock-map
+ (mapcar (lambda (arg)
+ (cons (purecopy (car arg)) (purecopy (cdr arg))))
'(
("etc/images/new" . "gtk-new")
("etc/images/open" . "gtk-open")
("etc/images/index" . "gtk-index")
("etc/images/search" . "gtk-find")
("etc/images/exit" . "gtk-quit")
+ ("etc/images/cancel" . "gtk-cancel")
+ ("etc/images/info" . "gtk-info")
+ ("etc/images/bookmark_add" . "n:bookmark_add")
;; Used in Gnus and/or MH-E:
- ("etc/images/attach.xpm" . "gtk-attach")
- ("etc/images/connect.xpm" . "gtk-connect")
- ("etc/images/contact.xpm" . "gtk-contact")
- ("etc/images/delete.xpm" . "gtk-delete")
- ("etc/images/describe.xpm" . "gtk-properties")
- ("etc/images/disconnect.xpm" . "gtk-disconnect")
- ;; ("etc/images/exit.xpm" . "gtk-exit")
- ("etc/images/lock-broken.xpm" . "gtk-lock_broken")
- ("etc/images/lock-ok.xpm" . "gtk-lock_ok")
- ("etc/images/lock.xpm" . "gtk-lock")
- ("etc/images/next-page.xpm" . "gtk-next-page")
- ("etc/images/refresh.xpm" . "gtk-refresh")
- ("etc/images/sort-ascending.xpm" . "gtk-sort-ascending")
- ("etc/images/sort-column-ascending.xpm" . "gtk-sort-column-ascending")
- ("etc/images/sort-criteria.xpm" . "gtk-sort-criteria")
- ("etc/images/sort-descending.xpm" . "gtk-sort-descending")
- ("etc/images/sort-row-ascending.xpm" . "gtk-sort-row-ascending")
- ("images/gnus/toggle-subscription.xpm" . "gtk-task-recurring")
- ("images/mail/compose.xpm" . "gtk-mail-compose")
- ("images/mail/copy.xpm" . "gtk-mail-copy")
- ("images/mail/forward.xpm" . "gtk-mail-forward")
- ("images/mail/inbox.xpm" . "gtk-inbox")
- ("images/mail/move.xpm" . "gtk-mail-move")
- ("images/mail/not-spam.xpm" . "gtk-not-spam")
- ("images/mail/outbox.xpm" . "gtk-outbox")
- ("images/mail/reply-all.xpm" . "gtk-mail-reply-to-all")
- ("images/mail/reply.xpm" . "gtk-mail-reply")
- ("images/mail/save-draft.xpm" . "gtk-mail-handling")
- ("images/mail/send.xpm" . "gtk-mail-send")
- ("images/mail/spam.xpm" . "gtk-spam")
+ ("etc/images/attach" . "gtk-attach")
+ ("etc/images/connect" . "gtk-connect")
+ ("etc/images/contact" . "gtk-contact")
+ ("etc/images/delete" . "gtk-delete")
+ ("etc/images/describe" . "gtk-properties")
+ ("etc/images/disconnect" . "gtk-disconnect")
+ ;; ("etc/images/exit" . "gtk-exit")
+ ("etc/images/lock-broken" . "gtk-lock_broken")
+ ("etc/images/lock-ok" . "gtk-lock_ok")
+ ("etc/images/lock" . "gtk-lock")
+ ("etc/images/next-page" . "gtk-next-page")
+ ("etc/images/refresh" . "gtk-refresh")
+ ("etc/images/sort-ascending" . "gtk-sort-ascending")
+ ("etc/images/sort-column-ascending" . "gtk-sort-column-ascending")
+ ("etc/images/sort-criteria" . "gtk-sort-criteria")
+ ("etc/images/sort-descending" . "gtk-sort-descending")
+ ("etc/images/sort-row-ascending" . "gtk-sort-row-ascending")
+ ("images/gnus/toggle-subscription" . "gtk-task-recurring")
+ ("images/mail/compose" . "gtk-mail-compose")
+ ("images/mail/copy" . "gtk-mail-copy")
+ ("images/mail/forward" . "gtk-mail-forward")
+ ("images/mail/inbox" . "gtk-inbox")
+ ("images/mail/move" . "gtk-mail-move")
+ ("images/mail/not-spam" . "gtk-not-spam")
+ ("images/mail/outbox" . "gtk-outbox")
+ ("images/mail/reply-all" . "gtk-mail-reply-to-all")
+ ("images/mail/reply" . "gtk-mail-reply")
+ ("images/mail/save-draft" . "gtk-mail-handling")
+ ("images/mail/send" . "gtk-mail-send")
+ ("images/mail/spam" . "gtk-spam")
+ ;; Used for GDB Graphical Interface
+ ("images/gud/break" . "gtk-no")
+ ("images/gud/recstart" . "gtk-media-record")
+ ("images/gud/recstop" . "gtk-media-stop")
;; No themed versions available:
- ;; mail/preview.xpm (combining stock_mail and stock_zoom)
- ;; mail/save.xpm (combining stock_mail, stock_save and stock_convert)
- )
+ ;; mail/preview (combining stock_mail and stock_zoom)
+ ;; mail/save (combining stock_mail, stock_save and stock_convert)
+ ))
"How icons for tool bars are mapped to Gtk+ stock items.
Emacs must be compiled with the Gtk+ toolkit for this to have any effect.
A value that begins with n: denotes a named icon instead of a stock icon."
:group 'x)
(defcustom icon-map-list '(x-gtk-stock-map)
- "A list of alists that maps icon file names to stock/named icons.
+ "A list of alists that map icon file names to stock/named icons.
The alists are searched in the order they appear. The first match is used.
The keys in the alists are file names without extension and with two directory
components. For example, to map /usr/share/emacs/22.1.1/etc/images/open.xpm
(string :tag "Stock/named")))))
:group 'x)
+(defconst x-gtk-stock-cache (make-hash-table :weakness t :test 'equal))
+
(defun x-gtk-map-stock (file)
- "Map icon with file name FILE to a Gtk+ stock name, using `x-gtk-stock-map'."
- (if (stringp file)
- (let* ((file-sans (file-name-sans-extension file))
- (key (and (string-match "/\\([^/]+/[^/]+/[^/]+$\\)" file-sans)
- (match-string 1 file-sans)))
- (value))
- (mapc (lambda (elem)
- (let ((assoc (if (symbolp elem) (symbol-value elem) elem)))
- (or value (setq value (assoc-string (or key file-sans)
- assoc)))))
- icon-map-list)
- (and value (cdr value)))
- nil))
+ "Map icon with file name FILE to a Gtk+ stock name.
+This uses `icon-map-list' to map icon file names to stock icon names."
+ (when (stringp file)
+ (or (gethash file x-gtk-stock-cache)
+ (puthash
+ file
+ (save-match-data
+ (let* ((file-sans (file-name-sans-extension file))
+ (key (and (string-match "/\\([^/]+/[^/]+/[^/]+$\\)"
+ file-sans)
+ (match-string 1 file-sans)))
+ (icon-map icon-map-list)
+ elem value)
+ (while (and (null value) icon-map)
+ (setq elem (car icon-map)
+ value (assoc-string (or key file-sans)
+ (if (symbolp elem)
+ (symbol-value elem)
+ elem))
+ icon-map (cdr icon-map)))
+ (and value (cdr value))))
+ x-gtk-stock-cache))))
(provide 'x-win)
HCoop / bpt / emacs.git / blobdiff