--- /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
+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 true
+
+\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
HCoop / clinton / lisp-on-lines.git / blobdiff