From 0b4db66a9deae682dc7d444f4ab8d0e49f15c3b9 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 23 Jun 2022 13:38:30 +0800 Subject: [PATCH] Allow dropping more data types on PGTK * lisp/loadup.el (featurep): Load `pgtk-dnd'. * lisp/pgtk-dnd.el: New file. (pgtk-dnd-test-function, pgtk-dnd-types-alist) (pgtk-dnd-known-types, pgtk-dnd-use-offix-drop) (pgtk-dnd-current-state, pgtk-get-selection-internal) (pgtk-register-dnd-targets, pgtk-dnd-empty-state) (pgtk-dnd-init-frame, pgtk-dnd-get-state-cons-for-frame) (pgtk-dnd-get-state-for-frame, pgtk-dnd-default-test-function) (pgtk-dnd-current-type, pgtk-dnd-forget-drop) (pgtk-dnd-maybe-call-test-function, pgtk-dnd-save-state) (pgtk-dnd-handle-moz-url, pgtk-dnd-insert-utf8-text) (pgtk-dnd-insert-utf16-text, pgtk-dnd-insert-ctext) (pgtk-dnd-handle-uri-list, pgtk-dnd-handle-file-name) (pgtk-dnd-choose-type, pgtk-dnd-drop-data) (pgtk-dnd-handle-drag-n-drop-event, pgtk-update-drop-status) (pgtk-drop-finish, pgtk-dnd-handle-gdk, pgtk-dnd): New variables and functions and library. * lisp/term/pgtk-win.el (special-event-map): Load `drag-n-drop-event'. (after-make-frame-functions): Register DND after make frame functions. * src/emacs.c (main): Stop calling empty init_pgtkterm function. * src/pgtkselect.c (Fpgtk_register_dnd_targets, Fpgtk_drop_finish) (Fpgtk_update_drop_status): New functions. (syms_of_pgtkselect): Register new functions. * src/pgtkterm.c (struct event_queue_t): Fix coding style of definition. (symbol_to_drag_action, drag_action_to_symbol) (pgtk_update_drop_status, pgtk_finish_drop): New functions. (drag_data_received): Delete function. (pgtk_set_event_handler): Register for DND correctly. (syms_of_pgtkterm): New defsyms for DND types. (init_pgtkterm): Delete function. * src/pgtkterm.h: Update prototypes, fix prototype coding style. --- lisp/loadup.el | 4 +- lisp/pgtk-dnd.el | 400 ++++++++++++++++++++++++++++++++++++++++++ lisp/term/pgtk-win.el | 5 + src/emacs.c | 3 - src/pgtkselect.c | 99 +++++++++-- src/pgtkterm.c | 276 ++++++++++++++++++++++++----- src/pgtkterm.h | 120 ++++++------- 7 files changed, 784 insertions(+), 123 deletions(-) create mode 100644 lisp/pgtk-dnd.el diff --git a/lisp/loadup.el b/lisp/loadup.el index aa15a3bbe8f..f076b8b2897 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -346,10 +346,8 @@ (load "term/ns-win")))) (if (featurep 'pgtk) (progn + (load "pgtk-dnd") (load "term/common-win") - ;; Don't load ucs-normalize.el unless uni-*.el files were - ;; already produced, because it needs uni-*.el files that might - ;; not be built early enough during bootstrap. (load "term/pgtk-win"))) (if (fboundp 'x-create-frame) ;; Do it after loading term/foo-win.el since the value of the diff --git a/lisp/pgtk-dnd.el b/lisp/pgtk-dnd.el new file mode 100644 index 00000000000..2aaf4c4e977 --- /dev/null +++ b/lisp/pgtk-dnd.el @@ -0,0 +1,400 @@ +;;; pgtk-dnd.el --- drag and drop support for GDK -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Maintainer: emacs-devel@gnu.org +;; Keywords: window, drag, drop +;; Package: emacs + +;; Significant portions taken from x-dnd.el. + +;; This file is part of GNU Emacs. + +;; 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 +;; 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 +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This file provides the receiving side of the GDK drag and drop +;; mechanism. + +;;; Code: + +(require 'dnd) + +;;; Customizable variables +(defcustom pgtk-dnd-test-function #'pgtk-dnd-default-test-function + "The function drag and drop uses to determine if to accept or reject a drop. +The function takes three arguments, WINDOW, ACTION and TYPES. +WINDOW is where the mouse is when the function is called. WINDOW +may be a frame if the mouse isn't over a real window (i.e. menu +bar, tool bar or scroll bar). ACTION is the suggested action +from the drag and drop source, one of the symbols move, copy, +link or ask. TYPES is a vector of available types for the drop. + +Each element of TYPE should either be a string (containing the +name of the type's X atom), or a symbol, whose name will be used. + +The function shall return nil to reject the drop or a cons with +two values, the wanted action as car and the wanted type as cdr. +The wanted action can be copy, move, link, ask or private. + +The default value for this variable is `pgtk-dnd-default-test-function'." + :version "22.1" + :type 'symbol + :group 'pgtk) + +(defcustom pgtk-dnd-types-alist + `((,(purecopy "text/uri-list") . pgtk-dnd-handle-uri-list) + (,(purecopy "FILE_NAME") . pgtk-dnd-handle-file-name) + (,(purecopy "UTF8_STRING") . pgtk-dnd-insert-utf8-text) + (,(purecopy "text/plain;charset=UTF-8") . pgtk-dnd-insert-utf8-text) + (,(purecopy "text/plain;charset=utf-8") . pgtk-dnd-insert-utf8-text) + (,(purecopy "text/plain") . dnd-insert-text) + (,(purecopy "COMPOUND_TEXT") . pgtk-dnd-insert-ctext) + (,(purecopy "STRING") . dnd-insert-text) + (,(purecopy "TEXT") . dnd-insert-text)) + "Which function to call to handle a drop of that type. +If the type for the drop is not present, or the function is nil, +the drop is rejected. The function takes three arguments, WINDOW, ACTION +and DATA. WINDOW is where the drop occurred, ACTION is the action for +this drop (copy, move, link, private or ask) as determined by a previous +call to `pgtk-dnd-test-function'. DATA is the drop data. +The function shall return the action used (copy, move, link or private) +if drop is successful, nil if not." + :version "22.1" + :type 'alist + :group 'pgtk) + +(defcustom pgtk-dnd-known-types + (mapcar 'purecopy '("text/uri-list" + "FILE_NAME" + "UTF8_STRING" + "text/plain;charset=UTF-8" + "text/plain;charset=utf-8" + "text/plain" + "COMPOUND_TEXT" + "STRING" + "TEXT")) + "The types accepted by default for dropped data. +The types are chosen in the order they appear in the list." + :version "22.1" + :type '(repeat string) + :group 'pgtk) + +(defcustom pgtk-dnd-use-offix-drop 'files + "If non-nil, use the OffiX protocol to drop files and text. +This allows dropping (via `dired-mouse-drag-files' or +`mouse-drag-and-drop-region-cross-program') on some old Java +applets and old KDE programs. Turning this off allows dropping +only text on some other programs such as xterm and urxvt. + +If the symbol `files', use the OffiX protocol when dropping +files, and the fallback drop method (which is used with programs +like xterm) for text." + :version "29.1" + :type '(choice (const :tag "Don't use the OffiX protocol for drag-and-drop" nil) + (const :tag "Only use the OffiX protocol to drop files" files) + (const :tag "Use the OffiX protocol for both files and text" t)) + :group 'pgtk) + +;; Internal variables + +(defvar pgtk-dnd-current-state nil + "The current state for a drop. +This is an alist with one entry for each display. The value for each display +is a vector that contains the state for drag and drop for that display. +Elements in the vector are: +Last buffer drag was in, +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, +any protocol specific data.") + +(declare-function pgtk-get-selection-internal "pgtkselect.c") +(declare-function pgtk-register-dnd-targets "pgtkselect.c") + +(defvar pgtk-dnd-empty-state [nil nil nil nil nil nil nil]) + +(defun pgtk-dnd-init-frame (&optional frame) + "Setup drag and drop for FRAME (i.e. create appropriate properties)." + (when (eq 'pgtk (window-system frame)) + (pgtk-register-dnd-targets frame pgtk-dnd-known-types))) + +(defun pgtk-dnd-get-state-cons-for-frame (frame-or-window) + "Return the entry in `pgtk-dnd-current-state' for a frame or window." + (let* ((frame (if (framep frame-or-window) frame-or-window + (window-frame frame-or-window))) + (display (frame-parameter frame 'display))) + (if (not (assoc display pgtk-dnd-current-state)) + (push (cons display (copy-sequence pgtk-dnd-empty-state)) + pgtk-dnd-current-state)) + (assoc display pgtk-dnd-current-state))) + +(defun pgtk-dnd-get-state-for-frame (frame-or-window) + "Return the state in `pgtk-dnd-current-state' for a frame or window." + (cdr (pgtk-dnd-get-state-cons-for-frame frame-or-window))) + +(defun pgtk-dnd-default-test-function (_window _action types) + "The default test function for drag and drop. +WINDOW is where the mouse is when this function is called. It may be +a frame if the mouse is over the menu bar, scroll bar or tool bar. +ACTION is the suggested action from the source, and TYPES are the +types the drop data can have. This function only accepts drops with +types in `pgtk-dnd-known-types'. It always returns the action `copy'." + (let ((type (pgtk-dnd-choose-type types))) + (when type (cons 'copy type)))) + +(defun pgtk-dnd-current-type (frame-or-window) + "Return the type we want the DND data to be in for the current drop. +FRAME-OR-WINDOW is the frame or window that the mouse is over." + (aref (pgtk-dnd-get-state-for-frame frame-or-window) 4)) + +(defun pgtk-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 (pgtk-dnd-get-state-cons-for-frame frame-or-window) + (copy-sequence pgtk-dnd-empty-state))) + +(defun pgtk-dnd-maybe-call-test-function (window action) + "Call `pgtk-dnd-test-function' if something has changed. +WINDOW is the window the mouse is over. ACTION is the suggested +action from the source. If nothing has changed, return the last +action and type we got from `pgtk-dnd-test-function'." + (let ((buffer (when (window-live-p window) + (window-buffer window))) + (current-state (pgtk-dnd-get-state-for-frame window))) + (unless (and (equal buffer (aref current-state 0)) + (equal window (aref current-state 1)) + (equal action (aref current-state 3))) + (save-current-buffer + (when buffer (set-buffer buffer)) + (let* ((action-type (funcall pgtk-dnd-test-function + window + action + (aref current-state 2))) + (handler (cdr (assoc (cdr action-type) pgtk-dnd-types-alist)))) + ;; Ignore action-type if we have no handler. + (setq current-state + (pgtk-dnd-save-state window + action + (when handler action-type))))))) + (let ((current-state (pgtk-dnd-get-state-for-frame window))) + (cons (aref current-state 5) + (aref current-state 4)))) + +(defun pgtk-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 `pgtk-dnd-test-function'. +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 (pgtk-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) + (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 (and (window-live-p window) (window-buffer window))) + (setcdr (pgtk-dnd-get-state-cons-for-frame window) current-state))) + + +(defun pgtk-dnd-handle-moz-url (window action data) + "Handle one item of type text/x-moz-url. +WINDOW is the window where the drop happened. ACTION is ignored. +DATA is the moz-url, which is formatted as two strings separated by \\r\\n. +The first string is the URL, the second string is the title of that URL. +DATA is encoded in utf-16. Decode the URL and call `pgtk-dnd-handle-uri-list'." + ;; Mozilla and applications based on it use text/unicode, but it is + ;; impossible to tell if it is le or be. Use what the machine Emacs + ;; runs on uses. This loses if dropping between machines + ;; with different endian-ness, but it is the best we can do. + (let* ((coding (if (eq (byteorder) ?B) 'utf-16be 'utf-16le)) + (string (decode-coding-string data coding)) + (strings (split-string string "[\r\n]" t)) + ;; Can one drop more than one moz-url ?? Assume not. + (url (car strings))) + (pgtk-dnd-handle-uri-list window action url))) + +(defun pgtk-dnd-insert-utf8-text (window action text) + "Decode the UTF-8 text and insert it at point. +TEXT is the text as a string, WINDOW is the window where the drop happened." + (dnd-insert-text window action (decode-coding-string text 'utf-8))) + +(defun pgtk-dnd-insert-utf16-text (window action text) + "Decode the UTF-16 text and insert it at point. +TEXT is the text as a string, WINDOW is the window where the drop happened." + ;; See comment in pgtk-dnd-handle-moz-url about coding. + (let ((coding (if (eq (byteorder) ?B) 'utf-16be 'utf-16le))) + (dnd-insert-text window action (decode-coding-string text coding)))) + +(defun pgtk-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." + (dnd-insert-text window action + (decode-coding-string text + 'compound-text-with-extensions))) + +(defun pgtk-dnd-handle-uri-list (window action string) + "Split an uri-list into separate URIs and call `dnd-handle-one-url'. +WINDOW is the window where the drop happened. +STRING is the uri-list as a string. The URIs are separated by \\r\\n." + (let ((uri-list (split-string string "[\0\r\n]" t)) + retval) + (dolist (bf uri-list) + ;; If one URL is handled, treat as if the whole drop succeeded. + (let ((did-action (dnd-handle-one-url window action bf))) + (when did-action (setq retval did-action)))) + retval)) + +(defun pgtk-dnd-handle-file-name (window action string) + "Convert file names to URLs and call `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)) + (coding (or file-name-coding-system + default-file-name-coding-system)) + retval) + (dolist (bf uri-list) + ;; If one URL is handled, treat as if the whole drop succeeded. + (if coding (setq bf (encode-coding-string bf coding))) + (let* ((file-uri (concat "file://" + (mapconcat 'url-hexify-string + (split-string bf "/") "/"))) + (did-action (dnd-handle-one-url window action file-uri))) + (when did-action (setq retval did-action)))) + retval)) + + +(defun pgtk-dnd-choose-type (types &optional known-types) + "Choose which type we want to receive for the drop. +TYPES are the types the source of the drop offers, a vector of type names +as strings or symbols. Select among the types in `pgtk-dnd-known-types' or +KNOWN-TYPES if given, and return that type name. +If no suitable type is found, return nil." + (let* ((known-list (or known-types pgtk-dnd-known-types)) + (first-known-type (car known-list)) + (types-array types) + (found (when first-known-type + (catch 'done + (dotimes (i (length types-array)) + (let* ((type (aref types-array i)) + (typename (if (symbolp type) + (symbol-name type) type))) + (when (equal first-known-type typename) + (throw 'done first-known-type)))) + nil)))) + + (if (and (not found) (cdr known-list)) + (pgtk-dnd-choose-type types (cdr known-list)) + found))) + +(defun pgtk-dnd-drop-data (event frame window data type) + "Drop one data item onto a frame. +EVENT is the client message for the drop, FRAME is the frame the drop +occurred on. WINDOW is the window of FRAME where the drop happened. +DATA is the data received from the source, and type is the type for DATA, +see `pgtk-dnd-types-alist'). + +Returns the action used (move, copy, link, private) if drop was successful, +nil if not." + (let* ((type-info (assoc type pgtk-dnd-types-alist)) + (handler (cdr type-info)) + (state (pgtk-dnd-get-state-for-frame frame)) + (action (aref state 5)) + (w (posn-window (event-start event)))) + (when handler + (if (and (window-live-p w) + (not (window-minibuffer-p w)) + (not (window-dedicated-p w))) + ;; If dropping in an ordinary window which we could use, + ;; let dnd-open-file-other-window specify what to do. + (progn + (when (and (not mouse-yank-at-point) + ;; If dropping on top of the mode line, insert + ;; the text at point instead. + (posn-point (event-start event))) + (goto-char (posn-point (event-start event)))) + (funcall handler window action data)) + ;; If we can't display the file here, + ;; make a new window for it. + (let ((dnd-open-file-other-window t)) + (select-frame frame) + (funcall handler window action data)))))) + +(defun pgtk-dnd-handle-drag-n-drop-event (event) + "Receive drag and drop events (X client messages). +Currently XDND, Motif and old KDE 1.x protocols are recognized." + (interactive "e") + (let* ((client-message (car (cdr (cdr event)))) + (window (posn-window (event-start event))) + (frame (if (framep window) + window + (window-frame window)))) + (pgtk-dnd-handle-gdk event frame window client-message))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; GDK protocol. + +(declare-function pgtk-update-drop-status "pgtkselect.c") +(declare-function pgtk-drop-finish "pgtkselect.c") + +(defun pgtk-dnd-handle-gdk (event frame window client-message) + "Handle drag-n-drop EVENT on FRAME. +WINDOW should be the window the event happened on top of. +CLIENT-MESSAGE is the detailed description of the drag-and-drop +message." + (cond + ;; We can't handle `drag-leave' here, since that signal is also + ;; sent right before `drag-drop', and there is no reliable way to + ;; distinguish the two. + ((eq (car client-message) 'lambda) ; drag-motion + (let ((state (pgtk-dnd-get-state-for-frame frame))) + (unless (aref state 0) ;; This is actually an entry. + (pgtk-dnd-save-state window nil nil + (pgtk-get-selection-internal + (nth 1 client-message) 'TARGETS) + t) + (setq state (pgtk-dnd-get-state-for-frame frame))) + (let* ((action (nth 3 client-message)) + (time (nth 2 client-message)) + (action-type (pgtk-dnd-maybe-call-test-function window + action))) + (pgtk-update-drop-status (car action-type) time) + (dnd-handle-movement (event-start event))))) + ((eq (car client-message) 'quote) ; drag-drop + (let* ((timestamp (nth 2 client-message)) + (value (and (pgtk-dnd-current-type window) + (pgtk-get-selection-internal + (nth 1 client-message) + (intern (pgtk-dnd-current-type window)) + timestamp))) + action) + (unwind-protect + (setq action (when value + (condition-case info + (pgtk-dnd-drop-data + event frame window value + (pgtk-dnd-current-type window)) + (error + (message "Error: %s" info) + nil)))) + (pgtk-drop-finish action timestamp (eq action 'move)) + (pgtk-dnd-forget-drop window)))))) + +(provide 'pgtk-dnd) + +;;; pgtk-dnd.el ends here diff --git a/lisp/term/pgtk-win.el b/lisp/term/pgtk-win.el index 8abea3edba6..ee1aad3d0ec 100644 --- a/lisp/term/pgtk-win.el +++ b/lisp/term/pgtk-win.el @@ -38,6 +38,7 @@ (require 'menu-bar) (require 'fontset) (require 'dnd) +(require 'pgtk-dnd) (defvar x-invocation-args) (defvar x-command-line-resources) @@ -389,6 +390,10 @@ Users should not call this function; see `device-class' instead." (defvaralias 'x-gtk-use-system-tooltips 'use-system-tooltips) + +(define-key special-event-map [drag-n-drop] #'pgtk-dnd-handle-drag-n-drop-event) +(add-hook 'after-make-frame-functions #'pgtk-dnd-init-frame) + (provide 'pgtk-win) (provide 'term/pgtk-win) diff --git a/src/emacs.c b/src/emacs.c index 37c6c76e7a3..3c768412818 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1930,9 +1930,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem init_bignum (); init_threads (); init_eval (); -#ifdef HAVE_PGTK - init_pgtkterm (); /* Must come before `init_atimer'. */ -#endif running_asynch_code = 0; init_random (); init_xfaces (); diff --git a/src/pgtkselect.c b/src/pgtkselect.c index 122b5d8c073..2a4f6adba4b 100644 --- a/src/pgtkselect.c +++ b/src/pgtkselect.c @@ -1762,6 +1762,86 @@ pgtk_handle_selection_notify (GdkEventSelection *event) (event->property != GDK_NONE ? Qt : Qlambda)); } + +/*********************************************************************** + Drag and drop support +***********************************************************************/ + +DEFUN ("pgtk-register-dnd-targets", Fpgtk_register_dnd_targets, + Spgtk_register_dnd_targets, 2, 2, 0, + doc: /* Register TARGETS on FRAME. +TARGETS should be a list of strings describing data types (selection +targets) that can be dropped on top of FRAME. */) + (Lisp_Object frame, Lisp_Object targets) +{ + struct frame *f; + GtkTargetEntry *entries; + GtkTargetList *list; + ptrdiff_t length, n; + Lisp_Object tem, t; + char *buf; + USE_SAFE_ALLOCA; + + f = decode_window_system_frame (frame); + CHECK_LIST (targets); + length = list_length (targets); + n = 0; + entries = SAFE_ALLOCA (sizeof *entries * length); + memset (entries, 0, sizeof *entries * length); + tem = targets; + + FOR_EACH_TAIL (tem) + { + if (!CONSP (tem)) + continue; + + t = XCAR (tem); + + CHECK_STRING (t); + SAFE_ALLOCA_STRING (buf, t); + + entries[n++].target = buf; + } + CHECK_LIST_END (tem, targets); + + if (n != length) + emacs_abort (); + + list = gtk_target_list_new (entries, n); + gtk_drag_dest_set_target_list (FRAME_GTK_WIDGET (f), list); + gtk_target_list_unref (list); + + SAFE_FREE (); + + return Qnil; +} + +DEFUN ("pgtk-drop-finish", Fpgtk_drop_finish, Spgtk_drop_finish, 3, 3, 0, + doc: /* Finish the drag-n-drop event that happened at TIMESTAMP. +SUCCESS is whether or not the drop was successful, i.e. the action +chosen in the last call to `pgtk-update-drop-status' was performed. +TIMESTAMP is the time associated with the drag-n-drop event that is +being finished. +DELETE is whether or not the action was `move'. */) + (Lisp_Object success, Lisp_Object timestamp, Lisp_Object delete) +{ + pgtk_finish_drop (success, timestamp, delete); + + return Qnil; +} + +DEFUN ("pgtk-update-drop-status", Fpgtk_update_drop_status, + Spgtk_update_drop_status, 2, 2, 0, + doc: /* Update the status of the current drag-and-drop operation. +ACTION is the action the drop source should take. +TIMESTAMP is the same as in `pgtk-drop-finish'. */) + (Lisp_Object action, Lisp_Object timestamp) +{ + pgtk_update_drop_status (action, timestamp); + + return Qnil; +} + void syms_of_pgtkselect (void) { @@ -1777,23 +1857,22 @@ syms_of_pgtkselect (void) DEFSYM (QNULL, "NULL"); DEFSYM (QATOM, "ATOM"); DEFSYM (QTARGETS, "TARGETS"); - - DEFSYM (Qpgtk_sent_selection_functions, - "pgtk-sent-selection-functions"); - DEFSYM (Qpgtk_lost_selection_functions, - "pgtk-lost-selection-functions"); - - DEFSYM (Qforeign_selection, "foreign-selection"); DEFSYM (QUTF8_STRING, "UTF8_STRING"); - DEFSYM (QSTRING, "STRING"); DEFSYM (QCOMPOUND_TEXT, "COMPOUND_TEXT"); - DEFSYM (Qtext_plain_charset_utf_8, "text/plain;charset=utf-8"); + + DEFSYM (Qforeign_selection, "foreign-selection"); + + DEFSYM (Qpgtk_sent_selection_functions, "pgtk-sent-selection-functions"); + DEFSYM (Qpgtk_lost_selection_functions, "pgtk-lost-selection-functions"); defsubr (&Spgtk_disown_selection_internal); defsubr (&Spgtk_get_selection_internal); defsubr (&Spgtk_own_selection_internal); defsubr (&Spgtk_selection_exists_p); defsubr (&Spgtk_selection_owner_p); + defsubr (&Spgtk_register_dnd_targets); + defsubr (&Spgtk_update_drop_status); + defsubr (&Spgtk_drop_finish); DEFVAR_LISP ("selection-converter-alist", Vselection_converter_alist, doc: /* SKIP: real doc in xselect.c. */); @@ -1817,7 +1896,7 @@ The functions are called with three arguments: We might have failed (and declined the request) for any number of reasons, including being asked for a selection that we no longer own, or being asked to convert into a type that we don't know about or that is inappropriate. -This hook doesn't let you change the behavior of Emacs's selection replies, +xThis hook doesn't let you change the behavior of Emacs's selection replies, it merely informs you that they have happened. */); Vpgtk_sent_selection_functions = Qnil; diff --git a/src/pgtkterm.c b/src/pgtkterm.c index 91874ff58a5..a123311366a 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -76,25 +76,36 @@ along with GNU Emacs. If not, see . */ static bool any_help_event_p; -struct pgtk_display_info *x_display_list; /* Chain of existing displays */ -extern Lisp_Object tip_frame; +/* Chain of existing displays */ +struct pgtk_display_info *x_display_list; -static struct event_queue_t +struct event_queue_t { union buffered_input_event *q; int nr, cap; -} event_q = { - NULL, 0, 0, }; +/* A queue of events that will be read by the read_socket_hook. */ +static struct event_queue_t event_q; + /* Non-zero timeout value means ignore next mouse click if it arrives before that timeout elapses (i.e. as part of the same sequence of events resulting from clicking on a frame to select it). */ - static Time ignore_next_mouse_click_timeout; +/* The default Emacs icon . */ static Lisp_Object xg_default_icon_file; +/* The current GdkDragContext of a drop. */ +static GdkDragContext *current_drop_context; + +/* Whether or not current_drop_context was set from a drop + handler. */ +static bool current_drop_context_drop; + +/* The time of the last drop. */ +static guint32 current_drop_time; + static void pgtk_delete_display (struct pgtk_display_info *); static void pgtk_clear_frame_area (struct frame *, int, int, int, int); static void pgtk_fill_rectangle (struct frame *, unsigned long, int, int, @@ -6146,40 +6157,217 @@ scroll_event (GtkWidget *widget, GdkEvent *event, gpointer *user_data) return TRUE; } + + +/* C part of drop handling code. + The Lisp part is in pgtk-dnd.el. */ + +static GdkDragAction +symbol_to_drag_action (Lisp_Object act) +{ + if (EQ (act, Qcopy)) + return GDK_ACTION_COPY; + + if (EQ (act, Qmove)) + return GDK_ACTION_MOVE; + + if (EQ (act, Qlink)) + return GDK_ACTION_LINK; + + if (EQ (act, Qprivate)) + return GDK_ACTION_PRIVATE; + + if (NILP (act)) + return GDK_ACTION_DEFAULT; + + signal_error ("Invalid drag acction", act); +} + +static Lisp_Object +drag_action_to_symbol (GdkDragAction action) +{ + switch (action) + { + case GDK_ACTION_COPY: + return Qcopy; + + case GDK_ACTION_MOVE: + return Qmove; + + case GDK_ACTION_LINK: + return Qlink; + + case GDK_ACTION_PRIVATE: + return Qprivate; + + case GDK_ACTION_DEFAULT: + default: + return Qnil; + } +} + +void +pgtk_update_drop_status (Lisp_Object action, Lisp_Object event_time) +{ + guint32 time; + + CONS_TO_INTEGER (event_time, guint32, time); + + if (!current_drop_context || time < current_drop_time) + return; + + gdk_drag_status (current_drop_context, + symbol_to_drag_action (action), + time); +} + +void +pgtk_finish_drop (Lisp_Object success, Lisp_Object event_time, + Lisp_Object del) +{ + guint32 time; + + CONS_TO_INTEGER (event_time, guint32, time); + + if (!current_drop_context || time < current_drop_time) + return; + + gtk_drag_finish (current_drop_context, !NILP (success), + !NILP (del), time); + + if (current_drop_context_drop) + g_clear_pointer (¤t_drop_context, + g_object_unref); +} + static void -drag_data_received (GtkWidget *widget, GdkDragContext *context, - gint x, gint y, GtkSelectionData *data, - guint info, guint time, gpointer user_data) +drag_leave (GtkWidget *widget, GdkDragContext *context, + guint time, gpointer user_data) { - struct frame *f = pgtk_any_window_to_frame (gtk_widget_get_window (widget)); - gchar **uris = gtk_selection_data_get_uris (data); + struct frame *f; + union buffered_input_event inev; + + f = pgtk_any_window_to_frame (gtk_widget_get_window (widget)); - if (uris != NULL) + if (current_drop_context) { - for (int i = 0; uris[i] != NULL; i++) - { - union buffered_input_event inev; - Lisp_Object arg = Qnil; + if (current_drop_context_drop) + gtk_drag_finish (current_drop_context, + FALSE, FALSE, current_drop_time); - EVENT_INIT (inev.ie); - inev.ie.kind = NO_EVENT; - inev.ie.arg = Qnil; + g_clear_pointer (¤t_drop_context, + g_object_unref); + } - arg = list2 (Qurl, build_string (uris[i])); + inev.ie.kind = DRAG_N_DROP_EVENT; + inev.ie.modifiers = 0; + inev.ie.arg = Qnil; + inev.ie.timestamp = time; - inev.ie.kind = DRAG_N_DROP_EVENT; - inev.ie.modifiers = 0; - XSETINT (inev.ie.x, x); - XSETINT (inev.ie.y, y); - XSETFRAME (inev.ie.frame_or_window, f); - inev.ie.arg = arg; - inev.ie.timestamp = 0; + XSETINT (inev.ie.x, 0); + XSETINT (inev.ie.y, 0); + XSETFRAME (inev.ie.frame_or_window, f); - evq_enqueue (&inev); - } + evq_enqueue (&inev); +} + +static gboolean +drag_motion (GtkWidget *widget, GdkDragContext *context, + gint x, gint y, guint time) + +{ + struct frame *f; + union buffered_input_event inev; + GdkAtom name; + GdkDragAction suggestion; + + f = pgtk_any_window_to_frame (gtk_widget_get_window (widget)); + + if (!f) + return FALSE; + + if (current_drop_context) + { + if (current_drop_context_drop) + gtk_drag_finish (current_drop_context, + FALSE, FALSE, current_drop_time); + + g_clear_pointer (¤t_drop_context, + g_object_unref); } - gtk_drag_finish (context, TRUE, FALSE, time); + current_drop_context = g_object_ref (context); + current_drop_time = time; + current_drop_context_drop = false; + + name = gdk_drag_get_selection (context); + suggestion = gdk_drag_context_get_suggested_action (context); + + EVENT_INIT (inev.ie); + + inev.ie.kind = DRAG_N_DROP_EVENT; + inev.ie.modifiers = 0; + inev.ie.arg = list4 (Qlambda, intern (gdk_atom_name (name)), + make_uint (time), + drag_action_to_symbol (suggestion)); + inev.ie.timestamp = time; + + XSETINT (inev.ie.x, x); + XSETINT (inev.ie.y, y); + XSETFRAME (inev.ie.frame_or_window, f); + + evq_enqueue (&inev); + + return TRUE; +} + +static gboolean +drag_drop (GtkWidget *widget, GdkDragContext *context, + int x, int y, guint time, gpointer user_data) +{ + struct frame *f; + union buffered_input_event inev; + GdkAtom name; + GdkDragAction selected_action; + + f = pgtk_any_window_to_frame (gtk_widget_get_window (widget)); + + if (!f) + return FALSE; + + if (current_drop_context) + { + if (current_drop_context_drop) + gtk_drag_finish (current_drop_context, + FALSE, FALSE, current_drop_time); + + g_clear_pointer (¤t_drop_context, + g_object_unref); + } + + current_drop_context = g_object_ref (context); + current_drop_time = time; + current_drop_context_drop = true; + + name = gdk_drag_get_selection (context); + selected_action = gdk_drag_context_get_selected_action (context); + + EVENT_INIT (inev.ie); + + inev.ie.kind = DRAG_N_DROP_EVENT; + inev.ie.modifiers = 0; + inev.ie.arg = list4 (Qquote, intern (gdk_atom_name (name)), + make_uint (time), + drag_action_to_symbol (selected_action)); + inev.ie.timestamp = time; + + XSETINT (inev.ie.x, x); + XSETINT (inev.ie.y, y); + XSETFRAME (inev.ie.frame_or_window, f); + + evq_enqueue (&inev); + + return TRUE; } static void @@ -6208,9 +6396,9 @@ pgtk_set_event_handler (struct frame *f) return; } - gtk_drag_dest_set (FRAME_GTK_WIDGET (f), GTK_DEST_DEFAULT_ALL, NULL, 0, - GDK_ACTION_COPY); - gtk_drag_dest_add_uri_targets (FRAME_GTK_WIDGET (f)); + gtk_drag_dest_set (FRAME_GTK_WIDGET (f), 0, NULL, 0, + (GDK_ACTION_MOVE | GDK_ACTION_COPY + | GDK_ACTION_LINK | GDK_ACTION_PRIVATE)); if (FRAME_GTK_OUTER_WIDGET (f)) { @@ -6251,8 +6439,12 @@ pgtk_set_event_handler (struct frame *f) G_CALLBACK (scroll_event), NULL); g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "configure-event", G_CALLBACK (configure_event), NULL); - g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "drag-data-received", - G_CALLBACK (drag_data_received), NULL); + g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "drag-leave", + G_CALLBACK (drag_leave), NULL); + g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "drag-motion", + G_CALLBACK (drag_motion), NULL); + g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "drag-drop", + G_CALLBACK (drag_drop), NULL); g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "draw", G_CALLBACK (pgtk_handle_draw), NULL); g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "property-notify-event", @@ -6803,12 +6995,17 @@ syms_of_pgtkterm (void) DEFSYM (Qlatin_1, "latin-1"); - xg_default_icon_file = - build_pure_c_string ("icons/hicolor/scalable/apps/emacs.svg"); + xg_default_icon_file + = build_pure_c_string ("icons/hicolor/scalable/apps/emacs.svg"); staticpro (&xg_default_icon_file); DEFSYM (Qx_gtk_map_stock, "x-gtk-map-stock"); + DEFSYM (Qcopy, "copy"); + DEFSYM (Qmove, "move"); + DEFSYM (Qlink, "link"); + DEFSYM (Qprivate, "private"); + Fput (Qalt, Qmodifier_value, make_fixnum (alt_modifier)); Fput (Qhyper, Qmodifier_value, make_fixnum (hyper_modifier)); @@ -7093,8 +7290,3 @@ pgtk_cr_export_frames (Lisp_Object frames, cairo_surface_type_t surface_type) return CALLN (Fapply, intern ("concat"), Fnreverse (acc)); } - -void -init_pgtkterm (void) -{ -} diff --git a/src/pgtkterm.h b/src/pgtkterm.h index 86578be6b56..fcc6c5310e9 100644 --- a/src/pgtkterm.h +++ b/src/pgtkterm.h @@ -448,9 +448,9 @@ enum #define FRAME_FONT(f) (FRAME_X_OUTPUT (f)->font) #define FRAME_GTK_OUTER_WIDGET(f) (FRAME_X_OUTPUT (f)->widget) #define FRAME_GTK_WIDGET(f) (FRAME_X_OUTPUT (f)->edit_widget) -#define FRAME_WIDGET(f) (FRAME_GTK_OUTER_WIDGET (f) ? \ - FRAME_GTK_OUTER_WIDGET (f) : \ - FRAME_GTK_WIDGET (f)) +#define FRAME_WIDGET(f) (FRAME_GTK_OUTER_WIDGET (f) \ + ? FRAME_GTK_OUTER_WIDGET (f) \ + : FRAME_GTK_WIDGET (f)) #define FRAME_PGTK_VIEW(f) FRAME_GTK_WIDGET (f) #define FRAME_X_WINDOW(f) FRAME_GTK_OUTER_WIDGET (f) @@ -538,69 +538,57 @@ extern void pgtk_handle_property_notify (GdkEventProperty *); extern void pgtk_handle_selection_notify (GdkEventSelection *); /* Display init/shutdown functions implemented in pgtkterm.c */ -extern struct pgtk_display_info *pgtk_term_init (Lisp_Object display_name, - char *resource_name); -extern void pgtk_term_shutdown (int sig); +extern struct pgtk_display_info *pgtk_term_init (Lisp_Object, char *); +extern void pgtk_term_shutdown (int); /* Implemented in pgtkterm, published in or needed from pgtkfns. */ -extern void pgtk_clear_frame (struct frame *f); -extern char *pgtk_xlfd_to_fontname (const char *xlfd); +extern void pgtk_clear_frame (struct frame *); +extern char *pgtk_xlfd_to_fontname (const char *); /* Implemented in pgtkfns.c. */ extern void pgtk_set_doc_edited (void); -extern const char *pgtk_get_defaults_value (const char *key); -extern const char *pgtk_get_string_resource (XrmDatabase rdb, - const char *name, - const char *class); -extern void pgtk_implicitly_set_name (struct frame *f, Lisp_Object arg, - Lisp_Object oldval); +extern const char *pgtk_get_defaults_value (const char *); +extern const char *pgtk_get_string_resource (XrmDatabase, const char *, const char *); +extern void pgtk_implicitly_set_name (struct frame *, Lisp_Object, Lisp_Object); /* Color management implemented in pgtkterm. */ -extern bool pgtk_defined_color (struct frame *f, - const char *name, - Emacs_Color * color_def, bool alloc, - bool makeIndex); -extern void pgtk_query_color (struct frame *f, Emacs_Color * color); -extern void pgtk_query_colors (struct frame *f, Emacs_Color * colors, - int ncolors); -extern int pgtk_parse_color (struct frame *f, const char *color_name, - Emacs_Color * color); +extern bool pgtk_defined_color (struct frame *, const char *, + Emacs_Color *, bool, bool); +extern void pgtk_query_color (struct frame *, Emacs_Color *); +extern void pgtk_query_colors (struct frame *, Emacs_Color *, int); +extern int pgtk_parse_color (struct frame *, const char *, Emacs_Color *); /* Implemented in pgtkterm.c */ -extern void pgtk_clear_area (struct frame *f, int x, int y, int width, - int height); -extern int pgtk_gtk_to_emacs_modifiers (struct pgtk_display_info *dpyinfo, - int state); -extern void pgtk_clear_under_internal_border (struct frame *f); -extern void pgtk_set_event_handler (struct frame *f); +extern void pgtk_clear_area (struct frame *, int, int, int, int); +extern int pgtk_gtk_to_emacs_modifiers (struct pgtk_display_info *, int); +extern void pgtk_clear_under_internal_border (struct frame *); +extern void pgtk_set_event_handler (struct frame *); /* Implemented in pgtkterm.c */ extern int pgtk_display_pixel_height (struct pgtk_display_info *); extern int pgtk_display_pixel_width (struct pgtk_display_info *); -extern void pgtk_destroy_window (struct frame *f); -extern void pgtk_set_parent_frame (struct frame *f, Lisp_Object, Lisp_Object); +extern void pgtk_destroy_window (struct frame *); +extern void pgtk_set_parent_frame (struct frame *, Lisp_Object, Lisp_Object); extern void pgtk_set_no_focus_on_map (struct frame *, Lisp_Object, Lisp_Object); extern void pgtk_set_no_accept_focus (struct frame *, Lisp_Object, Lisp_Object); extern void pgtk_set_z_group (struct frame *, Lisp_Object, Lisp_Object); /* Cairo related functions implemented in pgtkterm.c */ extern void pgtk_cr_update_surface_desired_size (struct frame *, int, int, bool); -extern cairo_t *pgtk_begin_cr_clip (struct frame *f); -extern void pgtk_end_cr_clip (struct frame *f); +extern cairo_t *pgtk_begin_cr_clip (struct frame *); +extern void pgtk_end_cr_clip (struct frame *); extern void pgtk_set_cr_source_with_gc_foreground (struct frame *, Emacs_GC *, bool); extern void pgtk_set_cr_source_with_gc_background (struct frame *, Emacs_GC *, bool); extern void pgtk_set_cr_source_with_color (struct frame *, unsigned long, bool); -extern void pgtk_cr_draw_frame (cairo_t * cr, struct frame *f); -extern void pgtk_cr_destroy_frame_context (struct frame *f); -extern Lisp_Object pgtk_cr_export_frames (Lisp_Object frames, cairo_surface_type_t surface_type); +extern void pgtk_cr_draw_frame (cairo_t *, struct frame *); +extern void pgtk_cr_destroy_frame_context (struct frame *); +extern Lisp_Object pgtk_cr_export_frames (Lisp_Object , cairo_surface_type_t); /* Defined in pgtkmenu.c */ -extern Lisp_Object pgtk_popup_dialog (struct frame *f, Lisp_Object header, - Lisp_Object contents); -extern Lisp_Object pgtk_dialog_show (struct frame *f, Lisp_Object title, - Lisp_Object header, - const char **error_name); +extern Lisp_Object pgtk_popup_dialog (struct frame *, Lisp_Object, Lisp_Object); +extern Lisp_Object pgtk_dialog_show (struct frame *, Lisp_Object, Lisp_Object, + const char **); extern void initialize_frame_menubar (struct frame *); @@ -612,44 +600,46 @@ extern void syms_of_pgtkselect (void); extern void syms_of_pgtkim (void); /* Initialization and marking implemented in pgtkterm.c */ -extern void init_pgtkterm (void); extern void mark_pgtkterm (void); -extern void pgtk_delete_terminal (struct terminal *terminal); +extern void pgtk_delete_terminal (struct terminal *); -extern void pgtk_make_frame_visible (struct frame *f); -extern void pgtk_make_frame_invisible (struct frame *f); +extern void pgtk_make_frame_visible (struct frame *); +extern void pgtk_make_frame_invisible (struct frame *); extern void pgtk_free_frame_resources (struct frame *); -extern void pgtk_iconify_frame (struct frame *f); -extern void pgtk_focus_frame (struct frame *f, bool noactivate); -extern void pgtk_set_scroll_bar_default_width (struct frame *f); -extern void pgtk_set_scroll_bar_default_height (struct frame *f); -extern Lisp_Object pgtk_get_focus_frame (struct frame *frame); +extern void pgtk_iconify_frame (struct frame *); +extern void pgtk_focus_frame (struct frame *, bool); +extern void pgtk_set_scroll_bar_default_width (struct frame *); +extern void pgtk_set_scroll_bar_default_height (struct frame *); +extern Lisp_Object pgtk_get_focus_frame (struct frame *); -extern void pgtk_frame_rehighlight (struct pgtk_display_info *dpyinfo); +extern void pgtk_frame_rehighlight (struct pgtk_display_info *); extern void pgtk_change_tab_bar_height (struct frame *, int); -extern struct pgtk_display_info *check_pgtk_display_info (Lisp_Object object); +extern struct pgtk_display_info *check_pgtk_display_info (Lisp_Object); -extern void pgtk_default_font_parameter (struct frame *f, Lisp_Object parms); +extern void pgtk_default_font_parameter (struct frame *, Lisp_Object); -extern void pgtk_menu_set_in_use (bool in_use); +extern void pgtk_menu_set_in_use (bool); +/* Drag and drop functions used by Lisp. */ +extern void pgtk_update_drop_status (Lisp_Object, Lisp_Object); +extern void pgtk_finish_drop (Lisp_Object, Lisp_Object, Lisp_Object); -extern void pgtk_enqueue_string (struct frame *f, gchar * str); -extern void pgtk_enqueue_preedit (struct frame *f, Lisp_Object image_data); -extern void pgtk_im_focus_in (struct frame *f); -extern void pgtk_im_focus_out (struct frame *f); -extern bool pgtk_im_filter_keypress (struct frame *f, GdkEventKey * ev); -extern void pgtk_im_set_cursor_location (struct frame *f, int x, int y, - int width, int height); -extern void pgtk_im_init (struct pgtk_display_info *dpyinfo); -extern void pgtk_im_finish (struct pgtk_display_info *dpyinfo); +extern void pgtk_enqueue_string (struct frame *, gchar *); +extern void pgtk_enqueue_preedit (struct frame *, Lisp_Object); +extern void pgtk_im_focus_in (struct frame *); +extern void pgtk_im_focus_out (struct frame *); +extern bool pgtk_im_filter_keypress (struct frame *, GdkEventKey *); +extern void pgtk_im_set_cursor_location (struct frame *, int, int, + int, int); +extern void pgtk_im_init (struct pgtk_display_info *); +extern void pgtk_im_finish (struct pgtk_display_info *); extern bool xg_set_icon (struct frame *, Lisp_Object); -extern bool xg_set_icon_from_xpm_data (struct frame *f, const char **data); +extern bool xg_set_icon_from_xpm_data (struct frame *, const char **); -extern bool pgtk_text_icon (struct frame *f, const char *icon_name); +extern bool pgtk_text_icon (struct frame *, const char *); extern double pgtk_frame_scale_factor (struct frame *); extern int pgtk_emacs_to_gtk_modifiers (struct pgtk_display_info *, int); -- 2.39.5