src/standard-descriptions/edit.lisp

   1 (in-package :lisp-on-lines)
   2
   3
   4 (define-description editable ()
   5   ()
   6   (:mixinp t))
   7
   8 (define-layered-class standard-attribute
   9   :in-layer #.(defining-description 'editable)
  10   ()
  11   ((edit-attribute-p
  12     :initform :inherit
  13     :layered-accessor attribute-editp
  14     :initarg :editp
  15     :layered t)
  16    (setter
  17     :initarg :setter
  18     :layered t
  19     :accessor attribute-setter
  20     :initform nil)
  21    (attribute-editor
  22     :initarg :input
  23     :layered t
  24     :accessor attribute-editor
  25     :initform nil
  26     :documentation "This ones a bit odd")))
  27
  28 (defmethod attribute-editor :around (attribute)
  29   (flet ((find-editor-class (spec)
  30            (let ((class (getf spec :class))
  31                  (type (getf spec :type)))
  32              (or class (when (and type (symbolp type))
  33                          (intern (format nil "~A-~A" type 'attribute-editor)))
  34                  'string-attribute-editor))))
  35   (let ((editor? (call-next-method)))
  36     (if (listp editor?)
  37         (setf (attribute-editor attribute)
  38               (apply #'make-instance (find-editor-class editor?)
  39                      editor?))
  40         (call-next-method)))))
  41
  42
  43 (defclass attribute-editor ()
  44     ((type :initarg :type
  45            :initform 'string)
  46      (parser :initarg :parse-using
  47              :initform 'identity
  48              :accessor attribute-editor-parsing-function)
  49      (prompt :initarg :prompt
  50              :initform nil)))
  51
  52 (defclass string-attribute-editor (attribute-editor) ())
  53 (defclass text-attribute-editor (string-attribute-editor) ())
  54 (defclass password-attribute-editor (string-attribute-editor) ())
  55
  56 (defclass number-attribute-editor (attribute-editor) ()
  57   (:default-initargs
  58    :parse-using 'parse-number:PARSE-NUMBER
  59    :type 'number))
  60
  61 (defun parse-attribute-value (attribute value)
  62   (funcall (attribute-editor-parsing-function
  63                     (attribute-editor attribute))
  64            value))
  65
  66 (define-layered-function display-attribute-editor (attribute)
  67   (:method (attribute)
  68     (setf (attribute-value attribute)
  69           (funcall (attribute-editor-parsing-function
  70                     (attribute-editor attribute))
  71                    (read-line)))))
  72
  73 (define-description T ()
  74   ((editp :label "Edit by Default?"
  75           :value nil
  76           :editp nil)
  77    (identity :editp nil)
  78    (type :editp nil)
  79    (class :editp nil))
  80   (:in-description editable))
  81
  82 (define-layered-method (setf attribute-value-using-object)
  83  :in-layer #.(defining-description 'editable)(value object attribute)
  84
  85  (let ((setter (attribute-setter attribute)))
  86    (if setter
  87        (funcall setter value object)
  88        (error "No setter in ~A for ~A" attribute object))))
  89
  90
  91 (define-layered-function attribute-editp (attribute)
  92   (:method (attribute) nil))
  93
  94 (define-layered-method attribute-editp
  95   :in-layer #.(defining-description 'editable)
  96   ((attribute standard-attribute))
  97   (let ((edit?       (call-next-method)))
  98     (if (eq :inherit edit?)
  99         (attribute-value (find-attribute
 100                           (attribute-description attribute)
 101                           'editp))
 102         edit?)))
 103
 104
 105 (define-layered-method display-attribute-value
 106   :in-layer #.(defining-description 'editable)
 107   ((attribute standard-attribute))
 108   (if (attribute-editp attribute)
 109       (display-attribute-editor attribute)
 110       (call-next-method)))
 111
 112
 113
 114
 115
 116