Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
G
gendl
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
47
Issues
47
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gendl
gendl
Commits
bd958423
Commit
bd958423
authored
Jan 30, 2015
by
Dave Cooper
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'release/1588'
parents
3db51aa3
45de51ab
Changes
91
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
91 changed files
with
4144 additions
and
2102 deletions
+4144
-2102
apps/dom/base/source/assembly.lisp
apps/dom/base/source/assembly.lisp
+296
-0
apps/dom/base/source/file-ordering.isc
apps/dom/base/source/file-ordering.isc
+23
-0
apps/dom/base/source/package.lisp
apps/dom/base/source/package.lisp
+30
-0
apps/dom/depends-on.isc
apps/dom/depends-on.isc
+1
-0
apps/dom/dom.asd
apps/dom/dom.asd
+17
-0
apps/dom/html/source/file-ordering.isc
apps/dom/html/source/file-ordering.isc
+22
-0
apps/dom/html/source/lenses.lisp
apps/dom/html/source/lenses.lisp
+264
-0
apps/dom/html/source/package.lisp
apps/dom/html/source/package.lisp
+26
-0
apps/dom/ignore-list.isc
apps/dom/ignore-list.isc
+1
-0
apps/dom/latex/source/file-ordering.isc
apps/dom/latex/source/file-ordering.isc
+22
-0
apps/dom/latex/source/lenses.lisp
apps/dom/latex/source/lenses.lisp
+425
-0
apps/dom/latex/source/package.lisp
apps/dom/latex/source/package.lisp
+27
-0
apps/dom/latex/source/utilities.lisp
apps/dom/latex/source/utilities.lisp
+47
-0
apps/dom/plain-text/source/lenses.lisp
apps/dom/plain-text/source/lenses.lisp
+114
-0
apps/dom/plain-text/source/package.lisp
apps/dom/plain-text/source/package.lisp
+27
-0
apps/dom/system-ordering.isc
apps/dom/system-ordering.isc
+1
-0
apps/dom/test-parts/source/assembly.lisp
apps/dom/test-parts/source/assembly.lisp
+59
-0
apps/dom/writers/source/dom-writer.lisp
apps/dom/writers/source/dom-writer.lisp
+53
-0
apps/dom/writers/source/file-ordering.isc
apps/dom/writers/source/file-ordering.isc
+22
-0
apps/dom/writers/source/html.lisp
apps/dom/writers/source/html.lisp
+26
-0
apps/dom/writers/source/latex.lisp
apps/dom/writers/source/latex.lisp
+26
-0
apps/dom/writers/source/package.lisp
apps/dom/writers/source/package.lisp
+29
-0
apps/dom/writers/source/plain-text.lisp
apps/dom/writers/source/plain-text.lisp
+25
-0
apps/ta2/ta2.asd
apps/ta2/ta2.asd
+16
-16
apps/tasty/tasty.asd
apps/tasty/tasty.asd
+18
-18
apps/translators/translators.asd
apps/translators/translators.asd
+13
-13
apps/tree/tree.asd
apps/tree/tree.asd
+13
-13
apps/yadd/yadd.asd
apps/yadd/yadd.asd
+19
-19
base/base.asd
base/base.asd
+31
-31
base/rest/source/vanilla-mixin.lisp
base/rest/source/vanilla-mixin.lisp
+1
-1
base/source/package.lisp
base/source/package.lisp
+3
-1
base/source/parameters.lisp
base/source/parameters.lisp
+3
-11
base/source/start.lisp
base/source/start.lisp
+3
-0
cl-lite/cl-lite.asd
cl-lite/cl-lite.asd
+12
-12
demos/bus/bus.asd
demos/bus/bus.asd
+25
-25
demos/ledger/ledger.asd
demos/ledger/ledger.asd
+12
-12
demos/robot/robot.asd
demos/robot/robot.asd
+13
-13
demos/wire-world/wire-world.asd
demos/wire-world/wire-world.asd
+11
-11
documentation/training/g102-tud/examples/examples.asd
documentation/training/g102-tud/examples/examples.asd
+11
-11
documentation/tutorial/examples/gwl-5-one-viewport.gdl
documentation/tutorial/examples/gwl-5-one-viewport.gdl
+64
-0
documentation/tutorial/examples/gwl-5.gdl
documentation/tutorial/examples/gwl-5.gdl
+1
-0
documentation/tutorial/examples/x3dom-basic.gdl
documentation/tutorial/examples/x3dom-basic.gdl
+64
-0
documentation/tutorial/images/example-angular-dimension.pdf
documentation/tutorial/images/example-angular-dimension.pdf
+56
-56
documentation/tutorial/images/example-arc.pdf
documentation/tutorial/images/example-arc.pdf
+12
-12
documentation/tutorial/images/example-base-drawing.pdf
documentation/tutorial/images/example-base-drawing.pdf
+28
-28
documentation/tutorial/images/example-base-view.pdf
documentation/tutorial/images/example-base-view.pdf
+46
-46
documentation/tutorial/images/example-bezier-curve.pdf
documentation/tutorial/images/example-bezier-curve.pdf
+30
-30
documentation/tutorial/images/example-box.pdf
documentation/tutorial/images/example-box.pdf
+11
-11
documentation/tutorial/images/example-c-cylinder.pdf
documentation/tutorial/images/example-c-cylinder.pdf
+19
-19
documentation/tutorial/images/example-center-line.pdf
documentation/tutorial/images/example-center-line.pdf
+393
-393
documentation/tutorial/images/example-circle.pdf
documentation/tutorial/images/example-circle.pdf
+16
-16
documentation/tutorial/images/example-cone.pdf
documentation/tutorial/images/example-cone.pdf
+16
-16
documentation/tutorial/images/example-cylinder.pdf
documentation/tutorial/images/example-cylinder.pdf
+22
-22
documentation/tutorial/images/example-ellipse.pdf
documentation/tutorial/images/example-ellipse.pdf
+15
-15
documentation/tutorial/images/example-general-note.pdf
documentation/tutorial/images/example-general-note.pdf
+147
-147
documentation/tutorial/images/example-global-filleted-polygon-projection.pdf
...ial/images/example-global-filleted-polygon-projection.pdf
+24
-24
documentation/tutorial/images/example-global-filleted-polyline.pdf
...tion/tutorial/images/example-global-filleted-polyline.pdf
+17
-17
documentation/tutorial/images/example-global-polygon-projection.pdf
...ion/tutorial/images/example-global-polygon-projection.pdf
+18
-18
documentation/tutorial/images/example-global-polyline.pdf
documentation/tutorial/images/example-global-polyline.pdf
+15
-15
documentation/tutorial/images/example-horizontal-dimension.pdf
...entation/tutorial/images/example-horizontal-dimension.pdf
+39
-39
documentation/tutorial/images/example-label.pdf
documentation/tutorial/images/example-label.pdf
+20
-20
documentation/tutorial/images/example-line.pdf
documentation/tutorial/images/example-line.pdf
+11
-11
documentation/tutorial/images/example-parallel-dimension.pdf
documentation/tutorial/images/example-parallel-dimension.pdf
+40
-40
documentation/tutorial/images/example-pie-chart.pdf
documentation/tutorial/images/example-pie-chart.pdf
+32
-32
documentation/tutorial/images/example-point.pdf
documentation/tutorial/images/example-point.pdf
+28
-28
documentation/tutorial/images/example-route-pipe.pdf
documentation/tutorial/images/example-route-pipe.pdf
+119
-119
documentation/tutorial/images/example-sphere.pdf
documentation/tutorial/images/example-sphere.pdf
+54
-54
documentation/tutorial/images/example-spherical-cap.pdf
documentation/tutorial/images/example-spherical-cap.pdf
+99
-99
documentation/tutorial/images/example-torus.pdf
documentation/tutorial/images/example-torus.pdf
+66
-66
documentation/tutorial/images/example-vertical-dimension.pdf
documentation/tutorial/images/example-vertical-dimension.pdf
+45
-45
documentation/tutorial/source/assembly.lisp
documentation/tutorial/source/assembly.lisp
+11
-0
documentation/tutorial/source/package.lisp
documentation/tutorial/source/package.lisp
+1
-1
emacs/README.txt
emacs/README.txt
+120
-127
geom-base/geom-base.asd
geom-base/geom-base.asd
+60
-60
glisp/glisp.asd
glisp/glisp.asd
+13
-13
gwl-graphics/gwl-graphics.asd
gwl-graphics/gwl-graphics.asd
+18
-18
gwl-graphics/gwl/source/base-ajax-graphics-sheet.lisp
gwl-graphics/gwl/source/base-ajax-graphics-sheet.lisp
+67
-59
gwl/gwl.asd
gwl/gwl.asd
+41
-41
licenses/open-source/alexandria.txt
licenses/open-source/alexandria.txt
+37
-0
licenses/open-source/asdf.txt
licenses/open-source/asdf.txt
+27
-0
licenses/open-source/bordeaux-threads.txt
licenses/open-source/bordeaux-threads.txt
+20
-0
licenses/open-source/cl-pdf.txt
licenses/open-source/cl-pdf.txt
+30
-0
licenses/open-source/cl-ppcre.txt
licenses/open-source/cl-ppcre.txt
+23
-0
licenses/open-source/cl-typesetting.txt
licenses/open-source/cl-typesetting.txt
+30
-0
licenses/open-source/cl-who.txt
licenses/open-source/cl-who.txt
+25
-0
licenses/open-source/iterate.txt
licenses/open-source/iterate.txt
+23
-0
licenses/open-source/quicklisp.txt
licenses/open-source/quicklisp.txt
+53
-0
licenses/open-source/uffi.txt
licenses/open-source/uffi.txt
+26
-0
licenses/open-source/uiop.txt
licenses/open-source/uiop.txt
+27
-0
regression/regression.asd
regression/regression.asd
+71
-71
surf/surf.asd
surf/surf.asd
+67
-67
No files found.
apps/dom/base/source/assembly.lisp
0 → 100755
View file @
bd958423
;;
;; Copyright 2002, 2009, 2012 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
(
in-package
:com.genworks.dom
)
(
define-object
base-document-component
(
base-html-sheet
)
:input-slots
(
data
level
heading-number
)
:computed-slots
((
body
(
when
(
listp
(
the
:data
))
(
rest
(
the
:data
))))
(
element-types
(
mapcar
#'
(
lambda
(
element
)
(
the
(
:compute-type
element
)))
(
the
:body
)))
(
elements-indices
(
let
((
ht
(
make-hash-table
)))
(
mapcar
#'
(
lambda
(
type
)
(
let
((
current
(
gethash
type
ht
)))
(
setf
(
gethash
type
ht
)
(
if
current
(
1+
current
)
1
))))
(
the
:element-types
))))
(
elements-data
(
when
(
the
:body
)
(
make-array
(
length
(
the
:body
))
:initial-contents
(
the
:body
))))
(
sections-list
(
remove-if-not
#'
(
lambda
(
element
)
(
typep
element
'section
))
(
list-elements
(
the
elements
)))))
:objects
((
elements
:type
(
:sequence
(
the
:element-types
))
:sequence
(
:size
(
length
(
the
:element-types
)))
:data
(
svref
(
the
:elements-data
)
(
the-child
:index
))
:heading-number
(
format
nil
"~a.~a"
(
the
:heading-number
)
(
nth
(
the-child
:index
)
(
the
:elements-indices
)))
:level
(
1+
(
the
:level
))))
:functions
((
compute-type
(
element
)
(
cond
((
stringp
element
)
'text-string
)
((
keywordp
element
)
'tag
)
((
and
(
listp
element
)
(
listp
(
first
element
)))
(
ecase
(
first
(
first
element
))
(
:section
'section
)
(
:section*
'section
)
(
:subsection
'section
)
(
:subsection*
'section
)
(
:subsubsection
'section
)
(
:subsubsection*
'section
)
(
:subsubsubsection
'section
)
(
:subsubsubsection*
'section
)
(
:subsubsubsubsection
'section
)
(
:subsubsubsubsection*
'section
)
(
:chapter
'section
)
(
:chapter*
'section
)
(
:list
'item-list
)
(
:item
'item-list-item
)
(
:footnote
'footnote
)
(
:figure
'figure
)
(
:boxed-figure
'figure
)
(
:image-figure
'figure
)
(
:rendered-figure
'rendered-figure
)
))
((
listp
element
)
(
case
(
first
element
)
((
:item
:li
)
'item-list-item
)
(
:dt
'description-title
)
(
:dd
'description-body
)
(
:quote
'blockquote
)
(
:ol
'ordered-item-list
)
(
:ul
'unordered-item-list
)
(
:dl
'definition-item-list
)
(
:tt
'text-tt-marked-up-string
)
(
:pre
'verbatim-text-marked-up-string
)
(
:strong
'strong-text-marked-up-string
)
(
otherwise
'marked-up-string
)))))))
(
define-object
tag
(
base-document-component
)
:computed-slots
((
strings-for-display
(
format
nil
"Tag (~s)"
(
the
:data
)))))
(
define-object
assembly
(
section
)
:input-slots
((
style-url
"/gdl/style/top.css"
))
:computed-slots
((
index-ht
(
the
yadd
index-ht
)))
:trickle-down-slots
(
index-ht
)
:hidden-objects
((
yadd
:type
'yadd::all
)))
(
define-object
section
(
base-document-component
)
:input-slots
((
data
(
symbol-value
(
read-from-string
"com.genworks.books::*book-data*"
)))
(
level
0
)
(
heading-number
nil
))
:trickle-down-slots
(
class
)
:computed-slots
((
attributes
(
rest
(
first
(
the
:data
))))
(
class
(
when
(
=
(
the
:level
)
0
)
(
or
(
getf
(
the
:attributes
)
:documentclass
)
(
getf
(
the
:attributes
)
:class
))))
(
copyright
(
when
(
=
(
the
:level
)
0
)
(
getf
(
the
:attributes
)
:copyright
)))
(
abstract
(
when
(
=
(
the
:level
)
0
)
(
getf
(
the
:attributes
)
:abstract
)))
(
links
(
getf
(
the
:attributes
)
:links
))
(
section-style
(
first
(
first
(
the
:data
))))
(
title
(
getf
(
the
:attributes
)
:title
))
(
strings-for-display
(
format
nil
"~a: ~a"
(
the
:section-descriptor
)
(
the
:title
)))
(
label
(
string-append
(
ecase
(
the
:section-style
)
(
:document
"doc"
)
((
:chapter
:chapter*
)
"chap"
)
((
:section
:section*
)
"sec"
)
((
:subsection
:subsection*
)
"subsec"
)
((
:subsubsection
:subsubsection*
)
"subsubsec"
))
":"
(
or
(
getf
(
the
:attributes
)
:label
)
(
title-to-label
(
the
:title
)))))
(
section-descriptor
(
case
(
the
:level
)
(
0
"Doc"
)
(
1
"Ch"
)
(
otherwise
(
format
nil
"~{~a-~}Sec"
(
make-list
(
-
(
the
:level
)
2
)
:initial-element
"sub"
)))))))
(
define-object
marked-up-string
(
base-document-component
)
:computed-slots
((
strings-for-display
(
format
nil
"Marked-up String (~s)"
(
first
(
the
:data
))))
(
markup-tag
(
if
(
keywordp
(
first
(
the
:data
)))
(
first
(
the
data
))
:no-op
))
(
body
(
if
(
keywordp
(
first
(
the
data
)))
(
rest
(
the
data
))
(
the
data
)))))
(
define-object
description-title
(
base-document-component
))
(
define-object
description-body
(
base-document-component
))
(
define-object
text-tt-marked-up-string
(
marked-up-string
)
:computed-slots
((
strings-for-display
(
format
nil
"Marked-up String (~s)"
(
the
markup-tag
)))
(
markup-tag
:texttt
)))
(
define-object
verbatim-text-marked-up-string
(
marked-up-string
)
:computed-slots
((
strings-for-display
(
format
nil
"Verbatim marked-up String (~s)"
(
the
markup-tag
)))
(
markup-tag
:verbatim
)))
(
define-object
strong-text-marked-up-string
(
marked-up-string
)
:computed-slots
((
strings-for-display
(
format
nil
"Strong-text marked-up String (~s)"
(
the
markup-tag
)))
(
markup-tag
:textbf
)))
(
define-object
blockquote
(
base-document-component
)
:computed-slots
((
tag
:quote
)))
(
define-object
item-list
(
base-document-component
)
:computed-slots
(
(
strings-for-display
"Item-List"
)
(
style
(
getf
(
rest
(
first
(
the
:data
)))
:style
))))
(
define-object
ordered-item-list
(
item-list
)
:computed-slots
((
style
:enumerate
)))
(
define-object
unordered-item-list
(
item-list
)
:computed-slots
((
style
:itemize
)))
(
define-object
definition-item-list
(
item-list
)
:computed-slots
((
style
:description
)))
(
define-object
item-list-item
(
base-document-component
)
:computed-slots
(
(
strings-for-display
(
format
nil
"Item-list Item: ~a..."
(
let
((
string
(
format
nil
"~s"
(
the
data
))))
(
subseq
string
0
(
min
24
(
1-
(
length
string
)))))))
(
word-data
(
when
(
listp
(
first
(
the
:data
)))
(
getf
(
rest
(
first
(
the
:data
)))
:word
)))
(
word-type
(
when
(
the
:word-data
)
(
the
(
:compute-type
(
the
:word-data
))))))
:objects
((
word
:type
(
or
(
the
:word-type
)
'null-part
)
:data
(
the
:word-data
))))
(
define-object
text-string
(
base-document-component
)
:input-slots
((
markup-tag
nil
))
:computed-slots
((
strings-for-display
"Text-String"
)
(
word-list
(
split
(
the
:data
)))))
(
define-object
figure
(
base-document-component
)
:computed-slots
((
strings-for-display
"Figure"
)
(
style
(
first
(
first
(
the
:data
))))
(
label
(
or
(
getf
(
rest
(
first
(
the
:data
)))
:label
)
""
))
(
caption
(
or
(
getf
(
rest
(
first
(
the
:data
)))
:caption
)
""
))
(
width
(
getf
(
rest
(
first
(
the
:data
)))
:width
))
(
height
(
getf
(
rest
(
first
(
the
:data
)))
:height
))
(
image-file
(
when
(
eql
(
the
:style
)
:image-figure
)
(
getf
(
rest
(
first
(
the
:data
)))
:image-file
)))))
(
define-object
rendered-figure
(
base-document-component
)
:computed-slots
((
width
(
or
(
getf
(
rest
(
first
(
the
:data
)))
:width
)
"4in"
))
(
height
(
or
(
getf
(
rest
(
first
(
the
:data
)))
:height
)
"4in"
))
(
strings-for-display
"Rendered Figure"
)
(
caption
(
or
(
getf
(
rest
(
first
(
the
:data
)))
:caption
)
""
))
(
label
(
or
(
getf
(
rest
(
first
(
the
:data
)))
:label
)
(
format
nil
"fig:~a"
(
the
object
))))
(
object
(
getf
(
rest
(
first
(
the
:data
)))
:object
))))
(
defun
title-to-label
(
title
)
(
replace-substring
(
replace-substring
(
replace-substring
(
replace-substring
(
replace-substring
(
replace-substring
(
string-downcase
title
)
" "
""
)
"{"
""
)
"}"
""
)
"'"
""
)
"`"
""
)
"\\texttt"
""
))
apps/dom/base/source/file-ordering.isc
0 → 100755
View file @
bd958423
;;
;; Copyright 2002, 2009, 2012 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
("package")
\ No newline at end of file
apps/dom/base/source/package.lisp
0 → 100755
View file @
bd958423
;;
;; Copyright 2002, 2009, 2012 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
(
in-package
:gdl-user
)
(
gwl:define-package
:com.genworks.dom
(
:export
#:base-document-component
#:assembly
#:section
#:marked-up-string
#:blockquote
#:item-list
#:item-list-item
#:description-title
#:description-body
#:text-string
#:figure
#:rendered-figure
#:tag
))
apps/dom/depends-on.isc
0 → 100644
View file @
bd958423
(:cl-who :yadd)
\ No newline at end of file
apps/dom/dom.asd
0 → 100644
View file @
bd958423
;;;; -*- coding: utf-8 -*-
(
asdf:defsystem
#:dom
:description
"The Gendl™ dom Subsystem"
:author
"John McCarthy"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20150122"
:depends-on
(
:cl-who
:yadd
)
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
#+
asdf-encodings
:encoding
#+
asdf-encodings
:utf-8
:components
((
:file
"base/source/package"
)
(
:file
"base/source/assembly"
)
(
:file
"writers/source/package"
)
(
:file
"writers/source/dom-writer"
)
(
:file
"writers/source/html"
)
(
:file
"writers/source/latex"
)
(
:file
"writers/source/plain-text"
)
(
:file
"html/source/package"
)
(
:file
"html/source/lenses"
)
(
:file
"latex/source/package"
)
(
:file
"latex/source/lenses"
)
(
:file
"latex/source/utilities"
)
(
:file
"test-parts/source/assembly"
)))
apps/dom/html/source/file-ordering.isc
0 → 100644
View file @
bd958423
;;
;; Copyright 2002, 2009, 2012 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
("package")
\ No newline at end of file
apps/dom/html/source/lenses.lisp
0 → 100755
View file @
bd958423
;;
;; Copyright 2002, 2009, 2012 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
(
in-package
:com.genworks.dom-html
)
(
publish-directory
:prefix
"/gdl/style/"
:destination
(
format
nil
"~a"
(
translate-logical-pathname
"~/genworks/gwl-apps/training/g101/style/"
)))
(
define-lens
(
html-format
assembly
)
()
:output-functions
((
main-sheet
()
(
html
(
:html
(
:head
(
:title
(
:princ
(
the
title
)))
(
:body
(
:p
(
write-the
contents
))
(
:p
(
write-the
base
)))))))
(
base
()
(
dolist
(
element
(
list-elements
(
the
elements
)))
(
write-the-object
element
base
)))
(
cl-who-out
()
(
with-cl-who
()
(
:html
(
:head
(
:title
(
str
(
the
title
)))
((
:link
:href
(
the
style-url
)
:rel
"stylesheet"
:type
"text/css"
)))
(
:body
(
:div
(
write-the
cl-who-contents-out
))
(
:div
(
write-the
cl-who-base
))))))
(
cl-who-base
()
(
dolist
(
element
(
list-elements
(
the
elements
)))
(
write-the-object
element
cl-who-base
)))
))
(
define-lens
(
html-format
yadd:assy
)()
:output-functions
((
cl-who-contents-out
())
(
cl-who-out
())
(
cl-who-base
())))
(
define-lens
(
html-format
base-document-component
)()
:output-functions
((
base
())
(
contents
()
(
html
((
:a
:href
(
format
nil
"#~a"
(
the
label
)))
(
:princ
(
the
title
)))
(
:ol
(
dolist
(
section
(
the
sections-list
))
(
html
(
:li
(
write-the-object
section
contents
)))))))
(
cl-who-contents-out
()
(
with-cl-who
()
((
:a
:href
(
format
nil
"#~a"
(
the
label
)))
(
str
(
the
title
)))
(
:ol
(
dolist
(
section
(
the
sections-list
))
(
htm
(
:li
(
write-the-object
section
cl-who-contents-out
)))))))
(
cl-who-base
())))
(
define-lens
(
html-format
section
)()
:output-functions
((
base
()
(
html
((
:a
:name
(
the
label
)))
(
:h2
(
:princ
(
the
title
)))
(
dolist
(
element
(
list-elements
(
the
elements
)))
(
write-the-object
element
base
))))
(
cl-who-base
()
(
with-cl-who
()
((
:a
:name
(
the
label
)))
(
:h2
(
str
(
the
title
)))
(
dolist
(
element
(
list-elements
(
the
elements
)))
(
write-the-object
element
cl-who-base
))))))
(
define-lens
(
html-format
marked-up-string
)()
:output-functions
((
base
()
(
print-messages
markup-tag
)
(
case
(
the
:markup-tag
)
(
:p
(
html
(
:p
(
dolist
(
element
(
list-elements
(
the
:elements
)))
(
write-the-object
element
(
:base
))))))
(
:define-object
(
format
t
"Hey now"
)
(
write-the
yadd
(
find-object-doc
(
the
(
elements
0
)))
pretty-definition
))
(
:verbatim
(
html
(
:pre
(
dolist
(
element
(
list-elements
(
the
:elements
)))
(
write-the-object
element
base
)))))
(
:emph
(
html
(
:i
(
dolist
(
element
(
list-elements
(
the
:elements
)))
(
write-the-object
element
base
)))))
(
:texttt
(
html
(
:tt
(
dolist
(
element
(
list-elements
(
the
:elements
)))
(
write-the-object
element
base
)))))))
(
cl-who-base
()
(
with-cl-who
()
(
case
(
the
markup-tag
)
(
:p
(
htm
(
:p
(
dolist
(
element
(
list-elements
(
the
:elements
)))
(
write-the-object
element
cl-who-base
)))))
(
:define-object
(
let
((
net.html.generator:*html-stream*
*stream*
))
(
write-the
yadd
(
find-object-doc
(
the
(
elements
0
)))
pretty-definition
)))
(
:verbatim
(
htm
(
:pre
(
dolist
(
element
(
list-elements
(
the
elements
)))
(
write-the-object
element
cl-who-base
)))))
(
:emph
(
htm
(
:i
(
dolist
(
element
(
list-elements
(
the
elements
)))
(
write-the-object
element
cl-who-base
)))))
(
:texttt
(
htm
(
:tt
(
dolist
(
element
(
list-elements
(
the
elements
)))
(
write-the-object
element
cl-who-base
)))))
(
:quote
(
print-variables
(
the
markup-tag
)
(
the
elements
))
(
htm
(
:blockquote
(
dolist
(
element
(
list-elements
(
the
elements
)))
(
write-the-object
element
cl-who-base
)))))
(
otherwise
(
warn
"Markup tag ~s was not recognized~%"
(
the
markup-tag
)))
)))))
(
define-lens
(
html-format
item-list
)()
:output-functions
((
:base
()
(
ecase
(
the
style
)
(
:itemize
(
html
(
:ul
(
dolist
(
element
(
list-elements
(
the
:elements
)))
(
write-the-object
element
(
:base
))))))
(
:enumerate
(
html
(
:ol
(
dolist
(
element
(
list-elements
(
the
:elements
)))
(
write-the-object
element
(
:base
))))))
(
:description
(
html
(
:dl
(
dolist
(
element
(
list-elements
(
the
:elements
)))
(
write-the-object
element
(
:base
))))))))
(
cl-who-base
()
(
with-cl-who
()
(
ecase
(
the
style
)
(
:itemize
(
htm
(
:ul
(
dolist
(
element
(
list-elements
(
the
:elements
)))
(
write-the-object
element
cl-who-base
)))))
(
:enumerate
(
htm
(
:ol
(
dolist
(
element
(
list-elements
(
the
:elements
)))
(
write-the-object
element
cl-who-base
)))))
(
:description
(
htm
(
:dl
(
dolist
(
element
(
list-elements
(
the
:elements
)))
(
write-the-object
element
cl-who-base
))))))))))