-;; 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 --- parse switches controlling interface with X window system
+;; Copyright (C) 1993 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; 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:
;; 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)))
(require 'frame)
(require 'mouse)
+(require 'scroll-bar)
+(require 'faces)
+(require 'select)
+(require 'menu-bar)
+
+(defvar x-invocation-args)
+
+(defvar x-command-line-resources nil)
(setq command-switch-alist
(append '(("-bw" . x-handle-numeric-switch)
("-d" . x-handle-display)
("-display" . x-handle-display)
- ("-name" . x-handle-switch)
+ ("-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-switch)
+ ("-ib" . x-handle-numeric-switch)
("-g" . x-handle-geometry)
("-geometry" . x-handle-geometry)
("-fg" . x-handle-switch)
("-bg" . x-handle-switch)
("-background". x-handle-switch)
("-ms" . x-handle-switch)
- ("-ib" . x-handle-switch)
- ("-iconic" . 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)
(defconst x-switch-definitions
'(("-name" name)
("-T" name)
- ("-r" lose)
- ("-rv" lose)
- ("-reverse" lose)
+ ("-r" reverse t)
+ ("-rv" reverse t)
+ ("-reverse" reverse t)
("-fn" font)
("-font" font)
("-ib" internal-border-width)
("-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)
+ ("-itype" icon-type t)
+ ("-i" icon-type t)
+ ("-vb" vertical-scroll-bars t)
+ ("-hb" horizontal-scroll-bars t)
("-bd" border-color)
("-bw" border-width)))
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)))
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)
- (setq initial-frame-alist (append initial-frame-alist
- (x-geometry (car x-invocation-args)))
+ (setq initial-frame-alist
+ (append initial-frame-alist
+ (x-parse-geometry (car x-invocation-args)))
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 X display name specifying server and X frame.")
(while all-colors
(setq this-color (car all-colors)
all-colors (cdr all-colors))
- (and (x-defined-color this-color)
+ (and (x-color-defined-p this-color)
(setq defined-colors (cons this-color defined-colors))))
defined-colors))
\f
-(defvar scroll-bar-mode nil)
-
-;;; ??? x-create-screen needs to be changed to use scroll-bar-mode
-;;; to decide (by default) whether to make a scroll bar.
-(defun scroll-bar-mode (flag)
- "Toggle display of vertical scroll bars on each frame.
-This command applies to all frames that exist and frames to be
-created in the future.
-With a numeric argument, if the argument is negative,
-turn off scroll bars; otherwise, turn on scroll bars."
- (interactive "P")
- (setq scroll-bar-mode (if (null flag) (not scroll-bar-mode)
- (or (not (numberp flag)) (>= flag 0))))
- (let ((frames (frame-list)))
- (while frames
- (modify-frame-parameters (car frames)
- (list (cons 'vertical-scrollbar scroll-bar-mode)))
- (setq frames (cdr frames)))))
-\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 [M-next] 'scroll-other-window)
-(define-key global-map [begin] 'beginning-of-buffer)
-(define-key global-map [end] 'end-of-buffer)
-
-(define-key global-map "\C-z" 'iconify-frame)
+(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)
+ (let ((foo (selected-frame)))
+ (make-frame-invisible foo)
+ (make-frame-visible foo))))
+
+(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)
+
+;; Set up to recognize vendor-specific keysyms.
+;; Unless/until there is a real conflict,
+;; we need not try to make this list depend on
+;; the type of X server in use.
+(setq system-key-alist
+ '(
+ ;; These are some HP keys.
+ ( 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)
+ ;; This is used on some system or other.
+ (0 . remove)
+ ;; These are for Sun.
+ (392976 . f35)
+ (392977 . f36)
+ (393056 . req)
+ ))
\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"))))
-
-(setq frame-creation-function 'x-create-frame)
-(setq suspend-hook
- '(lambda ()
- (error "Suspending an emacs running under X makes no sense")))
+;;;; 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)
-;;; Make TEXT, a string, the primary and clipboard X selections.
-;;; If you are running xclipboard, this means you can effectively
-;;; have a window on a copy of the kill-ring.
+;;; 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.")
+
+;;; Make TEXT, a string, the primary X selection.
;;; Also, set the value of X cut buffer 0, for backward compatibility
-;;; with older X application.
-(defun x-select-text (text)
- (x-set-cut-buffer 0 text)
- (x-own-selection text 'clipboard)
- (x-own-selection text)
+;;; 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)
(setq x-last-selected-text text))
;;; Return the value of the current X selection. For compatibility
;;; with older X applications, this checks cut buffer 0 before
;;; retrieving the value of the primary selection.
(defun x-cut-buffer-or-selection-value ()
- (let ((text (or (x-selection-value))))
- (if (or (string= text x-last-selected-text)
- (string= ""))
- nil
- (setq x-last-selected-text nil)
- text)))
+ (let (text)
+
+ ;; Consult the selection, then the cut buffer. Treat empty strings
+ ;; as if they were unset.
+ (setq text (x-get-selection 'PRIMARY))
+ (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.
+
+(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 ?-))))
+
+(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))
+
+;; 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")))
+ (if res-geometry
+ (setq initial-frame-alist (append initial-frame-alist
+ (x-parse-geometry res-geometry)))))
+
+;; 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)
;;; Turn off window-splitting optimization; X is usually fast enough
;;; that this is only annoying.
(setq split-window-keep-point t)
+
+;;; x-win.el ends here