xemacs-beta: lisp/select.el comparison

comparison lisp/select.el @ 410:de805c49cfc1 r21-2-35

Import from CVS: tag r21-2-35

author	cvs
date	Mon, 13 Aug 2007 11:19:21 +0200
parents	2f8bb876ab1d
children	697ef44129c6

comparison

equal deleted inserted replaced

-:301b9ebbdf3b
+:de805c49cfc1
 	       (selection-conversion-error
 		(if (cdr data-type)
 		    (get-selection type (cdr data-type))
 		  (signal (car err) (cdr err)))))
 	   (get-selection-internal type data-type))))
-(when (and (consp text) (symbolp (car text)))
-(setq text (cdr text)))
-(when (not (stringp text))
-(error "Selection is not a string: %S" text))
 text))
 ;; FSFmacs calls this `x-set-selection', and reverses the
 ;; first two arguments (duh ...).  This order is more logical.
-(defun own-selection (data &optional type append)
+(defun own-selection (data &optional type how-to-add data-type)
 "Make a window-system selection of type TYPE and value DATA.
 The argument TYPE (default `PRIMARY') says which selection,
-and DATA specifies the contents.  DATA may be a string,
+and DATA specifies the contents.  DATA may be any lisp data type
-a symbol, an integer (or a cons of two integers or list of two integers).
+that can be converted using the function corresponding to DATA-TYPE
-If APPEND is non-nil, append the data to the existing selection data.
+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
+system specific, but strings are always accepted).
+HOW-TO-ADD may be any of the following:
+'replace-all or nil -- replace all data in the selection.
+'replace-existing   -- replace data for specified DATA-TYPE only.
+'append or t        -- append data to existing DATA-TYPE data.
+DATA-TYPE is the window-system specific data type identifier
+(see `register-selection-data-type' for more information).
 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*.
+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).
 Thus, editing done in the buffer after you specify the selection
 can alter the effective value of the selection.
 The data may also be a vector of valid non-vector selection values.
 (let ((zmacs-region-stays zmacs-region-stays))
 					;FSFmacs huh??  It says:
 ;; "This is for temporary compatibility with pre-release Emacs 19."
 					;(if (stringp type)
 					;    (setq type (intern type)))
-(or (valid-simple-selection-p data)
-	(and (vectorp data)
-	     (let ((valid t)
-		   (i (1- (length data))))
-	       (while (>= i 0)
-		 (or (valid-simple-selection-p (aref data i))
-		     (setq valid nil))
-		 (setq i (1- i)))
-	       valid))
-	(signal 'error (list "invalid selection" data)))
 (or type (setq type 'PRIMARY))
-(flet ((own-selection-1
+(if (null data)
-	    (type data append)
+	(disown-selection-internal type)
-	    (when append
+(own-selection-internal type data how-to-add data-type)
-	      (unless (stringp data)
+(when (and (eq type 'PRIMARY)
-		;; kludge!
+		 selection-sets-clipboard)
-		(setq data (select-convert-to-text type 'STRING data))
+	 (own-selection-internal 'CLIPBOARD data how-to-add data-type)))
-		(if (stringp data)
-		    (setq data (concat (get-selection type) data)))))
-	    (own-selection-internal type data)))
-(if (null data)
-	  (disown-selection-internal type)
-	(own-selection-1 type data append)
-	(when (and (eq type 'PRIMARY)
-		   selection-sets-clipboard)
-	  (own-selection-internal 'CLIPBOARD data append))))
 (cond ((eq type 'PRIMARY)
 	   (setq primary-selection-extent
 		 (select-make-extent-for-selection
 		  data primary-selection-extent)))
 	  ((eq type 'SECONDARY)
 		  data secondary-selection-extent)))))
 ;; zmacs-region-stays is for commands, not low-level functions.
 ;; when behaving as the latter, we better not set it, or we will
 ;; cause unwanted sticky-region behavior in kill-region and friends.
 (if (interactive-p)
 (setq zmacs-region-stays t))
 data)
 (defun dehilight-selection (selection)
 "for use as a value of `lost-selection-hooks'."
 (cond ((eq selection 'PRIMARY)
 	       (setq secondary-selection-extent nil)))))
 nil)
 (setq lost-selection-hooks 'dehilight-selection)
-(defun own-clipboard (string &optional append)
+(defun own-clipboard (string &optional push)
 "Paste the given string to the window system Clipboard.
-If APPEND is non-nil, append the string to the existing contents."
+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."
 	  ))
 	previous-extent))))
 ;; moved from x-select.el
 (defun valid-simple-selection-p (data)
+"An obsolete function that tests whether something was a valid simple
+selection using the old XEmacs selection support. You shouldn't use this
+any more, because just about anything could be a valid selection now."
 (or (stringp data)
 ;FSFmacs huh?? (symbolp data)
 (integerp data)
 (and (consp data)
 	   (integerp (car data))
 		 (delete-rectangle s e)
 	       (delete-region s e))))
 (disown-selection nil)
 )))
 ;;; Functions to convert the selection into various other selection
