From b9aafad504b1d74b069788a088f7ee4b152f5628 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Jan=20Dj=C3=A4rv?= Date: Tue, 10 Feb 2004 17:27:26 +0000 Subject: [PATCH] x-dnd.el: Add COMPOUND_TEXT, handle FILE_NAME correctly, add Motif (CDE) protocol. --- lisp/ChangeLog | 17 +++ lisp/x-dnd.el | 320 +++++++++++++++++++++++++++++++++++++++++++++---- 2 files changed, 311 insertions(+), 26 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index cd9bee3d932..177bb887d35 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,20 @@ +2004-02-10 Jan Dj,Ad(Brv + + * x-dnd.el (x-dnd-types-alist): Add COMPOUND_TEXT, FILE_NAME + handeled by x-dnd-handle-file-name. + (x-dnd-known-types): Add COMPOUND_TEXT. + (x-dnd-init-frame): Call x-dnd-init-motif-for-frame. + (x-dnd-get-state-cons-for-frame): Must do copy-sequence on + x-dnd-empty-state. + (x-dnd-forget-drop): Ditto. + (x-dnd-save-state): Add optional parameter extra-data (for Motif). + (x-dnd-handle-one-url): Return private when inserting text. + (x-dnd-insert-ctext): New function. + (x-dnd-handle-file-name): New function for FILE_NAME. + (x-dnd-handle-drag-n-drop-event): Add Motif, remove call to error. + (x-dnd-init-motif-for-frame, x-dnd-get-motif-value) + (x-dnd-motif-value-to-list, x-dnd-handle-motif): New functions. + 2004-02-10 Kenichi Handa * term/x-win.el (x-select-utf8-or-ctext): Use compare-strings diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index ad55e3cbd34..14681ae7497 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -77,13 +77,14 @@ if some action was made, or nil if the URL is ignored." '( ("text/uri-list" . x-dnd-handle-uri-list) ("text/x-moz-url" . x-dnd-handle-moz-url) - ("FILE_NAME" . x-dnd-handle-uri-list) ("_NETSCAPE_URL" . x-dnd-handle-uri-list) + ("FILE_NAME" . x-dnd-handle-file-name) ("UTF8_STRING" . x-dnd-insert-utf8-text) ("text/plain;charset=UTF-8" . x-dnd-insert-utf8-text) ("text/plain;charset=utf-8" . x-dnd-insert-utf8-text) ("text/unicode" . x-dnd-insert-utf16-text) ("text/plain" . x-dnd-insert-text) + ("COMPOUND_TEXT" . x-dnd-insert-ctext) ("STRING" . x-dnd-insert-text) ("TEXT" . x-dnd-insert-text) ) @@ -108,13 +109,14 @@ is successful, nil if not." (defvar x-dnd-known-types '("text/uri-list" "text/x-moz-url" - "FILE_NAME" "_NETSCAPE_URL" + "FILE_NAME" "UTF8_STRING" "text/plain;charset=UTF-8" "text/plain;charset=utf-8" "text/unicode" "text/plain" + "COMPOUND_TEXT" "STRING" "TEXT" ) @@ -131,15 +133,17 @@ last window drag was in, types available for drop, the action suggested by the source, the type we want for the drop, -the action we want for the drop.") +the action we want for the drop, +any protocol specific data.") -(defvar x-dnd-empty-state [nil nil nil nil nil nil]) +(defvar x-dnd-empty-state [nil nil nil nil nil nil nil]) (defun x-dnd-init-frame (&optional frame) "Setup drag and drop for FRAME (i.e. create appropriate properties)." - (x-dnd-init-xdnd-for-frame frame)) + (x-dnd-init-xdnd-for-frame frame) + (x-dnd-init-motif-for-frame frame)) (defun x-dnd-get-state-cons-for-frame (frame-or-window) "Return the entry in x-dnd-current-state for a frame or window." @@ -147,7 +151,8 @@ the action we want for the drop.") (window-frame frame-or-window))) (display (frame-parameter frame 'display))) (if (not (assoc display x-dnd-current-state)) - (push (cons display x-dnd-empty-state) x-dnd-current-state)) + (push (cons display (copy-sequence x-dnd-empty-state)) + x-dnd-current-state)) (assoc display x-dnd-current-state))) (defun x-dnd-get-state-for-frame (frame-or-window) @@ -173,7 +178,8 @@ FRAME-OR-WINDOW is the frame or window that the mouse is over." (defun x-dnd-forget-drop (frame-or-window) "Remove all state for the last drop. FRAME-OR-WINDOW is the frame or window that the mouse is over." - (setcdr (x-dnd-get-state-cons-for-frame frame-or-window) x-dnd-empty-state)) + (setcdr (x-dnd-get-state-cons-for-frame frame-or-window) + (copy-sequence x-dnd-empty-state))) (defun x-dnd-maybe-call-test-function (window action) "Call `x-dnd-test-function' if something has changed. @@ -202,16 +208,18 @@ action and type we got from `x-dnd-test-function'." (cons (aref current-state 5) (aref current-state 4)))) -(defun x-dnd-save-state (window action action-type &optional types) +(defun x-dnd-save-state (window action action-type &optional types extra-data) "Save the state of the current drag and drop. WINDOW is the window the mouse is over. ACTION is the action suggested by the source. ACTION-TYPE is the result of calling `x-dnd-test-function'. -If given, TYPES are the types for the drop data that the source supports." +If given, TYPES are the types for the drop data that the source supports. +EXTRA-DATA is data needed for a specific protocol." (let ((current-state (x-dnd-get-state-for-frame window))) (aset current-state 5 (car action-type)) (aset current-state 4 (cdr action-type)) (aset current-state 3 action) - (if types (aset current-state 2 types)) + (when types (aset current-state 2 types)) + (when extra-data (aset current-state 6 extra-data)) (aset current-state 1 window) (aset current-state 0 (if (and (windowp window) (window-live-p window)) @@ -219,15 +227,6 @@ If given, TYPES are the types for the drop data that the source supports." (setcdr (x-dnd-get-state-cons-for-frame window) current-state))) -(defun x-dnd-test-and-save-state (window action types) - "Test if drop shall be accepted, and save the state for future reference. -ACTION is the suggested action by the source. -TYPES is a list of types the source supports." - (x-dnd-save-state window - action - (x-dnd-maybe-call-test-function window action) - types)) - (defun x-dnd-handle-one-url (window action arg) "Handle one dropped url by calling the appropriate handler. The handler is first localted by looking at `x-dnd-protocol-alist'. @@ -259,7 +258,9 @@ Returns ACTION." (funcall (cdr bf) uri action) (throw 'done t))) nil)) - (x-dnd-insert-text window action uri)) + (progn + (x-dnd-insert-text window action uri) + (setq ret 'private))) ret)) @@ -352,6 +353,13 @@ TEXT is the text as a string, WINDOW is the window where the drop happened." TEXT is the text as a string, WINDOW is the window where the drop happened." (x-dnd-insert-text window action (decode-coding-string text 'utf-16le))) +(defun x-dnd-insert-ctext (window action text) + "Decode the compound text and insert it at point. +TEXT is the text as a string, WINDOW is the window where the drop happened." + (x-dnd-insert-text window action + (decode-coding-string text + 'compound-text-with-extensions))) + (defun x-dnd-insert-text (window action text) "Insert text at point or push to the kill ring if buffer is read only. TEXT is the text as a string, WINDOW is the window where the drop happened." @@ -377,6 +385,19 @@ STRING is the uri-list as a string. The URIs are separated by \r\n." (when did-action (setq retval did-action)))) retval)) +(defun x-dnd-handle-file-name (window action string) + "Prepend file:// to file names and call `x-dnd-handle-one-url'. +WINDOW is the window where the drop happened. +STRING is the file names as a string, separated by nulls." + (let ((uri-list (split-string string "[\0\r\n]" t)) + retval) + (dolist (bf uri-list) + ;; If one URL is handeled, treat as if the whole drop succeeded. + (let* ((file-uri (concat "file://" bf)) + (did-action (x-dnd-handle-one-url window action file-uri))) + (when did-action (setq retval did-action)))) + retval)) + (defun x-dnd-choose-type (types &optional known-types) "Choose which type we want to receive for the drop. @@ -438,14 +459,16 @@ TODO: Add Motif and OpenWindows." (format (aref client-message 2)) (data (aref client-message 3))) - (cond ((equal "DndProtocol" message-atom) ;; Old KDE 1.x. + (cond ((equal "DndProtocol" message-atom) ; Old KDE 1.x. (x-dnd-handle-old-kde event frame window message-atom format data)) - ((and (> (length message-atom) 4) ;; XDND protocol. + ((equal "_MOTIF_DRAG_AND_DROP_MESSAGE" message-atom) ; Motif + (x-dnd-handle-motif event frame window message-atom format data)) + + ((and (> (length message-atom) 4) ; XDND protocol. (equal "Xdnd" (substring message-atom 0 4))) - (x-dnd-handle-xdnd event frame window message-atom format data)) + (x-dnd-handle-xdnd event frame window message-atom format data))))) - (t (error "Unknown DND atom: %s" message-atom))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Old KDE protocol. Only dropping of files. @@ -471,7 +494,7 @@ TODO: Add Motif and OpenWindows." "Mapping from XDND action types to lisp symbols.") (defun x-dnd-init-xdnd-for-frame (frame) - "Set the XdndAware for FRAME to indicate that we do XDND." + "Set the XdndAware property for FRAME to indicate that we do XDND." (x-change-window-property "XdndAware" '(5) ;; The version of XDND we support. frame "ATOM" 32 t)) @@ -566,7 +589,6 @@ FORMAT is 32 (not used). MESSAGE is the data part of an XClientMessageEvent." (if (windowp window) (select-window window)) (let* ((dnd-source (aref data 0)) (value (and (x-dnd-current-type window) - ;; Get selection with target DELETE if move. (x-get-selection-internal 'XdndSelection (intern (x-dnd-current-type window))))) @@ -597,6 +619,252 @@ FORMAT is 32 (not used). MESSAGE is the data part of an XClientMessageEvent." (t (error "Unknown XDND message %s %s" message data)))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Motif protocol. + +(defun x-dnd-init-motif-for-frame (frame) + "Set _MOTIF_DRAG_RECEIVER_INFO for FRAME to indicate that we do Motif DND." + (x-change-window-property "_MOTIF_DRAG_RECEIVER_INFO" + (list + (byteorder) + 0 ; The Motif DND version. + 5 ; We want drag dynamic. + 0 0 0 0 0 0 0 + 0 0 0 0 0 0) ; Property must be 16 bytes. + frame "_MOTIF_DRAG_RECEIVER_INFO" 8 t)) + +(defun x-dnd-get-motif-value (data offset size byteorder) + (cond ((eq size 2) + (if (eq byteorder ?l) + (+ (ash (aref data (1+ offset)) 8) + (aref data offset)) + (+ (ash (aref data offset) 8) + (aref data (1+ offset))))) + + ((eq size 4) + (if (eq byteorder ?l) + (cons (+ (ash (aref data (+ 3 offset)) 8) + (aref data (+ 2 offset))) + (+ (ash (aref data (1+ offset)) 8) + (aref data offset))) + (cons (+ (ash (aref data offset) 8) + (aref data (1+ offset))) + (+ (ash (aref data (+ 2 offset)) 8) + (aref data (+ 3 offset)))))))) + +(defun x-dnd-motif-value-to-list (value size byteorder) + (let ((bytes (cond ((eq size 2) + (list (logand (lsh value -8) ?\xff) + (logand value ?\xff))) + + ((eq size 4) + (if (consp value) + (list (logand (lsh (car value) -8) ?\xff) + (logand (car value) ?\xff) + (logand (lsh (cdr value) -8) ?\xff) + (logand (cdr value) ?\xff)) + (list (logand (lsh value -24) ?\xff) + (logand (lsh value -16) ?\xff) + (logand (lsh value -8) ?\xff) + (logand value ?\xff))))))) + (if (eq byteorder ?l) + (reverse bytes) + bytes))) + + +(defvar x-dnd-motif-message-types + '((0 . XmTOP_LEVEL_ENTER) + (1 . XmTOP_LEVEL_LEAVE) + (2 . XmDRAG_MOTION) + (3 . XmDROP_SITE_ENTER) + (4 . XmDROP_SITE_LEAVE) + (5 . XmDROP_START) + (6 . XmDROP_FINISH) + (7 . XmDRAG_DROP_FINISH) + (8 . XmOPERATION_CHANGED)) + "Mapping from numbers to Motif DND message types.") + +(defvar x-dnd-motif-to-action + '((1 . move) + (2 . copy) + (3 . link) ; Both 3 and 4 has been seen as link. + (4 . link) + (2 . private)) ; Motif does not have private, so use copy for private. + "Mapping from number to operation for Motif DND.") + +(defun x-dnd-handle-motif (event frame window message-atom format data) + (let* ((message-type (cdr (assoc (aref data 0) x-dnd-motif-message-types))) + (source-byteorder (aref data 1)) + (my-byteorder (byteorder)) + (source-flags (x-dnd-get-motif-value data 2 2 source-byteorder)) + (source-action (cdr (assoc (logand ?\xF source-flags) + x-dnd-motif-to-action)))) + + (cond ((eq message-type 'XmTOP_LEVEL_ENTER) + (let* ((dnd-source (x-dnd-get-motif-value + data 8 4 source-byteorder)) + (selection-atom (x-dnd-get-motif-value + data 12 4 source-byteorder)) + (atom-name (x-get-atom-name selection-atom)) + (types (when atom-name + (x-get-selection-internal (intern atom-name) + 'TARGETS)))) + (x-dnd-forget-drop frame) + (when types (x-dnd-save-state window nil nil + types + dnd-source)))) + + ;; Can not forget drop here, LEAVE comes before DROP_START and + ;; we need the state in DROP_START. + ((eq message-type 'XmTOP_LEVEL_LEAVE) + nil) + + ((eq message-type 'XmDRAG_MOTION) + (let* ((state (x-dnd-get-state-for-frame frame)) + (timestamp (x-dnd-motif-value-to-list + (x-dnd-get-motif-value data 4 4 + source-byteorder) + 4 my-byteorder)) + (x (x-dnd-motif-value-to-list + (x-dnd-get-motif-value data 8 2 source-byteorder) + 2 my-byteorder)) + (y (x-dnd-motif-value-to-list + (x-dnd-get-motif-value data 10 2 source-byteorder) + 2 my-byteorder)) + (dnd-source (aref state 6)) + (first-move (not (aref state 3))) + (action-type (x-dnd-maybe-call-test-function + window + source-action)) + (reply-action (car (rassoc (car action-type) + x-dnd-motif-to-action))) + (reply-flags + (x-dnd-motif-value-to-list + (if reply-action + (+ reply-action + ?\x30 ; 30: valid drop site + ?\x700) ; 700: can do copy, move or link + ?\x30) ; 30: drop site, but noop. + 2 my-byteorder)) + (reply (append + (list + (+ ?\x80 ; 0x80 indicates a reply. + (if first-move + 3 ; First time, reply is SITE_ENTER. + 2)) ; Not first time, reply is DRAG_MOTION. + my-byteorder) + reply-flags + timestamp + x + y))) + (x-send-client-message frame + dnd-source + frame + "_MOTIF_DRAG_AND_DROP_MESSAGE" + 8 + reply))) + + ((eq message-type 'XmOPERATION_CHANGED) + (let* ((state (x-dnd-get-state-for-frame frame)) + (timestamp (x-dnd-motif-value-to-list + (x-dnd-get-motif-value data 4 4 source-byteorder) + 4 my-byteorder)) + (dnd-source (aref state 6)) + (action-type (x-dnd-maybe-call-test-function + window + source-action)) + (reply-action (car (rassoc (car action-type) + x-dnd-motif-to-action))) + (reply-flags + (x-dnd-motif-value-to-list + (if reply-action + (+ reply-action + ?\x30 ; 30: valid drop site + ?\x700) ; 700: can do copy, move or link + ?\x30) ; 30: drop site, but noop + 2 my-byteorder)) + (reply (append + (list + (+ ?\x80 ; 0x80 indicates a reply. + 8) ; 8 is OPERATION_CHANGED + my-byteorder) + reply-flags + timestamp))) + (x-send-client-message frame + dnd-source + frame + "_MOTIF_DRAG_AND_DROP_MESSAGE" + 8 + reply))) + + ((eq message-type 'XmDROP_START) + (let* ((x (x-dnd-motif-value-to-list + (x-dnd-get-motif-value data 8 2 source-byteorder) + 2 my-byteorder)) + (y (x-dnd-motif-value-to-list + (x-dnd-get-motif-value data 10 2 source-byteorder) + 2 my-byteorder)) + (selection-atom (x-dnd-get-motif-value + data 12 4 source-byteorder)) + (atom-name (x-get-atom-name selection-atom)) + (dnd-source (x-dnd-get-motif-value + data 16 4 source-byteorder)) + (action-type (x-dnd-maybe-call-test-function + window + source-action)) + (reply-action (car (rassoc (car action-type) + x-dnd-motif-to-action))) + (reply-flags + (x-dnd-motif-value-to-list + (if reply-action + (+ reply-action + ?\x30 ; 30: valid drop site + ?\x700) ; 700: can do copy, move or link + (+ ?\x30 ; 30: drop site, but noop. + ?\x200)) ; 200: drop cancel. + 2 my-byteorder)) + (reply (append + (list + (+ ?\x80 ; 0x80 indicates a reply. + 5) ; DROP_START. + my-byteorder) + reply-flags + x + y)) + (timestamp (x-dnd-get-motif-value + data 4 4 source-byteorder)) + action) + + (x-send-client-message frame + dnd-source + frame + "_MOTIF_DRAG_AND_DROP_MESSAGE" + 8 + reply) + (setq action + (when (and reply-action atom-name) + (let* ((value (x-get-selection-internal + (intern atom-name) + (intern (x-dnd-current-type window))))) + (when value + (condition-case info + (x-dnd-drop-data event frame window value + (x-dnd-current-type window)) + (error + (message "Error: %s" info) + nil)))))) + (x-get-selection-internal + (intern atom-name) + (if action 'XmTRANSFER_SUCCESS 'XmTRANSFER_FAILURE) + timestamp) + (x-dnd-forget-drop frame))) + + (t (error "Unknown Motif DND message %s %s" message data))))) + + +;;; + + (provide 'x-dnd) ;;; arch-tag: b621fb7e-50da-4323-850b-5fc71ae64621 -- 2.39.2