X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/290cb602d339e571a2e3b2d20550702a197744ae..52f04d46fe299cfdb62efbed57a1dd1916f15fb8:/lisp/term/x-win.el?ds=sidebyside diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index 674097fd05..7361decaf7 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 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: @@ -53,6 +51,8 @@ ;; -font *font ;; -foreground *foreground ;; -geometry .geometry +;; -i .iconType +;; -itype .iconType ;; -iconic .iconic ;; -name .name ;; -reverse *reverseVideo @@ -65,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) @@ -74,18 +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) @@ -94,7 +99,9 @@ ("-background". x-handle-switch) ("-ms" . x-handle-switch) ("-itype" . x-handle-switch) - ("-iconic" . 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) @@ -104,9 +111,9 @@ (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) @@ -117,7 +124,7 @@ ("-ms" mouse-color) ("-cr" cursor-color) ("-itype" icon-type t) - ("-iconic" iconic-startup t) + ("-i" icon-type t) ("-vb" vertical-scroll-bars t) ("-hb" horizontal-scroll-bars t) ("-bd" border-color) @@ -137,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))) @@ -148,6 +160,13 @@ 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 @@ -155,6 +174,18 @@ (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.") @@ -428,7 +459,17 @@ 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) + (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. @@ -456,6 +497,40 @@ 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 on some system or other. + (0 . remove) + ;; These are for Sun. + (392976 . f35) + (392977 . f36) + (393056 . req) + )) ;;;; Selections and cut buffers @@ -464,14 +539,22 @@ 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.") + +;;; Make TEXT, a string, the primary X selection. ;;; Also, set the value of X cut buffer 0, for backward compatibility ;;; with older X applications. -(defun x-select-text (text) - (x-set-cut-buffer text) - (x-set-selection 'CLIPBOARD text) +;;; 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)) @@ -481,11 +564,11 @@ This returns ARGS with the arguments that have been processed removed." (defun x-cut-buffer-or-selection-value () (let (text) - ;; Consult the cut buffer, then the selection. Treat empty strings + ;; Consult the selection, then the cut buffer. Treat empty strings ;; as if they were unset. - (setq text (x-get-cut-buffer 0)) + (setq text (x-get-selection 'PRIMARY)) (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 @@ -503,11 +586,49 @@ 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")))) + (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)