Initial version

This commit is contained in:
Bo Yao 2018-06-24 13:08:30 -04:00
commit d0eefc4f2f
7 changed files with 165 additions and 0 deletions

1
.gitignore vendored Normal file
View file

@ -0,0 +1 @@
.DS_Store

18
README.md Normal file
View file

@ -0,0 +1,18 @@
# flute
[A short, one-line description of the project]
# Overview
[A longer description of the project, optionally with sub-sections like
'Features', 'History', 'Motivation', etc.]
# Usage
[Examples of usage]
# License
Licensed under the Specify license here License.

15
flute.asd Normal file
View file

@ -0,0 +1,15 @@
(defsystem flute
:author "Bo Yao <icerove@gmail.com"
:license "BSD"
:version "0.1"
:components ((:module "src"
:serial t
:components
((:file "flute"))))
:description "A beautiful, easilly composable html generation library"
:long-description
#.(uiop:read-file-string
(uiop:subpathname *load-pathname* "README.md"))
:in-order-to ((test-op (test-op flute-test)))
:depends-on (:assoc-utils
:let-over-lambda))

103
src/flute.lisp Normal file
View file

@ -0,0 +1,103 @@
(in-package :cl-user)
(defpackage flute
(:use :cl)
(:import-from :assoc-utils
:alist
:alistp
:hash-alist
:alist-plist)
(:import-from :let-over-lambda
:defmacro!
:mkstr)
(:export
;; all html5 elements, e.g. div, nav, media, export in code
;; except <time> and <map> conflicts with cl symbol, are defined and exported as |time|, |map|
))
(in-package :flute)
(defstruct element tag attrs children)
(defstruct attrs alist)
(defun split-attrs-and-chilren (attrs-and-children)
(cond
((attrs-p (first attrs-and-children))
(values (first attrs-and-children) (rest attrs-and-children)))
((alistp (first attrs-and-children))
(values (make-attrs :alist (first attrs-and-children))
(rest attrs-and-children)))
((listp (first attrs-and-children))
(values (make-attrs :alist (plist-alist (first attrs-and-children)))
(rest attrs-and-children)))
((hash-table-p (first attrs-and-children))
(values (make-attrs :alist (hash-alist (first attrs-and-children)))
(rest attrs-and-children)))
((keywordp (first attrs-and-children))
(loop for thing on attrs-and-children by #'cddr
for (k v) = thing
when (keywordp k)
collect (cons k v) into attrs
when (not (keywordp k))
return (values (make-attrs :alist attrs) thing)
finally (return (values (make-attrs :alist attrs) nil))))
(t
(values (make-attrs :alist nil) attrs-and-children))))
(defun plist-alist (plist)
(loop for (k v) on plist by #'cddr
collect (cons k v)))
(defun alist-plist* (alist)
(mapcan (lambda (kv)
(list (string-downcase (car kv))
(cdr kv)))
alist))
(defmacro define-builtin-element (element-name)
`(defun ,element-name (&rest attrs-and-children)
(multiple-value-bind (attrs children) (split-attrs-and-chilren attrs-and-children)
(make-element :tag (string-downcase (mkstr ',element-name)) :attrs attrs :children children))))
(defmacro define-and-export-builtin-elements (&rest element-names)
`(progn
,@(mapcan (lambda (e)
(list `(define-builtin-element ,e)
`(export ',e)))
element-names)))
(define-builtin-elements
a abbr address area article aside audio b base bdi bdo blockquote
body br button canvas caption cite code col colgroup data datalist
dd del details dfn dialog div dl dt em embed fieldset figcaption
figure footer form h1 h2 h3 h4 h5 h6 head header hr html i iframe
img input ins kbd label legend li link main |map| mark meta meter nav
noscript object ol optgroup option output p param picture pre progress
q rp rt ruby s samp script section select small source span strong
style sub summary sup svg table tbody td template textarea tfoot th
thead |time| title tr track u ul var video wbr)
(defmethod print-object ((attrs attrs) stream)
(if (attrs-alist attrs)
(format stream " ~{~a=~s~^ ~}" (alist-plist* (attrs-alist attrs)))
(format stream "")))
(defmethod print-object ((element element) stream)
(format stream "<~a~a>" (element-tag element) (element-attrs element))
(when (element-children element)
(format stream "~%~<~2I~@{~a~^~:@_~}~:>~%" (element-children element)))
(format stream "</~a>~%" (element-tag element)))
(defmethod print-object ((element element) stream)
(if (element-children element)
(format stream (if (rest (element-children element))
"~@<<~a~a>~2I~:@_~<~@{~a~^~:@_~}~:>~0I~:@_</~a>~:>"
"~@<<~a~a>~2I~:_~<~a~:>~0I~:_</~a>~:>")
(element-tag element)
(element-attrs element)
(element-children element)
(element-tag element))
(format stream "<~a~a>" (element-tag element) (element-attrs element))))
;; (defmacro! define-element (name (&rest args) &body body)
;; `(defun ,name (&rest g!attrs-and-children)))

16
src/test.html Normal file
View file

@ -0,0 +1,16 @@
<!DOCTYPE html>
<html>
<head>
<title>Page Title</title>
</head>
<body>
<h1>This is a Heading</h1>
<p>This is a paragraph.</p>
will This
<b>
sdf
</b>
break line
</body>
</html>

8
system-test.asd Normal file
View file

@ -0,0 +1,8 @@
(defsystem flute-test
:author "Your Name <your.name@example.com>"
:license "Specify license here"
:depends-on (:flute)
:components ((:module "t"
:serial t
:components
((:file "flute")))))

4
t/flute.lisp Normal file
View file

@ -0,0 +1,4 @@
(in-package :cl-user)
(defpackage flute.test
(:use :cl))
(in-package :flute.test)