2020-09-09 13:33:15 -04:00
|
|
|
|
;;; dnd.el --- drag and drop support -*- lexical-binding: t; -*-
|
2005-04-11 19:29:10 +00:00
|
|
|
|
|
2025-01-01 07:39:17 +00:00
|
|
|
|
;; Copyright (C) 2005-2025 Free Software Foundation, Inc.
|
2005-04-11 19:29:10 +00:00
|
|
|
|
|
2010-06-22 00:10:16 -07:00
|
|
|
|
;; Author: Jan Djärv <jan.h.d@swipnet.se>
|
2019-05-25 13:43:06 -07:00
|
|
|
|
;; Maintainer: emacs-devel@gnu.org
|
2005-04-11 19:29:10 +00:00
|
|
|
|
;; Keywords: window, drag, drop
|
2010-08-29 12:17:13 -04:00
|
|
|
|
;; Package: emacs
|
2005-04-11 19:29:10 +00:00
|
|
|
|
|
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
|
|
2008-05-06 08:06:51 +00:00
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
2005-04-11 19:29:10 +00:00
|
|
|
|
;; it under the terms of the GNU General Public License as published by
|
2008-05-06 08:06:51 +00:00
|
|
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
|
|
|
;; (at your option) any later version.
|
2005-04-11 19:29:10 +00:00
|
|
|
|
|
|
|
|
|
;; 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
|
2017-09-13 15:52:52 -07:00
|
|
|
|
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
2005-04-11 19:29:10 +00:00
|
|
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
|
|
|
|
;; This file provides the generic handling of the drop part only.
|
|
|
|
|
;; Different DND backends (X11, W32, etc.) that handle the platform
|
|
|
|
|
;; specific DND parts call the functions here to do final delivery of
|
|
|
|
|
;; a drop.
|
|
|
|
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
|
|
|
|
|
;;; Customizable variables
|
|
|
|
|
|
2022-06-03 12:32:17 +08:00
|
|
|
|
(eval-when-compile
|
|
|
|
|
(require 'cl-lib))
|
|
|
|
|
|
2020-09-09 13:33:15 -04:00
|
|
|
|
(defgroup dnd nil
|
|
|
|
|
"Handling data from drag and drop."
|
|
|
|
|
:group 'environment)
|
2005-04-11 19:29:10 +00:00
|
|
|
|
|
2005-05-14 11:24:17 +00:00
|
|
|
|
;;;###autoload
|
2005-04-11 19:29:10 +00:00
|
|
|
|
(defcustom dnd-protocol-alist
|
2024-12-09 21:11:45 +01:00
|
|
|
|
'(("^file:///" . dnd-open-local-file) ; XDND format.
|
|
|
|
|
("^file://[^/]" . dnd-open-file) ; URL with host
|
|
|
|
|
("^file:/[^/]" . dnd-open-local-file) ; Old KDE, Motif, Sun
|
|
|
|
|
("^file:[^/]" . dnd-open-local-file) ; MS-Windows
|
|
|
|
|
("^\\(https?\\|ftp\\|nfs\\)://" . dnd-open-file))
|
2005-04-11 19:29:10 +00:00
|
|
|
|
"The functions to call for different protocols when a drop is made.
|
2023-10-26 11:37:58 +00:00
|
|
|
|
This variable is used by `dnd-handle-multiple-urls'.
|
2005-04-11 19:29:10 +00:00
|
|
|
|
The list contains of (REGEXP . FUNCTION) pairs.
|
|
|
|
|
The functions shall take two arguments, URL, which is the URL dropped and
|
|
|
|
|
ACTION which is the action to be performed for the drop (move, copy, link,
|
|
|
|
|
private or ask).
|
2023-10-26 11:37:58 +00:00
|
|
|
|
If a function's `dnd-multiple-handler' property is set, it is provided
|
|
|
|
|
a list of each URI dropped instead.
|
2005-04-11 19:29:10 +00:00
|
|
|
|
If no match is found here, and the value of `browse-url-browser-function'
|
|
|
|
|
is a pair of (REGEXP . FUNCTION), those regexps are tried for a match.
|
|
|
|
|
If no match is found, the URL is inserted as text by calling `dnd-insert-text'.
|
|
|
|
|
The function shall return the action done (move, copy, link or private)
|
|
|
|
|
if some action was made, or nil if the URL is ignored."
|
2023-10-28 06:43:56 +00:00
|
|
|
|
:version "30.1"
|
2022-04-03 09:14:24 +08:00
|
|
|
|
:type '(repeat (cons (regexp) (function)))
|
|
|
|
|
:group 'dnd)
|
2005-04-11 19:29:10 +00:00
|
|
|
|
|
|
|
|
|
|
2006-09-07 07:44:33 +00:00
|
|
|
|
(defcustom dnd-open-remote-file-function
|
|
|
|
|
(if (eq system-type 'windows-nt)
|
2020-09-09 13:33:15 -04:00
|
|
|
|
#'dnd-open-local-file
|
|
|
|
|
#'dnd-open-remote-url)
|
2006-09-07 07:44:33 +00:00
|
|
|
|
"The function to call when opening a file on a remote machine.
|
lisp/*.el, src/*.c: Fix typos in docstrings
* lisp/apropos.el (apropos-do-all):
* lisp/auth-source-pass.el (auth-source-pass--select-from-entries):
* lisp/auth-source.el (auth-source-user-or-password):
* lisp/calc/calc-forms.el (math-tzone-names):
* lisp/calendar/diary-lib.el (diary-face-attrs)
(diary-mark-entries-1):
* lisp/cedet/cedet-files.el (cedet-files-list-recursively):
* lisp/cedet/ede.el (ede-constructing, ede-deep-rescan):
* lisp/cedet/ede/cpp-root.el (ede-cpp-root-header-file-p):
* lisp/cedet/ede/proj.el (ede-proj-target-makefile):
* lisp/cedet/inversion.el (inversion-check-version)
(inversion-test):
* lisp/cedet/mode-local.el (mode-local-map-file-buffers):
* lisp/cedet/semantic/complete.el (semantic-displayer-ghost):
* lisp/cedet/semantic/db-find.el (semanticdb-find-translate-path-default):
* lisp/cedet/semantic/db.el (semanticdb-table)
(semanticdb-search-system-databases):
* lisp/cedet/semantic/imenu.el (semantic-imenu-index-directory):
* lisp/cedet/semantic/java.el (semantic-java-doc-keywords-map):
* lisp/cedet/semantic/lex-spp.el (semantic-lex-spp-use-headers-flag):
* lisp/cedet/semantic/lex.el (semantic-lex-make-keyword-table)
(semantic-lex-make-type-table, semantic-lex-debug-analyzers):
* lisp/cedet/semantic/tag-ls.el (semantic-tag-abstract-p)
(semantic-tag-leaf-p, semantic-tag-static-p)
(semantic-tag-prototype-p):
* lisp/dnd.el (dnd-open-remote-file-function, dnd-open-local-file):
* lisp/emacs-lisp/eieio-opt.el (eieio-build-class-alist)
(eieio-read-class, eieio-read-subclass):
* lisp/emacs-lisp/generator.el (cps--replace-variable-references)
(cps--handle-loop-for):
* lisp/erc/erc-dcc.el (erc-dcc-list, erc-dcc-member, erc-dcc-server)
(erc-dcc-auto-mask-p, erc-dcc-get-file, erc-dcc-chat-accept):
* lisp/eshell/em-pred.el (eshell-pred-file-type):
* lisp/faces.el (defined-colors-with-face-attributes):
* lisp/font-core.el (font-lock-mode):
* lisp/frame.el (frame-restack):
* lisp/net/shr.el (shr-image-animate):
* lisp/org/org-agenda.el (org-agenda-change-all-lines)
(org-agenda-today-p):
* lisp/org/org-id.el (org-id-get):
* lisp/org/org.el (org-highlight-latex-and-related)
(org--valid-property-p):
* lisp/org/ox-beamer.el (org-beamer--get-label):
* lisp/org/ox-latex.el (org-latex--caption-above-p):
* lisp/org/ox-odt.el (org-odt--copy-image-file)
(org-odt--copy-formula-file):
* lisp/org/ox.el (org-export-with-timestamps):
* lisp/progmodes/verilog-mode.el (verilog-indent-declaration-macros):
* lisp/ses.el (ses-file-format-extend-parameter-list):
* lisp/term.el (ansi-term):
* lisp/textmodes/bibtex.el (bibtex-no-opt-remove-re)
(bibtex-beginning-of-first-entry, bibtex-autokey-get-title)
(bibtex-read-key, bibtex-initialize):
* lisp/textmodes/flyspell.el (flyspell-word):
* lisp/view.el (view-mode-exit):
* src/composite.c:
* src/floatfns.c (Fisnan): Fix typos in docstrings.
2019-09-19 04:32:25 +02:00
|
|
|
|
The function will be called with two arguments, URI and ACTION.
|
|
|
|
|
See `dnd-open-file' for details.
|
2006-09-07 07:44:33 +00:00
|
|
|
|
If nil, then dragging remote files into Emacs will result in an error.
|
2006-09-15 23:53:48 +00:00
|
|
|
|
Predefined functions are `dnd-open-local-file' and `dnd-open-remote-url'.
|
|
|
|
|
`dnd-open-local-file' attempts to open a remote file using its UNC name and
|
lisp/*.el, src/*.c: Fix typos in docstrings
* lisp/apropos.el (apropos-do-all):
* lisp/auth-source-pass.el (auth-source-pass--select-from-entries):
* lisp/auth-source.el (auth-source-user-or-password):
* lisp/calc/calc-forms.el (math-tzone-names):
* lisp/calendar/diary-lib.el (diary-face-attrs)
(diary-mark-entries-1):
* lisp/cedet/cedet-files.el (cedet-files-list-recursively):
* lisp/cedet/ede.el (ede-constructing, ede-deep-rescan):
* lisp/cedet/ede/cpp-root.el (ede-cpp-root-header-file-p):
* lisp/cedet/ede/proj.el (ede-proj-target-makefile):
* lisp/cedet/inversion.el (inversion-check-version)
(inversion-test):
* lisp/cedet/mode-local.el (mode-local-map-file-buffers):
* lisp/cedet/semantic/complete.el (semantic-displayer-ghost):
* lisp/cedet/semantic/db-find.el (semanticdb-find-translate-path-default):
* lisp/cedet/semantic/db.el (semanticdb-table)
(semanticdb-search-system-databases):
* lisp/cedet/semantic/imenu.el (semantic-imenu-index-directory):
* lisp/cedet/semantic/java.el (semantic-java-doc-keywords-map):
* lisp/cedet/semantic/lex-spp.el (semantic-lex-spp-use-headers-flag):
* lisp/cedet/semantic/lex.el (semantic-lex-make-keyword-table)
(semantic-lex-make-type-table, semantic-lex-debug-analyzers):
* lisp/cedet/semantic/tag-ls.el (semantic-tag-abstract-p)
(semantic-tag-leaf-p, semantic-tag-static-p)
(semantic-tag-prototype-p):
* lisp/dnd.el (dnd-open-remote-file-function, dnd-open-local-file):
* lisp/emacs-lisp/eieio-opt.el (eieio-build-class-alist)
(eieio-read-class, eieio-read-subclass):
* lisp/emacs-lisp/generator.el (cps--replace-variable-references)
(cps--handle-loop-for):
* lisp/erc/erc-dcc.el (erc-dcc-list, erc-dcc-member, erc-dcc-server)
(erc-dcc-auto-mask-p, erc-dcc-get-file, erc-dcc-chat-accept):
* lisp/eshell/em-pred.el (eshell-pred-file-type):
* lisp/faces.el (defined-colors-with-face-attributes):
* lisp/font-core.el (font-lock-mode):
* lisp/frame.el (frame-restack):
* lisp/net/shr.el (shr-image-animate):
* lisp/org/org-agenda.el (org-agenda-change-all-lines)
(org-agenda-today-p):
* lisp/org/org-id.el (org-id-get):
* lisp/org/org.el (org-highlight-latex-and-related)
(org--valid-property-p):
* lisp/org/ox-beamer.el (org-beamer--get-label):
* lisp/org/ox-latex.el (org-latex--caption-above-p):
* lisp/org/ox-odt.el (org-odt--copy-image-file)
(org-odt--copy-formula-file):
* lisp/org/ox.el (org-export-with-timestamps):
* lisp/progmodes/verilog-mode.el (verilog-indent-declaration-macros):
* lisp/ses.el (ses-file-format-extend-parameter-list):
* lisp/term.el (ansi-term):
* lisp/textmodes/bibtex.el (bibtex-no-opt-remove-re)
(bibtex-beginning-of-first-entry, bibtex-autokey-get-title)
(bibtex-read-key, bibtex-initialize):
* lisp/textmodes/flyspell.el (flyspell-word):
* lisp/view.el (view-mode-exit):
* src/composite.c:
* src/floatfns.c (Fisnan): Fix typos in docstrings.
2019-09-19 04:32:25 +02:00
|
|
|
|
is the default on MS-Windows. `dnd-open-remote-url' uses `url-handler-mode'
|
2006-09-15 23:53:48 +00:00
|
|
|
|
and is the default except for MS-Windows."
|
2006-09-07 07:44:33 +00:00
|
|
|
|
:version "22.1"
|
2022-04-03 09:14:24 +08:00
|
|
|
|
:type 'function
|
|
|
|
|
:group 'dnd)
|
2006-09-07 07:44:33 +00:00
|
|
|
|
|
2005-04-11 19:29:10 +00:00
|
|
|
|
|
|
|
|
|
(defcustom dnd-open-file-other-window nil
|
2021-09-13 06:04:32 +02:00
|
|
|
|
"If non-nil, always use `find-file-other-window' to open dropped files."
|
2005-04-11 19:29:10 +00:00
|
|
|
|
:version "22.1"
|
2022-04-03 09:14:24 +08:00
|
|
|
|
:type 'boolean
|
|
|
|
|
:group 'dnd)
|
|
|
|
|
|
|
|
|
|
(defcustom dnd-scroll-margin nil
|
|
|
|
|
"The scroll margin inside a window underneath the cursor during drag-and-drop.
|
|
|
|
|
If the mouse moves this many lines close to the top or bottom of
|
|
|
|
|
a window while dragging text, then that window will be scrolled
|
|
|
|
|
down and up respectively."
|
|
|
|
|
:type '(choice (const :tag "Don't scroll during mouse movement")
|
|
|
|
|
(integer :tag "This many lines from window top or bottom"))
|
|
|
|
|
:version "29.1"
|
|
|
|
|
:group 'dnd)
|
|
|
|
|
|
|
|
|
|
(defcustom dnd-indicate-insertion-point nil
|
|
|
|
|
"Whether or not point should follow the position of the mouse.
|
|
|
|
|
If non-nil, the point of the window underneath the mouse will be
|
|
|
|
|
adjusted to reflect where any text will be inserted upon drop
|
|
|
|
|
when the mouse moves while receiving a drop from another
|
|
|
|
|
program."
|
|
|
|
|
:type 'boolean
|
|
|
|
|
:version "29.1"
|
|
|
|
|
:group 'dnd)
|
2005-04-11 19:29:10 +00:00
|
|
|
|
|
2022-06-29 20:10:25 +08:00
|
|
|
|
(defcustom dnd-direct-save-remote-files 'x
|
|
|
|
|
"Whether or not to perform a direct save of remote files.
|
2023-02-21 16:55:21 +01:00
|
|
|
|
This is compatible with fewer programs, but means dropped files
|
2022-06-29 20:10:25 +08:00
|
|
|
|
will be saved with their actual file names, and not a temporary
|
|
|
|
|
file name provided by TRAMP.
|
|
|
|
|
|
2023-02-21 16:55:21 +01:00
|
|
|
|
This defaults to `x', which means to save that way only on X
|
2022-06-29 20:10:25 +08:00
|
|
|
|
Windows."
|
|
|
|
|
:type '(choice (const :tag "Only use direct save on X Windows" x)
|
|
|
|
|
(const :tag "Use direct save everywhere" t)
|
|
|
|
|
(const :tag "Don't use direct save")))
|
|
|
|
|
|
2005-04-11 19:29:10 +00:00
|
|
|
|
;; Functions
|
|
|
|
|
|
2022-04-03 09:14:24 +08:00
|
|
|
|
(defun dnd-handle-movement (posn)
|
|
|
|
|
"Handle mouse movement to POSN when receiving a drop from another program."
|
2022-04-04 20:32:46 +08:00
|
|
|
|
(when (windowp (posn-window posn))
|
|
|
|
|
(with-selected-window (posn-window posn)
|
2022-06-14 17:43:08 +08:00
|
|
|
|
(when (and dnd-scroll-margin
|
|
|
|
|
;; TODO: handle scroll bars reasonably.
|
|
|
|
|
(not (posn-area posn)))
|
2022-04-04 20:32:46 +08:00
|
|
|
|
(ignore-errors
|
|
|
|
|
(let* ((row (cdr (posn-col-row posn)))
|
|
|
|
|
(window (when (windowp (posn-window posn))
|
|
|
|
|
(posn-window posn)))
|
|
|
|
|
(text-height (window-text-height window))
|
|
|
|
|
;; Make sure it's possible to scroll both up
|
|
|
|
|
;; and down if the margin is too large for the
|
|
|
|
|
;; window.
|
|
|
|
|
(margin (min (/ text-height 3) dnd-scroll-margin)))
|
|
|
|
|
;; At 2 lines, the window becomes too small for any
|
|
|
|
|
;; meaningful scrolling.
|
|
|
|
|
(unless (<= text-height 2)
|
|
|
|
|
(cond
|
|
|
|
|
;; Inside the bottom scroll margin, scroll up.
|
|
|
|
|
((> row (- text-height margin))
|
|
|
|
|
(with-selected-window window
|
|
|
|
|
(scroll-up 1)))
|
|
|
|
|
;; Inside the top scroll margin, scroll down.
|
|
|
|
|
((< row margin)
|
|
|
|
|
(with-selected-window window
|
|
|
|
|
(scroll-down 1))))))))
|
|
|
|
|
(when dnd-indicate-insertion-point
|
2024-04-14 13:16:29 +03:00
|
|
|
|
(let ((pos (posn-point posn)))
|
|
|
|
|
;; We avoid errors here, since on some systems this runs
|
|
|
|
|
;; when waiting_for_input is non-zero, and that aborts on
|
|
|
|
|
;; error.
|
|
|
|
|
(if (and pos (<= (point-min) pos (point-max)))
|
|
|
|
|
(goto-char pos)
|
|
|
|
|
pos))))))
|
2022-04-03 09:14:24 +08:00
|
|
|
|
|
2006-05-20 04:28:48 +00:00
|
|
|
|
(defun dnd-handle-one-url (window action url)
|
2005-04-11 19:29:10 +00:00
|
|
|
|
"Handle one dropped url by calling the appropriate handler.
|
|
|
|
|
The handler is first located by looking at `dnd-protocol-alist'.
|
2020-05-06 16:48:57 +02:00
|
|
|
|
If no match is found here, `browse-url-handlers' and
|
|
|
|
|
`browse-url-default-handlers' are searched for a match.
|
|
|
|
|
If no match is found, just call `dnd-insert-text'. WINDOW is
|
|
|
|
|
where the drop happened, ACTION is the action for the drop, URL
|
2023-10-26 11:37:58 +00:00
|
|
|
|
is what has been dropped. Returns ACTION.
|
|
|
|
|
|
|
|
|
|
This function has been obsolete since Emacs 30.1; it has been
|
|
|
|
|
supplanted by `dnd-handle-multiple-urls'."
|
2006-05-20 04:28:48 +00:00
|
|
|
|
(let (ret)
|
2005-04-11 19:29:10 +00:00
|
|
|
|
(or
|
|
|
|
|
(catch 'done
|
|
|
|
|
(dolist (bf dnd-protocol-alist)
|
2006-05-20 04:28:48 +00:00
|
|
|
|
(when (string-match (car bf) url)
|
|
|
|
|
(setq ret (funcall (cdr bf) url action))
|
2005-04-11 19:29:10 +00:00
|
|
|
|
(throw 'done t)))
|
|
|
|
|
nil)
|
2020-05-06 16:48:57 +02:00
|
|
|
|
(catch 'done
|
2020-05-07 13:02:13 +02:00
|
|
|
|
(let ((browser (browse-url-select-handler url 'internal)))
|
2020-05-07 09:53:54 +02:00
|
|
|
|
(when browser
|
|
|
|
|
(setq ret 'private)
|
|
|
|
|
(funcall browser url action)
|
|
|
|
|
(throw 'done t)))
|
2020-05-06 16:48:57 +02:00
|
|
|
|
nil)
|
2005-04-11 19:29:10 +00:00
|
|
|
|
(progn
|
2006-05-20 04:28:48 +00:00
|
|
|
|
(dnd-insert-text window action url)
|
2005-04-11 19:29:10 +00:00
|
|
|
|
(setq ret 'private)))
|
|
|
|
|
ret))
|
|
|
|
|
|
2023-10-26 11:37:58 +00:00
|
|
|
|
(make-obsolete 'dnd-handle-one-url 'dnd-handle-multiple-urls "30.1")
|
|
|
|
|
|
|
|
|
|
(defun dnd-handle-multiple-urls (window urls action)
|
|
|
|
|
"Select a handler for, then open, each element of URLS.
|
|
|
|
|
The argument ACTION is the action which must be taken, much as
|
|
|
|
|
that to `dnd-begin-file-drag'.
|
|
|
|
|
|
|
|
|
|
Assign and give each URL to one of the \"DND handler\" functions
|
|
|
|
|
listed in the variable `dnd-protocol-alist'. When multiple
|
|
|
|
|
handlers matching the same subset of URLs exist, give precedence
|
|
|
|
|
to the handler assigned the greatest number of URLs.
|
|
|
|
|
|
|
|
|
|
If a handler is a symbol with the property
|
|
|
|
|
`dnd-multiple-handler', call it with ACTION and a list of every
|
|
|
|
|
URL it is assigned. Otherwise, call it once for each URL
|
|
|
|
|
assigned with ACTION and the URL in question.
|
|
|
|
|
|
|
|
|
|
Subsequently open URLs that don't match any handlers opened with
|
|
|
|
|
any handler selected by `browse-url-select-handler', and failing
|
|
|
|
|
even that, insert them with `dnd-insert-text'.
|
|
|
|
|
|
|
|
|
|
Return a symbol designating the actions taken by each DND handler
|
|
|
|
|
called. If all DND handlers called return the same symbol,
|
|
|
|
|
return that symbol; otherwise, or if no DND handlers are called,
|
|
|
|
|
return `private'.
|
|
|
|
|
|
|
|
|
|
Do not rely on the contents of URLS after calling this function,
|
|
|
|
|
for it will be modified."
|
|
|
|
|
(let ((list nil) (return-value nil))
|
|
|
|
|
(with-selected-window window
|
|
|
|
|
(dolist (handler dnd-protocol-alist)
|
|
|
|
|
(let ((pattern (car handler))
|
|
|
|
|
(handler (cdr handler)))
|
|
|
|
|
(dolist (uri urls)
|
|
|
|
|
(when (string-match pattern uri)
|
|
|
|
|
(let ((cell (or (cdr (assq handler list))
|
|
|
|
|
(let ((cell (cons handler nil)))
|
|
|
|
|
(push cell list)
|
|
|
|
|
cell))))
|
2023-10-28 06:42:48 +00:00
|
|
|
|
(unless (memq uri cell)
|
|
|
|
|
(setcdr cell (cons uri (cdr cell)))))))))
|
2023-10-26 11:37:58 +00:00
|
|
|
|
(setq list (nreverse list))
|
|
|
|
|
;; While unassessed handlers still exist...
|
|
|
|
|
(while list
|
|
|
|
|
;; Sort list by the number of URLs assigned to each handler.
|
|
|
|
|
(setq list (sort list (lambda (first second)
|
|
|
|
|
(> (length (cdr first))
|
|
|
|
|
(length (cdr second))))))
|
|
|
|
|
;; Call the handler in its car before removing each URL from
|
|
|
|
|
;; URLs.
|
|
|
|
|
(let ((handler (caar list))
|
|
|
|
|
(entry-urls (cdar list)))
|
|
|
|
|
(setq list (cdr list))
|
|
|
|
|
(when entry-urls
|
|
|
|
|
(if (and (symbolp handler)
|
|
|
|
|
(get handler 'dnd-multiple-handler))
|
|
|
|
|
(progn
|
|
|
|
|
(let ((value (funcall handler entry-urls action)))
|
|
|
|
|
(if (or (not return-value)
|
|
|
|
|
(eq return-value value))
|
|
|
|
|
(setq return-value value)
|
|
|
|
|
(setq return-value 'private)))
|
|
|
|
|
(dolist (url entry-urls)
|
|
|
|
|
(setq urls (delq url urls))
|
|
|
|
|
;; And each handler-URL list after this.
|
|
|
|
|
(dolist (item list)
|
|
|
|
|
(setcdr item (delq url (cdr item))))))
|
|
|
|
|
(dolist (url entry-urls)
|
|
|
|
|
(let ((value (funcall handler url action)))
|
|
|
|
|
(if (or (not return-value) (eq return-value value))
|
|
|
|
|
(setq return-value value)
|
|
|
|
|
(setq return-value 'private)))
|
|
|
|
|
(setq urls (delq url urls))
|
|
|
|
|
;; And each handler-URL list after this.
|
|
|
|
|
(dolist (item list)
|
|
|
|
|
(setcdr item (delq url (cdr item)))))))))
|
|
|
|
|
;; URLS should now incorporate only those which haven't been
|
|
|
|
|
;; assigned their own handlers.
|
|
|
|
|
(dolist (leftover urls)
|
|
|
|
|
(setq return-value 'private)
|
Mark if-let and when-let obsolete
* lisp/subr.el (if-let*, when-let*, if-let, when-let): Mark
if-let and when-let obsolete (bug#73853 and elsewhere). Move
docstring text around so that if-let* and when-let* descriptions
no longer refer to if-let and when-let.
* etc/NEWS: Announce the change.
* admin/admin.el (reminder-for-release-blocking-bugs):
* doc/misc/erc.texi (display-buffer):
* lisp/ansi-color.el (ansi-color-apply)
(ansi-color--face-vec-face):
* lisp/ansi-osc.el (ansi-osc-apply-on-region)
(ansi-osc-hyperlink):
* lisp/arc-mode.el (archive-goto-file)
(archive-next-file-displayer):
* lisp/auth-source-pass.el (auth-source-pass-search)
(auth-source-pass--parse-data)
(auth-source-pass--find-match-many):
* lisp/autorevert.el (auto-revert-notify-rm-watch):
* lisp/buff-menu.el (Buffer-menu-unmark-all-buffers)
(Buffer-menu-group-by-root):
* lisp/calendar/parse-time.el (parse-iso8601-time-string):
* lisp/cedet/pulse.el (pulse-tick):
* lisp/comint.el (comint--fontify-input-ppss-flush-indirect)
(comint--intersect-regions):
* lisp/completion-preview.el (completion-preview--try-table)
(completion-preview--capf-wrapper, completion-preview--update):
* lisp/cus-edit.el (setopt--set)
(custom-dirlocals-maybe-update-cons, custom-dirlocals-validate):
* lisp/custom.el (load-theme):
* lisp/descr-text.el (describe-char):
* lisp/desktop.el (desktop--emacs-pid-running-p):
* lisp/dired-x.el (menu):
* lisp/dired.el (dired-font-lock-keywords)
(dired-insert-directory, dired--insert-disk-space, dired-mode):
* lisp/dnd.el (dnd-handle-multiple-urls):
* lisp/dom.el (dom-remove-attribute):
* lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker):
* lisp/emacs-lisp/bytecomp.el (bytecomp--custom-declare):
* lisp/emacs-lisp/comp-common.el (comp-function-type-spec):
* lisp/emacs-lisp/comp-cstr.el (comp--all-classes)
(comp-cstr-set-range-for-arithm, comp--cstr-union-1-no-mem)
(comp-cstr-intersection-no-mem, comp-cstr-fixnum-p)
(comp-cstr-type-p):
* lisp/emacs-lisp/comp-run.el (comp-subr-trampoline-install)
(native--compile-async):
* lisp/emacs-lisp/comp.el (comp--get-function-cstr)
(comp--function-pure-p, comp--intern-func-in-ctxt)
(comp--addr-to-bb-name, comp--emit-assume, comp--maybe-add-vmvar)
(comp--add-call-cstr, comp--compute-dominator-tree)
(comp--dom-tree-walker, comp--ssa-rename)
(comp--function-call-maybe-fold, comp--fwprop-call)
(comp--call-optim-func):
* lisp/emacs-lisp/edebug.el (edebug-global-prefix)
(edebug-remove-instrumentation):
* lisp/emacs-lisp/eieio.el (initialize-instance):
* lisp/emacs-lisp/ert-x.el (ert-resource-directory):
* lisp/emacs-lisp/ert.el (ert--expand-should-1)
(ert-test-location, ert-write-junit-test-report)
(ert-test--erts-test):
* lisp/emacs-lisp/icons.el (icon-complete-spec, icon-string)
(icons--create):
* lisp/emacs-lisp/lisp-mode.el (lisp--local-defform-body-p):
* lisp/emacs-lisp/loaddefs-gen.el
(loaddefs-generate--make-autoload)
(loaddefs-generate--parse-file):
* lisp/emacs-lisp/multisession.el
(multisession-edit-mode--revert, multisession-edit-value):
* lisp/emacs-lisp/package-vc.el (package-vc--read-archive-data)
(package-vc--version, package-vc--clone):
* lisp/emacs-lisp/package.el (package--reload-previously-loaded):
* lisp/emacs-lisp/pp.el (pp--insert-lisp):
* lisp/emacs-lisp/subr-x.el (add-display-text-property):
* lisp/emacs-lisp/tabulated-list.el (tabulated-list-print):
* lisp/emacs-lisp/timer.el (run-at-time):
* lisp/emacs-lisp/vtable.el (vtable-goto-table)
(vtable-goto-column, vtable-update-object, vtable--insert-line)
(vtable--compute-widths, vtable--make-keymap):
* lisp/emacs-lisp/warnings.el (display-warning):
* lisp/epa-file.el (epa-file-insert-file-contents):
* lisp/epa.el (epa-show-key):
* lisp/erc/erc-backend.el (erc--split-line, erc--conceal-prompt)
(PRIVMSG, erc--get-isupport-entry):
* lisp/erc/erc-button.el (erc-button-add-nickname-buttons)
(erc--button-next):
* lisp/erc/erc-common.el (erc--find-group):
* lisp/erc/erc-fill.el (erc-fill, erc-fill-static)
(erc-fill--wrap-escape-hidden-speaker)
(erc-fill--wrap-unmerge-on-date-stamp)
(erc-fill--wrap-massage-initial-message-post-clear)
(erc-fill-wrap, erc-fill--wrap-rejigger-region):
* lisp/erc/erc-goodies.el (erc--scrolltobottom-all)
(erc--keep-place-indicator-on-window-buffer-change)
(keep-place-indicator, erc--keep-place-indicator-adjust-on-clear)
(erc-keep-place-move, erc--command-indicator-display):
* lisp/erc/erc-ibuffer.el (erc-members):
* lisp/erc/erc-join.el (erc-join--remove-requested-channel)
(erc-autojoin--join):
* lisp/erc/erc-networks.el
(erc-networks--id-qualifying-init-parts, erc-networks--id-reload)
(erc-networks--id-ensure-comparable)
(erc-networks--reclaim-orphaned-target-buffers)
(erc-networks--server-select):
* lisp/erc/erc-nicks.el (erc-nicks-invert)
(erc-nicks--redirect-face-widget-link, erc-nicks--highlight)
(erc-nicks--highlight-button)
(erc-nicks--list-faces-help-button-action, erc-nicks-list-faces)
(erc-nicks-refresh, erc-nicks--colors-from-faces)
(erc-nicks--track-prioritize)
(erc-nicks--remember-face-for-track):
* lisp/erc/erc-notify.el (querypoll, erc--querypoll-get-next)
(erc--querypoll-on-352, erc--querypoll-send):
* lisp/erc/erc-sasl.el (erc-sasl--read-password):
* lisp/erc/erc-services.el
(erc-services-issue-ghost-and-retry-nick):
* lisp/erc/erc-speedbar.el (erc-speedbar--ensure, nickbar)
(erc-speedbar-toggle-nicknames-window-lock)
(erc-speedbar--compose-nicks-face):
* lisp/erc/erc-stamp.el (erc-stamp--recover-on-reconnect)
(erc-stamp-prefix-log-filter, erc--conceal-prompt)
(erc--insert-timestamp-left, erc-insert-timestamp-right)
(erc-stamp--defer-date-insertion-on-post-modify)
(erc-insert-timestamp-left-and-right)
(erc-stamp--redo-right-stamp-post-clear)
(erc-stamp--reset-on-clear, erc-stamp--dedupe-date-stamps):
* lisp/erc/erc-status-sidebar.el (bufbar)
(erc-status-sidebar-prefer-target-as-name)
(erc-status-sidebar-default-allsort, erc-status-sidebar-click):
* lisp/erc/erc-track.el (erc-track--shortened-names-get)
(erc-track--setup, erc-track--select-mode-line-face)
(erc-track-modified-channels, erc-track--collect-faces-in)
(erc-track--switch-buffer, erc-track--replace-killed-buffer):
* lisp/erc/erc-truncate.el (erc-truncate--setup)
(erc-truncate-buffer):
* lisp/erc/erc.el (erc--ensure-query-member)
(erc--ensure-query-members, erc--remove-channel-users-but)
(erc--cusr-change-status, erc--find-mode, erc--update-modules)
(erc-log-irc-protocol, erc--refresh-prompt)
(erc--restore-important-text-props)
(erc--order-text-properties-from-hash, erc-send-input-line)
(erc-cmd-IGNORE, erc--unignore-user, erc-cmd-QUERY)
(erc-cmd-BANLIST, erc--speakerize-nick)
(erc--format-speaker-input-message, erc-channel-receive-names)
(erc-send-current-line, erc-format-target-and/or-network)
(erc-kill-buffer-function, erc-restore-text-properties)
(erc--get-eq-comparable-cmd):
* lisp/eshell/em-alias.el (eshell-maybe-replace-by-alias--which)
(eshell-maybe-replace-by-alias):
* lisp/eshell/em-glob.el (eshell-glob-convert):
* lisp/eshell/em-pred.el (eshell-pred-user-or-group)
(eshell-pred-file-time, eshell-pred-file-type)
(eshell-pred-file-mode, eshell-pred-file-links)
(eshell-pred-file-size):
* lisp/eshell/em-prompt.el (eshell-forward-paragraph)
(eshell-next-prompt):
* lisp/eshell/esh-arg.el (eshell-resolve-current-argument):
* lisp/eshell/esh-cmd.el (eshell-do-eval, eshell/which)
(eshell-plain-command--which, eshell-plain-command):
* lisp/eshell/esh-io.el (eshell-duplicate-handles)
(eshell-protect-handles, eshell-get-target, eshell-close-target):
* lisp/eshell/esh-proc.el (eshell-sentinel):
* lisp/eshell/esh-var.el (eshell-parse-variable-ref)
(eshell-get-variable, eshell-set-variable):
* lisp/faces.el (face-at-point):
* lisp/ffap.el (ffap-in-project):
* lisp/filenotify.el (file-notify--rm-descriptor):
* lisp/files-x.el (read-dir-locals-file)
(connection-local-update-profile-variables)
(connection-local-value):
* lisp/files.el (file-remote-p, abbreviate-file-name)
(set-auto-mode, hack-local-variables)
(revert-buffer-restore-read-only):
* lisp/find-dired.el (find-dired-sort-by-filename):
* lisp/font-lock.el (font-lock--filter-keywords):
* lisp/gnus/gnus-art.el (article-emojize-symbols):
* lisp/gnus/gnus-int.el (gnus-close-server):
* lisp/gnus/gnus-search.el (gnus-search-transform)
(gnus-search-indexed-parse-output, gnus-search-server-to-engine):
* lisp/gnus/gnus-sum.el (gnus-collect-urls, gnus-shorten-url):
* lisp/gnus/gnus.el (gnus-check-backend-function):
* lisp/gnus/message.el (message-send-mail):
* lisp/gnus/mml.el (mml-generate-mime, mml-insert-mime-headers):
* lisp/gnus/nnatom.el (nnatom--read-feed, nnatom--read-article)
(nnatom--read-article-or-group-authors, nnatom--read-publish)
(nnatom--read-update, nnatom--read-links):
* lisp/gnus/nnfeed.el (nnfeed--read-server, nnfeed--write-server)
(nnfeed--parse-feed, nnfeed--group-data, nnfeed-retrieve-article)
(nnfeed-retrieve-headers, nnfeed--print-part)
(nnfeed-request-article, nnfeed-request-group)
(nnfeed-request-list, nnfeed--group-description)
(nnfeed-request-group-description)
(nnfeed-request-list-newsgroups, nnfeed-request-rename-group):
* lisp/gnus/nnmh.el (nnmh-update-gnus-unreads):
* lisp/help-fns.el (help-find-source)
(help-fns--insert-menu-bindings, help-fns--mention-first-release)
(help-fns--mention-shortdoc-groups)
(help-fns--customize-variable-version)
(help-fns--face-custom-version-info, describe-mode):
* lisp/help-mode.el (help-make-xrefs):
* lisp/help.el (help-key-description, help--describe-command):
* lisp/hfy-cmap.el (htmlfontify-load-rgb-file):
* lisp/ibuf-ext.el (ibuffer-jump-to-filter-group)
(ibuffer-kill-filter-group, ibuffer-kill-line)
(ibuffer-save-filter-groups, ibuffer-save-filters, filename)
(basename, file-extension, ibuffer-diff-buffer-with-file-1)
(ibuffer-mark-by-file-name-regexp)
(ibuffer-mark-by-content-regexp):
* lisp/ibuf-macs.el (ibuffer-aif, ibuffer-awhen):
* lisp/ibuffer.el (ibuffer-mouse-toggle-mark)
(ibuffer-toggle-marks, ibuffer-mark-interactive)
(ibuffer-compile-format, process, ibuffer-map-lines):
* lisp/image.el (image--compute-map)
(image--compute-original-map):
* lisp/image/exif.el (exif-parse-buffer):
* lisp/image/image-converter.el (image-convert-p, image-convert)
(image-converter--find-converter):
* lisp/image/image-dired-util.el
(image-dired-file-name-at-point):
* lisp/image/image-dired.el (image-dired-track-original-file)
(image-dired--on-file-in-dired-buffer)
(image-dired--with-thumbnail-buffer)
(image-dired-jump-original-dired-buffer)
(image-dired--slideshow-step, image-dired-display-image):
* lisp/image/wallpaper.el (wallpaper--init-action-kill)
(wallpaper--find-setter, wallpaper--find-command)
(wallpaper--find-command-args, wallpaper--x-monitor-name):
* lisp/info-look.el (info-lookup-interactive-arguments)
(info-complete)::(:mode):
* lisp/info.el (info-pop-to-buffer, Info-read-node-name-1):
* lisp/international/emoji.el (emoji--adjust-displayable-1)
(emoji--add-recent):
* lisp/jsonrpc.el (jsonrpc--call-deferred)
(jsonrpc--process-sentinel, jsonrpc--remove):
* lisp/keymap.el (keymap-local-lookup):
* lisp/mail/emacsbug.el (report-emacs-bug-hook)
(submit-emacs-patch):
* lisp/mail/ietf-drums.el (ietf-drums-parse-addresses):
* lisp/mail/mailclient.el (mailclient-send-it):
* lisp/mail/rfc6068.el (rfc6068-parse-mailto-url):
* lisp/mail/undigest.el (rmail-digest-parse-mixed-mime):
* lisp/minibuffer.el (completion-metadata-get)
(completions--after-change)
(minibuffer-visible-completions--filter):
* lisp/net/browse-url.el (browse-url-url-at-point)
(browse-url-file-url, browse-url-emacs):
* lisp/net/dbus.el (dbus-byte-array-to-string)
(dbus-monitor-goto-serial):
* lisp/net/dictionary.el (dictionary-search):
* lisp/net/eww.el (eww--download-directory)
(eww-auto-rename-buffer, eww-open-in-new-buffer, eww-submit)
(eww-follow-link, eww-read-alternate-url)
(eww-copy-alternate-url):
* lisp/net/goto-addr.el (goto-address-at-point):
* lisp/net/mailcap.el (mailcap-mime-info):
* lisp/net/rcirc.el (rcirc, rcirc-connect, rcirc-send-string)
(rcirc-kill-buffer-hook, rcirc-print, rcirc-when)
(rcirc-color-attributes, rcirc-handler-NICK)
(rcirc-handler-TAGMSG, rcirc-handler-BATCH):
* lisp/net/shr.el (shr-descend, shr-adaptive-fill-function)
(shr-correct-dom-case, shr-tag-a):
* lisp/net/sieve.el (sieve-manage-quit):
* lisp/outline.el (outline-cycle-buffer):
* lisp/pcmpl-git.el (pcmpl-git--tracked-file-predicate):
* lisp/proced.el (proced-auto-update-timer):
* lisp/progmodes/bug-reference.el
(bug-reference-try-setup-from-vc):
* lisp/progmodes/c-ts-common.el (c-ts-common--fill-paragraph):
* lisp/progmodes/c-ts-mode.el (c-ts-mode--preproc-offset)
(c-ts-mode--anchor-prev-sibling, c-ts-mode-indent-defun):
* lisp/progmodes/compile.el (compilation-error-properties)
(compilation-find-file-1):
* lisp/progmodes/eglot.el (eglot--check-object)
(eglot--read-server, eglot-upgrade-eglot)
(eglot-handle-notification, eglot--CompletionParams)
(eglot-completion-at-point, eglot--sig-info)
(eglot-register-capability):
* lisp/progmodes/elisp-mode.el
(emacs-lisp-native-compile-and-load)
(elisp-eldoc-var-docstring-with-value):
* lisp/progmodes/erts-mode.el (erts-mode--goto-start-of-test):
* lisp/progmodes/flymake.el (flymake--update-eol-overlays)
(flymake-eldoc-function):
* lisp/progmodes/gdb-mi.el (gdb-breakpoints-list-handler-custom)
(gdb-frame-handler):
* lisp/progmodes/go-ts-mode.el (go-ts-mode-docstring)
(go-ts-mode--comment-on-previous-line-p)
(go-ts-mode--get-test-regexp-at-point)
(go-ts-mode-test-this-file):
* lisp/progmodes/grep.el (lgrep, rgrep-default-command)
(grep-file-at-point):
* lisp/progmodes/perl-mode.el (perl--end-of-format-p):
* lisp/progmodes/php-ts-mode.el
(php-ts-mode--anchor-prev-sibling, php-ts-mode--indent-defun):
* lisp/progmodes/project.el (project--other-place-command)
(project--find-default-from, project--transplant-file-name)
(project-prefixed-buffer-name, project--remove-from-project-list)
(project-prompt-project-name, project-remember-projects-under)
(project--switch-project-command)
(project-uniquify-dirname-transform, project-mode-line-format):
* lisp/progmodes/python.el
(python-font-lock-keywords-maximum-decoration)
(python--treesit-fontify-union-types)
(python-shell-get-process-name, python-shell-restart)
(python-shell-completion-at-point, python-ffap-module-path)
(python-util-comint-end-of-output-p, python--import-sources)
(python-add-import, python-remove-import, python-fix-imports):
* lisp/progmodes/xref.el (xref--add-log-current-defun):
* lisp/repeat.el (repeat-echo-message-string):
* lisp/saveplace.el (save-place-dired-hook):
* lisp/server.el (server-save-buffers-kill-terminal):
* lisp/shadowfile.el (shadow-make-fullname)
(shadow-contract-file-name, shadow-define-literal-group):
* lisp/shell.el (shell-highlight-undef-mode):
* lisp/simple.el (command-completion-using-modes-p)
(command-execute, file-user-uid, file-group-gid)
(first-completion, last-completion, switch-to-completions):
* lisp/startup.el (startup--load-user-init-file):
* lisp/tab-line.el (tab-line-tabs-buffer-group-by-project):
* lisp/tar-mode.el (tar-goto-file, tar-next-file-displayer):
* lisp/term/android-win.el (android-encode-select-string)
(gui-backend-set-selection):
* lisp/term/haiku-win.el (haiku-dnd-convert-string)
(haiku-select-encode-xstring, haiku-select-encode-utf-8-string):
* lisp/textmodes/emacs-news-mode.el (emacs-news--buttonize):
* lisp/textmodes/ispell.el (ispell-completion-at-point):
* lisp/textmodes/sgml-mode.el (sgml-validate)
(html-mode--complete-at-point):
* lisp/textmodes/tex-mode.el (tex-recenter-output-buffer)
(xref-backend-references):
* lisp/thingatpt.el (thing-at-point-file-at-point)
(thing-at-point-face-at-point):
* lisp/thread.el (thread-list--get-status):
* lisp/time.el (world-clock-copy-time-as-kill, world-clock):
* lisp/touch-screen.el (touch-screen-handle-touch):
* lisp/treesit.el (treesit-language-at, treesit-node-at)
(treesit-node-on, treesit-buffer-root-node)
(treesit-node-field-name, treesit-local-parsers-at)
(treesit-local-parsers-on, treesit--cleanup-local-range-overlays)
(treesit-font-lock-recompute-features)
(treesit-font-lock-fontify-region, treesit-transpose-sexps)
(treesit-add-log-current-defun, treesit-major-mode-setup)
(treesit--explorer-refresh, treesit-install-language-grammar):
* lisp/url/url.el (url-retrieve-synchronously):
* lisp/vc/smerge-mode.el (smerge-diff):
* lisp/vc/vc-dir.el (vc-dir):
* lisp/vc/vc-dispatcher.el (vc-do-async-command):
* lisp/vc/vc-git.el (vc-git-dir--branch-headers)
(vc-git-dir--stash-headers, vc-git--log-edit-summary-check)
(vc-git-stash-list):
* lisp/vc/vc.el (vc-responsible-backend, vc-buffer-sync-fileset)
(vc-clone):
* lisp/visual-wrap.el (visual-wrap--apply-to-line):
* lisp/wid-edit.el (widget-text)
(widget-editable-list-insert-before):
* lisp/window-tool-bar.el
(window-tool-bar--keymap-entry-to-string):
* lisp/window.el (display-buffer, display-buffer-full-frame)
(window-point-context-set, window-point-context-use)
(window-point-context-use-default-function):
* lisp/xdg.el (xdg-current-desktop):
* lisp/xwidget.el (xwidget-webkit-callback):
* lisp/yank-media.el (yank-media--get-selection)
(yank-media-types):
* test/lisp/comint-tests.el
(comint-tests/test-password-function):
* test/lisp/completion-preview-tests.el
(completion-preview-tests--capf):
* test/lisp/cus-edit-tests.el (with-cus-edit-test):
* test/lisp/erc/erc-scenarios-base-local-modules.el
(-phony-sblm-):
* test/lisp/erc/erc-scenarios-stamp.el
(erc-scenarios-stamp--on-post-modify):
* test/lisp/erc/erc-services-tests.el
(erc-services-tests--asp-parse-entry):
* test/lisp/erc/erc-tests.el (erc-modules--internal-property)
(erc--find-mode, erc-tests--update-modules):
* test/lisp/erc/resources/erc-d/erc-d-i.el
(erc-d-i--parse-message):
* test/lisp/erc/resources/erc-d/erc-d-t.el
(erc-d-t-kill-related-buffers, erc-d-t-with-cleanup):
* test/lisp/erc/resources/erc-d/erc-d-tests.el
(erc-d-i--parse-message--irc-parser-tests):
* test/lisp/erc/resources/erc-d/erc-d-u.el
(erc-d-u--read-exchange-slowly):
* test/lisp/erc/resources/erc-d/erc-d.el (erc-d--expire)
(erc-d--finalize-done, erc-d--command-handle-all):
* test/lisp/erc/resources/erc-scenarios-common.el
(erc-scenarios-common-with-cleanup):
* test/lisp/erc/resources/erc-tests-common.el
(erc-tests--common-display-message)
(erc-tests-common-create-subprocess):
* test/lisp/ibuffer-tests.el (ibuffer-test-Bug25058):
* test/lisp/international/mule-tests.el
(mule-cmds-tests--ucs-names-missing-names):
* test/lisp/progmodes/python-tests.el
(python-tests-get-shell-interpreter)
(python-tests--get-interpreter-info):
* test/lisp/progmodes/ruby-ts-mode-tests.el
(ruby-ts-resource-file):
* test/lisp/replace-tests.el (replace-tests-with-undo):
* test/src/emacs-tests.el (emacs-tests--seccomp-debug):
* test/src/process-tests.el (process-tests--emacs-command)
(process-tests--emacs-binary, process-tests--dump-file):
* test/src/treesit-tests.el (treesit--ert-test-defun-navigation):
Replace use of the now-obsolete if-let and when-let.
2024-10-24 16:50:07 +08:00
|
|
|
|
(if-let* ((handler (browse-url-select-handler leftover
|
|
|
|
|
'internal)))
|
2023-10-26 11:37:58 +00:00
|
|
|
|
(funcall handler leftover action)
|
|
|
|
|
(dnd-insert-text window action leftover)))
|
|
|
|
|
(or return-value 'private))))
|
2005-04-11 19:29:10 +00:00
|
|
|
|
|
|
|
|
|
(defun dnd-get-local-file-uri (uri)
|
|
|
|
|
"Return an uri converted to file:/// syntax if uri is a local file.
|
|
|
|
|
Return nil if URI is not a local file."
|
|
|
|
|
|
|
|
|
|
;; The hostname may be our hostname, in that case, convert to a local
|
|
|
|
|
;; file. Otherwise return nil. TODO: How about an IP-address as hostname?
|
2014-12-29 12:39:58 -08:00
|
|
|
|
(let ((sysname (system-name)))
|
2014-12-29 12:37:53 -08:00
|
|
|
|
(let ((hostname (when (string-match "^file://\\([^/]*\\)" uri)
|
2005-04-11 19:29:10 +00:00
|
|
|
|
(downcase (match-string 1 uri))))
|
2014-12-29 12:39:58 -08:00
|
|
|
|
(sysname-no-dot
|
|
|
|
|
(downcase (if (string-match "^[^\\.]+" sysname)
|
|
|
|
|
(match-string 0 sysname)
|
|
|
|
|
sysname))))
|
2014-12-29 12:37:53 -08:00
|
|
|
|
(when (and hostname
|
2019-03-02 20:07:36 +02:00
|
|
|
|
(not (eq system-type 'windows-nt))
|
2014-12-29 12:37:53 -08:00
|
|
|
|
(or (string-equal "localhost" hostname)
|
2014-12-29 12:39:58 -08:00
|
|
|
|
(string-equal (downcase sysname) hostname)
|
|
|
|
|
(string-equal sysname-no-dot hostname)))
|
2014-12-29 12:37:53 -08:00
|
|
|
|
(concat "file://" (substring uri (+ 7 (length hostname))))))))
|
2005-04-11 19:29:10 +00:00
|
|
|
|
|
2023-10-14 10:15:20 +08:00
|
|
|
|
(defvar dnd-unescape-file-uris t
|
|
|
|
|
"Whether to unescape file: URIs before they are opened.
|
|
|
|
|
Bind this to nil when providing `dnd-get-local-file-name' with a
|
|
|
|
|
file name that may incorporate URI escape sequences.")
|
|
|
|
|
|
2020-09-09 13:33:15 -04:00
|
|
|
|
(defun dnd--unescape-uri (uri)
|
|
|
|
|
;; Merge with corresponding code in URL library.
|
2010-12-20 21:11:01 +01:00
|
|
|
|
(replace-regexp-in-string
|
Replace manually crafted hex regexes with [:xdigit:]
* admin/charsets/mapconv:
* build-aux/gitlog-to-changelog (parse_amend_file, git_dir_option):
* lisp/progmodes/verilog-mode.el (verilog-delay-re):
(verilog-type-font-keywords, verilog-read-always-signals-recurse):
(verilog-is-number):
* lisp/progmodes/vera-mode.el (vera-font-lock-keywords):
* test/src/emacs-module-tests.el (mod-test-sum-test):
* lisp/xml.el: (xml--entity-replacement-text):
* lisp/version.el (emacs-repository-version-git):
* lisp/textmodes/sgml-mode.el (sgml-quote):
* lisp/textmodes/css-mode.el (css-escapes-re)
(css--colors-regexp):
* lisp/progmodes/prolog.el (prolog-syntax-propertize-function):
* lisp/progmodes/hideif.el (hif-token-regexp, hif-tokenize):
* lisp/progmodes/ebnf-dtd.el: (ebnf-dtd-attlistdecl)
(ebnf-dtd-entitydecl, ebnf-dtd-lex):
* lisp/progmodes/ebnf-ebx.el (ebnf-ebx-hex-character):
* lisp/progmodes/ebnf-abn.el (ebnf-abn-character):
* lisp/progmodes/cperl-mode.el (cperl-highlight-charclass)
(cperl-find-pods-heres):
* lisp/progmodes/cc-mode.el (c-maybe-quoted-number-head)
(c-maybe-quoted-number, c-parse-quotes-before-change)
(c-parse-quotes-after-change, c-quoted-number-head-before-point)
(c-quoted-number-straddling-point):
* lisp/progmodes/ada-mode.el (featurep, ada-in-numeric-literal-p)
(ada-font-lock-keywords):
* lisp/org/org-mobile.el (org-mobile-copy-agenda-files)
* lisp/org/org-table.el (org-table-number-regexp):
(org-mobile-update-checksum-for-capture-file):
* lisp/nxml/xsd-regexp.el (xsdre-gen-categories):
* lisp/nxml/xmltok.el (let*):
* lisp/nxml/rng-xsd.el (rng-xsd-convert-hex-binary)
(rng-xsd-convert-any-uri):
* lisp/nxml/rng-uri.el (rng-uri-file-name-1)
(rng-uri-unescape-multibyte, rng-uri-unescape-unibyte)
(rng-uri-unescape-unibyte-match)
(rng-uri-unescape-unibyte-replace):
* lisp/nxml/rng-cmpct.el (rng-c-process-escapes):
* lisp/nxml/nxml-maint.el (nxml-insert-target-repertoire-glyph-set):
* lisp/net/shr-color.el (shr-color->hexadecimal):
* lisp/mail/rfc2231.el (rfc2231-decode-encoded-string):
* lisp/international/mule-cmds.el (read-char-by-name):
* lisp/htmlfontify.el (hfy-hex-regex):
* lisp/gnus/nneething.el (nneething-decode-file-name):
* lisp/gnus/mml-sec.el (mml-secure-find-usable-keys):
* lisp/gnus/gnus-art.el (gnus-button-mid-or-mail-heuristic-alist):
* lisp/faces.el (read-color):
* lisp/epg.el (epg--status-ERRSIG, epg--status-VALIDSIG)
(epg--status-SIG_CREATED, epg--decode-percent-escape)
(epg--decode-hexstring, epg--decode-quotedstring)
(epg-dn-from-string):
* lisp/emulation/cua-rect.el (cua-incr-rectangle):
* lisp/dnd.el (dnd-unescape-uri):
* lisp/cedet/semantic/lex.el (semantic-lex-number-expression):
* lisp/cedet/semantic/java.el (semantic-java-number-regexp):
* lisp/calc/calc-lang.el (pascal):
* lisp/calc/calc-ext.el (math-read-number-fancy):
* lisp/calc/calc-aent.el (math-read-token):
Replace various combinations of [0-9a-fA-F] with [[:xdigit:]].
(Bug#36167)
2019-06-13 03:18:43 +03:00
|
|
|
|
"%[[:xdigit:]][[:xdigit:]]"
|
2010-12-20 21:11:01 +01:00
|
|
|
|
(lambda (arg)
|
|
|
|
|
(let ((str (make-string 1 0)))
|
|
|
|
|
(aset str 0 (string-to-number (substring arg 1) 16))
|
|
|
|
|
str))
|
|
|
|
|
uri t t))
|
|
|
|
|
|
2017-11-25 22:45:41 -08:00
|
|
|
|
;; https://lists.gnu.org/r/emacs-devel/2006-05/msg01060.html
|
2005-04-11 19:29:10 +00:00
|
|
|
|
(defun dnd-get-local-file-name (uri &optional must-exist)
|
|
|
|
|
"Return file name converted from file:/// or file: syntax.
|
|
|
|
|
URI is the uri for the file. If MUST-EXIST is given and non-nil,
|
|
|
|
|
only return non-nil if the file exists.
|
|
|
|
|
Return nil if URI is not a local file."
|
|
|
|
|
(let ((f (cond ((string-match "^file:///" uri) ; XDND format.
|
|
|
|
|
(substring uri (1- (match-end 0))))
|
|
|
|
|
((string-match "^file:" uri) ; Old KDE, Motif, Sun
|
2013-12-03 14:21:13 +02:00
|
|
|
|
(substring uri (match-end 0)))))
|
|
|
|
|
(coding (if (equal system-type 'windows-nt)
|
|
|
|
|
;; W32 pretends that file names are UTF-8 encoded.
|
|
|
|
|
'utf-8
|
|
|
|
|
(or file-name-coding-system
|
|
|
|
|
default-file-name-coding-system))))
|
2023-10-14 10:15:20 +08:00
|
|
|
|
(and f (setq f (decode-coding-string
|
|
|
|
|
(if dnd-unescape-file-uris
|
|
|
|
|
(dnd--unescape-uri f) f)
|
|
|
|
|
coding)))
|
2010-12-20 21:11:01 +01:00
|
|
|
|
(when (and f must-exist (not (file-readable-p f)))
|
|
|
|
|
(setq f nil))
|
2010-10-02 21:27:39 -04:00
|
|
|
|
f))
|
2005-04-11 19:29:10 +00:00
|
|
|
|
|
2011-04-19 15:44:55 +02:00
|
|
|
|
(defun dnd-open-local-file (uri _action)
|
2005-04-11 19:29:10 +00:00
|
|
|
|
"Open a local file.
|
|
|
|
|
The file is opened in the current window, or a new window if
|
|
|
|
|
`dnd-open-file-other-window' is set. URI is the url for the file,
|
|
|
|
|
and must have the format file:file-name or file:///file-name.
|
2006-09-15 23:53:48 +00:00
|
|
|
|
The last / in file:/// is part of the file name. If the system
|
|
|
|
|
natively supports unc file names, then remote urls of the form
|
|
|
|
|
file://server-name/file-name will also be handled by this function.
|
|
|
|
|
An alternative for systems that do not support unc file names is
|
lisp/*.el, src/*.c: Fix typos in docstrings
* lisp/apropos.el (apropos-do-all):
* lisp/auth-source-pass.el (auth-source-pass--select-from-entries):
* lisp/auth-source.el (auth-source-user-or-password):
* lisp/calc/calc-forms.el (math-tzone-names):
* lisp/calendar/diary-lib.el (diary-face-attrs)
(diary-mark-entries-1):
* lisp/cedet/cedet-files.el (cedet-files-list-recursively):
* lisp/cedet/ede.el (ede-constructing, ede-deep-rescan):
* lisp/cedet/ede/cpp-root.el (ede-cpp-root-header-file-p):
* lisp/cedet/ede/proj.el (ede-proj-target-makefile):
* lisp/cedet/inversion.el (inversion-check-version)
(inversion-test):
* lisp/cedet/mode-local.el (mode-local-map-file-buffers):
* lisp/cedet/semantic/complete.el (semantic-displayer-ghost):
* lisp/cedet/semantic/db-find.el (semanticdb-find-translate-path-default):
* lisp/cedet/semantic/db.el (semanticdb-table)
(semanticdb-search-system-databases):
* lisp/cedet/semantic/imenu.el (semantic-imenu-index-directory):
* lisp/cedet/semantic/java.el (semantic-java-doc-keywords-map):
* lisp/cedet/semantic/lex-spp.el (semantic-lex-spp-use-headers-flag):
* lisp/cedet/semantic/lex.el (semantic-lex-make-keyword-table)
(semantic-lex-make-type-table, semantic-lex-debug-analyzers):
* lisp/cedet/semantic/tag-ls.el (semantic-tag-abstract-p)
(semantic-tag-leaf-p, semantic-tag-static-p)
(semantic-tag-prototype-p):
* lisp/dnd.el (dnd-open-remote-file-function, dnd-open-local-file):
* lisp/emacs-lisp/eieio-opt.el (eieio-build-class-alist)
(eieio-read-class, eieio-read-subclass):
* lisp/emacs-lisp/generator.el (cps--replace-variable-references)
(cps--handle-loop-for):
* lisp/erc/erc-dcc.el (erc-dcc-list, erc-dcc-member, erc-dcc-server)
(erc-dcc-auto-mask-p, erc-dcc-get-file, erc-dcc-chat-accept):
* lisp/eshell/em-pred.el (eshell-pred-file-type):
* lisp/faces.el (defined-colors-with-face-attributes):
* lisp/font-core.el (font-lock-mode):
* lisp/frame.el (frame-restack):
* lisp/net/shr.el (shr-image-animate):
* lisp/org/org-agenda.el (org-agenda-change-all-lines)
(org-agenda-today-p):
* lisp/org/org-id.el (org-id-get):
* lisp/org/org.el (org-highlight-latex-and-related)
(org--valid-property-p):
* lisp/org/ox-beamer.el (org-beamer--get-label):
* lisp/org/ox-latex.el (org-latex--caption-above-p):
* lisp/org/ox-odt.el (org-odt--copy-image-file)
(org-odt--copy-formula-file):
* lisp/org/ox.el (org-export-with-timestamps):
* lisp/progmodes/verilog-mode.el (verilog-indent-declaration-macros):
* lisp/ses.el (ses-file-format-extend-parameter-list):
* lisp/term.el (ansi-term):
* lisp/textmodes/bibtex.el (bibtex-no-opt-remove-re)
(bibtex-beginning-of-first-entry, bibtex-autokey-get-title)
(bibtex-read-key, bibtex-initialize):
* lisp/textmodes/flyspell.el (flyspell-word):
* lisp/view.el (view-mode-exit):
* src/composite.c:
* src/floatfns.c (Fisnan): Fix typos in docstrings.
2019-09-19 04:32:25 +02:00
|
|
|
|
`dnd-open-remote-url'. ACTION is ignored."
|
2005-04-11 19:29:10 +00:00
|
|
|
|
|
|
|
|
|
(let* ((f (dnd-get-local-file-name uri t)))
|
|
|
|
|
(if (and f (file-readable-p f))
|
|
|
|
|
(progn
|
|
|
|
|
(if dnd-open-file-other-window
|
|
|
|
|
(find-file-other-window f)
|
|
|
|
|
(find-file f))
|
2021-07-20 13:48:10 +02:00
|
|
|
|
(file-name-history--add f)
|
2005-04-11 19:29:10 +00:00
|
|
|
|
'private)
|
|
|
|
|
(error "Can not read %s" uri))))
|
|
|
|
|
|
2011-04-19 15:44:55 +02:00
|
|
|
|
(defun dnd-open-remote-url (uri _action)
|
2006-09-07 07:44:33 +00:00
|
|
|
|
"Open a remote file with `find-file' and `url-handler-mode'.
|
|
|
|
|
Turns `url-handler-mode' on if not on before. The file is opened in the
|
|
|
|
|
current window, or a new window if `dnd-open-file-other-window' is set.
|
|
|
|
|
URI is the url for the file. ACTION is ignored."
|
|
|
|
|
(progn
|
2006-09-07 10:12:51 +00:00
|
|
|
|
(require 'url-handlers)
|
2006-09-07 07:44:33 +00:00
|
|
|
|
(or url-handler-mode (url-handler-mode))
|
|
|
|
|
(if dnd-open-file-other-window
|
|
|
|
|
(find-file-other-window uri)
|
|
|
|
|
(find-file uri))
|
|
|
|
|
'private))
|
|
|
|
|
|
|
|
|
|
|
2005-04-11 19:29:10 +00:00
|
|
|
|
(defun dnd-open-file (uri action)
|
|
|
|
|
"Open a local or remote file.
|
|
|
|
|
The file is opened in the current window, or a new window if
|
|
|
|
|
`dnd-open-file-other-window' is set. URI is the url for the file,
|
|
|
|
|
and must have the format file://hostname/file-name. ACTION is ignored.
|
|
|
|
|
The last / in file://hostname/ is part of the file name."
|
|
|
|
|
|
|
|
|
|
;; The hostname may be our hostname, in that case, convert to a local
|
|
|
|
|
;; file. Otherwise return nil.
|
|
|
|
|
(let ((local-file (dnd-get-local-file-uri uri)))
|
|
|
|
|
(if local-file (dnd-open-local-file local-file action)
|
2006-09-07 07:44:33 +00:00
|
|
|
|
(if dnd-open-remote-file-function
|
|
|
|
|
(funcall dnd-open-remote-file-function uri action)
|
|
|
|
|
(error "Remote files not supported")))))
|
2005-04-11 19:29:10 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun 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."
|
|
|
|
|
(if (or buffer-read-only
|
|
|
|
|
(not (windowp window)))
|
|
|
|
|
(progn
|
|
|
|
|
(kill-new text)
|
2005-09-18 12:25:02 +00:00
|
|
|
|
(message "%s"
|
2005-04-11 19:29:10 +00:00
|
|
|
|
(substitute-command-keys
|
|
|
|
|
"The dropped text can be accessed with \\[yank]")))
|
|
|
|
|
(insert text))
|
|
|
|
|
action)
|
|
|
|
|
|
2022-06-03 12:32:17 +08:00
|
|
|
|
|
|
|
|
|
;;; Functions for dragging stuff to other programs. These build upon
|
|
|
|
|
;;; the lower-level `x-begin-drag' interface, but take care of data
|
|
|
|
|
;;; types and abstracting around the different return values.
|
|
|
|
|
|
|
|
|
|
(defvar dnd-last-dragged-remote-file nil
|
|
|
|
|
"If non-nil, the name of a local copy of the last remote file that was dragged.
|
2022-06-03 19:43:06 +08:00
|
|
|
|
This may also be a list of files, if multiple files were dragged.
|
2022-06-03 12:32:17 +08:00
|
|
|
|
It can't be removed immediately after the drag-and-drop operation
|
|
|
|
|
completes, since there is no way to determine when the drop
|
|
|
|
|
target has finished opening it. So instead, this file is removed
|
|
|
|
|
when Emacs exits or the user drags another file.")
|
|
|
|
|
|
|
|
|
|
(defun dnd-remove-last-dragged-remote-file ()
|
2022-06-03 19:43:06 +08:00
|
|
|
|
"Remove the local copy of the last remote file to be dragged.
|
|
|
|
|
If `dnd-last-dragged-remote-file' is a list, remove all the files
|
|
|
|
|
in that list instead."
|
2022-06-03 12:32:17 +08:00
|
|
|
|
(when dnd-last-dragged-remote-file
|
|
|
|
|
(unwind-protect
|
2022-06-03 19:43:06 +08:00
|
|
|
|
(if (consp dnd-last-dragged-remote-file)
|
|
|
|
|
(mapc #'delete-file dnd-last-dragged-remote-file)
|
|
|
|
|
(delete-file dnd-last-dragged-remote-file))
|
2022-06-03 12:32:17 +08:00
|
|
|
|
(setq dnd-last-dragged-remote-file nil)))
|
2022-06-03 19:43:06 +08:00
|
|
|
|
(remove-hook 'kill-emacs-hook
|
|
|
|
|
#'dnd-remove-last-dragged-remote-file))
|
2022-06-03 12:32:17 +08:00
|
|
|
|
|
|
|
|
|
(declare-function x-begin-drag "xfns.c")
|
|
|
|
|
|
|
|
|
|
(defun dnd-begin-text-drag (text &optional frame action allow-same-frame)
|
|
|
|
|
"Begin dragging TEXT from FRAME.
|
2022-11-18 15:48:22 +01:00
|
|
|
|
Initiate a drag-and-drop operation allowing the user to drag text
|
2022-06-03 12:32:17 +08:00
|
|
|
|
from Emacs to another program (the drop target), then block until
|
2022-07-14 11:55:52 +02:00
|
|
|
|
the drop is completed or is canceled.
|
2022-06-03 12:32:17 +08:00
|
|
|
|
|
2022-06-03 14:50:11 +03:00
|
|
|
|
If the drop completed, return the action that the drop target
|
|
|
|
|
actually performed, which can be one of the following symbols:
|
2022-06-03 12:32:17 +08:00
|
|
|
|
|
|
|
|
|
- `copy', which means TEXT was inserted by the drop target.
|
|
|
|
|
|
|
|
|
|
- `move', which means TEXT was inserted, and the caller should
|
|
|
|
|
additionally delete TEXT from its source (such as the buffer
|
|
|
|
|
where it originated).
|
|
|
|
|
|
|
|
|
|
- `private', which means the drop target chose to perform an
|
|
|
|
|
unspecified action.
|
|
|
|
|
|
2022-07-14 11:55:52 +02:00
|
|
|
|
Return nil if the drop was canceled.
|
2022-06-03 12:32:17 +08:00
|
|
|
|
|
|
|
|
|
TEXT is a string containing text that will be inserted by the
|
|
|
|
|
program where the drop happened. FRAME is the frame where the
|
2022-06-03 14:50:11 +03:00
|
|
|
|
mouse is currently held down, or nil, which stands for the
|
|
|
|
|
current frame. ACTION is one of the symbols `copy' or `move',
|
2022-06-03 12:32:17 +08:00
|
|
|
|
where `copy' means that the text should be inserted by the drop
|
2022-07-01 18:03:57 +02:00
|
|
|
|
target, and `move' means the same as `copy', but in addition
|
2022-06-03 12:32:17 +08:00
|
|
|
|
the caller might have to delete TEXT from its source after this
|
2022-06-03 14:50:11 +03:00
|
|
|
|
function returns. If ALLOW-SAME-FRAME is nil, ignore any drops
|
|
|
|
|
on FRAME itself.
|
2022-06-03 12:32:17 +08:00
|
|
|
|
|
|
|
|
|
This function might return immediately if no mouse buttons are
|
|
|
|
|
currently being held down. It should only be called upon a
|
2024-03-16 12:58:33 +02:00
|
|
|
|
`down-mouse-1' (or similar) event.
|
|
|
|
|
|
|
|
|
|
This function is only supported on X Windows, macOS/GNUstep, and Haiku;
|
|
|
|
|
on all other platforms it will signal an error."
|
2022-06-03 12:32:17 +08:00
|
|
|
|
(unless (fboundp 'x-begin-drag)
|
|
|
|
|
(error "Dragging text from Emacs is not supported by this window system"))
|
|
|
|
|
(gui-set-selection 'XdndSelection text)
|
|
|
|
|
(unless action
|
|
|
|
|
(setq action 'copy))
|
|
|
|
|
(let ((return-value
|
|
|
|
|
(x-begin-drag '(;; Traditional X selection targets used by GTK, the
|
|
|
|
|
;; Motif drag-and-drop protocols, and programs like
|
|
|
|
|
;; Xterm. `STRING' is also used on NS and Haiku.
|
|
|
|
|
"STRING" "TEXT" "COMPOUND_TEXT" "UTF8_STRING"
|
|
|
|
|
;; Used by Xdnd clients that strictly comply with
|
|
|
|
|
;; the standard (i.e. Qt programs).
|
|
|
|
|
"text/plain" "text/plain;charset=utf-8")
|
|
|
|
|
(cl-ecase action
|
2022-09-13 18:19:26 +02:00
|
|
|
|
(copy 'XdndActionCopy)
|
|
|
|
|
(move 'XdndActionMove))
|
2022-06-03 12:32:17 +08:00
|
|
|
|
frame nil allow-same-frame)))
|
|
|
|
|
(cond
|
|
|
|
|
((eq return-value 'XdndActionCopy) 'copy)
|
|
|
|
|
((eq return-value 'XdndActionMove) 'move)
|
|
|
|
|
((not return-value) nil)
|
|
|
|
|
(t 'private))))
|
|
|
|
|
|
|
|
|
|
(defun dnd-begin-file-drag (file &optional frame action allow-same-frame)
|
|
|
|
|
"Begin dragging FILE from FRAME.
|
2022-11-18 15:48:22 +01:00
|
|
|
|
Initiate a drag-and-drop operation allowing the user to drag a file
|
2022-06-03 12:32:17 +08:00
|
|
|
|
from Emacs to another program (the drop target), then block until
|
2022-07-14 11:55:52 +02:00
|
|
|
|
the drop happens or is canceled.
|
2022-06-03 12:32:17 +08:00
|
|
|
|
|
|
|
|
|
Return the action that the drop target actually performed, which
|
|
|
|
|
can be one of the following symbols:
|
|
|
|
|
|
|
|
|
|
- `copy', which means FILE was opened by the drop target.
|
|
|
|
|
|
|
|
|
|
- `move', which means FILE was moved to another location by the
|
|
|
|
|
drop target.
|
|
|
|
|
|
|
|
|
|
- `link', which means a symbolic link was created to FILE by
|
|
|
|
|
the drop target, usually a file manager.
|
|
|
|
|
|
|
|
|
|
- `private', which means the drop target chose to perform an
|
|
|
|
|
unspecified action.
|
|
|
|
|
|
2022-07-14 11:55:52 +02:00
|
|
|
|
Return nil if the drop was canceled.
|
2022-06-03 12:32:17 +08:00
|
|
|
|
|
2022-06-03 14:50:11 +03:00
|
|
|
|
FILE is the file name that will be sent to the program where the
|
|
|
|
|
drop happened. If it is a remote file, Emacs will make a
|
|
|
|
|
temporary copy and pass that. FRAME is the frame where the mouse
|
|
|
|
|
is currently held down, or nil (which means to use the current
|
|
|
|
|
frame). ACTION is one of the symbols `copy', `move' or `link',
|
|
|
|
|
where `copy' means that the file should be opened or copied by
|
|
|
|
|
the drop target, `move' means the drop target should move the
|
|
|
|
|
file to another location, and `link' means the drop target should
|
|
|
|
|
create a symbolic link to FILE. It is an error to specify `link'
|
|
|
|
|
as the action if FILE is a remote file. If ALLOW-SAME-FRAME is
|
|
|
|
|
nil, any drops on FRAME itself will be ignored.
|
2022-06-03 12:32:17 +08:00
|
|
|
|
|
|
|
|
|
This function might return immediately if no mouse buttons are
|
|
|
|
|
currently being held down. It should only be called upon a
|
2024-03-16 12:58:33 +02:00
|
|
|
|
`down-mouse-1' (or similar) event.
|
|
|
|
|
|
|
|
|
|
This function is only supported on X Windows, macOS/GNUstep, and Haiku;
|
|
|
|
|
on all other platforms it will signal an error."
|
2022-06-03 12:32:17 +08:00
|
|
|
|
(unless (fboundp 'x-begin-drag)
|
|
|
|
|
(error "Dragging files from Emacs is not supported by this window system"))
|
|
|
|
|
(dnd-remove-last-dragged-remote-file)
|
|
|
|
|
(unless action
|
|
|
|
|
(setq action 'copy))
|
2022-06-29 20:10:25 +08:00
|
|
|
|
(if (and (or (and (eq dnd-direct-save-remote-files 'x)
|
|
|
|
|
(eq (framep (or frame
|
|
|
|
|
(selected-frame)))
|
|
|
|
|
'x))
|
|
|
|
|
(and dnd-direct-save-remote-files
|
|
|
|
|
(not (eq dnd-direct-save-remote-files 'x))))
|
|
|
|
|
(eq action 'copy)
|
|
|
|
|
(file-remote-p file))
|
|
|
|
|
(dnd-direct-save file (file-name-nondirectory file)
|
|
|
|
|
frame allow-same-frame)
|
|
|
|
|
(let ((original-file file))
|
|
|
|
|
(when (file-remote-p file)
|
|
|
|
|
(if (eq action 'link)
|
|
|
|
|
(error "Cannot create symbolic link to remote file")
|
|
|
|
|
(setq file (file-local-copy file))
|
|
|
|
|
(setq dnd-last-dragged-remote-file file)
|
|
|
|
|
(add-hook 'kill-emacs-hook
|
|
|
|
|
#'dnd-remove-last-dragged-remote-file)))
|
|
|
|
|
(gui-set-selection 'XdndSelection
|
|
|
|
|
(propertize (expand-file-name file) 'text/uri-list
|
|
|
|
|
(concat "file://"
|
|
|
|
|
(expand-file-name file))))
|
|
|
|
|
(let ((return-value
|
|
|
|
|
(x-begin-drag '(;; Xdnd types used by GTK, Qt, and most other
|
|
|
|
|
;; modern programs that expect filenames to
|
|
|
|
|
;; be supplied as URIs.
|
|
|
|
|
"text/uri-list" "text/x-xdnd-username"
|
|
|
|
|
;; Traditional X selection targets used by
|
|
|
|
|
;; programs supporting the Motif
|
|
|
|
|
;; drag-and-drop protocols. Also used by NS
|
|
|
|
|
;; and Haiku.
|
|
|
|
|
"FILE_NAME" "FILE" "HOST_NAME"
|
|
|
|
|
;; ToolTalk filename. Mostly used by CDE
|
|
|
|
|
;; programs.
|
|
|
|
|
"_DT_NETFILE")
|
|
|
|
|
(cl-ecase action
|
2022-09-13 18:19:26 +02:00
|
|
|
|
(copy 'XdndActionCopy)
|
|
|
|
|
(move 'XdndActionMove)
|
|
|
|
|
(link 'XdndActionLink))
|
2022-06-29 20:10:25 +08:00
|
|
|
|
frame nil allow-same-frame)))
|
|
|
|
|
(cond
|
|
|
|
|
((eq return-value 'XdndActionCopy) 'copy)
|
|
|
|
|
((eq return-value 'XdndActionMove)
|
|
|
|
|
(prog1 'move
|
|
|
|
|
;; If original-file is a remote file, delete it from the
|
|
|
|
|
;; remote as well.
|
|
|
|
|
(when (file-remote-p original-file)
|
|
|
|
|
(ignore-errors
|
|
|
|
|
(delete-file original-file)))))
|
|
|
|
|
((eq return-value 'XdndActionLink) 'link)
|
|
|
|
|
((not return-value) nil)
|
|
|
|
|
(t 'private))))))
|
2005-04-11 19:29:10 +00:00
|
|
|
|
|
2022-06-03 19:43:06 +08:00
|
|
|
|
(defun dnd-begin-drag-files (files &optional frame action allow-same-frame)
|
|
|
|
|
"Begin dragging FILES from FRAME.
|
|
|
|
|
This is like `dnd-begin-file-drag', except with multiple files.
|
|
|
|
|
FRAME, ACTION and ALLOW-SAME-FRAME mean the same as in
|
|
|
|
|
`dnd-begin-file-drag'.
|
|
|
|
|
|
|
|
|
|
FILES is a list of files that will be dragged. If the drop
|
|
|
|
|
target doesn't support dropping multiple files, the first file in
|
2024-03-16 12:58:33 +02:00
|
|
|
|
FILES will be dragged.
|
|
|
|
|
|
|
|
|
|
This function is only supported on X Windows, macOS/GNUstep, and Haiku;
|
|
|
|
|
on all other platforms it will signal an error."
|
2022-06-03 19:43:06 +08:00
|
|
|
|
(unless (fboundp 'x-begin-drag)
|
|
|
|
|
(error "Dragging files from Emacs is not supported by this window system"))
|
|
|
|
|
(dnd-remove-last-dragged-remote-file)
|
|
|
|
|
(let* ((new-files (copy-sequence files))
|
|
|
|
|
(tem new-files))
|
|
|
|
|
(while tem
|
|
|
|
|
(setcar tem (expand-file-name (car tem)))
|
|
|
|
|
(when (file-remote-p (car tem))
|
|
|
|
|
(when (eq action 'link)
|
|
|
|
|
(error "Cannot create symbolic link to remote file"))
|
2022-06-06 19:05:36 +08:00
|
|
|
|
(condition-case error
|
|
|
|
|
(progn (setcar tem (file-local-copy (car tem)))
|
|
|
|
|
(push (car tem) dnd-last-dragged-remote-file))
|
|
|
|
|
(error (message "Failed to download file: %s" error)
|
|
|
|
|
(setcar tem nil))))
|
2022-06-03 19:43:06 +08:00
|
|
|
|
(setq tem (cdr tem)))
|
2022-06-29 20:10:25 +08:00
|
|
|
|
(when dnd-last-dragged-remote-file
|
|
|
|
|
(add-hook 'kill-emacs-hook
|
|
|
|
|
#'dnd-remove-last-dragged-remote-file))
|
2022-06-06 19:05:36 +08:00
|
|
|
|
;; Remove any files that failed to download from a remote host.
|
|
|
|
|
(setq new-files (delq nil new-files))
|
|
|
|
|
(unless new-files
|
|
|
|
|
(error "No files were specified or no remote file could be downloaded"))
|
2022-06-03 19:43:06 +08:00
|
|
|
|
(unless action
|
|
|
|
|
(setq action 'copy))
|
|
|
|
|
(gui-set-selection 'XdndSelection
|
|
|
|
|
(propertize (car new-files)
|
|
|
|
|
'text/uri-list
|
|
|
|
|
(cl-loop for file in new-files
|
|
|
|
|
collect (concat "file://" file)
|
|
|
|
|
into targets finally return
|
|
|
|
|
(apply #'vector targets))
|
|
|
|
|
'FILE_NAME (apply #'vector new-files)))
|
|
|
|
|
(let ((return-value
|
|
|
|
|
(x-begin-drag '(;; Xdnd types used by GTK, Qt, and most other
|
|
|
|
|
;; modern programs that expect filenames to
|
|
|
|
|
;; be supplied as URIs.
|
2022-06-08 10:40:20 +08:00
|
|
|
|
"text/uri-list" "text/x-xdnd-username"
|
2022-06-03 19:43:06 +08:00
|
|
|
|
;; Traditional X selection targets used by
|
|
|
|
|
;; programs supporting the Motif
|
|
|
|
|
;; drag-and-drop protocols. Also used by NS
|
|
|
|
|
;; and Haiku.
|
|
|
|
|
"FILE_NAME" "HOST_NAME")
|
|
|
|
|
(cl-ecase action
|
2022-09-13 18:19:26 +02:00
|
|
|
|
(copy 'XdndActionCopy)
|
|
|
|
|
(move 'XdndActionMove)
|
|
|
|
|
(link 'XdndActionLink))
|
2022-06-03 19:43:06 +08:00
|
|
|
|
frame nil allow-same-frame)))
|
|
|
|
|
(cond
|
|
|
|
|
((eq return-value 'XdndActionCopy) 'copy)
|
|
|
|
|
((eq return-value 'XdndActionMove)
|
|
|
|
|
(prog1 'move
|
|
|
|
|
;; If original-file is a remote file, delete it from the
|
|
|
|
|
;; remote as well.
|
|
|
|
|
(dolist (original-file files)
|
|
|
|
|
(when (file-remote-p original-file)
|
|
|
|
|
(ignore-errors
|
|
|
|
|
(delete-file original-file))))))
|
|
|
|
|
((eq return-value 'XdndActionLink) 'link)
|
|
|
|
|
((not return-value) nil)
|
|
|
|
|
(t 'private)))))
|
|
|
|
|
|
2022-06-29 20:10:25 +08:00
|
|
|
|
(declare-function x-dnd-do-direct-save "x-dnd.el")
|
|
|
|
|
|
|
|
|
|
(defun dnd-direct-save (file name &optional frame allow-same-frame)
|
|
|
|
|
"Drag FILE from FRAME, but do not treat it as an actual file.
|
|
|
|
|
Instead, ask the target window to insert the file with NAME.
|
|
|
|
|
File managers will create a file in the displayed directory with
|
|
|
|
|
the contents of FILE and the name NAME, while text editors will
|
|
|
|
|
insert the contents of FILE in a new document named
|
|
|
|
|
NAME.
|
|
|
|
|
|
|
|
|
|
ALLOW-SAME-FRAME means the same as in `dnd-begin-file-drag'.
|
|
|
|
|
Return `copy' if the drop was successful, else nil."
|
|
|
|
|
(setq file (expand-file-name file))
|
|
|
|
|
(cond ((eq window-system 'x)
|
|
|
|
|
(when (x-dnd-do-direct-save file name frame
|
|
|
|
|
allow-same-frame)
|
|
|
|
|
'copy))
|
|
|
|
|
;; Avoid infinite recursion.
|
|
|
|
|
(t (let ((dnd-direct-save-remote-files nil))
|
|
|
|
|
(dnd-begin-file-drag file frame nil allow-same-frame)))))
|
|
|
|
|
|
2005-04-11 19:29:10 +00:00
|
|
|
|
(provide 'dnd)
|
|
|
|
|
|
|
|
|
|
;;; dnd.el ends here
|