Fix compilation of xmenu.c and unexcoff.c, clean up MSDOS source files.

[bpt/emacs.git] / lisp / select.el

diff --git a/lisp/select.el b/lisp/select.el
index 34f63d7..842c250 100644 (file)
--- a/lisp/select.el
+++ b/lisp/select.el
@@ -3,16 +3,16 @@
 ;; Maintainer: FSF
 ;; Keywords: internal
 
 ;; Maintainer: FSF
 ;; Keywords: internal
 

-;; Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
+;;   2008, 2009, 2010 Free Software Foundation, Inc.

 ;; Based partially on earlier release by Lucid.
 
 ;; This file is part of GNU Emacs.
 
 ;; Based partially on earlier release by Lucid.
 
 ;; This file is part of GNU Emacs.
 

-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify

 ;; it under the terms of the GNU General Public License as published by
 ;; it under the terms of the GNU General Public License as published by

-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.

 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of


@@ -20,9 +20,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License

-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

 
 ;;; Commentary:
 
 
 ;;; Commentary:
 


@@ -66,6 +64,9 @@ other X clients.  But, if this variable is set, it is used for
 the next communication only.  After the communication, this
 variable is set to nil.")
 
 the next communication only.  After the communication, this
 variable is set to nil.")
 

+(declare-function x-get-selection-internal "xselect.c"
+                 (selection-symbol target-type &optional time-stamp))
+

 ;; This is for temporary compatibility with pre-release Emacs 19.
 (defalias 'x-selection 'x-get-selection)
 (defun x-get-selection (&optional type data-type)
 ;; This is for temporary compatibility with pre-release Emacs 19.
 (defalias 'x-selection 'x-get-selection)
 (defun x-get-selection (&optional type data-type)


@@ -90,7 +91,7 @@ in `selection-converter-alist', which see."
                       selection-coding-system
                       (cond ((eq data-type 'UTF8_STRING)
                              'utf-8)
                       selection-coding-system
                       (cond ((eq data-type 'UTF8_STRING)
                              'utf-8)

-                            ((eq data-type 'COMPOUND-TEXT)
+                            ((eq data-type 'COMPOUND_TEXT)

                              'compound-text-with-extensions)
                             ((eq data-type 'C_STRING)
                              nil)
                              'compound-text-with-extensions)
                             ((eq data-type 'C_STRING)
                              nil)


@@ -108,8 +109,13 @@ in `selection-converter-alist', which see."
   "Return text pasted to the clipboard."
   (x-get-selection-internal 'CLIPBOARD 'STRING))
 
   "Return text pasted to the clipboard."
   (x-get-selection-internal 'CLIPBOARD 'STRING))
 

