* 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.
(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
--- /dev/null
+;;; 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 <https://www.gnu.org/licenses/>.
+
+;;; 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
(require 'menu-bar)
(require 'fontset)
(require 'dnd)
+(require 'pgtk-dnd)
(defvar x-invocation-args)
(defvar x-command-line-resources)
(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)
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 ();
(event->property != GDK_NONE ? Qt : Qlambda));
}
+\f
+/***********************************************************************
+ 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)
{
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. */);
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;
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,
return TRUE;
}
+\f
+
+/* 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
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))
{
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",
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));
return CALLN (Fapply, intern ("concat"), Fnreverse (acc));
}
-
-void
-init_pgtkterm (void)
-{
-}
#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)
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 *);
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);
projects / emacs.git / commitdiff