LCOV - code coverage report
Current view: top level - lisp - dnd.el (source / functions) Hit Total Coverage
Test: tramp-tests-after.info Lines: 0 77 0.0 %
Date: 2017-08-30 10:12:24 Functions: 0 9 0.0 %

          Line data    Source code
       1             : ;;; dnd.el --- drag and drop support
       2             : 
       3             : ;; Copyright (C) 2005-2017 Free Software Foundation, Inc.
       4             : 
       5             : ;; Author: Jan Djärv <jan.h.d@swipnet.se>
       6             : ;; Maintainer: emacs-devel@gnu.org
       7             : ;; Keywords: window, drag, drop
       8             : ;; Package: emacs
       9             : 
      10             : ;; This file is part of GNU Emacs.
      11             : 
      12             : ;; GNU Emacs is free software: you can redistribute it and/or modify
      13             : ;; it under the terms of the GNU General Public License as published by
      14             : ;; the Free Software Foundation, either version 3 of the License, or
      15             : ;; (at your option) any later version.
      16             : 
      17             : ;; GNU Emacs is distributed in the hope that it will be useful,
      18             : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
      19             : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      20             : ;; GNU General Public License for more details.
      21             : 
      22             : ;; You should have received a copy of the GNU General Public License
      23             : ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
      24             : 
      25             : ;;; Commentary:
      26             : 
      27             : ;; This file provides the generic handling of the drop part only.
      28             : ;; Different DND backends (X11, W32, etc.) that handle the platform
      29             : ;; specific DND parts call the functions here to do final delivery of
      30             : ;; a drop.
      31             : 
      32             : ;;; Code:
      33             : 
      34             : ;;; Customizable variables
      35             : 
      36             : 
      37             : ;;;###autoload
      38             : (defcustom dnd-protocol-alist
      39             :   `((,(purecopy "^file:///")  . dnd-open-local-file)  ; XDND format.
      40             :     (,(purecopy "^file://")   . dnd-open-file)                ; URL with host
      41             :     (,(purecopy "^file:")     . dnd-open-local-file)  ; Old KDE, Motif, Sun
      42             :     (,(purecopy "^\\(https?\\|ftp\\|file\\|nfs\\)://") . dnd-open-file)
      43             :    )
      44             : 
      45             :   "The functions to call for different protocols when a drop is made.
      46             : This variable is used by `dnd-handle-one-url' and `dnd-handle-file-name'.
      47             : The list contains of (REGEXP . FUNCTION) pairs.
      48             : The functions shall take two arguments, URL, which is the URL dropped and
      49             : ACTION which is the action to be performed for the drop (move, copy, link,
      50             : private or ask).
      51             : If no match is found here, and the value of `browse-url-browser-function'
      52             : is a pair of (REGEXP . FUNCTION), those regexps are tried for a match.
      53             : If no match is found, the URL is inserted as text by calling `dnd-insert-text'.
      54             : The function shall return the action done (move, copy, link or private)
      55             : if some action was made, or nil if the URL is ignored."
      56             :   :version "22.1"
      57             :   :type '(repeat (cons (regexp) (function)))
      58             :   :group 'dnd)
      59             : 
      60             : 
      61             : (defcustom dnd-open-remote-file-function
      62             :   (if (eq system-type 'windows-nt)
      63             :       'dnd-open-local-file
      64             :     'dnd-open-remote-url)
      65             :   "The function to call when opening a file on a remote machine.
      66             : The function will be called with two arguments; URI and ACTION. See
      67             : `dnd-open-file' for details.
      68             : If nil, then dragging remote files into Emacs will result in an error.
      69             : Predefined functions are `dnd-open-local-file' and `dnd-open-remote-url'.
      70             : `dnd-open-local-file' attempts to open a remote file using its UNC name and
      71             : is the  default on MS-Windows.  `dnd-open-remote-url' uses `url-handler-mode'
      72             : and is the default except for MS-Windows."
      73             :   :version "22.1"
      74             :   :type 'function
      75             :   :group 'dnd)
      76             : 
      77             : 
      78             : (defcustom dnd-open-file-other-window nil
      79             :   "If non-nil, always use find-file-other-window to open dropped files."
      80             :   :version "22.1"
      81             :   :type 'boolean
      82             :   :group 'dnd)
      83             : 
      84             : 
      85             : ;; Functions
      86             : 
      87             : (defun dnd-handle-one-url (window action url)
      88             :   "Handle one dropped url by calling the appropriate handler.
      89             : The handler is first located by looking at `dnd-protocol-alist'.
      90             : If no match is found here, and the value of `browse-url-browser-function'
      91             : is a pair of (REGEXP . FUNCTION), those regexps are tried for a match.
      92             : If no match is found, just call `dnd-insert-text'.
      93             : WINDOW is where the drop happened, ACTION is the action for the drop,
      94             : URL is what has been dropped.
      95             : Returns ACTION."
      96           0 :   (require 'browse-url)
      97           0 :   (let (ret)
      98           0 :     (or
      99           0 :      (catch 'done
     100           0 :        (dolist (bf dnd-protocol-alist)
     101           0 :          (when (string-match (car bf) url)
     102           0 :            (setq ret (funcall (cdr bf) url action))
     103           0 :            (throw 'done t)))
     104           0 :        nil)
     105           0 :      (when (not (functionp browse-url-browser-function))
     106           0 :        (catch 'done
     107           0 :          (dolist (bf browse-url-browser-function)
     108           0 :            (when (string-match (car bf) url)
     109           0 :              (setq ret 'private)
     110           0 :              (funcall (cdr bf) url action)
     111           0 :              (throw 'done t)))
     112           0 :          nil))
     113           0 :      (progn
     114           0 :        (dnd-insert-text window action url)
     115           0 :        (setq ret 'private)))
     116           0 :     ret))
     117             : 
     118             : 
     119             : (defun dnd-get-local-file-uri (uri)
     120             :   "Return an uri converted to file:/// syntax if uri is a local file.
     121             : Return nil if URI is not a local file."
     122             : 
     123             :   ;; The hostname may be our hostname, in that case, convert to a local
     124             :   ;; file.  Otherwise return nil.  TODO:  How about an IP-address as hostname?
     125           0 :   (let ((sysname (system-name)))
     126           0 :     (let ((hostname (when (string-match "^file://\\([^/]*\\)" uri)
     127           0 :                       (downcase (match-string 1 uri))))
     128             :           (sysname-no-dot
     129           0 :            (downcase (if (string-match "^[^\\.]+" sysname)
     130           0 :                          (match-string 0 sysname)
     131           0 :                        sysname))))
     132           0 :       (when (and hostname
     133           0 :                  (or (string-equal "localhost" hostname)
     134           0 :                      (string-equal (downcase sysname) hostname)
     135           0 :                      (string-equal sysname-no-dot hostname)))
     136           0 :         (concat "file://" (substring uri (+ 7 (length hostname))))))))
     137             : 
     138             : (defsubst dnd-unescape-uri (uri)
     139           0 :   (replace-regexp-in-string
     140             :    "%[A-Fa-f0-9][A-Fa-f0-9]"
     141             :    (lambda (arg)
     142           0 :      (let ((str (make-string 1 0)))
     143           0 :        (aset str 0 (string-to-number (substring arg 1) 16))
     144           0 :        str))
     145           0 :    uri t t))
     146             : 
     147             : ;; http://lists.gnu.org/archive/html/emacs-devel/2006-05/msg01060.html
     148             : (defun dnd-get-local-file-name (uri &optional must-exist)
     149             :   "Return file name converted from file:/// or file: syntax.
     150             : URI is the uri for the file.  If MUST-EXIST is given and non-nil,
     151             : only return non-nil if the file exists.
     152             : Return nil if URI is not a local file."
     153           0 :   (let ((f (cond ((string-match "^file:///" uri)      ; XDND format.
     154           0 :                   (substring uri (1- (match-end 0))))
     155           0 :                  ((string-match "^file:" uri)         ; Old KDE, Motif, Sun
     156           0 :                   (substring uri (match-end 0)))))
     157           0 :         (coding (if (equal system-type 'windows-nt)
     158             :                     ;; W32 pretends that file names are UTF-8 encoded.
     159             :                     'utf-8
     160           0 :                   (or file-name-coding-system
     161           0 :                       default-file-name-coding-system))))
     162           0 :     (and f (setq f (decode-coding-string (dnd-unescape-uri f) coding)))
     163           0 :     (when (and f must-exist (not (file-readable-p f)))
     164           0 :       (setq f nil))
     165           0 :     f))
     166             : 
     167             : (defun dnd-open-local-file (uri _action)
     168             :   "Open a local file.
     169             : The file is opened in the current window, or a new window if
     170             : `dnd-open-file-other-window' is set.  URI is the url for the file,
     171             : and must have the format file:file-name or file:///file-name.
     172             : The last / in file:/// is part of the file name.  If the system
     173             : natively supports unc file names, then remote urls of the form
     174             : file://server-name/file-name will also be handled by this function.
     175             : An alternative for systems that do not support unc file names is
     176             : `dnd-open-remote-url'. ACTION is ignored."
     177             : 
     178           0 :   (let* ((f (dnd-get-local-file-name uri t)))
     179           0 :     (if (and f (file-readable-p f))
     180           0 :         (progn
     181           0 :           (if dnd-open-file-other-window
     182           0 :               (find-file-other-window f)
     183           0 :             (find-file f))
     184           0 :           'private)
     185           0 :       (error "Can not read %s" uri))))
     186             : 
     187             : (defun dnd-open-remote-url (uri _action)
     188             :   "Open a remote file with `find-file' and `url-handler-mode'.
     189             : Turns `url-handler-mode' on if not on before.  The file is opened in the
     190             : current window, or a new window if `dnd-open-file-other-window' is set.
     191             : URI is the url for the file.  ACTION is ignored."
     192           0 :   (progn
     193           0 :     (require 'url-handlers)
     194           0 :     (or url-handler-mode (url-handler-mode))
     195           0 :     (if dnd-open-file-other-window
     196           0 :         (find-file-other-window uri)
     197           0 :       (find-file uri))
     198           0 :     'private))
     199             : 
     200             : 
     201             : (defun dnd-open-file (uri action)
     202             :   "Open a local or remote file.
     203             : The file is opened in the current window, or a new window if
     204             : `dnd-open-file-other-window' is set.  URI is the url for the file,
     205             : and must have the format file://hostname/file-name.  ACTION is ignored.
     206             : The last / in file://hostname/ is part of the file name."
     207             : 
     208             :   ;; The hostname may be our hostname, in that case, convert to a local
     209             :   ;; file.  Otherwise return nil.
     210           0 :   (let ((local-file (dnd-get-local-file-uri uri)))
     211           0 :     (if local-file (dnd-open-local-file local-file action)
     212           0 :       (if dnd-open-remote-file-function
     213           0 :           (funcall dnd-open-remote-file-function uri action)
     214           0 :         (error "Remote files not supported")))))
     215             : 
     216             : 
     217             : (defun dnd-insert-text (window action text)
     218             :   "Insert text at point or push to the kill ring if buffer is read only.
     219             : TEXT is the text as a string, WINDOW is the window where the drop happened."
     220           0 :   (if (or buffer-read-only
     221           0 :           (not (windowp window)))
     222           0 :       (progn
     223           0 :         (kill-new text)
     224           0 :         (message "%s"
     225           0 :          (substitute-command-keys
     226           0 :           "The dropped text can be accessed with \\[yank]")))
     227           0 :     (insert text))
     228           0 :   action)
     229             : 
     230             : 
     231             : (provide 'dnd)
     232             : 
     233             : ;;; dnd.el ends here

Generated by: LCOV version 1.12