update.

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

diff --git a/lisp/select.el b/lisp/select.el
index 1a9a20a..b185dea 100644 (file)
--- 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
 ;; 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.
 
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 

@@ -28,7 +28,7 @@
 
 ;;; Commentary:
 
 
 ;;; Commentary:
 

-;; This file is dumped with XEmacs 
+;; This file is dumped with XEmacs

 
 ;;; Code:
 
 
 ;;; 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.")
 
 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.")
   "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 ()
       (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))
 
   (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.")
 (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)
   "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)
 
 (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))
   (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.
 
 ;; 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
 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:
 
 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
 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.
 
 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)
   (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)
   (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.
 
 ;;; 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
 (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))))))
 
       (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)
 ;; 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)))
 
             (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)))
 (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)))
     (if (stringp outval)
        (cons 'STRING outval)
       outval)))

@@ -585,7 +613,7 @@ representation otherwise."
   (user-full-name))
 
 (defun select-convert-to-class (selection type size)
   (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.
 
 ;; 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)
 (defun select-convert-from-integer (selection type value)
   (cond ((integerp value)              ; Integer
         value)

-       
+

        ((and (consp value)             ; (integer . integer)
              (integerp (car value))
              (integerp (cdr value)))
        ((and (consp value)             ; (integer . integer)
              (integerp (car value))
              (integerp (cdr value)))

@@ -620,7 +648,7 @@ representation otherwise."
                    (< (cdr value) 0))
               (cdr value)
             value)))
                    (< (cdr value) 0))
               (cdr value)
             value)))

-       
+

        ((and (listp value)             ; (integer integer)
              (eq (length value) 2)
              (integerp (car 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)))))
                    (< (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))))
        ((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)))
        ((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)
        ))
 
        (t nil)
        ))
 

@@ -694,13 +722,18 @@ representation otherwise."
 
 ;;; Buffer kill handlers
 
 
 ;;; 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)
 (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)
           value))
        ((markerp value)
         (unless (eq (marker-buffer value) buffer)

@@ -708,14 +741,21 @@ representation otherwise."
        ((and (consp value)
              (markerp (car value))
              (markerp (cdr 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))
+        (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))
        (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)
 ;; 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)
        ))
 
        (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)
 ;; Types listed here can be appended by own-selection
 (setq selection-appender-alist
       '((nil . select-append-default)