-;;; types.  Every selection type that emacs handles is implemented
+;;; types.
-;;; this way, except for TIMESTAMP, which is a special case. These are
-;;; all moved from x-select.el
+;; These two 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
+suitable internal representation otherwise."
+(when value
+(let ((handler-fn (cdr (assq type selection-converter-in-alist))))
+(when handler-fn
+	(apply handler-fn (list selection type value))))))
+(defun select-convert-out (selection type value)
+"Attempt to convert the specified internal VALUE for the specified DATA-TYPE
+and SELECTION. Return nil if this is impossible, or a suitable external
+representation otherwise."
+(when value
+(let ((handler-fn (cdr (assq type selection-converter-out-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)
 (cond ((stringp value)
 	 value)
 	((extentp value)
 	 (save-excursion
 	   (save-restriction
 	     (widen)
 	     (buffer-substring (car value) (cdr value)))))
 	(t nil)))
+(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.
 (if (stringp outval)
 	(cons 'STRING outval)
 		(abs (- (car value) (cdr value)))))))
 (if value ; force it to be in 32-bit format.
 	(cons (ash value -16) (logand value 65535))
 nil)))
+(defun select-convert-from-length (selection type value)
+(select-convert-to-length selection type value))
 (defun select-convert-to-targets (selection type value)
 ;; return a vector of atoms, but remove duplicates first.
 (let* ((all (cons 'TIMESTAMP (mapcar 'car selection-converter-alist)))
 	 (rest all))
 (while rest
 (cond ((memq (car rest) (cdr rest))
 	     (setcdr rest (delq (car rest) (cdr rest))))
-	    ((eq (car (cdr rest)) '_EMACS_INTERNAL)  ; shh, it's a secret
-	     (setcdr rest (cdr (cdr rest))))
 	    (t
 	     (setq rest (cdr rest)))))
 (apply 'vector all)))
 (defun select-convert-to-delete (selection type value)
 	      (markerp (car value))
 	      (markerp (cdr value)))
 	 (buffer-file-name (or (marker-buffer (car value))
 			       (error "selection is in a killed buffer"))))
 	(t nil)))
+(defun select-convert-from-filename (selection type value)
+(when (stringp value)
+value))
 (defun select-convert-to-charpos (selection type value)
 (let (a b tmp)
 (cond ((cond ((extentp value)
 		  (setq a (extent-start-position value)
 (defun select-convert-to-integer (selection type value)
 (and (integerp value)
 (cons (ash value -16) (logand value 65535))))
+;; Can convert from the following integer representations
+;;
+;;    integer
+;;    (integer . integer)
+;;    (integer integer)
+;;    (list [integer|(integer . integer)]*)
+;;    (vector [integer|(integer . integer)]*)
+;;
+;; Cons'd integers get cleaned up a little.
+(defun select-convert-from-integer (selection type value)
+(cond ((integerp value)		; Integer
+	 value)
+	((and (consp value)		; (integer . integer)
+	      (integerp (car value))
+	      (integerp (cdr value)))
+	 (if (eq (car value) 0)
+	     (cdr value)
+	   (if (and (eq (car value) -1)
+		    (< (cdr value) 0))
+	       (cdr value)
+	     value)))
+	((and (listp value)		; (integer integer)
+	      (eq (length value) 2)
+	      (integerp (car value))
+	      (integerp (cadr value)))
+	 (if (eq (car value) 0)
+	     (cadr value)
+	   (if (and (eq (car value) -1)
+		    (< (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)
+	))
 (defun select-convert-to-atom (selection type value)
 (and (symbolp value) value))
-(defun select-convert-to-identity (selection type value) ; used internally
+;;; CF_xxx conversions
-(vector value))
+(defun select-convert-from-cf-text (selection type value)
+(replace-in-string (if (string-match "\0" value)
-(setq selection-converter-alist
+			 (substring value 0 (match-beginning 0))
+		       value)
+		     "\\(\r\n\\|\n\r\\)" "\n" t))
+(defun select-convert-to-cf-text (selection type value)
+(let ((text (select-convert-to-text selection type value)))
+(concat (replace-in-string text "\n" "\r\n" t) "\0")))
+;;; Appenders
+(defun select-append-to-text (selection type value1 value2)
+(let ((text1 (select-convert-to-text selection 'STRING value1))
+	(text2 (select-convert-to-text selection 'STRING value2)))
+(if (and text1 text2)
+	(concat text1 text2)
+nil)))
+(defun select-append-to-string (selection type value1 value2)
+(select-append-to-text selection type value1 value2))
+(defun select-append-to-compound-text (selection type value1 value2)
+(select-append-to-text selection type value1 value2))
+(defun select-append-to-cf-text (selection type value1 value2)
+(let ((text1 (select-convert-from-cf-text selection 'CF_TEXT value1))
+	(text2 (select-convert-from-cf-text selection 'CF_TEXT value2)))
+(if (and text1 text2)
+	(select-convert-to-cf-text selection type (concat text1 text2))
+nil)))
+(defun select-append-default (selection type value1 value2)
+;; This appender gets used if the type is "nil" - i.e. default.
+;; It should probably have more cases implemented than it does - e.g.
+;; appending numbers to strings, etc...
+(cond ((and (stringp value1) (stringp value2))
+	 (select-append-to-string selection 'STRING value1 value2))
+	(t nil)))
+;;; 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)
+	   value))
+	((markerp value)
+	 (unless (eq (marker-buffer value) buffer)
+	   value))
+	((and (consp value)
+	      (markerp (car value))
+	      (markerp (cdr value)))
+	 (unless (or (eq (marker-buffer (car value)) buffer)
+		     (eq (marker-buffer (cdr value)) buffer))
+	   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)
 	(STRING . select-convert-to-string)
 	(COMPOUND_TEXT . select-convert-to-compound-text)
 	(TARGETS . select-convert-to-targets)
 	(LENGTH . select-convert-to-length)
 	(USER . select-convert-to-user)
 	(CLASS . select-convert-to-class)
 	(NAME . select-convert-to-name)
 	(ATOM . select-convert-to-atom)
 	(INTEGER . select-convert-to-integer)
-	(_EMACS_INTERNAL . select-convert-to-identity)
+	(CF_TEXT . select-convert-to-cf-text)
 	))
+;; Types listed here can be selections foreign to XEmacs
+(setq selection-converter-in-alist
+'(; Specific types that get handled by generic converters
+	(COMPOUND_TEXT . select-convert-from-text)
+	(SOURCE_LOC . select-convert-from-text)
+	(OWNER_OS . select-convert-from-text)
+	(HOST_NAME . select-convert-from-text)
+	(USER . select-convert-from-text)
+	(CLASS . select-convert-from-text)
+	(NAME . select-convert-from-text)
+	; Generic types
+	(INTEGER . select-convert-from-integer)
+	(TEXT . select-convert-from-text)
+	(STRING . select-convert-from-text)
+	(LENGTH . select-convert-from-length)
+	(FILE_NAME . select-convert-from-filename)
+	(CF_TEXT . select-convert-from-cf-text)
+	))
+;; Types listed here can be appended by own-selection
+(setq selection-appender-alist
+'((nil . select-append-default)
+	(TEXT . select-append-to-text)
+	(STRING . select-append-to-string)
+	(COMPOUND_TEXT . select-append-to-compound-text)
+	(CF_TEXT . select-append-to-cf-text)
+	))
+;; Types listed here have buffer-kill handlers
+(setq selection-buffer-killed-alist
+'((nil . select-buffer-killed-default)
+	(TEXT . select-buffer-killed-text)
+	(STRING . select-buffer-killed-text)
+	(COMPOUND_TEXT . select-buffer-killed-text)
+	(CF_TEXT . select-buffer-killed-text)))
+;; Lists of types that are coercible (can be converted to other types)
+(setq selection-coercible-types '(TEXT STRING COMPOUND_TEXT))
 ;;; select.el ends here

Mercurial > hg > xemacs-beta

comparison lisp/select.el @ 410:de805c49cfc1 r21-2-35