]> code.delx.au - gnu-emacs/blobdiff - lisp/dnd.el
Merge from emacs-23.
[gnu-emacs] / lisp / dnd.el
index 85881b3261f596659c096050455d755a3814a7b5..757fc951b53fca1d8130ae66f0b36863dac73e94 100644 (file)
@@ -1,17 +1,19 @@
-;;; dnd.el --- drag and drop support.
+;;; dnd.el --- drag and drop support.  -*- coding: utf-8 -*-
 
-;; Copyright (C) 2005, 2006 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010, 2011
+;;   Free Software Foundation, Inc.
 
-;; Author: Jan Dj\e,Ad\e(Brv <jan.h.d@swipnet.se>
+;; Author: Jan Djรคrv <jan.h.d@swipnet.se>
 ;; Maintainer: FSF
 ;; Keywords: window, drag, drop
+;; Package: emacs
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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 2, or (at your option)
-;; any later version.
+;; 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
@@ -19,9 +21,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
 
 ;;;###autoload
 (defcustom dnd-protocol-alist
-  '(
-    ("^file:///" . dnd-open-local-file)        ; XDND format.
-    ("^file://"  . dnd-open-file)      ; URL with host
-    ("^file:"    . dnd-open-local-file)        ; Old KDE, Motif, Sun
-    )
+  `((,(purecopy "^file:///")  . dnd-open-local-file)   ; XDND format.
+    (,(purecopy "^file://")   . dnd-open-file)         ; URL with host
+    (,(purecopy "^file:")     . dnd-open-local-file)   ; Old KDE, Motif, Sun
+    (,(purecopy "^\\(https?\\|ftp\\|file\\|nfs\\)://") . dnd-open-file)
+   )
 
   "The functions to call for different protocols when a drop is made.
 This variable is used by `dnd-handle-one-url' and `dnd-handle-file-name'.
@@ -59,6 +59,22 @@ if some action was made, or nil if the URL is ignored."
   :group 'dnd)
 
 
+(defcustom dnd-open-remote-file-function
+  (if (eq system-type 'windows-nt)
+      'dnd-open-local-file
+    'dnd-open-remote-url)
+  "The function to call when opening a file on a remote machine.
+The function will be called with two arguments; URI and ACTION. See
+`dnd-open-file' for details.
+If nil, then dragging remote files into Emacs will result in an error.
+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
+is the  default on MS-Windows.  `dnd-open-remote-url' uses `url-handler-mode'
+and is the default except for MS-Windows."
+  :version "22.1"
+  :type 'function
+  :group 'dnd)
+
 
 (defcustom dnd-open-file-other-window nil
   "If non-nil, always use find-file-other-window to open dropped files."
@@ -75,7 +91,7 @@ The handler is first located by looking at `dnd-protocol-alist'.
 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, just call `dnd-insert-text'.
-WINDOW is where the drop happend, ACTION is the action for the drop,
+WINDOW is where the drop happened, ACTION is the action for the drop,
 URL is what has been dropped.
 Returns ACTION."
   (require 'browse-url)
@@ -119,6 +135,16 @@ Return nil if URI is not a local file."
                 (string-equal system-name-no-dot hostname)))
        (concat "file://" (substring uri (+ 7 (length hostname)))))))
 
+(defsubst dnd-unescape-uri (uri)
+  (replace-regexp-in-string
+   "%[A-Fa-f0-9][A-Fa-f0-9]"
+   (lambda (arg)
+     (let ((str (make-string 1 0)))
+       (aset str 0 (string-to-number (substring arg 1) 16))
+       str))
+   uri t t))
+
+;; http://lists.gnu.org/archive/html/emacs-devel/2006-05/msg01060.html
 (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,
@@ -128,26 +154,23 @@ Return nil if URI is not a local file."
                  (substring uri (1- (match-end 0))))
                 ((string-match "^file:" uri)           ; Old KDE, Motif, Sun
                  (substring uri (match-end 0))))))
-    (when (and f must-exist)
-      (setq f (replace-regexp-in-string
-              "%[A-Z0-9][A-Z0-9]"
-              (lambda (arg)
-                (format "%c" (string-to-number (substring arg 1) 16)))
-              f nil t))
-      (let* ((decoded-f (decode-coding-string
-                        f
-                        (or file-name-coding-system
-                            default-file-name-coding-system)))
-            (try-f (if (file-readable-p decoded-f) decoded-f f)))
-       (when (file-readable-p try-f) try-f)))))
-
+    (and f (setq f (decode-coding-string (dnd-unescape-uri f)
+                                         (or file-name-coding-system
+                                             default-file-name-coding-system))))
+    (when (and f must-exist (not (file-readable-p f)))
+      (setq f nil))
+    f))
 
 (defun dnd-open-local-file (uri action)
   "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.
-The last / in file:/// is part of the file name.  ACTION is ignored."
+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
+`dnd-open-remote-url'. ACTION is ignored."
 
   (let* ((f (dnd-get-local-file-name uri t)))
     (if (and f (file-readable-p f))
@@ -158,6 +181,20 @@ The last / in file:/// is part of the file name.  ACTION is ignored."
          'private)
       (error "Can not read %s" uri))))
 
+(defun dnd-open-remote-url (uri action)
+  "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
+    (require 'url-handlers)
+    (or url-handler-mode (url-handler-mode))
+    (if dnd-open-file-other-window
+       (find-file-other-window uri)
+      (find-file uri))
+    'private))
+
+
 (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
@@ -169,7 +206,9 @@ The last / in file://hostname/ is part of the file name."
   ;; file.  Otherwise return nil.
   (let ((local-file (dnd-get-local-file-uri uri)))
     (if local-file (dnd-open-local-file local-file action)
-      (error "Remote files not supported"))))
+      (if dnd-open-remote-file-function
+         (funcall dnd-open-remote-file-function uri action)
+       (error "Remote files not supported")))))
 
 
 (defun dnd-insert-text (window action text)
@@ -188,5 +227,4 @@ TEXT is the text as a string, WINDOW is the window where the drop happened."
 
 (provide 'dnd)
 
-;; arch-tag: 0472f6a5-2e8f-4304-9e44-1a0877c771b7
 ;;; dnd.el ends here