Commit | Line | Data |
---|---|---|
da26d003 DC |
1 | (in-package :lisp-on-lines) |
2 | ||
3 | ;;;; *LoL Entry points | |
4 | ;;;; | |
5 | ||
6 | ;;;; This file contains the high level functions and macros | |
7 | ;;;; that are part of LoL proper, that is to say, not Mewa | |
8 | ;;;; or Meta-Model. | |
9 | ||
10 | ;;;; ** Initialisation | |
11 | ;;;; The following macros are used to initialise a set of database tables as LoL objects. | |
12 | (eval-when (:compile-toplevel :load-toplevel :execute) | |
13 | (defun generate-initialize-lol-for-table (table) | |
14 | " | |
15 | Generates a form that, when evaluated, initialises the given table as an lol object. | |
16 | This involves creating a meta-model, a clsql view-class, and the setting up the default attributes for a mewa presentation" | |
17 | ||
18 | `(progn | |
5a4eea11 | 19 | (def-view-class-from-table ,table) |
da26d003 DC |
20 | (set-default-attributes (quote ,(meta-model::sql->sym table)))))) |
21 | ||
22 | (defmacro initialize-lol-for-table (&rest tables) | |
23 | " expand to a form which initialises TABLES for use with LOL" | |
24 | `(progn | |
25 | ,@(loop for tbl in tables collect (generate-initialize-lol-for-table tbl)) | |
26 | (values))) | |
27 | ||
28 | (defmacro initialize-lol-for-database () | |
29 | "expands to init-i-f-t using the listing of tables provided by meta-model" | |
38a016c7 DC |
30 | `(initialize-lol-for-table ,@(meta-model::list-tables))) |
31 | ||
32 | ;;;; * AJAX stuff | |
33 | ||
34 | ;;;; TODO: This search stuff should probably me refactored elsewhere | |
35 | ||
36 | (defmethod find-slots-of-type (model &key (type 'string) | |
37 | (types '((string)) types-supplied-p)) | |
38 | "returns a list of slots matching TYPE, or matching any of TYPES" | |
39 | (let (ty) | |
40 | (if types-supplied-p | |
41 | (setf ty types) | |
42 | (setf ty (list type))) | |
43 | (remove nil (mapcar #'(lambda (st) (when (member (second st) ty) | |
44 | (first st))) | |
45 | (lisp-on-lines::list-slot-types model))))) | |
46 | ||
47 | ||
48 | (defmethod word-search (class-name slots search-terms | |
49 | &key (limit 10) (where (sql-and t))) | |
50 | (select class-name | |
51 | :where (sql-and | |
52 | where | |
53 | (word-search-where class-name slots search-terms :format-string "~a%")) | |
54 | :flatp t | |
55 | :limit limit)) | |
56 | ||
57 | ||
58 | (defmethod word-search (class-name slots (s string) &rest args) | |
59 | (apply #'word-search class-name slots | |
60 | (split-sequence:split-sequence #\Space s) args)) | |
61 | ||
62 | (defmethod word-search-where (class-name slots search-terms &key (format-string "%~a%")) | |
63 | (sql-or | |
64 | (mapcar #'(lambda (term) | |
65 | (apply #'sql-or | |
66 | (mapcar #'(lambda (slot) | |
67 | (sql-uplike | |
68 | (sql-slot-value class-name slot) | |
69 | (format nil format-string term))) | |
70 | slots))) | |
71 | search-terms))) | |
72 |