diff --git a/common-doc.asd b/common-doc.asd index ff3b66b..9ef9673 100644 --- a/common-doc.asd +++ b/common-doc.asd @@ -19,6 +19,7 @@ (:file "error") (:file "file") (:file "classes") + (:file "constructors") (:file "macros") (:file "format") (:file "util") diff --git a/contrib/split-paragraphs/split-paragraphs.lisp b/contrib/split-paragraphs/split-paragraphs.lisp index 031a78c..f58d4d0 100644 --- a/contrib/split-paragraphs/split-paragraphs.lisp +++ b/contrib/split-paragraphs/split-paragraphs.lisp @@ -63,7 +63,7 @@ leaving a paragraph marker between each string." "Return whether a list has paragraph markers." (if (member +paragraph-marker+ list) t)) -(defun make-paragraph (contents) +(defun create-paragraph (contents) (cond ((null contents) nil) @@ -84,7 +84,7 @@ paragraph nodes." (cond ((equal elem +paragraph-marker+) ;; End of the paragraph - (push (make-paragraph (reverse current-paragraph-contents)) + (push (create-paragraph (reverse current-paragraph-contents)) output) (setf current-paragraph-contents nil)) ((or (typep elem 'code-block) @@ -94,7 +94,7 @@ paragraph nodes." (typep elem 'table) (typep elem 'section)) ;; Another end of paragraph - (push (make-paragraph (reverse current-paragraph-contents)) + (push (create-paragraph (reverse current-paragraph-contents)) output) (setf current-paragraph-contents nil) (push elem output)) @@ -102,7 +102,7 @@ paragraph nodes." ;; Another node, so just push it in the paragraph (push elem current-paragraph-contents)))) (when current-paragraph-contents - (push (make-paragraph (reverse current-paragraph-contents)) + (push (create-paragraph (reverse current-paragraph-contents)) output)) (remove-if #'null (reverse output))) list)) diff --git a/src/constructors.lisp b/src/constructors.lisp new file mode 100644 index 0000000..8731f7a --- /dev/null +++ b/src/constructors.lisp @@ -0,0 +1,145 @@ +(in-package :common-doc) + +;;; Utilities + +(defun construct (class children metadata) + "Instantiate a class with children and metadata." + (make-instance class :children children :metadata metadata)) + +;;; Interface + +(defun make-meta (pairs) + "Create a metadata table from a list of pairs. If the list is empty, return an +empty metadata table." + (let ((table (make-hash-table :test #'equal))) + (loop for pair in pairs do + (setf (gethash (first pair) table) (rest pair))) + table)) + +(defun make-content (children &key metadata) + "Create a content node from its children." + (construct 'content-node children metadata)) + +(defun make-text (string &key metadata) + "Create a text node from the contents of a string." + (make-instance 'text-node + :text string + :metadata metadata)) + +(defun make-paragraph (children &key metadata) + "Create a paragraph node from its children." + (construct 'paragraph children metadata)) + +(defun make-bold (children &key metadata) + "Create a bold node from its children." + (construct 'bold children metadata)) + +(defun make-italic (children &key metadata) + "Create an italicized node from its children." + (construct 'italic children metadata)) + +(defun make-underline (children &key metadata) + "Create an underlined node from its children." + (construct 'underline children metadata)) + +(defun make-strikethrough (children &key metadata) + "Create an striked out node from its children." + (construct 'strikethrough children metadata)) + +(defun make-code (children &key metadata) + "Create an inline code node from its children." + (construct 'code children metadata)) + +(defun make-superscript (children &key metadata) + "Create a superscripted node from its children." + (construct 'superscript children metadata)) + +(defun make-subscript (children &key metadata) + "Create a subscripted node from its children." + (construct 'subscript children metadata)) + +(defun make-code-block (language children &key metadata) + "Create a code block node from its children and language." + (make-instance 'code-block + :language language + :children children + :metadata metadata)) + +(defun make-inline-quote (children &key metadata) + "Create an inline quote node from its children." + (construct 'inline-quote children metadata)) + +(defun make-block-quote (children &key metadata) + "Create a block quote node from its children." + (construct 'block-quote children metadata)) + +(defun make-document-link (document section children &key metadata) + "Create a document link from document and section references and its children." + (make-instance 'document-link + :document-reference document + :section-reference section + :children children + :metadata metadata)) + +(defun make-web-link (uri children &key metadata) + "Create a web link." + (make-instance 'web-link + :uri (quri:uri uri) + :children children + :metadata metadata)) + +(defun make-list-item (children &key metadata) + (construct 'list-item children metadata)) + +(defun make-definition (term definition &key metadata) + (make-instance 'definition + :term term + :definition definition + :metadata metadata)) + +(defun make-unordered-list (children &key metadata) + (construct 'unordered-list children metadata)) + +(defun make-ordered-list (children &key metadata) + (construct 'ordered-list children metadata)) + +(defun make-definition-list (children &key metadata) + (construct 'definition-list children metadata)) + +(defun make-image (source &key description metadata) + (make-instance 'image + :source source + :description description + :metadata metadata)) + +(defun make-figure (image description &key metadata) + (make-instance 'figure + :image image + :description description + :metadata metadata)) + +(defun make-table (rows &key metadata) + (make-instance 'table + :rows rows + :metadata metadata)) + +(defun make-row (cells &key metadata) + (make-instance 'row + :cells cells + :metadata metadata)) + +(defun make-cell (children &key metadata) + (construct 'cell children metadata)) + +(defun make-section (title &key children reference metadata) + (make-instance 'section + :title title + :reference reference + :children children + :metadata metadata)) + +(defun make-document (title &key children keywords &allow-other-keys) + (make-instance 'document + :title title + :children children + :keywords keywords)) diff --git a/src/operations/toc.lisp b/src/operations/toc.lisp index 5e42977..c97411b 100644 --- a/src/operations/toc.lisp +++ b/src/operations/toc.lisp @@ -79,9 +79,10 @@ call fill-unique-refs first." (filter-depth list max-depth) list)))) (make-instance 'ordered-list - :metadata (common-doc.util:make-meta (list (cons "class" "toc"))) + :metadata (make-meta (list (cons "class" "toc"))) :children (loop for child in (if (listp toc) toc (children toc)) collecting - (make-instance 'list-item :children (list child)))))) + (make-instance 'list-item + :children (list child)))))) diff --git a/src/packages.lisp b/src/packages.lisp index a4b3d88..068553c 100644 --- a/src/packages.lisp +++ b/src/packages.lisp @@ -62,6 +62,35 @@ :rights :version :created-on) + ;; Constructors + (:export :make-meta + :make-content + :make-text + :make-paragraph + :make-bold + :make-italic + :make-underline + :make-strikethrough + :make-code + :make-superscript + :make-subscript + :make-code-block + :make-inline-quote + :make-block-quote + :make-document-link + :make-web-link + :make-list-item + :make-definition + :make-unordered-list + :make-ordered-list + :make-definition-list + :make-image + :make-figure + :make-table + :make-row + :make-cell + :make-section + :make-document) ;; Node definition (:export :define-node :find-node @@ -110,10 +139,7 @@ (defpackage common-doc.util (:use :cl :common-doc) - (:export :doc - :make-meta - :make-text - :string-to-slug) + (:export :string-to-slug) (:documentation "CommonDoc utilities.")) (defpackage common-doc.ops diff --git a/src/util.lisp b/src/util.lisp index 0fb4f21..fda7d85 100644 --- a/src/util.lisp +++ b/src/util.lisp @@ -1,53 +1,5 @@ (in-package :common-doc.util) -(defmacro doc (class args &rest children) - "Easily create a document or node. - -\\code[lang=lisp]{ -(doc subscript ()) -} - -is equivalent to: - -\\code[lang=lisp]{ -(make-instance 'subscript) -} - -\\code[lang=lisp]{ -(doc document - (:title \"My Document\") - (text-node (:text \"...\"))) -} - -is equivalent to: - -\\code[lang=lisp]{ -(make-instance 'document - :title \"My Document\" - :children (list (make-instance 'text-node :text \"...\"))) -}" - (labels ((recur (args) - (destructuring-bind (class args &rest children) args - (if children - `(make-instance ',class - ,@args - :children (list - ,@(loop for child in children collecting - (recur child)))) - `(make-instance ',class ,@args))))) - (recur (cons class (cons args children))))) - -(defun make-meta (pairs) - "Create a metadata hash table from a list of cons cells." - (let ((table (make-hash-table :test #'equal))) - (loop for pair in pairs do - (setf (gethash (first pair) table) (rest pair))) - table)) - -(defun make-text (string &optional metadata) - "Create a text node from the contents of a string." - (make-instance 'text-node :text string :metadata metadata)) - (defun string-to-slug (string) "Take a string, usually the name of a section, and create something that is more similar to an identifier, i.e. no spaces, same case, etc." diff --git a/t/common-doc.lisp b/t/common-doc.lisp index b2e1132..7eddb3f 100644 --- a/t/common-doc.lisp +++ b/t/common-doc.lisp @@ -1,27 +1,58 @@ (in-package :cl-user) (defpackage common-doc-test (:use :cl :fiveam :common-doc) - (:import-from :common-doc.util - :doc - :make-text)) + (:export :basic-tests)) (in-package :common-doc-test) -(def-suite tests +(def-suite basic-tests :description "common-doc tests.") -(in-suite tests) +(in-suite basic-tests) + +(test constructors + (is-true + (typep (make-strikethrough nil) 'strikethrough)) + (is-true + (typep (make-superscript nil) 'superscript)) + (is-true + (typep (make-subscript nil) 'subscript)) + (let ((node (make-code-block "lisp" nil))) + (typep node 'code-block) + (is (equal (language node) "lisp"))) + (is-true + (typep (make-inline-quote nil) 'inline-quote)) + (is-true + (typep (make-block-quote nil) 'block-quote)) + (is-true + (typep (make-document-link "doc" "sec" nil) + 'document-link)) + (is-true + (typep (make-web-link "http://www.example.com" nil) + 'web-link)) + (is-true + (typep (make-list-item nil) 'list-item)) + (is-true + (typep (make-unordered-list nil) 'unordered-list)) + (is-true + (typep (make-ordered-list nil) 'ordered-list)) + (let ((def (make-definition nil nil))) + (is-true + (typep def 'definition)) + (is-true (make-definition-list (list def)) + 'definition-list))) + (test simple-doc - (let ((document - (doc - document - (:title "My Document" - :creator "me" - :keywords (list "test" "test1")) - (paragraph - () - (text-node - (:text "test")))))) + (let ((document (make-document + "My Document" + :creator "me" + :keywords (list "test" "test1") + :children + (list + (make-paragraph + (list + (make-text "test"))))))) (is - (equal (keywords document) (list "test" "test1"))) + (equal (keywords document) + (list "test" "test1"))) (is (equal (common-doc.ops:collect-all-text document) "test")))) diff --git a/t/contrib/contrib.lisp b/t/contrib/contrib.lisp index ccf2998..1e0a4cc 100644 --- a/t/contrib/contrib.lisp +++ b/t/contrib/contrib.lisp @@ -1,8 +1,8 @@ (in-package :cl-user) (defpackage common-doc-test.contrib (:use :cl :fiveam :common-doc) - (:import-from :common-doc.util - :doc - :make-text) - (:export :tests)) + (:export :contrib)) (in-package :common-doc-test.contrib) + +(def-suite contrib) +(in-suite contrib) diff --git a/t/contrib/split-paragraphs.lisp b/t/contrib/split-paragraphs.lisp index 0ae2c9b..6b2f472 100644 --- a/t/contrib/split-paragraphs.lisp +++ b/t/contrib/split-paragraphs.lisp @@ -2,20 +2,13 @@ (test split-paragraphs (let ((node - (doc - content-node - () - (text-node - (:text (format nil "Paragraph 1.~%~%"))) - (text-node - (:text (format nil "Paragraph with "))) - (bold - () - (text-node - (:text "bold text"))) - (text-node - (:text (format nil ".~%~%"))) - (text-node - (:text (format nil "Paragraph 3.")))))) + (make-content + (list + (make-text (format nil "Paragraph 1.~%~%")) + (make-text "Paragraph with ") + (make-bold + (list (make-text "bold text"))) + (make-text (format nil ".~%~%")) + (make-text "Paragraph 3."))))) (finishes (common-doc.split-paragraphs:split-paragraphs node)))) diff --git a/t/equality.lisp b/t/equality.lisp index 4dd1446..3cff51a 100644 --- a/t/equality.lisp +++ b/t/equality.lisp @@ -4,21 +4,16 @@ (is (node-equal (make-text "test") (make-text "test"))) - (let* ((image - (doc image (:source "fig1.jpg"))) - (paragraph - (doc - paragraph - () - (text-node - (:text "test")))) - (section - (doc - section - (:title (list (make-text "Section 1"))) - (figure - (:image image - :description (list paragraph)))))) + (let* ((image (make-image "fig1.jpg")) + (paragraph (make-paragraph + (list (make-text "test")))) + (section (make-section + (list (make-text "Section 1")) + :children + (list + (make-figure + image + (list paragraph)))))) (macrolet ((tests (&rest nodes) `(progn ,@(loop for node in nodes collecting diff --git a/t/final.lisp b/t/final.lisp index 8443893..612e68b 100644 --- a/t/final.lisp +++ b/t/final.lisp @@ -1,5 +1,7 @@ ;;;; Run tests (in-package :common-doc-test) -(run! 'tests) -(run! 'common-doc-test.ops:tests) +(run! 'basic-tests) +(run! 'common-doc-test.ops:operations) +(run! 'common-doc-test.contrib:contrib) + diff --git a/t/operations.lisp b/t/operations.lisp index 857cc1c..8507b22 100644 --- a/t/operations.lisp +++ b/t/operations.lisp @@ -1,31 +1,27 @@ (in-package :cl-user) (defpackage common-doc-test.ops (:use :cl :fiveam :common-doc) - (:import-from :common-doc.util - :doc - :make-text) (:import-from :common-doc.ops :with-document-traversal :collect-figures :node-equal) - (:export :tests)) + (:export :operations)) (in-package :common-doc-test.ops) -(def-suite tests +(def-suite operations :description "common-doc operations tests.") -(in-suite tests) +(in-suite operations) -(test traverse-depth - (let ((document - (doc - document - () - (bold - () - (italic - () - (underline - ()))))) +(test traverse + (let ((document (make-document + "test" + :children + (list + (make-bold + (list + (make-italic + (list + (make-underline nil)))))))) (document-depth) (bold-depth) (italic-depth) @@ -50,32 +46,31 @@ (is (equal underline-depth 3)))) -(test extract-figures +(test figures (let ((document) (figs)) (finishes (setf document - (doc - document - () - (section - (:title (list (make-text "Section 1"))) - (figure - (:image (doc image (:source "fig1.jpg")) - :description - (list - (doc - text-node - (:text "Fig 1")))))) - (section - (:title (list (make-text "Section 2"))) - (figure - (:image (doc image (:source "fig2.jpg")) - :description - (list - (doc - text-node - (:text "Fig 2"))))))))) + (make-document + "test" + :children + (list + (make-section + (list (make-text "Section 1")) + :children + (list + (make-figure + (make-image "fig1.jpg") + (list + (make-text "Fig 1"))))) + (make-section + (list (make-text "Section 2")) + :children + (list + (make-figure + (make-image "fig2.jpg") + (list + (make-text "Fig 2"))))))))) (finishes (setf figs (collect-figures document))) (let* ((first-fig (first figs)) @@ -87,21 +82,22 @@ (is (equal (source second-img) "fig2.jpg"))))) -(test unique-refs - (let ((doc (doc - document - () - (section - (:title (list (make-text "Section 1"))) - (content-node - () - (content-node - () - (section - (:title (list (make-text "Section 1.1")) - :reference "sec11"))))) - (section - (:title (list (make-text "Section 2"))))))) +(test unique-ref + (let ((doc (make-document + "test" + :children + (list + (make-section + (list (make-text "Section 1")) + :children (list + (make-content + (list + (make-content + (list + (make-section (list (make-text "Section 1.1")) + :reference "sec11"))))))) + (make-section + (list (make-text "Section 2"))))))) (finishes (common-doc.ops:fill-unique-refs doc)) (is @@ -117,22 +113,26 @@ (equal (reference (second (children doc))) "section-2")))) + (test toc - (let* ((doc (doc - document - () - (section - (:title (list (make-text "Section 1")) - :reference "sec1") - (content-node - () - (content-node - () - (section - (:title (list (make-text "Section 1.1")) - :reference "sec11"))))) - (section - (:title (list (make-text "Section 2")) + (let* ((doc (make-document + "test" + :children + (list + (make-section + (list (make-text "Section 1")) + :reference "sec1" + :children + (list + (make-content + (list + (make-content + (list + (make-section + (list (make-text "Section 1.1")) + :reference "sec11"))))))) + (make-section + (list (make-text "Section 2")) :reference "sec2")))) (toc (common-doc.ops:table-of-contents doc))) (is-true (typep toc 'ordered-list))