;;;-*- Mode: Lisp; Package: CL-USER -*- ;; ;; Drag and drop between windows ;; (defclass drag-list (capi:list-panel) ((flavor :initform nil :initarg :flavor :accessor flavor)) (:default-initargs :drag-callback #'drag-callback :drop-callback #'drop-callback :interaction :extended-selection)) (defun make-chooser (type items) (let* ((items-pane (make-instance 'drag-list :items items :flavor type)) (layout (make-instance 'capi:row-layout :adjust :center :description (list items-pane))) (window (make-instance 'capi:interface :title (format nil "~:(~as~)" type) :best-width 200 :best-height 150 :layout layout))) (capi:display window))) (defun drag-callback (pane indices) (list (flavor pane) (cons pane (map 'list #'(lambda (i) (elt (capi:collection-items pane) i)) indices)))) (defmethod drop-callback (pane drop-object stage) (case stage (:formats (capi:set-drop-object-supported-formats drop-object (list (flavor pane)))) (:drag (let ((format (flavor pane))) (when (capi:drop-object-provides-format drop-object format) ;; Ignore drop position (setf (capi:drop-object-collection-index drop-object) (values -1 :item)) (setf (capi:drop-object-drop-effect drop-object) :move)))) (:drop (let ((format (flavor pane))) (when (capi:drop-object-provides-format drop-object format) (let ((drag (capi:drop-object-get-object drop-object pane format))) (move-items (cdr drag) (car drag) pane) (setf (capi:drop-object-drop-effect drop-object) :move))))))) (defun move-items (items from to) (capi:remove-items from items) (capi:append-items to items)) ; Example (make-chooser :animal '("Alligator" "Buzzard" "Cheetah" "Dolphin" "Elephant")) (make-chooser :animal '("Cat" "Mouse" "Giraffe" "Panther" "Tiger")) (make-chooser :plant '("Daisy" "Oak" "Fern" "Rose" "Lily")) (make-chooser :plant '("Sycamore" "Pine" "Hyacinth" "Cabbage" "Dandelion"))