X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/f9d71b4284fa1009f8c38a9d389e2202ef1e4dd9..cc232200f77c373da233803992a70d2d30bb73ff:/lisp/term/x-win.el diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index b3ce877be5..e3c42626a3 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -1,7 +1,6 @@ ;;; 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, -;; 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1993-1994, 2001-2011 Free Software Foundation, Inc. ;; Author: FSF ;; Keywords: terminals, i18n @@ -252,50 +251,6 @@ exists." (defconst x-pointer-invisible 255) -(defvar x-colors) - -(defun xw-defined-colors (&optional frame) - "Internal function called by `defined-colors'." - (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 (color-supported-p this-color frame t) - (setq defined-colors (cons this-color defined-colors)))) - defined-colors)) - -;;;; Function keys - -(defvar x-alternatives-map - (let ((map (make-sparse-keymap))) - ;; Map certain keypad keys into ASCII characters that people usually expect. - (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 the graphical frame FRAME." - ;; 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))) - ;;;; Keysyms (defun vendor-specific-keysyms (vendor) @@ -1192,101 +1147,55 @@ as returned by `x-server-vendor'." ;; #x0dde THAI MAIHANAKAT Thai -;;;; Selections and cut buffers +;;;; Selections ;; 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. We track all three +;; from x-selection-value. We track both ;; separately in case another X application only sets one of them -;; (say the cut buffer) we aren't fooled by the PRIMARY or -;; CLIPBOARD selection staying the same. +;; we aren't fooled by the PRIMARY or CLIPBOARD selection staying the same. (defvar x-last-selected-text-clipboard nil "The value of the CLIPBOARD X selection last time we selected or pasted text.") (defvar x-last-selected-text-primary nil "The value of the PRIMARY X selection last time we selected or pasted text.") -(defvar x-last-selected-text-cut nil - "The value of the X cut buffer last time we selected or pasted text. -The actual text stored in the X cut buffer is what encoded from this value.") -(defvar x-last-selected-text-cut-encoded nil - "The value of the X cut buffer last time we selected or pasted text. -This is the actual text stored in the X cut buffer.") -(defvar x-last-cut-buffer-coding 'iso-latin-1 - "The coding we last used to encode/decode the text from the X cut buffer") - -(defvar x-cut-buffer-max 20000 ; Note this value is overridden below. - "Max number of characters to put in the cut buffer. -It is said that overlarge strings are slow to put into the cut buffer.") - -(defcustom x-select-enable-clipboard t - "Non-nil means cutting and pasting uses the clipboard. -This is in addition to, but in preference to, the primary selection." - :type 'boolean - :group 'killing) -(defcustom x-select-enable-primary t +(defcustom x-select-enable-primary nil "Non-nil means cutting and pasting uses the primary selection." :type 'boolean - :group 'killing) + :group 'killing + :version "24.1") -(defun x-select-text (text &optional push) - "Select TEXT, a string, according to the window system. - -On X, put TEXT in the primary X selection. For backward -compatibility with older X applications, set the value of X cut -buffer 0 as well, and if the optional argument PUSH is non-nil, -rotate the cut buffers. If `x-select-enable-clipboard' is -non-nil, copy the text to the X clipboard as well. - -On Windows, make TEXT the current selection. If -`x-select-enable-clipboard' is non-nil, copy the text to the -clipboard as well. The argument PUSH is ignored. - -On Nextstep, put TEXT in the pasteboard; PUSH is ignored." - ;; 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. +(defcustom x-select-request-type nil + "Data type request for X selection. 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 one of the above symbols, try only the specified -type. +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. -The value nil is the same as this list: - \(UTF8_STRING COMPOUND_TEXT STRING) -") +The value nil is the same as the list (UTF8_STRING COMPOUND_TEXT STRING)." + :type '(choice (const :tag "Default" nil) + (const COMPOUND_TEXT) + (const UTF8_STRING) + (const STRING) + (const TEXT) + (set :tag "List of values" + (const COMPOUND_TEXT) + (const UTF8_STRING) + (const STRING) + (const TEXT))) + :group 'killing) ;; Get a selection value of type TYPE by calling x-get-selection with ;; an appropriate 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) +(defun x-selection-value-internal (type) (let ((request-type (or x-select-request-type '(UTF8_STRING COMPOUND_TEXT STRING))) text) @@ -1304,17 +1213,16 @@ The value nil is the same as this list: text)) ;; Return the value of the current X selection. -;; Consult the selection, and the cut buffer. Treat empty strings -;; as if they were unset. +;; Consult the selection. Treat empty strings as if they were unset. ;; If this function is called twice and finds the same 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 () +(defun x-selection-value () ;; 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) + (let (clip-text primary-text) (when x-select-enable-clipboard - (setq clip-text (x-selection-value 'CLIPBOARD)) + (setq clip-text (x-selection-value-internal 'CLIPBOARD)) (if (string= clip-text "") (setq clip-text nil)) ;; Check the CLIPBOARD selection for 'newness', is it different @@ -1333,7 +1241,7 @@ The value nil is the same as this list: (t (setq x-last-selected-text-clipboard clip-text))))) (when x-select-enable-primary - (setq primary-text (x-selection-value 'PRIMARY)) + (setq primary-text (x-selection-value-internal '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. @@ -1350,69 +1258,45 @@ The value nil is the same as this list: (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 + ;; selection from clipboard (if we are supposed to) and primary. + ;; 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 + ;; selections, then Application Y set only one of them. + ;; 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) + (or clip-text primary-text) ))) +(define-obsolete-function-alias 'x-cut-buffer-or-selection-value + 'x-selection-value "24.1") + ;; 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) +(setq interprogram-paste-function 'x-selection-value) + +;; Make paste from other applications use the decoding in x-select-request-type +;; and not just STRING. +(defun x-get-selection-value () + "Get the current value of the PRIMARY selection. +Request data types in the order specified by `x-select-request-type'." + (x-selection-value-internal 'PRIMARY)) (defun x-clipboard-yank () "Insert the clipboard contents, or the last stretch of killed text." (interactive "*") - (let ((clipboard-text (x-selection-value 'CLIPBOARD)) + (let ((clipboard-text (x-selection-value-internal 'CLIPBOARD)) (x-select-enable-clipboard t)) (if (and clipboard-text (> (length clipboard-text) 0)) (kill-new clipboard-text)) @@ -1469,9 +1353,6 @@ The value nil is the same as this list: ;; 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)) - ;; Create the default fontset. (create-default-fontset) @@ -1701,5 +1582,4 @@ This uses `icon-map-list' to map icon file names to stock icon names." (provide 'x-win) -;; arch-tag: f1501302-db8b-4d95-88e3-116697d89f78 ;;; x-win.el ends here