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