+(declare-function x-own-selection-internal "xselect.c"
+                 (selection-name selection-value))
+(declare-function x-disown-selection-internal "xselect.c"
+                 (selection &optional time))
+

 (defun x-set-selection (type data)
 (defun x-set-selection (type data)

-  "Make an X Windows selection of type TYPE and value DATA.
+  "Make an X selection of type TYPE and value DATA.

 The argument TYPE (nil means `PRIMARY') says which selection, and
 DATA specifies the contents.  TYPE must be a symbol.  \(It can also
 be a string, which stands for the symbol with that name, but this
 The argument TYPE (nil means `PRIMARY') says which selection, and
 DATA specifies the contents.  TYPE must be a symbol.  \(It can also
 be a string, which stands for the symbol with that name, but this


@@ -128,13 +134,14 @@ The return value is DATA.
 
 Interactively, this command sets the primary selection.  Without
 prefix argument, it reads the selection in the minibuffer.  With
 
 Interactively, this command sets the primary selection.  Without
 prefix argument, it reads the selection in the minibuffer.  With

-prefix argument, it uses the text of the region as the selection value ."
+prefix argument, it uses the text of the region as the selection value.
+
+Note that on MS-Windows, primary and secondary selections set by Emacs
+are not available to other programs."

   (interactive (if (not current-prefix-arg)
                   (list 'PRIMARY (read-string "Set text for pasting: "))
                 (list 'PRIMARY (buffer-substring (region-beginning) (region-end)))))
   (interactive (if (not current-prefix-arg)
                   (list 'PRIMARY (read-string "Set text for pasting: "))
                 (list 'PRIMARY (buffer-substring (region-beginning) (region-end)))))

-  ;; This is for temporary compatibility with pre-release Emacs 19.
-  (if (stringp type)
-      (setq type (intern type)))
+  (if (stringp type) (setq type (intern type)))

   (or (x-valid-simple-selection-p data)
       (and (vectorp data)
           (let ((valid t)
   (or (x-valid-simple-selection-p data)
       (and (vectorp data)
           (let ((valid t)


@@ -152,31 +159,27 @@ prefix argument, it uses the text of the region as the selection value ."
   data)
 
 (defun x-valid-simple-selection-p (data)
   data)
 
 (defun x-valid-simple-selection-p (data)

-  (or (stringp data)
-      (symbolp data)
-      (integerp data)
-      (and (consp data)
-          (integerp (car data))
-          (or (integerp (cdr data))
-              (and (consp (cdr data))
-                   (integerp (car (cdr data))))))
-      (overlayp data)
+  (or (bufferp data)

       (and (consp data)
           (markerp (car data))
           (markerp (cdr data))
           (marker-buffer (car data))
       (and (consp data)
           (markerp (car data))
           (markerp (cdr data))
           (marker-buffer (car data))

-          (marker-buffer (cdr data))
-          (eq (marker-buffer (car data))
-              (marker-buffer (cdr data)))

           (buffer-name (marker-buffer (car data)))
           (buffer-name (marker-buffer (car data)))

-          (buffer-name (marker-buffer (cdr data))))))
+          (eq (marker-buffer (car data))
+              (marker-buffer (cdr data))))
+      (stringp data)
+      (and (overlayp data)
+          (overlay-buffer data)
+          (buffer-name (overlay-buffer data)))
+      (symbolp data)
+      (integerp data)))

 \f
 ;;; Cut Buffer support
 
 (declare-function x-get-cut-buffer-internal "xselect.c")
 
 (defun x-get-cut-buffer (&optional which-one)
 \f
 ;;; Cut Buffer support
 
 (declare-function x-get-cut-buffer-internal "xselect.c")
 
 (defun x-get-cut-buffer (&optional which-one)

-  "Returns the value of one of the 8 X server cut-buffers.
+  "Return the value of one of the 8 X server cut-buffers.

 Optional arg WHICH-ONE should be a number from 0 to 7, defaulting to 0.
 Cut buffers are considered obsolete; you should use selections instead."
   (x-get-cut-buffer-internal
 Optional arg WHICH-ONE should be a number from 0 to 7, defaulting to 0.
 Cut buffers are considered obsolete; you should use selections instead."
   (x-get-cut-buffer-internal


@@ -195,41 +198,52 @@ If PUSH is non-nil, also rotate the cut buffers:
 this means the previous value of the primary cut buffer moves to the second
 cut buffer, and the second to the third, and so on (there are 8 buffers.)
 Cut buffers are considered obsolete; you should use selections instead."
 this means the previous value of the primary cut buffer moves to the second
 cut buffer, and the second to the third, and so on (there are 8 buffers.)
 Cut buffers are considered obsolete; you should use selections instead."

-  (or (stringp string) (signal 'wrong-type-argument (list 'string string)))
+  (or (stringp string) (signal 'wrong-type-argument (list 'stringp string)))

   (if push
       (x-rotate-cut-buffers-internal 1))
   (x-store-cut-buffer-internal 'CUT_BUFFER0 string))
 
 \f
   (if push
       (x-rotate-cut-buffers-internal 1))
   (x-store-cut-buffer-internal 'CUT_BUFFER0 string))
 
 \f

-;;; 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.
+;; 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.
+
+(defun xselect--selection-bounds (value)
+  "Return bounds of X selection value VALUE.
+The return value is a list (BEG END BUF) if VALUE is a cons of
+two markers or an overlay.  Otherwise, it is nil."
+  (cond ((bufferp value)
+        (with-current-buffer value
+          (when (mark t)
+            (list (mark t) (point) value))))
+       ((and (consp value)
+             (markerp (car value))
+             (markerp (cdr value)))
+        (when (and (marker-buffer (car value))
+                   (buffer-name (marker-buffer (car value)))
+                   (eq (marker-buffer (car value))
+                       (marker-buffer (cdr value))))
+          (list (marker-position (car value))
+                (marker-position (cdr value))
+                (marker-buffer (car value)))))
+       ((overlayp value)
+        (when (overlay-buffer value)
+          (list (overlay-start value)
+                (overlay-end value)
+                (overlay-buffer value))))))
+
+(defun xselect--int-to-cons (n)
+  (cons (ash n -16) (logand n 65535)))

 
 (defun xselect-convert-to-string (selection type value)
   (let (str coding)
     ;; Get the actual string from VALUE.
     (cond ((stringp value)
           (setq str value))
 
 (defun xselect-convert-to-string (selection type value)
   (let (str coding)
     ;; Get the actual string from VALUE.
     (cond ((stringp value)
           (setq str value))

-
-         ((overlayp value)
-          (save-excursion
-            (or (buffer-name (overlay-buffer value))
-                (error "selection is in a killed buffer"))
-            (set-buffer (overlay-buffer value))
-            (setq str (buffer-substring (overlay-start value)
-                                        (overlay-end value)))))
-         ((and (consp value)
-               (markerp (car value))
-               (markerp (cdr value)))
-          (or (eq (marker-buffer (car value)) (marker-buffer (cdr value)))
-              (signal 'error
-                      (list "markers must be in the same buffer"
-                            (car value) (cdr value))))
-          (save-excursion
-            (set-buffer (or (marker-buffer (car value))
-                            (error "selection is in a killed buffer")))
-            (setq str (buffer-substring (car value) (cdr value))))))
-
+         ((setq value (xselect--selection-bounds value))
+          (with-current-buffer (nth 2 value)
+            (setq str (buffer-substring (nth 0 value)
+                                        (nth 1 value))))))

     (when str
       ;; If TYPE is nil, this is a local request, thus return STR as
       ;; is.  Otherwise, encode STR.
     (when str
       ;; If TYPE is nil, this is a local request, thus return STR as
       ;; is.  Otherwise, encode STR.


@@ -241,13 +255,12 @@ Cut buffers are considered obsolete; you should use selections instead."
        (let ((inhibit-read-only t))
          ;; Suppress producing escape sequences for compositions.
          (remove-text-properties 0 (length str) '(composition nil) str)
        (let ((inhibit-read-only t))
          ;; Suppress producing escape sequences for compositions.
          (remove-text-properties 0 (length str) '(composition nil) str)

-         (if (not (multibyte-string-p str))
-             ;; Don't have to encode unibyte string.
-             (setq type 'C_STRING)
-           (if (eq type 'TEXT)
-               ;; TEXT is a polimorphic target.  We must select the
-               ;; actual type from `UTF8_STRING', `COMPOUND_TEXT',
-               ;; `STRING', and `C_STRING'.
+         (if (eq type 'TEXT)
+             ;; TEXT is a polymorphic target.  We must select the
+             ;; actual type from `UTF8_STRING', `COMPOUND_TEXT',
+             ;; `STRING', and `C_STRING'.
+             (if (not (multibyte-string-p str))
+                 (setq type 'C_STRING)

                (let (non-latin-1 non-unicode eight-bit)
                  (mapc #'(lambda (x)
                            (if (>= x #x100)
                (let (non-latin-1 non-unicode eight-bit)
                  (mapc #'(lambda (x)
                            (if (>= x #x100)


@@ -259,55 +272,42 @@ Cut buffers are considered obsolete; you should use selections instead."
                        str)
                  (setq type (if non-unicode 'COMPOUND_TEXT
                               (if non-latin-1 'UTF8_STRING
                        str)
                  (setq type (if non-unicode 'COMPOUND_TEXT
                               (if non-latin-1 'UTF8_STRING

-                                (if eight-bit 'C_STRING 'STRING))))))
-           (cond
-            ((eq type 'UTF8_STRING)
-             (if (or (not coding)
-                     (not (eq (coding-system-type coding) 'utf-8)))
-                 (setq coding 'utf-8))
-             (setq str (encode-coding-string str coding)))
-
-            ((eq type 'STRING)
-             (if (or (not coding)
-                     (not (eq (coding-system-type coding) 'charset)))
-                 (setq coding 'iso-8859-1))
-             (setq str (encode-coding-string str coding)))
-
-            ((eq type 'COMPOUND_TEXT)
-             (if (or (not coding)
-                     (not (eq (coding-system-type coding) 'iso-2022)))
-                 (setq coding 'compound-text-with-extensions))
-             (setq str (encode-coding-string str coding)))
-
-            ((eq type 'C_STRING)
-             (setq str (string-make-unibyte str)))
-
-            (t
-             (error "Unknow selection type: %S" type))
-            ))))
+                                (if eight-bit 'C_STRING 'STRING)))))))
+         (cond
+          ((eq type 'UTF8_STRING)
+           (if (or (not coding)
+                   (not (eq (coding-system-type coding) 'utf-8)))
+               (setq coding 'utf-8))
+           (setq str (encode-coding-string str coding)))
+
+          ((eq type 'STRING)
+           (if (or (not coding)
+                   (not (eq (coding-system-type coding) 'charset)))
+               (setq coding 'iso-8859-1))
+           (setq str (encode-coding-string str coding)))
+
+          ((eq type 'COMPOUND_TEXT)
+           (if (or (not coding)
+                   (not (eq (coding-system-type coding) 'iso-2022)))
+               (setq coding 'compound-text-with-extensions))
+           (setq str (encode-coding-string str coding)))
+
+          ((eq type 'C_STRING)
+           (setq str (string-make-unibyte str)))
+
+          (t
+           (error "Unknown selection type: %S" type)))))

 
       (setq next-selection-coding-system nil)
       (cons type str))))
 
 
       (setq next-selection-coding-system nil)
       (cons type str))))
 

-

 (defun xselect-convert-to-length (selection type value)
 (defun xselect-convert-to-length (selection type value)

-  (let ((value
-        (cond ((stringp value)
-               (length value))
-              ((overlayp value)
-               (abs (- (overlay-end value) (overlay-start value))))
-              ((and (consp value)
-                    (markerp (car value))
-                    (markerp (cdr value)))
-               (or (eq (marker-buffer (car value))
-                       (marker-buffer (cdr value)))
-                   (signal 'error
-                           (list "markers must be in the same buffer"
-                                 (car value) (cdr value))))
-               (abs (- (car value) (cdr value)))))))
-    (if value ; force it to be in 32-bit format.
-       (cons (ash value -16) (logand value 65535))
-      nil)))
+  (let ((len (cond ((stringp value)
+                   (length value))
+                  ((setq value (xselect--selection-bounds value))
+                   (abs (- (nth 0 value) (nth 1 value)))))))
+    (if len
+       (xselect--int-to-cons len))))

 
 (defun xselect-convert-to-targets (selection type value)
   ;; return a vector of atoms, but remove duplicates first.
 
 (defun xselect-convert-to-targets (selection type value)
   ;; return a vector of atoms, but remove duplicates first.


@@ -330,77 +330,31 @@ Cut buffers are considered obsolete; you should use selections instead."
   'NULL)
 
 (defun xselect-convert-to-filename (selection type value)
   'NULL)
 
 (defun xselect-convert-to-filename (selection type value)

-  (cond ((overlayp value)
-        (buffer-file-name (or (overlay-buffer value)
-                              (error "selection is in a killed buffer"))))
-       ((and (consp value)
-             (markerp (car value))
-             (markerp (cdr value)))
-        (buffer-file-name (or (marker-buffer (car value))
-                              (error "selection is in a killed buffer"))))
-       (t nil)))
+  (when (setq value (xselect--selection-bounds value))
+    (buffer-file-name (nth 2 value))))

 
 (defun xselect-convert-to-charpos (selection type value)
 
 (defun xselect-convert-to-charpos (selection type value)

-  (let (a b tmp)
-    (cond ((cond ((overlayp value)
-                 (setq a (overlay-start value)
-                       b (overlay-end value)))
-                ((and (consp value)
-                      (markerp (car value))
-                      (markerp (cdr value)))
-                 (setq a (car value)
-                       b (cdr value))))
-          (setq a (1- a) b (1- b)) ; zero-based
-          (if (< b a) (setq tmp a a b b tmp))
-          (cons 'SPAN
-                (vector (cons (ash a -16) (logand a 65535))
-                        (cons (ash b -16) (logand b 65535))))))))
+  (when (setq value (xselect--selection-bounds value))
+    (let ((beg (1- (nth 0 value))) ; zero-based
+         (end (1- (nth 1 value))))
+      (cons 'SPAN (vector (xselect--int-to-cons (min beg end))
+                         (xselect--int-to-cons (max beg end)))))))

 
 (defun xselect-convert-to-lineno (selection type value)
 
 (defun xselect-convert-to-lineno (selection type value)

-  (let (a b buf tmp)
-    (cond ((cond ((and (consp value)
-                      (markerp (car value))
-                      (markerp (cdr value)))
-                 (setq a (marker-position (car value))
-                       b (marker-position (cdr value))
-                       buf (marker-buffer (car value))))
-                ((overlayp value)
-                 (setq buf (overlay-buffer value)
-                       a (overlay-start value)
-                       b (overlay-end value)))
-                )
-          (save-excursion
-            (set-buffer buf)
-            (setq a (count-lines 1 a)
-                  b (count-lines 1 b)))
-          (if (< b a) (setq tmp a a b b tmp))
-          (cons 'SPAN
-                (vector (cons (ash a -16) (logand a 65535))
-                        (cons (ash b -16) (logand b 65535))))))))
+  (when (setq value (xselect--selection-bounds value))
+    (with-current-buffer (nth 2 value)
+      (let ((beg (line-number-at-pos (nth 0 value)))
+           (end (line-number-at-pos (nth 1 value))))
+       (cons 'SPAN (vector (xselect--int-to-cons (min beg end))
+                           (xselect--int-to-cons (max beg end))))))))

 
 (defun xselect-convert-to-colno (selection type value)
 
 (defun xselect-convert-to-colno (selection type value)

-  (let (a b buf tmp)
-    (cond ((cond ((and (consp value)
-                      (markerp (car value))
-                      (markerp (cdr value)))
-                 (setq a (car value)
-                       b (cdr value)
-                       buf (marker-buffer a)))
-                ((overlayp value)
-                 (setq buf (overlay-buffer value)
-                       a (overlay-start value)
-                       b (overlay-end value)))
-                )
-          (save-excursion
-            (set-buffer buf)
-            (goto-char a)
-            (setq a (current-column))
-            (goto-char b)
-            (setq b (current-column)))
-          (if (< b a) (setq tmp a a b b tmp))
-          (cons 'SPAN
-                (vector (cons (ash a -16) (logand a 65535))
-                        (cons (ash b -16) (logand b 65535))))))))
+  (when (setq value (xselect--selection-bounds value))
+    (with-current-buffer (nth 2 value)
+      (let ((beg (progn (goto-char (nth 0 value)) (current-column)))
+           (end (progn (goto-char (nth 1 value)) (current-column))))
+       (cons 'SPAN (vector (xselect--int-to-cons (min beg end))
+                           (xselect--int-to-cons (max beg end))))))))

 
 (defun xselect-convert-to-os (selection type size)
   (symbol-name system-type))
 
 (defun xselect-convert-to-os (selection type size)
   (symbol-name system-type))


@@ -425,7 +379,7 @@ This function returns the string \"emacs\"."
 
 (defun xselect-convert-to-integer (selection type value)
   (and (integerp value)
 
 (defun xselect-convert-to-integer (selection type value)
   (and (integerp value)

-       (cons (ash value -16) (logand value 65535))))
+       (xselect--int-to-cons value)))

 
 (defun xselect-convert-to-atom (selection type value)
   (and (symbolp value) value))
 
 (defun xselect-convert-to-atom (selection type value)
   (and (symbolp value) value))


@@ -452,10 +406,9 @@ This function returns the string \"emacs\"."
        (NAME . xselect-convert-to-name)
        (ATOM . xselect-convert-to-atom)
        (INTEGER . xselect-convert-to-integer)
        (NAME . xselect-convert-to-name)
        (ATOM . xselect-convert-to-atom)
        (INTEGER . xselect-convert-to-integer)

-       (_EMACS_INTERNAL . xselect-convert-to-identity)
-       ))
+       (_EMACS_INTERNAL . xselect-convert-to-identity)))

 
 (provide 'select)
 
 
 (provide 'select)
 

-;;; arch-tag: bb634f97-8a3b-4b0a-b940-f6e09982328c
+;; arch-tag: bb634f97-8a3b-4b0a-b940-f6e09982328c

 ;;; select.el ends here
 ;;; select.el ends here