blob: e48d6530eab1bdb974df3cf1441486345c72b953 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
(declaim (optimize (speed 0) (safety 3) (debug 3)))
(in-package #:ldapadmin)
(defclass generic-form (base-service)
((name :initarg :name
:initform nil
:accessor name)
(http-method :initarg :http-method
:initform "POST"
:accessor http-method)
(action :initarg :action
:initform nil
:accessor action)
(required-p :initarg :required-p
:initform nil
:accessor required-p)
(form-fields :initarg :form-fields
:initform nil
:accessor form-fields))
(:documentation ""))
(defclass form-field (base-service)
((name :initarg :name
:initform nil
:accessor name)
(label :initarg :label
:initform nil
:accessor label)
(value :initarg :value
:initform nil
:accessor value)
(checked :initarg :checked
:initform nil
:accessor checked)
(field-type :initarg :field-type
:initform nil
:accessor field-type)
(required :initarg :required
:initform nil
:accessor required)
(dismiss :initarg :dismiss
:initform nil
:accessor dismiss)
(options :initarg :options
:initform nil
:accessor options)
(onclick :initarg :onclick
:initform nil
:accessor onclick)
(onchange :initarg :onchange
:initform nil
:accessor onchange))
(:documentation ""))
(defclass option (base-service)
((label :initarg :label
:initform nil
:accessor label)
(value :initarg :value
:initform nil
:accessor value))
(:documentation ""))
(defun make-form (name action required-p fields)
(make-instance 'generic-form
:name name
:action action
:required-p required-p
:form-fields (mapcar (lambda (field)
(make-instance 'form-field
:name (getf field :name)
:label (getf field :label)
:value (getf field :value)
:checked (getf field :checked)
:field-type (getf field :field-type)
:required (getf field :required)
:dismiss (getf field :dismiss)
:options (mapcar (lambda (option)
(make-instance 'option
:label (getf option :label)
:value (getf option :value)))
(getf field :options))
:onclick (getf field :onclick)
:onchange (getf field :onchange)))
fields)))
|
