import -ko -b 1.1.3 XEmacs XEmacs-21_2 r21-2-35

[chise/xemacs-chise.git.1] / lisp / select.el

diff --git a/lisp/select.el b/lisp/select.el
index 82788f4..1a9a20a 100644 (file)
--- a/lisp/select.el
+++ b/lisp/select.el
@@ -105,24 +105,33 @@ says how to convert the data. If there is no selection an error is signalled."
                    (get-selection type (cdr data-type))
                  (signal (car err) (cdr err)))))
           (get-selection-internal type 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.
     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,
   "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,
-a symbol, an integer (or a cons of two integers or list of two integers).
-If APPEND is non-nil, append the data to the existing selection data.
+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
+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
 
 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.
 
 Thus, editing done in the buffer after you specify the selection
 can alter the effective value of the selection.
 

@@ -138,32 +147,13 @@ Interactively, the text of the region is used as the selection value."
     ;; "This is for temporary compatibility with pre-release Emacs 19."
                                        ;(if (stringp type)
                                        ;    (setq type (intern type)))
     ;; "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))
     (or type (setq type 'PRIMARY))

-    (flet ((own-selection-1
-           (type data append)
-           (when append
-             (unless (stringp data)
-               ;; kludge!
-               (setq data (select-convert-to-text type 'STRING data))
-               (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))))
+    (if (null data)
+       (disown-selection-internal type)
+      (own-selection-internal type data how-to-add data-type)
+      (when (and (eq type 'PRIMARY)
+                selection-sets-clipboard)
+        (own-selection-internal 'CLIPBOARD data how-to-add data-type)))

     (cond ((eq type 'PRIMARY)
           (setq primary-selection-extent
                 (select-make-extent-for-selection
     (cond ((eq type 'PRIMARY)
           (setq primary-selection-extent
                 (select-make-extent-for-selection

@@ -176,7 +166,7 @@ Interactively, the text of the region is used as the selection value."
   ;; 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)
   ;; 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))
+  (setq zmacs-region-stays t))

   data)
 
 (defun dehilight-selection (selection)
   data)
 
 (defun dehilight-selection (selection)

@@ -200,9 +190,9 @@ Interactively, the text of the region is used as the selection value."
 
 (setq lost-selection-hooks 'dehilight-selection)
 
 
 (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.
   "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)
   (own-selection string 'CLIPBOARD))
 
 (defun disown-selection (&optional secondary-p)

@@ -306,6 +296,9 @@ secondary selection instead of the primary selection."
 
 ;; moved from x-select.el
 (defun valid-simple-selection-p (data)
 
 ;; 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)
   (or (stringp data)
       ;FSFmacs huh?? (symbolp data)
       (integerp data)

@@ -367,11 +360,31 @@ secondary selection instead of the primary selection."
       (disown-selection nil)
       )))
 
       (disown-selection nil)
       )))
 

+\f

 ;;; Functions to convert the selection into various other selection
 ;;; Functions to convert the selection into various other selection

-;;; types.  Every selection type that emacs handles is implemented
-;;; this way, except for TIMESTAMP, which is a special case. These are
-;;; all moved from x-select.el
-
+;;; types.
+
+;; 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)
 (defun select-convert-to-text (selection type value)
   (cond ((stringp value)
         value)

@@ -397,6 +410,10 @@ secondary selection instead of the primary selection."
             (buffer-substring (car value) (cdr value)))))
        (t nil)))
 
             (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.
 (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.

@@ -427,6 +444,9 @@ secondary selection instead of the primary selection."
        (cons (ash value -16) (logand value 65535))
       nil)))
 
        (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)))
 (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)))

@@ -434,8 +454,6 @@ secondary selection instead of the primary selection."
     (while rest
       (cond ((memq (car rest) (cdr rest))
             (setcdr rest (delq (car rest) (cdr rest))))
     (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)))
            (t
             (setq rest (cdr rest)))))
     (apply 'vector all)))

@@ -458,6 +476,10 @@ secondary selection instead of the primary selection."
                               (error "selection is in a killed buffer"))))
        (t nil)))
 
                               (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)
 (defun select-convert-to-charpos (selection type value)
   (let (a b tmp)
     (cond ((cond ((extentp value)

@@ -575,13 +597,127 @@ secondary selection instead of the primary selection."
   (and (integerp value)
        (cons (ash value -16) (logand value 65535))))
 
   (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-atom (selection type value)
   (and (symbolp value) value))
 

-(defun select-convert-to-identity (selection type value) ; used internally
-  (vector value))
+;;; CF_xxx conversions
+(defun select-convert-from-cf-text (selection type value)
+  (replace-in-string (if (string-match "\0" value)
+                        (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)))

 
 

-(setq selection-converter-alist
+(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)
       '((TEXT . select-convert-to-text)
        (STRING . select-convert-to-string)
        (COMPOUND_TEXT . select-convert-to-compound-text)

@@ -600,7 +736,46 @@ secondary selection instead of the primary selection."
        (NAME . select-convert-to-name)
        (ATOM . select-convert-to-atom)
        (INTEGER . select-convert-to-integer)
        (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
 ;;; select.el ends here