This incorporates Jamie’s patch of the middle of last year; a patch of mine
that did the same for outgoing data as did Jamie’s for incoming data; and a
fix to Esben’s problem where XEmacs wasn’t offering a TIMESTAMP for
selections. Beyond the first two patches--which made it possible to copy and
paste or middle-click non-ASCII text to and from apps that aren’t some form
of emacs--this makes it possible to paste images into XEmacs, though, since
the integration of images into XEmacs isn’t thorough, this is pretty much
cosmetic. We also do serious content negotiation for the first time.
It renames get-selection-timestamp to get-xemacs-selection-timestamp,
because the function never worked for non-XEmacs selections. It also reverts
it to returning a cons of sixteen-bit quantities, because X11 Time
quantities are always thirty-two bits wide, and Lisp needs to be able to
manipulate the data, not treating it as an opaque pointer, for pasting into
non-XEmacs apps.
Builds linked against Motif previous to this patch only offered TIMESTAMP,
TEXT and COMPOUND_TEXT as the types of XEmacs selections to make available;
I haven’t changed this, on the perhaps invalid assumption that people had
their reasons for this. If anyone knows this, tell me, because UTF8_STRING
gives much more functionality in 2005.
Comments and testing, especially testing on Windows, would be appreciated. I
don’t believe this adds any more functionality to copying and pasting there,
and I also don’t believe it’ll break any functionality there, but
reassurance of the latter would be helpful.
lisp/ChangeLog addition:
2005-02-26 Aidan Kehoe <kehoea(a)parhasard.net>
* mouse.el (insert-selection): Honour check-cutbuffer-p.
* select.el (selected-text-type): Removed.
* select.el (selection-preferred-types): New.
* select.el ('selected-text-type): New.
Rename selected-text-type to selection-preferred-types, now that
it's full of image types as fallbacks. Define an alias to the old
name.
* select.el (kill-primary-selection): deleted -> delete
* select.el (get-selection-no-error):
* select.el (get-selection):
* select.el (get-selection-foreign):
Reference selection-preferred-types instead of giving details of
which types these functions default to wanting.
* select.el (select-make-extent-for-selection): Comment that we
need to hook something similar into the rectangle functions.
* select.el (select-convert-in):
If we don't have a handler for an X11 selection, pass the value
itself as a string. Fixes X11 atoms.
* select.el (select-convert-to-timestamp): New.
Uses get-xemacs-selection-timestamp.
* select.el (select-convert-to-utf-8-text): New.
* select.el (select-convert-from-text): Removed.
The change in select-convert-in makes this irrelevant.
* select.el (select-convert-from-length): Removed.
We have a more generic integer conversion routine here.
* select.el (select-convert-from-filename): Removed.
The generic string conversion handles this.
* select.el (select-convert-from-ip-address): New.
Whee.
* select.el (select-convert-from-utf-8-text): New.
* select.el (select-convert-from-utf-16-le-text): New.
The various Mozilla-specific types need the utf-16 conversion;
utf-8 conversion is _in_ this season, didn't you know?
* select.el (select-convert-from-image-data): New.
Generic convert-an-image-to-a-space-with-end-glyph function. Used
by the next six functions.
* select.el (select-convert-from-image/gif): New.
* select.el (select-convert-from-image/jpeg): New.
* select.el (select-convert-from-image/png): New.
* select.el (select-convert-from-image/tiff): New.
* select.el (select-convert-from-image/xpm): New.
* select.el (select-convert-from-image/xbm): New.
Check if we have support for a given image format; if so, pass
back a space with the corresponding selection's image attached as
glyph data.
* select.el (select-convert-from-cf-unicodetext):
* select.el (select-convert-to-cf-text):
* select.el (select-convert-to-cf-unicodetext):
Check that the corresponding Windows coding systems are available
before trying to convert.
* select.el (selection-converter-out-alist):
* select.el (selection-converter-in-alist):
Update both lists to reflect the other changes in the file.
* x-select.el (x-selected-text-type):
Update the define-obsolete-variable-alias now selected-text-type
is called something else.
src/ChangeLog addition:
2005-02-26 Aidan Kehoe <kehoea(a)parhasard.net>
* select-gtk.c (emacs_gtk_selection_handle):
* select-gtk.c (emacs_gtk_selection_clear_event_handle):
Use get_selection_raw_timestamp instead of Fget_selection_timestamp.
* select-gtk.c (gtk_own_selection):
Cross reference to some debate in select-x.c
* select-x.c:
* select-x.c (x_handle_selection_request):
Discuss Time vs. time_t--I think Time is _always_ thirty-two-bit
and time_t is variable in size.
* select-x.c (x_handle_selection_clear):
Replace call to Fget_selection_timestamp with call to
get_selection_raw_time, check that pasted data pointer is non-zero
before trying to free it.
* select.c:
* select.c (Fown_selection_internal):
Informative comment! Shouldn't actually be needed outside of the X
world.
* select.c (get_selection_raw_time): New function.
* select.c (Fget_selection_timestamp): Rework to use
get_selection_raw_time.
* select.h:
Make get_selection_raw_time available.
XEmacs Trunk source patch:
Diff command: cvs -q diff -u
Files affected: src/select.h src/select.c src/select-x.c src/select-gtk.c lisp/x-select.el lisp/select.el lisp/mouse.el
Index: lisp/mouse.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mouse.el,v
retrieving revision 1.31
diff -u -u -r1.31 mouse.el
--- lisp/mouse.el 2005/01/26 04:47:14 1.31
+++ lisp/mouse.el 2005/02/26 20:42:59
@@ -125,13 +125,11 @@
"Insert the current selection into buffer at point."
(interactive "P")
;; we fallback to the clipboard if the current selection is not existent
- (let ((text (if check-cutbuffer-p
- (or (get-selection-no-error)
- (get-cutbuffer)
- (get-selection-no-error 'CLIPBOARD)
- (error "No selection, clipboard or cut buffer available"))
- (or (get-selection-no-error)
- (get-selection 'CLIPBOARD)))))
+ (let ((text (or (get-selection-no-error 'PRIMARY)
+ (and check-cutbuffer-p (get-cutbuffer))
+ (get-selection-no-error 'CLIPBOARD)
+ (error "no selection: PRIMARY or CLIPBOARD")
+ )))
(cond (move-point-event
(mouse-set-point move-point-event)
(push-mark (point)))
Index: lisp/select.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/select.el,v
retrieving revision 1.13
diff -u -u -r1.13 select.el
--- lisp/select.el 2002/05/23 11:46:10 1.13
+++ lisp/select.el 2005/02/26 20:42:59
@@ -33,13 +33,25 @@
;;; Code:
-(defvar selected-text-type
- (if (featurep 'mule) '(COMPOUND_TEXT STRING) 'STRING)
- "The type atom used to obtain selections from the X server.
-Can be either a valid X selection data type, or a list of such types.
-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.")
+;; We prefer UTF8_STRING to COMPOUND_TEXT because, even though the latter
+;; gives us more information when taking data from other XEmacs invocations,
+;; Mozilla will happily give us broken COMPOUND_TEXT where a non-broken
+;; UTF8_STRING is available.
+(defvar selection-preferred-types
+ (let ((res '(UTF8_STRING COMPOUND_TEXT STRING image/png image/gif
+ image/jpeg image/tiff image/xpm image/xbm)))
+ (unless (featurep 'mule) (delq 'COMPOUND_TEXT res))
+ res)
+ "An ordered list of X11 type atoms for selections we want to receive.
+We prefer UTF8_STRING over COMPOUND_TEXT, for compatibility with a certain
+widely-used browser suite, and COMPOUND_TEXT over STRING. (COMPOUND_TEXT
+isn't available on non-Mule.) We also accept several image types.
+
+For compatibility, this can be a single atom. ")
+
+;; Renamed because it was just ridiculous for it to be mostly image formats
+;; and named selected-text-type.
+(define-obsolete-variable-alias 'selected-text-type 'selection-preferred-types)
(defvar selection-sets-clipboard nil
"Controls the selection's relationship to the clipboard.
@@ -56,7 +68,7 @@
(cut-copy-clear-internal 'copy)))
(defun kill-primary-selection ()
- "Copy the selection to the Clipboard and the kill ring, then deleted it.
+ "Copy the selection to the Clipboard and the kill ring, then delete it.
This is similar to the command \\[kill-region] except that it will
save to the Clipboard even if that command doesn't, and it handles rectangles
properly."
@@ -97,34 +109,62 @@
(defun get-selection-no-error (&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. Returns NIL if there is no selection."
+The argument TYPE (default `PRIMARY') says which selection, and the argument
+DATA-TYPE (defaulting to the value of `selection-preferred-types'), 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.
-Not suitable in a `interprogram-paste-function', q.v."
+The argument TYPE (default `PRIMARY') says which selection, and the argument
+DATA-TYPE (defaulting to the value of, and compatible with,
+`selection-preferred-types') 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 data-type (setq data-type selection-preferred-types))
(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)))))
+ (let ((targets (get-selection-internal type 'TARGETS))
+ res good-target)
+ (catch 'converted
+ (if targets
+ (dolist (current-preference data-type)
+ (condition-case err
+ (progn
+ (setq good-target nil)
+ ;; Tell me I don't need to do this and that we
+ ;; actually have a (member) that works on
+ ;; vectors.
+ (mapc '(lambda (x) (if (eq x current-preference)
+ (setq good-target t)))
+ targets)
+ (if (and good-target
+ (setq res (get-selection-internal
+ type current-preference)))
+ (throw 'converted res)))
+ (selection-conversion-error
+ nil))))
+ ;; The source app didn't offer us anything compatible in TARGETS,
+ ;; or they're not negotiating at all. (That is, we're probably not
+ ;; on X11.) Try to convert to the types specified by our caller,
+ ;; and throw an error if the last one of those fails.
+ (while data-type
+ (condition-case err
+ (progn
+ (setq res (get-selection-internal type (car data-type)))
+ (throw 'converted res))
+ (selection-conversion-error
+ (if (cdr data-type)
+ (setq data-type (pop 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."
+The argument TYPE (default `PRIMARY') says which selection, and the argument
+DATA-TYPE (defaulting to the value of `selection-preferred-types' which see)
+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)))
@@ -255,6 +295,8 @@
;; Given a selection, this makes an extent in the buffer which holds that
;; selection, for highlighting purposes. If the selection isn't associated
;; with a buffer, this does nothing.
+ ;;
+ ;; Something similar needs to be hooked into the rectangle functions.
(let ((buffer nil)
(valid (and (extentp previous-extent)
(extent-object previous-extent)
@@ -391,8 +433,9 @@
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))))))
+ (if handler-fn
+ (apply handler-fn (list selection type value))
+ value))))
(defun select-convert-out (selection type value)
"Attempt to convert the specified internal VALUE for the specified DATA-TYPE
@@ -439,13 +482,42 @@
(buffer-substring (car value) (cdr value)))))
(t nil)))
+(defun select-convert-to-timestamp (selection type value)
+ (let ((ts (get-xemacs-selection-timestamp selection)))
+ (if ts (cons 'TIMESTAMP ts))))
+
+(defun select-convert-to-utf-8-text (selection type value)
+ (cond ((stringp value)
+ (cons 'UTF8_STRING (encode-coding-string value 'utf-8)))
+ ((extentp value)
+ (save-excursion
+ (set-buffer (extent-object value))
+ (save-restriction
+ (widen)
+ (cons 'UTF8_STRING
+ (encode-coding-string
+ (buffer-substring (extent-start-position value)
+ (extent-end-position value)) 'utf-8)))))
+ ((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")))
+ (save-restriction
+ (widen)
+ (cons 'UTF8_STRING (encode-coding-string
+ (buffer-substring (car value) (cdr value))
+ 'utf-8)))))
+ (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. This grubby
@@ -477,9 +549,6 @@
(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)))
@@ -509,10 +578,6 @@
(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)
@@ -682,35 +747,89 @@
(t nil)
))
+(defun select-convert-from-ip-address (selection type value)
+ (if (and (stringp value)
+ (= (length value) 4))
+ (format "%d.%d.%d.%d"
+ (aref value 0) (aref value 1) (aref value 2) (aref value 3))))
+
(defun select-convert-to-atom (selection type value)
(and (symbolp value) value))
+(defun select-convert-from-utf-8-text (selection type value)
+ (decode-coding-string value 'utf-8))
+
+(defun select-convert-from-utf-16-le-text (selection type value)
+ (decode-coding-string value 'utf-16-le))
+
+;; Image conversion.
+(defun select-convert-from-image-data (image-type value)
+ "Take an image type specification--one of the image types this XEmacs
+supports--and some data in that format, return a space, with a glyph
+corresponding to that data as an end-glyph extent property of that space. "
+ (let* ((str (make-string 1 ?\ ))
+ (extent (make-extent 0 1 str))
+ (glyph (make-glyph (vector image-type ':data value))))
+ (when glyph
+ (set-extent-property extent 'invisible t)
+ (set-extent-property extent 'start-open t)
+ (set-extent-property extent 'end-open t)
+ (set-extent-property extent 'duplicable t)
+ (set-extent-property extent 'atomic t)
+ (set-extent-end-glyph extent glyph)
+ str)))
+
+;; Could automate defining these functions these with a macro, but damned if
+;; I can get that to work. Anyway, this is more readable.
+
+(defun select-convert-from-image/gif (selection type value)
+ (if (featurep 'gif) (select-convert-from-image-data 'gif value)))
+
+(defun select-convert-from-image/jpeg (selection type value)
+ (if (featurep 'jpeg) (select-convert-from-image-data 'jpeg value)))
+
+(defun select-convert-from-image/png (selection type value)
+ (if (featurep 'png) (select-convert-from-image-data 'png value)))
+
+(defun select-convert-from-image/tiff (selection type value)
+ (if (featurep 'tiff) (select-convert-from-image-data 'tiff value)))
+
+(defun select-convert-from-image/xpm (selection type value)
+ (if (featurep 'xpm) (select-convert-from-image-data 'xpm value)))
+
+(defun select-convert-from-image/xbm (selection type value)
+ (if (featurep 'xbm) (select-convert-from-image-data 'xbm value)))
+
;;; CF_xxx conversions
(defun select-convert-from-cf-text (selection type value)
- (let ((value (decode-coding-string value 'mswindows-multibyte)))
- (replace-in-string (if (string-match "\0" value)
- (substring value 0 (match-beginning 0))
- value)
- "\\(\r\n\\|\n\r\\)" "\n" t)))
+ (if (find-coding-system 'mswindows-multibyte)
+ (let ((value (decode-coding-string value 'mswindows-multibyte)))
+ (replace-in-string (if (string-match "\0" value)
+ (substring value 0 (match-beginning 0))
+ value)
+ "\\(\r\n\\|\n\r\\)" "\n" t))))
(defun select-convert-from-cf-unicodetext (selection type value)
- (let ((value (decode-coding-string value 'mswindows-unicode)))
- (replace-in-string (if (string-match "\0" value)
- (substring value 0 (match-beginning 0))
- value)
- "\\(\r\n\\|\n\r\\)" "\n" t)))
+ (if (find-coding-system 'mswindows-unicode)
+ (let ((value (decode-coding-string value 'mswindows-unicode)))
+ (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)))
- (encode-coding-string
- (concat (replace-in-string text "\n" "\r\n" t) "\0")
- 'mswindows-multibyte)))
+ (if (find-coding-system 'mswindows-multibyte)
+ (let ((text (select-convert-to-text selection type value)))
+ (encode-coding-string
+ (concat (replace-in-string text "\n" "\r\n" t) "\0")
+ 'mswindows-multibyte))))
(defun select-convert-to-cf-unicodetext (selection type value)
- (let ((text (select-convert-to-text selection type value)))
- (encode-coding-string
- (concat (replace-in-string text "\n" "\r\n" t) "\0")
- 'mswindows-unicode)))
+ (if (find-coding-system 'mswindows-unicode)
+ (let ((text (select-convert-to-text selection type value)))
+ (encode-coding-string
+ (concat (replace-in-string text "\n" "\r\n" t) "\0")
+ 'mswindows-unicode))))
;;; Appenders
(defun select-append-to-text (selection type value1 value2)
@@ -788,7 +907,9 @@
;; Types listed in here can be selections of XEmacs
(setq selection-converter-out-alist
- '((TEXT . select-convert-to-text)
+ '((TIMESTAMP . select-convert-to-timestamp)
+ (UTF8_STRING . select-convert-to-utf-8-text)
+ (TEXT . select-convert-to-text)
(STRING . select-convert-to-string)
(COMPOUND_TEXT . select-convert-to-compound-text)
(TARGETS . select-convert-to-targets)
@@ -813,21 +934,28 @@
;; 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)
+ (TIMESTAMP . select-convert-from-integer)
+ (LENGTH . select-convert-from-integer)
+ (LIST_LENGTH . select-convert-from-integer)
+ (CLIENT_WINDOW . select-convert-from-integer)
+ (PROCESS . select-convert-from-integer)
+ (IP_ADDRESS . select-convert-from-ip-address)
+ ;; We go after UTF8_STRING in preference to STRING because Mozilla,
+ ;; at least, does bad things with non-Latin-1 Unicode characters in
+ ;; STRING.
+ (UTF8_STRING . select-convert-from-utf-8-text)
(CF_TEXT . select-convert-from-cf-text)
(CF_UNICODETEXT . select-convert-from-cf-unicodetext)
+ (text/html . select-convert-from-utf-16-le-text) ; Mozilla
+ (text/_moz_htmlcontext . select-convert-from-utf-16-le-text)
+ (text/_moz_htmlinfo . select-convert-from-utf-16-le-text)
+ (image/png . select-convert-from-image/png)
+ (image/gif . select-convert-from-image/gif)
+ (image/jpeg . select-convert-from-image/jpeg )
+ (image/tiff . select-convert-from-image/tiff )
+ (image/xpm . select-convert-from-image/xpm)
+ (image/xbm . select-convert-from-image/xbm)
))
;; Types listed here have special coercion functions that can munge
Index: lisp/x-select.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/x-select.el,v
retrieving revision 1.7
diff -u -u -r1.7 x-select.el
--- lisp/x-select.el 2001/05/04 22:42:18 1.7
+++ lisp/x-select.el 2005/02/26 20:43:00
@@ -43,7 +43,7 @@
(define-obsolete-function-alias 'x-selection-owner-p 'selection-owner-p)
(define-obsolete-variable-alias 'x-selection-converter-alist 'selection-converter-alist)
(define-obsolete-variable-alias 'x-lost-selection-hooks 'lost-selection-hooks)
-(define-obsolete-variable-alias 'x-selected-text-type 'selected-text-type)
+(define-obsolete-variable-alias 'x-selected-text-type 'selection-preferred-types)
(define-obsolete-function-alias 'x-valid-simple-selection-p 'valid-simple-selection-p)
(define-obsolete-function-alias 'x-own-selection 'own-selection)
(define-obsolete-function-alias 'x-disown-selection 'disown-selection)
Index: src/select-gtk.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/select-gtk.c,v
retrieving revision 1.16
diff -u -u -r1.16 select-gtk.c
--- src/select-gtk.c 2004/11/04 23:06:52 1.16
+++ src/select-gtk.c 2005/02/26 20:43:00
@@ -158,7 +158,7 @@
target_symbol = fetch_multiple_target (selection_data);
#endif
- temp_obj = Fget_selection_timestamp (selection_symbol);
+ temp_obj = get_selection_raw_time(selection_symbol);
if (NILP (temp_obj))
{
@@ -255,7 +255,7 @@
selection_symbol = atom_to_symbol (d, selection);
- local_selection_time_lisp = Fget_selection_timestamp (selection_symbol);
+ local_selection_time_lisp = get_selection_raw_time (selection_symbol);
/* We don't own the selection, so that's fine. */
if (NILP (local_selection_time_lisp))
@@ -428,13 +428,14 @@
selection_atom,
thyme);
- /* We do NOT use time_to_lisp() here any more, like we used to.
+ /* [[ We do NOT use time_to_lisp() here any more, like we used to.
That assumed equivalence of time_t and Time, which is not
necessarily the case (e.g. under OSF on the Alphas, where
Time is a 64-bit quantity and time_t is a 32-bit quantity).
- Opaque pointers are the clean way to go here.
- */
+ Opaque pointers are the clean way to go here. ]]
+
+ See my comment on the same issue in select-x.c -- Aidan. */
return make_opaque (&thyme, sizeof (thyme));
}
Index: src/select-x.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/select-x.c,v
retrieving revision 1.17
diff -u -u -r1.17 select-x.c
--- src/select-x.c 2005/01/24 23:34:09 1.17
+++ src/select-x.c 2005/02/26 20:43:01
@@ -237,13 +237,21 @@
XSetSelectionOwner (display, selection_atom, selecting_window, thyme);
- /* We do NOT use time_to_lisp() here any more, like we used to.
+ /* [[ We do NOT use time_to_lisp() here any more, like we used to.
That assumed equivalence of time_t and Time, which is not
necessarily the case (e.g. under OSF on the Alphas, where
- Time is a 64-bit quantity and time_t is a 32-bit quantity).
+ Time is a 64-bit quantity and time_t is a 32-bit quantity).]]
- Opaque pointers are the clean way to go here.
- */
+ This is wrong--on Digital Unix, time_t is a sixty-four-bit quantity,
+ and Time is, as the X protocol dictates, a thirty-two-bit quantity.
+
+ [[ Opaque pointers are the clean way to go here. ]]
+
+ Again, I disagree--the Lisp selection infrastructure needs to be
+ able to manipulate the selection timestamps if it is, as we want
+ it to, to be able to do most of the work. Though I have moved the
+ conversion to lisp to get-xemacs-selection-timestamp. -- Aidan. */
+
selection_time = make_opaque (&thyme, sizeof (thyme));
#ifdef MOTIF_CLIPBOARDS
@@ -605,7 +613,7 @@
target_symbol = fetch_multiple_target (event);
#endif
- temp_obj = Fget_selection_timestamp (selection_symbol);
+ temp_obj = get_selection_raw_time (selection_symbol);
if (NILP (temp_obj))
{
@@ -653,7 +661,12 @@
successful_p = Qt;
/* Tell x_selection_request_lisp_error() it's cool. */
event->type = 0;
- xfree (data, Rawbyte *);
+ /* Data need not have been allocated; cf. select-convert-to-delete in
+ lisp/select.el . */
+ if ((Rawbyte *)0 != data)
+ {
+ xfree (data, Rawbyte *);
+ }
}
unbind_to (count);
@@ -693,7 +706,7 @@
selection_symbol = x_atom_to_symbol (d, selection);
- local_selection_time_lisp = Fget_selection_timestamp (selection_symbol);
+ local_selection_time_lisp = get_selection_raw_time (selection_symbol);
/* We don't own the selection, so that's fine. */
if (NILP (local_selection_time_lisp))
Index: src/select.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/select.c,v
retrieving revision 1.6
diff -u -u -r1.6 select.c
--- src/select.c 2002/06/20 21:18:45 1.6
+++ src/select.c 2005/02/26 20:43:02
@@ -289,6 +289,14 @@
/* have to do device specific stuff last so that methods can access the
selection_alist */
+
+ /* If you are re-implementing this for another redisplay type, either make
+ certain that the selection time will fit within thirty-two bits, or
+ redesign get-xemacs-selection-timestamp to return, say, a bignum, and
+ convert the device-specific timestamp to a bignum before storing it in
+ this list. The current practice is to blindly assume that the timestamp
+ is thirty-two bits, which will work for extant architectures. */
+
if (HAS_DEVMETH_P (XDEVICE (device), own_selection))
selection_time = DEVMETH (XDEVICE (device), own_selection,
(selection_name, selection_value,
@@ -492,18 +500,36 @@
: Qnil;
}
+Lisp_Object
+get_selection_raw_time(Lisp_Object selection)
+{
+ Lisp_Object local_value = assq_no_quit (selection, Vselection_alist);
+
+ if (!NILP (local_value))
+ {
+ return XCAR (XCDR (XCDR (local_value)));
+ }
+ return Qnil;
+}
+
/* Get the timestamp of the given selection */
-DEFUN ("get-selection-timestamp", Fget_selection_timestamp, 1, 1, 0, /*
-Return the timestamp associated with the specified SELECTION, if it exists.
-Note that the timestamp is a device-specific object, and may not actually be
-visible from Lisp.
+DEFUN ("get-xemacs-selection-timestamp", Fget_selection_timestamp, 1, 1, 0, /*
+Return timestamp for SELECTION, if belongs to XEmacs and exists.
+
+The timestamp is a cons of two integers, the first being the higher-order
+sixteen bits of the device-specific thirty-two-bit quantity, the second
+being the lower-order sixteen bits of same. Expect to see this API change
+when and if redisplay on a window system with timestamps wider than 32bits
+happens.
*/
(selection))
{
- Lisp_Object local_value = assq_no_quit (selection, Vselection_alist);
+ Lisp_Object val = get_selection_raw_time(selection);
- if (!NILP (local_value))
- return XCAR (XCDR (XCDR (local_value)));
+ if (!NILP (val))
+ {
+ return word_to_lisp(* (UINT_32_BIT *) XOPAQUE_DATA (val));
+ }
return Qnil;
}
Index: src/select.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/select.h,v
retrieving revision 1.2
diff -u -u -r1.2 select.h
--- src/select.h 2001/04/12 18:24:19 1.2
+++ src/select.h 2005/02/26 20:43:02
@@ -57,12 +57,13 @@
void select_notify_buffer_kill (Lisp_Object buffer);
+Lisp_Object get_selection_raw_time(Lisp_Object selection);
+
/* Lisp functions we export for other files' use */
EXFUN (Fregister_selection_data_type, 2);
EXFUN (Fselection_data_type_name, 2);
EXFUN (Favailable_selection_types, 2);
EXFUN (Fselection_owner_p, 1);
EXFUN (Fselection_exists_p, 3);
-EXFUN (Fget_selection_timestamp, 1);
#endif /* INCLUDED_select_h_ */
--
“I, for instance, am gung-ho about open source because my family is being
held hostage in Rob Malda’s basement. But who fact-checks me, or Enderle,
when we say something in public? No-one!” -- Danny O’Brien