+++ /dev/null
-#LyX 1.3 created this file. For more info see http://www.lyx.org/
-\lyxformat 221
-\textclass article
-\language english
-\inputencoding auto
-\fontscheme default
-\graphics default
-\paperfontsize default
-\spacing single
-\papersize a4paper
-\paperpackage widemarginsa4
-\use_geometry 0
-\use_amsmath 0
-\use_natbib 0
-\use_numerical_citations 0
-\paperorientation portrait
-\secnumdepth 3
-\tocdepth 3
-\paragraph_separation indent
-\defskip medskip
-\quotes_language english
-\quotes_times 2
-\papercolumns 1
-\papersides 1
-\paperpagestyle default
-
-\layout Title
-
-LISP-ON-LINES
-\layout Author
-
-
-\noun on
-v v v v v v v
-Drew Crampsie
-^ ^ ^ ^ ^ ^ ^
-\noun default
-,
-\noun on
-José Pablo Ezequiel
-\begin_inset Quotes eld
-\end_inset
-
-Pupeno
-\begin_inset Quotes erd
-\end_inset
-
- Fernández Silva
-\layout Abstract
-
-
-\noun on
-Lisp-On-Lines
-\noun default
- is a very useful module that works on top of the
-\noun on
-UnCommon Web
-\noun default
- framework to do rapid developing of complex data-driven web appilcations
- (on
-\noun on
-Common Lisp
-\noun default
-, of course).
-\layout Section
-
-Introduction
-\layout Standard
-
-
-\noun on
-Lisp-On-Lines
-\noun default
- was founded and developed and continues to be developed and mantained by
-
-\noun on
-Drew Crampsie
-\noun default
-.
-\layout Subsection
-
-Conventions
-\layout Standard
-
-The conventions used in this manual are:
-\layout Itemize
-
-Code is shown in a monospace font.
- When it is expected that the user is working in an interactive environment
- what the user should type appears as bold, while the computer result appears
- non-bold, for example:
-\begin_deeper
-\layout LyX-Code
-
->
-\series bold
-(+ 5 10)
-\layout LyX-Code
-
-15
-\end_deeper
-\layout Itemize
-
-Names of people or products are show as small caps, like
-\noun on
-Drew Crampsie
-\noun default
- or
-\noun on
-Lisp-On-Lines
-\noun default
-.
-\layout Itemize
-
-Sections marked with
-\color red
-ToDo
-\color default
- require further revision.
-\layout Standard
-
-
-\color red
-ToDo: Add more conventions as they are needed, possible classes of text:
- names of concepts, name of programming entities, like variables, functions,
- etc (which are embedded in text, should they be shown monospaced ?).
-\layout Section
-
-Components
-\layout Description
-
-Meta\SpecialChar ~
-Model\SpecialChar ~
-Protocol A Protocol for introspection on relational objects.
-\layout Description
-
-Mewa\SpecialChar ~
-Presentations A Mewa-like
-\begin_inset Foot
-collapsed true
-
-\layout Standard
-
-http://www.adrian-lienhard.ch/files/mewa.pdf
-\end_inset
-
- layer for UncommonWeb
-\begin_inset Foot
-collapsed true
-
-\layout Standard
-
-http://common-lisp.net/project/ucw/
-\end_inset
-
- Presentations.
-\layout Section
-
-Example
-\layout Standard
-
-First we start with the data model.
- The Meta Model Protocol (MMP) is used to provide information on the data
- objects and how they relate to one another.
- Its is currently implemented as a layer over CLSQL
-\begin_inset Foot
-collapsed true
-
-\layout Standard
-
-http://clsql.b9.com/
-\end_inset
-
-, although support is planned for other backends (
-\noun on
-CLOS
-\noun default
-,
-\noun on
-Elephant
-\noun default
-[4], whatever).
-\layout Standard
-
-The MMP shares its definition syntax with
-\emph on
-\noun on
-CLSQL
-\emph default
-\noun default
-'s Object Oriented Data Definition Language (OODDL)
-\begin_inset Foot
-collapsed true
-
-\layout Standard
-
-http://clsql.b9.com/manual/ref-ooddl.html
-\begin_inset Note
-collapsed true
-
-\layout Standard
-
-Shouldn't this footnote be a bibliographical entry ? or something like that
- ?
-\end_inset
-
-
-\end_inset
-
-.
- The macro to define view-classes is named DEF-VIEW-CLASS/META, and takes
- the same arguments as DEF-VIEW-CLASS from CLSQL.
- For the purposes of this simple example, we will only need two functions
- from the MMP beyond what CLSQL provides : LIST-SLOTS and LIST-SLOT-TYPES[5].
-\layout Standard
-
-We'll define a simple class to hold a user.
-\layout LyX-Code
-
->
-\series bold
-(def-view-class/meta user ()
-\layout LyX-Code
-
-
-\series bold
- ((userid :initarg :userid :accessor userid :type integer :db-kind :key)
-\layout LyX-Code
-
-
-\series bold
- (username :initarg :username :accessor username :type string :db-kind
- :base)
-\layout LyX-Code
-
-
-\series bold
- (password :initarg :password :accessor password :type string :db-kind
- :base)))
-\layout Standard
-
-and now we create a user:
-\layout LyX-Code
-
->
-\series bold
-(defparameter user (make-instance 'user :userid 1
-\layout LyX-Code
-
-
-\series bold
- :username "drewc"
-\layout LyX-Code
-
-
-\series bold
- :password "p@ssw0rd"))
-\layout Standard
-
-We can see the slots of users running:
-\layout LyX-Code
-
->
-\series bold
-(lisp-on-lines::list-slots user)
-\layout LyX-Code
-
-(USERID USERNAME PASSWORD)
-\layout Standard
-
-or the types with:
-\layout LyX-Code
-
->
-\series bold
-(lisp-on-lines::list-slot-types user)
-\layout LyX-Code
-
-((USERID INTEGER) (USERNAME STRING) (PASSWORD STRING))
-\layout Standard
-
-To see the default attributes of a class
-\begin_inset Marginal
-collapsed true
-
-\layout Standard
-
-Is this correct ? Drew, please, check.
-\end_inset
-
- we run.
-\layout LyX-Code
-
->
-\series bold
-(lisp-on-lines::default-attributes user)
-\layout LyX-Code
-
-((USERID INTEGER :LABEL "USERID" :SLOT-NAME USERID)
-\layout LyX-Code
-
- (USERNAME STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
-\layout LyX-Code
-
- (PASSWORD STRING :LABEL "PASSWORD" :SLOT-NAME PASSWORD))
-\layout Standard
-
-To set the attributes of a class to the default values we use:
-\layout LyX-Code
-
->
-\series bold
-(lisp-on-lines::set-default-attributes user)
-\layout LyX-Code
-
-((USERID INTEGER :LABEL "USERID" :SLOT-NAME USERID)
-\layout LyX-Code
-
- (USERNAME STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
-\layout LyX-Code
-
- (PASSWORD STRING :LABEL "PASSWORD" :SLOT-NAME PASSWORD))
-\layout Standard
-
-which takes an object of the class we are working with.
- This is going to be change so we can do this action directly on the class.
- It is on the TODO file.
-\layout Standard
-
-Class attributes?
-\layout LyX-Code
-
->
-\series bold
-(lisp-on-lines::find-class-attributes user)
-\layout LyX-Code
-
-(USER (PASSWORD STRING :LABEL "PASSWORD" :SLOT-NAME PASSWORD)
-\layout LyX-Code
-
- (USERNAME STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
-\layout LyX-Code
-
- (USERID INTEGER :LABEL "USERID" :SLOT-NAME USERID)
-\layout LyX-Code
-
- NIL)
-\layout Standard
-
-note that the mewa functions (find-attribute, set-attribute etc) can take
- either an instance, or a class-name as a symbol:
-\layout LyX-Code
-
->
-\series bold
-(lisp-on-lines::find-class-attributes 'user)
-\layout LyX-Code
-
-(USER (PASSWORD STRING :LABEL "PASSWORD" :SLOT-NAME PASSWORD)
-\layout LyX-Code
-
- (USERNAME STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
-\layout LyX-Code
-
- (USERID INTEGER :LABEL "USERID" :SLOT-NAME USERID)
-\layout LyX-Code
-
- NIL)
-\layout LyX-Code
-
->
-\series bold
-(lisp-on-lines::find-class-attributes (make-instance 'user))
-\layout LyX-Code
-
-(USER (PASSWORD STRING :LABEL "PASSWORD" :SLOT-NAME PASSWORD)
-\layout LyX-Code
-
- (USERNAME STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
-\layout LyX-Code
-
- (USERID INTEGER :LABEL "USERID" :SLOT-NAME USERID)
-\layout LyX-Code
-
- NIL)
-\layout Standard
-
-Using that information, we have enough to create an interface to the object.
-
-\noun on
-UnCommon Web
-\noun default
- includes a powerful presentation system
-\begin_inset Foot
-collapsed true
-
-\layout Standard
-
-To see this system in action, we strongly recomend to study the presentations
- example which comes with
-\noun on
-UnCommon Web
-\noun default
-.
- Reading components/presentations.lisp can help understand a lot about how
- presentations are built.
-\end_inset
-
-, but it is not dynamic enough for some of the most advanced applications.
- Mewa defines an approach to presentations that solves that problem, but
- the paper is written from a
-\noun on
-Smalltalk
-\noun default
- point of view.
- A mixture of the two , Mewa Presentations(MP), is described here.
-\layout Standard
-
-MP introduces to
-\noun on
-UnCommon Web
-\noun default
- the concept of
-\emph on
-attributes
-\emph default
-.
- An attribute is essentially a named version of the DEFPRESENTATION slot-like
- arguments, for example in :
-\layout LyX-Code
-
->
-\series bold
-(defpresentation person-editor (object-presentation)
-\layout LyX-Code
-
-
-\series bold
- ((string :label "First Name" :slot-name 'first-name :max-length 30)))
-\layout Standard
-
-the (string :label "First Name" ...) form is an attribute definiton.
- Attributes are accessed through FIND-ATTIRIBUTES, and are composed at run
- time (where the
-\noun on
-UnCommon Web
-\noun default
-'s presentation system is done at compile time) to display the object.
- This allows a very flexible system of displaying objects which is reminiscent
- of
-\noun on
-CSS
-\noun default
-
-\begin_inset Foot
-collapsed false
-
-\layout Standard
-
-
-\noun on
-Drew Crampsie
-\noun default
- discovered this, rather than invent or design it, so there are some rough
- edges, but its a good start.
- Exploration baby yeah!
-\end_inset
-
-.
-\layout Standard
-
-Its much easier to show this than to tell.
- Lets present our user class.
- Currently in
-\noun on
-UnCommon Web
-\noun default
-, you'd define a presentation as such :
-\layout LyX-Code
-
->
-\series bold
-(defpresentation user-presentation (object-presentation)
-\layout LyX-Code
-
-((INTEGER :LABEL "USERID" :SLOT-NAME USERID)
-\layout LyX-Code
-
- (STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
-\layout LyX-Code
-
- (STRING :LABEL "PASSWORD" :SLOT-NAME PASSWORD)))
-\layout Standard
-
-which could be presented using PRESENT-OBJECT :
-\layout LyX-Code
-
->
-\series bold
-(present-object user :using 'user-presentation)
-\layout Standard
-
-The equivalent approach using mewa presentations is actually longer and
- more verbose(!) but it serves to demonstrate how the MP system works.
-\layout Standard
-
-Mewa Presentations adds a set of attributes to a class, keyed off the class
- name.
- Attributes are inherited, so if you define an attribute on T, you can use
- it with any class.
-\layout Standard
-
-MP stores named attributes keyed on a class name.
- To achieve the same functionality as the above using mp would look like
- this :
-\layout LyX-Code
-
->
-\series bold
-(setf (lisp-on-lines::find-attribute 'user :viewer)
-\begin_inset Marginal
-collapsed true
-
-\layout Standard
-
-Isn't this too imperative (in contrast to functional, lispy).
-\end_inset
-
-
-\layout LyX-Code
-
-
-\series bold
- '(lisp-on-lines::mewa-object-presentation
-\layout LyX-Code
-
-
-\series bold
- :attributes (userid username password)
-\layout LyX-Code
-
-
-\series bold
- :global-properties (:editablep nil)))
-\layout LyX-Code
-
-(:VIEWER MEWA-OBJECT-PRESENTATION
-\layout LyX-Code
-
- :ATTRIBUTES
-\layout LyX-Code
-
- (USERID USERNAME PASSWORD)
-\layout LyX-Code
-
- :GLOBAL-PROPERTIES
-\layout LyX-Code
-
- (:EDITABLEP NIL))
-\layout LyX-Code
-
->
-\series bold
-(setf (lisp-on-lines::find-attribute 'user 'userid)
-\begin_inset Marginal
-collapsed false
-
-\layout Standard
-
-Are this setfs to 'userid, 'username and 'password needed ? I (Pupeno) inspected
- they contents at of this moment and they seem to already contain what they
- are being set to.
-\end_inset
-
-
-\layout LyX-Code
-
-
-\series bold
- '(integer :label "userid" :slot-name userid))
-\layout LyX-Code
-
-(USERID INTEGER :LABEL "USERID" :SLOT-NAME USERID)
-\layout LyX-Code
-
->
-\series bold
-(setf (lisp-on-lines::find-attribute 'user 'username)
-\layout LyX-Code
-
-
-\series bold
- '(STRING :LABEL "USERNAME" :SLOT-NAME USERNAME))
-\layout LyX-Code
-
-(USERNAME STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
-\layout LyX-Code
-
->
-\series bold
-(setf (lisp-on-lines::find-attribute 'user 'password)
-\layout LyX-Code
-
-
-\series bold
- '(STRING :LABEL "USERNAME" :SLOT-NAME PASSWORD))
-\layout LyX-Code
-
-(PASSWORD STRING :LABEL "USERNAME" :SLOT-NAME PASSWORD)
-\layout LyX-Code
-
->
-\series bold
-(lisp-on-lines::find-class-attributes 'user)
-\layout LyX-Code
-
-(USER
-\layout LyX-Code
-
- (:VIEWER MEWA-OBJECT-PRESENTATION
-\layout LyX-Code
-
- :ATTRIBUTES
-\layout LyX-Code
-
- (USERID USERNAME PASSWORD)
-\layout LyX-Code
-
- :GLOBAL-PROPERTIES
-\layout LyX-Code
-
- (:EDITABLEP NIL))
-\layout LyX-Code
-
- (PASSWORD STRING :LABEL "PASSWORD" :SLOT-NAME PASSWORD)
-\layout LyX-Code
-
- (USERNAME STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
-\layout LyX-Code
-
- (USERID INTEGER :LABEL "USERID" :SLOT-NAME USERID)
-\layout LyX-Code
-
- NIL)
-\layout Standard
-
-this is all turned into a
-\noun on
-UnCommon Web
-\noun default
- presentation at runtime using MAKE-PRESENTATION, for example, the following
- code should be enough to show what's built so far attached to the examples
- application:
-\layout LyX-Code
-
->
-\series bold
-(defcomponent lol-example (window-component)
-\layout LyX-Code
-
-
-\series bold
- ())
-\layout LyX-Code
-
->
-\series bold
-(defmethod render-on ((res response) (lol-example lol-example))
-\layout LyX-Code
-
-
-\series bold
- (<:h1 "User")
-\layout LyX-Code
-
-
-\series bold
- (<ucw:render-component :component (lisp-on-lines::make-presentation
- user :type :viewer)))
-\layout LyX-Code
-
->
-\series bold
-(defentry-point "lol.ucw" (:application *example-application*) ()
-\layout LyX-Code
-
-
-\series bold
- (call 'lol-example))
-\layout Standard
-
-As you'll see, nothing is exported from the LISP-ON-LINES package.
- If you wish to use LOL in your own package (or in UCW-USER or whatever),
- you simply need to use the MEWA and META-MODEL packages.
-\layout Standard
-
-SET-ATTRIBUTE can be used in place of (setf (find-attribute ...)) when you
- want to "inherit" the properties of an existing attribute definition :
-\layout LyX-Code
-
-LISP-ON-LINES>
-\series bold
-(set-attribute 'user 'password '(string :label "password: (must be at least
- 8 chars)"))
-\layout LyX-Code
-
-(PASSWORD STRING
-\layout LyX-Code
-
-:LABEL
-\layout LyX-Code
-
-"password: (must be at leat 8 chars)"
-\layout LyX-Code
-
-:SLOT-NAME
-\layout LyX-Code
-
-PASSWORD)
-\layout Standard
-
-Now we want to create a presentation with which to edit the username.
- we will use the existing attributes on a subclass of mewa-object-presetation
- :
-\layout LyX-Code
-
->
-\series bold
-(defcomponent user-editor (mewa-object-presentation)
-\layout LyX-Code
-
-
-\series bold
- ()
-\layout LyX-Code
-
-
-\series bold
- (:default-initargs
-\layout LyX-Code
-
-
-\series bold
- :attributes '((username :label "Enter your New Username") password)
-\layout LyX-Code
-
-
-\series bold
- :global-properties '(:editablep t)))
-\layout LyX-Code
-
-USER-EDITOR
-\layout LyX-Code
-
-LISP-ON-LINES>
-\series bold
-(setf (find-attribute 'user :editor) '(user-editor))
-\layout LyX-Code
-
-(:EDITOR USER-EDITOR)
-\layout Standard
-
-which we then can display below our earlier example :
-\layout LyX-Code
-
-
-\series bold
-(defmethod render-on ((res response) (e presentations-index))
-\layout LyX-Code
-
-
-\series bold
-"
-\layout LyX-Code
-
-
-\series bold
-As you'll see, nothing is exported from the LISP-ON-LINES package.
-
-\layout LyX-Code
-
-
-\series bold
-if you wish to use LOL in your own package (or in UCW-USER or whatever),
-\layout LyX-Code
-
-
-\series bold
-you simply need to use the MEWA and META-MODEL packages"
-\layout LyX-Code
-
-
-\series bold
-(<ucw:render-component :component (lisp-on-lines::make-presentation lisp-on-line
-s::user :type :viewer))
-\layout LyX-Code
-
-
-\series bold
-(<ucw:render-component :component (lisp-on-lines::make-presentation lisp-on-line
-s::user :type :editor)))
-\layout Standard
-
-that should give you some idea on how it works ..
- ask me when you get confused :)
-\layout Section
-
-Pupeno's Example
-\layout Standard
-
-This is Pupeno's view of how to do rapid developing of a database-driven
- web application.
- It currently is going to assume a very specific case but latter it may
- be made bigger.
-\layout Standard
-
-We first start with a
-\noun on
-PostgreSQL
-\noun default
- connection of CLSQL which is set up with one line:
-\layout LyX-Code
-
->
-\series bold
-(clsql:connect '("localhost" "geo" "geo" "geogeo"))
-\layout Standard
-
-which connect us to the server on
-\family typewriter
-localhost
-\family default
-, to the database
-\family typewriter
-geo
-\family default
- as user
-\begin_inset Quotes eld
-\end_inset
-
-geo
-\begin_inset Quotes erd
-\end_inset
-
- with password
-\begin_inset Quotes eld
-\end_inset
-
-geogeo
-\begin_inset Quotes erd
-\end_inset
-
- (this is not a smart way to generate password, don't do this).
- To have a nice SQL environment, we also want:
-\layout LyX-Code
-
->
-\series bold
-(clsql:locally-enable-sql-reader-syntax)
-\layout LyX-Code
-
->
-\series bold
-(setf clsql:*default-caching* nil)
-\layout Standard
-
-Actually, it is more than a nice environmnet, without those lines the rest
- of the code won't work.
-\layout Standard
-
-On the
-\family typewriter
-geo
-\family default
- database, there's a table called
-\family typewriter
-product
-\family default
- which has the following structure:
-\layout LyX-Code
-
-
-\series bold
-CREATE TABLE product (
-\layout LyX-Code
-
-
-\series bold
- id serial NOT NULL,
-\layout LyX-Code
-
-
-\series bold
- name text NOT NULL,
-\layout LyX-Code
-
-
-\series bold
- details text,
-\layout LyX-Code
-
-
-\series bold
- description text,
-\layout LyX-Code
-
-
-\series bold
- cost double precision,
-\layout LyX-Code
-
-
-\series bold
- CONSTRAINT product_cost_check CHECK ((cost > (0)::double precision))
-\layout LyX-Code
-
-
-\series bold
-);
-\layout LyX-Code
-
-
-\series bold
-ALTER TABLE ONLY product ADD CONSTRAINT product_name_key UNIQUE (name);
-\layout LyX-Code
-
-
-\series bold
-ALTER TABLE ONLY product ADD CONSTRAINT product_pkey PRIMARY KEY (id);
-\layout Standard
-
-
-\color red
-ToDo: express the table structure in a better way.
-\layout Standard
-
-Now we'll create the class that represents a product, mirroring the database
- structure:
-\layout LyX-Code
-
->
-\series bold
-(lisp-on-lines::def-view-class/table "product")
-\layout Standard
-
-and then we generate the default attributes (from
-\family typewriter
-product
-\family default
-'s slots) and assign it to
-\family typewriter
-product
-\family default
-:
-\layout LyX-Code
-
->
-\series bold
-(lisp-on-lines::set-default-attributes (make-instance 'product))-
-\begin_inset Marginal
-collapsed true
-
-\layout Standard
-
-set-default-attributes is marked to be renamed to set-generated-attributes.
-\end_inset
-
-
-\layout Standard
-\align left
-As you can see, we instantiate
-\family typewriter
-product
-\family default
- to pass it to
-\family typewriter
-set-default-attributes
-\family default
-, because it expects an object instead of a class.
- We don't need the object anymore, so we don't save any reference to it.
- In the future we might have a
-\family typewriter
-set-default-attributes
-\family default
- that can use a class directly.
- Now we set a the attribute
-\family typewriter
-:viewer
-\family default
- to contain the
-\family typewriter
-mewa-object-presentation
-\family default
- exposing the attributes we like the user to work with:
-\layout LyX-Code
-
->
-\series bold
-(setf (lisp-on-lines::find-attribute (make-instance 'product) :viewer)
-\layout LyX-Code
-
-
-\series bold
- '(lisp-on-lines::mewa-object-presentation
-\layout LyX-Code
-
-
-\series bold
- :attributes (name details description cost)
-\layout LyX-Code
-
-
-\series bold
- :global-properties (:editablep nil)))
-\layout Standard
-
-The last parameter is a list of properties that will be applied to each
- attribute.
-\layout Section
-
-Yet Another Example .
-\layout Standard
-
-Drew Crampsie Posted the following to comp.lang.lisp ..
- it just might help until he writes some real documentation.
-
-\layout Standard
-
-I've written a system that generates presentations for database objects
- based on the type and relation information in the system catalog.
- Its based on Mewa
-\begin_inset Foot
-collapsed true
-
-\layout Standard
-
-Mewa : Meta-level Architecture for Generic Web-Application Construction
-\layout Standard
-
-http://map1.squeakfoundation.org/sm/package/32c5401f-fa30-4a2b-80c8-1006dd462859
-\end_inset
-
- clsql + postgres and the UCW presentation components.
-\layout Standard
-
-This is the code to add a new contact to the system.
- (screenshot pr0n follows).
-\layout Standard
-
-In the RENDER-ON method of my front-page i have :
-\layout LyX-Code
-
-(let ((p (make-instance 'person :person-type-code nil)))
-\layout LyX-Code
-
- (<:as-html "Add Person :")
-\layout LyX-Code
-
- (<ucw:render-component
-\layout LyX-Code
-
- :component (make-presentation
-\layout LyX-Code
-
- p
-\layout LyX-Code
-
- :type :one-line
-\layout LyX-Code
-
- :initargs '(:attributes
-\layout LyX-Code
-
- ((person-type-code :editablep t)))))
-\layout LyX-Code
-
- (<ucw:submit :action (new-person self p) :value "add"))
-\layout LyX-Code
-
-\layout Standard
-
-This creates a drop-down list of person-types and an "add" button which
- calls NEW-PERSON :
-\layout LyX-Code
-
-(defaction new-person ((self component) person)
-\layout LyX-Code
-
- "
-\layout LyX-Code
-
-Take a PERSON with a user-defined PERSON-TYPE-CODE,
-\layout LyX-Code
-
- * Prompt the user for a FIRST-NAME, LAST-NAME and/or COMPANY-NAME
-\layout LyX-Code
-
- * Search for similar PERSONs in the database.
-\layout LyX-Code
-
- * If they exist, ask the user to select one or continue
-\layout LyX-Code
-
- * otherwise, just continue editing the person"
-\layout LyX-Code
-
- (let ((named-person
-\layout LyX-Code
-
- (call-component self (make-presentation
-\layout LyX-Code
-
- person
-\layout LyX-Code
-
- :type 'new-person
-\layout LyX-Code
-
- :initargs '(:global-properties
-\layout LyX-Code
-
- (:size 25 :editablep t))))))
-\layout LyX-Code
-
- (when named-person
-\layout LyX-Code
-
- (call-component self (make-presentation
-\layout LyX-Code
-
- (find-or-return-named-person self named-person)
-\layout LyX-Code
-
- :type :editor)))))
-\layout LyX-Code
-
-\layout LyX-Code
-
-(defaction find-or-return-named-person ((self component) person)
-\layout LyX-Code
-
- "
-\layout LyX-Code
-
-If any similiar contacts exist in the database,
-\layout LyX-Code
-
-select one or continue with the current person
-\layout LyX-Code
-
-PERSON must have FIRST-NAME, LAST-NAME and COMPANY-NAME bound."
-\layout LyX-Code
-
- (let ((instances (sql-word-search person 'first-name 'last-name 'company-name)
-))
-\layout LyX-Code
-
- (if instances
-\layout LyX-Code
-
- (call-component self (make-presentation
-\layout LyX-Code
-
- person
-\layout LyX-Code
-
- :type 'person-chooser
-\layout LyX-Code
-
- :initargs
-\layout LyX-Code
-
- `(:instances ,instances)))
-\layout LyX-Code
-
- person)))
-\layout LyX-Code
-
-\layout Standard
-
-You can hardly tell it's a web application ...
- there is no checking of CGI params etc...
- just nice code in the order i wanted to write it.
-\layout Standard
-
-Screenshots :
-\layout Itemize
-
-http://tech.coop/img/screenshots/select-person-type.jpg
-\layout Itemize
-
-http://tech.coop/img/screenshots/enter-person-name.jpg
-\layout Itemize
-
-http://tech.coop/img/screenshots/select-similar-contacts.jpg
-\layout Itemize
-
-http://tech.coop/img/screenshots/edit-person-details.jpg
-\layout Itemize
-
-http://tech.coop/img/screenshots/view-recent-changes.jpg
-\layout Standard
-
-All of the code used to create the presentations for this is below my sig.
- I do eventually plan to release the presentation system as Free Software,
- it just needs a little cleaning up.
- E-mail me for a sneak peak.
-\layout LyX-Code
-
---
-\layout LyX-Code
-
-Drew Crampsie
-\layout LyX-Code
-
-drewc at tech dot coop
-\layout LyX-Code
-
-"Never mind the bollocks -- here's the sexp's tools."
-\layout LyX-Code
-
- -- Karl A.
- Krueger on comp.lang.lisp
-\layout LyX-Code
-
-\layout LyX-Code
-
-(def-view-class/table "person")
-\layout LyX-Code
-
-\layout LyX-Code
-
-(set-default-attributes (make-instance 'person)
-\layout LyX-Code
-
-\layout LyX-Code
-
-(defcomponent person-display (mewa::two-column-presentation)
-\layout LyX-Code
-
- ())
-\layout LyX-Code
-
-\layout LyX-Code
-
-(defcomponent one-line-person (mewa::mewa-one-line-presentation)
-\layout LyX-Code
-
- ()
-\layout LyX-Code
-
- (:default-initargs :attributes '(first-name last-name company-name)))
-\layout LyX-Code
-
-\layout LyX-Code
-
-(setf (find-attribute 'person :one-line) '(one-line-person))
-\layout LyX-Code
-
-\layout LyX-Code
-
-(set-attribute 'person 'person-type-code '(code-select :category 1))
-\layout LyX-Code
-
-\layout LyX-Code
-
-(set-attribute 'person 'province-state-code '(code-select :category 2))
-\layout LyX-Code
-
-\layout LyX-Code
-
-(setf (find-attribute 'person :viewer) '(person-display :global-properties
- (:editablep nil)))
-\layout LyX-Code
-
-\layout LyX-Code
-
-(set-attribute 'person :editor '(person-display :global-properties (:editablep
- t)))
-\layout LyX-Code
-
-\layout LyX-Code
-
-(setf (find-attribute 'person 'claim->adjuster-id) '(ucw::has-very-many
- :label "Claims as Adjuster" :slot-name claim->adjuster-id ) )
-\layout LyX-Code
-
-\layout LyX-Code
-
-(set-attribute 'person 'policy->agent-id '(ucw::has-very-many :label "Policies
- as Agent"))
-\layout LyX-Code
-
-\layout LyX-Code
-
-(defcomponent new-person (person-display)
-\layout LyX-Code
-
- ()
-\layout LyX-Code
-
- (:default-initargs
-\layout LyX-Code
-
- :attributes '(first-name last-name company-name)))
-\layout LyX-Code
-
-\layout LyX-Code
-
-(defcomponent person-chooser (mewa::mewa-list-presentation)
-\layout LyX-Code
-
- ()
-\layout LyX-Code
-
- (:default-initargs
-\layout LyX-Code
-
- :attributes '(first-name
-\layout LyX-Code
-
- last-name
-\layout LyX-Code
-
- company-name
-\layout LyX-Code
-
- address
-\layout LyX-Code
-
- city
-\layout LyX-Code
-
- person-type-code)
-\layout LyX-Code
-
- :global-properties '(:editablep nil)
-\layout LyX-Code
-
- :editablep nil
-\layout LyX-Code
-
- :deleteablep nil))
-\layout LyX-Code
-
-\layout LyX-Code
-
-(defmethod render-on :wrapping ((res response) (self person-chooser))
-\layout LyX-Code
-
- (<:p (<:as-html "Similar contact(s) in database.
- You can :")
-\layout LyX-Code
-
- (<:ul
-\layout LyX-Code
-
- (<:li (<:as-html "Select one of the contacts below"))
-\layout LyX-Code
-
- (<:li (<ucw:a :action (answer (instance self))
-\layout LyX-Code
-
- (<:as-html "Continue, adding a new contact")))))
-\layout LyX-Code
-
- (call-next-method))
-\layout LyX-Code
-
-\layout LyX-Code
-
-(defaction ok ((self new-person) &optional arg)
-\layout LyX-Code
-
- (declare (ignore arg))
-\layout LyX-Code
-
- (answer (instance self)))
-\layout LyX-Code
-
-\layout LyX-Code
-
-(defmethod sql-word-search ((instance standard-db-object) &rest slots)
-\layout LyX-Code
-
- (let ((names
-\layout LyX-Code
-
- (loop for slot in slots
-\layout LyX-Code
-
- nconc (split-sequence #
-\backslash
-Space (slot-value instance slot)))))
-\layout LyX-Code
-
- (select (class-name (class-of instance))
-\layout LyX-Code
-
- :where (sql-or (mapcar #'(lambda (x)
-\layout LyX-Code
-
- (when (< 0 (length x))
-\layout LyX-Code
-
- (apply #'sql-or
-\layout LyX-Code
-
- (mapcar #'(lambda (y)
-\layout LyX-Code
-
- (sql-uplike
-\layout LyX-Code
-
-(sql-slot-value 'person y)
-\layout LyX-Code
-
- (format nil
- "%~a%" x)))
-\layout LyX-Code
-
- slots))))
-\layout LyX-Code
-
- names))
-\layout LyX-Code
-
- :flatp t)))
-\layout LyX-Code
-
-\the_end
+++ /dev/null
-LISP-ON-LINES
-
-Drew Crampsie, José Pablo Ezequiel "Pupeno" Fernández Silva
-
-Abstract
-
-Lisp-On-Lines is a very useful module that works on top
-of the UnCommon Web framework to do rapid developing of
-complex data-driven web appilcations (on Common Lisp,
-of course).
-
-1 Introduction
-
-Lisp-On-Lines was founded and developed and continues
-to be developed and mantained by Drew Crampsie.
-
-1.1 Conventions
-
-The conventions used in this manual are:
-
-* Code is shown in a monospace font. When it is
- expected that the user is working in an interactive
- environment what the user should type appears as
- bold, while the computer result appears non-bold, for example:
-
- > (+ 5 10)
-
- 15
-
-* Names of people or products are show as small caps,
- like Drew Crampsie or Lisp-On-Lines.
-
-* Sections marked with ToDo require further revision.
-
-ToDo: Add more conventions as they are needed, possible
-classes of text: names of concepts, name of programming
-entities, like variables, functions, etc (which are
-embedded in text, should they be shown monospaced ?).
-
-2 Components
-
- Meta Model Protocol A Protocol for introspection on
- relational objects.
-
- Mewa Presentations A Mewa-likehttp://www.adrian-lienhard.ch/files/mewa.pdf layer for UncommonWebhttp://common-lisp.net/project/ucw/
- Presentations.
-
-3 Example
-
-First we start with the data model. The Meta Model
-Protocol (MMP) is used to provide information on the
-data objects and how they relate to one another. Its is
-currently implemented as a layer over CLSQLhttp://clsql.b9.com/, although
-support is planned for other backends (CLOS,
-Elephant[4], whatever).
-
-The MMP shares its definition syntax with CLSQL's
-Object Oriented Data Definition Language (OODDL)http://clsql.b9.com/manual/ref-ooddl.html. The
-macro to define view-classes is named
-DEF-VIEW-CLASS/META, and takes the same arguments as
-DEF-VIEW-CLASS from CLSQL. For the purposes of this
-simple example, we will only need two functions from
-the MMP beyond what CLSQL provides : LIST-SLOTS and
-LIST-SLOT-TYPES[5].
-
-We'll define a simple class to hold a user.
-
-> (def-view-class/meta user ()
-
- ((userid :initarg :userid :accessor userid :type
-integer :db-kind :key)
-
- (username :initarg :username :accessor username
-:type string :db-kind :base)
-
- (password :initarg :password :accessor password
-:type string :db-kind :base)))
-
-and now we create a user:
-
-> (defparameter user (make-instance 'user :userid 1
-
- :username "drewc"
-
- :password "p@ssw0rd"))
-
-We can see the slots of users running:
-
-> (lisp-on-lines::list-slots user)
-
-(USERID USERNAME PASSWORD)
-
-or the types with:
-
-> (lisp-on-lines::list-slot-types user)
-
-((USERID INTEGER) (USERNAME STRING) (PASSWORD STRING))
-
-To see the default attributes of a classIs this correct ? Drew, please, check. we run.
-
-> (lisp-on-lines::default-attributes user)
-
-((USERID INTEGER :LABEL "USERID" :SLOT-NAME USERID)
-
- (USERNAME STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
-
- (PASSWORD STRING :LABEL "PASSWORD" :SLOT-NAME PASSWORD))
-
-To set the attributes of a class to the default values
-we use:
-
-> (lisp-on-lines::set-default-attributes user)
-
-((USERID INTEGER :LABEL "USERID" :SLOT-NAME USERID)
-
- (USERNAME STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
-
- (PASSWORD STRING :LABEL "PASSWORD" :SLOT-NAME PASSWORD))
-
-which takes an object of the class we are working with.
-This is going to be change so we can do this action
-directly on the class. It is on the TODO file.
-
-Class attributes?
-
-> (lisp-on-lines::find-class-attributes user)
-
-(USER (PASSWORD STRING :LABEL "PASSWORD" :SLOT-NAME PASSWORD)
-
- (USERNAME STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
-
- (USERID INTEGER :LABEL "USERID" :SLOT-NAME USERID)
-
- NIL)
-
-note that the mewa functions (find-attribute,
-set-attribute etc) can take either an instance, or a
-class-name as a symbol:
-
-> (lisp-on-lines::find-class-attributes 'user)
-
-(USER (PASSWORD STRING :LABEL "PASSWORD" :SLOT-NAME PASSWORD)
-
- (USERNAME STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
-
- (USERID INTEGER :LABEL "USERID" :SLOT-NAME USERID)
-
- NIL)
-
-> (lisp-on-lines::find-class-attributes (make-instance 'user))
-
-(USER (PASSWORD STRING :LABEL "PASSWORD" :SLOT-NAME PASSWORD)
-
- (USERNAME STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
-
- (USERID INTEGER :LABEL "USERID" :SLOT-NAME USERID)
-
- NIL)
-
-Using that information, we have enough to create an
-interface to the object. UnCommon Web includes a
-powerful presentation systemTo see this system in action, we strongly recomend to
-study the presentations example which comes with
-UnCommon Web. Reading components/presentations.lisp can
-help understand a lot about how presentations are built.
-, but it is not dynamic enough for some of the most
-advanced applications. Mewa defines an approach to
-presentations that solves that problem, but the paper
-is written from a Smalltalk point of view. A mixture of
-the two , Mewa Presentations(MP), is described here.
-
-MP introduces to UnCommon Web the concept of
-attributes. An attribute is essentially a named version
-of the DEFPRESENTATION slot-like arguments, for example
-in :
-
-> (defpresentation person-editor (object-presentation)
-
- ((string :label "First Name" :slot-name 'first-name
-:max-length 30)))
-
-the (string :label "First Name" ...) form is an
-attribute definiton. Attributes are accessed through
-FIND-ATTIRIBUTES, and are composed at run time (where
-the UnCommon Web's presentation system is done at
-compile time) to display the object. This allows a very
-flexible system of displaying objects which is
-reminiscent of CSSDrew Crapmsie discovered this, rather than invent or
-design it, so there are some rough edges, but its a
-good start.
-.
-
-Its much easier to show this than to tell. Lets present
-our user class. Currently in UnCommon Web, you'd define
-a presentation as such :
-
-> (defpresentation user-presentation (object-presentation)
-
-((INTEGER :LABEL "USERID" :SLOT-NAME USERID)
-
- (STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
-
- (STRING :LABEL "PASSWORD" :SLOT-NAME PASSWORD)))
-
-which could be presented using PRESENT-OBJECT :
-
-> (present-object user :using 'user-presentation)
-
-The equivalent approach using mewa presentations is
-actually longer and more verbose(!) but it serves to
-demonstrate how the MP system works.
-
-Mewa Presentations adds a set of attributes to a class,
-keyed off the class name. Attributes are inherited, so
-if you define an attribute on T, you can use it with
-any class.
-
-MP stores named attributes keyed on a class name. To
-achieve the same functionality as the above using mp
-would look like this :
-
-> (setf (lisp-on-lines::find-attribute 'user :viewer)Isn't this too imperative (in contrast to functional, lispy).
-
- '(lisp-on-lines::mewa-object-presentation
-
- :attributes (userid username password)
-
- :global-properties (:editablep nil)))
-
-(:VIEWER MEWA-OBJECT-PRESENTATION
-
- :ATTRIBUTES
-
- (USERID USERNAME PASSWORD)
-
- :GLOBAL-PROPERTIES
-
- (:EDITABLEP NIL))
-
-> (setf (lisp-on-lines::find-attribute 'user 'userid)Are this setfs to 'userid, 'username and 'password
-needed ? I (Pupeno) inspected they contents at of this
-moment and they seem to already contain what they are
-being set to.
-
- '(integer :label "userid" :slot-name userid))
-
-(USERID INTEGER :LABEL "USERID" :SLOT-NAME USERID)
-
-> (setf (lisp-on-lines::find-attribute 'user 'username)
-
- '(STRING :LABEL "USERNAME" :SLOT-NAME USERNAME))
-
-(USERNAME STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
-
-> (setf (lisp-on-lines::find-attribute 'user 'password)
-
- '(STRING :LABEL "USERNAME" :SLOT-NAME PASSWORD))
-
-(PASSWORD STRING :LABEL "USERNAME" :SLOT-NAME PASSWORD)
-
-> (lisp-on-lines::find-class-attributes 'user)
-
-(USER
-
- (:VIEWER MEWA-OBJECT-PRESENTATION
-
- :ATTRIBUTES
-
- (USERID USERNAME PASSWORD)
-
- :GLOBAL-PROPERTIES
-
- (:EDITABLEP NIL))
-
- (PASSWORD STRING :LABEL "PASSWORD" :SLOT-NAME PASSWORD)
-
- (USERNAME STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
-
- (USERID INTEGER :LABEL "USERID" :SLOT-NAME USERID)
-
- NIL)
-
-this is all turned into a UnCommon Web presentation at
-runtime using MAKE-PRESENTATION, for example, the
-following code should be enough to show what's built so
-far attached to the examples application:
-
-> (defcomponent lol-example (window-component)
-
- ())
-
-> (defmethod render-on ((res response) (lol-example lol-example))
-
- (<:h1 "User")
-
- (<ucw:render-component :component
-(lisp-on-lines::make-presentation user :type :viewer)))
-
-> (defentry-point "lol.ucw" (:application
-*example-application*) ()
-
- (call 'lol-example))
-
-As you'll see, nothing is exported from the
-LISP-ON-LINES package. If you wish to use LOL in your
-own package (or in UCW-USER or whatever), you simply
-need to use the MEWA and META-MODEL packages.
-
-SET-ATTRIBUTE can be used in place of (setf
-(find-attribute ...)) when you want to "inherit" the
-properties of an existing attribute definition :
-
-LISP-ON-LINES> (set-attribute 'user 'password '(string
-:label "password: (must be at least 8 chars)"))
-
-(PASSWORD STRING
-
-:LABEL
-
-"password: (must be at leat 8 chars)"
-
-:SLOT-NAME
-
-PASSWORD)
-
-Now we want to create a presentation with which to edit
-the username. we will use the existing attributes on a
-subclass of mewa-object-presetation :
-
-> (defcomponent user-editor (mewa-object-presentation)
-
- ()
-
- (:default-initargs
-
- :attributes '((username :label "Enter your New
-Username") password)
-
- :global-properties '(:editablep t)))
-
-USER-EDITOR
-
-LISP-ON-LINES> (setf (find-attribute 'user :editor)
-'(user-editor))
-
-(:EDITOR USER-EDITOR)
-
-which we then can display below our earlier example :
-
-(defmethod render-on ((res response) (e presentations-index))
-
-"
-
-As you'll see, nothing is exported from the
-LISP-ON-LINES package.
-
-if you wish to use LOL in your own package (or in
-UCW-USER or whatever),
-
-you simply need to use the MEWA and META-MODEL
-packages"
-
-(<ucw:render-component :component
-(lisp-on-lines::make-presentation lisp-on-lines::user
-:type :viewer))
-
-(<ucw:render-component :component
-(lisp-on-lines::make-presentation lisp-on-lines::user
-:type :editor)))
-
-that should give you some idea on how it works .. ask
-me when you get confused :)
-
-4 Pupeno's Example
-
-This is Pupeno's view of how to do rapid developing of
-a database-driven web application. It currently is
-going to assume a very specific case but latter it may
-be made bigger.
-
-We first start with a PostgreSQL connection of CLSQL
-which is set up with one line:
-
-> (clsql:connect '("localhost" "geo" "geo" "geogeo"))
-
-which connect us to the server on localhost, to the
-database geo as user "geo" with password "geogeo" (this is
-not a smart way to generate password, don't do this).
-To have a nice SQL environment, we also want:
-
-> (clsql:locally-enable-sql-reader-syntax)
-
-> (setf clsql:*default-caching* nil)
-
-Actually, it is more than a nice environmnet, without
-those lines the rest of the code won't work.
-
-On the geo database, there's a table called product
-which has the following structure:
-
-CREATE TABLE product (
-
- id serial NOT NULL,
-
- name text NOT NULL,
-
- details text,
-
- description text,
-
- cost double precision,
-
- CONSTRAINT product_cost_check CHECK ((cost >
-(0)::double precision))
-
-);
-
-ALTER TABLE ONLY product ADD CONSTRAINT
-product_name_key UNIQUE (name);
-
-ALTER TABLE ONLY product ADD CONSTRAINT product_pkey
-PRIMARY KEY (id);
-
-ToDo: express the table structure in a better way.
-
-Now we'll create the class that represents a product,
-mirroring the database structure:
-
-> (lisp-on-lines::def-view-class/table "product")
-
-and then we generate the default attributes (from
-product's slots) and assign it to product:
-
-> (lisp-on-lines::set-default-attributes (make-instance
-'product))set-default-attributes is marked to be renamed to
-set-generated-attributes.
-
-As you can see, we instantiate product to pass it to
-set-default-attributes, because it expects an object
-instead of a class. We don't need the object anymore,
-so we don't save any reference to it. In the future we
-might have a set-default-attributes that can use a
-class directly. Now we set a the attribute :viewer to
-contain the mewa-object-presentation exposing the
-attributes we like the user to work with:
-
-> (setf (lisp-on-lines::find-attribute (make-instance
-'product) :viewer)
-
- '(lisp-on-lines::mewa-object-presentation
-
- :attributes (name details description cost)
-
- :global-properties (:editablep nil)))
-
-The last parameter is a list of properties that will be
-applied to each attribute.
-
-5 Yet Another Example .
-
-Drew Crampsie Posted the following to comp.lang.lisp ..
-it just might help until he writes some real
-documentation.
-
-I've written a system that generates presentations for
-database objects based on the type and relation
-information in the system catalog. Its based on MewaMewa : Meta-level Architecture for Generic
-Web-Application Construction
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-http://map1.squeakfoundation.org/sm/package/32c5401f-fa30-4a2b-80c8-1006dd462859
- clsql + postgres and the UCW presentation components.
-
-This is the code to add a new contact to the system.
-(screenshot pr0n follows).
-
-In the RENDER-ON method of my front-page i have :
-
-
-
-(let ((p (make-instance 'person :person-type-code nil)))
-
- (<:as-html "Add Person :")
-
- (<ucw:render-component
-
- :component (make-presentation
-
- p
-
- :type :one-line
-
- :initargs '(:attributes
-
- ((person-type-code
-:editablep t)))))
-
- (<ucw:submit :action (new-person self p) :value "add"))
-
-
-
-
-
-This creates a drop-down list of person-types and an
-"add" button which calls NEW-PERSON :
-
-(defaction new-person ((self component) person)
-
- "
-
-Take a PERSON with a user-defined PERSON-TYPE-CODE,
-
- * Prompt the user for a FIRST-NAME, LAST-NAME and/or
-COMPANY-NAME
-
- * Search for similar PERSONs in the database.
-
- * If they exist, ask the user to select one or continue
-
- * otherwise, just continue editing the person"
-
- (let ((named-person
-
- (call-component self (make-presentation
-
- person
-
- :type 'new-person
-
- :initargs '(:global-properties
-
- (:size 25
-:editablep t))))))
-
- (when named-person
-
- (call-component self (make-presentation
-
-
-(find-or-return-named-person self named-person)
-
- :type :editor)))))
-
-
-
-(defaction find-or-return-named-person ((self
-component) person)
-
- "
-
-If any similiar contacts exist in the database,
-
-select one or continue with the current person
-
-PERSON must have FIRST-NAME, LAST-NAME and COMPANY-NAME bound."
-
- (let ((instances (sql-word-search person 'first-name
-'last-name 'company-name)))
-
- (if instances
-
- (call-component self (make-presentation
-
- person
-
- :type 'person-chooser
-
- :initargs
-
- `(:instances ,instances)))
-
- person)))
-
-You can hardly tell it's a web application ... there is
-no checking of CGI params etc... just nice code in the
-order i wanted to write it.
-
-Screenshots :
-
-* http://tech.coop/img/screenshots/select-person-type.jpg
-
-* http://tech.coop/img/screenshots/enter-person-name.jpg
-
-* http://tech.coop/img/screenshots/select-similar-contacts.jpg
-
-* http://tech.coop/img/screenshots/edit-person-details.jpg
-
-* http://tech.coop/img/screenshots/view-recent-changes.jpg
-
-All of the code used to create the presentations for
-this is below my sig. I do eventually plan to release
-the presentation system as Free Software, it just needs
-a little cleaning up. E-mail me for a sneak peak.
-
---
-
-Drew Crampsie
-
-drewc at tech dot coop
-
-"Never mind the bollocks -- here's the sexp's tools."
-
- -- Karl A. Krueger on comp.lang.lisp
-
-
-
-(def-view-class/table "person")
-
-
-
-(set-default-attributes (make-instance 'person)
-
-
-
-(defcomponent person-display (mewa::two-column-presentation)
-
- ())
-
-
-
-(defcomponent one-line-person (mewa::mewa-one-line-presentation)
-
- ()
-
- (:default-initargs :attributes '(first-name last-name
-company-name)))
-
-
-
-(setf (find-attribute 'person :one-line) '(one-line-person))
-
-
-
-(set-attribute 'person 'person-type-code '(code-select
-:category 1))
-
-
-
-(set-attribute 'person 'province-state-code
-'(code-select :category 2))
-
-
-
-(setf (find-attribute 'person :viewer) '(person-display
-:global-properties (:editablep nil)))
-
-
-
-(set-attribute 'person :editor '(person-display
-:global-properties (:editablep t)))
-
-
-
-(setf (find-attribute 'person 'claim->adjuster-id)
-'(ucw::has-very-many :label "Claims as Adjuster"
-:slot-name claim->adjuster-id ) )
-
-
-
-(set-attribute 'person 'policy->agent-id
-'(ucw::has-very-many :label "Policies as Agent"))
-
-
-
-(defcomponent new-person (person-display)
-
- ()
-
- (:default-initargs
-
- :attributes '(first-name last-name company-name)))
-
-
-
-(defcomponent person-chooser (mewa::mewa-list-presentation)
-
- ()
-
- (:default-initargs
-
- :attributes '(first-name
-
- last-name
-
- company-name
-
- address
-
- city
-
- person-type-code)
-
- :global-properties '(:editablep nil)
-
- :editablep nil
-
- :deleteablep nil))
-
-
-
-(defmethod render-on :wrapping ((res response) (self
-person-chooser))
-
- (<:p (<:as-html "Similar contact(s) in database. You
-can :")
-
- (<:ul
-
- (<:li (<:as-html "Select one of the contacts below"))
-
- (<:li (<ucw:a :action (answer (instance self))
-
- (<:as-html "Continue, adding a
-new contact")))))
-
- (call-next-method))
-
-
-
-(defaction ok ((self new-person) &optional arg)
-
- (declare (ignore arg))
-
- (answer (instance self)))
-
-
-
-(defmethod sql-word-search ((instance
-standard-db-object) &rest slots)
-
- (let ((names
-
- (loop for slot in slots
-
- nconc (split-sequence #\Space
-(slot-value instance slot)))))
-
- (select (class-name (class-of instance))
-
- :where (sql-or (mapcar #'(lambda (x)
-
- (when (< 0
-(length x))
-
- (apply #'sql-or
-
-
-(mapcar #'(lambda (y)
-
-
- (sql-uplike
-
-(sql-slot-value 'person y)
-
-
- (format nil "%~a%" x)))
-
-
- slots))))
-
- names))
-
- :flatp t)))