-;; Parse switches controlling how Emacs interfaces with X window system.
-;; Copyright (C) 1990 Free Software Foundation, Inc.
+;;; x-win.el --- parse switches controlling interface with X window system
+
+;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
+
+;; Author: FSF
+;; 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. 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.
+;; 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.
-;; 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.
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;; Commentary:
;; 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
;; startup.el will then examine startup files, and eventually call the hooks
;; which create the first window (s).
+
+;;; Code:
\f
;; These are the standard X switches from the Xt Initialize.c file of
;; Release 4.
;; -font *font
;; -foreground *foreground
;; -geometry .geometry
+;; -i .iconType
+;; -itype .iconType
;; -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"))
+ (error "%s: Loading x-win.el but not compiled for X" (invocation-name)))
-;; 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 '(("-dm" . x-establish-daemon-mode)
- ("-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)))
+(require 'frame)
+(require 'mouse)
+(require 'scroll-bar)
+(require 'faces)
+(require 'select)
+(require 'menu-bar)
+(if (fboundp 'new-fontset)
+ (require 'fontset))
+
+(defvar x-invocation-args)
+
+(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 x-switch-definitions)))
+ (let ((aelt (assoc switch command-line-x-option-alist)))
(if aelt
- (if (nth 2 aelt)
- (setq screen-default-alist
- (cons (cons (nth 1 aelt) (nth 2 aelt))
- screen-default-alist))
- (setq screen-default-alist
- (cons (cons (nth 1 aelt)
- (car x-invocation-args))
- screen-default-alist)
- x-invocation-args (cdr x-invocation-args))))))
+ (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 x-switch-definitions)))
+ (let ((aelt (assoc switch command-line-x-option-alist)))
(if aelt
- (setq screen-default-alist
- (cons (cons (nth 1 aelt)
- (string-to-int (car x-invocation-args)))
- screen-default-alist)
- x-invocation-args
- (cdr x-invocation-args)))))
+ (let ((param (nth 3 aelt)))
+ (setq default-frame-alist
+ (cons (cons param
+ (string-to-int (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)))
+
+;; 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)
- (setq initial-screen-alist (append initial-screen-alist
- (x-geometry (car x-invocation-args)))
- x-invocation-args (cdr x-invocation-args)))
-
-;; The daemon stuff isn't really useful at the moment.
-(defvar x-daemon-mode nil
- "When set, means initially create just a minibuffer.")
-
-(defun x-establish-daemon-mode (switch)
- (setq x-daemon-mode t))
+ (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 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)))
(defvar x-display-name nil
- "The X display name specifying server and X screen.")
+ "The X display name specifying server and X 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 ()
- "Here the X-related command line options are processed, before the user's
-startup file is loaded. These are present in ARGS (see startup.el).
-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).
-When finished, only things not pertaining to X (e.g., \"-q\", filenames)
-are left in 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 x-invocation-args
+ (while (and x-invocation-args
+ (not (equal (car x-invocation-args) "--")))
(let* ((this-switch (car x-invocation-args))
- (aelt (assoc this-switch command-switch-alist)))
+ (orig-this-switch this-switch)
+ completion argval aelt handler)
(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)))
-
-
-;; Handle Xresources.
-
-(defun x-read-resources ()
- "Reread the X defaults from the X server and install them in
-`screen-default-alist', to be used in new screens."
- (interactive)
- (mapcar (function
- (lambda (key-resname-default)
- (let* ((key (nth 0 key-resname-default))
- (tail (assq key screen-default-alist))
- (value
- (or (x-get-resource (nth 1 key-resname-default))
- (nth 3 key-resname-default))))
- (if tail (setcdr tail value)
- (setq screen-default-alist
- (cons (cons key value)
- screen-default-alist))))))
- '((font "font" "9x15")
- (background-color "background" "white")
- (border-width "#BorderWidth" 2)
- (internal-border-width "#InternalBorderWidth" 1)
-
- (foreground-color "foreground" "black")
- (mouse-color "mouse" "black")
- (cursor-color "cursor" "black")
- (border-color "border" "black"))))
-
-\f
-;; This is the function which creates the first X window. It is called
-;; from startup.el before the user's init file is processed.
-
-(defun x-pop-initial-window ()
- ;; see screen.el for this function
- (pop-initial-screen (append initial-screen-alist
- screen-default-alist))
- (delete-screen terminal-screen))
-
+ ;; 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))
\f
;;
;; Standard X cursor shapes, courtesy of Mr. Fox, who wanted ALL of them.
"Gold"
"goldenrod"
"Goldenrod"
- "medium goldenrod"
- "MediumGoldenrod"
"green"
"Green"
"dark green"
"ForestGreen"
"lime green"
"LimeGreen"
- "medium forest green"
- "MediumForestGreen"
"medium sea green"
"MediumSeaGreen"
"medium spring green"
"Yellow"
"green yellow"
"GreenYellow")
- "The full list of X colors from the rgb.text file.")
+ "The list of X colors from the `rgb.txt' file.")
-(defun x-defined-colors ()
- "Return a list of colors supported by the current X-Display."
+(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 (x-defined-color this-color)
+ (and (face-color-supported-p frame this-color t)
(setq defined-colors (cons this-color defined-colors))))
defined-colors))
-
\f
-;;
-;; Function key processing under X. Function keys are received through
-;; in the input stream as Lisp symbols.
-;;
-
-(defun define-function-key (map sym definition)
- (let ((exist (assq sym (cdr map))))
- (if exist
- (setcdr exist definition)
- (setcdr map
- (cons (cons sym definition)
- (cdr map))))))
+;;;; Function keys
-;; For unused keysyms. If this happens, it's probably a server or
-;; Xlib bug.
-
-(defun weird-x-keysym ()
+(defun iconify-or-deiconify-frame ()
+ "Iconify the selected frame, or deiconify if it's currently an icon."
(interactive)
- (error "Bizarre X keysym received."))
-(define-function-key global-function-map 'xk-not-serious 'weird-x-keysym)
-
-;; Keypad type things
-
-(define-function-key global-function-map 'xk-home 'beginning-of-line)
-(define-function-key global-function-map 'xk-left 'backward-char)
-(define-function-key global-function-map 'xk-up 'previous-line)
-(define-function-key global-function-map 'xk-right 'forward-char)
-(define-function-key global-function-map 'xk-down 'next-line)
-(define-function-key global-function-map 'xk-prior 'previous-line)
-(define-function-key global-function-map 'xk-next 'next-line)
-(define-function-key global-function-map 'xk-end 'end-of-line)
-(define-function-key global-function-map 'xk-begin 'beginning-of-line)
-
- ;; IsMiscFunctionKey
-
-(define-function-key global-function-map 'xk-select nil)
-(define-function-key global-function-map 'xk-print nil)
-(define-function-key global-function-map 'xk-execute nil)
-(define-function-key global-function-map 'xk-insert nil)
-(define-function-key global-function-map 'xk-undo nil)
-(define-function-key global-function-map 'xk-redo nil)
-(define-function-key global-function-map 'xk-menu nil)
-(define-function-key global-function-map 'xk-find nil)
-(define-function-key global-function-map 'xk-cancel nil)
-(define-function-key global-function-map 'xk-help nil)
-(define-function-key global-function-map 'xk-break nil)
-
- ;; IsKeypadKey
-
-(define-function-key global-function-map 'xk-kp-space
- '(lambda nil (interactive)
- (insert " ")))
-(define-function-key global-function-map 'xk-kp-tab
- '(lambda nil (interactive)
- (insert "\t")))
-(define-function-key global-function-map 'xk-kp-enter
- '(lambda nil (interactive)
- (insert "\n")))
-
-(define-function-key global-function-map 'xk-kp-f1 nil)
-(define-function-key global-function-map 'xk-kp-f2 nil)
-(define-function-key global-function-map 'xk-kp-f3 nil)
-(define-function-key global-function-map 'xk-kp-f4 nil)
-
-(define-function-key global-function-map 'xk-kp-equal
- '(lambda nil (interactive)
- (insert "=")))
-(define-function-key global-function-map 'xk-kp-multiply
- '(lambda nil (interactive)
- (insert "*")))
-(define-function-key global-function-map 'xk-kp-add
- '(lambda nil (interactive)
- (insert "+")))
-(define-function-key global-function-map 'xk-kp-separator
- '(lambda nil (interactive)
- (insert ";")))
-(define-function-key global-function-map 'xk-kp-subtract
- '(lambda nil (interactive)
- (insert "-")))
-(define-function-key global-function-map 'xk-kp-decimal
- '(lambda nil (interactive)
- (insert ".")))
-(define-function-key global-function-map 'xk-kp-divide
- '(lambda nil (interactive)
- (insert "/")))
-
-(define-function-key global-function-map 'xk-kp-0
- '(lambda nil (interactive)
- (insert "0")))
-(define-function-key global-function-map 'xk-kp-1
- '(lambda nil (interactive)
- (insert "1")))
-(define-function-key global-function-map 'xk-kp-2
- '(lambda nil (interactive)
- (insert "2")))
-(define-function-key global-function-map 'xk-kp-3
- '(lambda nil (interactive)
- (insert "3")))
-(define-function-key global-function-map 'xk-kp-4
- '(lambda nil (interactive)
- (insert "4")))
-(define-function-key global-function-map 'xk-kp-5
- '(lambda nil (interactive)
- (insert "5")))
-(define-function-key global-function-map 'xk-kp-6
- '(lambda nil (interactive)
- (insert "6")))
-(define-function-key global-function-map 'xk-kp-7
- '(lambda nil (interactive)
- (insert "7")))
-(define-function-key global-function-map 'xk-kp-8
- '(lambda nil (interactive)
- (insert "8")))
-(define-function-key global-function-map 'xk-kp-9
- '(lambda nil (interactive)
- (insert "9")))
-
- ;; IsFunctionKey
-
-(define-function-key global-function-map 'xk-f1 'rmail)
-(define-function-key global-function-map 'xk-f2 nil)
-(define-function-key global-function-map 'xk-f3 nil)
-(define-function-key global-function-map 'xk-f4 nil)
-(define-function-key global-function-map 'xk-f5 nil)
-(define-function-key global-function-map 'xk-f6 nil)
-(define-function-key global-function-map 'xk-f7 nil)
-(define-function-key global-function-map 'xk-f8 nil)
-(define-function-key global-function-map 'xk-f9 nil)
-(define-function-key global-function-map 'xk-f10 nil)
-(define-function-key global-function-map 'xk-f11 nil)
-(define-function-key global-function-map 'xk-f12 nil)
-(define-function-key global-function-map 'xk-f13 nil)
-(define-function-key global-function-map 'xk-f14 nil)
-(define-function-key global-function-map 'xk-f15 nil)
-(define-function-key global-function-map 'xk-f16 nil)
-(define-function-key global-function-map 'xk-f17 nil)
-(define-function-key global-function-map 'xk-f18 nil)
-(define-function-key global-function-map 'xk-f19 nil)
-(define-function-key global-function-map 'xk-f20 nil)
-(define-function-key global-function-map 'xk-f21 nil)
-(define-function-key global-function-map 'xk-f22 nil)
-(define-function-key global-function-map 'xk-f23 nil)
-(define-function-key global-function-map 'xk-f24 nil)
-(define-function-key global-function-map 'xk-f25 nil)
-(define-function-key global-function-map 'xk-f26 nil)
-(define-function-key global-function-map 'xk-f27 nil)
-(define-function-key global-function-map 'xk-f28 nil)
-(define-function-key global-function-map 'xk-f29 nil)
-(define-function-key global-function-map 'xk-f30 nil)
-(define-function-key global-function-map 'xk-f31 nil)
-(define-function-key global-function-map 'xk-f32 nil)
-(define-function-key global-function-map 'xk-f33 nil)
-(define-function-key global-function-map 'xk-f34 nil)
-(define-function-key global-function-map 'xk-f35 nil)
+ (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] [?\C-l])
+(define-key function-key-map [return] [?\C-m])
+(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-\C-l])
+(define-key function-key-map [M-return] [?\M-\C-m])
+(define-key function-key-map [M-escape] [?\M-\e])
+(define-key function-key-map [iso-lefttab] [backtab])
+
+;; 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)
+
+(defun vendor-specific-keysyms (vendor)
+ "Return the appropriate value of system-key-alist for VENDOR.
+VENDOR is a string containing the name of the X Server's vendor,
+as returned by (x-server-vendor)."
+ (cond ((string-equal vendor "Apollo Computer Inc.")
+ '((65280 . linedel)
+ (65281 . chardel)
+ (65282 . copy)
+ (65283 . cut)
+ (65284 . paste)
+ (65285 . move)
+ (65286 . grow)
+ (65287 . cmd)
+ (65288 . shell)
+ (65289 . leftbar)
+ (65290 . rightbar)
+ (65291 . leftbox)
+ (65292 . rightbox)
+ (65293 . upbox)
+ (65294 . downbox)
+ (65295 . pop)
+ (65296 . read)
+ (65297 . edit)
+ (65298 . save)
+ (65299 . exit)
+ (65300 . repeat)))
+ ((or (string-equal vendor "Hewlett-Packard Incorporated")
+ (string-equal vendor "Hewlett-Packard Company"))
+ '(( 168 . mute-acute)
+ ( 169 . mute-grave)
+ ( 170 . mute-asciicircum)
+ ( 171 . mute-diaeresis)
+ ( 172 . mute-asciitilde)
+ ( 175 . lira)
+ ( 190 . guilder)
+ ( 252 . block)
+ ( 256 . longminus)
+ (65388 . reset)
+ (65389 . system)
+ (65390 . user)
+ (65391 . clearline)
+ (65392 . insertline)
+ (65393 . deleteline)
+ (65394 . insertchar)
+ (65395 . deletechar)
+ (65396 . backtab)
+ (65397 . kp-backtab)))
+ ((or (string-equal vendor "X11/NeWS - Sun Microsystems Inc.")
+ (string-equal vendor "X Consortium"))
+ '((392976 . f36)
+ (392977 . f37)
+ (393056 . req)
+ ;; These are for Sun under X11R6
+ (393072 . props)
+ (393073 . front)
+ (393074 . copy)
+ (393075 . open)
+ (393076 . paste)
+ (393077 . cut)))
+ (t
+ ;; This is used by DEC's X server.
+ '((65280 . remove)))))
+
+\f
+;;;; 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 nil
+ "Non-nil means cutting and pasting uses the clipboard.
+This is in addition to the primary selection.")
+
+;;; 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@lcs.mit.edu says it's not desirable to put kills
+;;; in the clipboard.
+(defun x-select-text (text &optional push)
+ ;; Don't send the cut buffer too much text.
+ ;; It becomes slow, and if really big it causes errors.
+ (if (< (length text) x-cut-buffer-max)
+ (x-set-cut-buffer text push)
+ (x-set-cut-buffer "" push))
+ (x-set-selection 'PRIMARY text)
+ (if x-select-enable-clipboard
+ (x-set-selection 'CLIPBOARD text))
+ (setq x-last-selected-text text))
+
+;;; Return the value of the current X selection.
+;;; Consult the selection, then the cut buffer. Treat empty strings
+;;; as if they were unset.
+(defun x-cut-buffer-or-selection-value ()
+ (let (text)
+
+ ;; Don't die if x-get-selection signals an error.
+ (condition-case c
+ (setq text (x-get-selection 'PRIMARY))
+ (error nil))
+ (if (string= text "") (setq text nil))
+
+ (if x-select-enable-clipboard
+ (condition-case c
+ (setq text (x-get-selection 'CLIPBOARD))
+ (error nil)))
+ (if (string= text "") (setq text nil))
+ (or text (setq text (x-get-cut-buffer 0)))
+ (if (string= text "") (setq text nil))
+
+ (cond
+ ((not text) nil)
+ ((eq text x-last-selected-text) nil)
+ ((string= text x-last-selected-text)
+ ;; Record the newer string, so subsequent calls can use the `eq' test.
+ (setq x-last-selected-text text)
+ nil)
+ (t
+ (setq x-last-selected-text text)))))
+\f
;;; Do the actual X Windows setup here; the above code just defines
;;; functions and variables that we use now.
-;; xterm.c depends on using interrupt-driven input.
-(set-input-mode t nil t)
-(x-read-resources)
-(x-handle-args)
-(x-open-connection (or x-display-name
- (setq x-display-name (getenv "DISPLAY"))))
-(x-pop-initial-window)
-
-(setq suspend-hook
- '(lambda ()
- (error "Suspending an emacs running under X makes no sense")))
-
-(define-key global-map "\C-z" 'iconify-emacs)
+(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 (or x-display-name
+ (setq x-display-name (getenv "DISPLAY")))
+ x-command-line-resources
+ ;; Exit Emacs with fatal error if this fails.
+ t)
+ (x-open-connection (or x-display-name
+ (setq x-display-name (getenv "DISPLAY")))
+ 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))
+
+(if (fboundp 'new-fontset)
+ (progn
+ ;; Create a default fontset.
+ (create-fontset-from-fontset-spec default-fontset-spec)
+
+ ;; Create fontset specified in X resources.
+ (create-fontset-from-x-resource)
+
+ ;; Try to create a fontset from font specification which comes from
+ ;; initial-frame-alist, default-frame-alist, or X resource if the font
+ ;; name conforms to XLFD and the registry part is `fontset'. A font
+ ;; specification in command line argument (-fn XXXX) should be in
+ ;; default-frame-alist already. However, any font specification in
+ ;; site-start library, user's init file (.emacs), and default.el are
+ ;; not yet handled here.
+
+ (let ((font (or (cdr (assq 'font initial-frame-alist))
+ (cdr (assq 'font default-frame-alist))
+ (x-get-resource "font" "Font")
+ (x-get-resource "fontset" "Fontset")))
+ xlfd-fields fontlist)
+ (if (and font
+ (not (query-fontset font))
+ (setq xlfd-fields (x-decompose-font-name font)))
+ (progn
+ (if (not (string= "fontset"
+ (aref xlfd-fields xlfd-regexp-registry-subnum)))
+ (progn
+ ;; Create a fontset of the name FONT.
+ (setq fontlist (list (cons 'ascii font)))
+ (aset xlfd-fields xlfd-regexp-foundry-subnum nil)
+ (aset xlfd-fields xlfd-regexp-family-subnum nil)
+ (aset xlfd-fields xlfd-regexp-adstyle-subnum nil)
+ (aset xlfd-fields xlfd-regexp-avgwidth-subnum nil)))
+ (new-fontset font (x-complement-fontset-spec xlfd-fields fontlist)))))))
+
+;; Sun expects the menu bar cut and paste commands to use the clipboard.
+;; This has ,? to match both on Sunos and on Solaris.
+(if (string-match "Sun Microsystems,? Inc\\."
+ (x-server-vendor))
+ (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 X 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-cut-buffer-or-selection-value)
+
+;;; Turn off window-splitting optimization; X is usually fast enough
+;;; that this is only annoying.
+(setq split-window-keep-point t)
+
+;; Don't show the frame name; that's redundant with X.
+(setq-default mode-line-buffer-identification '("Emacs: %12b"))
+
+;;; Motif direct handling of f10 wasn't working right,
+;;; So temporarily we've turned it off in lwlib-Xm.c
+;;; and turned the Emacs f10 back on.
+;;; ;; Motif normally handles f10 itself, so don't try to handle it a second time.
+;;; (if (featurep 'motif)
+;;; (global-set-key [f10] 'ignore))
+
+;;; x-win.el ends here