Mercurial > hg > xemacs-beta

comparison lisp/select.el @ 416:ebe98a74bd68 r21-2-16

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-16
author cvs
date Mon, 13 Aug 2007 11:22:23 +0200
parents da8ed4261e83
children e804706bfb8c
comparison
equal deleted inserted replaced
415:a27f76b40c83 416:ebe98a74bd68
38 Can be either a valid X selection data type, or a list of such types. 38 Can be either a valid X selection data type, or a list of such types.
39 COMPOUND_TEXT and STRING are the most commonly used data types. 39 COMPOUND_TEXT and STRING are the most commonly used data types.
40 If a list is provided, the types are tried in sequence until 40 If a list is provided, the types are tried in sequence until
41 there is a successful conversion.") 41 there is a successful conversion.")
42 42
43 (defvar selection-is-clipboard-p nil
44 "Controls the selection's relationship to the clipboard.
45 When non-nil, any operation that sets the primary selection will also
46 set the clipboard.")
47
43 (defun copy-primary-selection () 48 (defun copy-primary-selection ()
44 "Copy the selection to the Clipboard and the kill ring." 49 "Copy the selection to the Clipboard and the kill ring."
45 (interactive) 50 (interactive)
46 (and (console-on-window-system-p) 51 (and (console-on-window-system-p)
47 (cut-copy-clear-internal 'copy))) 52 (cut-copy-clear-internal 'copy)))
72 77
73 (defun get-selection (&optional type data-type) 78 (defun get-selection (&optional type data-type)
74 "Return the value of a Windows selection. 79 "Return the value of a Windows selection.
75 The argument TYPE (default `PRIMARY') says which selection, 80 The argument TYPE (default `PRIMARY') says which selection,
76 and the argument DATA-TYPE (default `STRING', or `COMPOUND_TEXT' under Mule) 81 and the argument DATA-TYPE (default `STRING', or `COMPOUND_TEXT' under Mule)
77 says how to convert the data." 82 says how to convert the data. If there is no selection an error is signalled."
83 (let ((text (get-selection-no-error type data-type)))
84 (when (not (stringp text))
85 (error "Selection is not a string: %S" text))
86 text))
87
88 (defun get-selection-no-error (&optional type data-type)
89 "Return the value of a Windows selection.
90 The argument TYPE (default `PRIMARY') says which selection,
91 and the argument DATA-TYPE (default `STRING', or `COMPOUND_TEXT' under Mule)
92 says how to convert the data. Returns NIL if there is no selection"
78 (or type (setq type 'PRIMARY)) 93 (or type (setq type 'PRIMARY))
79 (or data-type (setq data-type selected-text-type)) 94 (or data-type (setq data-type selected-text-type))
80 (let ((text 95 (let ((text
81 (if (consp data-type) 96 (if (consp data-type)
82 (condition-case err 97 (condition-case err
86 (get-selection type (cdr data-type)) 101 (get-selection type (cdr data-type))
87 (signal (car err) (cdr err))))) 102 (signal (car err) (cdr err)))))
88 (get-selection-internal type data-type)))) 103 (get-selection-internal type data-type))))
89 (when (and (consp text) (symbolp (car text))) 104 (when (and (consp text) (symbolp (car text)))
90 (setq text (cdr text))) 105 (setq text (cdr text)))
91 (when (not (stringp text))
92 (error "Selection is not a string: %S" text))
93 text)) 106 text))
94 107
95 ;; FSFmacs calls this `x-set-selection', and reverses the 108 ;; FSFmacs calls this `x-set-selection', and reverses the
96 ;; arguments (duh ...). This order is more logical. 109 ;; arguments (duh ...). This order is more logical.
97 (defun own-selection (data &optional type) 110 (defun own-selection (data &optional type)
125 (setq valid nil)) 138 (setq valid nil))
126 (setq i (1- i))) 139 (setq i (1- i)))
127 valid)) 140 valid))
128 (signal 'error (list "invalid selection" data))) 141 (signal 'error (list "invalid selection" data)))
129 (or type (setq type 'PRIMARY)) 142 (or type (setq type 'PRIMARY))
130 (if data 143 (if (null data)
131 (own-selection-internal type data) 144 (disown-selection-internal type)
132 (disown-selection-internal type)) 145 (own-selection-internal type data)
146 (when (and (eq type 'PRIMARY)
147 selection-is-clipboard-p)
148 (own-selection-internal 'CLIPBOARD data)))
133 (cond ((eq type 'PRIMARY) 149 (cond ((eq type 'PRIMARY)
134 (setq primary-selection-extent 150 (setq primary-selection-extent
135 (select-make-extent-for-selection 151 (select-make-extent-for-selection
136 data primary-selection-extent))) 152 data primary-selection-extent)))
137 ((eq type 'SECONDARY) 153 ((eq type 'SECONDARY)