X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/5d20eba6587bafb6c2020abc7c87e774a0218079..e7399dcc7256ba7bbde1491e68417f0804a60438:/lisp/term/x-win.el diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index 06f7d375b7..7632905ce5 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -1,26 +1,24 @@ ;;; x-win.el --- parse switches controlling interface with X window system +;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. ;; Author: FSF ;; Keywords: terminals -;; Copyright (C) 1993 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. +;;; 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: @@ -67,7 +65,7 @@ ;; ../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) @@ -76,20 +74,23 @@ (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) @@ -99,8 +100,8 @@ ("-ms" . x-handle-switch) ("-itype" . x-handle-switch) ("-i" . x-handle-switch) - ("-iconic" . x-handle-switch) - ("-rn" . x-handle-rn-switch) + ("-iconic" . x-handle-iconic) + ("-xrm" . x-handle-xrm-switch) ("-cr" . x-handle-switch) ("-vb" . x-handle-switch) ("-hb" . x-handle-switch) @@ -124,7 +125,6 @@ ("-cr" cursor-color) ("-itype" icon-type t) ("-i" icon-type t) - ("-iconic" iconic-startup t) ("-vb" vertical-scroll-bars t) ("-hb" horizontal-scroll-bars t) ("-bd" border-color) @@ -144,6 +144,11 @@ 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))) @@ -155,17 +160,36 @@ x-invocation-args (cdr x-invocation-args))))) -;; Handle the -rn option. -(defun x-handle-rn-switch (switch) +;; 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-parse-geometry (car x-invocation-args))) - x-invocation-args (cdr x-invocation-args))) + (let ((geo (x-parse-geometry (car x-invocation-args)))) + (setq initial-frame-alist + (append initial-frame-alist + (if (or (assq 'left geo) (assq 'top geo)) + '((user-position . t))) + (if (or (assq 'height geo) (assq 'width geo)) + '((user-size . t))) + geo) + x-invocation-args (cdr x-invocation-args)))) + +;; Handle the -name and -rn options. Set the variable x-resource-name +;; to the option's operand; if the switch was `-name', set the name of +;; the initial frame, too. +(defun x-handle-name-rn-switch (switch) + (or (consp x-invocation-args) + (error "%s: missing argument to `%s' option" (invocation-name) switch)) + (setq x-resource-name (car x-invocation-args) + x-invocation-args (cdr x-invocation-args)) + (if (string= switch "-name") + (setq initial-frame-alist (cons (cons 'name x-resource-name) + initial-frame-alist)))) (defvar x-display-name nil "The X display name specifying server and X frame.") @@ -177,11 +201,11 @@ (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 + "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). +\(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) @@ -440,7 +464,15 @@ This returns ARGS with the arguments that have been processed removed." ;;;; Function keys -(substitute-key-definition 'suspend-emacs 'iconify-frame global-map) +(defun iconify-or-deiconify-frame () + "Iconify the selected frame, or deiconify if it's currently an icon." + (interactive) + (if (eq (cdr (assq 'visibility (frame-parameters))) t) + (iconify-frame) + (make-frame-visible))) + +(substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame + global-map) ;; Map certain keypad keys into ASCII characters ;; that people usually expect. @@ -468,6 +500,48 @@ This returns ARGS with the arguments that have been processed removed." (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 by DEC's X server. + (65280 . remove) + ;; These are for Sun. + (392963 . mute-acute) + (392976 . f35) + (392977 . f36) + (393056 . req) + ;; These are for Sun under X11R6 + (393072 . props) + (393073 . front) + (393074 . copy) + (393075 . open) + (393076 . paste) + (393077 . cut) + )) ;;;; Selections and cut buffers @@ -476,28 +550,49 @@ This returns ARGS with the arguments that have been processed removed." ;;; 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.") + +(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) - (x-set-cut-buffer text push) - (x-set-selection 'CLIPBOARD text) + ;; 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. For compatibility -;;; with older X applications, this checks cut buffer 0 before -;;; retrieving the value of the primary selection. +;;; 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) - ;; Consult the cut buffer, then the selection. Treat empty strings - ;; as if they were unset. - (setq text (x-get-cut-buffer 0)) + ;; Don't die if x-get-selection signals an error. + (condition-case c + (setq text (x-get-selection 'PRIMARY)) + (error (message "%s" c))) + (if (string= text "") (setq text nil)) + + (if x-select-enable-clipboard + (condition-case c + (setq text (x-get-selection 'CLIPBOARD)) + (error (message "%s" c)))) (if (string= text "") (setq text nil)) - (or text (setq text (x-get-selection 'PRIMARY))) + (or text (setq text (x-get-cut-buffer 0))) (if (string= text "") (setq text nil)) (cond @@ -515,12 +610,31 @@ This returns ARGS with the arguments that have been processed removed." ;;; 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)) + +;; Sun expects the menu bar cut and paste commands to use the clipboard. +(if (string-match "X11/NeWS - 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. @@ -529,6 +643,21 @@ This returns ARGS with the arguments that have been processed removed." (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)