X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fselect.el;h=b185dea27388e587421a9d364dc7407e1aa8e280;hb=84d69cedb1497fde83814a796ebe5d93e168c78b;hp=1a9a20a2d6b3427d1418a81d4ada3ff1bd8e3563;hpb=762383636a99307282c2d93d26c35c046ec24da1;p=chise%2Fxemacs-chise.git.1 diff --git a/lisp/select.el b/lisp/select.el index 1a9a20a..b185dea 100644 --- a/lisp/select.el +++ b/lisp/select.el @@ -20,7 +20,7 @@ ;; General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the +;; along with XEmacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. @@ -28,7 +28,7 @@ ;;; Commentary: -;; This file is dumped with XEmacs +;; This file is dumped with XEmacs ;;; Code: @@ -40,7 +40,7 @@ COMPOUND_TEXT and STRING are the most commonly used data types. If a list is provided, the types are tried in sequence until there is a successful conversion.") -(defvar selection-sets-clipboard nil +(defvar selection-sets-clipboard nil "Controls the selection's relationship to the clipboard. When non-nil, any operation that sets the primary selection will also set the clipboard.") @@ -75,9 +75,15 @@ set the clipboard.") (insert clip)))) (defun get-clipboard () - "Return text pasted to the clipboard." + "Return text pasted to the clipboard. +Not suitable for `interprogram-paste-function', use `get-clipboard-foreign'." (get-selection 'CLIPBOARD)) +(defun get-clipboard-foreign () + "Return text pasted to the clipboard by another program. +See `interprogram-paste-function' for more information." + (get-selection-foreign 'CLIPBOARD)) + (define-device-method get-cutbuffer "Return the value of one of the cut buffers. This will do nothing under anything other than X.") @@ -86,26 +92,34 @@ This will do nothing under anything other than X.") "Return the value of a window-system selection. The argument TYPE (default `PRIMARY') says which selection, and the argument DATA-TYPE (default `STRING', or `COMPOUND_TEXT' under Mule) -says how to convert the data. Returns NIL if there is no selection" - (condition-case err (get-selection type data-type) (t nil))) +says how to convert the data. Returns NIL if there is no selection." + (condition-case nil (get-selection type data-type) (t nil))) (defun get-selection (&optional type data-type) "Return the value of a window-system selection. The argument TYPE (default `PRIMARY') says which selection, and the argument DATA-TYPE (default `STRING', or `COMPOUND_TEXT' under Mule) -says how to convert the data. If there is no selection an error is signalled." +says how to convert the data. If there is no selection an error is signalled. +Not suitable in a `interprogram-paste-function', q.v." (or type (setq type 'PRIMARY)) (or data-type (setq data-type selected-text-type)) - (let ((text - (if (consp data-type) - (condition-case err - (get-selection-internal type (car data-type)) - (selection-conversion-error - (if (cdr data-type) - (get-selection type (cdr data-type)) - (signal (car err) (cdr err))))) - (get-selection-internal type data-type)))) - text)) + (if (consp data-type) + (condition-case err + (get-selection-internal type (car data-type)) + (selection-conversion-error + (if (cdr data-type) + (get-selection type (cdr data-type)) + (signal (car err) (cdr err))))) + (get-selection-internal type data-type))) + +(defun get-selection-foreign (&optional type data-type) + "Return the value of a window-system selection, or nil if XEmacs owns it. +The argument TYPE (default `PRIMARY') says which selection, +and the argument DATA-TYPE (default `STRING', or `COMPOUND_TEXT' under Mule) +says how to convert the data. If there is no selection an error is signalled. +See `interprogram-paste-function' for more information." + (unless (selection-owner-p type) + (get-selection type data-type))) ;; FSFmacs calls this `x-set-selection', and reverses the ;; first two arguments (duh ...). This order is more logical. @@ -116,7 +130,7 @@ and DATA specifies the contents. DATA may be any lisp data type that can be converted using the function corresponding to DATA-TYPE in `select-converter-alist'---strings are the usual choice, but other types may be permissible depending on the DATA-TYPE parameter -(if DATA-TYPE is not supplied, the default behaviour is window +(if DATA-TYPE is not supplied, the default behavior is window system specific, but strings are always accepted). HOW-TO-ADD may be any of the following: @@ -131,7 +145,7 @@ The selection may also be a cons of two markers pointing to the same buffer, or an overlay. In these cases, the selection is considered to be the text between the markers *at whatever time the selection is examined* (note that the window system clipboard does not necessarily duplicate this -behaviour - it doesn't on mswindows for example). +behavior - it doesn't on mswindows for example). Thus, editing done in the buffer after you specify the selection can alter the effective value of the selection. @@ -196,8 +210,9 @@ See `interprogram-cut-function' for more information." (own-selection string 'CLIPBOARD)) (defun disown-selection (&optional secondary-p) - "Assuming we own the selection, disown it. With an argument, discard the -secondary selection instead of the primary selection." + "Assuming we own the selection, disown it. +With an argument, discard the secondary selection instead of the +primary selection." (disown-selection-internal (if secondary-p 'SECONDARY 'PRIMARY)) (when (and selection-sets-clipboard (or (not secondary-p) @@ -364,7 +379,7 @@ any more, because just about anything could be a valid selection now." ;;; Functions to convert the selection into various other selection ;;; types. -;; These two functions get called by C code... +;; These next three functions get called by C code... (defun select-convert-in (selection type value) "Attempt to convert the specified external VALUE to the specified DATA-TYPE, for the specified SELECTION. Return nil if this is impossible, or a @@ -383,6 +398,15 @@ representation otherwise." (when handler-fn (apply handler-fn (list selection type value)))))) +(defun select-coerce (selection type value) + "Attempt to convert the specified internal VALUE to a representation +suitable for return from `get-selection' in the specified DATA-TYPE. Return +nil if this is impossible, or a suitable representation otherwise." + (when value + (let ((handler-fn (cdr (assq type selection-coercion-alist)))) + (when handler-fn + (apply handler-fn (list selection type value)))))) + ;; The rest of the functions on this "page" are conversion handlers, ;; append handlers and buffer-kill handlers. (defun select-convert-to-text (selection type value) @@ -410,13 +434,17 @@ representation otherwise." (buffer-substring (car value) (cdr value))))) (t nil))) +(defun select-coerce-to-text (selection type value) + (select-convert-to-text selection type value)) + (defun select-convert-from-text (selection type value) (when (stringp value) value)) (defun select-convert-to-string (selection type value) (let ((outval (select-convert-to-text selection type value))) - ;; force the string to be not in Compound Text format. + ;; force the string to be not in Compound Text format. This grubby + ;; hack will go soon, to be replaced by a more general mechanism. (if (stringp outval) (cons 'STRING outval) outval))) @@ -585,7 +613,7 @@ representation otherwise." (user-full-name)) (defun select-convert-to-class (selection type size) - x-emacs-application-class) + (symbol-value 'x-emacs-application-class)) ;; We do not try to determine the name Emacs was invoked with, ;; because it is not clean for a program's behavior to depend on that. @@ -610,7 +638,7 @@ representation otherwise." (defun select-convert-from-integer (selection type value) (cond ((integerp value) ; Integer value) - + ((and (consp value) ; (integer . integer) (integerp (car value)) (integerp (cdr value))) @@ -620,7 +648,7 @@ representation otherwise." (< (cdr value) 0)) (cdr value) value))) - + ((and (listp value) ; (integer integer) (eq (length value) 2) (integerp (car value)) @@ -631,21 +659,21 @@ representation otherwise." (< (cdr value) 0)) (- (cadr value)) (cons (car value) (cadr value))))) - + ((listp value) ; list (if (cdr value) (mapcar '(lambda (x) (select-convert-from-integer selection type x)) value) (select-convert-from-integer selection type (car value)))) - + ((vectorp value) ; vector (if (eq (length value) 1) (select-convert-from-integer selection type (aref value 0)) (mapvector '(lambda (x) (select-convert-from-integer selection type x)) value))) - + (t nil) )) @@ -694,13 +722,18 @@ representation otherwise." ;;; Buffer kill handlers -;; #### Should this function take the text *out* of the buffer that's -;; being killed? Or should it do what the original code did and just -;; destroy the selection? (defun select-buffer-killed-default (selection type value buffer) ;; This handler gets used if the type is "nil". (cond ((extentp value) - (unless (eq (extent-object value) buffer) + (if (eq (extent-object value) buffer) + ; If this selection is on the clipboard, grab it quick + (when (eq selection 'CLIPBOARD) + (save-excursion + (set-buffer (extent-object value)) + (save-restriction + (widen) + (buffer-substring (extent-start-position value) + (extent-end-position value))))) value)) ((markerp value) (unless (eq (marker-buffer value) buffer) @@ -708,14 +741,21 @@ representation otherwise." ((and (consp value) (markerp (car value)) (markerp (cdr value))) - (unless (or (eq (marker-buffer (car value)) buffer) - (eq (marker-buffer (cdr value)) buffer)) - value)) + (if (or (eq (marker-buffer (car value)) buffer) + (eq (marker-buffer (cdr value)) buffer)) + ; If this selection is on the clipboard, grab it quick + (when (eq selection 'CLIPBOARD) + (save-excursion + (set-buffer (marker-buffer (car value))) + (save-restriction + (widen) + (buffer-substring (car value) (cdr value))))) + value)) (t value))) (defun select-buffer-killed-text (selection type value buffer) (select-buffer-killed-default selection type value buffer)) - + ;; Types listed in here can be selections of XEmacs (setq selection-converter-out-alist '((TEXT . select-convert-to-text) @@ -758,6 +798,22 @@ representation otherwise." (CF_TEXT . select-convert-from-cf-text) )) +;; Types listed here have special coercion functions that can munge +;; other types. This can also be used to add special features - e.g. +;; being able to pass a region or a cons of markers to own-selection, +;; but getting the *current* text in the region back when calling +;; get-selection. +;; +;; Any function listed in here *will be called* whenever a value of +;; its type is retrieved from the internal selection cache, or when +;; no suitable values could be found in which case XEmacs looks for +;; values with types listed in selection-coercible-types. +(setq selection-coercion-alist + '((TEXT . select-coerce-to-text) + (STRING . select-coerce-to-text) + (COMPOUND_TEXT . select-coerce-to-text) + (CF_TEXT . select-coerce-to-text))) + ;; Types listed here can be appended by own-selection (setq selection-appender-alist '((nil . select-append-default)