doc/lisp-on-lines.lyx

   1 #LyX 1.3 created this file. For more info see http://www.lyx.org/
   2 \lyxformat 221
   3 \textclass article
   4 \language english
   5 \inputencoding auto
   6 \fontscheme default
   7 \graphics default
   8 \paperfontsize default
   9 \spacing single
  10 \papersize a4paper
  11 \paperpackage widemarginsa4
  12 \use_geometry 0
  13 \use_amsmath 0
  14 \use_natbib 0
  15 \use_numerical_citations 0
  16 \paperorientation portrait
  17 \secnumdepth 3
  18 \tocdepth 3
  19 \paragraph_separation indent
  20 \defskip medskip
  21 \quotes_language english
  22 \quotes_times 2
  23 \papercolumns 1
  24 \papersides 1
  25 \paperpagestyle default
  26
  27 \layout Title
  28
  29 LISP-ON-LINES
  30 \layout Author
  31
  32
  33 \noun on
  34 v v v v v v v
  35 Drew Crampsie
  36 ^ ^ ^ ^ ^ ^ ^
  37 \noun default
  38 ,
  39 \noun on
  40 José Pablo Ezequiel
  41 \begin_inset Quotes eld
  42 \end_inset
  43
  44 Pupeno
  45 \begin_inset Quotes erd
  46 \end_inset
  47
  48  Fernández Silva
  49 \layout Abstract
  50
  51
  52 \noun on
  53 Lisp-On-Lines
  54 \noun default
  55  is a very useful module that works on top of the
  56 \noun on
  57 UnCommon Web
  58 \noun default
  59  framework to do rapid developing of complex data-driven web appilcations
  60  (on
  61 \noun on
  62 Common Lisp
  63 \noun default
  64 , of course).
  65 \layout Section
  66
  67 Introduction
  68 \layout Standard
  69
  70
  71 \noun on
  72 Lisp-On-Lines
  73 \noun default
  74  was founded and developed and continues to be developed and mantained by
  75
  76 \noun on
  77 Drew Crampsie
  78 \noun default
  79 .
  80 \layout Subsection
  81
  82 Conventions
  83 \layout Standard
  84
  85 The conventions used in this manual are:
  86 \layout Itemize
  87
  88 Code is shown in a monospace font.
  89  When it is expected that the user is working in an interactive environment
  90  what the user should type appears as bold, while the computer result appears
  91  non-bold, for example:
  92 \begin_deeper
  93 \layout LyX-Code
  94
  95 >
  96 \series bold
  97 (+ 5 10)
  98 \layout LyX-Code
  99
 100 15
 101 \end_deeper
 102 \layout Itemize
 103
 104 Names of people or products are show as small caps, like
 105 \noun on
 106 Drew Crampsie
 107 \noun default
 108  or
 109 \noun on
 110 Lisp-On-Lines
 111 \noun default
 112 .
 113 \layout Itemize
 114
 115 Sections marked with
 116 \color red
 117 ToDo
 118 \color default
 119  require further revision.
 120 \layout Standard
 121
 122
 123 \color red
 124 ToDo: Add more conventions as they are needed, possible classes of text:
 125  names of concepts, name of programming entities, like variables, functions,
 126  etc (which are embedded in text, should they be shown monospaced ?).
 127 \layout Section
 128
 129 Components
 130 \layout Description
 131
 132 Meta\SpecialChar ~
 133 Model\SpecialChar ~
 134 Protocol A Protocol for introspection on relational objects.
 135 \layout Description
 136
 137 Mewa\SpecialChar ~
 138 Presentations A Mewa-like
 139 \begin_inset Foot
 140 collapsed true
 141
 142 \layout Standard
 143
 144 http://www.adrian-lienhard.ch/files/mewa.pdf
 145 \end_inset
 146
 147  layer for UncommonWeb
 148 \begin_inset Foot
 149 collapsed true
 150
 151 \layout Standard
 152
 153 http://common-lisp.net/project/ucw/
 154 \end_inset
 155
 156  Presentations.
 157 \layout Section
 158
 159 Example
 160 \layout Standard
 161
 162 First we start with the data model.
 163  The Meta Model Protocol (MMP) is used to provide information on the data
 164  objects and how they relate to one another.
 165  Its is currently implemented as a layer over CLSQL
 166 \begin_inset Foot
 167 collapsed true
 168
 169 \layout Standard
 170
 171 http://clsql.b9.com/
 172 \end_inset
 173
 174 , although support is planned for other backends (
 175 \noun on
 176 CLOS
 177 \noun default
 178 ,
 179 \noun on
 180 Elephant
 181 \noun default
 182 [4], whatever).
 183 \layout Standard
 184
 185 The MMP shares its definition syntax with
 186 \emph on
 187 \noun on
 188 CLSQL
 189 \emph default
 190 \noun default
 191 's Object Oriented Data Definition Language (OODDL)
 192 \begin_inset Foot
 193 collapsed true
 194
 195 \layout Standard
 196
 197 http://clsql.b9.com/manual/ref-ooddl.html
 198 \begin_inset Note
 199 collapsed true
 200
 201 \layout Standard
 202
 203 Shouldn't this footnote be a bibliographical entry ? or something like that
 204  ?
 205 \end_inset
 206
 207
 208 \end_inset
 209
 210 .
 211  The macro to define view-classes is named DEF-VIEW-CLASS/META, and takes
 212  the same arguments as DEF-VIEW-CLASS from CLSQL.
 213  For the purposes of this simple example, we will only need two functions
 214  from the MMP beyond what CLSQL provides : LIST-SLOTS and LIST-SLOT-TYPES[5].
 215 \layout Standard
 216
 217 We'll define a simple class to hold a user.
 218 \layout LyX-Code
 219
 220 >
 221 \series bold
 222 (def-view-class/meta user ()
 223 \layout LyX-Code
 224
 225
 226 \series bold
 227    ((userid :initarg :userid :accessor userid :type integer :db-kind :key)
 228 \layout LyX-Code
 229
 230
 231 \series bold
 232     (username :initarg :username :accessor username :type string :db-kind
 233  :base)
 234 \layout LyX-Code
 235
 236
 237 \series bold
 238     (password :initarg :password :accessor password :type string :db-kind
 239  :base)))
 240 \layout Standard
 241
 242 and now we create a user:
 243 \layout LyX-Code
 244
 245 >
 246 \series bold
 247 (defparameter user (make-instance 'user :userid 1
 248 \layout LyX-Code
 249
 250
 251 \series bold
 252                                           :username "drewc"
 253 \layout LyX-Code
 254
 255
 256 \series bold
 257                                           :password "p@ssw0rd"))
 258 \layout Standard
 259
 260 We can see the slots of users running:
 261 \layout LyX-Code
 262
 263 >
 264 \series bold
 265 (lisp-on-lines::list-slots user)
 266 \layout LyX-Code
 267
 268 (USERID USERNAME PASSWORD)
 269 \layout Standard
 270
 271 or the types with:
 272 \layout LyX-Code
 273
 274 >
 275 \series bold
 276 (lisp-on-lines::list-slot-types user)
 277 \layout LyX-Code
 278
 279 ((USERID INTEGER) (USERNAME STRING) (PASSWORD STRING))
 280 \layout Standard
 281
 282 To see the default attributes of a class
 283 \begin_inset Marginal
 284 collapsed true
 285
 286 \layout Standard
 287
 288 Is this correct ? Drew, please, check.
 289 \end_inset
 290
 291  we run.
 292 \layout LyX-Code
 293
 294 >
 295 \series bold
 296 (lisp-on-lines::default-attributes user)
 297 \layout LyX-Code
 298
 299 ((USERID INTEGER :LABEL "USERID" :SLOT-NAME USERID)
 300 \layout LyX-Code
 301
 302  (USERNAME STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
 303 \layout LyX-Code
 304
 305  (PASSWORD STRING :LABEL "PASSWORD" :SLOT-NAME PASSWORD))
 306 \layout Standard
 307
 308 To set the attributes of a class to the default values we use:
 309 \layout LyX-Code
 310
 311 >
 312 \series bold
 313 (lisp-on-lines::set-default-attributes user)
 314 \layout LyX-Code
 315
 316 ((USERID INTEGER :LABEL "USERID" :SLOT-NAME USERID)
 317 \layout LyX-Code
 318
 319  (USERNAME STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
 320 \layout LyX-Code
 321
 322  (PASSWORD STRING :LABEL "PASSWORD" :SLOT-NAME PASSWORD))
 323 \layout Standard
 324
 325 which takes an object of the class we are working with.
 326  This is going to be change so we can do this action directly on the class.
 327  It is on the TODO file.
 328 \layout Standard
 329
 330 Class attributes?
 331 \layout LyX-Code
 332
 333 >
 334 \series bold
 335 (lisp-on-lines::find-class-attributes user)
 336 \layout LyX-Code
 337
 338 (USER (PASSWORD STRING :LABEL "PASSWORD" :SLOT-NAME PASSWORD)
 339 \layout LyX-Code
 340
 341       (USERNAME STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
 342 \layout LyX-Code
 343
 344       (USERID INTEGER :LABEL "USERID" :SLOT-NAME USERID)
 345 \layout LyX-Code
 346
 347       NIL)
 348 \layout Standard
 349
 350 note that the mewa functions (find-attribute, set-attribute etc) can take
 351  either an instance, or a class-name as a symbol:
 352 \layout LyX-Code
 353
 354 >
 355 \series bold
 356 (lisp-on-lines::find-class-attributes 'user)
 357 \layout LyX-Code
 358
 359 (USER (PASSWORD STRING :LABEL "PASSWORD" :SLOT-NAME PASSWORD)
 360 \layout LyX-Code
 361
 362       (USERNAME STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
 363 \layout LyX-Code
 364
 365       (USERID INTEGER :LABEL "USERID" :SLOT-NAME USERID)
 366 \layout LyX-Code
 367
 368       NIL)
 369 \layout LyX-Code
 370
 371 >
 372 \series bold
 373 (lisp-on-lines::find-class-attributes (make-instance 'user))
 374 \layout LyX-Code
 375
 376 (USER (PASSWORD STRING :LABEL "PASSWORD" :SLOT-NAME PASSWORD)
 377 \layout LyX-Code
 378
 379       (USERNAME STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
 380 \layout LyX-Code
 381
 382       (USERID INTEGER :LABEL "USERID" :SLOT-NAME USERID)
 383 \layout LyX-Code
 384
 385       NIL)
 386 \layout Standard
 387
 388 Using that information, we have enough to create an interface to the object.
 389
 390 \noun on
 391 UnCommon Web
 392 \noun default
 393  includes a powerful presentation system
 394 \begin_inset Foot
 395 collapsed true
 396
 397 \layout Standard
 398
 399 To see this system in action, we strongly recomend to study the presentations
 400  example which comes with
 401 \noun on
 402 UnCommon Web
 403 \noun default
 404 .
 405  Reading components/presentations.lisp can help understand a lot about how
 406  presentations are built.
 407 \end_inset
 408
 409 , but it is not dynamic enough for some of the most advanced applications.
 410  Mewa defines an approach to presentations that solves that problem, but
 411  the paper is written from a
 412 \noun on
 413 Smalltalk
 414 \noun default
 415  point of view.
 416  A mixture of the two , Mewa Presentations(MP), is described here.
 417 \layout Standard
 418
 419 MP introduces to
 420 \noun on
 421 UnCommon Web
 422 \noun default
 423  the concept of
 424 \emph on
 425 attributes
 426 \emph default
 427 .
 428  An attribute is essentially a named version of the DEFPRESENTATION slot-like
 429  arguments, for example in :
 430 \layout LyX-Code
 431
 432 >
 433 \series bold
 434 (defpresentation person-editor (object-presentation)
 435 \layout LyX-Code
 436
 437
 438 \series bold
 439    ((string :label "First Name" :slot-name 'first-name :max-length 30)))
 440 \layout Standard
 441
 442 the (string :label "First Name" ...) form is an attribute definiton.
 443  Attributes are accessed through FIND-ATTIRIBUTES, and are composed at run
 444  time (where the
 445 \noun on
 446 UnCommon Web
 447 \noun default
 448 's presentation system is done at compile time) to display the object.
 449  This allows a very flexible system of displaying objects which is reminiscent
 450  of
 451 \noun on
 452 CSS
 453 \noun default
 454
 455 \begin_inset Foot
 456 collapsed false
 457
 458 \layout Standard
 459
 460
 461 \noun on
 462 Drew Crampsie
 463 \noun default
 464  discovered this, rather than invent or design it, so there are some rough
 465  edges, but its a good start.
 466  Exploration baby yeah!
 467 \end_inset
 468
 469 .
 470 \layout Standard
 471
 472 Its much easier to show this than to tell.
 473  Lets present our user class.
 474  Currently in
 475 \noun on
 476 UnCommon Web
 477 \noun default
 478 , you'd define a presentation as such :
 479 \layout LyX-Code
 480
 481 >
 482 \series bold
 483 (defpresentation user-presentation (object-presentation)
 484 \layout LyX-Code
 485
 486 ((INTEGER :LABEL "USERID" :SLOT-NAME USERID)
 487 \layout LyX-Code
 488
 489  (STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
 490 \layout LyX-Code
 491
 492  (STRING :LABEL "PASSWORD" :SLOT-NAME PASSWORD)))
 493 \layout Standard
 494
 495 which could be presented using PRESENT-OBJECT :
 496 \layout LyX-Code
 497
 498 >
 499 \series bold
 500 (present-object user :using 'user-presentation)
 501 \layout Standard
 502
 503 The equivalent approach using mewa presentations is actually longer and
 504  more verbose(!) but it serves to demonstrate how the MP system works.
 505 \layout Standard
 506
 507 Mewa Presentations adds a set of attributes to a class, keyed off the class
 508  name.
 509  Attributes are inherited, so if you define an attribute on T, you can use
 510  it with any class.
 511 \layout Standard
 512
 513 MP stores named attributes keyed on a class name.
 514  To achieve the same functionality as the above using mp would look like
 515  this :
 516 \layout LyX-Code
 517
 518 >
 519 \series bold
 520 (setf (lisp-on-lines::find-attribute 'user :viewer)
 521 \begin_inset Marginal
 522 collapsed true
 523
 524 \layout Standard
 525
 526 Isn't this too imperative (in contrast to functional, lispy).
 527 \end_inset
 528
 529
 530 \layout LyX-Code
 531
 532
 533 \series bold
 534         '(lisp-on-lines::mewa-object-presentation
 535 \layout LyX-Code
 536
 537
 538 \series bold
 539           :attributes (userid username password)
 540 \layout LyX-Code
 541
 542
 543 \series bold
 544           :global-properties (:editablep nil)))
 545 \layout LyX-Code
 546
 547 (:VIEWER MEWA-OBJECT-PRESENTATION
 548 \layout LyX-Code
 549
 550          :ATTRIBUTES
 551 \layout LyX-Code
 552
 553          (USERID USERNAME PASSWORD)
 554 \layout LyX-Code
 555
 556          :GLOBAL-PROPERTIES
 557 \layout LyX-Code
 558
 559          (:EDITABLEP NIL))
 560 \layout LyX-Code
 561
 562 >
 563 \series bold
 564 (setf (lisp-on-lines::find-attribute 'user 'userid)
 565 \begin_inset Marginal
 566 collapsed false
 567
 568 \layout Standard
 569
 570 Are this setfs to 'userid, 'username and 'password needed ? I (Pupeno) inspected
 571  they contents at of this moment and they seem to already contain what they
 572  are being set to.
 573 \end_inset
 574
 575
 576 \layout LyX-Code
 577
 578
 579 \series bold
 580         '(integer :label "userid" :slot-name userid))
 581 \layout LyX-Code
 582
 583 (USERID INTEGER :LABEL "USERID" :SLOT-NAME USERID)
 584 \layout LyX-Code
 585
 586 >
 587 \series bold
 588 (setf (lisp-on-lines::find-attribute 'user 'username)
 589 \layout LyX-Code
 590
 591
 592 \series bold
 593         '(STRING :LABEL "USERNAME" :SLOT-NAME USERNAME))
 594 \layout LyX-Code
 595
 596 (USERNAME STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
 597 \layout LyX-Code
 598
 599 >
 600 \series bold
 601 (setf (lisp-on-lines::find-attribute 'user 'password)
 602 \layout LyX-Code
 603
 604
 605 \series bold
 606         '(STRING :LABEL "USERNAME" :SLOT-NAME PASSWORD))
 607 \layout LyX-Code
 608
 609 (PASSWORD STRING :LABEL "USERNAME" :SLOT-NAME PASSWORD)
 610 \layout LyX-Code
 611
 612 >
 613 \series bold
 614 (lisp-on-lines::find-class-attributes 'user)
 615 \layout LyX-Code
 616
 617 (USER
 618 \layout LyX-Code
 619
 620  (:VIEWER MEWA-OBJECT-PRESENTATION
 621 \layout LyX-Code
 622
 623           :ATTRIBUTES
 624 \layout LyX-Code
 625
 626           (USERID USERNAME PASSWORD)
 627 \layout LyX-Code
 628
 629           :GLOBAL-PROPERTIES
 630 \layout LyX-Code
 631
 632           (:EDITABLEP NIL))
 633 \layout LyX-Code
 634
 635  (PASSWORD STRING :LABEL "PASSWORD" :SLOT-NAME PASSWORD)
 636 \layout LyX-Code
 637
 638  (USERNAME STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
 639 \layout LyX-Code
 640
 641  (USERID INTEGER :LABEL "USERID" :SLOT-NAME USERID)
 642 \layout LyX-Code
 643
 644  NIL)
 645 \layout Standard
 646
 647 this is all turned into a
 648 \noun on
 649 UnCommon Web
 650 \noun default
 651  presentation at runtime using MAKE-PRESENTATION, for example, the following
 652  code should be enough to show what's built so far attached to the examples
 653  application:
 654 \layout LyX-Code
 655
 656 >
 657 \series bold
 658 (defcomponent lol-example (window-component)
 659 \layout LyX-Code
 660
 661
 662 \series bold
 663    ())
 664 \layout LyX-Code
 665
 666 >
 667 \series bold
 668 (defmethod render-on ((res response) (lol-example lol-example))
 669 \layout LyX-Code
 670
 671
 672 \series bold
 673     (<:h1 "User")
 674 \layout LyX-Code
 675
 676
 677 \series bold
 678     (<ucw:render-component :component (lisp-on-lines::make-presentation
 679  user :type :viewer)))
 680 \layout LyX-Code
 681
 682 >
 683 \series bold
 684 (defentry-point "lol.ucw" (:application *example-application*) ()
 685 \layout LyX-Code
 686
 687
 688 \series bold
 689     (call 'lol-example))
 690 \layout Standard
 691
 692 As you'll see, nothing is exported from the LISP-ON-LINES package.
 693  If you wish to use LOL in your own package (or in UCW-USER or whatever),
 694  you simply need to use the MEWA and META-MODEL packages.
 695 \layout Standard
 696
 697 SET-ATTRIBUTE can be used in place of (setf (find-attribute ...)) when you
 698  want to "inherit" the properties of an existing attribute definition :
 699 \layout LyX-Code
 700
 701 LISP-ON-LINES>
 702 \series bold
 703 (set-attribute 'user 'password '(string :label "password: (must be at least
 704  8 chars)"))
 705 \layout LyX-Code
 706
 707 (PASSWORD STRING
 708 \layout LyX-Code
 709
 710 :LABEL
 711 \layout LyX-Code
 712
 713 "password: (must be at leat 8 chars)"
 714 \layout LyX-Code
 715
 716 :SLOT-NAME
 717 \layout LyX-Code
 718
 719 PASSWORD)
 720 \layout Standard
 721
 722 Now we want to create a presentation with which to edit the username.
 723  we will use the existing attributes on a subclass of mewa-object-presetation
 724  :
 725 \layout LyX-Code
 726
 727 >
 728 \series bold
 729 (defcomponent user-editor (mewa-object-presentation)
 730 \layout LyX-Code
 731
 732
 733 \series bold
 734    ()
 735 \layout LyX-Code
 736
 737
 738 \series bold
 739    (:default-initargs
 740 \layout LyX-Code
 741
 742
 743 \series bold
 744      :attributes '((username :label "Enter your New Username") password)
 745 \layout LyX-Code
 746
 747
 748 \series bold
 749      :global-properties '(:editablep t)))
 750 \layout LyX-Code
 751
 752 USER-EDITOR
 753 \layout LyX-Code
 754
 755 LISP-ON-LINES>
 756 \series bold
 757 (setf (find-attribute 'user :editor) '(user-editor))
 758 \layout LyX-Code
 759
 760 (:EDITOR USER-EDITOR)
 761 \layout Standard
 762
 763 which we then can display below our earlier example :
 764 \layout LyX-Code
 765
 766
 767 \series bold
 768 (defmethod render-on ((res response) (e presentations-index))
 769 \layout LyX-Code
 770
 771
 772 \series bold
 773 "
 774 \layout LyX-Code
 775
 776
 777 \series bold
 778 As you'll see, nothing is exported from the LISP-ON-LINES package.
 779
 780 \layout LyX-Code
 781
 782
 783 \series bold
 784 if you wish to use LOL in your own package (or in UCW-USER or whatever),
 785 \layout LyX-Code
 786
 787
 788 \series bold
 789 you simply need to use the MEWA and META-MODEL packages"
 790 \layout LyX-Code
 791
 792
 793 \series bold
 794 (<ucw:render-component :component (lisp-on-lines::make-presentation lisp-on-line
 795 s::user :type :viewer))
 796 \layout LyX-Code
 797
 798
 799 \series bold
 800 (<ucw:render-component :component (lisp-on-lines::make-presentation lisp-on-line
 801 s::user :type :editor)))
 802 \layout Standard
 803
 804 that should give you some idea on how it works ..
 805  ask me when you get confused :)
 806 \layout Section
 807
 808 Pupeno's Example
 809 \layout Standard
 810
 811 This is Pupeno's view of how to do rapid developing of a database-driven
 812  web application.
 813  It currently is going to assume a very specific case but latter it may
 814  be made bigger.
 815 \layout Standard
 816
 817 We first start with a
 818 \noun on
 819 PostgreSQL
 820 \noun default
 821  connection of CLSQL which is set up with one line:
 822 \layout LyX-Code
 823
 824 >
 825 \series bold
 826 (clsql:connect '("localhost" "geo" "geo" "geogeo"))
 827 \layout Standard
 828
 829 which connect us to the server on
 830 \family typewriter
 831 localhost
 832 \family default
 833 , to the database
 834 \family typewriter
 835 geo
 836 \family default
 837  as user
 838 \begin_inset Quotes eld
 839 \end_inset
 840
 841 geo
 842 \begin_inset Quotes erd
 843 \end_inset
 844
 845  with password
 846 \begin_inset Quotes eld
 847 \end_inset
 848
 849 geogeo
 850 \begin_inset Quotes erd
 851 \end_inset
 852
 853  (this is not a smart way to generate password, don't do this).
 854  To have a nice SQL environment, we also want:
 855 \layout LyX-Code
 856
 857 >
 858 \series bold
 859 (clsql:locally-enable-sql-reader-syntax)
 860 \layout LyX-Code
 861
 862 >
 863 \series bold
 864 (setf clsql:*default-caching* nil)
 865 \layout Standard
 866
 867 Actually, it is more than a nice environmnet, without those lines the rest
 868  of the code won't work.
 869 \layout Standard
 870
 871 On the
 872 \family typewriter
 873 geo
 874 \family default
 875  database, there's a table called
 876 \family typewriter
 877 product
 878 \family default
 879  which has the following structure:
 880 \layout LyX-Code
 881
 882
 883 \series bold
 884 CREATE TABLE product (
 885 \layout LyX-Code
 886
 887
 888 \series bold
 889     id serial NOT NULL,
 890 \layout LyX-Code
 891
 892
 893 \series bold
 894     name text NOT NULL,
 895 \layout LyX-Code
 896
 897
 898 \series bold
 899     details text,
 900 \layout LyX-Code
 901
 902
 903 \series bold
 904     description text,
 905 \layout LyX-Code
 906
 907
 908 \series bold
 909     cost double precision,
 910 \layout LyX-Code
 911
 912
 913 \series bold
 914     CONSTRAINT product_cost_check CHECK ((cost > (0)::double precision))
 915 \layout LyX-Code
 916
 917
 918 \series bold
 919 );
 920 \layout LyX-Code
 921
 922
 923 \series bold
 924 ALTER TABLE ONLY product ADD CONSTRAINT product_name_key UNIQUE (name);
 925 \layout LyX-Code
 926
 927
 928 \series bold
 929 ALTER TABLE ONLY product ADD CONSTRAINT product_pkey PRIMARY KEY (id);
 930 \layout Standard
 931
 932
 933 \color red
 934 ToDo: express the table structure in a better way.
 935 \layout Standard
 936
 937 Now we'll create the class that represents a product, mirroring the database
 938  structure:
 939 \layout LyX-Code
 940
 941 >
 942 \series bold
 943 (lisp-on-lines::def-view-class/table "product")
 944 \layout Standard
 945
 946 and then we generate the default attributes (from
 947 \family typewriter
 948 product
 949 \family default
 950 's slots) and assign it to
 951 \family typewriter
 952 product
 953 \family default
 954 :
 955 \layout LyX-Code
 956
 957 >
 958 \series bold
 959 (lisp-on-lines::set-default-attributes (make-instance 'product))-
 960 \begin_inset Marginal
 961 collapsed true
 962
 963 \layout Standard
 964
 965 set-default-attributes is marked to be renamed to set-generated-attributes.
 966 \end_inset
 967
 968
 969 \layout Standard
 970 \align left
 971 As you can see, we instantiate
 972 \family typewriter
 973 product
 974 \family default
 975  to pass it to
 976 \family typewriter
 977 set-default-attributes
 978 \family default
 979 , because it expects an object instead of a class.
 980  We don't need the object anymore, so we don't save any reference to it.
 981  In the future we might have a
 982 \family typewriter
 983 set-default-attributes
 984 \family default
 985  that can use a class directly.
 986  Now we set a the attribute
 987 \family typewriter
 988 :viewer
 989 \family default
 990  to contain the
 991 \family typewriter
 992 mewa-object-presentation
 993 \family default
 994  exposing the attributes we like the user to work with:
 995 \layout LyX-Code
 996
 997 >
 998 \series bold
 999 (setf (lisp-on-lines::find-attribute (make-instance 'product) :viewer)
1000 \layout LyX-Code
1001
1002
1003 \series bold
1004         '(lisp-on-lines::mewa-object-presentation
1005 \layout LyX-Code
1006
1007
1008 \series bold
1009           :attributes (name details description cost)
1010 \layout LyX-Code
1011
1012
1013 \series bold
1014           :global-properties (:editablep nil)))
1015 \layout Standard
1016
1017 The last parameter is a list of properties that will be applied to each
1018  attribute.
1019 \layout Section
1020
1021 Yet Another Example .
1022 \layout Standard
1023
1024 Drew Crampsie Posted the following to comp.lang.lisp ..
1025  it just might help until he writes some real documentation.
1026
1027 \layout Standard
1028
1029 I've written a system that generates presentations for database objects
1030  based on the type and relation information in the system catalog.
1031  Its based on Mewa
1032 \begin_inset Foot
1033 collapsed true
1034
1035 \layout Standard
1036
1037 Mewa : Meta-level Architecture for Generic Web-Application Construction
1038 \layout Standard
1039
1040 http://map1.squeakfoundation.org/sm/package/32c5401f-fa30-4a2b-80c8-1006dd462859
1041 \end_inset
1042
1043  clsql + postgres and the UCW presentation components.
1044 \layout Standard
1045
1046 This is the code to add a new contact to the system.
1047  (screenshot pr0n follows).
1048 \layout Standard
1049
1050 In the RENDER-ON method of my front-page i have :
1051 \layout LyX-Code
1052
1053 (let ((p (make-instance 'person :person-type-code nil)))
1054 \layout LyX-Code
1055
1056   (<:as-html "Add Person :")
1057 \layout LyX-Code
1058
1059    (<ucw:render-component
1060 \layout LyX-Code
1061
1062     :component (make-presentation
1063 \layout LyX-Code
1064
1065                 p
1066 \layout LyX-Code
1067
1068                 :type :one-line
1069 \layout LyX-Code
1070
1071                 :initargs '(:attributes
1072 \layout LyX-Code
1073
1074                             ((person-type-code :editablep t)))))
1075 \layout LyX-Code
1076
1077    (<ucw:submit :action (new-person self p) :value  "add"))
1078 \layout LyX-Code
1079
1080 \layout Standard
1081
1082 This creates a drop-down list of person-types and an "add" button which
1083  calls NEW-PERSON :
1084 \layout LyX-Code
1085
1086 (defaction new-person ((self component) person)
1087 \layout LyX-Code
1088
1089   "
1090 \layout LyX-Code
1091
1092 Take a PERSON with a user-defined PERSON-TYPE-CODE,
1093 \layout LyX-Code
1094
1095  * Prompt the user for a FIRST-NAME, LAST-NAME and/or COMPANY-NAME
1096 \layout LyX-Code
1097
1098  * Search for similar PERSONs in the database.
1099 \layout LyX-Code
1100
1101  * If they exist, ask the user to select one or continue
1102 \layout LyX-Code
1103
1104  * otherwise, just continue editing the person"
1105 \layout LyX-Code
1106
1107   (let ((named-person
1108 \layout LyX-Code
1109
1110          (call-component self (make-presentation
1111 \layout LyX-Code
1112
1113                                person
1114 \layout LyX-Code
1115
1116                                :type 'new-person
1117 \layout LyX-Code
1118
1119                                :initargs '(:global-properties
1120 \layout LyX-Code
1121
1122                                            (:size 25 :editablep t))))))
1123 \layout LyX-Code
1124
1125     (when named-person
1126 \layout LyX-Code
1127
1128       (call-component self (make-presentation
1129 \layout LyX-Code
1130
1131                             (find-or-return-named-person self named-person)
1132 \layout LyX-Code
1133
1134                             :type :editor)))))
1135 \layout LyX-Code
1136
1137 \layout LyX-Code
1138
1139 (defaction find-or-return-named-person ((self component) person)
1140 \layout LyX-Code
1141
1142   "
1143 \layout LyX-Code
1144
1145 If any similiar contacts exist in the database,
1146 \layout LyX-Code
1147
1148 select one or continue with the current person
1149 \layout LyX-Code
1150
1151 PERSON must have FIRST-NAME, LAST-NAME and COMPANY-NAME bound."
1152 \layout LyX-Code
1153
1154   (let ((instances (sql-word-search person 'first-name 'last-name 'company-name)
1155 ))
1156 \layout LyX-Code
1157
1158     (if instances
1159 \layout LyX-Code
1160
1161         (call-component self (make-presentation
1162 \layout LyX-Code
1163
1164                               person
1165 \layout LyX-Code
1166
1167                               :type 'person-chooser
1168 \layout LyX-Code
1169
1170                               :initargs
1171 \layout LyX-Code
1172
1173                               `(:instances ,instances)))
1174 \layout LyX-Code
1175
1176         person)))
1177 \layout LyX-Code
1178
1179 \layout Standard
1180
1181 You can hardly tell it's a web application ...
1182  there is no checking of CGI params etc...
1183  just nice code in the order i wanted to write it.
1184 \layout Standard
1185
1186 Screenshots :
1187 \layout Itemize
1188
1189 http://tech.coop/img/screenshots/select-person-type.jpg
1190 \layout Itemize
1191
1192 http://tech.coop/img/screenshots/enter-person-name.jpg
1193 \layout Itemize
1194
1195 http://tech.coop/img/screenshots/select-similar-contacts.jpg
1196 \layout Itemize
1197
1198 http://tech.coop/img/screenshots/edit-person-details.jpg
1199 \layout Itemize
1200
1201 http://tech.coop/img/screenshots/view-recent-changes.jpg
1202 \layout Standard
1203
1204 All of the code used to create the presentations for this is below my sig.
1205  I do eventually plan to release the presentation system as Free Software,
1206  it just needs a little cleaning up.
1207  E-mail me for a sneak peak.
1208 \layout LyX-Code
1209
1210 --
1211 \layout LyX-Code
1212
1213 Drew Crampsie
1214 \layout LyX-Code
1215
1216 drewc at tech dot coop
1217 \layout LyX-Code
1218
1219 "Never mind the bollocks -- here's the sexp's tools."
1220 \layout LyX-Code
1221
1222     -- Karl A.
1223  Krueger on comp.lang.lisp
1224 \layout LyX-Code
1225
1226 \layout LyX-Code
1227
1228 (def-view-class/table "person")
1229 \layout LyX-Code
1230
1231 \layout LyX-Code
1232
1233 (set-default-attributes (make-instance 'person)
1234 \layout LyX-Code
1235
1236 \layout LyX-Code
1237
1238 (defcomponent person-display (mewa::two-column-presentation)
1239 \layout LyX-Code
1240
1241   ())
1242 \layout LyX-Code
1243
1244 \layout LyX-Code
1245
1246 (defcomponent one-line-person (mewa::mewa-one-line-presentation)
1247 \layout LyX-Code
1248
1249   ()
1250 \layout LyX-Code
1251
1252   (:default-initargs :attributes '(first-name last-name company-name)))
1253 \layout LyX-Code
1254
1255 \layout LyX-Code
1256
1257 (setf (find-attribute 'person :one-line) '(one-line-person))
1258 \layout LyX-Code
1259
1260 \layout LyX-Code
1261
1262 (set-attribute 'person 'person-type-code '(code-select :category 1))
1263 \layout LyX-Code
1264
1265 \layout LyX-Code
1266
1267 (set-attribute 'person 'province-state-code '(code-select :category 2))
1268 \layout LyX-Code
1269
1270 \layout LyX-Code
1271
1272 (setf (find-attribute 'person :viewer) '(person-display :global-properties
1273  (:editablep nil)))
1274 \layout LyX-Code
1275
1276 \layout LyX-Code
1277
1278 (set-attribute 'person :editor '(person-display :global-properties (:editablep
1279  t)))
1280 \layout LyX-Code
1281
1282 \layout LyX-Code
1283
1284 (setf (find-attribute 'person 'claim->adjuster-id) '(ucw::has-very-many
1285  :label "Claims as Adjuster" :slot-name claim->adjuster-id ) )
1286 \layout LyX-Code
1287
1288 \layout LyX-Code
1289
1290 (set-attribute 'person 'policy->agent-id '(ucw::has-very-many :label "Policies
1291  as Agent"))
1292 \layout LyX-Code
1293
1294 \layout LyX-Code
1295
1296 (defcomponent new-person (person-display)
1297 \layout LyX-Code
1298
1299   ()
1300 \layout LyX-Code
1301
1302   (:default-initargs
1303 \layout LyX-Code
1304
1305       :attributes '(first-name last-name company-name)))
1306 \layout LyX-Code
1307
1308 \layout LyX-Code
1309
1310 (defcomponent person-chooser (mewa::mewa-list-presentation)
1311 \layout LyX-Code
1312
1313   ()
1314 \layout LyX-Code
1315
1316   (:default-initargs
1317 \layout LyX-Code
1318
1319       :attributes '(first-name
1320 \layout LyX-Code
1321
1322                    last-name
1323 \layout LyX-Code
1324
1325                    company-name
1326 \layout LyX-Code
1327
1328                    address
1329 \layout LyX-Code
1330
1331                    city
1332 \layout LyX-Code
1333
1334                    person-type-code)
1335 \layout LyX-Code
1336
1337     :global-properties '(:editablep nil)
1338 \layout LyX-Code
1339
1340     :editablep nil
1341 \layout LyX-Code
1342
1343     :deleteablep nil))
1344 \layout LyX-Code
1345
1346 \layout LyX-Code
1347
1348 (defmethod render-on :wrapping ((res response) (self person-chooser))
1349 \layout LyX-Code
1350
1351   (<:p (<:as-html "Similar contact(s) in database.
1352  You can :")
1353 \layout LyX-Code
1354
1355        (<:ul
1356 \layout LyX-Code
1357
1358         (<:li (<:as-html "Select one of the contacts below"))
1359 \layout LyX-Code
1360
1361         (<:li (<ucw:a :action (answer (instance self))
1362 \layout LyX-Code
1363
1364                       (<:as-html "Continue, adding a new contact")))))
1365 \layout LyX-Code
1366
1367   (call-next-method))
1368 \layout LyX-Code
1369
1370 \layout LyX-Code
1371
1372 (defaction ok  ((self new-person) &optional arg)
1373 \layout LyX-Code
1374
1375   (declare (ignore arg))
1376 \layout LyX-Code
1377
1378   (answer (instance self)))
1379 \layout LyX-Code
1380
1381 \layout LyX-Code
1382
1383 (defmethod sql-word-search ((instance standard-db-object) &rest slots)
1384 \layout LyX-Code
1385
1386   (let ((names
1387 \layout LyX-Code
1388
1389          (loop for slot in slots
1390 \layout LyX-Code
1391
1392                nconc (split-sequence #
1393 \backslash
1394 Space (slot-value instance slot)))))
1395 \layout LyX-Code
1396
1397     (select (class-name (class-of instance))
1398 \layout LyX-Code
1399
1400             :where (sql-or  (mapcar #'(lambda (x)
1401 \layout LyX-Code
1402
1403                                         (when (< 0 (length x))
1404 \layout LyX-Code
1405
1406                                           (apply #'sql-or
1407 \layout LyX-Code
1408
1409                                                  (mapcar #'(lambda (y)
1410 \layout LyX-Code
1411
1412                                                              (sql-uplike
1413 \layout LyX-Code
1414
1415 (sql-slot-value 'person y)
1416 \layout LyX-Code
1417
1418                                                               (format nil
1419  "%~a%" x)))
1420 \layout LyX-Code
1421
1422                                                          slots))))
1423 \layout LyX-Code
1424
1425                                     names))
1426 \layout LyX-Code
1427
1428             :flatp t)))
1429 \layout LyX-Code
1430
1431 \the_end