Common Graphics Class-Grid and Object-Editor

The Class-Grid is a type of Grid-Widget designed to display information about multiple instances of a class, specifically the values o selected slots. The Object-Editor is a dialog designed to display information about a specific instance of a class. Both tools are designed to be used with databases such as AllegroCache but both will work with any class and instance. Here is a Class-Grid:

The various instances of a class are shown with slots and values displayed. We will show below how to create this Class-Grid. Here is an Object-Editor:

In order to create a class grid or an object editor, you need to specify the value of the edited-slots property. This property tells the system which slots of a class you are interested in displaying and potentially editing. While there are other options you can specify (and we do specify more in the examples below), once you have a value for edited-slots, the dialogs are more or less ready to go.

Of course, you must first have a class whose slots you are interested in viewing and editing. We will use the example in Creating an Object-Editor Dialog or Class-Grid Programmatically which creates a patient database and a medications database.

If you are running this example by cutting and pasting from this article, run these administrative forms first (all the code with explanations appears in Creating an Object-Editor Dialog or Class-Grid Programmatically):

(in-package :cg-user)
(require-cg-acache)
(unless db.ac:*allegrocache*
  (db.ac:create-file-database
   (merge-pathnames "tempdb/" (sys:temporary-directory))))
(cg-rollback :confirm nil)

Now we define a class for patients:

(defclass patient ()
    ((last-name :accessor last-name
                :initarg :last-name
                :index :any
                :initform "")
     (first-name :accessor first-name
                 :initarg :first-name
                 :initform "")
     (access :accessor access
             :initarg :access
             :initform nil)
     (date-of-birth :accessor date-of-birth
                    :initarg :date-of-birth
                    :initform "")
     (unpaid-balance :accessor unpaid-balance
                     :initarg :unpaid-balance
                     :initform "0.00")
     (friendly :accessor friendly
                :initarg :friendly
                :initform t)
     (favorite-color :accessor favorite-color
                     :initarg :favorite-color
                     :initform "")
     (static-note :accessor static-note
                  :initarg :static-note
                  :initform "")
     (best-friend :accessor best-friend
                  :initarg :best-friend
                  :initform nil)
     (prescriptions :accessor prescriptions
                    :initarg :prescriptions
                    :initform nil)
     )
  (:metaclass db.ac:persistent-class))

and we create some instances and set the value of the best-friend slot:

