Function: mpc-drag-n-drop

mpc-drag-n-drop is an interactive and byte-compiled function defined in mpc.el.gz.

Signature

(mpc-drag-n-drop EVENT)

Documentation

DWIM for a drag EVENT.

Key Bindings

Source Code

;; Defined in /usr/src/emacs/lisp/mpc.el.gz
;; (defun mpc-play-tagval ()
;;   "Play all the songs of the tag at point."
;;   (interactive)
;;   (let* ((val (buffer-substring (line-beginning-position) (line-end-position)))
;;          (songs (mapcar 'cdar
;;                         (mpc-proc-buf-to-alists
;;                          (mpc-proc-cmd (list "find" mpc-tag val))))))
;;     (mpc-cmd-add songs)
;;     (if (member (cdr (assq 'state (mpc-cmd-status))) '("stop"))
;;         (mpc-cmd-play))))

;;; Drag'n'drop support ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Todo:
;; the main thing to do here, is to provide visual feedback during the drag:
;; - change the mouse-cursor.
;; - highlight/select the source and the current destination.

(defun mpc-drag-n-drop (event)
  "DWIM for a drag EVENT."
  (interactive "e")
  (let* ((start (event-start event))
         (end (event-end event))
         (start-buf (window-buffer (posn-window start)))
         (end-buf (window-buffer (posn-window end)))
         (songs
          (with-current-buffer start-buf
            (goto-char (posn-point start))
            (if (get-text-property (point) 'mpc-select)
                ;; FIXME: actually we should only consider the constraints
                ;; corresponding to the selection in this particular buffer.
                (mpc-songs-selection)
              (cond
               ((and (derived-mode-p 'mpc-songs-mode)
                     (get-text-property (point) 'mpc-file))
                (list (cons (get-text-property (point) 'mpc-file)
                            (get-text-property (point) 'mpc-file-pos))))
               ((and mpc-tag (not (mpc-tagbrowser-all-p)))
                (mapcar (lambda (song)
                          (list (cdr (assq 'file song))))
                        (mpc-cmd-find
                         mpc-tag
                         (buffer-substring (line-beginning-position)
                                           (line-end-position)))))
               (t
                (error "Unsupported starting position for drag'n'drop gesture")))))))
    (with-current-buffer end-buf
      (goto-char (posn-point end))
      (cond
       ((eq mpc-tag 'Playlist)
        ;; Adding elements to a named playlist.
        (let ((playlist (if (or (mpc-tagbrowser-all-p)
                               (and (bolp) (eolp)))
                           (error "Not a playlist")
                         (buffer-substring (line-beginning-position)
                                           (line-end-position)))))
         (mpc-cmd-add (mapcar #'car songs) playlist)
         (message "Added %d songs to %s" (length songs) playlist)
         (if (member playlist
                     (cdr (assq 'Playlist (mpc-constraints-get-current))))
             (mpc-songs-refresh))))
       ((derived-mode-p 'mpc-songs-mode)
        (cond
         ((null mpc-songs-playlist)
          (error "The songs shown do not belong to a playlist"))
         ((eq start-buf end-buf)
          ;; Moving songs within the shown playlist.
          (let ((dest-pos (get-text-property (point) 'mpc-file-pos)))
            (mpc-cmd-move (mapcar #'cdr songs) dest-pos mpc-songs-playlist)
            (message "Moved %d songs" (length songs))))
         (t
          ;; Adding songs to the shown playlist.
          (let ((dest-pos (get-text-property (point) 'mpc-file-pos))
                (pl (if (stringp mpc-songs-playlist)
                        (mpc-cmd-find 'Playlist mpc-songs-playlist)
                      (mpc-proc-cmd-to-alist "playlist"))))
            ;; MPD's protocol does not let us add songs at a particular
            ;; position in a playlist, so we first have to add them to the
            ;; end, and then move them to their final destination.
            (mpc-cmd-add (mapcar #'car songs) mpc-songs-playlist)
            (mpc-cmd-move (let ((poss '()))
                            (dotimes (i (length songs))
                              (push (+ i (length pl)) poss))
                            (nreverse poss))
                            dest-pos mpc-songs-playlist)
            (message "Added %d songs" (length songs)))))
        (mpc-songs-refresh))
      (t
       (error "Unsupported drag'n'drop gesture"))))))