src/standard-descriptions/edit.lisp

   1 (in-package :lisp-on-lines)
   2
   3 (define-description editable ()
   4   ()
   5   (:mixinp t))
   6
   7 (define-layered-class define-description-attribute
   8   :in-layer #.(defining-description 'editable)
   9   ()
  10   ((edit-attribute-p
  11     :initform :inherit
  12     :layered-accessor attribute-editp
  13     :initarg :editp
  14     :layered t
  15     :special t)
  16    (setter
  17     :initarg :setter
  18     :layered t
  19     :layered-accessor attribute-setter
  20     :initform nil)
  21    (attribute-editor
  22     :initarg :editor
  23     :layered t
  24     :accessor attribute-editor
  25     :initform (make-instance 'attribute-editor)
  26     :documentation "This ones a bit odd")))
  27
  28 (define-layered-method attribute-setter (object)
  29   nil)
  30
  31 (defmethod shared-initialize :after ((object standard-attribute)
  32                                       slots &rest args &key input &allow-other-keys)
  33
  34   (when input
  35     (setf (attribute-editor object)
  36           (apply #'make-instance (find-editor-class input)
  37                  input))))
  38
  39
  40 (defun find-editor-class (spec)
  41   (let ((class (getf spec :class))
  42         (type (getf spec :type)))
  43     (or class (when
  44                   (and type (symbolp type))
  45                 (let ((name (format nil "~A-~A" type 'attribute-editor)))
  46                   (or (unless (eq (find-package :cl)
  47                                   (symbol-package type))
  48                         (find-class (intern name (symbol-package type)) nil))
  49                       (find-class (intern name) nil)
  50                       (find-class (intern name :lol) nil)
  51                       'string-attribute-editor))))))
  52
  53 (defclass attribute-editor ()
  54     ((class :initarg :class)
  55      (type :initarg :type
  56            :initform 'string
  57            :accessor attribute-editor-type)
  58      (parser :initarg :parse-using
  59              :initform 'identity
  60              :accessor attribute-editor-parsing-function)
  61      (attributes :initarg :attributes
  62                  :initform nil
  63                  :accessor attribute-editor-attributes)
  64      (prompt :initarg :prompt
  65              :initform nil)
  66      (unbound-value
  67          :initarg :unbound-value
  68        :initform "")))
  69
  70
  71
  72 (defclass string-attribute-editor (attribute-editor) ())
  73 (defclass text-attribute-editor (string-attribute-editor) ())
  74
  75 (deftype password () 'string)
  76
  77 (defclass password-attribute-editor (string-attribute-editor) ())
  78
  79 (defclass number-attribute-editor (attribute-editor) ()
  80   (:default-initargs
  81    :parse-using 'parse-number:PARSE-NUMBER
  82    :type 'number))
  83
  84 (defun parse-attribute-value (attribute value)
  85   (funcall (attribute-editor-parsing-function
  86                     (attribute-editor attribute))
  87            value))
  88
  89 (define-layered-function display-attribute-editor (attribute)
  90   (:method (attribute)
  91     (setf (attribute-value attribute)
  92           (funcall (attribute-editor-parsing-function
  93                     (attribute-editor attribute))
  94                    (read-line)))))
  95
  96 (define-description T ()
  97   ((editp :label "Edit by Default?"
  98           :value nil
  99           :editp nil)
 100    (identity :editp nil)
 101    (type :editp nil)
 102    (class :editp nil))
 103   (:in-description editable))
 104
 105 (define-layered-method (setf attribute-value-using-object)
 106  :in-layer #.(defining-description 'editable)(value object attribute)
 107
 108  (let ((setter (attribute-setter attribute)))
 109    (if setter
 110        (funcall setter value object)
 111        (error "No setter in ~A for ~A" attribute object))))
 112
 113
 114 (define-layered-function attribute-editp (attribute)
 115   (:method (attribute) nil))
 116
 117 (define-layered-method attribute-editp
 118   :in-layer #.(defining-description 'editable)
 119   ((attribute standard-attribute))
 120   (let ((value (attribute-value attribute)))
 121     (unless (or (unbound-slot-value-p value)
 122                 (typep value
 123                      (attribute-editor-type
 124                       (attribute-editor attribute))))
 125       (return-from attribute-editp nil)))
 126   (let ((edit?       (call-next-method)))
 127
 128     (if (eq :inherit edit?)
 129         (attribute-value (find-attribute
 130                           (attribute-description attribute)
 131                           'editp))
 132         edit?)))
 133
 134
 135 (define-layered-method display-attribute-value
 136   :in-layer #.(defining-description 'editable)
 137   ((attribute standard-attribute))
 138   (if (attribute-editp attribute)
 139       (display-attribute-editor attribute)
 140       (call-next-method)))
 141
 142
 143
 144
 145
 146