(defparameter *patients*
  (list (make-instance 'patient
          :first-name "Sarah" :last-name "Somebody"
          :date-of-birth "1963/01/15"
          :unpaid-balance "34.89"
          :friendly t :favorite-color :blue
          :static-note (format nil "Sarah is the first patient, ~
                         but will get sorted toward the end.")
          )
        (make-instance 'patient
          :first-name "Andy" :last-name "Anybody"
          :access :partial
          :date-of-birth "1971/03/02"
          :unpaid-balance ".09"
          :friendly nil :favorite-color :yellow
          :static-note (format nil "This description of Andy ~
           is so long that it may cause a scrolling-static-text ~
           widget that holds it to scroll.")
          )
        (make-instance 'patient
          :first-name "Alice" :last-name "Loom"
          :access :partial
          :date-of-birth "1967/05/17"
          :unpaid-balance "729.95"
          :friendly nil :favorite-color :blue
          :static-note "This is a rather unimportant note that's not really about Alice at all."
          )
        (make-instance 'patient
          :first-name "Helen" :last-name "Nurble"
          :date-of-birth "1959/04/29"
          :unpaid-balance "8844.22"
          :friendly t :favorite-color :red
          :static-note "This field displays UNEDITABLE text."
          )
        (make-instance 'patient
          :first-name "Bill" :last-name "Nurby"
          :date-of-birth "1948/04/29"
          :unpaid-balance "42000.03"
          :friendly t :favorite-color :red
          :static-note "It's later than it's ever been."
          )
        (make-instance 'patient
          :first-name "Higgledy" :last-name "Piggledy"
          :access :full
          :date-of-birth "1968/06/12"
          :unpaid-balance "123.45"
          :friendly nil :favorite-color :blue
          :static-note "I suspect that this is not a real person."
          )
        (make-instance 'patient
          :first-name "Oof" :last-name "Noof"
          :access :partial
          :date-of-birth "1958/02/15"
          :unpaid-balance "3600.00"
          :friendly nil :favorite-color :red
          :static-note "What sort of name is Oof anyway?"
          )
        ))
(do* ((patients *patients* (rest patients)))
     ((null patients))
  (setf (best-friend (first patients))
    (or (second patients)(first *patients*))))
(progn
  (setf (primary-name-slot 'patient) 'last-name)
  (setf (secondary-name-slot 'patient) 'first-name))

Here is the the value for edited-slots. This is abreviated from the one in the full example and we have eliminated the comments which detail the values and choices (see here for the full detailed example):

(setq patient-edited-slots
      `(
        (first-name :edited-type (:variable-char)
                    :width-in-chars 12)
        (last-name :edited-type (:variable-char)
                   :width 120 :sortable t
                   :label "Family Name")
        (date-of-birth :edited-type (:date :yyyy/mm/dd)
                       :label "Birth Date")
        (unpaid-balance :edited-type (:fixed-numeric 6 2)
                        :template-allows-sign t
                        :label "Unpaid Balance")
        (friendly :edited-type (:boolean)
                  :sortable t
                  :label "Friendly?")
        (favorite-color
                  :edited-type (:single-choice (:red :green :blue :yellow))
                  :on-print capitalize-object
                  :label "Fave Color")
        (best-friend
                  :edited-type (:class-instance patient)
                  :edited-instances ,*patients*
                  :width 100)
        (static-note
                  :edited-type (:static-text)
                  :width 160)
                 )
   )

The Class-Grid Example

Now we are ready to create and display the Class-Grid. Besides giving a value for :edited-slots, we need only specify the class being edited and a few appearance details.

(let* ((width 800)
       (height 250)
       (grid (make-instance 'class-grid
               :column-header-height 40
               :edited-class 'patient
               :edited-slots patient-edited-slots
               :right-attachment :right
               :bottom-attachment :bottom
               :width width
               :height height))
       (dialog (make-window :class-grid-example
                 :class 'dialog
                 :dialog-items (list grid)
                 :interior (make-box-relative 200 200 width height))))
  (select-window dialog)
  (setf (value grid) *patients*)
  dialog)

The following dialog is displayed:

Scrolling the image to the right displays the remaining edited slot (Static Note):

All except the static note slots are editable. The current value of the unpaid balance and favorite color slots for patient Sarah Somebody (top line) are 34.89 and blue:

cg-user(17): (setq sarah (first *patients*))
#
cg-user(18): (slot-value sarah 'unpaid-balance)
"34.89"
cg-user(19): (slot-value sarah 'favorite-color)
:blue
cg-user(20): 

But is we edit the Unpaid Balance to 114.23 and chose red from the Fave Color combo box widget,

the values in the database change accordingly:

cg-user(20): (slot-value sarah 'unpaid-balance)
"114.23"
cg-user(21): (slot-value sarah 'favorite-color)
:red
cg-user(22):

An Object-Editor Example

The Object-Editor displays more information about individual instances. For an example, let us define a new class, medication, and some instances of that class:

(defclass medication ()
  ((drug-name :accessor drug-name
              :initarg :drug-name
              :initform "")
   (drug-price :accessor drug-price
               :initarg :drug-price
               :initform "0.00")
   (drug-warnings :accessor drug-warnings
                  :initarg :drug-warnings
                  :initform ""))
  (:metaclass db.ac:persistent-class))

(defparameter *medications*
  (list
   (make-instance 'medication
     :drug-name "Lispitol"
     :drug-price "23.89"
     :drug-warnings "Associated with computer addiction.")
   (make-instance 'medication
     :drug-name "Franzeril"
     :drug-price "1.95"
     :drug-warnings "May give Bill Gates a headache.")
   (make-instance 'medication
     :drug-name "Objectifin"
     :drug-price "29.95"
     :drug-warnings "Sometimes leads to modularity.")
   (make-instance 'medication
     :drug-name "Dynamicine"
     :drug-price "299.00"
     :drug-warnings "May increase free time to kill.")
   (make-instance 'medication
     :drug-name "Parenthezol"
     :drug-price "123.45"
     :drug-warnings "Can reduce concern about syntax.")
   (make-instance 'medication
     :drug-name "Macrozine"
     :drug-price "14.89"
     :drug-warnings "Causes feelings of superiority.")
   ))

(setf (primary-name-slot 'medication) 'drug-name)

And a prescription class, which associates medicaions with patients:

(defclass prescription ()
  ((medication :accessor medication
               :initarg :medication
               :initform nil)
   (patient :accessor patient
            :initarg :patient
            :initform nil)
   (refills :accessor refills
            :initarg :refills
            :initform "0"))
  (:metaclass db.ac:persistent-class))

We generate some prescriptions for our patients:

(do* ((count 0 (1+ count))
      (patients *patients* (rest patients))
      patient)
     ((null patients))
  (setq patient (first patients))
  (do* ((medications *medications* (rest medications))
        (medication (first medications)(first medications))
        (prescriptions nil))
       ((null medications))
    (when (or (zerop (random 2))
              
              ;; Make sure that each person has at least
              ;; two prescriptions.
              (<= (+ (length medications)
                     (length prescriptions))
                  2))
      
      (push (make-instance 'prescription
              :medication medication
              :patient patient
              :refills (random 3))
            prescriptions))
    (setf (prescriptions patient) prescriptions)))

This form will now display the Object Editor. The value of the :edited-slots property is similar to what appeared for the Class-Grid, but with some additional values (which are indicated):

(make-window :test
  :class 'object-editor
  :scrollbars :vertical
  :exterior (make-box-relative
             60 60 700 600)
  :layout-spacing (make-instance 'layout-spacing
                    :layout-widget-spacing 4   ;; this is the default
                    :layout-outer-margin 12)
  :include-table-of-all-instances nil
  :command-buttons
  '(:first-button :previous-button :next-button :last-button
                  :select-button :search-button
                  :save-button :revert-button :new-button :delete-button
                  :commit-button :rollback-button)
  :edited-class 'patient
  :edited-instances *patients*
  :edited-slots
  `(
    (first-name :edited-type (:variable-char))
    (last-name :edited-type (:variable-char)
               :width 200
               :label "Family Name")
    (date-of-birth :edited-type (:date :yyyy/mm/dd)
                   :label "Birth Date")
    (unpaid-balance :edited-type (:fixed-numeric 6 2)
                    :template-allows-sign t
                    :fixed-width-font t
                    :label "Unpaid Balance")
    (friendly :edited-type (:boolean)
              :width 120
              :label "Friendly?")
    (favorite-color
     :new-column t
     :edited-type (:single-choice (:red :green :blue :yellow))
     :on-print capitalize-object
     :label "Fave Color")
    (static-note
     :height 44
     :edited-type (:static-text-multi-line))
    (best-friend
     :edited-type (:class-instance patient)
     :edited-instances ,*patients*
     )
    ;; This slot is new:
    (prescriptions
     :edited-type (:table-of-class-instances prescription)
     :include-create-button t
     :include-delete-button t
     :edited-slots
     ((medication :edited-type (:class-instance medication)
                  :edited-instances ,*medications*)
      (refills :edited-type (:fixed-numeric 1 0)
               :horizontal-justification :center
               :label "Num Refills")
      ((medication drug-price)
       :edited-type (:fixed-numeric 6 2))
      ((medication drug-warnings)
       :edited-type (:variable-char)
       :width 200)))
    ))

This dialog is displayed:

The various buttons and other controls allow seeing the slot values and making modifications where necessary.

These examples are fully worked out, with many more comments and some more options, in the document Creating an Object-Editor Dialog or Class-Grid Programmatically.

Copyright © 2023 Franz Inc., All Rights Reserved | Privacy Statement Twitter