NOTE: This patch has been committed. SUPERSEDES 16928.62724.829178.430388(a)parhasard.net Updated, based on feedback. lisp/ChangeLog addition: 2005-02-28 Aidan Kehoe <kehoea(a)parhasard.net&gt; * 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-28 Aidan Kehoe <kehoea(a)parhasard.net&gt; * 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 (existing ChangeLogs) 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 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/28 20:12:08 ＠＠ -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,56 ＠＠ (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))))) + ;; TARGETS is a vector; we want a list so we can memq --> append it to + ;; nil. + (let ((targets (append (get-selection-internal type 'TARGETS) nil)) + res) + (catch 'converted + (if targets + (dolist (current-preference data-type) + (condition-case err + (if (and (memq current-preference targets) + (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 +289,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 +427,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 +476,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 +543,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 +572,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 +741,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 +901,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 +928,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/28 20:12:09 ＠＠ -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/28 20:12:38 ＠＠ -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.18 diff -u -u -r1.18 select-x.c --- src/select-x.c 2005/02/28 17:02:10 1.18 +++ src/select-x.c 2005/02/28 20:12:38 ＠＠ -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 ＠＠ -617,7 +625,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)) { ＠＠ -665,7 +673,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); ＠＠ -705,7 +718,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/28 20:12:39 ＠＠ -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/28 20:12:39 ＠＠ -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