list editor

list-editor.lisp

(in-package #:clim-user)

(define-application-frame property-list-editor ()
  ((list :initarg :list :accessor property-list-editor-list))
  (:panes
   (main :application
         :display-function #'display-property-list-editor
         :text-margins '(:left (:relative 10)
                         :top (:relative 10)
                         :right (:relative 10)
                         :bottom (:relative 10)))
   (interactor :interactor))
  (:layouts
   (default
    (vertically ()
      (9/10 main)
      (1/10 interactor)))))

(defun display-property-list-editor (frame pane)
  (let ((list (property-list-editor-list frame)))
    (formatting-table (pane)
      (loop for (indicator value) on list by #'cddr
            do (with-output-as-presentation (pane indicator 'plist-entry :single-box t)
                 (formatting-row (pane)
                   (formatting-cell (pane)
                     (write indicator :stream pane))
                   (formatting-cell (pane)
                     (write value :stream pane))))))))

(define-presentation-type plist-entry ())

(define-property-list-editor-command (com-quit :menu t) ()
  (frame-exit *application-frame*))

(define-property-list-editor-command (com-delete-entry)
    ((entry plist-entry :gesture :delete))
  (let ((frame *application-frame*))
    (symbol-macrolet ((list (property-list-editor-list frame)))
      (setf list (alexandria:remove-from-plist list entry)))))

(define-property-list-editor-command (com-new-entry :menu t)
    ((indicator expression)
     (value expression))
  (let ((frame *application-frame*))
    (symbol-macrolet ((list (property-list-editor-list frame)))
      (setf list (list* indicator value (alexandria:remove-from-plist list indicator))))))

(define-property-list-editor-command (com-move-up :menu t)
    ((entry plist-entry))
  (let ((frame *application-frame*))
    (symbol-macrolet ((list (property-list-editor-list frame)))
      (do ((head list (cddr head)))
          ((null head))
        (when (eq (caddr head) entry)
          (rotatef (car head) (caddr head))
          (rotatef (cadr head) (cadddr head))
          (return))))))

(define-property-list-editor-command (com-move-down :menu t)
    ((entry plist-entry))
  (let ((frame *application-frame*))
    (symbol-macrolet ((list (property-list-editor-list frame)))
      (do ((head list (cddr head)))
          ((null head))
        (when (and (eq (car head) entry) (cddr head))
          (rotatef (car head) (caddr head))
          (rotatef (cadr head) (cadddr head))
          (return))))))

(define-presentation-to-command-translator up-entry
    (plist-entry com-move-up property-list-editor)
    (entry)
  (list entry))

(define-presentation-to-command-translator down-entry
    (plist-entry com-move-down property-list-editor)
    (entry)
  (list entry))

(defun edit-plist (&optional plist)
  (let ((frame (make-application-frame 'property-list-editor :list (copy-list plist))))
    (run-frame-top-level frame)
    (property-list-editor-list frame)))