Function: dired-mouse-drag

dired-mouse-drag is an interactive and byte-compiled function defined in dired.el.gz.

Signature

(dired-mouse-drag EVENT)

Documentation

Begin a drag-and-drop operation for the file at EVENT.

If there are marked files and that file is marked, drag every other marked file as well. Otherwise, unmark all files.

Key Bindings

Source Code

;; Defined in /usr/src/emacs/lisp/dired.el.gz
(defun dired-mouse-drag (event)
  "Begin a drag-and-drop operation for the file at EVENT.
If there are marked files and that file is marked, drag every
other marked file as well.  Otherwise, unmark all files."
  (interactive "e")
  (when mark-active
    (deactivate-mark))
  (let* ((modifiers (event-modifiers event))
         (action (cond ((memq 'control modifiers) 'copy)
                       ((memq 'shift modifiers) 'move)
                       ((memq 'meta modifiers) 'link)
                       (t (if (memq dired-mouse-drag-files
                                    '(copy move link))
                              dired-mouse-drag-files
                            'copy)))))
    (save-excursion
      (with-selected-window (posn-window (event-end event))
        (goto-char (posn-point (event-end event))))
      (track-mouse
        (let ((beginning-position (mouse-pixel-position))
              new-event)
          (catch 'track-again
            (setq new-event (read-event))
            (if (not (eq (event-basic-type new-event) 'mouse-movement))
                (when (eq (event-basic-type new-event) 'mouse-1)
                  (push new-event unread-command-events))
              (let ((current-position (mouse-pixel-position)))
                ;; If the mouse didn't move far enough, don't
                ;; inadvertently trigger a drag.
                (when (and (eq (car current-position) (car beginning-position))
                           (ignore-errors
                             (and (> 3 (abs (- (cadr beginning-position)
                                               (cadr current-position))))
                                  (> 3 (abs (- (caddr beginning-position)
                                               (caddr current-position)))))))
                  (throw 'track-again nil)))
              ;; We can get an error if there's by some chance no file
              ;; name at point.
              (condition-case error
                  (let ((filename (with-selected-window (posn-window
                                                         (event-end event))
                                    (let ((marked-files (dired-map-over-marks (dired-get-filename
                                                                               nil 'no-error-if-not-filep)
                                                                              'marked))
                                          (file-name (dired-get-filename nil 'no-error-if-not-filep)))
                                      (if (and marked-files
                                               (member file-name marked-files))
                                          marked-files
                                        (when marked-files
                                          (dired-map-over-marks (dired-unmark nil)
                                                                'marked))
                                        file-name)))))
                    (when filename
                      (if (and (consp filename)
                               (cdr filename))
                          (dnd-begin-drag-files filename nil action t)
                        (dnd-begin-file-drag (if (stringp filename)
                                                 filename
                                               (car filename))
                                             nil action t))))
                (error (when (eq (event-basic-type new-event) 'mouse-1)
                         (push new-event unread-command-events))
                       ;; Errors from `dnd-begin-drag-files' should be
                       ;; treated as user errors, since they should
                       ;; only occur when the user performs an invalid
                       ;; action, such as trying to create a link to
                       ;; a remote file.
                       (user-error (cadr error)))))))))))