;;; 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 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: FSF
;; Keywords: terminals, i18n
;;; 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
-;; pertaining to X are processed and removed from the command line. The
-;; X display is opened and hooks are set for popping up the initial window.
+;; X-win.el: this file defines functions to initialize the X window
+;; 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
+;; `window-system-initialization-alist' for more details.
;; startup.el will then examine startup files, and eventually call the hooks
;; which create the first window(s).
;; An alist of X options and the function which handles them. See
;; ../startup.el.
-(if (not (eq window-system 'x))
+(if (not (fboundp 'x-create-frame))
(error "%s: Loading x-win.el but not compiled for X" (invocation-name)))
(require 'frame)
(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)
+ (error "%s: missing argument to `%s' option" (invocation-name) switch))
+ (setq initial-frame-alist (cons
+ (cons 'parent-id
+ (string-to-number (car 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.
(defconst x-pointer-ur-angle 148)
(defconst x-pointer-watch 150)
(defconst x-pointer-xterm 152)
+(defconst x-pointer-invisible 255)
\f
;;
;; Available colors
\f
;;;; Function keys
-(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])
-(define-key function-key-map [S-iso-lefttab] [backtab])
+(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])
+ (define-key map [M-linefeed] [?\M-\n])
+ (define-key map [M-clear] [?\M-\C-l])
+ (define-key map [M-return] [?\M-\C-m])
+ (define-key map [M-escape] [?\M-\e])
+ (define-key map [iso-lefttab] [backtab])
+ (define-key map [S-iso-lefttab] [backtab])
+ map)
+ "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."
+ ;; 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)
+ ;; Map certain keypad keys into ASCII characters that people usually expect.
+ (with-selected-frame frame
+ (let ((map (copy-keymap x-alternatives-map)))
+ (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.
"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'."
- ;; Fixme: Drop Apollo now?
- (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")
+ (cond ((or (string-equal vendor "Hewlett-Packard Incorporated")
(string-equal vendor "Hewlett-Packard Company"))
'(( 168 . mute-acute)
( 169 . mute-grave)
:type 'boolean
:group 'killing)
+(defcustom x-select-enable-primary t
+ "Non-nil means cutting and pasting uses 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."
- ;; Don't send the cut buffer too much text.
- ;; It becomes slow, and if really big it causes errors.
- (cond ((>= (length text) x-cut-buffer-max)
- (x-set-cut-buffer "" push)
- (setq x-last-selected-text-cut ""
- x-last-selected-text-cut-encoded ""))
- (t
- (setq x-last-selected-text-cut text
- x-last-cut-buffer-coding 'iso-latin-1
- x-last-selected-text-cut-encoded
- ;; ICCCM says cut buffer always contain ISO-Latin-1
- (encode-coding-string text 'iso-latin-1))
- (x-set-cut-buffer x-last-selected-text-cut-encoded push)))
- (x-set-selection 'PRIMARY text)
- (setq x-last-selected-text-primary text)
- (when x-select-enable-clipboard
- (x-set-selection 'CLIPBOARD text)
- (setq x-last-selected-text-clipboard text))
- )
+ ;; 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.
+ ;; It becomes slow, and if really big it causes errors.
+ (cond ((>= (length text) x-cut-buffer-max)
+ (x-set-cut-buffer "" push)
+ (setq x-last-selected-text-cut ""
+ x-last-selected-text-cut-encoded ""))
+ (t
+ (setq x-last-selected-text-cut text
+ x-last-cut-buffer-coding 'iso-latin-1
+ x-last-selected-text-cut-encoded
+ ;; ICCCM says cut buffer always contain ISO-Latin-1
+ (encode-coding-string text 'iso-latin-1))
+ (x-set-cut-buffer x-last-selected-text-cut-encoded push)))
+ (when x-select-enable-primary
+ (x-set-selection 'PRIMARY text)
+ (setq x-last-selected-text-primary text))
+ (when x-select-enable-clipboard
+ (x-set-selection 'CLIPBOARD text)
+ (setq x-last-selected-text-clipboard text))))
(defvar x-select-request-type nil
"*Data type request for X selection.
-The value is nil, one of the following data types, or a list of them:
+The value is one of the following data types, a list of them, or nil:
`COMPOUND_TEXT', `UTF8_STRING', `STRING', `TEXT'
-If the value is nil, try `COMPOUND_TEXT' and `UTF8_STRING', and
-use the more appropriate result. If both fail, try `STRING', and
-then `TEXT'.
-
If the value is one of the above symbols, try only the specified
type.
If the value is a list of them, try each of them in the specified
-order until succeed.")
+order until succeed.
-;; Helper function for x-selection-value. Select UTF8 or CTEXT
-;; whichever is more appropriate. Here, we use this heurisitcs.
-;;
-;; (1) If their lengthes are different, select the longer one. This
-;; is because an X client may just cut off unsupported characters.
-;;
-;; (2) Otherwise, if they are different at Nth character, and that
-;; of UTF8 is a Latin character and that of CTEXT belongs to a CJK
-;; character set, select UTF8. Also select UTF8 if the Nth
-;; character of UTF8 is non-ASCII where as that of CTEXT is ASCII.
-;; This is because an X client may replace unsupported characters
-;; with some ASCII character (typically ` ' or `?') in CTEXT.
-;;
-;; (3) Otherwise, select CTEXT. This is because legacy charsets are
-;; better for the current Emacs, especially when the selection owner
-;; is also Emacs.
-
-(defun x-select-utf8-or-ctext (utf8 ctext)
- (let ((len-utf8 (length utf8))
- (len-ctext (length ctext))
- (selected ctext)
- (i 0)
- char)
- (if (/= len-utf8 len-ctext)
- (if (> len-utf8 len-ctext) utf8 ctext)
- (let ((result (compare-strings utf8 0 len-utf8 ctext 0 len-ctext)))
- (if (eq result t)
- ctext
- (let ((utf8-char (aref utf8 (1- (abs result))))
- (ctext-char (aref ctext (1- (abs result)))))
- (if (or (and (aref (char-category-set utf8-char) ?l)
- (aref (char-category-set ctext-char) ?C))
- (and (>= utf8-char 128)
- (< ctext-char 128)))
- utf8
- ctext)))))))
+The value nil is the same as this list:
+ \(UTF8_STRING COMPOUND_TEXT STRING)
+")
;; Get a selection value of type TYPE by calling x-get-selection with
-;; an appropiate DATA-TYPE argument decidd by `x-select-request-type'.
+;; an appropiate 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.
(defun x-selection-value (type)
- (let (text)
- (cond ((null x-select-request-type)
- (let (utf8 ctext utf8-coding)
- ;; We try both UTF8_STRING and COMPOUND_TEXT, and choose
- ;; the more appropriate one. If both fail, try STRING.
-
- ;; At first try UTF8_STRING.
- (setq utf8 (condition-case nil
- (x-get-selection type 'UTF8_STRING)
- (error nil))
- utf8-coding last-coding-system-used)
- (if utf8
- ;; If it is a local selection, or it contains only
- ;; ASCII characers, choose it.
- (if (or (not (get-text-property 0 'foreign-selection utf8))
- (= (length utf8) (string-bytes utf8)))
- (setq text utf8)))
- ;; If not yet decided, try COMPOUND_TEXT.
- (if (not text)
- (if (setq ctext (condition-case nil
- (x-get-selection type 'COMPOUND_TEXT)
- (error nil)))
- ;; If UTF8_STRING was also successful, choose the
- ;; more appropriate one from UTF8 and CTEXT.
- (if utf8
- (setq text (x-select-utf8-or-ctext utf8 ctext))
- ;; Othewise, choose CTEXT.
- (setq text ctext))
- (setq text utf8)))
- ;; If not yet decided, try STRING.
- (or text
- (setq text (condition-case nil
- (x-get-selection type 'STRING)
- (error nil))))
- (if (eq text utf8)
- (setq last-coding-system-used utf8-coding))))
-
- ((consp x-select-request-type)
- (let ((tail x-select-request-type))
- (while (and tail (not text))
- (condition-case nil
- (setq text (x-get-selection type (car tail)))
- (error nil))
- (setq tail (cdr tail)))))
-
- (t
- (condition-case nil
- (setq text (x-get-selection type x-select-request-type))
- (error nil))))
-
+ (let ((request-type (or x-select-request-type
+ '(UTF8_STRING COMPOUND_TEXT STRING)))
+ text)
+ (if (consp request-type)
+ (while (and request-type (not text))
+ (condition-case nil
+ (setq text (x-get-selection type (car request-type)))
+ (error nil))
+ (setq request-type (cdr request-type)))
+ (condition-case nil
+ (setq text (x-get-selection type request-type))
+ (error nil)))
(if text
(remove-text-properties 0 (length text) '(foreign-selection nil) text))
text))
;; it returns nil the second time. This is so that a single
;; selection won't be added to the kill ring over and over.
(defun x-cut-buffer-or-selection-value ()
- (let (clip-text primary-text cut-text)
- (when x-select-enable-clipboard
- (setq clip-text (x-selection-value 'CLIPBOARD))
- (if (string= clip-text "") (setq clip-text nil))
-
- ;; Check the CLIPBOARD selection for 'newness', is it different
+ ;; With multi-tty, this function may be called from a tty frame.
+ (when (eq (framep (selected-frame)) 'x)
+ (let (clip-text primary-text cut-text)
+ (when x-select-enable-clipboard
+ (setq clip-text (x-selection-value 'CLIPBOARD))
+ (if (string= clip-text "") (setq clip-text nil))
+
+ ;; Check the CLIPBOARD selection for 'newness', is it different
+ ;; from what we remebered them to be last time we did a
+ ;; cut/paste operation.
+ (setq clip-text
+ (cond ;; check clipboard
+ ((or (not clip-text) (string= clip-text ""))
+ (setq x-last-selected-text-clipboard nil))
+ ((eq clip-text x-last-selected-text-clipboard) nil)
+ ((string= clip-text x-last-selected-text-clipboard)
+ ;; Record the newer string,
+ ;; so subsequent calls can use the `eq' test.
+ (setq x-last-selected-text-clipboard clip-text)
+ nil)
+ (t (setq x-last-selected-text-clipboard clip-text)))))
+
+ (when x-select-enable-primary
+ (setq primary-text (x-selection-value 'PRIMARY))
+ ;; Check the PRIMARY selection for 'newness', is it different
+ ;; from what we remebered them to be last time we did a
+ ;; cut/paste operation.
+ (setq primary-text
+ (cond ;; check primary selection
+ ((or (not primary-text) (string= primary-text ""))
+ (setq x-last-selected-text-primary nil))
+ ((eq primary-text x-last-selected-text-primary) nil)
+ ((string= primary-text x-last-selected-text-primary)
+ ;; Record the newer string,
+ ;; so subsequent calls can use the `eq' test.
+ (setq x-last-selected-text-primary primary-text)
+ nil)
+ (t
+ (setq x-last-selected-text-primary primary-text)))))
+
+ (setq cut-text (x-get-cut-buffer 0))
+
+ ;; Check the x cut buffer for 'newness', is it different
;; from what we remebered them to be last time we did a
;; cut/paste operation.
- (setq clip-text
- (cond;; check clipboard
- ((or (not clip-text) (string= clip-text ""))
- (setq x-last-selected-text-clipboard nil))
- ((eq clip-text x-last-selected-text-clipboard) nil)
- ((string= clip-text x-last-selected-text-clipboard)
- ;; Record the newer string,
- ;; so subsequent calls can use the `eq' test.
- (setq x-last-selected-text-clipboard clip-text)
- nil)
- (t
- (setq x-last-selected-text-clipboard clip-text))))
- )
-
- (setq primary-text (x-selection-value 'PRIMARY))
- ;; Check the PRIMARY selection for 'newness', is it different
- ;; from what we remebered them to be last time we did a
- ;; cut/paste operation.
- (setq primary-text
- (cond;; check primary selection
- ((or (not primary-text) (string= primary-text ""))
- (setq x-last-selected-text-primary nil))
- ((eq primary-text x-last-selected-text-primary) nil)
- ((string= primary-text x-last-selected-text-primary)
- ;; Record the newer string,
- ;; so subsequent calls can use the `eq' test.
- (setq x-last-selected-text-primary primary-text)
- nil)
- (t
- (setq x-last-selected-text-primary primary-text))))
-
- (setq cut-text (x-get-cut-buffer 0))
-
- ;; Check the x cut buffer for 'newness', is it different
- ;; from what we remebered them to be last time we did a
- ;; cut/paste operation.
- (setq cut-text
- (let ((next-coding (or next-selection-coding-system 'iso-latin-1)))
- (cond;; check cut buffer
- ((or (not cut-text) (string= cut-text ""))
- (setq x-last-selected-text-cut nil))
- ;; This short cut doesn't work because x-get-cut-buffer
- ;; always returns a newly created string.
- ;; ((eq cut-text x-last-selected-text-cut) nil)
- ((and (string= cut-text x-last-selected-text-cut-encoded)
- (eq x-last-cut-buffer-coding next-coding))
- ;; See the comment above. No need of this recording.
- ;; Record the newer string,
- ;; so subsequent calls can use the `eq' test.
- ;; (setq x-last-selected-text-cut cut-text)
- nil)
- (t
- (setq x-last-selected-text-cut-encoded cut-text
- x-last-cut-buffer-coding next-coding
- x-last-selected-text-cut
- ;; ICCCM says cut buffer always contain ISO-Latin-1, but
- ;; use next-selection-coding-system if not nil.
- (decode-coding-string
- cut-text next-coding))))))
-
- ;; As we have done one selection, clear this now.
- (setq next-selection-coding-system nil)
-
- ;; At this point we have recorded the current values for the
- ;; selection from clipboard (if we are supposed to) primary,
- ;; and cut buffer. So return the first one that has changed
- ;; (which is the first non-null one).
- ;;
- ;; NOTE: There will be cases where more than one of these has
- ;; changed and the new values differ. This indicates that
- ;; something like the following has happened since the last time
- ;; we looked at the selections: Application X set all the
- ;; selections, then Application Y set only one or two of them (say
- ;; just the cut-buffer). In this case since we don't have
- ;; timestamps there is no way to know what the 'correct' value to
- ;; return is. The nice thing to do would be to tell the user we
- ;; saw multiple possible selections and ask the user which was the
- ;; one they wanted.
- ;; This code is still a big improvement because now the user can
- ;; futz with the current selection and get emacs to pay attention
- ;; to the cut buffer again (previously as soon as clipboard or
- ;; primary had been set the cut buffer would essentially never be
- ;; checked again).
- (or clip-text primary-text cut-text)
- ))
+ (setq cut-text
+ (let ((next-coding (or next-selection-coding-system 'iso-latin-1)))
+ (cond ;; check cut buffer
+ ((or (not cut-text) (string= cut-text ""))
+ (setq x-last-selected-text-cut nil))
+ ;; This short cut doesn't work because x-get-cut-buffer
+ ;; always returns a newly created string.
+ ;; ((eq cut-text x-last-selected-text-cut) nil)
+ ((and (string= cut-text x-last-selected-text-cut-encoded)
+ (eq x-last-cut-buffer-coding next-coding))
+ ;; See the comment above. No need of this recording.
+ ;; Record the newer string,
+ ;; so subsequent calls can use the `eq' test.
+ ;; (setq x-last-selected-text-cut cut-text)
+ nil)
+ (t
+ (setq x-last-selected-text-cut-encoded cut-text
+ x-last-cut-buffer-coding next-coding
+ x-last-selected-text-cut
+ ;; ICCCM says cut buffer always contain ISO-Latin-1, but
+ ;; use next-selection-coding-system if not nil.
+ (decode-coding-string
+ cut-text next-coding))))))
+
+ ;; As we have done one selection, clear this now.
+ (setq next-selection-coding-system nil)
+
+ ;; At this point we have recorded the current values for the
+ ;; selection from clipboard (if we are supposed to) primary,
+ ;; and cut buffer. So return the first one that has changed
+ ;; (which is the first non-null one).
+ ;;
+ ;; NOTE: There will be cases where more than one of these has
+ ;; changed and the new values differ. This indicates that
+ ;; something like the following has happened since the last time
+ ;; we looked at the selections: Application X set all the
+ ;; selections, then Application Y set only one or two of them (say
+ ;; just the cut-buffer). In this case since we don't have
+ ;; timestamps there is no way to know what the 'correct' value to
+ ;; return is. The nice thing to do would be to tell the user we
+ ;; saw multiple possible selections and ask the user which was the
+ ;; one they wanted.
+ ;; This code is still a big improvement because now the user can
+ ;; futz with the current selection and get emacs to pay attention
+ ;; to the cut buffer again (previously as soon as clipboard or
+ ;; primary had been set the cut buffer would essentially never be
+ ;; checked again).
+ (or clip-text primary-text cut-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
- ;; Exit Emacs with fatal error if this fails.
- t)
-
-(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))
-
-;; Setup the default fontset.
-(setup-default-fontset)
-
-;; Create the standard fontset.
-(create-fontset-from-fontset-spec standard-fontset-spec t)
-
-;; Create fontset specified in X resources "Fontset-N" (N is 0, 1, ...).
-(create-fontset-from-x-resource)
-
-;; 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. Don't set it if there are
- ;; sizes there already (from command line).
- (if (and (assq 'height parsed)
- (not (assq 'height default-frame-alist)))
- (setq default-frame-alist
- (cons (cons 'height (cdr (assq 'height parsed)))
- default-frame-alist)))
- (if (and (assq 'width parsed)
- (not (assq 'width default-frame-alist)))
- (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)))))
+;; 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)
+
+(defun x-clipboard-yank ()
+ "Insert the clipboard contents, or the last stretch of killed text."
+ (interactive "*")
+ (let ((clipboard-text (x-selection-value 'CLIPBOARD))
+ (x-select-enable-clipboard t))
+ (if (and clipboard-text (> (length clipboard-text) 0))
+ (kill-new clipboard-text))
+ (yank)))
-;; 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-menu-bar-open (&optional frame)
+ "Open the menu bar if `menu-bar-mode' is on. otherwise call `tmm-menubar'."
+ (interactive "i")
+ (if menu-bar-mode (accelerate-menu frame)
+ (tmm-menubar)))
-;; Set scroll bar mode to right if set by X resources. Default is left.
-(if (equal (x-get-resource "verticalScrollBars" "ScrollBars") "right")
- (customize-set-variable 'scroll-bar-mode 'right))
+\f
+;;; Window system initialization.
(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)
+(defvar x-initialized nil
+ "Non-nil if the X window system has been initialized.")
+
+(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.
+ (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 (or (getenv "DISPLAY" (selected-frame))
+ (getenv "DISPLAY"))))
+ x-command-line-resources
+ ;; Exit Emacs with fatal error if this fails and we
+ ;; are the initial display.
+ (eq initial-window-system 'x))
+
+ (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 standard fontset.
+ (create-fontset-from-fontset-spec standard-fontset-spec t)
+
+ ;; Create fontset specified in X resources "Fontset-N" (N is 0, 1, ...).
+ (create-fontset-from-x-resource)
+
+ ;; Set scroll bar mode to right if set by X resources. Default is left.
+ (if (equal (x-get-resource "verticalScrollBars" "ScrollBars") "right")
+ (customize-set-variable 'scroll-bar-mode 'right))
+
+ ;; 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. Don't set it if there are
+ ;; sizes there already (from command line).
+ (if (and (assq 'height parsed)
+ (not (assq 'height default-frame-alist)))
+ (setq default-frame-alist
+ (cons (cons 'height (cdr (assq 'height parsed)))
+ default-frame-alist)))
+ (if (and (assq 'width parsed)
+ (not (assq 'width default-frame-alist)))
+ (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)))))
-;; Turn off window-splitting optimization; X is usually fast enough
-;; that this is only annoying.
-(setq split-window-keep-point t)
+ ;; 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))))
-;; Don't show the frame name; that's redundant with X.
-(setq-default mode-line-frame-identification " ")
+ ;; Don't let Emacs suspend under X.
+ (add-hook 'suspend-hook 'x-win-suspend-error)
-;; 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))
+ ;; Turn off window-splitting optimization; X is usually fast enough
+ ;; that this is only annoying.
+ (setq split-window-keep-point t)
-;; Turn on support for mouse wheels.
-(mouse-wheel-mode 1)
+ ;; 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))
+ ;; Turn on support for mouse wheels.
+ (mouse-wheel-mode 1)
-;; Enable CLIPBOARD copy/paste through menu bar commands.
-(menu-bar-enable-clipboard)
+ ;; Enable CLIPBOARD copy/paste through menu bar commands.
+ (menu-bar-enable-clipboard)
-;; Override Paste so it looks at CLIPBOARD first.
-(defun x-clipboard-yank ()
- "Insert the clipboard contents, or the last stretch of killed text."
- (interactive "*")
- (let ((clipboard-text (x-selection-value 'CLIPBOARD))
- (x-select-enable-clipboard t))
- (if (and clipboard-text (> (length clipboard-text) 0))
- (kill-new clipboard-text))
- (yank)))
+ ;; 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 menu-bar-edit-menu [paste]
- '(menu-item "Paste" x-clipboard-yank
- :enable (not buffer-read-only)
- :help "Paste (yank) text most recently cut/copied"))
+(add-to-list 'handle-args-function-alist '(x . x-handle-args))
+(add-to-list 'frame-creation-function-alist '(x . x-create-frame-with-faces))
+(add-to-list 'window-system-initialization-alist '(x . x-initialize-window-system))
;; Initiate drag and drop
(add-hook 'after-make-frame-functions 'x-dnd-init-frame)
(define-key special-event-map [drag-n-drop] 'x-dnd-handle-drag-n-drop-event)
-;; Let F10 do menu bar navigation.
-(defun x-menu-bar-open (&optional frame)
- "Open the menu bar if `menu-bar-mode' is on. otherwise call `tmm-menubar'."
- (interactive "i")
- (if menu-bar-mode (menu-bar-open frame)
- (tmm-menubar)))
-
-(and (fboundp 'menu-bar-open)
- (global-set-key [f10] 'x-menu-bar-open))
-
(defcustom x-gtk-stock-map
'(
- ("new" . "gtk-new")
- ("open" . "gtk-open")
- ("diropen" . "gtk-directory")
- ("close" . "gtk-close")
- ("save" . "gtk-save")
- ("saveas" . "gtk-save-as")
- ("undo" . "gtk-undo")
- ("cut" . "gtk-cut")
- ("copy" . "gtk-copy")
- ("paste" . "gtk-paste")
- ("search" . "gtk-find")
- ("print" . "gtk-print")
- ("preferences" . "gtk-preferences")
- ("help" . "gtk-help")
- ("left-arrow" . "gtk-go-back")
- ("right-arrow" . "gtk-go-forward")
- ("home" . "gtk-home")
- ("jump-to" . "gtk-jump-to")
- ("index" . "gtk-index")
- ("search" . "gtk-find")
- ("exit" . "gtk-quit"))
+ ("etc/images/new" . "gtk-new")
+ ("etc/images/open" . "gtk-open")
+ ("etc/images/diropen" . "n:system-file-manager")
+ ("etc/images/close" . "gtk-close")
+ ("etc/images/save" . "gtk-save")
+ ("etc/images/saveas" . "gtk-save-as")
+ ("etc/images/undo" . "gtk-undo")
+ ("etc/images/cut" . "gtk-cut")
+ ("etc/images/copy" . "gtk-copy")
+ ("etc/images/paste" . "gtk-paste")
+ ("etc/images/search" . "gtk-find")
+ ("etc/images/print" . "gtk-print")
+ ("etc/images/preferences" . "gtk-preferences")
+ ("etc/images/help" . "gtk-help")
+ ("etc/images/left-arrow" . "gtk-go-back")
+ ("etc/images/right-arrow" . "gtk-go-forward")
+ ("etc/images/home" . "gtk-home")
+ ("etc/images/jump-to" . "gtk-jump-to")
+ ("etc/images/index" . "gtk-index")
+ ("etc/images/search" . "gtk-find")
+ ("etc/images/exit" . "gtk-quit")
+ ;; 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")
+ ;; No themed versions available:
+ ;; mail/preview.xpm (combining stock_mail and stock_zoom)
+ ;; mail/save.xpm (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."
- :version "23.0"
- :type 'alist
+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."
+ :version "22.2"
+ :type '(choice (repeat (choice symbol
+ (cons (string :tag "Emacs icon")
+ (string :tag "Stock/named")))))
+ :group 'x)
+
+(defcustom icon-map-list '(x-gtk-stock-map)
+ "A list of alists that maps 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
+to stock item gtk-open, use:
+
+ (\"etc/images/open\" . \"gtk-open\")
+
+Themes also have named icons. To map to one of those, use n: before the name:
+
+ (\"etc/images/diropen\" . \"n:system-file-manager\")
+
+The list elements are either the symbol name for the alist or the
+alist itself.
+
+If you don't want stock icons, set the variable to nil."
+ :version "22.2"
+ :type '(choice (const :tag "Don't use stock icons" nil)
+ (repeat (choice symbol
+ (cons (string :tag "Emacs icon")
+ (string :tag "Stock/named")))))
:group 'x)
(defun x-gtk-map-stock (file)
"Map icon with file name FILE to a Gtk+ stock name, using `x-gtk-stock-map'."
- (let ((value (and file
- (assoc-string (file-name-sans-extension
- (file-name-nondirectory file))
- x-gtk-stock-map))))
- (and value (cdr value))))
+ (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))
+
+(provide 'x-win)
;; arch-tag: f1501302-db8b-4d95-88e3-116697d89f78
;;; x-win.el ends here