├── .gitignore ├── .travis.yml ├── README.md ├── common-doc-contrib.asd ├── common-doc-gnuplot.asd ├── common-doc-graphviz.asd ├── common-doc-include.asd ├── common-doc-plantuml.asd ├── common-doc-split-paragraphs.asd ├── common-doc-test.asd ├── common-doc-tex.asd ├── common-doc.asd ├── contrib ├── gnuplot │ ├── README.md │ ├── direction-field.png │ └── gnuplot.lisp ├── graphviz │ ├── README.md │ └── graphviz.lisp ├── include │ ├── README.md │ └── include.lisp ├── plantuml │ ├── README.md │ └── plantuml.lisp ├── split-paragraphs │ ├── README.md │ └── split-paragraphs.lisp └── tex │ ├── README.md │ └── tex.lisp ├── docs ├── beowulf.scr ├── defining-nodes.scr ├── defining-nodes.txt ├── errors.scr ├── example.scr ├── example.tex ├── extensions.scr ├── extraction.lisp ├── files.scr ├── formats.scr ├── future-work.scr ├── gnuplot.scr ├── graphviz.scr ├── html.lisp ├── libraries.scr ├── macros.scr ├── manifest.lisp ├── math.tex ├── nodes.lisp ├── nodes.scr ├── operations.scr ├── overview.scr ├── pandocl.txt ├── plantuml.scr ├── split.lisp ├── tex.scr ├── toc.lisp ├── traverse.lisp └── vertex-format.lisp ├── src ├── classes.lisp ├── constructors.lisp ├── define.lisp ├── error.lisp ├── file.lisp ├── format.lisp ├── macros.lisp ├── metadata.lisp ├── operations │ ├── equality.lisp │ ├── figures.lisp │ ├── links.lisp │ ├── tables.lisp │ ├── text.lisp │ ├── toc.lisp │ ├── traverse.lisp │ └── unique-ref.lisp ├── packages.lisp ├── print.lisp └── util.lisp └── t ├── common-doc.lisp ├── contrib └── contrib.lisp ├── equality.lisp ├── final.lisp └── operations.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | *.fasl 2 | *.dx32fsl 3 | *.dx64fsl 4 | *.lx32fsl 5 | *.lx64fsl 6 | *.x86f 7 | *~ 8 | .#* 9 | docs/build 10 | docs/dir-field.png 11 | docs/sin-cos.png -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: common-lisp 2 | 3 | env: 4 | global: 5 | - PATH=~/.roswell/bin:$PATH 6 | - ROSWELL_BRANCH=master 7 | - ROSWELL_INSTALL_DIR=$HOME/.roswell 8 | - COVERAGE_EXCLUDE=t 9 | matrix: 10 | - LISP=sbcl-bin COVERALLS=true 11 | 12 | install: 13 | # Roswell & coveralls 14 | - curl -L https://raw.githubusercontent.com/snmsts/roswell/$ROSWELL_BRANCH/scripts/install-for-ci.sh | sh 15 | - git clone https://github.com/fukamachi/cl-coveralls ~/lisp/cl-coveralls 16 | # needed to test the gnuplot contrib 17 | - sudo apt-get install gnuplot 18 | 19 | cache: 20 | directories: 21 | - $HOME/.roswell 22 | - $HOME/.config/common-lisp 23 | 24 | before_script: 25 | - ros --version 26 | - ros config 27 | 28 | script: 29 | - ros -e '(ql:quickload (list :fiveam :cl-coveralls))' 30 | -e '(setf fiveam:*debug-on-error* t 31 | fiveam:*debug-on-failure* t)' 32 | -e '(setf *debugger-hook* 33 | (lambda (c h) 34 | (declare (ignore c h)) 35 | (uiop:quit -1)))' 36 | -e '(coveralls:with-coveralls (:exclude (list "t" "contrib" "src/error.lisp")) 37 | (ql:quickload :common-doc-test))' 38 | 39 | notifications: 40 | email: 41 | - eudoxiahp@gmail.com 42 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # CommonDoc 2 | 3 | [![Build Status](https://travis-ci.org/CommonDoc/common-doc.svg?branch=master)](https://travis-ci.org/CommonDoc/common-doc) 4 | [![Coverage Status](https://coveralls.io/repos/CommonDoc/common-doc/badge.svg?branch=master)](https://coveralls.io/r/CommonDoc/common-doc?branch=master) 5 | [![Quicklisp badge](http://quickdocs.org/badge/common-doc.svg)](http://quickdocs.org/common-doc/) 6 | 7 | A framework for representing and manipulating documents as CLOS objects. 8 | 9 | See the [documentation](http://commondoc.github.io/docs/overview.html). 10 | 11 | # Libraries 12 | 13 | * [CommonHTML](https://github.com/CommonDoc/common-html) [![Build Status](https://travis-ci.org/CommonDoc/common-html.svg?branch=master)](https://travis-ci.org/CommonDoc/common-html) 14 | * [VerTeX](https://github.com/CommonDoc/vertex) [![Build Status](https://travis-ci.org/CommonDoc/vertex.svg?branch=master)](https://travis-ci.org/CommonDoc/vertex) 15 | * [Codex](https://github.com/CommonDoc/codex) [![Build Status](https://travis-ci.org/CommonDoc/codex.svg?branch=master)](https://travis-ci.org/CommonDoc/codex) 16 | * [ParenML](https://github.com/CommonDoc/parenml) [![Build Status](https://travis-ci.org/CommonDoc/parenml.svg?branch=master)](https://travis-ci.org/CommonDoc/parenml) 17 | * [Thorn](https://github.com/CommonDoc/thorn) [![Build Status](https://travis-ci.org/CommonDoc/thorn.svg?branch=master)](https://travis-ci.org/CommonDoc/thorn) 18 | 19 | # License 20 | 21 | Copyright (c) 2014-2015 Fernando Borretti 22 | 23 | Licensed under the MIT License. 24 | -------------------------------------------------------------------------------- /common-doc-contrib.asd: -------------------------------------------------------------------------------- 1 | (defsystem common-doc-contrib 2 | :author "Fernando Borretti " 3 | :maintainer "Fernando Borretti " 4 | :license "MIT" 5 | :version "0.1" 6 | :depends-on (:common-doc-gnuplot 7 | :common-doc-graphviz 8 | :common-doc-plantuml 9 | :common-doc-include 10 | :common-doc-split-paragraphs 11 | :common-doc-tex) 12 | :description "System to load all CommonDoc contrib systems.") 13 | -------------------------------------------------------------------------------- /common-doc-gnuplot.asd: -------------------------------------------------------------------------------- 1 | (defsystem common-doc-gnuplot 2 | :author "Fernando Borretti " 3 | :maintainer "Fernando Borretti " 4 | :license "MIT" 5 | :version "0.1" 6 | :depends-on (:common-doc 7 | :split-sequence) 8 | :components ((:module "contrib" 9 | :components 10 | ((:module "gnuplot" 11 | :components 12 | ((:file "gnuplot")))))) 13 | :description "Render gnuplot plots." 14 | :long-description 15 | #.(uiop:read-file-string 16 | (uiop:subpathname *load-pathname* "contrib/gnuplot/README.md"))) 17 | -------------------------------------------------------------------------------- /common-doc-graphviz.asd: -------------------------------------------------------------------------------- 1 | (defsystem common-doc-graphviz 2 | :author "Fernando Borretti " 3 | :maintainer "Fernando Borretti " 4 | :license "MIT" 5 | :version "0.1" 6 | :depends-on (:common-doc 7 | :trivial-shell) 8 | :components ((:module "contrib" 9 | :components 10 | ((:module "graphviz" 11 | :components 12 | ((:file "graphviz")))))) 13 | :description "Graphviz macro for CommonDoc." 14 | :long-description 15 | #.(uiop:read-file-string 16 | (uiop:subpathname *load-pathname* "contrib/graphviz/README.md"))) 17 | -------------------------------------------------------------------------------- /common-doc-include.asd: -------------------------------------------------------------------------------- 1 | (defsystem common-doc-include 2 | :author "Fernando Borretti " 3 | :maintainer "Fernando Borretti " 4 | :license "MIT" 5 | :version "0.1" 6 | :depends-on (:common-doc 7 | :split-sequence) 8 | :components ((:module "contrib" 9 | :components 10 | ((:module "include" 11 | :components 12 | ((:file "include")))))) 13 | :description "Including external files into CommonDoc documents." 14 | :long-description 15 | #.(uiop:read-file-string 16 | (uiop:subpathname *load-pathname* "contrib/include/README.md"))) 17 | -------------------------------------------------------------------------------- /common-doc-plantuml.asd: -------------------------------------------------------------------------------- 1 | (defsystem common-doc-plantuml 2 | :author "Willem Rein Oudshoorn " 3 | :maintainer "Willem Rein Oudshoorn " 4 | :license "MIT" 5 | :version "0.1" 6 | :depends-on (:common-doc 7 | :trivial-shell) 8 | :components ((:module "contrib" 9 | :components 10 | ((:module "plantuml" 11 | :components 12 | ((:file "plantuml")))))) 13 | :description "PlantUML macro for CommonDoc." 14 | :long-description 15 | #.(uiop:read-file-string 16 | (uiop:subpathname *load-pathname* "contrib/plantuml/README.md"))) 17 | -------------------------------------------------------------------------------- /common-doc-split-paragraphs.asd: -------------------------------------------------------------------------------- 1 | (defsystem common-doc-split-paragraphs 2 | :author "Fernando Borretti " 3 | :maintainer "Fernando Borretti " 4 | :license "MIT" 5 | :version "0.1" 6 | :depends-on (:common-doc 7 | :cl-ppcre) 8 | :components ((:module "contrib" 9 | :components 10 | ((:module "split-paragraphs" 11 | :components 12 | ((:file "split-paragraphs")))))) 13 | :description "Automatically generate paragraphs by splitting text nodes." 14 | :long-description 15 | #.(uiop:read-file-string 16 | (uiop:subpathname *load-pathname* "contrib/split-paragraphs/README.md"))) 17 | -------------------------------------------------------------------------------- /common-doc-test.asd: -------------------------------------------------------------------------------- 1 | (defsystem common-doc-test 2 | :author "Fernando Borretti " 3 | :license "MIT" 4 | :description "CommonDoc tests." 5 | :depends-on (:common-doc 6 | :common-doc-contrib 7 | :fiveam) 8 | :components ((:module "t" 9 | :serial t 10 | :components 11 | ((:file "common-doc") 12 | (:file "operations") 13 | (:file "equality") 14 | (:module "contrib" 15 | :serial t 16 | :components 17 | ((:file "contrib"))) 18 | (:file "final"))))) 19 | -------------------------------------------------------------------------------- /common-doc-tex.asd: -------------------------------------------------------------------------------- 1 | (defsystem common-doc-tex 2 | :author "Fernando Borretti " 3 | :maintainer "Fernando Borretti " 4 | :license "MIT" 5 | :version "0.1" 6 | :depends-on (:common-doc) 7 | :components ((:module "contrib" 8 | :components 9 | ((:module "tex" 10 | :components 11 | ((:file "tex")))))) 12 | :description "TeX math macros for CommonDoc." 13 | :long-description 14 | #.(uiop:read-file-string 15 | (uiop:subpathname *load-pathname* "contrib/tex/README.md"))) 16 | -------------------------------------------------------------------------------- /common-doc.asd: -------------------------------------------------------------------------------- 1 | (defsystem common-doc 2 | :author "Fernando Borretti " 3 | :maintainer "Fernando Borretti " 4 | :license "MIT" 5 | :version "0.2" 6 | :homepage "https://github.com/CommonDoc/common-doc" 7 | :bug-tracker "https://github.com/CommonDoc/common-doc/issues" 8 | :source-control (:git "git@github.com:CommonDoc/common-doc.git") 9 | :depends-on (:trivial-types 10 | :local-time 11 | :quri 12 | :anaphora 13 | :alexandria 14 | :closer-mop) 15 | :components ((:module "src" 16 | :serial t 17 | :components 18 | ((:file "packages") 19 | (:file "define") 20 | (:file "error") 21 | (:file "file") 22 | (:file "classes") 23 | (:file "metadata") 24 | (:file "constructors") 25 | (:file "macros") 26 | (:file "format") 27 | (:file "util") 28 | (:module "operations" 29 | :serial t 30 | :components 31 | ((:file "traverse") 32 | (:file "figures") 33 | (:file "tables") 34 | (:file "links") 35 | (:file "text") 36 | (:file "unique-ref") 37 | (:file "toc") 38 | (:file "equality"))) 39 | (:file "print")))) 40 | :description "A framework for representing and manipulating documents as CLOS 41 | objects." 42 | :long-description 43 | #.(uiop:read-file-string 44 | (uiop:subpathname *load-pathname* "README.md")) 45 | :in-order-to ((test-op (test-op common-doc-test)))) 46 | -------------------------------------------------------------------------------- /contrib/gnuplot/README.md: -------------------------------------------------------------------------------- 1 | # CommonDoc gnuplot 2 | 3 | Render gnuplot plots from source code. 4 | 5 | # Overview 6 | 7 | This contrib provides a macro for turning gnuplot commands into images. 8 | 9 | # Examples 10 | 11 | ## Direction Field 12 | 13 | Scriba input: 14 | 15 | ``` 16 | @begin[path=dir-field.png](gnuplot) 17 | @begin(verb) 18 | set xrange [-10:10] 19 | set yrange [-10:10] 20 | set samples 25 21 | set isosamples 25 22 | dx(x) = x 23 | dy(x) = 2*x 24 | plot "++" using 1:2:(dx($1)):(dy($2)) w vec 25 | @end(verb) 26 | @end(gnuplot) 27 | ``` 28 | 29 | Output: 30 | 31 | ![dir field](direction-field.png) 32 | 33 | # License 34 | 35 | Copyright (c) 2015 Fernando Borretti 36 | 37 | Licensed under the MIT License. 38 | -------------------------------------------------------------------------------- /contrib/gnuplot/direction-field.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CommonDoc/common-doc/bcde4cfee3d34482d9830c8f9ea45454c73cf5aa/contrib/gnuplot/direction-field.png -------------------------------------------------------------------------------- /contrib/gnuplot/gnuplot.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage common-doc.gnuplot 3 | (:use :cl) 4 | (:import-from :common-doc 5 | :text 6 | :children 7 | :make-text 8 | :make-image 9 | :define-node) 10 | (:import-from :common-doc.macro 11 | :macro-node 12 | :expand-macro) 13 | (:import-from :common-doc.file 14 | :absolute-path 15 | :relativize-pathname) 16 | (:export :gnuplot 17 | :image-path 18 | :*gnuplot-command* 19 | :*gnuplot-default-term*) 20 | (:documentation "gnuplot contrib package.")) 21 | (in-package :common-doc.gnuplot) 22 | 23 | ;;; Configuration 24 | 25 | (defvar *gnuplot-command* "gnuplot" 26 | "The path/executable name used for @c(gnuplot). The default is @c(\"gnuplot\"). 27 | 28 | It is either a string, which indicates an executable name, or full 29 | path to the executable. Or it is a list of strings. If it is a list, 30 | the first element is the executable and the rest are command line 31 | arguments.") 32 | 33 | (defvar *gnuplot-default-term* 34 | #+darwin "png" 35 | #-darwin "pngcairo" 36 | "Default terminal to use for gnuplot. The default is @c(pngcairo) except for mac OSX because 37 | @c(pngcairo) is not available. On OSX the default terminal is @c(png).") 38 | ;;; Classes 39 | 40 | (define-node gnuplot (macro-node) 41 | ((path :reader image-path 42 | :initarg :path 43 | :type string 44 | :attribute-name "path" 45 | :documentation "Path to file where the image will be stored.") 46 | (term :reader term 47 | :initarg :term 48 | :type string 49 | :attribute-name "term" 50 | :documentation "Terminal used by gnuplot as in @c(set term ). The default is taken from @c(*gnuplot-default-term*).")) 51 | (:tag-name "gnuplot") 52 | (:documentation "gnuplot plot.")) 53 | 54 | ;;; Macroexpansion 55 | 56 | (defmethod expand-macro ((plot gnuplot)) 57 | "Take the gnuplot source code from the children and the image name, render it 58 | with gnuplot into an image." 59 | (let* ((pathname (absolute-path (image-path plot))) 60 | ;; The gnuplot commands 61 | (text (text (first (children plot)))) 62 | ;; The gnuplot commands to set output format, file etc. 63 | (input (format nil "set term ~S; set output ~S; ~A~%" 64 | (or (term plot) *gnuplot-default-term*) 65 | (namestring pathname) 66 | text)) 67 | ;; The gnuplot command 68 | (command "gnuplot")) 69 | ;; Run 70 | (handler-case 71 | (progn 72 | (with-input-from-string (stream input) 73 | (uiop:run-program command :input stream)) 74 | (make-image (namestring (relativize-pathname pathname)))) 75 | (t (e) 76 | (make-text (format nil "gnuplot error: ~A" e)))))) 77 | -------------------------------------------------------------------------------- /contrib/graphviz/README.md: -------------------------------------------------------------------------------- 1 | # CommonDoc Graphviz 2 | 3 | [Graphviz][gv] macro for CommonDoc. 4 | 5 | [gv]: http://www.graphviz.org/ 6 | 7 | # Usage 8 | 9 | ```lisp 10 | 11 | ``` 12 | 13 | # License 14 | 15 | Copyright (c) 2014 Fernando Borretti 16 | 17 | Licensed under the MIT License. 18 | -------------------------------------------------------------------------------- /contrib/graphviz/graphviz.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage common-doc.graphviz 3 | (:use :cl) 4 | (:import-from 5 | :common-doc 6 | :text 7 | :children 8 | :make-image 9 | :make-text 10 | :define-node) 11 | (:import-from 12 | :common-doc.macro 13 | :macro-node 14 | :expand-macro) 15 | (:import-from 16 | :common-doc.file 17 | :absolute-path 18 | :relativize-pathname) 19 | (:export 20 | :graphviz 21 | :image-path 22 | :*dot-command*) 23 | (:documentation "Graphviz package.")) 24 | (in-package :common-doc.graphviz) 25 | 26 | ;;; Global Configuration 27 | 28 | (defvar *dot-command* "dot" 29 | "The path/executable name used for the @c(dot) command. The default is @c(\"dot\"). 30 | 31 | It is either a string, which is taken as the name of an executable. 32 | This can also be a full pathname to the executable. 33 | 34 | Or it is a list of strings, where the first taken as the executable and 35 | the rest are extra command line arguments.") 36 | 37 | ;;; Classes 38 | 39 | (define-node graphviz (macro-node) 40 | ((path :reader image-path 41 | :initarg :path 42 | :type string 43 | :attribute-name "path" 44 | :documentation "Path to file where the image will be stored.") 45 | (output-format :reader output-format 46 | :initarg :output-format 47 | :type string 48 | :attribute-name "format" 49 | :documentation "Output format for @c(dot), used as argument @c(-T)")) 50 | (:tag-name "graphviz") 51 | (:documentation "Graphviz diagram.")) 52 | 53 | 54 | ;;; Macroexpansion 55 | 56 | (defmethod expand-macro ((plot graphviz)) 57 | "Take the graphviz zource code from the children and render it using dot into an image." 58 | (let* ((pathname (absolute-path (image-path plot))) 59 | (text (text (first (children plot)))) 60 | (command (list *dot-command* "-T" (or (output-format plot) "png") "-o" (namestring pathname)))) 61 | (handler-case 62 | (progn 63 | (with-input-from-string (stream text) 64 | (uiop:run-program command :input stream)) 65 | (make-image (namestring (relativize-pathname pathname)))) 66 | (t (e) 67 | (make-text (format nil "graphviz dot error: ~A~%" e)))))) 68 | -------------------------------------------------------------------------------- /contrib/include/README.md: -------------------------------------------------------------------------------- 1 | # CommonDoc `include` 2 | 3 | Including external files into documents. 4 | 5 | # Overview 6 | 7 | This contrib introduces macros for including, verbatim, the contents of external 8 | files to CommonDoc documents. 9 | 10 | # License 11 | 12 | Copyright (c) 2014 Fernando Borretti 13 | 14 | Licensed under the MIT License. 15 | -------------------------------------------------------------------------------- /contrib/include/include.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage common-doc.include 3 | (:use :cl) 4 | (:import-from :anaphora 5 | :aif 6 | :it) 7 | (:import-from :split-sequence 8 | :split-sequence) 9 | (:import-from :common-doc.macro 10 | :macro-node 11 | :expand-macro) 12 | (:import-from :common-doc 13 | :define-node) 14 | (:import-from :common-doc.util 15 | :make-text) 16 | (:export :include 17 | :include-path 18 | :include-start 19 | :include-end) 20 | (:documentation "Includex package.")) 21 | (in-package :common-doc.include) 22 | 23 | ;;; Classes 24 | 25 | (define-node include (macro-node) 26 | ((path :reader include-path 27 | :initarg :path 28 | :type string 29 | :attribute-name "path" 30 | :documentation "Path to the local file to include.") 31 | (start :reader include-start 32 | :initarg :start 33 | :initform nil 34 | :type (or null string) 35 | :attribute-name "start" 36 | :documentation "The line where the inclusion will start.") 37 | (end :reader include-end 38 | :initarg :end 39 | :initform nil 40 | :type (or null string) 41 | :attribute-name "end" 42 | :documentation "The line where the inclusion will end.")) 43 | (:tag-name "include") 44 | (:documentation "Include an external file.")) 45 | 46 | ;;; Macroexpansions 47 | 48 | (defmethod expand-macro ((include include)) 49 | "Expand the include file into a text node with its contents." 50 | (let* ((path (common-doc.file:absolute-path (include-path include))) 51 | (start (aif (include-start include) 52 | (parse-integer it :junk-allowed t) 53 | nil)) 54 | (end (aif (include-end include) 55 | (parse-integer it :junk-allowed t) 56 | nil)) 57 | (full-text (uiop:read-file-string path))) 58 | (if (or start end) 59 | ;; We have at least some range information 60 | (let ((lines (split-sequence #\Newline full-text))) 61 | (flet ((make-text-from-lines (lines) 62 | (make-text (reduce 63 | #'(lambda (a b) 64 | (concatenate 'string a (string #\Newline) b)) 65 | lines)))) 66 | (cond 67 | ((and start (not end)) 68 | ;; Start at a line, and go to the end 69 | (make-text-from-lines (subseq lines (1- start)))) 70 | ((and (not start) end) 71 | ;; Start at 0, go to the end 72 | (make-text-from-lines (subseq lines 0))) 73 | (t 74 | ;; Full range, select the text we want 75 | (make-text-from-lines (subseq lines (1- start) end)))))) 76 | ;; We have no range information, return the full text 77 | (make-text full-text)))) 78 | -------------------------------------------------------------------------------- /contrib/plantuml/README.md: -------------------------------------------------------------------------------- 1 | # CommonDoc PlantUML 2 | 3 | [PlantUML][plantuml] macro for CommonDoc. 4 | 5 | [plantuml]: http://plantuml.com 6 | 7 | 8 | # Usage 9 | 10 | ```lisp 11 | 12 | ``` 13 | 14 | # License 15 | 16 | Copyright (c) 2022 Wim Oudshoorn 17 | 18 | Licensed under the MIT License 19 | -------------------------------------------------------------------------------- /contrib/plantuml/plantuml.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage common-doc.plantuml 3 | (:use :cl) 4 | (:import-from 5 | :common-doc 6 | :text 7 | :children 8 | :make-text 9 | :make-image 10 | :define-node) 11 | (:import-from 12 | :common-doc.macro 13 | :macro-node 14 | :expand-macro) 15 | (:import-from 16 | :common-doc.file 17 | :absolute-path 18 | :relativize-pathname) 19 | (:export :plantuml 20 | :image-path 21 | :*plantuml-command*) 22 | (:documentation "PlantUML contrib package.")) 23 | (in-package :common-doc.plantuml) 24 | 25 | ;;; Configuration 26 | 27 | (defvar *plantuml-command* '("java" "-Djava.awt.headless=true" "-jar" "plantuml.jar") 28 | "The command used to execute the PlantUML program. 29 | 30 | This is either a string, naming an executable which will be looked up 31 | in the standard search path. (Or a full path to the executable.) 32 | 33 | Or a list of strings, where the first names the executable as above, and the rest 34 | are command line arguments. 35 | 36 | For PlantUML it should most likely resemble this: 37 | 38 | @c('(\"java\" \"-Djava.awt.headless=true\" \"-jar\" \"plantuml.jar\")). 39 | 40 | This is the default. But most likely this needs to be modified by replacing @c(plantuml.jar) with 41 | the correct jar file and with a full path so @c(java) can find it. 42 | 43 | The option @c(-Djava.awt.headless=true) is optional, but without it a temporary foreground process 44 | will steal focus.") 45 | 46 | ;;; Classes 47 | 48 | (define-node plantuml (macro-node) 49 | ((path :reader image-path 50 | :initarg :path 51 | :type string 52 | :attribute-name "path" 53 | :documentation "Path to file where the image will be stored.") 54 | (output-format :reader output-format 55 | :initarg :output-format 56 | :type string 57 | :attribute-name "format" 58 | :documentation "Output format for @c(PlantUML), used as argument @c(-t ).")) 59 | (:tag-name "plantuml") 60 | (:documentation "Macro to include PlantUML diagrams.")) 61 | 62 | ;;; Macroexpansion 63 | 64 | (defmethod expand-macro ((plot plantuml)) 65 | (let ((pathname (absolute-path (image-path plot))) 66 | (text (text (first (children plot)))) 67 | (command (concatenate 'list *plantuml-command* 68 | (list (concatenate 'string "-t" (or (output-format plot) "png")) 69 | "-p")))) 70 | (handler-case 71 | (progn 72 | (with-input-from-string (stream text) 73 | (uiop:run-program command :input stream :output pathname)) 74 | (make-image (namestring (relativize-pathname pathname)))) 75 | (t (e) 76 | (make-text (format nil "PlantUML error: ~A" e)))))) 77 | -------------------------------------------------------------------------------- /contrib/split-paragraphs/README.md: -------------------------------------------------------------------------------- 1 | # CommonDoc Split Paragraphs 2 | 3 | Generate paragraph nodes in a document by automatically splitting text nodes 4 | with double newlines. A useful pass to run after parsing from some input format. 5 | 6 | # License 7 | 8 | Copyright (c) 2015 Fernando Borretti 9 | 10 | Licensed under the MIT License. 11 | -------------------------------------------------------------------------------- /contrib/split-paragraphs/split-paragraphs.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage common-doc.split-paragraphs 3 | (:use :cl :common-doc) 4 | (:import-from :common-doc.util 5 | :make-text) 6 | (:export :*paragraph-separator-regex* 7 | :split-paragraphs) 8 | (:documentation "Main package of split-paragraphs.")) 9 | (in-package :common-doc.split-paragraphs) 10 | 11 | ;;; External interface 12 | 13 | (defparameter *paragraph-separator-regex* 14 | (ppcre:create-scanner "\\n\\n") 15 | "A regular expression that matches double newlines.") 16 | 17 | (defgeneric split-paragraphs (node) 18 | (:documentation "Recursively go through a document, splitting paragraphs in 19 | text nodes into paragraph nodes.")) 20 | 21 | ;;; Internals 22 | 23 | (defparameter +paragraph-marker+ 24 | :paragraph-split 25 | "A marker that is inserted between strings after they are separated by 26 | paragraphs.") 27 | 28 | (defun has-paragraph-separator (string) 29 | "Does string contain a paragraph separator?" 30 | (if (ppcre:scan *paragraph-separator-regex* string) t)) 31 | 32 | (defun split-paragraph (string) 33 | "Split a string by the separator into a list of strings, or return the intact 34 | string if it has none." 35 | (if (has-paragraph-separator string) 36 | (let ((result (ppcre:split *paragraph-separator-regex* string))) 37 | (cond 38 | ((null result) 39 | (list "" "")) 40 | ((equal result (list (string #\Newline))) 41 | "") 42 | (t 43 | result))) 44 | string)) 45 | 46 | (defun excise-paragraph-separators (list) 47 | "Take a list of text nodes or other elements. Separate strings by paragraphs, 48 | leaving a paragraph marker between each string." 49 | (let ((output (list))) 50 | (loop for elem in list do 51 | (if (typep elem 'text-node) 52 | ;; If it's a text node, split it by its separator 53 | (let ((split (split-paragraph (text elem)))) 54 | (if (not (listp split)) 55 | ;; Just a regular text node with no separators, add it to the 56 | ;; output 57 | (push elem output) 58 | ;; A list of text nodes, add each to the output, followed by a 59 | ;; paragraph separator marker 60 | (loop for sublist on split do 61 | (let ((text (first sublist))) 62 | (unless (equal text "") 63 | (push (make-text text) output)) 64 | (when (rest sublist) 65 | (push +paragraph-marker+ output)))))) 66 | ;; If it's another node, add it to the output unconditionally 67 | (push (split-paragraphs elem) output))) 68 | (reverse output))) 69 | 70 | (defun has-paragraph-markers (list) 71 | "Return whether a list has paragraph markers." 72 | (if (member +paragraph-marker+ list) t)) 73 | 74 | (defun create-paragraph (contents) 75 | (cond 76 | ((null contents) 77 | nil) 78 | ((and (eql (length contents) 1) 79 | (typep (first contents) 'markup)) 80 | (first contents)) 81 | (t 82 | (make-instance 'paragraph 83 | :children contents)))) 84 | 85 | (defun group-into-paragraph-nodes (list) 86 | "Take a list of nodes separated by paragraph markers and merge them into 87 | paragraph nodes." 88 | (if (has-paragraph-markers list) 89 | (let ((output (list)) 90 | (current-paragraph-contents (list))) 91 | (loop for elem in list do 92 | (cond 93 | ((equal elem +paragraph-marker+) 94 | ;; End of the paragraph 95 | (push (create-paragraph (reverse current-paragraph-contents)) 96 | output) 97 | (setf current-paragraph-contents nil)) 98 | ((or (typep elem 'code-block) 99 | (typep elem 'block-quote) 100 | (typep elem 'base-list) 101 | (typep elem 'table) 102 | (typep elem 'figure) 103 | (typep elem 'section)) 104 | ;; Another end of paragraph 105 | (push (create-paragraph (reverse current-paragraph-contents)) 106 | output) 107 | (setf current-paragraph-contents nil) 108 | (push elem output)) 109 | (t 110 | ;; Another node, so just push it in the paragraph 111 | (push elem current-paragraph-contents)))) 112 | (when current-paragraph-contents 113 | (push (create-paragraph (reverse current-paragraph-contents)) 114 | output)) 115 | (remove-if #'null (reverse output))) 116 | list)) 117 | 118 | (defun split-and-group (list) 119 | "Take a list (A node's children), and split the paragraphs." 120 | (group-into-paragraph-nodes 121 | (excise-paragraph-separators list))) 122 | 123 | ;;; Methods 124 | 125 | (defmethod split-paragraphs ((node content-node)) 126 | "Split the paragraphs in a node's children." 127 | (setf (children node) 128 | (split-and-group (children node))) 129 | node) 130 | 131 | (defmethod split-paragraphs ((node document-node)) 132 | "Regular nodes are just passed as-is." 133 | node) 134 | 135 | (defmethod split-paragraphs ((def definition)) 136 | (setf (definition def) 137 | (split-and-group (definition def))) 138 | def) 139 | 140 | (defmethod split-paragraphs ((list base-list)) 141 | (setf (children list) 142 | (split-and-group (children list))) 143 | list) 144 | 145 | (defmethod split-paragraphs ((code-block code-block)) 146 | "Don't split paragraphs in code blocks." 147 | code-block) 148 | 149 | (defmethod split-paragraphs ((doc document)) 150 | "Split paragraphs in a document's children." 151 | (setf (children doc) 152 | (split-and-group (children doc))) 153 | doc) 154 | -------------------------------------------------------------------------------- /contrib/tex/README.md: -------------------------------------------------------------------------------- 1 | # CommonDoc TeX 2 | 3 | TeX macros for CommonDoc. 4 | 5 | # Overview 6 | 7 | This contrib introduces two new macros, `` and ``, which represent 8 | inline TeX code and TeX blocks, respectively. 9 | 10 | # License 11 | 12 | Copyright (c) 2014 Fernando Borretti 13 | 14 | Licensed under the MIT License. 15 | -------------------------------------------------------------------------------- /contrib/tex/tex.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage common-doc.tex 3 | (:use :cl) 4 | (:import-from :common-doc.macro 5 | :macro-node 6 | :expand-macro) 7 | (:import-from :common-doc 8 | :text-node 9 | :content-node 10 | :children 11 | :define-node 12 | :reference) 13 | (:export :tex 14 | :tex-block) 15 | (:documentation "TeX package.")) 16 | (in-package :common-doc.tex) 17 | 18 | ;;; Classes 19 | 20 | (define-node tex (macro-node) 21 | () 22 | (:tag-name "tex") 23 | (:documentation "Inline TeX code.")) 24 | 25 | (define-node tex-block (macro-node) 26 | () 27 | (:tag-name "texb") 28 | (:documentation "Block of TeX code.")) 29 | 30 | ;;; Macroexpansions 31 | 32 | (defmethod expand-macro ((tex tex)) 33 | "Wrap the children in dollar signs." 34 | (make-instance 'content-node 35 | :children 36 | (append (list (make-instance 'text-node :text "$")) 37 | (common-doc:children tex) 38 | (list (make-instance 'text-node :text "$"))))) 39 | 40 | (defmethod expand-macro ((texb tex-block)) 41 | "Wrap the children in TeX block tags." 42 | (make-instance 'content-node 43 | :reference (reference texb) 44 | :children 45 | (append (list (make-instance 'text-node :text "\\(")) 46 | (common-doc:children texb) 47 | (list (make-instance 'text-node :text "\\)"))))) 48 | -------------------------------------------------------------------------------- /docs/beowulf.scr: -------------------------------------------------------------------------------- 1 | Hw@l(ae)t! We Gardena in geardagum, 2 | 3 | @l(th)eodcyninga, @l(th)rym gefrunon, 4 | 5 | hu @l(eth)a @l(ae)þelingas ellen fremedon. 6 | 7 | Oft Scyld Scefing scea@l(th)ena @l(th)reatum, 8 | -------------------------------------------------------------------------------- /docs/defining-nodes.scr: -------------------------------------------------------------------------------- 1 | @begin(section) 2 | @title(Defining Nodes) 3 | 4 | CommonDoc has a macro, @c(define-node), which is exactly like @c(defclass) but 5 | with a few minor extensions to define CommonDoc nodes. These are the 6 | @c(:tag-name) class option and the @c(:attribute-name) slot option. 7 | 8 | In a language with a regular syntax, like Scriba or VerTeX, where all syntactic 9 | structures have an explicit name and optionally an attribute list, these allow 10 | the parser and emitter to associate these with CommonDoc nodes, my mapping a 11 | string (The @c(:tag-name)) in the text to a class. This way, macro nodes can be 12 | parsed without actually modifying the parser of any of these formats. 13 | 14 | Markdown, Textile, and other formats that @i(explicitly) map specific syntaxes 15 | to specific nodes won't benefit from these extensions, since for every node you 16 | want to support you have to modify both parser and emitter to add a new 17 | syntactic construct that creates it. 18 | 19 | For example, Codex defines the following macro nodes: 20 | 21 | @begin[lang=lisp](code) 22 | @begin(verb)(define-node cl-doc (macro-node) 23 | () 24 | (:tag-name "cl:doc") 25 | (:documentation "Insert documentation of a node.")) 26 | 27 | (define-node with-package (macro-node) 28 | ((name :reader package-macro-name 29 | :type string 30 | :attribute-name "name" 31 | :documentation "The package's name.")) 32 | (:tag-name "cl:with-package") 33 | (:documentation "Set the current package to use in the body.")) 34 | 35 | (define-node param (macro-node) 36 | () 37 | (:tag-name "cl:param") 38 | (:documentation "An argument of an operator.")) 39 | 40 | (define-node spec (macro-node) 41 | () 42 | (:tag-name "cl:spec") 43 | (:documentation "Add a link to the Common Lisp HyperSpec.")) 44 | @end(verb) 45 | @end(code) 46 | 47 | This means that, if there's a Scriba file with the text: 48 | 49 | @begin(code) 50 | @include[path=defining-nodes.txt]() 51 | @end(code) 52 | 53 | The @c(cl:param) tag will be parsed into the @c(param) macro node. This doesn't 54 | require modifying the source code of the Scriba parser. 55 | 56 | @begin(section) 57 | @title(API) 58 | 59 | @cl:with-package[name="common-doc"]( 60 | @cl:doc(macro define-node) 61 | @cl:doc(function find-node) 62 | @cl:doc(function find-tag) 63 | @cl:doc(function find-special-slots) 64 | ) 65 | 66 | @end(section) 67 | 68 | @end(section) 69 | -------------------------------------------------------------------------------- /docs/defining-nodes.txt: -------------------------------------------------------------------------------- 1 | ... the parameter @cl:param(array) is the array of elements which... 2 | -------------------------------------------------------------------------------- /docs/errors.scr: -------------------------------------------------------------------------------- 1 | @begin(section) 2 | @title(Errors) 3 | 4 | CommonDoc defines the following error conditions: 5 | 6 | @cl:with-package[name="common-doc.error"]( 7 | @cl:doc(condition common-doc-error) 8 | @cl:doc(condition macro-error) 9 | @cl:doc(condition no-macro-expander) 10 | ) 11 | 12 | @end(section) 13 | -------------------------------------------------------------------------------- /docs/example.scr: -------------------------------------------------------------------------------- 1 | @title(My Document) 2 | 3 | @begin(section) 4 | @title(Lists) 5 | 6 | This is a list with two items: 7 | 8 | @begin(list) 9 | @item(As promised) 10 | @item(Just two) 11 | @end(list) 12 | 13 | And this is an enumerated list: 14 | 15 | @begin(enum) 16 | @item(This is the first item) 17 | @item(And this the second) 18 | @end(enum) 19 | 20 | The real numbers have these properties, among others: 21 | 22 | @begin(deflist) 23 | @term(Associative Law for Addition) 24 | @def($(x + y) + z = x + (y + z)$) 25 | 26 | @term(Commutative Law for Addition) 27 | @def($x + y = y + x$) 28 | @end(deflist) 29 | 30 | @end(section) 31 | -------------------------------------------------------------------------------- /docs/example.tex: -------------------------------------------------------------------------------- 1 | \title{My Document} 2 | 3 | \section{ 4 | \title{Lists} 5 | 6 | This is a list with two items: 7 | 8 | \list{ 9 | \item{As promised} 10 | \item{Just two) 11 | } 12 | 13 | And this is an enumerated list: 14 | 15 | \enum{ 16 | \item{This is the first item} 17 | \item{And this the second} 18 | } 19 | 20 | The real numbers have these properties, among others: 21 | 22 | \deflist{ 23 | \term{Associative Law for Addition} 24 | \def{$(x + y) + z = x + (y + z)$} 25 | 26 | \term{Commutative Law for Addition} 27 | \def{$x + y = y + x$} 28 | } 29 | 30 | } 31 | -------------------------------------------------------------------------------- /docs/extensions.scr: -------------------------------------------------------------------------------- 1 | @begin(section) 2 | @title(Extensions) 3 | 4 | @begin(section) 5 | @title(Plotting with gnuplot) 6 | 7 | The @c(common-doc-gnuplot) system allows you to render plots using gnuplot 8 | commands from inside the document. 9 | 10 | @begin(section) 11 | @title(API) 12 | 13 | @cl:with-package[name="common-doc.gnuplot"]( 14 | @cl:doc(variable *gnuplot-command*) 15 | @cl:doc(variable *gnuplot-default-term*) 16 | @cl:doc(class gnuplot) 17 | ) 18 | 19 | @end(section) 20 | 21 | @begin(section) 22 | @title(Examples) 23 | 24 | Rendering a direction field: 25 | 26 | @begin[lang=scribe](code) 27 | @include[path=gnuplot.scr start=1 end=12]() 28 | @end(code) 29 | 30 | @begin[path=dir-field.png](gnuplot) 31 | @begin(verb) 32 | set xrange [-10:10] 33 | set yrange [-10:10] 34 | set samples 25 35 | set isosamples 25 36 | set key off 37 | dx(x) = x 38 | dy(x) = 2*x 39 | plot "++" using 1:2:(dx($1)):(dy($2)) w vec 40 | @end(verb) 41 | @end(gnuplot) 42 | 43 | The sine and cosine functions: 44 | 45 | @begin[lang=scribe](code) 46 | @include[path=gnuplot.scr start=14 end=18]() 47 | @end(code) 48 | 49 | @begin[path=sin-cos.png](gnuplot) 50 | @begin(verb) 51 | plot sin(x), cos(x) 52 | @end(verb) 53 | @end(gnuplot) 54 | 55 | @end(section) 56 | 57 | @end(section) 58 | 59 | @begin(section) 60 | @title(Diagrams with Graphviz) 61 | 62 | The @c(common-doc-graphviz) system allows you to render diagrams using @c(dot) from the Graphviz collection 63 | of graph layout tools. The Graphviz tool and documentation can be found at @link[uri=https://graphviz.org](Graphviz Home Page). 64 | 65 | @begin(section) 66 | @title(API) 67 | 68 | @cl:with-package[name="common-doc.graphviz"]( 69 | @cl:doc(variable *dot-command*) 70 | @cl:doc(class graphviz) 71 | ) 72 | @end(section) 73 | 74 | @begin(section) 75 | @title(Example) 76 | 77 | @begin[lang=scribe](code) 78 | @include[path=graphviz.scr]() 79 | @end(code) 80 | 81 | @begin[path=graphviz-example.svg format=svg](graphviz) 82 | @begin(verb) 83 | digraph G { 84 | node [shape=box]; 85 | src [label="Source Code"]; 86 | doc [label="Doc Files (.scr)"]; 87 | codex; 88 | html; 89 | src -> codex -> html; 90 | doc -> codex; 91 | } 92 | @end(verb) 93 | @end(graphviz) 94 | 95 | @end(section) 96 | @end(section) 97 | 98 | @begin(section) 99 | @title(PlantUML Diagrams) 100 | 101 | The @c(common-doc-plantuml) system adds the feature to create UML diagrams using PlantUML. 102 | Documentation of the PlantUML language and tools can be found at @link[uri=https://plantuml.com](PlantUML Homepage). 103 | @begin(section) 104 | @title(API) 105 | 106 | @cl:with-package[name="common-doc.plantuml"]( 107 | @cl:doc(variable *plantuml-command*) 108 | @cl:doc(class plantuml) 109 | ) 110 | 111 | @end(section) 112 | 113 | @begin(section) 114 | @title(Examples) 115 | 116 | @begin[lang=scribe](code) 117 | @include[path=plantuml.scr]() 118 | @end(code) 119 | 120 | @begin[path=plantuml-example.svg format=svg](plantuml) 121 | @begin(verb) 122 | @startuml 123 | class plantuml { 124 | path : string 125 | output-format : string 126 | expand-macro (plot) 127 | } 128 | class macro-node { 129 | name : string 130 | } 131 | class document-node { 132 | metadata : hash-table 133 | reference : string 134 | } 135 | "macro-node" <|-- plantuml 136 | "document-node" <|-- "macro-node" 137 | @enduml 138 | @end(verb) 139 | @end(plantuml) 140 | 141 | @end(section) 142 | 143 | @end(section) 144 | @begin(section) 145 | @title(Include Files) 146 | 147 | The @c(common-doc-include) contrib loads external text files into the 148 | document. The @c(path) attribute is the path to the file, and the optional 149 | @c(start) and @c(end) attributes can be used to specify a numeric range of 150 | lines. 151 | 152 | @begin(section) 153 | @title(API) 154 | 155 | @cl:with-package[name="common-doc.include"]( 156 | @cl:doc(class include) 157 | ) 158 | 159 | @end(section) 160 | 161 | @begin(section) 162 | @title(Examples) 163 | 164 | The @link[uri=https://github.com/CommonDoc/common-doc/tree/master/docs](source 165 | code) of this documentation uses @c(common-doc-include) extensively. 166 | 167 | @end(section) 168 | 169 | @end(section) 170 | 171 | @begin(section) 172 | @title(Split Paragraphs) 173 | 174 | The @c(common-doc-split-paragraphs) contrib splits text nodes on double newlines 175 | into separate paragraphs. 176 | 177 | @begin(section) 178 | @title(API) 179 | 180 | @cl:with-package[name="common-doc.split-paragraphs"]( 181 | @cl:doc(variable *paragraph-separator-regex*) 182 | @cl:doc(generic split-paragraphs) 183 | ) 184 | 185 | @end(section) 186 | 187 | @begin(section) 188 | @title(Examples) 189 | 190 | @code[lang=lisp](@include[path=split.lisp]()) 191 | 192 | @end(section) 193 | 194 | @end(section) 195 | 196 | @begin(section) 197 | @title(TeX) 198 | 199 | The @c(common-doc-tex) contrib is just a couple of macros that expand to TeX 200 | notation. They are useful for two reasons: 201 | 202 | @begin(enum) 203 | @item(Using them is more semantic than using the resulting @c($...$) syntax.) 204 | @item(The macroexpansion can be overriden.) 205 | @end(enum) 206 | 207 | @begin(section) 208 | @title(API) 209 | 210 | @cl:with-package[name="common-doc.tex"]( 211 | @cl:doc(class tex) 212 | @cl:doc(class tex-block) 213 | ) 214 | 215 | @end(section) 216 | 217 | @begin(section) 218 | @title(Examples) 219 | 220 | The following Scriba input: 221 | 222 | @code[lang=scribe](@include[path=tex.scr start=1 end=5]()) 223 | 224 | Expands to the following: 225 | 226 | @code[lang=scribe](@include[path=tex.scr start=7]()) 227 | 228 | @end(section) 229 | 230 | @end(section) 231 | 232 | @end(section) 233 | -------------------------------------------------------------------------------- /docs/extraction.lisp: -------------------------------------------------------------------------------- 1 | (defpackage extraction-example 2 | (:use :cl :common-doc) 3 | (:import-from :common-doc.ops 4 | :collect-figures)) 5 | (in-package :extraction-example) 6 | 7 | (defvar *document* 8 | (make-document "test" 9 | :children 10 | (list 11 | (make-section 12 | (list (make-text "Section 1")) 13 | :children 14 | (list 15 | (make-figure 16 | (make-image "fig1.jpg") 17 | (list 18 | (make-text "Fig 1"))))) 19 | (make-section 20 | (list (make-text "Section 2")) 21 | :children 22 | (list 23 | (make-figure 24 | (make-image "fig2.jpg") 25 | (list 26 | (make-text "Fig 2")))))))) 27 | 28 | (collect-figures *document*) ;; => (#
#
) 29 | -------------------------------------------------------------------------------- /docs/files.scr: -------------------------------------------------------------------------------- 1 | @begin(section) 2 | @title(Files) 3 | 4 | Documents are hardly ever self-contained, and references to external resources 5 | are necessary and useful for the following reasons: 6 | 7 | @begin(enum) 8 | 9 | @item(We don't want to have to load images to memory just to represent the 10 | document, and then have to write those images to base-64 when writing the 11 | document to an output format.) 12 | 13 | @item(External resources can reduce errors. For instance, if we're writing an 14 | article detailing the internals of a piece of code, we can keep the code in an 15 | external file (along with a script to test it), and simply include bits of it 16 | using the very flexible 17 | @link[uri="https://github.com/CommonDoc/common-doc/tree/master/contrib/include"](@c(include)) 18 | contrib. Then, changes to the file will be automatically reflected in the 19 | document, reducing duplication and removing the need to manually synchronize 20 | contents.) 21 | 22 | @item(Just about every markup format supports at least referencing images both 23 | on the local filesystem and on the web, so we have to support that if we are to 24 | support that markup.) 25 | 26 | @end(enum) 27 | 28 | CommonDoc has simple support for doing operations with external files. There's a 29 | special variable, @c(*base-directory*), which basically the directory where all 30 | relative pathnames referenced in the document begin. Once that variable is 31 | bound, a couple of functions can be used to manipulate pathnames. 32 | 33 | @begin(section) 34 | @title(API) 35 | 36 | @cl:with-package[name="common-doc.file"]( 37 | @cl:doc(variable *base-directory*) 38 | @cl:doc(function absolute-path) 39 | @cl:doc(function relativize-pathname) 40 | ) 41 | 42 | @end(section) 43 | 44 | @begin(section) 45 | @title(Examples) 46 | 47 | @begin[lang=lisp](code)@begin(verb)(in-package :common-doc.file) 48 | 49 | (let ((*base-directory* (user-homedir-pathname))) 50 | (absolute-path #p"directory/file.txt")) 51 | ;; => #p"/home/eudoxia/directory/file.txt" 52 | @end(verb) 53 | @end(code) 54 | 55 | @end(section) 56 | 57 | @end(section) 58 | -------------------------------------------------------------------------------- /docs/formats.scr: -------------------------------------------------------------------------------- 1 | @begin(section) 2 | @title(Formats) 3 | 4 | @begin(section) 5 | @title(Existing Formats) 6 | 7 | @begin[ref=scriba](section) 8 | @title(Scriba 9 | @image[src="https://travis-ci.org/CommonDoc/scriba.svg?branch=master"]()) 10 | 11 | Scriba is a markup format with a syntax similar to that of 12 | @link[uri=https://en.wikipedia.org/wiki/Scribe_(markup_language)](Scribe), the 13 | late-seventies markup language. 14 | 15 | @begin[lang=scribe](code) 16 | @include[path=example.scr]() 17 | @end(code) 18 | 19 | @begin(section) 20 | @title(Emacs Mode) 21 | 22 | The Scriba repository contains a file, @c(scriba.el), which implements an Emacs 23 | mode for @c(.scr) files. The following commands are defined: 24 | 25 | @begin(deflist) 26 | @term(@c(Tab)) 27 | @def(Insert an at sign.) 28 | 29 | @term(@c(C-c C-c b)) 30 | @def(Prompts for a tag name and inserts the begin/end block with that name.) 31 | 32 | @term(@c(C-c C-c s)) 33 | @def(Prompts for a title and inserts the section block.) 34 | 35 | @term(@c(C-c C-s b)) 36 | @def(Inserts bold markup around the selection.) 37 | 38 | @term(@c(C-c C-s i)) 39 | @def(Inserts italic markup around the selection.) 40 | 41 | @term(@c(C-c C-s u)) 42 | @def(Inserts underline markup around the selection.) 43 | 44 | @term(@c(C-c C-s s)) 45 | @def(Inserts strikethrough markup around the selection.) 46 | 47 | @term(@c(C-c C-s c)) 48 | @def(Inserts code markup around the selection.) 49 | 50 | @term(@c(C-c C-s ^)) 51 | @def(Inserts superscript markup around the selection.) 52 | 53 | @term(@c(C-c C-s v)) 54 | @def(Inserts subscript markup around the selection.) 55 | @end(deflist) 56 | 57 | @end(section) 58 | 59 | @end(section) 60 | 61 | @begin(section) 62 | @title(VerTeX) 63 | 64 | VerTeX is a markup format with a 65 | @link[uri=https://en.wikipedia.org/wiki/TeX](TeX) like syntax. 66 | 67 | An example of VerTeX syntax is: 68 | 69 | @begin[lang=tex](code) 70 | @include[path=example.tex]() 71 | @end(code) 72 | 73 | One disadvantage of using VerTeX comes when writing documents with TeX (to be 74 | rendered, say, by @link[uri=https://www.mathjax.org/](MathJax) in the HTML 75 | backend). Because TeX mathematics has operators which would be parsed as VerTeX 76 | syntax (e.g. @c(\int), @c(\sigma)), you either need to escape the slashes or use 77 | the @c(\verb) tag to enter verbatim text. For example: 78 | 79 | @begin[lang=tex](code) 80 | @include[path=math.tex]() 81 | @end(code) 82 | 83 | As such, documents using TeX extensively should consider 84 | @ref[sec=scriba](Scriba). 85 | 86 | The parser uses the 87 | @link[uri=https://github.com/Shinmera/plump-tex](@c(plump-tex)) library. 88 | 89 | @end(section) 90 | 91 | @end(section) 92 | 93 | @begin(section) 94 | @title(Defining Formats) 95 | 96 | To define a new format, you simply subclass @c(document-format) and define the 97 | necessary mehods. 98 | 99 | @begin(section) 100 | @title(API) 101 | 102 | @cl:with-package[name="common-doc.format"]( 103 | @cl:doc(class document-format) 104 | @cl:doc(generic parse-document) 105 | @cl:doc(generic emit-document) 106 | ) 107 | 108 | @end(section) 109 | 110 | @begin(section) 111 | @title(Examples) 112 | 113 | Here's how the VerTeX format is defined: 114 | 115 | @code[lang=lisp](@include[path=vertex-format.lisp]()) 116 | 117 | @end(section) 118 | 119 | @end(section) 120 | 121 | @end(section) 122 | -------------------------------------------------------------------------------- /docs/future-work.scr: -------------------------------------------------------------------------------- 1 | @begin(section) 2 | @title(Future Work) 3 | 4 | @begin(deflist) 5 | @term(LaTeX Backend) 6 | @begin(def) 7 | This is essential for producing PDFs without actually having to write a PDF file 8 | directly. The problem is it requires the user to have a TeX engine installed. 9 | @end(def) 10 | 11 | @term(Classes to represent mathematics) 12 | @begin(def) 13 | A format-independent syntax should be introduced, along with translators that 14 | convert it to TeX, MathML, et cetera. The CommonDoc macro system could be used 15 | to define mathematics-specific macros. 16 | @end(def) 17 | 18 | @term(Wiki) 19 | @begin(def) 20 | A wiki built on top of CommonDoc, with a web front-end and filesystem storage. 21 | @end(def) 22 | @end(deflist) 23 | 24 | @end(section) 25 | -------------------------------------------------------------------------------- /docs/gnuplot.scr: -------------------------------------------------------------------------------- 1 | @begin[path=dir-field.png](gnuplot) 2 | @begin(verb) 3 | set xrange [-10:10] 4 | set yrange [-10:10] 5 | set samples 25 6 | set isosamples 25 7 | set key off 8 | dx(x) = x 9 | dy(x) = 2*x 10 | plot "++" using 1:2:(dx($1)):(dy($2)) w vec 11 | @end(verb) 12 | @end(gnuplot) 13 | 14 | @begin[path=sin-cos.png](gnuplot) 15 | @begin(verb) 16 | plot sin(x), cos(x) 17 | @end(verb) 18 | @end(gnuplot) 19 | -------------------------------------------------------------------------------- /docs/graphviz.scr: -------------------------------------------------------------------------------- 1 | @begin[path=graphviz-example.svg format=svg](graphviz) 2 | @begin(verb) 3 | digraph G { 4 | node [shape=box]; 5 | src [label="Source Code"]; 6 | doc [label="Doc Files (.scr)"]; 7 | codex; 8 | html; 9 | src -> codex -> html; 10 | doc -> codex; 11 | } 12 | @end(verb) 13 | @end(graphviz) 14 | -------------------------------------------------------------------------------- /docs/html.lisp: -------------------------------------------------------------------------------- 1 | (defpackage html-example 2 | (:use :cl :common-doc)) 3 | (in-package :html-example) 4 | 5 | (ql:quickload :common-html) 6 | 7 | (defvar *document* 8 | (make-document 9 | "My Document" 10 | :children 11 | (list 12 | (make-section (list (make-text "Introduction")) 13 | :children 14 | (list 15 | (make-paragraph 16 | (list (make-text "This is an example of using CommonHTML."))) 17 | (make-ordered-list 18 | (list 19 | (make-list-item 20 | (list (make-text "Item one"))) 21 | (make-list-item 22 | (list (make-text "Item two")))) 23 | :metadata (make-meta (list (cons "class" "my-list")))) 24 | (make-definition-list 25 | (list 26 | (make-definition 27 | (list (make-text "Term")) 28 | (list (make-text "Definition")))))))))) 29 | 30 | (common-doc.format:emit-to-string (make-instance 'common-html:html) 31 | *document*) 32 | " 33 | 34 | 35 | My Document 36 | 37 | 38 |

Introduction

39 | 40 |

This is an example of using CommonHTML.

41 | 42 |
    43 |
  1. Item one
    2. 44 |
  2. Item two
    3. 45 |
46 | 47 |
48 |
Term
Definition 50 |
51 | 52 | " 53 | -------------------------------------------------------------------------------- /docs/libraries.scr: -------------------------------------------------------------------------------- 1 | @begin(section) 2 | @title(Libraries) 3 | 4 | @begin(section) 5 | @title(Codex) 6 | 7 | @image[src="https://travis-ci.org/CommonDoc/codex.svg?branch=master"]() 8 | @image[src="https://coveralls.io/repos/CommonDoc/codex/badge.svg?branch=master"]() 9 | 10 | @link[uri="https://github.com/CommonDoc/codex"](@b(Codex)) is the documentation 11 | generator used to create this manual. 12 | 13 | @end(section) 14 | 15 | @begin(section) 16 | @title(CommonHTML) 17 | 18 | @image[src="https://travis-ci.org/CommonDoc/common-html.svg?branch=master"]() 19 | @image[src="https://coveralls.io/repos/CommonDoc/common-html/badge.svg?branch=master"]() 20 | 21 | @link[uri="https://github.com/CommonDoc/common-html"](@b(CommonHTML)) is 22 | CommonDoc's HTML parser and emitter. 23 | 24 | @begin(section) 25 | @title(Examples) 26 | 27 | @code[lang=lisp](@include[path=html.lisp]()) 28 | 29 | @end(section) 30 | 31 | @end(section) 32 | 33 | @begin(section) 34 | @title(Thorn) 35 | 36 | @image[src="https://travis-ci.org/CommonDoc/thorn.svg?branch=master"]() 37 | 38 | @link[uri="https://github.com/CommonDoc/thorn"](@b(Thorn)) is a library for 39 | inserting special characters into CommonDoc documents. 40 | 41 | Most input methods allow the user to insert characters in different alphabets 42 | and accented or modified versions of the same, but these are different for 43 | everyone and often the user will end up looking up a character by name. 44 | 45 | Thorn is a tool for inserting Unicode characters by an ASCII name, the way TeX 46 | allows users to insert the letters @l(alpha) and @l(beta) with the commands 47 | @c(\alpha) and @c(\beta), respectively. 48 | 49 | Simply put, it defines a macro, @c(l), that maps a string to a Unicode 50 | character. 51 | 52 | @begin(section) 53 | @title(Examples) 54 | 55 | The following Scriba input: 56 | 57 | @begin[lang=scribe](code) 58 | @include[path=beowulf.scr]() 59 | @end(code) 60 | 61 | Produces the first lines of 62 | @link[uri=http://www.sacred-texts.com/neu/asbeo.htm](@q(Beowulf)) in 63 | Anglo-Saxon: 64 | 65 | @begin(quote) 66 | Hw@l(ae)t! We Gardena in geardagum, 67 | 68 | 69 | @l(th)eodcyninga, @l(th)rym gefrunon, 70 | 71 | 72 | hu @l(eth)a @l(ae)þelingas ellen fremedon. 73 | 74 | 75 | Oft Scyld Scefing scea@l(th)ena @l(th)reatum, 76 | @end(quote) 77 | 78 | @end(section) 79 | 80 | @end(section) 81 | 82 | @begin(section) 83 | @title(Pandocl) 84 | 85 | @link[uri="https://github.com/CommonDoc/pandocl"](@b(Pandocl)) is an easy to use 86 | document converter, meant as a simple interface to CommonDoc. 87 | 88 | @begin(section) 89 | @title(Examples) 90 | 91 | @begin[lang=lisp](code) 92 | @include[path=pandocl.txt]() 93 | @end(code) 94 | 95 | @end(section) 96 | 97 | @end(section) 98 | 99 | @end(section) 100 | -------------------------------------------------------------------------------- /docs/macros.scr: -------------------------------------------------------------------------------- 1 | @begin(section) 2 | @title(Macros) 3 | 4 | @end(section) 5 | -------------------------------------------------------------------------------- /docs/manifest.lisp: -------------------------------------------------------------------------------- 1 | (:docstring-markup-format :scriba 2 | :systems (:common-doc 3 | :common-doc-gnuplot 4 | :common-doc-graphviz 5 | :common-doc-plantuml 6 | :common-doc-include 7 | :common-doc-split-paragraphs 8 | :common-doc-tex) 9 | :documents ((:title "CommonDoc" 10 | :authors ("Fernando Borretti") 11 | :output-format (:type :multi-html 12 | :template :minima) 13 | :sources ("overview.scr" 14 | "formats.scr" 15 | "nodes.scr" 16 | "defining-nodes.scr" 17 | "operations.scr" 18 | "files.scr" 19 | "errors.scr" 20 | ;"macros.scr" 21 | "libraries.scr" 22 | "extensions.scr" 23 | "future-work.scr")))) 24 | -------------------------------------------------------------------------------- /docs/math.tex: -------------------------------------------------------------------------------- 1 | The speed of light is $@verb(\frac{1}{\sqrt{\mu_0 \epsilon_0}})$. 2 | 3 | The derivative of $\\log(x)$ is $\\frac{1}{x}$. 4 | -------------------------------------------------------------------------------- /docs/nodes.lisp: -------------------------------------------------------------------------------- 1 | (in-package :common-doc) 2 | 3 | (make-document "My Document" 4 | :children 5 | (list 6 | (make-section (list (make-text "Introduction")) 7 | :children 8 | (list 9 | (make-paragraph 10 | (list (make-text "..."))))))) 11 | 12 | COMMON-DOC> (dump my-doc) 13 | document 14 | section 15 | paragraph 16 | text-node 17 | "..." 18 | 19 | CL-USER> (in-package :common-doc) 20 | # 21 | 22 | COMMON-DOC> (text (make-text "Hello, world!")) 23 | "Hello, world!" 24 | 25 | COMMON-DOC> (children (make-paragraph 26 | (list (make-text "This is ") 27 | (make-text "a test")))) 28 | (# #) 29 | 30 | COMMON-DOC> (children (make-paragraph (list (make-text "This is ") (make-text "a test")))) 31 | (# #) 32 | 33 | COMMON-DOC> (make-code-block "lisp" (list (make-text "(progn ...)"))) 34 | # 35 | 36 | COMMON-DOC> (language *) 37 | "lisp" 38 | 39 | COMMON-DOC> (children **) 40 | (#) 41 | -------------------------------------------------------------------------------- /docs/nodes.scr: -------------------------------------------------------------------------------- 1 | @begin(section) 2 | @title(Nodes) 3 | 4 | A node is a subtree of a document. Nodes range from atomic nodes like text nodes 5 | and images to containing nodes like paragraphs, bold text nodes, or section 6 | nodes. 7 | 8 | @begin(section) 9 | @title(Metadata) 10 | 11 | @cl:with-package[name="common-doc"]( 12 | @cl:doc(function make-meta) 13 | @cl:doc(function get-meta) 14 | @cl:doc(macro do-meta) 15 | ) 16 | 17 | @end(section) 18 | 19 | @begin(section) 20 | @title(Basic Classes) 21 | 22 | @cl:with-package[name="common-doc"]( 23 | @cl:doc(class document) 24 | @cl:doc(class section) 25 | @cl:doc(class document-node) 26 | @cl:doc(class content-node) 27 | @cl:doc(class text-node) 28 | @cl:doc(class paragraph) 29 | ) 30 | 31 | @end(section) 32 | 33 | @begin(section) 34 | @title(Inline Nodes) 35 | 36 | @cl:with-package[name="common-doc"]( 37 | @cl:doc(class markup) 38 | @cl:doc(class bold) 39 | @cl:doc(class italic) 40 | @cl:doc(class underline) 41 | @cl:doc(class strikethrough) 42 | @cl:doc(class code) 43 | @cl:doc(class superscript) 44 | @cl:doc(class subscript) 45 | ) 46 | 47 | @end(section) 48 | 49 | @begin(section) 50 | @title(Code) 51 | 52 | @cl:with-package[name="common-doc"]( 53 | @cl:doc(class code-block) 54 | ) 55 | 56 | @end(section) 57 | 58 | @begin(section) 59 | @title(Quotes) 60 | 61 | @cl:with-package[name="common-doc"]( 62 | @cl:doc(class base-quote) 63 | @cl:doc(class inline-quote) 64 | @cl:doc(class block-quote) 65 | ) 66 | 67 | @end(section) 68 | 69 | @begin(section) 70 | @title(Links) 71 | 72 | @cl:with-package[name="common-doc"]( 73 | @cl:doc(class link) 74 | @cl:doc(class document-link) 75 | @cl:doc(class web-link) 76 | ) 77 | 78 | @end(section) 79 | 80 | @begin(section) 81 | @title(Lists) 82 | 83 | @cl:with-package[name="common-doc"]( 84 | @cl:doc(class base-list) 85 | @cl:doc(class unordered-list) 86 | @cl:doc(class ordered-list) 87 | @cl:doc(class definition-list) 88 | @cl:doc(class list-item) 89 | @cl:doc(class definition) 90 | ) 91 | 92 | @end(section) 93 | 94 | @begin(section) 95 | @title(Images & Figures) 96 | 97 | @cl:with-package[name="common-doc"]( 98 | @cl:doc(class image) 99 | @cl:doc(class figure) 100 | ) 101 | 102 | @end(section) 103 | 104 | @begin(section) 105 | @title(Tables) 106 | 107 | @cl:with-package[name="common-doc"]( 108 | @cl:doc(class table) 109 | @cl:doc(class row) 110 | @cl:doc(class cell) 111 | ) 112 | 113 | @end(section) 114 | 115 | @begin(section) 116 | @title(Constructors) 117 | 118 | @cl:with-package[name="common-doc"]( 119 | @cl:doc(function make-content) 120 | @cl:doc(function make-text) 121 | @cl:doc(function make-paragraph) 122 | @cl:doc(function make-bold) 123 | @cl:doc(function make-italic) 124 | @cl:doc(function make-underline) 125 | @cl:doc(function make-strikethrough) 126 | @cl:doc(function make-code) 127 | @cl:doc(function make-superscript) 128 | @cl:doc(function make-subscript) 129 | @cl:doc(function make-code-block) 130 | @cl:doc(function make-inline-quote) 131 | @cl:doc(function make-block-quote) 132 | @cl:doc(function make-document-link) 133 | @cl:doc(function make-web-link) 134 | @cl:doc(function make-list-item) 135 | @cl:doc(function make-definition) 136 | @cl:doc(function make-unordered-list) 137 | @cl:doc(function make-ordered-list) 138 | @cl:doc(function make-definition-list) 139 | @cl:doc(function make-image) 140 | @cl:doc(function make-figure) 141 | @cl:doc(function make-table) 142 | @cl:doc(function make-row) 143 | @cl:doc(function make-cell) 144 | @cl:doc(function make-section) 145 | @cl:doc(function make-document) 146 | ) 147 | 148 | @end(section) 149 | 150 | @begin(section) 151 | @title(Examples) 152 | 153 | We'll create an example document using the constructor functions: 154 | 155 | @code[lang=lisp](@include[path=nodes.lisp start=1 end=10]()) 156 | 157 | We can use the @c(dump) function to inspect the structure of this document: 158 | 159 | @code[lang=lisp](@include[path=nodes.lisp start=12 end=17]()) 160 | 161 | Some examples of accessors: 162 | 163 | @code[lang=lisp](@include[path=nodes.lisp start=19 end=40]()) 164 | 165 | @end(section) 166 | 167 | @end(section) 168 | -------------------------------------------------------------------------------- /docs/operations.scr: -------------------------------------------------------------------------------- 1 | @begin(section) 2 | @title(Operations) 3 | 4 | @begin(quote) 5 | 6 | As computers capable of constructing concordances become more and more 7 | acessible, the task of compiling such an index becomes less and less 8 | significant. What was once the work of a lifetime @l(ndash) or longer @l(ndash) 9 | is now a relatively modest project. In 1875, Mary Cowden Clarke proudly wrote in 10 | the preface to her concordance of Shakespeare that "to furnish a faithful guide 11 | to this rich mine of intellectual treasure... has been the ambition of a life; 12 | and it is hoped that the sixteen years' assiduous labour... may be found to have 13 | accomplished that ambition". It may have been hard for Mrs. Clarke to imagine 14 | that a century later, just one person, Todd K. Bender, professor of English at 15 | the University of Wisconsin, would produce nine concordances in the time it took 16 | her to construct one. 17 | 18 | 19 | @l(mdash) Ian H. Witten, Alistair Moffat, and Timothy C. Bell. @i(Managing 20 | Gigabytes: Compressing and Indexing Documents and Images) 21 | @end(quote) 22 | 23 | Representing documents is half the battle: Now we need ways to traverse, edit 24 | and filter them. 25 | 26 | CommonDoc, on top of providing the representation of documents, also provides 27 | operations that can be applied to all documents. These range from the simple 28 | operation of traversing every node in the document to more complex tasks like 29 | generating a table of contents or ensuring every section in the document has a 30 | unique ID. 31 | 32 | @begin(section) 33 | @title(Document Traversal) 34 | 35 | @cl:with-package[name="common-doc.ops"]( 36 | @cl:doc(generic traverse-document) 37 | @cl:doc(macro with-document-traversal) 38 | ) 39 | 40 | @begin(section) 41 | @title(Examples) 42 | 43 | @code[lang=lisp](@include[path=traverse.lisp]()) 44 | 45 | @end(section) 46 | 47 | @end(section) 48 | 49 | @begin(section) 50 | @title(Extraction) 51 | 52 | Many textbooks include lists of figures and tables. These operations make this 53 | kind of document preparation tasks easier. 54 | 55 | @cl:with-package[name="common-doc.ops"]( 56 | @cl:doc(function collect-figures) 57 | @cl:doc(function collect-images) 58 | @cl:doc(function collect-tables) 59 | @cl:doc(function collect-external-links) 60 | @cl:doc(function collect-all-text) 61 | ) 62 | 63 | @begin(section) 64 | @title(Examples) 65 | 66 | @code[lang=lisp](@include[path=extraction.lisp]()) 67 | 68 | @end(section) 69 | 70 | @end(section) 71 | 72 | @begin(section) 73 | @title(Filling References) 74 | 75 | This operation goes through a document, ensuring every section has a unique 76 | reference ID. Each ID is the 'slug' of the title's text (The text is extracted 77 | using the @c(collect-all-text) operations), optionally with a number preprended 78 | if this slug is not unique. 79 | 80 | @cl:with-package[name="common-doc.ops"]( 81 | @cl:doc(function fill-unique-refs) 82 | ) 83 | 84 | @end(section) 85 | 86 | @begin(section) 87 | @title(Table of Contents) 88 | 89 | @cl:with-package[name="common-doc.ops"]( 90 | @cl:doc(function table-of-contents) 91 | ) 92 | 93 | @begin(section) 94 | @title(Examples) 95 | 96 | @code[lang=lisp](@include[path=toc.lisp]()) 97 | 98 | @end(section) 99 | 100 | @end(section) 101 | 102 | @begin(section) 103 | @title(Equality) 104 | 105 | @cl:with-package[name="common-doc.ops"]( 106 | @cl:doc(generic node-equal) 107 | @cl:doc(generic node-specific-equal) 108 | ) 109 | 110 | @end(section) 111 | 112 | @end(section) 113 | -------------------------------------------------------------------------------- /docs/overview.scr: -------------------------------------------------------------------------------- 1 | @begin(section) 2 | @title(Overview) 3 | 4 | @link[uri=https://github.com/CommonDoc/common-doc](CommonDoc) is a library of 5 | classes for representing structured documents. It's completely independent of 6 | input or output formats, and provides operations for inspecting and manipulating 7 | documents. 8 | 9 | @begin(section) 10 | @title(Features) 11 | 12 | @begin(deflist) 13 | 14 | @term(Separation of Concerns) 15 | @begin(def) 16 | Parsers for Markdown and other markup languages generally implement their 17 | internal representation of document structure, and code to transform it directly 18 | to one or more output formats. Generally, every parser has a different internal 19 | representation, a different set of supported backends, each in various degrees 20 | of completeness. 21 | 22 | What CommonDoc provides is a way to separate parser and emitter by providing a 23 | common framework for representing documents. Parsers and emitters can be written 24 | to convert text to and from various markup languages (Markdown, Textile, ReST, 25 | etc.) while keeping a single, backend-agnostic internal representation. 26 | @end(def) 27 | 28 | @term(Macros) 29 | @begin(def) 30 | CommonDoc has macro nodes that can be expanded to other nodes, and has built-in 31 | nodes for including external text files, rendering gnuplot graphs, among other 32 | things. 33 | @end(def) 34 | 35 | @term(Operations) 36 | @begin(def) 37 | CommonDoc provides operations that modify or extract information from documents, 38 | and because of the input/output-agnostic design work for all documents. 39 | @end(def) 40 | 41 | @end(deflist) 42 | 43 | @end(section) 44 | 45 | @begin(section) 46 | @title(Use Cases) 47 | 48 | @begin(section) 49 | @title(Documentation) 50 | 51 | The @link[uri="https://github.com/CommonDoc/codex"](Codex) documentation 52 | generation (used to build this manual) uses CommonDoc to represent the 53 | documentation as well as parse docstrings, and build highly customizable user 54 | and programer documentation for Common Lisp projects. 55 | 56 | @end(section) 57 | 58 | @begin(section) 59 | @title(Document Conversion) 60 | 61 | CommonDoc defines input and output parsers for each input format, making it an 62 | ideal tool to convert documents from one markup format to the other. 63 | 64 | @end(section) 65 | 66 | @begin(section) 67 | @title(Wiki) 68 | 69 | CommonDoc, along with CommonHTML, can be used as the backend of a wiki system. 70 | 71 | @end(section) 72 | 73 | @end(section) 74 | 75 | @begin(section) 76 | @title(Motivation) 77 | 78 | This library can be considered an implementation of Robert Strandh's suggestion 79 | for the creation of a 80 | @link[uri="http://metamodular.com/Common-Lisp/document-library.html"](library 81 | for representing documents): 82 | 83 | @begin(quote) 84 | The purpose of this project is to create a library that defines a set of classes 85 | and generic functions that allow some client code to create and manipulate a 86 | document. Contrary to the types of systems cited above, the specification of 87 | this system is thus in terms of what kind of objects it manipulates, and what 88 | functions exist to manipulate them. 89 | 90 | A library like this can then be used both by an application that reads some 91 | markup syntax and produces the document in the form of a graph of class 92 | instances, and by an interactive application that allows the user to create the 93 | document by issuing gestures. In fact, it will be possible to create several 94 | different application with different markups and with a different set of 95 | possible gestures. 96 | @end(quote) 97 | 98 | @end(section) 99 | 100 | @end(section) 101 | -------------------------------------------------------------------------------- /docs/pandocl.txt: -------------------------------------------------------------------------------- 1 | CL-USER> (pandocl:convert #p"input.tex" #p"output.html") 2 | # 3 | 4 | CL-USER> (pandocl:emit #p"input.tex" #p"output.html" 5 | :input-format :vertex 6 | :output-format :html) 7 | # 8 | 9 | CL-USER> (pandocl:parse #p"path/to/doc.tex") 10 | # 11 | 12 | CL-USER> (pandocl:parse #p"path/to/doc.tex" :format :vertex) 13 | # 14 | 15 | CL-USER> (pandocl:emit doc #p"path/to/output.html") 16 | # 17 | 18 | CL-USER> (pandocl:emit doc #p"path/to/output.html" :format :html) 19 | # 20 | -------------------------------------------------------------------------------- /docs/plantuml.scr: -------------------------------------------------------------------------------- 1 | @begin[path=plantuml-example.svg format=svg](plantuml) 2 | @begin(verb) 3 | @startuml 4 | class plantuml { 5 | path : string 6 | output-format : string 7 | expand-macro (plot) 8 | } 9 | class macro-node { 10 | name : string 11 | } 12 | class document-node { 13 | metadata : hash-table 14 | reference : string 15 | } 16 | "macro-node" <|-- plantuml 17 | "document-node" <|-- "macro-node" 18 | @enduml 19 | @end(verb) 20 | @end(plantuml) 21 | -------------------------------------------------------------------------------- /docs/split.lisp: -------------------------------------------------------------------------------- 1 | (defpackage split-paragraphs-example 2 | (:use :cl :common-doc) 3 | (:import-from :common-doc.split-paragraphs 4 | :split-paragraphs)) 5 | (in-package :split-paragraphs-example) 6 | 7 | (defvar *document* (make-content 8 | (list 9 | (make-text 10 | (format nil "Some text.~%~%Some ")) 11 | (make-bold 12 | (list (make-text "bold text"))) 13 | (make-text (format nil ".~%~%Other text."))))) 14 | 15 | (dump *document*) 16 | 17 | ;; content-node 18 | ;; text-node 19 | ;; "Some text. 20 | ;; 21 | ;; Some " 22 | ;; bold 23 | ;; text-node 24 | ;; "bold text" 25 | ;; text-node 26 | ;; ". 27 | ;; 28 | ;; Other text." 29 | 30 | (setf *document* (split-paragraphs *document*)) 31 | 32 | (dump *document*) 33 | 34 | ;; content-node 35 | ;; paragraph 36 | ;; text-node 37 | ;; "Some text." 38 | ;; paragraph 39 | ;; text-node 40 | ;; "Some " 41 | ;; bold 42 | ;; text-node 43 | ;; "bold text" 44 | ;; text-node 45 | ;; "." 46 | ;; paragraph 47 | ;; text-node 48 | ;; "Other text." 49 | -------------------------------------------------------------------------------- /docs/tex.scr: -------------------------------------------------------------------------------- 1 | The derivative of a function @tex(f) at @tex(a), @tex(f'(a)), is 2 | 3 | @begin(texb) 4 | f'(a) = \lim_{h \to 0} \frac{f(a+h)-f(a)}{h} 5 | @end(texb) 6 | 7 | The derivative of a function $f$ at $a$, $f'(a)$, is 8 | 9 | \( 10 | f'(a) = \lim_{h \to 0} \frac{f(a+h)-f(a)}{h} 11 | \) 12 | -------------------------------------------------------------------------------- /docs/toc.lisp: -------------------------------------------------------------------------------- 1 | (defpackage toc-example 2 | (:use :cl :common-doc) 3 | (:import-from :common-doc.ops 4 | :table-of-contents)) 5 | (in-package :toc-example) 6 | 7 | (defvar *document* 8 | (make-document "test" 9 | :children 10 | (list 11 | (make-section 12 | (list (make-text "Section 1")) 13 | :reference "sec1" 14 | :children 15 | (list 16 | (make-content 17 | (list 18 | (make-content 19 | (list 20 | (make-section 21 | (list (make-text "Section 1.1")) 22 | :reference "sec11"))))))) 23 | (make-section 24 | (list (make-text "Section 2")) 25 | :reference "sec2" 26 | :children 27 | (list 28 | (make-text "sec2 contents")))))) 29 | 30 | (defvar *toc* (table-of-contents *document*)) 31 | 32 | (dump *toc*) 33 | ;; ordered-list [class=toc] 34 | ;; list-item 35 | ;; content-node 36 | ;; document-link 37 | ;; text-node 38 | ;; "Section 1" 39 | ;; ordered-list 40 | ;; list-item 41 | ;; content-node 42 | ;; document-link 43 | ;; text-node 44 | ;; "Section 1.1" 45 | ;; list-item 46 | ;; content-node 47 | ;; document-link 48 | ;; text-node 49 | ;; "Section 2" 50 | -------------------------------------------------------------------------------- /docs/traverse.lisp: -------------------------------------------------------------------------------- 1 | (defpackage traverse-example 2 | (:use :cl :common-doc) 3 | (:import-from :common-doc.ops 4 | :with-document-traversal)) 5 | (in-package :traverse-example) 6 | 7 | (defvar *document* 8 | (make-document "test" 9 | :children 10 | (list 11 | (make-bold 12 | (list 13 | (make-italic 14 | (list 15 | (make-underline 16 | (list (make-text "Hello, world!")))))))))) 17 | 18 | (with-document-traversal (*document* node) 19 | (print node)) 20 | 21 | ;; # 22 | ;; # 23 | ;; # 24 | ;; # 25 | ;; # 26 | ;; NIL 27 | -------------------------------------------------------------------------------- /docs/vertex-format.lisp: -------------------------------------------------------------------------------- 1 | (defclass vertex (document-format) 2 | () 3 | (:documentation "The VerTeX format.")) 4 | 5 | (defmethod parse-document ((vertex vertex) 6 | (string string)) 7 | "Return a VerTeX document parsed from a string." 8 | (vertex.parser:parse-string string)) 9 | 10 | (defmethod parse-document ((vertex vertex) 11 | (pathname pathname)) 12 | "Return a VerTeX document parsed from a file." 13 | (vertex.parser:parse-file pathname)) 14 | 15 | (defmethod emit-document ((vertex vertex) 16 | (node common-doc:document-node) 17 | stream) 18 | (vertex.emitter:emit-to-stream node stream)) 19 | 20 | (defmethod emit-document ((vertex vertex) 21 | (doc common-doc:document) 22 | stream) 23 | (vertex.emitter:emit-to-stream doc stream)) 24 | -------------------------------------------------------------------------------- /src/classes.lisp: -------------------------------------------------------------------------------- 1 | (in-package :common-doc) 2 | 3 | ;;; Basic classes 4 | 5 | (define-node document-node () 6 | ((metadata :accessor metadata 7 | :initarg :metadata 8 | :type (or null hash-table) 9 | :initform nil 10 | :documentation "Node metadata.") 11 | (reference :accessor reference 12 | :initarg :reference 13 | :type (or null string) 14 | :initform nil 15 | :attribute-name "ref" 16 | :documentation "A unique string identifying the node.")) 17 | (:documentation "The base class of all document classes.")) 18 | 19 | (define-node content-node (document-node) 20 | ((children :accessor children 21 | :initarg :children 22 | :initform nil 23 | :type (proper-list document-node) 24 | :documentation "The node's children.")) 25 | (:documentation "A node with children. This is the base class of all nodes 26 | that have a @c(children) slot (Except @c(document), since this class inherits 27 | from @c(document-node)) and can also be used as a way to represent a generic 28 | grouping of elements. This is useful when building a CommonDoc document by 29 | parsing some input language.")) 30 | 31 | (define-node text-node (document-node) 32 | ((text :accessor text 33 | :initarg :text 34 | :type string 35 | :documentation "The node's text.")) 36 | (:documentation "A node representing a bare string of text.")) 37 | 38 | (define-node paragraph (content-node) 39 | () 40 | (:tag-name "p") 41 | (:documentation "A paragraph.")) 42 | 43 | ;;; Markup 44 | 45 | (define-node markup (content-node) 46 | () 47 | (:documentation "The superclass of all inline markup elements.")) 48 | 49 | (define-node bold (markup) 50 | () 51 | (:tag-name "b") 52 | (:documentation "Text in this element is bold.")) 53 | 54 | (define-node italic (markup) 55 | () 56 | (:tag-name "i") 57 | (:documentation "Text in this element is italicized.")) 58 | 59 | (define-node underline (markup) 60 | () 61 | (:tag-name "u") 62 | (:documentation "Text in this element is underlined.")) 63 | 64 | (define-node strikethrough (markup) 65 | () 66 | (:tag-name "strike") 67 | (:documentation "Text in this element is striked out.")) 68 | 69 | (define-node code (markup) 70 | () 71 | (:tag-name "c") 72 | (:documentation "Text in this element is monospaced or otherwise marked as 73 | code or computer output.")) 74 | 75 | (define-node superscript (markup) 76 | () 77 | (:tag-name "sup") 78 | (:documentation "Text in this element is superscripted relative to containing 79 | elements.")) 80 | 81 | (define-node subscript (markup) 82 | () 83 | (:tag-name "sub") 84 | (:documentation "Text in this element is subscripted relative to containing 85 | elements.")) 86 | 87 | ;;; Code 88 | 89 | (define-node code-block (content-node) 90 | ((language :accessor language 91 | :initarg :language 92 | :initform nil 93 | :type (or null string) 94 | :attribute-name "lang" 95 | :documentation "The language of the code block's contents.")) 96 | (:tag-name "code") 97 | (:documentation "A block of code.")) 98 | 99 | ;;; Quotes 100 | 101 | (define-node base-quote (content-node) 102 | () 103 | (:documentation "The base class of all quotes.")) 104 | 105 | (define-node inline-quote (base-quote) 106 | () 107 | (:tag-name "q") 108 | (:documentation "A quote that occurs inside a paragraph in the document.")) 109 | 110 | (define-node block-quote (base-quote) 111 | () 112 | (:tag-name "quote") 113 | (:documentation "A block quote.")) 114 | 115 | ;;; Links 116 | 117 | (define-node link (content-node) 118 | () 119 | (:documentation "The base class for all links, internal and external.")) 120 | 121 | (define-node document-link (link) 122 | ((document-reference :accessor document-reference 123 | :initarg :document-reference 124 | :initform nil 125 | :type (or null string) 126 | :attribute-name "doc" 127 | :documentation "A reference ID for the linked document. 128 | If @c(NIL), the link is only to a section within the document.") 129 | (node-reference :accessor node-reference 130 | :initarg :node-reference 131 | :type (or null string) 132 | :attribute-name "id" 133 | :documentation "A reference ID for the linked node.")) 134 | (:tag-name "ref") 135 | (:documentation "A link to a section of this document, to another document and 136 | optionally a section within that document. See also the @c(reference) slot in 137 | the @c(document) class.")) 138 | 139 | (define-node web-link (link) 140 | ((uri :accessor uri 141 | :initarg :uri 142 | :type quri:uri 143 | :attribute-name "uri" 144 | :documentation "The URI of the external resource.")) 145 | (:tag-name "link") 146 | (:documentation "An external link.")) 147 | 148 | ;;; Lists 149 | 150 | (define-node base-list (document-node) 151 | () 152 | (:documentation "The base class of all lists.")) 153 | 154 | (define-node list-item (content-node) 155 | () 156 | (:tag-name "item") 157 | (:documentation "The item in a non-definition list.")) 158 | 159 | (define-node definition (document-node) 160 | ((term :accessor term 161 | :initarg :term 162 | :type (proper-list document-node) 163 | :documentation "The definition term.") 164 | (definition :accessor definition 165 | :initarg :definition 166 | :type (proper-list document-node) 167 | :documentation "Defines the term.")) 168 | (:documentation "An item in a definition list.")) 169 | 170 | (define-node unordered-list (base-list) 171 | ((children :accessor children 172 | :initarg :children 173 | :type (proper-list list-item) 174 | :documentation "The list of @c(list-item) instances.")) 175 | (:tag-name "list") 176 | (:documentation "A list where the elements are unordered.")) 177 | 178 | (define-node ordered-list (base-list) 179 | ((children :accessor children 180 | :initarg :children 181 | :type (proper-list list-item) 182 | :documentation "The list of @c(list-item) instances.")) 183 | (:tag-name "enum") 184 | (:documentation "A list where the elements are ordered.")) 185 | 186 | (define-node definition-list (base-list) 187 | ((children :accessor children 188 | :initarg :children 189 | :type (proper-list definition) 190 | :documentation "The list of @c(definition) instances.")) 191 | (:tag-name "deflist") 192 | (:documentation "A list of definitions.")) 193 | 194 | ;;; Figures 195 | 196 | (define-node image (document-node) 197 | ((source :accessor source 198 | :initarg :source 199 | :type string 200 | :attribute-name "src" 201 | :documentation "The source where the image is stored.") 202 | (description :accessor description 203 | :initarg :description 204 | :type (or null string) 205 | :initform nil 206 | :attribute-name "desc" 207 | :documentation "A plain text description of the image.")) 208 | (:tag-name "image") 209 | (:documentation "An image.")) 210 | 211 | (define-node figure (document-node) 212 | ((image :accessor image 213 | :initarg :image 214 | :type image 215 | :documentation "The figure's image.") 216 | (description :accessor description 217 | :initarg :description 218 | :type (proper-list document-node) 219 | :documentation "A description of the image.")) 220 | (:tag-name "figure") 221 | (:documentation "A figure, an image plus an annotation.")) 222 | 223 | ;;; Tables 224 | 225 | (define-node table (document-node) 226 | ((rows :accessor rows 227 | :initarg :rows 228 | :type (proper-list row) 229 | :documentation "The list of rows in a table.")) 230 | (:tag-name "table") 231 | (:documentation "A table.")) 232 | 233 | (define-node row (document-node) 234 | ((header :accessor header 235 | :initarg :header 236 | :type (proper-list document-node) 237 | :documentation "The row header.") 238 | (footer :accessor footer 239 | :initarg :footer 240 | :type (proper-list document-node) 241 | :documentation "The row footer.") 242 | (cells :accessor cells 243 | :initarg :cells 244 | :type (proper-list cell) 245 | :documentation "The cells in the row.")) 246 | (:tag-name "row") 247 | (:documentation "A row in a table.")) 248 | 249 | (define-node cell (content-node) 250 | () 251 | (:tag-name "cell") 252 | (:documentation "A cell in a table.")) 253 | 254 | ;;; Large-scale structure 255 | 256 | (define-node section (content-node) 257 | ((title :accessor title 258 | :initarg :title 259 | :type (proper-list document-node) 260 | :attribute-name "title" 261 | :documentation "The section title.")) 262 | (:tag-name "section") 263 | (:documentation "Represents a section in the document. Unlike HTML, where a 264 | section is just another element, sections in CommonDoc contain their contents.")) 265 | 266 | (defclass document () 267 | ((children :accessor children 268 | :initarg :children 269 | :type (proper-list document-node) 270 | :documentation "The document's children nodes.") 271 | (title :accessor title 272 | :initarg :title 273 | :type string 274 | :documentation "The document's title.") 275 | (creator :accessor creator 276 | :initarg :creator 277 | :type string 278 | :documentation "The creator of the document.") 279 | (publisher :accessor publisher 280 | :initarg :publisher 281 | :type string 282 | :documentation "The document's publisher.") 283 | (subject :accessor subject 284 | :initarg :subject 285 | :type string 286 | :documentation "The subject the document deals with.") 287 | (description :accessor description 288 | :initarg :description 289 | :type string 290 | :documentation "A description of the document.") 291 | (keywords :accessor keywords 292 | :initarg :keywords 293 | :type (proper-list string) 294 | :documentation "A list of strings, each being a keyword for the document.") 295 | (reference :accessor reference 296 | :initarg :reference 297 | :type string 298 | :documentation "A reference string to uniquely identify the 299 | document within a certain context.") 300 | (language :accessor language 301 | :initarg :language 302 | :type string 303 | :documentation "An @link[uri=http://www.ietf.org/rfc/rfc4646.txt](RFC4646) string denoting the language the document is written in.") 304 | (rights :accessor rights 305 | :initarg :rights 306 | :type string 307 | :documentation "Information on the document's copyright.") 308 | (version :accessor version 309 | :initarg :version 310 | :type string 311 | :documentation "The document version.") 312 | (created-on :accessor created-on 313 | :initarg :created-on 314 | :type local-time:timestamp 315 | :initform (local-time:now) 316 | :documentation "The date and time when the document was 317 | created. By default, this is the date and time at instance 318 | creation.")) 319 | (:documentation "A document. 320 | 321 | Metadata is mostly based on 322 | @link[uri=https://en.wikipedia.org/wiki/Dublin_Core](Dublin Core) and the 323 | @link[uri=https://en.wikipedia.org/wiki/OpenDocument_technical_specification#Metadata](OpenDocument) 324 | format.")) 325 | -------------------------------------------------------------------------------- /src/constructors.lisp: -------------------------------------------------------------------------------- 1 | (in-package :common-doc) 2 | 3 | ;;; Utilities 4 | 5 | (defun construct (class children metadata reference) 6 | "Instantiate a class with children and metadata." 7 | (make-instance class 8 | :children (uiop:ensure-list children) 9 | :metadata metadata 10 | :reference reference)) 11 | 12 | ;; NOTE: 13 | ;; Originally, I wanted something like that, to keep metadata and 14 | ;; slots in sync, but reality is more complex and web-link's URI slot 15 | ;; contains QURI:URI object whereas Scriba expects that metadata's URI 16 | ;; item has a string. 17 | ;; 18 | ;; Thus I've decided to create correct meta-data in the web-link's contructor :( 19 | ;; 20 | ;; QUESTION: May be it is Scriba should be fixed, to fill attributes 21 | ;; from slot values of items returned by FIND-SPECIAL-SLOTS? 22 | ;; 23 | ;; (defmethod initialize-instance :after ((node document-node) &rest initargs) 24 | ;; (declare (ignore initargs)) 25 | 26 | ;; ;; We have to keep metadata and slot values syncronized, because 27 | ;; ;; some formats like Scriba when emiting node attributes take 28 | ;; ;; their names and values from node's metadata. 29 | ;; (loop with special-slots = (common-doc:find-special-slots (class-of node)) 30 | ;; for (meta-name . slot-name) in special-slots 31 | ;; for slot-value = (when (slot-boundp node slot-name) 32 | ;; (slot-value node slot-name)) 33 | ;; for meta-value = (get-meta node meta-name) 34 | ;; when (and meta-value 35 | ;; (not (equal meta-value slot-value))) 36 | ;; do (warn "Node ~S has different value for slot ~S. In metadata: ~S and in slot ~S." 37 | ;; node slot-name meta-value slot-value) 38 | ;; when slot-value 39 | ;; do (setf (get-meta node meta-name) 40 | ;; slot-value))) 41 | 42 | ;;; Interface 43 | 44 | (defun make-content (children &key metadata reference) 45 | "Create a content node from its children." 46 | (construct 'content-node children metadata reference)) 47 | 48 | (defun make-text (string &key metadata reference) 49 | "Create a text node from the contents of a string." 50 | (make-instance 'text-node 51 | :text string 52 | :metadata metadata 53 | :reference reference)) 54 | 55 | (defun make-paragraph (children &key metadata reference) 56 | "Create a paragraph node from its children." 57 | (construct 'paragraph children metadata reference)) 58 | 59 | (defun make-bold (children &key metadata reference) 60 | "Create a bold node from its children." 61 | (construct 'bold children metadata reference)) 62 | 63 | (defun make-italic (children &key metadata reference) 64 | "Create an italicized node from its children." 65 | (construct 'italic children metadata reference)) 66 | 67 | (defun make-underline (children &key metadata reference) 68 | "Create an underlined node from its children." 69 | (construct 'underline children metadata reference)) 70 | 71 | (defun make-strikethrough (children &key metadata reference) 72 | "Create an striked out node from its children." 73 | (construct 'strikethrough children metadata reference)) 74 | 75 | (defun make-code (children &key metadata reference) 76 | "Create an inline code node from its children." 77 | (construct 'code children metadata reference)) 78 | 79 | (defun make-superscript (children &key metadata reference) 80 | "Create a superscripted node from its children." 81 | (construct 'superscript children metadata reference)) 82 | 83 | (defun make-subscript (children &key metadata reference) 84 | "Create a subscripted node from its children." 85 | (construct 'subscript children metadata reference)) 86 | 87 | (defun make-code-block (language children &key metadata reference) 88 | "Create a code block node from its children and language." 89 | (make-instance 'code-block 90 | :language language 91 | :children (uiop:ensure-list children) 92 | :metadata metadata 93 | :reference reference)) 94 | 95 | (defun make-inline-quote (children &key metadata reference) 96 | "Create an inline quote node from its children." 97 | (construct 'inline-quote children metadata reference)) 98 | 99 | (defun make-block-quote (children &key metadata reference) 100 | "Create a block quote node from its children." 101 | (construct 'block-quote children metadata reference)) 102 | 103 | (defun make-document-link (document reference children &key metadata) 104 | "Create a document link from document and node references and its children." 105 | (check-type document (or null string)) 106 | (check-type reference (or null string)) 107 | 108 | (let ((node (make-instance 'document-link 109 | :document-reference document 110 | :node-reference reference 111 | :children (uiop:ensure-list children) 112 | :metadata metadata))) 113 | ;; Scriba expects there will be a STRING in this metadata item: 114 | (when document 115 | (setf (get-meta node "doc") 116 | document)) 117 | (when reference 118 | (setf (get-meta node "id") 119 | reference)) 120 | (values node))) 121 | 122 | (defun make-web-link (uri children &key metadata reference) 123 | "Create a web link." 124 | (let ((node (make-instance 'web-link 125 | :uri (quri:uri uri) 126 | :children (uiop:ensure-list children) 127 | :metadata metadata 128 | :reference reference))) 129 | ;; Scriba expects there will be a STRING in this metadata item: 130 | (setf (get-meta node "uri") 131 | uri) 132 | (values node))) 133 | 134 | (defun make-list-item (children &key metadata reference) 135 | "Create a list item." 136 | (construct 'list-item children metadata reference)) 137 | 138 | (defun make-definition (term definition &key metadata reference) 139 | "Create a definition list item." 140 | (make-instance 'definition 141 | :term term 142 | :definition definition 143 | :metadata metadata 144 | :reference reference)) 145 | 146 | (defun make-unordered-list (children &key metadata reference) 147 | "Create an unordered list." 148 | (construct 'unordered-list children metadata reference)) 149 | 150 | (defun make-ordered-list (children &key metadata reference) 151 | "Create an ordered list." 152 | (construct 'ordered-list children metadata reference)) 153 | 154 | (defun make-definition-list (children &key metadata reference) 155 | "Create a definition list." 156 | (construct 'definition-list children metadata reference)) 157 | 158 | (defun make-image (source &key description metadata reference) 159 | "Create an image." 160 | (make-instance 'image 161 | :source source 162 | :description description 163 | :metadata metadata 164 | :reference reference)) 165 | 166 | (defun make-figure (image description &key metadata reference) 167 | "Create a figure." 168 | (make-instance 'figure 169 | :image image 170 | :description description 171 | :metadata metadata 172 | :reference reference)) 173 | 174 | (defun make-table (rows &key metadata reference) 175 | "Create a table from a list of rows." 176 | (make-instance 'table 177 | :rows rows 178 | :metadata metadata 179 | :reference reference)) 180 | 181 | (defun make-row (cells &key metadata reference) 182 | "Create a row from a list of cells." 183 | (make-instance 'row 184 | :cells cells 185 | :metadata metadata 186 | :reference reference)) 187 | 188 | (defun make-cell (children &key metadata reference) 189 | "Create a cell from its children." 190 | (construct 'cell children metadata reference)) 191 | 192 | (defun make-section (title &key children reference metadata) 193 | "Create a section from its title and children." 194 | 195 | (let ((title (loop for item in (uiop:ensure-list title) 196 | collect (etypecase item 197 | (string (make-text item)) 198 | (document-node item))))) 199 | (make-instance 'section 200 | :title title 201 | :reference reference 202 | :children (uiop:ensure-list children) 203 | :metadata metadata))) 204 | 205 | (defun make-document (title &key children keywords &allow-other-keys) 206 | "Create a document." 207 | (make-instance 'document 208 | :title title 209 | :children (uiop:ensure-list children) 210 | :keywords keywords)) 211 | -------------------------------------------------------------------------------- /src/define.lisp: -------------------------------------------------------------------------------- 1 | (in-package :common-doc) 2 | 3 | (defvar *registry* (make-hash-table :test #'equal) 4 | "A hash table from tag names to node classes.") 5 | 6 | (defvar *node-slots* (make-hash-table :test #'equal)) 7 | 8 | (defmacro define-node (name (&rest superclasses) slots &body class-options) 9 | "Define a CommonDoc node." 10 | (flet ((tag-name-p (opt) 11 | "Whether `opt` is a list of the form `(:tag-name ...)`." 12 | (and (listp opt) 13 | (eq (first opt) :tag-name))) 14 | (extract-slot-names (slots) 15 | "Extract the value of the `:attribute-name` key of a slot, if it exists." 16 | (let ((final-slots (list)) 17 | (special-slots (list))) 18 | ;; `final-slots` is the list of slots that will be handed to the 19 | ;; `defclass` form, while `special-slots` is an alist of attribute 20 | ;; names to slot names 21 | (loop for slot in slots do 22 | (let ((slot-attrs (rest slot))) 23 | (awhen (getf slot-attrs :attribute-name) 24 | (push (cons it (first slot)) special-slots)) 25 | (push (cons (first slot) 26 | (alexandria:remove-from-plist slot-attrs :attribute-name)) 27 | final-slots))) 28 | (cons (reverse final-slots) 29 | (reverse special-slots))))) 30 | (let* ((tag-name (find-if #'tag-name-p class-options)) 31 | (class-options (remove-if #'tag-name-p class-options)) 32 | (slots-and-special-slots (extract-slot-names slots)) 33 | (slots (first slots-and-special-slots)) 34 | (special-slots (rest slots-and-special-slots))) 35 | `(progn 36 | (defclass ,name ,superclasses 37 | ,slots 38 | ,@class-options) 39 | (let ((class (find-class ',name))) 40 | (when ,(cadr tag-name) 41 | (setf (gethash ,(cadr tag-name) *registry*) 42 | class)) 43 | (when ',special-slots 44 | (setf (gethash class *node-slots*) 45 | ',special-slots))) 46 | t)))) 47 | 48 | (defun find-node (tag-name) 49 | "Find a node class by its tag name." 50 | (gethash tag-name *registry*)) 51 | 52 | (defun find-tag (class) 53 | "Return a node class' tag name." 54 | (loop for tag-name being the hash-keys of *registry* 55 | using (hash-value tag-class) 56 | if (equal class tag-class) 57 | return tag-name)) 58 | 59 | (defun find-special-slots (class) 60 | "Return a node class' special slots." 61 | (append (gethash class *node-slots*) 62 | (loop for superclass in (closer-mop:class-direct-superclasses class) 63 | appending (find-special-slots superclass)))) 64 | -------------------------------------------------------------------------------- /src/error.lisp: -------------------------------------------------------------------------------- 1 | (in-package :common-doc.error) 2 | 3 | (define-condition common-doc-error (simple-error) 4 | () 5 | (:documentation "The base class of all CommonDoc errors.")) 6 | 7 | (define-condition macro-error (common-doc-error) 8 | () 9 | (:documentation "The base class of all macro-related errors.")) 10 | 11 | (define-condition no-macro-expander (macro-error) 12 | ((node :accessor node 13 | :initarg :node 14 | :type common-doc.macro:macro-node 15 | :documentation "The node that couldn't be expanded.")) 16 | (:report 17 | (lambda (condition stream) 18 | (format stream "No expand-macro method for node with name ~S." 19 | (common-doc.macro:name (node condition))))) 20 | (:documentation "Signaled when a macro node has no @c(expand-macro) method.")) 21 | -------------------------------------------------------------------------------- /src/file.lisp: -------------------------------------------------------------------------------- 1 | (in-package :common-doc.file) 2 | 3 | (defvar *base-directory* *default-pathname-defaults* 4 | "The directory all resources with relative paths are based from. This is 5 | intended to be bound by a @c(let) by specific input formats.") 6 | 7 | (defun absolute-path (pathname-or-string) 8 | "Take a pathname or namestring. If it's absolute, return it, otherwise, merge 9 | it with @c(*base-directory*)." 10 | (if (stringp pathname-or-string) 11 | (absolute-path (parse-namestring pathname-or-string)) 12 | (if (uiop:absolute-pathname-p pathname-or-string) 13 | pathname-or-string 14 | (merge-pathnames pathname-or-string *base-directory*)))) 15 | 16 | (defun relativize-pathname (pathname) 17 | "If a pathname is inside @c(*base-directory*), return a relative 18 | pathname. Otherwise, return the pathname unchanged." 19 | (if *base-directory* 20 | (let ((subpath (uiop:subpathp pathname *base-directory*))) 21 | (or subpath pathname)) 22 | pathname)) 23 | -------------------------------------------------------------------------------- /src/format.lisp: -------------------------------------------------------------------------------- 1 | (in-package :common-doc.format) 2 | 3 | (defclass document-format () 4 | () 5 | (:documentation "A data format that can be parsed into a CommonDoc document, 6 | or that a document can be formatted to.")) 7 | 8 | (defgeneric parse-document (document-format input) 9 | (:documentation "Parse an input into a CommonDoc document.")) 10 | 11 | (defgeneric emit-document (document-format document stream) 12 | (:documentation "Dump a CommonDoc document into a stream.")) 13 | 14 | (defmethod emit-to-string ((format document-format) (document document)) 15 | (with-output-to-string (stream) 16 | (emit-document format document stream))) 17 | 18 | (defmethod emit-to-string ((format document-format) (node document-node)) 19 | (with-output-to-string (stream) 20 | (emit-document format node stream))) 21 | -------------------------------------------------------------------------------- /src/macros.lisp: -------------------------------------------------------------------------------- 1 | (in-package :common-doc.macro) 2 | 3 | (defclass macro-node (content-node) 4 | ((name :accessor name 5 | :initarg :name 6 | :type string 7 | :documentation "The name of the macro.")) 8 | (:documentation "A macro to be expanded.")) 9 | 10 | (defgeneric expand-macro (node) 11 | (:documentation "Replace a macro node with a primitive node.")) 12 | 13 | (defmethod expand-macro ((node document-node)) 14 | "The default macroexpansion: Do nothing." 15 | node) 16 | 17 | (defmethod expand-macro ((macro macro-node)) 18 | (error 'common-doc.error:no-macro-expander :node macro)) 19 | 20 | (defgeneric expand-macros (node) 21 | (:documentation "Recursively expand all macros in `node`.")) 22 | 23 | (defmethod expand-macros ((node document-node)) 24 | "The default macroexpansion." 25 | node) 26 | 27 | (defun %expand-macros (node) 28 | (let ((current-node (expand-macro node))) 29 | (assert (typep current-node '(or document-node document))) 30 | (if (and (slot-exists-p current-node 'children) 31 | (children current-node)) 32 | (progn 33 | (setf (children current-node) 34 | (loop for child in (children current-node) collecting 35 | (expand-macros child))) 36 | current-node) 37 | (if (subtypep (type-of current-node) 'macro-node) 38 | (expand-macros current-node) 39 | current-node)))) 40 | 41 | (defmethod expand-macros ((node base-list)) 42 | "Expand the macros in a base list." 43 | (%expand-macros node)) 44 | 45 | (defmethod expand-macros ((node definition)) 46 | "Expand the macros in a definition." 47 | (setf (term node) 48 | (loop for child in (term node) collecting 49 | (expand-macros child))) 50 | (setf (definition node) 51 | (loop for child in (definition node) collecting 52 | (expand-macros child))) 53 | node) 54 | 55 | (defmethod expand-macros ((node content-node)) 56 | "Expand the macros in a node with children." 57 | (%expand-macros node)) 58 | 59 | (defmethod expand-macros ((doc document)) 60 | "Expand the macros in a document." 61 | (setf (children doc) 62 | (loop for child in (children doc) collecting 63 | (expand-macros child))) 64 | doc) 65 | 66 | ;;; Define metadata macros 67 | 68 | (defvar *meta-macros* (make-hash-table :test #'equal) 69 | "A hash table of metadata macros to their definition.") 70 | 71 | (define-node define-meta-macro (macro-node) 72 | ((name :reader meta-macro-name 73 | :initarg :name 74 | :type string 75 | :attribute-name "name" 76 | :documentation "The macro's name.")) 77 | (:tag-name "defmetamacro") 78 | (:documentation "A metadata macro.")) 79 | 80 | (defmethod expand-macro ((node define-meta-macro)) 81 | "Define the metadata macro, and return an empty text node." 82 | (setf (gethash (meta-macro-name node) *meta-macros*) 83 | (common-doc.ops:collect-all-text (children node))) 84 | (common-doc:make-text "")) 85 | -------------------------------------------------------------------------------- /src/metadata.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Metadata interface 2 | (in-package :common-doc) 3 | 4 | (defun make-meta (pairs) 5 | "Create a metadata table from a list of pairs. If the list is empty, return an 6 | empty metadata table." 7 | (let ((table (make-hash-table :test #'equal))) 8 | (loop for pair in pairs do 9 | (setf (gethash (first pair) table) (rest pair))) 10 | table)) 11 | 12 | (defun get-meta (node key) 13 | "Find the value corresponding to @cl:param(key) in the node's metadata. If not 14 | found, return @c(NIL)." 15 | (when (metadata node) 16 | (gethash key (metadata node)))) 17 | 18 | (defun (setf get-meta) (value node key) 19 | (if (metadata node) 20 | (setf (gethash key (metadata node)) value) 21 | (progn 22 | (setf (metadata node) 23 | (make-hash-table :test #'equal)) 24 | (setf (get-meta node key) value)))) 25 | 26 | (defmacro do-meta ((key value node) &body body) 27 | "Iterate over the keys and values of a node's metadata." 28 | (let ((meta (gensym))) 29 | `(let ((,meta (metadata ,node))) 30 | (loop for ,key being the hash-keys of ,meta 31 | for ,value being the hash-values of ,meta 32 | do (progn ,@body))))) 33 | -------------------------------------------------------------------------------- /src/operations/equality.lisp: -------------------------------------------------------------------------------- 1 | (in-package :common-doc.ops) 2 | 3 | (defun hash-table-key-equal (table-a table-b) 4 | "Check whether two hash tables have the same keys." 5 | (equal (alexandria:hash-table-keys table-a) 6 | (alexandria:hash-table-keys table-b))) 7 | 8 | (defun hash-table-equal (table-a table-b) 9 | "Check whether two hash tables are equal." 10 | (and (hash-table-key-equal table-a table-b) 11 | (every #'identity 12 | (loop for key in (alexandria:hash-table-keys table-a) collecting 13 | (equal (gethash key table-a) 14 | (gethash key table-b)))))) 15 | 16 | (defgeneric node-equal (node-a node-b) 17 | (:documentation "Recursively check whether two nodes are equal.")) 18 | 19 | (defun node-list-equal (list-a list-b) 20 | (every #'identity 21 | (loop for node-a in list-a 22 | for node-b in list-b 23 | collecting 24 | (node-equal node-a node-b)))) 25 | 26 | (defmethod node-children-equal ((node-a document-node) 27 | (node-b document-node)) 28 | "Recursively check for equality in the children of a node." 29 | (if (subtypep (class-of node-a) 'content-node) 30 | ;; If they have children, recursively check them 31 | (node-list-equal (children node-a) (children node-b)) 32 | t)) 33 | 34 | (defmethod node-metadata-equal ((node-a document-node) 35 | (node-b document-node)) 36 | "Check whether two nodes have the same metadata." 37 | (let ((metadata-a (metadata node-a)) 38 | (metadata-b (metadata node-b))) 39 | ;; If the nodes are the same, we verify the metadata match. Either both 40 | ;; metadata are null, or they are equal hash tables. 41 | (if (and (null metadata-a) 42 | (null metadata-b)) 43 | t 44 | (if (or (null metadata-a) 45 | (null metadata-b)) 46 | nil 47 | (hash-table-equal metadata-a metadata-b))))) 48 | 49 | (defgeneric node-specific-equal (node-a node-b) 50 | (:documentation "Use this method to make node equality more specific.")) 51 | 52 | (defmethod node-specific-equal ((node-a document-node) 53 | (node-b document-node)) 54 | "By default, return true." 55 | t) 56 | 57 | (defmethod node-equal ((node-a document-node) 58 | (node-b document-node)) 59 | 60 | (and 61 | ;; First, the obvious: We verify they are both the same kind of node 62 | (equal (class-of node-a) 63 | (class-of node-b)) 64 | ;; Now, we use other methods 65 | (node-metadata-equal node-a node-b) 66 | (node-children-equal node-a node-b) 67 | ;; And, finally 68 | (node-specific-equal node-a node-b))) 69 | 70 | ;; Specific equality to different methods 71 | 72 | (defmethod node-specific-equal ((text-a text-node) 73 | (text-b text-node)) 74 | (equal (text text-a) (text text-b))) 75 | 76 | (defmethod node-specific-equal ((code-a code-block) 77 | (code-b code-block)) 78 | (equal (language code-a) (language code-b))) 79 | 80 | (defmethod node-specific-equal ((link-a document-link) 81 | (link-b document-link)) 82 | (and 83 | (equal (document-reference link-a) (document-reference link-b)) 84 | (equal (node-reference link-a) (node-reference link-b)))) 85 | 86 | (defmethod node-specific-equal ((link-a web-link) 87 | (link-b web-link)) 88 | (quri:uri= (uri link-a) (uri link-b))) 89 | 90 | (defmethod node-specific-equal ((definition-a definition) 91 | (definition-b definition)) 92 | (and (node-list-equal (term definition-a) 93 | (term definition-b)) 94 | (node-list-equal (definition definition-a) 95 | (definition definition-b)))) 96 | 97 | (defmethod node-specific-equal ((image-a image) 98 | (image-b image)) 99 | (and (equal (source image-a) (source image-b)) 100 | (equal (description image-a) (description image-b)))) 101 | 102 | (defmethod node-specific-equal ((figure-a figure) 103 | (figure-b figure)) 104 | (and (node-equal (image figure-a) 105 | (image figure-b)) 106 | (node-list-equal (description figure-a) 107 | (description figure-b)))) 108 | 109 | (defmethod node-specific-equal ((section-a section) 110 | (section-b section)) 111 | (and (node-list-equal (title section-a) 112 | (title section-b)) 113 | (equal (reference section-a) 114 | (reference section-b)))) 115 | -------------------------------------------------------------------------------- /src/operations/figures.lisp: -------------------------------------------------------------------------------- 1 | (in-package :common-doc.ops) 2 | 3 | (defun collect-figures (doc-or-node) 4 | "Return a list of figures in the document." 5 | (let ((figures (list))) 6 | (with-document-traversal (doc-or-node node) 7 | (when (typep node 'figure) 8 | (push node figures))) 9 | (reverse figures))) 10 | 11 | (defun collect-images (doc-or-node) 12 | "Return a list of images in the document." 13 | (let ((images (list))) 14 | (with-document-traversal (doc-or-node node) 15 | (when (typep node 'image) 16 | (push node images)) 17 | (when (typep node 'figure) 18 | (push (image node) images))) 19 | (reverse images))) 20 | -------------------------------------------------------------------------------- /src/operations/links.lisp: -------------------------------------------------------------------------------- 1 | (in-package :common-doc.ops) 2 | 3 | (defun collect-external-links (doc-or-node) 4 | "Return a list of external links in the document." 5 | (let ((links (list))) 6 | (with-document-traversal (doc-or-node node) 7 | (when (typep node 'web-link) 8 | (push node links))) 9 | (reverse links))) 10 | -------------------------------------------------------------------------------- /src/operations/tables.lisp: -------------------------------------------------------------------------------- 1 | (in-package :common-doc.ops) 2 | 3 | (defun collect-tables (doc-or-node) 4 | "Return a list of tables in the document." 5 | (let ((tables (list))) 6 | (with-document-traversal (doc-or-node node) 7 | (when (typep node 'table) 8 | (push node tables))) 9 | (reverse tables))) 10 | -------------------------------------------------------------------------------- /src/operations/text.lisp: -------------------------------------------------------------------------------- 1 | (in-package :common-doc.ops) 2 | 3 | (defgeneric node-text (node) 4 | (:documentation "Extract a string with all the text inside a node.")) 5 | 6 | (defmethod node-text ((node content-node)) 7 | "Extract text from a content node." 8 | (node-text (children node))) 9 | 10 | (defmethod node-text ((node base-list)) 11 | "Extract text from a content node." 12 | (node-text (children node))) 13 | 14 | (defmethod node-text ((list list)) 15 | "Extract text from a list of nodes." 16 | (let ((list-of-strings (loop for elem in list collecting 17 | (node-text elem)))) 18 | (reduce #'(lambda (a b) 19 | (concatenate 'string a " " b)) 20 | (or list-of-strings (list ""))))) 21 | 22 | (defmethod node-text ((text text-node)) 23 | "Extract text from a text node." 24 | (text text)) 25 | 26 | (defmethod node-text ((def definition)) 27 | "Extract text from a definition." 28 | (concatenate 'string 29 | (node-text (term def)) 30 | " " 31 | (node-text (definition def)))) 32 | 33 | (defmethod node-text ((image image)) 34 | "Extract the description from an image." 35 | (description image)) 36 | 37 | (defmethod node-text ((fig figure)) 38 | "Extract the description from a figure." 39 | (concatenate 'string 40 | (node-text (image fig)) 41 | " " 42 | (node-text (description fig)))) 43 | 44 | (defmethod node-text ((row row)) 45 | "Extract text from a row of cells." 46 | (node-text (cells row))) 47 | 48 | (defmethod node-text ((table table)) 49 | "Extract text from a table." 50 | (node-text (rows table))) 51 | 52 | (defmethod node-text ((section section)) 53 | "Extract text from a section." 54 | (concatenate 'string 55 | (node-text (title section)) 56 | " " 57 | (node-text (children section)))) 58 | 59 | (defmethod node-text ((doc document)) 60 | "Extract text from a document." 61 | (node-text (children doc))) 62 | 63 | (defun collect-all-text (doc-or-node) 64 | "Return all the text from a node or document." 65 | (node-text doc-or-node)) 66 | -------------------------------------------------------------------------------- /src/operations/toc.lisp: -------------------------------------------------------------------------------- 1 | (in-package :common-doc.ops) 2 | 3 | (defgeneric toc-traverse (node) 4 | (:documentation "A function that traverses a document tree looking for section 5 | nodes.") 6 | (:method ((doc document)) 7 | (toc-traverse (children doc))) 8 | (:method ((node content-node)) 9 | (toc-traverse (children node))) 10 | (:method ((sec section)) 11 | (list :sec sec 12 | :children (toc-traverse (children sec)))) 13 | (:method ((list list)) 14 | (remove-if #'null 15 | (loop for elem in list collecting 16 | (toc-traverse elem)))) 17 | (:method ((obj t)) 18 | nil)) 19 | 20 | (defun un-nest (node) 21 | "Remove unnecessary nesting, ie: (((A))) => (A)." 22 | (cond 23 | ((null node) 24 | node) 25 | ((listp node) 26 | (if (eql (length node) 1) 27 | (un-nest (first node)) 28 | (loop for child in node collecting 29 | (un-nest child)))) 30 | (t 31 | node))) 32 | 33 | (defun filter-depth (node max-depth) 34 | "Remove all nodes deeper than max-depth." 35 | (labels ((traverse (node depth) 36 | (if (listp node) 37 | (if (eq (first node) :sec) 38 | (if (>= depth max-depth) 39 | (append 40 | (alexandria:remove-from-plist node :children) 41 | (list :children nil)) 42 | node) 43 | (loop for child in node collecting 44 | (traverse child (1+ depth)))) 45 | node))) 46 | (traverse node 1))) 47 | 48 | (defun extract (node) 49 | (if (listp node) 50 | (if (eq (first node) :sec) 51 | (let ((sec (getf node :sec))) 52 | (make-instance 'content-node 53 | :children 54 | (append 55 | (list (make-instance 'document-link 56 | :node-reference (reference sec) 57 | :children (title sec))) 58 | (let ((children (extract (getf node :children)))) 59 | (if children 60 | (let ((children (if (listp children) 61 | children 62 | (list children)))) 63 | (list 64 | (make-instance 'ordered-list 65 | :children 66 | (loop for child in children collecting 67 | (make-instance 'list-item 68 | :children (list child))))))))))) 69 | (loop for child in node collecting 70 | (extract child))) 71 | node)) 72 | 73 | (defun table-of-contents (doc-or-node &key max-depth) 74 | "Extract a tree of document links representing the table of contents of a 75 | document. All the sections in the document must have references, so you should 76 | call fill-unique-refs first." 77 | (let* ((list (un-nest (toc-traverse doc-or-node))) 78 | (toc (extract (if max-depth 79 | (filter-depth list max-depth) 80 | list)))) 81 | (make-instance 'ordered-list 82 | :metadata (make-meta (list (cons "html:class" "toc"))) 83 | :children (loop for child in (if (listp toc) 84 | toc 85 | (children toc)) 86 | collecting 87 | (make-instance 'list-item 88 | :children (list child)))))) 89 | -------------------------------------------------------------------------------- /src/operations/traverse.lisp: -------------------------------------------------------------------------------- 1 | (in-package :common-doc.ops) 2 | 3 | (defgeneric traverse-document (node function &optional depth) 4 | (:documentation "Apply a side-effectful function recursively to every element 5 | in the document. Depth-first. Doesn't apply the function to the document 6 | itself.") 7 | 8 | (:method ((doc document) function &optional (depth 0)) 9 | (loop for child in (children doc) do 10 | (traverse-document child function (1+ depth)))) 11 | 12 | (:method ((cnode content-node) function &optional (depth 0)) 13 | (funcall function cnode depth) 14 | (loop for child in (children cnode) do 15 | (traverse-document child function (1+ depth)))) 16 | 17 | (:method ((node base-list) function &optional (depth 0)) 18 | ;; BASE-LIST itself does not define CHILDREN slot, 19 | ;; but all it's ancestors do. 20 | ;; We need this method to let you to traverse 21 | ;; a list of any type. 22 | (funcall function node depth) 23 | (loop for child in (children node) do 24 | (traverse-document child function (1+ depth)))) 25 | 26 | (:method ((dnode document-node) function &optional (depth 0)) 27 | (funcall function dnode depth))) 28 | 29 | (defmacro with-document-traversal ((doc node &optional (depth 'depth)) &body body) 30 | "Execute @cl:param(body) in each @cl:param(node) of the document." 31 | `(traverse-document ,doc 32 | #'(lambda (,node ,depth) 33 | ,(if (eql depth 'depth) 34 | `(declare (ignore depth))) 35 | ,@body))) 36 | -------------------------------------------------------------------------------- /src/operations/unique-ref.lisp: -------------------------------------------------------------------------------- 1 | (in-package :common-doc.ops) 2 | 3 | (defun fill-unique-refs (doc-or-node) 4 | "Recur through a document, giving unique reference IDs to each section." 5 | (let ((taken (make-hash-table :test #'equal))) 6 | ;; `taken` is a hash table of node references to booleans 7 | (with-document-traversal (doc-or-node node) 8 | ;; Go through every node, noting the reference ID's that are taken 9 | (when (reference node) 10 | (setf (gethash (reference node) taken) t))) 11 | (let ((table (make-hash-table :test #'eql)) 12 | (current-pos 0)) 13 | ;; `table` is a hash table that maps the position of a section (0 for 14 | ;; first, 1 for second, etc.) to a unique section ID. 15 | (labels ((ref-in-table-p (ref) 16 | ;; Determine if `ref` is in the table 17 | (member ref 18 | (alexandria:hash-table-values table) 19 | :test #'equal)) 20 | (takenp (ref) 21 | ;; Determine if the reference is taken 22 | (or (ref-in-table-p ref) 23 | (gethash ref taken))) 24 | (generate-unique-ref (section) 25 | ;; Generate a unique ref for a section 26 | (let* ((title (common-doc.ops:collect-all-text (title section))) 27 | (slug (common-doc.util:string-to-slug title))) 28 | (loop while (takenp slug) do 29 | (setf slug 30 | (concatenate 'string 31 | (write-to-string current-pos) 32 | "-" 33 | slug)) 34 | (incf current-pos)) 35 | (setf (gethash slug taken) t) 36 | slug)) 37 | (add-section-reference (section) 38 | (let ((ref (generate-unique-ref section))) 39 | ;; Add it to the table 40 | (setf (gethash current-pos table) ref) 41 | ;; Set the section's reference to the ref 42 | (setf (reference section) ref)))) 43 | (with-document-traversal (doc-or-node node) 44 | (when (and (typep node 'section) 45 | (null (reference node))) 46 | (add-section-reference node))) 47 | doc-or-node)))) 48 | -------------------------------------------------------------------------------- /src/packages.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage common-doc 3 | (:use :cl :trivial-types :anaphora) 4 | ;; Classes 5 | (:export :document-node 6 | :content-node 7 | :text-node 8 | :paragraph 9 | :markup 10 | :bold 11 | :italic 12 | :underline 13 | :strikethrough 14 | :code 15 | :superscript 16 | :subscript 17 | :code-block 18 | :base-quote 19 | :inline-quote 20 | :block-quote 21 | :link 22 | :document-link 23 | :web-link 24 | :base-list 25 | :list-item 26 | :definition 27 | :unordered-list 28 | :ordered-list 29 | :definition-list 30 | :image 31 | :figure 32 | :table 33 | :row 34 | :cell 35 | :section 36 | :document) 37 | ;; Accessors 38 | (:export :metadata 39 | :children 40 | :text 41 | :language 42 | :document-reference 43 | :node-reference 44 | :uri 45 | :term 46 | :definition 47 | :source 48 | :description 49 | :image 50 | :rows 51 | :header 52 | :footer 53 | :cells 54 | :title 55 | :reference 56 | :title 57 | :creator 58 | :publisher 59 | :subject 60 | :description 61 | :keywords 62 | :rights 63 | :version 64 | :created-on) 65 | ;; Constructors 66 | (:export :make-content 67 | :make-text 68 | :make-paragraph 69 | :make-bold 70 | :make-italic 71 | :make-underline 72 | :make-strikethrough 73 | :make-code 74 | :make-superscript 75 | :make-subscript 76 | :make-code-block 77 | :make-inline-quote 78 | :make-block-quote 79 | :make-document-link 80 | :make-web-link 81 | :make-list-item 82 | :make-definition 83 | :make-unordered-list 84 | :make-ordered-list 85 | :make-definition-list 86 | :make-image 87 | :make-figure 88 | :make-table 89 | :make-row 90 | :make-cell 91 | :make-section 92 | :make-document) 93 | ;; Metadata 94 | (:export :make-meta 95 | :get-meta 96 | :do-meta) 97 | ;; Node definition 98 | (:export :define-node 99 | :find-node 100 | :find-tag 101 | :find-special-slots) 102 | ;; Printing 103 | (:export :dump 104 | :dump-to-string) 105 | (:documentation "CommonDoc classes and and accessors.")) 106 | 107 | (defpackage common-doc.error 108 | (:use :cl) 109 | (:export :common-doc-error 110 | :macro-error 111 | :no-macro-expander 112 | :node) 113 | (:documentation "CommonDoc errors.")) 114 | 115 | (defpackage common-doc.file 116 | (:use :cl) 117 | (:export :*base-directory* 118 | :absolute-path 119 | :relativize-pathname) 120 | (:documentation "File-related operations for CommonDoc.")) 121 | 122 | (defpackage common-doc.format 123 | (:use :cl :common-doc) 124 | (:export :document-format 125 | :parse-document 126 | :emit-document 127 | :emit-to-string) 128 | (:documentation "CommonDoc input/output formats.")) 129 | 130 | (defpackage common-doc.macro 131 | (:use :cl) 132 | (:import-from :common-doc 133 | :content-node 134 | :document-node 135 | :base-list 136 | :definition 137 | :term 138 | :document 139 | :children 140 | :define-node) 141 | (:export :macro-node 142 | :name 143 | :expand-macro 144 | :expand-macros 145 | :define-meta-macro) 146 | (:documentation "CommonDoc macros.")) 147 | 148 | (defpackage common-doc.util 149 | (:use :cl :common-doc) 150 | (:export :string-to-slug) 151 | (:documentation "CommonDoc utilities.")) 152 | 153 | (defpackage common-doc.ops 154 | (:use :cl :common-doc) 155 | (:export :traverse-document 156 | :with-document-traversal 157 | :collect-figures 158 | :collect-images 159 | :collect-tables 160 | :collect-external-links 161 | :collect-all-text 162 | :fill-unique-refs 163 | :table-of-contents 164 | :node-equal 165 | :node-specific-equal) 166 | (:documentation "Common operations on CommonDoc documents.")) 167 | -------------------------------------------------------------------------------- /src/print.lisp: -------------------------------------------------------------------------------- 1 | ;;;; In this file we keep the print-object methods for all the classes, which 2 | ;;;; help specially in debugging 3 | (in-package :common-doc) 4 | 5 | (defmethod print-object ((node text-node) stream) 6 | "Print a text-node." 7 | (print-unreadable-object (node stream :type t) 8 | (let ((string (if (> (length (text node)) 33) 9 | (concatenate 'string 10 | (subseq (text node) 0 30) 11 | "...") 12 | (text node)))) 13 | (format stream "text: ~A" string)))) 14 | 15 | (defmethod print-object ((node content-node) stream) 16 | "Print an arbitrary content-node." 17 | (print-unreadable-object (node stream :type t) 18 | (format stream "children: ~{~A~#[~:;, ~]~}" 19 | (loop for child in (children node) collecting 20 | (type-of child))))) 21 | 22 | (defmethod print-object ((node document-link) stream) 23 | "Print a text-node." 24 | (print-unreadable-object (node stream :type t) 25 | (format stream "document: ~A, section: ~A" 26 | (document-reference node) 27 | (node-reference node)))) 28 | 29 | (defmethod print-object ((node base-list) stream) 30 | "Print a list." 31 | (print-unreadable-object (node stream :type t) 32 | (format stream "~A items" (length (children node))))) 33 | 34 | (defmethod print-object ((node section) stream) 35 | "Print a section." 36 | (print-unreadable-object (node stream :type t) 37 | (let ((title (common-doc.ops:collect-all-text (title node))) 38 | (ref (reference node))) 39 | (format stream "title: ~A, ref: ~A" title ref)))) 40 | 41 | (defmethod print-object ((doc document) stream) 42 | "Print a document." 43 | (print-unreadable-object (doc stream :type t) 44 | (format stream "~S" (title doc)))) 45 | 46 | ;;; Dumping documents 47 | 48 | (defun dump (node &optional (stream *standard-output*)) 49 | "Write the tree structure of the document tree to a stream." 50 | (labels (;; Utilities 51 | (write-depth (depth) 52 | (let ((string (make-string depth 53 | :initial-element #\Space))) 54 | (write-string string stream))) 55 | (node-name (node) 56 | (string-downcase (symbol-name (class-name (class-of node))))) 57 | (write-metadata (meta) 58 | (write-char #\Space stream) 59 | (write-char #\[ stream) 60 | (loop for key being the hash-keys of meta 61 | for value being the hash-values of meta do 62 | (format stream "~A=~A" key value)) 63 | (write-char #\] stream)) 64 | ;; Actual printing 65 | (print-node (node depth) 66 | (write-depth depth) 67 | (write-string (node-name node) stream) 68 | (unless (typep node 'document) 69 | (awhen (metadata node) 70 | (write-metadata it))) 71 | (write-char #\Newline stream) 72 | (cond 73 | ((typep node 'text-node) 74 | (write-depth (+ 2 depth)) 75 | (format stream "~S~%" (text node))) 76 | ((and (not (or (typep node 'image) 77 | (typep node 'definition) 78 | (typep node 'table))) 79 | (slot-boundp node 'children)) 80 | (loop for child in (children node) do 81 | (print-node child (+ 2 depth))))))) 82 | (print-node node 0))) 83 | 84 | (defun dump-to-string (node) 85 | "Write the tree structure of the document tree to a string." 86 | (with-output-to-string (stream) 87 | (dump node stream))) 88 | -------------------------------------------------------------------------------- /src/util.lisp: -------------------------------------------------------------------------------- 1 | (in-package :common-doc.util) 2 | 3 | (defun string-to-slug (string) 4 | "Take a string, usually the name of a section, and create something that is 5 | more similar to an identifier, i.e. no spaces, same case, etc." 6 | (let* ((no-space (substitute #\- #\Space string)) 7 | (no-slashes (substitute #\- #\/ no-space)) 8 | (no-colons (substitute #\- #\: no-slashes))) 9 | (string-downcase no-colons))) 10 | -------------------------------------------------------------------------------- /t/common-doc.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage common-doc-test 3 | (:use :cl :fiveam :common-doc) 4 | (:export :basic-tests)) 5 | (in-package :common-doc-test) 6 | 7 | (def-suite basic-tests 8 | :description "common-doc tests.") 9 | (in-suite basic-tests) 10 | 11 | (test constructors 12 | (is-true 13 | (typep (make-code nil) 'code)) 14 | (is-true 15 | (typep (make-strikethrough nil) 'strikethrough)) 16 | (is-true 17 | (typep (make-superscript nil) 'superscript)) 18 | (is-true 19 | (typep (make-subscript nil) 'subscript)) 20 | (let ((node (make-code-block "lisp" nil))) 21 | (typep node 'code-block) 22 | (is (equal (language node) "lisp"))) 23 | (is-true 24 | (typep (make-inline-quote nil) 'inline-quote)) 25 | (is-true 26 | (typep (make-block-quote nil) 'block-quote)) 27 | (is-true 28 | (typep (make-document-link "doc" "sec" nil) 29 | 'document-link)) 30 | (is-true 31 | (typep (make-web-link "http://www.example.com" nil) 32 | 'web-link)) 33 | (is-true 34 | (typep (make-list-item nil) 'list-item)) 35 | (is-true 36 | (typep (make-unordered-list nil) 'unordered-list)) 37 | (is-true 38 | (typep (make-ordered-list nil) 'ordered-list)) 39 | (let ((def (make-definition nil nil))) 40 | (is-true 41 | (typep def 'definition)) 42 | (is-true (make-definition-list (list def)) 43 | 'definition-list))) 44 | 45 | (test metadata 46 | (let ((node (make-text "text" :metadata (make-meta (list (cons "a" 1)))))) 47 | (is 48 | (equal (get-meta node "a") 49 | 1))) 50 | (let ((node (make-text "text" :metadata (make-meta (list (cons "a" 1) 51 | (cons "b" 2)))))) 52 | (do-meta (key value node) 53 | (when (string= key "a") 54 | (is (equal value 1))) 55 | (when (string= key "b") 56 | (is (equal value 2)))))) 57 | 58 | (test web-link-metadata 59 | ;; URI should be present not only as a slot, but also as 60 | ;; an item in metadata hash-table, because Scriba's 61 | ;; emitter takes attribute values from the metadata dictionary. 62 | (let ((link (make-web-link "http://www.example.com" nil))) 63 | (is (string= (get-meta link "uri") 64 | "http://www.example.com")))) 65 | 66 | 67 | (test document-link-metadata 68 | ;; For DOCUMENT-LINK we also have to save should be present not only as a slot, but also as 69 | ;; an item in metadata hash-table, because Scriba's 70 | ;; emitter takes attribute values from the metadata dictionary. 71 | (let ((link (make-document-link "document-id" "reference-id" nil))) 72 | (is (string= (get-meta link "doc") 73 | "document-id")) 74 | (is (string= (get-meta link "id") 75 | "reference-id")))) 76 | 77 | (test nodes 78 | (is 79 | (eql (find-node "b") 80 | (find-class 'bold))) 81 | (is 82 | (equal (find-tag (find-class 'bold)) 83 | "b")) 84 | (is 85 | (equal (find-special-slots (find-class 'code-block)) 86 | (list (cons "lang" 'language) 87 | (cons "ref" 'reference))))) 88 | 89 | (test simple-doc 90 | (let ((document (make-document 91 | "My Document" 92 | :creator "me" 93 | :keywords (list "test" "test1") 94 | :children 95 | (list 96 | (make-paragraph 97 | (list 98 | (make-text "test"))))))) 99 | (is 100 | (equal (keywords document) 101 | (list "test" "test1"))))) 102 | 103 | (test file 104 | (let ((common-doc.file:*base-directory* (user-homedir-pathname))) 105 | (is 106 | (equal 107 | (common-doc.file:absolute-path #p"file.txt") 108 | (merge-pathnames #p"file.txt" 109 | (user-homedir-pathname)))) 110 | (is 111 | (equal 112 | (common-doc.file:absolute-path "file.txt") 113 | (merge-pathnames #p"file.txt" 114 | (user-homedir-pathname)))) 115 | (is 116 | (equal 117 | (common-doc.file:relativize-pathname 118 | (merge-pathnames #p"file.txt" 119 | (user-homedir-pathname))) 120 | #p"file.txt")))) 121 | 122 | (define-node custom-macro (common-doc.macro:macro-node) 123 | ()) 124 | 125 | (defmethod common-doc.macro:expand-macro ((node custom-macro)) 126 | (make-text "test")) 127 | 128 | (test macros 129 | (is 130 | (typep (common-doc.macro:expand-macros (make-paragraph nil)) 131 | 'paragraph)) 132 | (is 133 | (typep (common-doc.macro:expand-macros (make-document "title")) 134 | 'document)) 135 | (signals common-doc.error:no-macro-expander 136 | (common-doc.macro:expand-macros (make-instance 'common-doc.macro:macro-node))) 137 | (let ((doc 138 | (make-document 139 | "test" 140 | :children 141 | (list 142 | (make-unordered-list 143 | (list 144 | (make-list-item (list (make-instance 'custom-macro))))) 145 | (make-definition-list 146 | (list 147 | (make-definition (list (make-text "term")) 148 | (list (make-instance 'custom-macro))))))))) 149 | (finishes 150 | (setf doc (common-doc.macro:expand-macros doc))))) 151 | 152 | (test print 153 | (is 154 | (equal (prin1-to-string (make-text "abc")) 155 | "#")) 156 | (is 157 | (equal (prin1-to-string (make-text "The quick brown fox jumps over the lazy dog")) 158 | "#")) 159 | (is 160 | (equal (prin1-to-string (make-paragraph 161 | (list (make-text "test") 162 | (make-text "abc")))) 163 | "#")) 164 | (finishes 165 | (print (make-document-link "doc" "sec" nil)) 166 | (print (make-unordered-list nil)) 167 | (print (make-section (list (make-text "title")))) 168 | (print (make-document "title"))) 169 | (is 170 | (equal (dump-to-string (make-text "test")) 171 | "text-node 172 | \"test\" 173 | ")) 174 | (is 175 | (equal (dump-to-string (make-paragraph 176 | (list (make-text "a") 177 | (make-text "b")))) 178 | "paragraph 179 | text-node 180 | \"a\" 181 | text-node 182 | \"b\" 183 | ")) 184 | (is 185 | (equal (dump-to-string (make-text "test" 186 | :metadata (make-meta 187 | (list 188 | (cons "a" 1))))) 189 | "text-node [a=1] 190 | \"test\" 191 | "))) 192 | 193 | ;;; Formats 194 | 195 | (defclass custom-format (common-doc.format:document-format) 196 | ()) 197 | 198 | (defmethod common-doc.format:parse-document ((document-format custom-format) 199 | input) 200 | (make-document "test document")) 201 | 202 | (defmethod common-doc.format:emit-document ((document-format custom-format) 203 | (node document-node) stream) 204 | (write-string "test node" stream)) 205 | 206 | (defmethod common-doc.format:emit-document ((document-format custom-format) 207 | (document document) stream) 208 | (write-string "test document" stream)) 209 | 210 | (test formats 211 | (let ((doc (common-doc.format:parse-document (make-instance 'custom-format) 212 | "test"))) 213 | (is 214 | (equal (title doc) 215 | "test document")) 216 | (is 217 | (equal (common-doc.format:emit-to-string (make-instance 'custom-format) 218 | doc) 219 | "test document")) 220 | (is 221 | (equal (common-doc.format:emit-to-string (make-instance 'custom-format) 222 | (make-text "test")) 223 | "test node")))) 224 | 225 | (define-node macro-a (common-doc.macro:macro-node) 226 | ()) 227 | 228 | (define-node macro-b (common-doc.macro:macro-node) 229 | ()) 230 | 231 | (defmethod common-doc.macro:expand-macro ((node macro-a)) 232 | (make-instance 'macro-b)) 233 | 234 | (defmethod common-doc.macro:expand-macro ((node macro-b)) 235 | (make-text "test")) 236 | 237 | (test recursive-macros 238 | (let ((doc 239 | (make-document 240 | "test" 241 | :children 242 | (list 243 | (make-instance 'macro-a))))) 244 | (finishes 245 | (setf doc (common-doc.macro:expand-macros doc))) 246 | (is 247 | (equal (length (children doc)) 248 | 1)) 249 | (let ((child (first (children doc)))) 250 | (is 251 | (typep child 'text-node)) 252 | (is 253 | (equal (text child) 254 | "test"))))) 255 | -------------------------------------------------------------------------------- /t/contrib/contrib.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage common-doc-test.contrib 3 | (:use :cl :fiveam :common-doc) 4 | (:export :contrib)) 5 | (in-package :common-doc-test.contrib) 6 | 7 | (def-suite contrib) 8 | (in-suite contrib) 9 | 10 | (test gnuplot 11 | (let ((common-doc.file:*base-directory* 12 | (asdf:system-relative-pathname :common-doc-test 13 | #p"t/contrib/")) 14 | (doc (make-content 15 | (list 16 | (make-instance 'common-doc.gnuplot:gnuplot 17 | :path "gnuplot.png" 18 | :children 19 | (list 20 | (make-text "plot sin(x)/x")))))) 21 | (image-path (asdf:system-relative-pathname :common-doc-test 22 | #p"t/contrib/gnuplot.png"))) 23 | (finishes 24 | (setf doc (common-doc.macro:expand-macros doc))) 25 | (is-true 26 | (probe-file image-path)) 27 | (delete-file image-path))) 28 | 29 | (test include 30 | (let ((common-doc.file:*base-directory* 31 | (asdf:system-relative-pathname :common-doc-test 32 | #p"t/contrib/")) 33 | (node 34 | (make-content 35 | (list 36 | (make-instance 'common-doc.include:include 37 | :path "contrib.lisp"))))) 38 | (finishes 39 | (setf node (common-doc.macro:expand-macros node))) 40 | (is 41 | (typep (first (children node)) 'text-node)) 42 | (is 43 | (equal (text (first (children node))) 44 | (uiop:read-file-string 45 | (asdf:system-relative-pathname :common-doc-test 46 | #p"t/contrib/contrib.lisp")))))) 47 | 48 | (test split-paragraphs 49 | (let ((node 50 | (make-content 51 | (list 52 | (make-text 53 | (format nil "Paragraph 1.~%~%Paragraph with ")) 54 | (make-bold 55 | (list (make-text "bold text"))) 56 | (make-text (format nil ".~%~%Paragraph 3.")))))) 57 | (finishes 58 | (common-doc.split-paragraphs:split-paragraphs node)) 59 | (is-true 60 | (typep node 'content-node)) 61 | (is 62 | (equal (length (children node)) 63 | 3)) 64 | (is 65 | (every #'(lambda (node) 66 | (typep node 'paragraph)) 67 | (children node))))) 68 | 69 | (test tex 70 | (let ((tex-inline (make-content 71 | (list 72 | (make-instance 'common-doc.tex:tex 73 | :children 74 | (list 75 | (make-text "1+x")))))) 76 | (tex-block (make-content 77 | (list 78 | (make-instance 'common-doc.tex:tex-block 79 | :children 80 | (list 81 | (make-text "\\int \\log x"))))))) 82 | (finishes 83 | (setf doc (common-doc.macro:expand-macros tex-inline))) 84 | (finishes 85 | (setf doc (common-doc.macro:expand-macros tex-block))) 86 | (is (equal (common-doc.ops:collect-all-text tex-inline) 87 | "$ 1+x $")) 88 | (is (equal (common-doc.ops:collect-all-text tex-block) 89 | "\\( \\int \\log x \\)")))) 90 | -------------------------------------------------------------------------------- /t/equality.lisp: -------------------------------------------------------------------------------- 1 | (in-package :common-doc-test.ops) 2 | 3 | (defun limit-list (list) 4 | (if (> (length list) 3) 5 | (subseq list 0 3) 6 | list)) 7 | 8 | (test node-equality 9 | (let* ((text (make-text "test")) 10 | (text-meta (make-text "test" 11 | :metadata (make-meta (list (cons "a" 1))))) 12 | (code-block (make-code-block "lisp" 13 | (list (make-text "test")))) 14 | (doc-link (make-document-link "doc" "sec" 15 | (list (make-text "test")))) 16 | (web-link (make-web-link "http://www.example.com" 17 | (list (make-text "test")))) 18 | (def (make-definition 19 | (list (make-text "test")) 20 | (list (make-text "test")))) 21 | (image (make-image "fig1.jpg")) 22 | (paragraph (make-paragraph 23 | (list (make-text "test")))) 24 | (section (make-section 25 | (list (make-text "Section 1")) 26 | :children 27 | (list 28 | (make-figure 29 | image 30 | (list paragraph)))))) 31 | (macrolet ((tests (&rest nodes) 32 | `(progn 33 | ,@(loop for node in nodes collecting 34 | `(is (node-equal ,node ,node))) 35 | ,@(loop for node in nodes collecting 36 | `(progn 37 | ,@(loop for other-node in (limit-list (set-difference nodes (list node))) 38 | collecting 39 | `(is (not (node-equal ,node ,other-node))))))))) 40 | (tests text text-meta code-block doc-link web-link def image paragraph section)))) 41 | -------------------------------------------------------------------------------- /t/final.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Run tests 2 | (in-package :common-doc-test) 3 | 4 | (run! 'basic-tests) 5 | (run! 'common-doc-test.ops:operations) 6 | (run! 'common-doc-test.contrib:contrib) 7 | 8 | -------------------------------------------------------------------------------- /t/operations.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage common-doc-test.ops 3 | (:use :cl :fiveam :common-doc) 4 | (:import-from :common-doc.ops 5 | :with-document-traversal 6 | :collect-figures 7 | :collect-images 8 | :collect-tables 9 | :collect-external-links 10 | :node-equal) 11 | (:export :operations)) 12 | (in-package :common-doc-test.ops) 13 | 14 | (def-suite operations 15 | :description "common-doc operations tests.") 16 | (in-suite operations) 17 | 18 | (test traverse 19 | (let ((document (make-document 20 | "test" 21 | :children 22 | (list 23 | (make-bold 24 | (list 25 | (make-italic 26 | (list 27 | (make-underline nil)))))))) 28 | (bold-depth) 29 | (italic-depth) 30 | (underline-depth)) 31 | (finishes 32 | (with-document-traversal (document node depth) 33 | (typecase node 34 | (bold 35 | (setf bold-depth depth)) 36 | (italic 37 | (setf italic-depth depth)) 38 | (underline 39 | (setf underline-depth depth))))) 40 | (is 41 | (equal bold-depth 1)) 42 | (is 43 | (equal italic-depth 2)) 44 | (is 45 | (equal underline-depth 3)))) 46 | 47 | (test figures 48 | (let ((document) 49 | (figs) 50 | (images)) 51 | (finishes 52 | (setf document 53 | (make-document 54 | "test" 55 | :children 56 | (list 57 | (make-section 58 | (list (make-text "Section 1")) 59 | :children 60 | (list 61 | (make-figure 62 | (make-image "fig1.jpg") 63 | (list 64 | (make-text "Fig 1"))))) 65 | (make-section 66 | (list (make-text "Section 2")) 67 | :children 68 | (list 69 | (make-figure 70 | (make-image "fig2.jpg") 71 | (list 72 | (make-text "Fig 2"))) 73 | (make-image "fig3.jpg"))))))) 74 | (finishes 75 | (setf figs (collect-figures document))) 76 | (finishes 77 | (setf images (collect-images document))) 78 | (let* ((first-fig (first figs)) 79 | (second-fig (second figs)) 80 | (first-img (image first-fig)) 81 | (second-img (image second-fig))) 82 | (is 83 | (equal (source first-img) "fig1.jpg")) 84 | (is 85 | (equal (source second-img) "fig2.jpg"))) 86 | (is 87 | (equal (source (first images)) "fig1.jpg")) 88 | (is 89 | (equal (source (second images)) "fig2.jpg")) 90 | (is 91 | (equal (source (third images)) "fig3.jpg")))) 92 | 93 | (test tables 94 | (let ((document 95 | (make-document 96 | "test" 97 | :children 98 | (list 99 | (make-table 100 | (list 101 | (make-row (list (make-cell nil))))) 102 | (make-table 103 | (list 104 | (make-row (list (make-cell nil)))))))) 105 | (tables)) 106 | (finishes 107 | (setf tables (collect-tables document))) 108 | (is 109 | (equal (length tables) 2)))) 110 | 111 | (test links 112 | (let ((document 113 | (make-document 114 | "test" 115 | :children 116 | (list 117 | (make-paragraph 118 | (list 119 | (make-web-link "http://example.com/" nil)))))) 120 | (links)) 121 | (finishes 122 | (setf links (collect-external-links document))) 123 | (is 124 | (equal (length links) 1)))) 125 | 126 | (test text 127 | (let ((document (make-document "test"))) 128 | (is (equal (common-doc.ops:collect-all-text document) 129 | ""))) 130 | (let ((document (make-document 131 | "test" 132 | :children 133 | (list 134 | (make-text "test"))))) 135 | (is (equal (common-doc.ops:collect-all-text document) 136 | "test"))) 137 | (let ((document (make-document 138 | "test" 139 | :children 140 | (list 141 | (make-definition 142 | (list (make-image "pic.jpg" :description "desc1")) 143 | (list (make-figure 144 | (make-image "pic.jpg" :description "desc2") 145 | (list (make-text "test"))))))))) 146 | (is (equal (common-doc.ops:collect-all-text document) 147 | "desc1 desc2 test"))) 148 | (let ((document (make-document 149 | "test" 150 | :children 151 | (list 152 | (make-table 153 | (list 154 | (make-row 155 | (list 156 | (make-cell (list (make-text "a"))) 157 | (make-cell (list (make-text "b"))) 158 | (make-cell (list (make-text "c"))))) 159 | (make-row 160 | (list 161 | (make-cell (list (make-text "1"))) 162 | (make-cell (list (make-text "2"))) 163 | (make-cell (list (make-text "3"))))))))))) 164 | (is (equal (common-doc.ops:collect-all-text document) 165 | "a b c 1 2 3"))) 166 | (let ((document (make-document 167 | "test" 168 | :children 169 | (list 170 | (make-section (list (make-text "sec1")) 171 | :children 172 | (list 173 | (make-text "test"))))))) 174 | (is (equal (common-doc.ops:collect-all-text document) 175 | "sec1 test")))) 176 | 177 | (test unique-ref 178 | (let ((doc (make-document 179 | "test" 180 | :children 181 | (list 182 | (make-section 183 | (list (make-text "Section 1")) 184 | :children (list 185 | (make-content 186 | (list 187 | (make-content 188 | (list 189 | (make-section (list (make-text "Section 1.1")) 190 | :reference "sec11"))))))) 191 | (make-section 192 | (list (make-text "Section 2"))) 193 | (make-section 194 | (list (make-text "Section 2"))))))) 195 | (finishes 196 | (common-doc.ops:fill-unique-refs doc)) 197 | (is 198 | (equal (reference (first (children doc))) 199 | "section-1")) 200 | (is 201 | (equal (reference (first (children 202 | (first (children 203 | (first (children 204 | (first (children doc))))))))) 205 | "sec11")) 206 | (is 207 | (equal (reference (second (children doc))) 208 | "section-2")))) 209 | 210 | (test toc 211 | (let* ((doc (make-document 212 | "test" 213 | :children 214 | (list 215 | (make-section 216 | (list (make-text "Section 1")) 217 | :reference "sec1" 218 | :children 219 | (list 220 | (make-content 221 | (list 222 | (make-content 223 | (list 224 | (make-section 225 | (list (make-text "Section 1.1")) 226 | :reference "sec11"))))))) 227 | (make-section 228 | (list (make-text "Section 2")) 229 | :reference "sec2" 230 | :children 231 | (list 232 | (make-text "sec2 contents")))))) 233 | (toc (common-doc.ops:table-of-contents doc))) 234 | (is-true (typep toc 'ordered-list)) 235 | (is 236 | (equal (length (children toc)) 237 | 2)) 238 | (let ((list-item (first (children toc)))) 239 | (is-true (typep list-item 'list-item))) 240 | (let ((list-item (second (children toc)))) 241 | (is-true (typep list-item 'list-item)) 242 | (let ((link (first (children list-item)))) 243 | (is 244 | (equal (common-doc.ops:collect-all-text link) 245 | "Section 2")))) 246 | (let ((toc (common-doc.ops:table-of-contents doc :max-depth 1))) 247 | (is-true (typep toc 'ordered-list)) 248 | (is 249 | (equal (length (children toc)) 250 | 2)) 251 | (let ((list-item (first (children toc)))) 252 | (is-true (typep list-item 'list-item))) 253 | (let ((list-item (second (children toc)))) 254 | (is-true (typep list-item 'list-item)) 255 | (let ((link (first (children list-item)))) 256 | (is 257 | (equal (common-doc.ops:collect-all-text link) 258 | "Section 2"))))))) 259 | --------------------------------------------------------------------------------