|
Revision 3671, 1.7 kB
(checked in by ksprotte, 4 months ago)
|
again whitespace cleanup + removed tabs
|
| Line | |
|---|
| 1 |
(in-package :bos.web) |
|---|
| 2 |
|
|---|
| 3 |
(enable-interpol-syntax) |
|---|
| 4 |
|
|---|
| 5 |
(defclass contract-handler (editor-only-handler object-handler) |
|---|
| 6 |
() |
|---|
| 7 |
(:default-initargs :class 'contract)) |
|---|
| 8 |
|
|---|
| 9 |
(defparameter *show-m2s* 5) |
|---|
| 10 |
|
|---|
| 11 |
(defmethod handle-object ((handler contract-handler) contract) |
|---|
| 12 |
(with-bos-cms-page (:title "Displaying contract details") |
|---|
| 13 |
((:table :border "0") |
|---|
| 14 |
(:tr (:td "sponsor") |
|---|
| 15 |
(:td (html-edit-link (contract-sponsor contract)))) |
|---|
| 16 |
(:tr (:td "date") |
|---|
| 17 |
(:td (:princ-safe (format-date-time (contract-date contract))))) |
|---|
| 18 |
(:tr (:td "paid?") |
|---|
| 19 |
(:td (:princ-safe (if (contract-paidp contract) "yes" "no")))) |
|---|
| 20 |
(:tr (:td "m2s") |
|---|
| 21 |
(:td (:princ-safe (length (contract-m2s contract))) |
|---|
| 22 |
" (" |
|---|
| 23 |
(let ((show-m2s (subseq (contract-m2s contract) 0 *show-m2s*))) |
|---|
| 24 |
(dolist (m2 show-m2s) |
|---|
| 25 |
(html (:princ-safe (m2-x m2)) "/" (:princ-safe (m2-y m2)) " ")) |
|---|
| 26 |
(when (> (length (contract-m2s contract)) |
|---|
| 27 |
(length show-m2s)) |
|---|
| 28 |
(html "..."))) |
|---|
| 29 |
")")) |
|---|
| 30 |
(:tr (:td "color") |
|---|
| 31 |
(:td (:princ-safe (contract-color contract)))) |
|---|
| 32 |
#+(or) |
|---|
| 33 |
(:tr (:td "cert issued?") |
|---|
| 34 |
(:td (:princ-safe (if (contract-cert-issued contract) "yes" "no"))))))) |
|---|
| 35 |
|
|---|
| 36 |
(defclass cert-issued-handler (object-handler) |
|---|
| 37 |
() |
|---|
| 38 |
(:default-initargs :class 'contract)) |
|---|
| 39 |
|
|---|
| 40 |
(defmethod handle-object ((handler cert-issued-handler) contract) |
|---|
| 41 |
(with-http-response (:content-type "text/html; charset=UTF-8") |
|---|
| 42 |
(with-http-body () |
|---|
| 43 |
(:princ (if (and (contract-certificates-generated-p contract) |
|---|
| 44 |
(not (contract-tree-needs-update-p))) |
|---|
| 45 |
"READY" |
|---|
| 46 |
"PROCESSING"))))) |
|---|
