12 | {include resources/ug-navigation.md}
13 |
14 |
--------------------------------------------------------------------------------
/unit-tests/markdown-tests/Amps and angle encoding.text:
--------------------------------------------------------------------------------
1 | AT&T has an ampersand in their name.
2 |
3 | AT&T is another way to write it.
4 |
5 | This & that.
6 |
7 | 4 < 5.
8 |
9 | 6 > 5.
10 |
11 | Here's a [link] [1] with an ampersand in the URL.
12 |
13 | Here's a link with an amersand in the link text: [AT&T] [2].
14 |
15 | Here's an inline [link](/script?foo=1&bar=2).
16 |
17 | Here's an inline [link]().
18 |
19 |
20 | [1]: http://example.com/?foo=1&bar=2
21 | [2]: http://att.com/ "AT&T"
--------------------------------------------------------------------------------
/unit-tests/markdown-tests/Horizontal rules.text:
--------------------------------------------------------------------------------
1 | Dashes:
2 |
3 | ---
4 |
5 | ---
6 |
7 | ---
8 |
9 | ---
10 |
11 | ---
12 |
13 | - - -
14 |
15 | - - -
16 |
17 | - - -
18 |
19 | - - -
20 |
21 | - - -
22 |
23 |
24 | Asterisks:
25 |
26 | ***
27 |
28 | ***
29 |
30 | ***
31 |
32 | ***
33 |
34 | ***
35 |
36 | * * *
37 |
38 | * * *
39 |
40 | * * *
41 |
42 | * * *
43 |
44 | * * *
45 |
46 |
47 | Underscores:
48 |
49 | ___
50 |
51 | ___
52 |
53 | ___
54 |
55 | ___
56 |
57 | ___
58 |
59 | _ _ _
60 |
61 | _ _ _
62 |
63 | _ _ _
64 |
65 | _ _ _
66 |
67 | _ _ _
68 |
--------------------------------------------------------------------------------
/unit-tests/test-strippers.lisp:
--------------------------------------------------------------------------------
1 | (in-package #:cl-markdown-test)
2 |
3 | (deftestsuite test-strippers ()
4 | ())
5 |
6 | (deftestsuite test-one-tab-stripper (test-strippers)
7 | ()
8 | (:equality-test 'samep))
9 |
10 | (addtest
11 | test-spaces-1
12 | (ensure-same (one-tab-stripper " hello") (values "hello" t)))
13 |
14 | (addtest
15 | test-tabs-1
16 | (ensure-same (one-tab-stripper (concatenate 'string (string #\Tab) "hello"))
17 | (values "hello" t)))
18 |
19 | (addtest
20 | test-tabs-2
21 | (ensure-same (one-tab-stripper (concatenate 'string (string #\Tab) " hello"))
22 | (values " hello" t)))
23 |
24 | (addtest
25 | test-spaces-2
26 | (ensure-same (one-tab-stripper " hello") (values " hello" nil)))
--------------------------------------------------------------------------------
/resources/markdown-report-styles.css:
--------------------------------------------------------------------------------
1 | body {
2 | font-family: Georgia, "Times New Roman", Times, serif;
3 | margin-right: 0.5in;
4 | margin-left: 0.5in;
5 | margin-bottom: 0.25px;
6 | }
7 |
8 | .markdown-report {
9 | margin-left: 4em;
10 | }
11 |
12 | #main-content {
13 | float: left;
14 | width: 80%;
15 | margin-bottom: 2em;
16 | line-height: 1.4;
17 | font-size: 80%;
18 | }
19 |
20 | #footer {
21 | margin-top: 2em;
22 | margin-bottom: 2em;
23 | padding-top: 0.25em;
24 | border-top-style: inset;
25 | border-top-width: 3px;
26 | clear: both;
27 | width: 80%;
28 | }
29 |
30 | div.markdown-report h1,h2 {
31 | margin-left: -2em;
32 | clear: both;
33 | margin-bottom: 0.5em;
34 | }
35 |
36 | .markdown-report span {
37 | float: left;
38 | display: block;
39 | width: 2.5in;
40 | }
--------------------------------------------------------------------------------
/.boring:
--------------------------------------------------------------------------------
1 | # Boring file regexps:
2 | \.hi$
3 | \.o$
4 | \.o\.cmd$
5 | # *.ko files aren't boring by default because they might
6 | # be Korean translations rather than kernel modules.
7 | # \.ko$
8 | \.ko\.cmd$
9 | \.mod\.c$
10 | (^|/)\.tmp_versions($|/)
11 | (^|/)CVS($|/)
12 | (^|/)RCS($|/)
13 | ~$
14 | #(^|/)\.[^/]
15 | (^|/)_darcs($|/)
16 | \.bak$
17 | \.BAK$
18 | \.orig$
19 | (^|/)vssver\.scc$
20 | \.swp$
21 | (^|/)MT($|/)
22 | (^|/)\{arch\}($|/)
23 | (^|/).arch-ids($|/)
24 | (^|/),
25 | \.class$
26 | \.prof$
27 | (^|/)\.DS_Store$
28 | (^|/)BitKeeper($|/)
29 | (^|/)ChangeSet($|/)
30 | (^|/)\.svn($|/)
31 | \.py[co]$
32 | \#
33 | \.cvsignore$
34 | (^|/)Thumbs\.db$
35 | (^|/)autom4te\.cache($|/)
36 | (^|/)scratch($|/)
37 | (^|/)two words($|/)
38 | (^|/)test-results($|/)
39 | \.dribble
40 | (^|/)make($|/)
41 |
--------------------------------------------------------------------------------
/website/source/resources/header.md:
--------------------------------------------------------------------------------
1 | {include shared-links.md}
2 |
3 | {set-property html yes}
4 | {set-property style-sheet "http://common-lisp.net/project/cl-containers/shared/style.css"}
5 | {set-property author "Gary Warren King"}
6 |
7 | [devel-list]: http://common-lisp.net/cgi-bin/mailman/listinfo/cl-markdown-devel
8 | [cliki-home]: http://www.cliki.net/cl-markdown
9 | [tarball]: http://common-lisp.net/project/cl-markdown/cl-markdown.tar.gz
10 |
11 |
12 | 
13 |
14 | ## CL-Markdown
15 |
16 | #### Finally, text mucking fun the whole family can enjoy
17 |
18 |
19 |
--------------------------------------------------------------------------------
/unit-tests/test-anchors.lisp:
--------------------------------------------------------------------------------
1 | (in-package #:cl-markdown-test)
2 |
3 | (deftestsuite test-anchors (test-snippets)
4 | ()
5 | (:dynamic-variables
6 | (cl-markdown::*default-properties*
7 | '((:omit-initial-paragraph t)
8 | (:omit-final-paragraph t)))))
9 |
10 | (addtest (test-anchors)
11 | just-a-name
12 | (check-html-output
13 | "@(foo)"
14 | ""))
15 |
16 | (addtest (test-anchors)
17 | name-with-text
18 | (check-html-output
19 | "@[bar](foo)"
20 | "bar"))
21 |
22 | #|
23 | (markdown
24 | "
25 | hi
26 | @(foo)
27 | @[bar](foo)
28 | " :format :html)
29 |
30 | (markdown "hi @(foo)" :stream nil)
31 | (shell-tidy "hi ")
32 | (markdown "@(foo)"
33 | :properties '((:omit-initial-paragraph t)
34 | (:omit-final-paragraph t)))
35 | (markdown "@[bar](foo)")
36 | |#
--------------------------------------------------------------------------------
/unit-tests/markdown-tests/Inline HTML (Simple).text:
--------------------------------------------------------------------------------
1 | Here's a simple block:
2 |
3 |
13 |
14 | ## CL-Markdown
15 |
16 | #### Finally, text mucking fun the whole family can enjoy
17 |
18 |
4 | foo
5 |
6 |
7 | This should be a code block, though:
8 |
9 |
10 | foo
11 |
12 |
13 | As should this:
14 |
15 | foo
16 |
17 | Now, nested:
18 |
19 |
20 |
26 |
27 | This should just be an HTML comment:
28 |
29 |
30 |
31 | Multiline:
32 |
33 |
37 |
38 | Code block:
39 |
40 |
41 |
42 | Just plain comment, with trailing spaces on the line:
43 |
44 |
45 |
46 | Code:
47 |
48 |
21 |
25 |
22 | foo
23 |
24 | 49 | 50 | Hr's: 51 | 52 |
53 | 54 |
55 | 56 |
57 | 58 |
59 | 60 |
61 | 62 |
63 | 64 |
65 | 66 |
67 | 68 |
69 | 70 | -------------------------------------------------------------------------------- /lift-standard.config: -------------------------------------------------------------------------------- 1 | ;;; configuration for LIFT tests 2 | 3 | ;; settings 4 | (:if-dribble-exists :supersede) 5 | (:dribble "lift.dribble") 6 | (:print-length 10) 7 | (:print-level 5) 8 | (:print-test-case-names t) 9 | 10 | ;; suites to run 11 | (cl-markdown-test) 12 | 13 | ;; report properties 14 | (:report-property :title "CL-Markdown | Test results") 15 | (:report-property :relative-to cl-markdown-test) 16 | 17 | 18 | 19 | (:report-property :style-sheet "test-style.css") 20 | (:report-property :if-exists :supersede) 21 | (:report-property :format :html) 22 | (:report-property :full-pathname "test-results/test-report") 23 | (:report-property :unique-name t) 24 | (:build-report) 25 | 26 | (:report-property :format :save) 27 | (:report-property :full-pathname "test-results/test-report.sav") 28 | (:build-report) 29 | 30 | (:report-property :format :describe) 31 | (:report-property :full-pathname *standard-output*) 32 | (:build-report) 33 | -------------------------------------------------------------------------------- /cl-markdown-comparisons.asd: -------------------------------------------------------------------------------- 1 | (in-package #:common-lisp-user) 2 | (defpackage #:cl-markdown-test-system (:use #:cl #:asdf)) 3 | (in-package #:cl-markdown-test-system) 4 | 5 | (defsystem cl-markdown-comparisons 6 | :version "0.1" 7 | :author "Gary Warren King
2 | 
3 | 
4 | 
5 | 
6 | 
7 | {include resources/navigation.md}
8 |
9 | ### Copyright (c) 2007 - 2008 Gary Warren King (gwking@metabang.com)
10 |
11 | Cl-Markdown has an [MIT style][mit-license] license
12 |
13 |
14 | [Other Software][metabang-software] 15 | Last updated {today} at {now} 16 |
--------------------------------------------------------------------------------
/unit-tests/markdown-tests/style.css:
--------------------------------------------------------------------------------
1 |
2 |
3 | body {
4 | margin: 2em;
5 | background: #000033;
6 | }
7 |
8 | #contents {
9 | margin: 002em;
10 | background: #9999cc;
11 | padding: 1em;
12 | border: 3px outset #9999cc;
13 | }
14 |
15 | h1 {
16 | font-size: 120%;
17 | }
18 |
19 | #footer {
20 | clear: both;
21 | padding-top: 2em;
22 | text-align: left;
23 | font-style: italic;
24 | }
25 |
26 | .section-contents {
27 | margin-left: 2em;
28 | background: #ccccff;
29 | padding: 0.5em;
30 | }
31 |
32 | .diff {
33 |
34 | }
35 |
36 | ins {
37 | color: green;
38 | }
39 |
40 | del {
41 | color: red;
42 | text-decoration: line-through;
43 | }
44 |
45 | #cl-markdown-output {
46 | float: left;
47 | width: 50%;
48 | overflow: auto;
49 | }
50 |
51 | #notes {
52 | font-size: 80%;
53 | clear: both;
54 | padding-top: 1em;
55 | padding-right: 1em;
56 | padding-left: 1em;
57 | }
58 |
59 | #markdown-output {
60 | float: left;
61 | overflow: auto;
62 | width: 50%;
63 | }
64 |
65 | #diff-output {
66 | float: left;
67 | clear: both;
68 | overflow: auto;
69 | }
70 |
71 | #cl-markdown-html {
72 | float: left;
73 | overflow: auto;
74 | }
75 |
76 | #original-source {
77 | float: left;
78 | clear: both;
79 | overflow: auto;
80 | }
81 |
82 | .index-entry {
83 | float: left;
84 | clear: both;
85 | text-decoration: none;
86 | line-height: 21pt;
87 | }
88 |
89 | .index-entry a {
90 | text-decoration: none;
91 | }
92 |
93 | .error a {
94 | color: red;
95 | }
96 |
97 | .error {
98 | color: red;
99 | }
100 |
101 | .good a {
102 | color: #330099;
103 | }
104 |
105 | .good {
106 | color: #330099;
107 | }
108 |
109 |
--------------------------------------------------------------------------------
/dev/package.lisp:
--------------------------------------------------------------------------------
1 | (in-package #:common-lisp-user)
2 |
3 | (defpackage #:cl-markdown
4 | (:use #:common-lisp #:metatilities #:cl-containers #:cl-ppcre
5 | #:metabang-bind #:anaphora)
6 | (:export
7 | #:handle-spans
8 | #:markdown
9 | #:markdown-many
10 | #:render-to-stream
11 | #:*current-document*
12 | #:*output-stream*
13 | #:document-property)
14 | (:nicknames #:markdown)
15 | (:export
16 | #:*render-active-functions*
17 | #:*parse-active-functions*
18 | #:anchor
19 | #:table-of-contents
20 | #:property
21 | #:set-property
22 | #:render
23 | #:render-documentation)
24 | ;; handy (?) regular expressions
25 | (:export
26 | #:emphasis-1 #:emphasis-2
27 | #:strong-1 #:strong-2
28 | #:backtick
29 | #:auto-link #:auto-mail
30 | #:html #:entity
31 | #:hostname-char #:hostname
32 | #:pathname-char #:url-pathname
33 | #:url #:url-no-registers
34 | #:bracketed #:link+title
35 | #:reference-link #:inline-link #:link-label)
36 | (:export
37 | #:footnote
38 | #:footnotes
39 | #:find-documentation
40 | #:add-documentation-strategy
41 | #:defextension
42 | #:defsimple-extension)
43 | (:export
44 | ;; ugh
45 | #:phase
46 | #:args
47 | #:result
48 | #:*current-format*
49 | ;; for docudown::remove-non-html-entities
50 | #:+first-name-characters+
51 | #:+name-characters+))
52 |
53 | (defpackage #:cl-markdown-user
54 | (:use #:common-lisp #:metatilities #:cl-markdown)
55 | (:import-from #:cl-markdown
56 | #:footnote
57 | #:footnotes
58 | #:defextension
59 | #:defsimple-extension
60 | )
61 | (:export
62 | #:footnote
63 | #:footnotes
64 | #:find-documentation
65 | #:add-documentation-strategy
66 | #:defextension
67 | #:defsimple-extension
68 | ))
69 |
70 |
--------------------------------------------------------------------------------
/unit-tests/utilities.lisp:
--------------------------------------------------------------------------------
1 | (in-package #:cl-markdown-test)
2 |
3 | (defun strip-html (string)
4 | (with-output-to-string (out)
5 | (flet ((emit (ch)
6 | (write-char ch out)))
7 | (let ((quote? nil)
8 | (bracket? nil)
9 | (index 0))
10 | (loop while (< index (length string)) do
11 | (let ((ch (aref string index)))
12 | (cond ((char= ch #\\)
13 | (emit ch)
14 | (emit (aref string (incf index))))
15 | ((char= ch #\")
16 | (setf quote? (not quote?))
17 | (emit ch))
18 | ((and (not quote?) (char= ch #\<))
19 | (setf bracket? t))
20 | ((and bracket? (char= ch #\>))
21 | (setf bracket? nil))
22 | (bracket?
23 | ;; skip it
24 | )
25 | (t
26 | (emit ch)))
27 | (incf index)))))))
28 |
29 | (defun compare-line-by-line (a b &key (key 'identity) (test 'string=))
30 | (setf key (coerce key 'function))
31 | (setf test (coerce test 'function))
32 | (let ((ia (make-iterator a :treat-contents-as :lines))
33 | (ib (make-iterator b :treat-contents-as :lines)))
34 | (map-containers
35 | (lambda (la lb)
36 | (unless (funcall test (funcall key la) (funcall key lb))
37 | (return-from compare-line-by-line nil)))
38 | ia ib)
39 | (and (null (move-forward-p ia)) (null (move-forward-p ib)))))
40 |
41 | #+(or)
42 | (defun compare-line-by-line (a b &key (key 'identity) (test 'string=))
43 | (setf key (coerce key 'function))
44 | (setf test (coerce test 'function))
45 | (with-input-from-string (sa a)
46 | (with-input-from-string (sb b)
47 | (loop for la = (read-line sa nil nil)
48 | for lb = (read-line sb nil nil)
49 | when (and (not la) (not lb)) do (return t)
50 | when (or (not la) (not lb)
51 | (not (funcall test (funcall key la) (funcall key lb)))) do
52 | (return nil)
53 | finally (return t)))))
54 |
55 | #+(or)
56 | (compare-line-by-line
57 | "a
58 | b
59 | c"
60 | "a
61 | b
62 | c"
63 | )
64 |
--------------------------------------------------------------------------------
/dev/api.lisp:
--------------------------------------------------------------------------------
1 | (in-package #:cl-markdown)
2 |
3 |
4 | (defgeneric reset (thing)
5 | )
6 |
7 |
8 | (defgeneric (setf document-property) (value name))
9 |
10 | (defgeneric render-to-stream (document style stream-specifier)
11 | )
12 |
13 | (defgeneric main-parent (document)
14 | )
15 |
16 | (defgeneric handle-spans (document)
17 | )
18 |
19 | (defgeneric scan-one-span (what scanner-name scanner scanners)
20 | )
21 |
22 | (defgeneric process-span-in-span-p (sub-span current-span)
23 | )
24 |
25 | (defgeneric unconvert-escapes (what)
26 | )
27 |
28 | (defgeneric render (document style stream)
29 | )
30 |
31 | (defgeneric it-starts-with-block-level-html-p (chunk)
32 | )
33 |
34 | (defgeneric markup-class-mergable-p (what)
35 | )
36 |
37 | (defgeneric merge-lines-in-chunks (what)
38 | )
39 |
40 | (defgeneric can-merge-lines-p (first second)
41 | )
42 |
43 | (defgeneric handle-paragraph-eval-interactions (what)
44 | )
45 |
46 | (defgeneric encode-html (what encoding-method &rest codes)
47 | )
48 |
49 | (defgeneric markup-class-for-html (what)
50 | )
51 |
52 | (defgeneric render-span-to-html (kind body encoding-method)
53 | )
54 |
55 | (defgeneric generate-link-output (link-info text)
56 | )
57 |
58 | (defgeneric add-html-header-p (document)
59 | )
60 |
61 | (defgeneric render-plain (what)
62 | )
63 |
64 | (defgeneric render-span-plain (kind body)
65 | )
66 |
67 | (defgeneric process-span-for (kind command args)
68 | )
69 |
70 | (defgeneric generate-link-output-for-kind (kind link-info text)
71 | )
72 |
73 | (defgeneric process-span (name registers)
74 | (:documentation "Called during span processing on each match of name in the
75 | document. Registers a list of the registers captured by names regular expression.
76 | Returns a possibly new set of registers.")
77 | (:method ((name t) (registers t))
78 | (values registers)))
79 |
80 | (defgeneric print-html-markup (markup stream)
81 | )
82 |
--------------------------------------------------------------------------------
/unit-tests/package.lisp:
--------------------------------------------------------------------------------
1 | (in-package #:common-lisp-user)
2 |
3 | (defpackage #:cl-markdown-test
4 | (:use #:common-lisp #:lift #:metatilities #:cl-containers
5 | #:cl-ppcre #:cl-markdown #:trivial-shell
6 | #:metabang-bind)
7 | (:shadowing-import-from #:lift
8 | #:with-timeout)
9 | (:shadowing-import-from #:metatilities
10 | #:copy-file)
11 | (:import-from #:trivial-shell
12 | #:shell-command)
13 | (:import-from #:cl-markdown
14 | #:scan-lines-with-scanners
15 | #:atx-header-markup-class
16 | #:blockquote-stripper
17 | #:chunk-source
18 | #:line-could-be-link-reference-title-p
19 | #:line-indentation
20 | #:line-is-blockquote-p
21 | #:line-is-code-p
22 | #:line-is-empty-p
23 | #:line-is-horizontal-rule-p
24 | #:line-starts-with-bullet-p
25 | #:line-starts-with-number-p
26 | #:it-starts-with-block-level-html-p
27 | #:markdown
28 | #:one-tab-stripper
29 | #:remove-atx-header
30 | #:remove-marker
31 | #:remove-number
32 | #:strippers
33 | #:reset
34 |
35 | #:handle-setext-headers
36 | #:lines
37 | #:indentation
38 | #:maybe-strip-line
39 | #:chunks
40 | #:markup-class
41 | #:paragraph?
42 | #:link-info
43 | #:id
44 | #:properties
45 | #:title
46 |
47 | #:header1
48 | #:header2
49 | #:header3
50 | #:header4
51 | #:header5
52 | #:header6
53 |
54 | #:*spaces-per-tab*
55 | #:*parsing-environment*
56 |
57 | #:system-relative-pathname))
58 |
--------------------------------------------------------------------------------
/website/source/style.css:
--------------------------------------------------------------------------------
1 | pre { padding:5px; background-color:#e0e0e0;
2 | overflow: auto;
3 | }
4 |
5 | body {
6 | background: white;
7 | margin: 2px;
8 | padding-left: 3em;
9 | padding-right: 3em;
10 | }
11 |
12 | .note {
13 | border: 2px inset gray;
14 | padding: 0.5em;
15 | margin-right: 2em;
16 | margin-left: 2em;
17 | }
18 |
19 | #footer {
20 | margin-top: 2em;
21 | border-top-style: inset;
22 | border-top-width: 2px;
23 | }
24 |
25 | #header {
26 | text-align: left;
27 | border-top: 1px none black;
28 | border-collapse: collapse;
29 | border-bottom: 1px dotted black;
30 | margin-bottom: 1em;
31 | }
32 |
33 | #navigation li {
34 | display: inline;
35 | border-right-style: dotted;
36 | border-right-width: 1px;
37 | border-left-style: dotted;
38 | border-left-width: 1px;
39 | border-collapse: collapse;
40 | padding-right: 0.25em;
41 | padding-left: 0.25em;
42 | margin-right: 1em;
43 | }
44 |
45 | #navigation {
46 | text-align: center;
47 | }
48 |
49 | #timestamp {
50 | font-size: 80%;
51 | text-align: right;
52 | }
53 | a.none { text-decoration: none; color:black }
54 | a.none:visited { text-decoration: none; color:black }
55 | a.none:active { text-decoration: none; color:black }
56 | a.none:hover { text-decoration: none; color:black }
57 | a { text-decoration: none; }
58 | a:visited { text-decoration: none; }
59 | a:active { text-decoration: underline; }
60 | a:hover { text-decoration: underline; }
61 |
62 | .note {
63 |
64 | }
65 |
66 | .windows {
67 |
68 | }
69 |
70 | /* @group toc */
71 |
72 | .table-of-contents {
73 | font-size: 90%;
74 | }
75 |
76 | .table-of-contents h1, h2, h3, h4, h5, h6, h7 {
77 | font-size: inherit;
78 | }
79 |
80 | .table-of-contents h2 {
81 | position: relative;
82 | left: 2em;
83 | }
84 |
85 | .table-of-contents h3 {
86 | position: relative;
87 | left: 4em;
88 | }
89 |
90 | .table-of-contents h4 {
91 | position: relative;
92 | left: 6em;
93 | }
94 |
95 | .table-of-contents h5 {
96 | position: relative;
97 | left: 8px;
98 | }
99 |
100 | /* @end */
101 |
--------------------------------------------------------------------------------
/website/source/user-guide.css:
--------------------------------------------------------------------------------
1 | /* @override file:///Users/gwking/darcs/log5/website/output/style.css */
2 |
3 | pre { background-color:#e0e0e0;
4 | overflow: auto;
5 | margin-right: 1em;
6 | margin-left: 1em;
7 | padding: 5px;
8 | }
9 |
10 | body {
11 | background: white;
12 | margin: 2px;
13 | padding-left: 6em;
14 | padding-right: 6em;
15 | }
16 |
17 | .note {
18 | border: 2px inset gray;
19 | padding: 0.5em;
20 | margin-right: 2em;
21 | margin-left: 2em;
22 | }
23 |
24 | #footer {
25 | margin-top: 2em;
26 | border-top-style: inset;
27 | border-top-width: 2px;
28 | }
29 |
30 | #header {
31 | text-align: left;
32 | border-top: 1px none black;
33 | border-collapse: collapse;
34 | border-bottom: 1px dotted black;
35 | margin-bottom: 1em;
36 | }
37 |
38 | #navigation li {
39 | display: inline;
40 | border-right-style: dotted;
41 | border-right-width: 1px;
42 | border-left-style: dotted;
43 | border-left-width: 1px;
44 | border-collapse: collapse;
45 | padding-right: 0.25em;
46 | padding-left: 0.25em;
47 | margin-right: 1em;
48 | }
49 |
50 | #navigation {
51 | text-align: center;
52 | }
53 |
54 | #timestamp {
55 | font-size: 80%;
56 | text-align: right;
57 | }
58 | a.none { text-decoration: none; color:black }
59 | a.none:visited { text-decoration: none; color:black }
60 | a.none:active { text-decoration: none; color:black }
61 | a.none:hover { text-decoration: none; color:black }
62 | a { text-decoration: none; }
63 | a:visited { text-decoration: none; }
64 | a:active { text-decoration: underline; }
65 | a:hover { text-decoration: underline; }
66 |
67 | .note {
68 |
69 | }
70 |
71 | .windows {
72 |
73 | }
74 |
75 | /* @group toc */
76 |
77 | .table-of-contents {
78 | font-size: 90%;
79 | }
80 |
81 | .table-of-contents h1, h2, h3, h4, h5, h6, h7 {
82 | font-size: inherit;
83 | margin-top: -0.5em;
84 | }
85 |
86 | .table-of-contents h2 {
87 | position: relative;
88 | left: 2em;
89 | }
90 |
91 | .table-of-contents h3 {
92 | position: relative;
93 | left: 4em;
94 | }
95 |
96 | .table-of-contents h4 {
97 | position: relative;
98 | left: 6em;
99 | }
100 |
101 | .table-of-contents h5 {
102 | position: relative;
103 | left: 8px;
104 | }
105 |
106 | /* @end */
107 |
--------------------------------------------------------------------------------
/dev/plain.lisp:
--------------------------------------------------------------------------------
1 | (in-package #:cl-markdown)
2 |
3 | #|
4 | (markdown "`test` blue **beans**" :format :plain)
5 | (markdown "Eta
6 |
7 | * beta
8 | * data
9 |
10 | Eta" :format :plain)
11 | |#
12 |
13 | (defmethod render ((document abstract-document) (style (eql :plain)) stream)
14 | (declare (ignore stream))
15 | (render-plain document))
16 |
17 | (defmethod render-plain ((document abstract-document))
18 | (bind ((current-chunk nil))
19 | (labels ((render-block (block level markup inner?)
20 | (declare (ignore markup))
21 | (let ((add-markup? (not (eq (first block) current-chunk))))
22 | (cond ((or (length-1-list-p block))
23 | (render-plain (first block)))
24 | ((not add-markup?)
25 | (render-plain (first block))
26 | (do-it (rest block) level))
27 | (t
28 | (setf current-chunk (and inner? (first block)))
29 | (do-it block level)))))
30 | (do-it (chunks level)
31 | (loop for rest = chunks then (rest rest)
32 | for chunk = (first rest) then (first rest)
33 | while chunk
34 | for new-level = (and chunk (level chunk))
35 | when (= level new-level) do
36 | (let ((index (inner-block rest))
37 | (inner-markup (html-inner-block-markup chunk)))
38 | (render-block (subseq rest 0 index)
39 | level inner-markup t)
40 | (setf rest (nthcdr (1- index) rest)))
41 | when (< level new-level) do
42 | (multiple-value-bind (block remaining method)
43 | (next-block rest new-level)
44 | (declare (ignore method))
45 | (render-block
46 | block new-level (html-block-markup chunk) nil)
47 | (setf rest remaining)))))
48 | (do-it (collect-elements (chunks document)) (level document)))))
49 |
50 | (defmethod render-plain ((chunk chunk))
51 | (bind ((paragraph? (paragraph? chunk)))
52 | (iterate-elements
53 | (lines chunk)
54 | (lambda (line)
55 | (render-plain line)))
56 | (when paragraph?
57 | (fresh-line *output-stream*))))
58 |
59 | (defmethod render-plain ((line string))
60 | (format *output-stream* "~a" line))
61 |
62 | (defmethod render-plain ((chunk list))
63 | (render-span-plain (first chunk) (rest chunk)))
64 |
65 | (defmethod render-span-plain ((code t) body)
66 | (format *output-stream* "~a" (first body)))
67 |
68 | (defmethod render-span-plain ((code (eql 'eval)) body)
69 | (render-handle-eval body))
70 |
71 | (defmethod render-span-plain ((code (eql 'code-eval)) body)
72 | (render-handle-eval body))
73 |
--------------------------------------------------------------------------------
/unit-tests/test-utilities.lisp:
--------------------------------------------------------------------------------
1 | (in-package #:cl-markdown-test)
2 |
3 | (deftestsuite test-utilities (cl-markdown-test-all) ())
4 |
5 | (deftestsuite list-depth (test-utilities) ()
6 | (:test ((ensure-same (list-depth '(((a)))) 3)))
7 | (:test ((ensure-same (list-depth '(((a) b))) 3)))
8 | (:test ((ensure-same (list-depth '(((a b)))) 3)))
9 | (:test ((ensure-same (list-depth '(a)) 1)))
10 | (:test ((ensure-same (list-depth nil) 0))))
11 |
12 | (deftestsuite test-list->tree (test-utilities)
13 | ()
14 | (:test ((ensure-same (list->tree '((a 1) (b 1) (c 1)) :key #'first :depth-fn #'second)
15 | '(a b c) :test 'equal)))
16 | (:test ((ensure-same (list->tree '((a 1) (b 1) (c 2)) :key #'first :depth-fn #'second)
17 | '(a b (c)) :test 'equal)))
18 | (:test ((ensure-same (list->tree '((a 2) (b 1) (c 1)) :key #'first :depth-fn #'second)
19 | '((a) b c) :test 'equal)))
20 | (:test ((ensure-same (list->tree '((a 1) (b 2) (c 1)) :key #'first :depth-fn #'second)
21 | '(a (b) c) :test 'equal)))
22 | (:test ((ensure-same (list->tree '((a 1) (b 2) (c 3)) :key #'first :depth-fn #'second)
23 | '(a (b (c))) :test 'equal)))
24 | (:test ((ensure-same (list->tree '((a 1) (b 2) (c 3) (d 3)) :key #'first :depth-fn #'second)
25 | '(a (b (c d))) :test 'equal)))
26 | (:test ((ensure-same (list->tree '((a 3) (b 2) (c 1)) :key #'first :depth-fn #'second)
27 | '(((a) b) c) :test 'equal)))
28 | (:test ((ensure-same (list->tree '((a 1) (b 2) (c 3) (d 3) (e 1)) :key #'first :depth-fn #'second)
29 | '(a (b (c d)) e) :test 'equal)))
30 | (:test ((ensure-same (list->tree '((a 1) (b 2 :q) (c 3 :q) (d 3) (e 1))
31 | :key #'first :depth-fn #'second
32 | :marker #'third)
33 | '(a (:q b (:q c d)) e) :test 'equal))))
34 |
35 | (deftestsuite test-merge-atom-with-list-at-depth (test-utilities) ())
36 | (addtest (ensure-same (merge-atom-with-list-at-depth 'a '((b) c) 2) '((a b) c)
37 | :test 'tree-equal))
38 | (addtest (ensure-same (merge-atom-with-list-at-depth 'a '((b) c) 3) '(((a)) (b) c)
39 | :test 'tree-equal))
40 | (addtest (ensure-same (merge-atom-with-list-at-depth 'a '((b) c) 1) '(a (b) c)
41 | :test 'tree-equal))
42 | (addtest (ensure-same (merge-atom-with-list-at-depth 'b '(((c d)) e) 2) '((b (c d)) e)
43 | :test 'tree-equal))
44 |
45 |
46 |
47 |
--------------------------------------------------------------------------------
/cl-markdown.asd:
--------------------------------------------------------------------------------
1 | (in-package #:common-lisp-user)
2 |
3 | (defpackage #:cl-markdown-system (:use #:cl #:asdf))
4 | (in-package #:cl-markdown-system)
5 |
6 | ;; Load asdf-system-connections if available
7 | (unless (member :asdf-system-connections *features*)
8 | (if (asdf:find-system "asdf-system-connections" nil)
9 | (asdf:load-system "asdf-system-connections")
10 | (warn "The CL-Markdown system would enjoy having ~
11 | asdf-system-connections around. See
12 | http://www.cliki.net/asdf-system-connections for details and download
13 | instructions.")))
14 |
15 | (defsystem cl-markdown
16 | :version "0.10.6"
17 | :author "Gary Warren King
3 |
4 |
5 |
6 |
7 | {include resources/navigation.md}
8 |
9 | ### Copyright (c) 2007 - 2008 Gary Warren King (gwking@metabang.com)
10 |
11 | Cl-Markdown has an [MIT style][mit-license] license
12 |
13 | 14 | [Other Software][metabang-software] 15 | Last updated {today} at {now} 16 |
-
115 |
- Punt 116 |
- Kick a ball 117 |
- Take a bet 118 |
-
127 |
- Punt 128 |
- Dance 129 |
- Take a bet 130 |
-
141 |
- Punt 142 |
- Take a bet 143 |
- Dance 144 |
- Shake a jig 145 |
-
187 |
- Punt 188 |
- Take a bet
189 |
190 |
that is right.
191 |
"
148 | :format :html :stream nil)))
149 | "Hi
Hithere
")) 165 | 166 | (addtest (inline-html) 167 | encode-in-code 168 | (ensure-same 169 | (remove-if 'whitespacep 170 | (nth-value 171 | 1 (markdown "Hi `there`" 172 | :format :html :stream nil))) 173 | "Hi<em>there</em>
5 |
111 |
112 | {include resources/footer.md}
113 |
114 | [1]: http://common-lisp.net/project/cl-containers/shared/metabang-2.png (metabang.com)
115 | [2]: http://www.metabang.com/ (metabang.com)
116 | [3]: #mailing-lists
117 | [4]: #downloads
118 | [5]: documentation/ (documentation link)
119 | [6]: #news
120 | [7]: changelog.html
121 | [8]: comparison-tests
122 | [9]: http://trac.common-lisp.net/cl-markdown
123 | [10]: http://trac.common-lisp.net/cl-markdown/newticket
124 | [11]: http://common-lisp.net/cgi-bin/mailman/listinfo/cl-markdown-announce
125 | [12]: http://common-lisp.net/cgi-bin/mailman/listinfo/cl-markdown-devel
126 | [13]: downloads
127 | [14]: http://www.cliki.net/asdf-install
128 | [15]: http://common-lisp.net/project/cl-markdown/cl-markdown_latest.tar.gz
129 | [16]: http://www.darcs.net/
130 | [17]: news
131 | [18]: http://common-lisp.net/project/cl-containers/shared/buttons/xhtml.gif (valid xhtml button)
132 | [19]: http://validator.w3.org/check/referer (xhtml1.1)
133 | [20]: http://common-lisp.net/project/cl-containers/shared/buttons/hacker.png (hacker emblem)
134 | [21]: http://www.catb.org/hacker-emblem/ (hacker)
135 | [22]: http://common-lisp.net/project/cl-containers/shared/buttons/lml2-powered.png (lml2 powered)
136 | [23]: http://lml2.b9.com/ (lml2 powered)
137 | [24]: http://common-lisp.net/project/cl-containers/shared/buttons/lambda-lisp.png (ALU emblem)
138 | [25]: http://www.lisp.org/ (Association of Lisp Users)
139 | [26]: http://common-lisp.net/project/cl-containers/shared/buttons/lisp-lizard.png (Common-Lisp.net)
140 | [27]: http://common-lisp.net/ (Common-Lisp.net)
141 |
142 |
--------------------------------------------------------------------------------
/dev/class-defs.lisp:
--------------------------------------------------------------------------------
1 | (in-package #:cl-markdown)
2 |
3 | ;; someday
4 | (defclass markdown-warning ()
5 | ())
6 |
7 | (defclass* abstract-document ()
8 | ((chunks (make-container 'vector-container) r)
9 | (link-info (make-container 'simple-associative-container
10 | :test #'equalp) r)
11 | (level 0 a)
12 | (markup nil a)
13 | (properties (make-container 'alist-container
14 | :test #'string-equal) r)
15 | (metadata (make-container 'alist-container
16 | :test #'string-equal) r)
17 | (bracket-references (make-container 'flexible-vector-container) r)
18 | (parent nil ir)
19 | (warnings nil a)
20 | (source nil ir)
21 | (destination nil ia) ;more or less the last place
22 | ;it was rendered
23 | (children nil ia)))
24 |
25 | (defmethod print-object ((object abstract-document) stream)
26 | (print-unreadable-object (object stream :type t :identity t)
27 | (format stream "~a" (short-source (source object)))))
28 |
29 | (defclass* document (abstract-document)
30 | ())
31 |
32 | (defclass* child-document (document)
33 | ())
34 |
35 | (defclass* multi-document (abstract-document)
36 | ())
37 |
38 | (defmethod print-object ((object multi-document) stream)
39 | (print-unreadable-object (object stream :type t :identity t)
40 | (format stream "~d children" (length (children object)))))
41 |
42 | (defclass* included-document (abstract-document)
43 | ())
44 |
45 | (defgeneric document-property (name &optional default)
46 | (:documentation "Returns the value of the property `name` of the `*current-document*` or the default if the property is not defined or there is no `*current-document*`."))
47 |
48 | (defmethod document-property (name &optional default)
49 | (or (when *current-document*
50 | (multiple-value-bind (value found?)
51 | (item-at-1 (properties *current-document*)
52 | (form-property-name name))
53 | (when found? (return-from document-property (first value)))))
54 | (when (and *current-document*
55 | (parent *current-document*))
56 | (let ((*current-document* (parent *current-document*)))
57 | (document-property name default)))
58 | default))
59 |
60 | (defmethod (setf document-property) (value name)
61 | (when *current-document*
62 | (setf (item-at-1 (properties *current-document*)
63 | (form-property-name name))
64 | ;; so that we don't lose 'nil'
65 | (list value)))
66 | ;;?? weird since nothing happened
67 | (values value))
68 |
69 | (defun find-link (id)
70 | (or (item-at-1 (link-info *current-document*) id)
71 | (and (parent *current-document*)
72 | (let ((*current-document* (parent *current-document*)))
73 | (find-link id)))))
74 |
75 | (defun form-property-name (name)
76 | (form-keyword (typecase name
77 | (string (intern name
78 | (load-time-value (find-package :keyword))))
79 | (symbol (form-property-name (symbol-name name)))
80 | (t name))))
81 |
82 | (defclass* chunk ()
83 | ((lines (make-container 'vector-container) r)
84 | (blank-line-before? nil ia)
85 | (blank-line-after? nil ia)
86 | (started-by nil ia)
87 | (ended-by nil ia)
88 | (ignore? nil a)
89 | (markup-class nil ia)
90 | (indentation 0 ia)
91 | (level 0 ia)
92 | (paragraph? nil ia)
93 | (properties (make-container 'alist-container
94 | :test #'string-equal) r)
95 | (stripper? nil ia)
96 | (process? t ia)))
97 |
98 | (defmethod initialize-instance :after ((object chunk) &key lines)
99 | (when lines
100 | (iterate-elements lines (lambda (line) (insert-item (lines object) line)))))
101 |
102 | (defmethod print-object ((chunk chunk) stream)
103 | (print-unreadable-object (chunk stream :type t)
104 | (format stream "~a~A/~A ~D lines ~A ~A"
105 | (if (paragraph? chunk) "*" "")
106 | (markup-class chunk)
107 | (level chunk)
108 | (size (lines chunk))
109 | (started-by chunk)
110 | (ended-by chunk))))
111 |
112 | (defclass* chunk-parsing-environment ()
113 | ((name nil ir)
114 | (chunk-enders nil ia)
115 | (chunk-starters nil ia)
116 | (line-coders nil ia)
117 | (parser-map nil ia)))
118 |
119 | (defclass* parsing-environment ()
120 | ((chunk-parsing-environment (make-container 'stack-container) r)
121 | (chunk-post-processors nil ia)
122 | (chunk-level 0 ia)
123 | (current-strip "" ia)
124 | (line-code->stripper (make-container 'simple-associative-container
125 | :initial-element nil #+(or) 'null-stripper) r)
126 | (strippers (make-container 'stack-container) r)))
127 |
128 | (defun current-chunk-parser ()
129 | (first-item (chunk-parsing-environment *parsing-environment*)))
130 |
131 | (defclass* basic-link-info ()
132 | ((id nil ia)))
133 |
134 | (defclass* link-info (basic-link-info)
135 | ((url nil ir)
136 | (title nil ia)
137 | (properties nil ia)))
138 |
139 | (defmethod initialize-instance :after ((link link-info) &key properties)
140 | (when (stringp properties)
141 | (setf (properties link)
142 | (collect-window-over-elements
143 | (string->list properties) 2 2
144 | :transform
145 | (lambda (pair) (cons (form-keyword (first pair))
146 | (second pair)))))))
147 |
148 | (defclass* extended-link-info (basic-link-info)
149 | ((kind nil ir)
150 | (contents nil ia)))
151 |
152 | (defmethod print-object ((object link-info) stream)
153 | (print-unreadable-object (object stream :type t :identity t)
154 | (format stream "~A -> ~A" (id object) (url object))))
155 |
--------------------------------------------------------------------------------
/dev/footnotes.lisp:
--------------------------------------------------------------------------------
1 | (in-package #:cl-markdown)
2 |
3 | #|
4 | To do:
5 |
6 | - allow footnotes to appear on a completely separate page
7 | - do footnotes as a popup window with mouse over
8 | - handle footnotes 'out of band' a la links
9 |
10 | Footnotes
11 | {note foo}
12 | {note "This is a note"}
13 | {note "Foo"}
14 | {note This is a note}
15 |
16 | (markdown
17 | "That is what he thought.{footnote foo}
18 |
19 | [foo]> \"This is a longer note with
20 | linefeeds, *mark-up*, and \\\"escaped\\\" quotes.
21 | I'll be wicked surprised if it works out of the
22 | box.\"
23 | ")
24 |
25 | Need to
26 |
27 | 1. get a number
28 | 2. add link where the footnote starts
29 | 3. add anchor where the footnote starts
30 | 4. add footnote text at bottom of document / separate page
31 | 5. add link back to anchor in footnote
32 |
33 | Our footnote HTML is so heavily influenced by DF that you might think
34 | we just copied it all.
35 |
36 | (markdown "
37 | Maybe people{footnote Well, at least one person} find CL-Markdown
38 | to be the bees knees, the cats pajamas and the gnats goulash. In
39 | fact, if computers could dance, you could tell that one had
40 | CL-Markdown installed on it just by watching.{footnote Not really.}
41 |
42 | {footnotes}
43 |
44 | This was generated {today} at {now}.")
45 | |#
46 |
47 | (defclass* footnote-info ()
48 | ((id nil ia)
49 | (text nil ia)
50 | (reference-name nil ia)
51 | (name nil ia)))
52 |
53 | (eval-when (:load-toplevel :execute)
54 | (setf *extensions* (remove 'footnote *extensions* :key #'first))
55 | (push (list 'footnote t) *extensions*)
56 | (setf *extensions* (remove 'footnotes *extensions* :key #'first))
57 | (push (list 'footnotes t) *extensions*))
58 |
59 | ;; provides an example of using result during render phase
60 | (defun footnote (phase args result)
61 | ;; {documentation text}
62 | (let ((footnotes
63 | (or (document-property :footnote)
64 | (setf (document-property :footnote)
65 | (make-instance 'vector-container)))))
66 | (cond ((eq phase :parse)
67 | (let* ((text (format nil "~{~a ~}" args)))
68 | (when text
69 | (bind ((id (size footnotes))
70 | (fn-basename
71 | (format nil "~d-~a"
72 | id
73 | (format-date "%Y-%m-%d"
74 | (document-property
75 | :date-modified
76 | (get-universal-time)))))
77 | (fn-name (format nil "fn~a" fn-basename))
78 | (ref-name (format nil "fnr~a" fn-basename)))
79 | (insert-item footnotes
80 | (make-instance
81 | 'footnote-info
82 | :id id
83 | :name fn-name
84 | :reference-name ref-name
85 | :text text))
86 | (values id)))))
87 | ((eq phase :render)
88 | (let ((footnote (item-at footnotes (first result))))
89 | (output-anchor (reference-name footnote))
90 | (format *output-stream*
91 | "~d"
92 | (name footnote)
93 | (1+ (id footnote))))))))
94 |
95 | (defun footnotes (phase args result)
96 | (declare (ignore args result))
97 | (ecase phase
98 | (:parse)
99 | (:render
100 | (unless (empty-p (document-property :footnote))
101 | (format *output-stream* "~&
6 |
7 | * [Mailing Lists][3]
8 | * [Getting it][4]
9 | {remark * [Documentation][5]}
10 | * [News][6]
11 | {remark * [Test results][tr]}
12 | * [Changelog][7]
13 |
14 | [3]: #mailing-lists
15 | [4]: #downloads
16 | [5]: documentation/ "documentation link"
17 | [6]: #news
18 | [7]: changelog.html
19 | [tr]: test-report.html
20 |
21 |
22 |
23 |
24 | ### What it is
25 |
26 | (Note: CL-Markdown just split off it's Lisp documentation
27 | abilities into the [docudown][] project. Don't be alarmed.
28 | Everything is good.)
29 |
30 | [Markdown][] is [John Gruber][df]'s text markup langauge and
31 | the Perl program that converts documents written in that
32 | language into HTML. CL-Markdown is a Common Lisp rewrite of
33 | Markdown. CL-Markdown is licensed under the [MIT
34 | license][mit-license].
35 |
36 | You can see the source of this page by clicking in the
37 | address bar of your browser and changing the extension from
38 | `html` to `text`. For example, this page's source is at
39 | [index.text](index.text).
40 |
41 | You can view a comparison of Markdown and CL-Markdown output
42 | [here][8].
43 |
44 | {anchor mailing-lists}
45 |
46 | ### Mailing Lists
47 |
48 | * [devel-list][]: A list for questions, patches, bug
49 | reports, and so on; It's for everything other than
50 | announcements.
51 |
52 | {anchor downloads}
53 |
54 | ### Where is it
55 |
56 | metabang.com is switching from [darcs][] to [git][]
57 | for source control; the current cl-markdown repository is on
58 | [github][github-cl-markdown] and you can clone it using:
59 |
60 | git clone git://github.com/gwkkwg/cl-markdown
61 |
62 | (note that this won't let you build CL-Markdown unless you
63 | also get all of its dependencies which I should list but don't
64 | because I haven't found (er, made) the time to automate the
65 | process yet...)
66 |
67 | The easiest way to get setup with CL-Markdown is by using
68 | [QuickLisp][] or [ASDF-Install][14] (deprecated). If that
69 | doesn't float your boat, there is a handy [gzipped tar
70 | file][15]
71 |
72 | {anchor news}
73 |
74 | ### What is happening
75 |
76 |
110 | -
77 |
- 8 January 2011 78 |
- Moved to github. Very minor cleanup. 79 |
- 28 May 2008 80 |
- Many small improvements, bug fixes, tweaks, and 81 | extensions. The biggest change, however, is that I've 82 | move the Lisp documentation work into it's own 83 | [project][docudown]. This keeps CL-Markdown simpler. 84 | The dependencies on [moptilities][] and 85 | [defsystem-compatibility][] have both been removed. 86 | A dependency on [anaphora][clnet-anaphora] has been added. 87 | 88 |
- 30 August 2007 89 |
- Tons of improvements in the documentation extension, lots of 90 | cleanup, better HTML generation, better footnotes, what's not to like! 91 | 92 |
- 20 Feb 2007 93 |
- Lots of stuff has happened; see the change log for details. 94 | 95 |
- 5 June 2006 96 |
- More tweaking of block structure processing and paragraph marking. In every day and in every way, it's getting better and better. 97 | 98 |
- 22 May 2006 99 |
- Removed LML2 dependency for CL-Markdown and fixed some bugs! 100 | 101 |
- 17 May 2006 102 |
- Updated with SBCL and Allegro support (son far only alisp) 103 | 104 |
- 8 May 2006 105 |
- Created site. 106 | 107 |
")
102 | (format *output-stream* "~&
")))))
123 |
124 | ;; not yet
125 | #|
126 | (defun handle-footnote-links (document)
127 | (iterate-elements
128 | (chunks document)
129 | (lambda (chunk)
130 | (when (line-is-footnote-text-p)
131 | (bind (((values nil link-info)
132 | (scan-to-strings '(:sequence footnote-text)
133 | (first-element (lines chunk))))
134 | (id (aref link-info 0))
135 | (text (aref link-info 1)))
136 | (setf (item-at (link-info document) id)
137 | (make-instance 'footnote-text
138 | :id id :title text)
139 | (ignore? chunk) t)))))
140 | ;; now remove the unneeded chunks
141 | (removed-ignored-chunks? document)
142 | document)
143 |
144 | (defun line-is-footnote-text-p (line)
145 | (scan #.(ppcre:create-scanner '(:sequence footnote-text)) line))
146 |
147 | (define-parse-tree-synonym
148 | footnote-label
149 | (:sequence
150 | :start-anchor
151 | (:greedy-repetition 0 3 :whitespace-char-class)
152 | bracketed
153 | #\>
154 | (:greedy-repetition 0 nil :whitespace-char-class)
155 | (:register
156 | (:alternation
157 | (:sequence
158 | #\" (:greedy-repetition 0 nil (:inverted-char-class #\") #\"))
159 | (:greedy-repetition 0 nil :everything)))))
160 |
161 | #+(or)
162 | (scan-to-strings
163 | (create-scanner 'footnote-label)
164 | " [a]> why are you here
165 | ok")
166 |
167 | #+(or)
168 | (scan-to-strings
169 | (create-scanner 'footnote-label)
170 | " [a]> \"why are you here?
171 | I am here because that is why.
172 |
173 | OK? ok!\"")
174 |
175 | |#
--------------------------------------------------------------------------------
/website/source/user-guide.md:
--------------------------------------------------------------------------------
1 | {include resources/ug-header.md}
2 | {set-property title "CL-Markdown User's Guide"}
3 |
4 | # CL-Markdown - Quick Start
5 |
6 | {table-of-contents :start 2 :depth 3}
7 |
8 | CL-Markdown is an enhanced version of John Gruber's [Markdown][] text
9 | markup langauge. Markdown's goal is to keep text readable as *text* and
10 | as HTML. CL-Markdown keeps this principle and adds a flexible extension
11 | mechanism so that you can build complex documents easily.
12 |
13 | [Markdown]: http://daringfireball.net/projects/markdown/
14 |
15 |
16 | ### Getting Started
17 |
18 | The easiest way to install CL-Markdown is using the
19 | [bundle][]. You can also use [ASDF-Install][], download
20 | tarballs or grab the sources directly (usings [darcs][]). If
21 | you do use the bundle, here is what you'd do:
22 |
23 | shell> cd - ")
103 | (iterate-elements
104 | (document-property :footnote)
105 | (lambda (footnote)
106 | (format *output-stream* "~&
- ") 107 | (output-anchor (name footnote)) 108 | (markdown (text footnote) 109 | :stream *output-stream* 110 | :format *current-format* 111 | :properties '((:html . nil) 112 | (:omit-final-paragraph . t) 113 | (:omit-initial-paragraph . t)) 114 | :document-class 'included-document) 115 | (format *output-stream* "↩ "))) 121 | (format *output-stream* 122 | "~&
Hello there
" 45 | 46 | CL-Markdown implements most of John Gruber's 47 | [specification][markdown-specification] (though it does not 48 | yet handle e-mails and some edges cases). It also adds a new 49 | syntax for extensions. 50 | 51 | [markdown-specification]: http://daringfireball.net/projects/markdown/syntax 52 | 53 | ### Function calls: \{ and \} 54 | 55 | Calling extension functions requires three things: 56 | 57 | 1. writing (or finding) the extension that you want 58 | 2. telling CL-Markdown that you want to use the extension 59 | 3. writing your Markdown text with calls to the extension 60 | 61 | The last part is the easiest; all you need to do is open a 62 | curly brace, type the name of extension function, type in the 63 | arguments (separated by spaces) and type a closing curly 64 | brace. For example: 65 | 66 | "\{now\}" will generate the text "{now}". 67 | 68 | The second step is necessary because CL-Markdown won't 69 | recognize functions as functions unless you tell it to up 70 | front. After all, you wouldn't want to allow people to 71 | execute arbitrary code; it **might** be a security risk 72 | (smile). Because CL-Markdown operates in two stages, there 73 | are two times when functions can be called: during parsing 74 | and during rendering. Functions active during these stages 75 | are keep in the special variables `*render-active-functions*` 76 | and `*parse-active-functions*`. 77 | 78 | An example might make this clearer. First, we'll call Markdown 79 | without specifying any functions: 80 | 81 | ? (markdown "Today is {today}. It is {now}." 82 | :format :html :stream t) 83 |Today is
84 | ; Warning: Inactive or undefined CL-Markdown function TODAY
85 | ; While executing: #
Today is 1 August 2006. It is 11:36.
101 | 102 | By now, we've seen how to include function calls in CL-Markdown 103 | documents and how to generate those documents with CL-Markdown. The 104 | final piece of the puzzle is actually writing the extensions. 105 | 106 | 107 | #### Writing Cl-Markdown extensions 108 | 109 | There are several ways to write extensions. {footnote 110 | Extensions beg for a little {abbrev DSL Domain Specific 111 | Language} but those macros are still to be written.} The 112 | easiest is one is to write functions active during rendering 113 | that return the text that you wish to be included in the 114 | document. For example: 115 | 116 | (defun today (phase arguments result) 117 | (declare (ignore phase arguments result)) 118 | (format-date "%e %B %Y" (get-universal-time))) 119 | 120 | The format-date command is part of [metatilities-base][]; it 121 | returns a string of the date using the C library inspired 122 | date format. This string is placed in the document whereever 123 | the function call (\{today\}) is found. 124 | 125 | [metatilities]: 126 | 127 | Alternately, one can use the `*output-stream*` variable to 128 | insert more complicated text. This would look like: 129 | 130 | (defun now (phase arguments result) 131 | (declare (ignore phase arguments result)) 132 | (format *output-stream* "~a" 133 | (format-date "%H:%M" (get-universal-time))) 134 | nil) 135 | 136 | (Note that `now` returns `nil` so that the date isn't inserted 137 | twice!). 138 | 139 | The other alternative is to use your function calls to alter 140 | the structure of the CL-Markdown document and then let 141 | Markdown deal with some or all of the rest. The `anchor` 142 | extension provides an example of this: 143 | 144 | (defun anchor (phase &rest args) 145 | (ecase phase 146 | (:parse 147 | (let ((name (caar args)) 148 | (title (cadar args))) 149 | (setf (item-at (link-info *current-document*) name) 150 | (make-instance 'link-info 151 | :id name :url (format nil "#~a" name) 152 | :title (or title ""))))) 153 | (:render (let ((name (caar args))) 154 | (format nil "" 155 | name name))))) 156 | 157 | `Anchor` makes it easier to insert anchors into your document 158 | and to link to those anchors from elsewhere. It is active 159 | during both parsing and rendering. During the parsing phase, 160 | it uses it's arguments to determine the name and title of the 161 | link and places this into the current document's link 162 | information table. During rendering, it outputs the HTML 163 | needed to mark the link. {footnote If you would like to see 164 | more examples, look in the files `extensions.lisp` or 165 | `footnotes.lisp`.} 166 | 167 |168 | 169 | {footnotes} 170 | 171 | {include resources/ug-footer.md} 172 | -------------------------------------------------------------------------------- /dev/extension-mechanisms.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-markdown) 2 | 3 | #| 4 | extensions should have a unique name and a priority (as should the built-ins) 5 | |# 6 | 7 | ;;?? only add once 8 | (defun add-extension (extension &key (filter (constantly t))) 9 | (iterate-key-value 10 | *spanner-parsing-environments* 11 | (lambda (key value) 12 | (when (funcall filter key) 13 | (insert-new-item value extension))))) 14 | 15 | #| 16 | (markdown "Hello {user-name :format :long}, how are you. Go {{here}}." :format :none) 17 | ==> '("Hello " 18 | (EVAL "user-name :format :long") 19 | ", how are you. Go " 20 | (MARKDOWN::WIKI-LINK "here") 21 | ". ") 22 | 23 | (let ((*render-active-functions* 24 | (append '(today now) *render-active-functions*))) 25 | (markdown "Today is {today}. It is {now}." 26 | :format :html :stream t)) 27 | 28 | |# 29 | 30 | (define-parse-tree-synonym 31 | wiki-link (:sequence 32 | #\{ #\{ 33 | (:register (:greedy-repetition 0 nil (:inverted-char-class #\}))) 34 | #\} #\})) 35 | 36 | (define-parse-tree-synonym 37 | eval (:sequence 38 | #\{ 39 | (:register (:greedy-repetition 0 nil (:inverted-char-class #\}))) 40 | #\})) 41 | 42 | (define-parse-tree-synonym 43 | eval-in-code (:sequence 44 | #\{ #\{ 45 | (:register (:greedy-repetition 0 nil (:inverted-char-class #\}))) 46 | #\} #\})) 47 | 48 | ;; should only happen once! (but need names to do this correctly) 49 | (eval-when (:load-toplevel :execute) 50 | #+(or) 51 | (add-extension (list (create-scanner '(:sequence wiki-link)) 'wiki-link) 52 | :filter (lambda (key) (not (equal key '(code))))) 53 | (add-extension 54 | (make-markdown-scanner 55 | :regex (create-scanner '(:sequence eval)) 56 | :name 'eval 57 | :priority 1.5) 58 | :filter 59 | (lambda (key) (not (equal key '(code))))) 60 | (add-extension 61 | (make-markdown-scanner 62 | :regex (create-scanner '(:sequence eval-in-code)) 63 | :name 'code-eval 64 | :priority 1.5) 65 | :filter 66 | (lambda (key) (equal key '(code))))) 67 | 68 | (defmethod render-span-to-html ((code (eql 'eval)) body encoding-method) 69 | (declare (ignore encoding-method)) 70 | (render-handle-eval body)) 71 | 72 | (defmethod render-span-to-html ((code (eql 'code-eval)) body encoding-method) 73 | (declare (ignore encoding-method)) 74 | (render-handle-eval body)) 75 | 76 | (defun render-handle-eval (body) 77 | ;;?? parse out commands and arguments (deal with quoting, etc) 78 | (bind (((command arguments result _) body) 79 | (result 80 | (cond ((and (member command *render-active-functions*) 81 | (fboundp command)) 82 | (funcall command :render arguments (ensure-list result))) 83 | ((and (member command *render-active-functions*) 84 | (not (fboundp command))) 85 | (warn "Undefined CL-Markdown function ~s" command)) 86 | (t 87 | nil)))) 88 | (when result 89 | (output-html (list result)) 90 | (setf *magic-space-p* nil) 91 | (setf *magic-line-p* -1)))) 92 | 93 | (defun canonize-command (command) 94 | (intern (symbol-name command) 95 | (load-time-value (find-package :cl-markdown-user)))) 96 | 97 | (defmethod process-span ((name (eql 'eval)) registers) 98 | ;; the one register contains the command and the buffer index. 99 | (bind (((command &rest args) 100 | (%pull-arguments-from-string (first registers))) 101 | (buffer-index (and args (fixnump (first args)) (first args)))) 102 | (process-handle-eval 103 | command 104 | (or (and buffer-index 105 | (%pull-arguments-from-string 106 | (item-at (bracket-references *current-document*) 107 | buffer-index))) 108 | args)))) 109 | 110 | (defmethod process-span ((name (eql 'code-eval)) registers) 111 | ;;; the one register contains the command and all its arguments as one 112 | ;; big string we tokenize it and make sure the command exists and, if 113 | ;; it is 'active' during parsing, we call it for effect. 114 | (bind (((command &rest arguments) 115 | (%pull-arguments-from-string (first registers)))) 116 | (process-handle-eval command arguments))) 117 | 118 | (defun process-handle-eval (command arguments) 119 | (bind ((command (canonize-command command)) 120 | ((:values result processed?) 121 | (when (member command *parse-active-functions*) 122 | (if (fboundp command) 123 | (values (funcall command :parse arguments nil) t) 124 | (warn "Undefined CL-Markdown parse active function ~s" 125 | command))))) 126 | #+(or) 127 | (format t "~&~s: ~s ~a ~a" 128 | command (symbol-package command) (fboundp command) 129 | (member command *parse-active-functions*) result) 130 | `(,command ,arguments ,result ,processed?))) 131 | 132 | (defmethod process-span-in-span-p ((span-1 t) (span-2 (eql 'eval))) 133 | (values nil)) 134 | 135 | (defmethod process-span-in-span-p ((span-1 t) (span-2 (eql 'code-eval))) 136 | (values nil)) 137 | 138 | (defun %pull-arguments-from-string (string) 139 | (let ((start 0) 140 | (done (load-time-value (list :eof))) 141 | (result nil)) 142 | (loop collect 143 | (multiple-value-bind (value new-start) 144 | (ignore-errors (read-from-string string nil done :start start)) 145 | (when (eq value done) 146 | (return)) 147 | (cond ((and new-start (numberp new-start)) 148 | (setf start new-start) 149 | (push value result)) 150 | (t 151 | (incf start))))) 152 | (nreverse result))) 153 | 154 | ;;;;; 155 | 156 | #| Another extension mechanism 157 | 158 | |# 159 | 160 | (defmethod generate-link-output-for-kind 161 | ((kind (eql :glossary)) (link-info extended-link-info) text) 162 | (let ((text (if (consp text) (first text) text))) 163 | (format *output-stream* 164 | "~a" 165 | (id link-info) 166 | text 167 | text))) 168 | 169 | (defextension (glossary) 170 | (when (eq phase :render) 171 | (format *output-stream* "~&
")
172 | (format *output-stream* "~&
~%")))
188 |
189 | ;;; sort of works
190 | ;; can't use html in title
191 | (defmethod generate-link-output-for-kind
192 | ((kind (eql :abbreviation)) (link-info extended-link-info) text)
193 | (let ((output (nth-value 1 (markdown (contents link-info)
194 | :stream nil
195 | :document-class 'included-document))))
196 | (format *output-stream* "~a"
197 | output
198 | text)))
199 |
200 |
--------------------------------------------------------------------------------
/dev/dead-code/lml2.lisp:
--------------------------------------------------------------------------------
1 | (in-package #:cl-markdown)
2 |
3 | (defparameter *markup->lml2*
4 | (make-container
5 | 'simple-associative-container
6 | :test #'equal
7 | :initial-contents
8 | '((header1) (nil :h1)
9 | (header2) (nil :h2)
10 | (header3) (nil :h3)
11 | (header4) (nil :h4)
12 | (header5) (nil :h5)
13 | (header6) (nil :h6)
14 |
15 | (bullet) ((:ul) :li)
16 | (code) ((:pre :code) nil)
17 | (number) ((:ol) :li)
18 | (quote) ((:blockquote) nil)
19 | (horizontal-rule) (nil :hr))))
20 |
21 | ;;; ---------------------------------------------------------------------------
22 |
23 | (defmethod render ((document document) (style (eql :lml2)) stream)
24 | (let ((*current-document* document))
25 | (setf (level document) 0
26 | (markup document) nil)
27 | (let* ((chunks (collect-elements (chunks document)))
28 | (result (lml2-list->tree chunks)))
29 | (if stream
30 | (format stream "~S" result)
31 | result))))
32 |
33 | ;;; ---------------------------------------------------------------------------
34 |
35 | (defun lml2-marker (chunk)
36 | (bind ((markup (markup-class-for-lml2 chunk)))
37 | (first markup)))
38 |
39 | ;;; ---------------------------------------------------------------------------
40 |
41 | (defmethod render-to-lml2 ((chunk chunk))
42 | (bind ((block (collect-elements
43 | (lines chunk)
44 | :transform (lambda (line)
45 | (render-to-lml2 line))))
46 | (markup (second (markup-class-for-lml2 chunk)))
47 | (paragraph? (paragraph? chunk)))
48 | (cond ((and paragraph? markup)
49 | (values `(,markup (:P ,@block)) t))
50 | (paragraph?
51 | (values `(:P ,@block) t))
52 | (markup
53 | (values `(,markup ,@block) t))
54 | (t
55 | (values block nil)))))
56 |
57 | ;;; ---------------------------------------------------------------------------
58 |
59 | (defmethod markup-class-for-lml2 ((chunk chunk))
60 | (when (markup-class chunk)
61 | (let ((translation (item-at-1 *markup->lml2* (markup-class chunk))))
62 | (unless translation
63 | (warn "No translation for '~A'" (markup-class chunk)))
64 | translation)))
65 |
66 | ;;; ---------------------------------------------------------------------------
67 |
68 | (defmethod render-to-lml2 ((chunk list))
69 | (render-span-to-lml2 (first chunk) (rest chunk)))
70 |
71 | ;;; ---------------------------------------------------------------------------
72 |
73 | (defmethod render-to-lml2 ((chunk string))
74 | ;;?? unlovely
75 | (format nil "~A" chunk))
76 |
77 | ;;; ---------------------------------------------------------------------------
78 |
79 | (defmethod render-span-to-lml2 ((code (eql 'strong)) body)
80 | `(:strong ,@body))
81 |
82 | ;;; ---------------------------------------------------------------------------
83 |
84 | (defmethod render-span-to-lml2 ((code (eql 'mail)) body)
85 | (let ((address (first body)))
86 | `((:a :href ,(format nil "mailto:~A" address)) ,address)))
87 |
88 | ;;; ---------------------------------------------------------------------------
89 |
90 | (defmethod render-span-to-lml2 ((code (eql 'emphasis)) body)
91 | `(:em ,@body))
92 |
93 | ;;; ---------------------------------------------------------------------------
94 |
95 | (defmethod render-span-to-lml2 ((code (eql 'strong-em)) body)
96 | `(:strong (:em ,@body)))
97 |
98 | ;;; ---------------------------------------------------------------------------
99 |
100 | (defmethod render-span-to-lml2 ((code (eql 'code)) body)
101 | `(:code ,(render-to-lml2 (first body))))
102 |
103 | ;;; ---------------------------------------------------------------------------
104 |
105 | (defmethod render-span-to-lml2 ((code (eql 'entity)) body)
106 | (first body))
107 |
108 | ;;; ---------------------------------------------------------------------------
109 |
110 | (defmethod render-span-to-lml2 ((code (eql 'reference-link)) body)
111 | (bind (((text &optional (id text)) body)
112 | (link-info (item-at-1 (link-info *current-document*) id)))
113 | (if link-info
114 | `((:a :href ,(url link-info) ,@(awhen (title link-info) `(:title ,it)))
115 | ,text)
116 | `,text)))
117 |
118 | ;;; ---------------------------------------------------------------------------
119 |
120 | (defmethod render-span-to-lml2 ((code (eql 'inline-link)) body)
121 | (bind (((text &optional (url "") title) body))
122 | `((:a :href ,url ,@(awhen title `(:title ,it)))
123 | ,text)))
124 |
125 | ;;; ---------------------------------------------------------------------------
126 |
127 | (defmethod render-span-to-lml2 ((code (eql 'link)) body)
128 | (bind ((url body))
129 | `((:a :href ,@url) ,@url)))
130 |
131 | ;;; ---------------------------------------------------------------------------
132 |
133 | (defmethod render-span-to-lml2 ((code (eql 'html)) body)
134 | (html-encode:encode-for-pre (first body)))
135 |
136 |
137 |
138 | (defun lml2-list->tree (chunks &key (level nil))
139 | (unless level
140 | (setf level (or (and (first chunks) (level (first chunks))) 0)))
141 |
142 | (labels ((do-it (chunks level)
143 |
144 | ;;?? rather inpenetrable... don't understand at the level I should...
145 | (apply-mark
146 | (lml2-marker (first chunks))
147 | (let (output append? result)
148 | (loop for rest = chunks then (rest rest)
149 | for chunk = (first rest) then (first rest)
150 | while chunk
151 | for new-level = (level chunk)
152 |
153 | do (setf (values output append?) (render-to-lml2 chunk))
154 |
155 | do (format t "~%C(~D/~D): ~A, ~A" level new-level append? chunk)
156 |
157 | when (and (= level new-level) append?) do
158 | (setf result `(,output ,@result))
159 |
160 | when (and (= level new-level) (not append?)) do
161 | (setf result `(,@output ,@result))
162 |
163 | when (< level new-level) do
164 | (multiple-value-bind (block remaining method)
165 | (next-block rest new-level)
166 | (let ((inner (do-it block (1+ level))))
167 | ; (format t "~%--- ~A" method)
168 | (setf rest remaining)
169 | (ecase method
170 | (:level (if (listp (first result))
171 | (push-end inner (first result))
172 | (push inner result)))
173 | (:markup (push inner result))
174 | (:none
175 | (setf result `(,inner ,@result))))))
176 |
177 | when (> level new-level) do
178 | (warn "unexpected chunk level"))
179 | (reverse result)))))
180 | (apply #'do-it chunks level)))
181 |
182 | ;;; ---------------------------------------------------------------------------
183 |
184 | (defun apply-mark (mark rest)
185 | (cond ((null mark) rest)
186 | ((consp mark)
187 | (if (length-1-list-p mark)
188 | `(,(first mark) ,@(apply-mark (rest mark) rest))
189 | `(,(first mark) (,@(apply-mark (rest mark) rest)))))
190 | (t
191 | (error "unhandled case"))))
192 |
193 |
194 |
195 |
--------------------------------------------------------------------------------
/dev/multiple-documents.lisp:
--------------------------------------------------------------------------------
1 | (in-package #:cl-markdown)
2 |
3 | (defun markdown-many (pairs &rest args
4 | &key format additional-extensions render-extensions
5 | &allow-other-keys)
6 | "Markdown-many processes several documents simultaneously as if it
7 | was processing one large document. Its chief purpose is to make it easy to
8 | create inter-document links. Markdown-many takes as input
9 |
10 | * `pairs` - a list of lists where each sublist contains the markdown
11 | file to be processed as `input` in its first element and the name of
12 | the file to be produced as the `output`.
13 | * `:format` - a keyword argument specifying the kind of output document
14 | to produce
15 | * `:additional-extensions` - a list of extensions that should be active
16 | both while parsing and rendering.
17 | * `:render-extensions` - a list of extensions that should be active
18 | during rendering.
19 |
20 | Here is an example: suppose document-1.md contains
21 |
22 | # Document-1
23 |
24 | See [document-2][] for details.
25 |
26 | and document-2.md contains
27 |
28 | # Document 2
29 |
30 | [Document-1][] provides an overview.
31 |
32 | Getting these links to work using only Markdown will require added explicit
33 | reference link information that will be tied to the file _names_. Markdown-many,
34 | on the other hand, will automatically combine the link information and
35 | processes it automatically.
36 | "
37 | (let ((main-document (make-instance 'multi-document))
38 | (docs nil))
39 | (setf docs
40 | (loop for datum in pairs collect
41 | (bind (((source destination &rest doc-args) datum))
42 | (format t "~&Parsing: ~s~%" source)
43 | (list (apply #'markdown source
44 | :document-class 'child-document
45 | :parent main-document
46 | :format :none (merge-arguments args doc-args))
47 | destination))))
48 | ;; transfer information from docs to the parent
49 | (loop for (doc destination) in docs do
50 | (transfer-document-data main-document doc destination))
51 | ;; render 'em
52 | (loop for (doc destination) in docs do
53 | (format t "~&Rendering: ~s" destination)
54 | (let ((*current-document* doc)
55 | (*render-active-functions*
56 | (mapcar #'canonize-command
57 | (or render-extensions
58 | (if additional-extensions
59 | `(,@additional-extensions
60 | ,@*render-active-functions*)
61 | *render-active-functions*)))))
62 | (render-to-stream doc format destination)))
63 | (setf (children main-document) (mapcar #'first docs))
64 | (values main-document docs)))
65 |
66 | (defun merge-arguments (args-1 args-2)
67 | (let ((result args-1))
68 | (map-window-over-elements
69 | args-2 2 2
70 | (lambda (pair)
71 | (bind (((key value) pair)
72 | (present (getf result key)))
73 | (setf (getf result key)
74 | (if present
75 | (append (ensure-list present) (ensure-list value))
76 | value)))))
77 | result))
78 |
79 | #+(or)
80 | (merge-arguments '(:a (1) :b (2)) '(:c (3) :a (2)))
81 |
82 | #+(or)
83 | (defun _render-one (doc)
84 | (let ((*current-document* doc)
85 | (*render-active-functions*
86 | (mapcar #'canonize-command
87 | `(cl-markdown::docs cl-markdown::docs-index
88 | cl-markdown::today cl-markdown::now
89 | cl-markdown::glossary
90 | ,@*render-active-functions*))))
91 | (render-to-stream doc :html #p"/tmp/one.html")))
92 |
93 | #+(or)
94 | (untrace markdown)
95 |
96 | #+(or)
97 | (compile 'markdown-many)
98 |
99 | #+(or)
100 | (cl-markdown:markdown-many
101 | `((,(system-relative-pathname 'cl-markdown "dev/md1.md")
102 | ,(system-relative-pathname 'cl-markdown "dev/md1.html"))
103 | (,(system-relative-pathname 'cl-markdown "dev/md2.md")
104 | ,(system-relative-pathname 'cl-markdown "dev/md2.html")))
105 | :format :html)
106 |
107 | (defun transfer-document-data (parent child destination)
108 | (transfer-link-info parent child destination)
109 | (transfer-selected-properties
110 | parent child
111 | (set-difference (collect-keys (properties child))
112 | (list :footnote :style-sheet :style-sheets :title)))
113 | (transfer-document-metadata parent child))
114 |
115 | (defun transfer-document-metadata (parent child)
116 | (iterate-key-value
117 | (metadata child)
118 | (lambda (key value)
119 | ; (print (list :p (item-at-1 (metadata parent) key)
120 | ; :c value))
121 | (aif (item-at-1 (metadata parent) key)
122 | (setf (item-at-1 (metadata parent) key) (merge-entries it value))
123 | (setf (item-at-1 (metadata parent) key) value)))))
124 |
125 |
126 | (defun transfer-selected-properties (parent child properties)
127 | (let ((*current-document* parent))
128 | (iterate-elements
129 | properties
130 | (lambda (property)
131 | (when (item-at-1 (properties child) property)
132 | (setf (document-property property)
133 | (first (item-at-1 (properties child) property))))))))
134 |
135 | (defun transfer-link-info (parent child destination)
136 | (let ((*current-document* parent))
137 | (iterate-key-value
138 | (link-info child)
139 | (lambda (id info)
140 | (setf (item-at (link-info parent) id)
141 | (transfer-1-link-info info parent child destination))))))
142 |
143 | (defgeneric transfer-1-link-info (info parent child destination))
144 |
145 | (defmethod transfer-1-link-info ((info link-info) parent child destination)
146 | (declare (ignore parent child))
147 | (make-instance 'link-info
148 | :id (id info)
149 | :url (if (relative-url-p (url info))
150 | (format nil "~@[~a~]~@[.~a~]~a"
151 | (pathname-name destination)
152 | (pathname-type destination)
153 | (url info))
154 | (url info))
155 | :title (title info)
156 | :properties (properties info)))
157 |
158 | (defun relative-url-wrt-destination (url destination)
159 | (if (relative-url-p url)
160 | (format nil "~@[~a~]~@[.~a~]~a"
161 | (pathname-name destination)
162 | (pathname-type destination)
163 | url)
164 | url))
165 |
166 | (defun relative-url-p (url)
167 | ;; FIXME -- look at the spec...
168 | (not
169 | (or (starts-with url "http:")
170 | (starts-with url "mailto:")
171 | (starts-with url "file:"))))
172 |
173 | (defmethod transfer-1-link-info ((info extended-link-info)
174 | parent child destination)
175 | (declare (ignore parent child destination))
176 | (make-instance 'extended-link-info
177 | :id (id info)
178 | :kind (kind info)
179 | :contents (contents info)))
180 |
181 |
182 | ;;;
183 |
184 |
185 | ;; A slightly horrid hack that is good enough for indices but
186 | ;; completely untested
187 | (defgeneric ugly-create-from-template (thing)
188 | )
189 |
190 | (defmethod ugly-create-from-template ((thing standard-object))
191 | (make-instance (class-of thing)))
192 |
193 | (defgeneric merge-entries (a b)
194 | (:documentation "Returns a new container C \(of the same type as `a`\)
195 | such that C contains every *entry* in a and b. C may share structure with
196 | `a` and `b`."))
197 |
198 | (defmethod merge-entries :around ((a t) (b t))
199 | ; (print (list :me a b))
200 | (call-next-method))
201 |
202 | (defmethod merge-entries ((a null) (b t))
203 | b)
204 |
205 | (defmethod merge-entries ((a null) (b iteratable-container-mixin))
206 | (error "not implemented"))
207 |
208 | (defmethod merge-entries ((a null) (b key-value-iteratable-container-mixin))
209 | (merge-using-key-value (ugly-create-from-template b) b))
210 |
211 | (defmethod merge-entries ((a t) (b t))
212 | (cond ((and (key-value-iteratable-p a)
213 | (key-value-iteratable-p b))
214 | #+(or)
215 | (merge-key-value-via-iteration a b)
216 | (error "not implemented"))
217 | ((and (iteratable-p a)
218 | (iteratable-p b))
219 | (merge-elements-via-iteration a b))
220 | (t
221 | ;; FIXME - drop b?
222 | a)))
223 |
224 | (defmethod merge-entries ((a list) (b t))
225 | (append a (list b)))
226 |
227 | (defmethod merge-entries ((a list) (b list))
228 | (merge-elements-via-iteration a b))
229 |
230 | (defmethod merge-entries ((a iteratable-container-mixin)
231 | (b iteratable-container-mixin))
232 | (merge-elements-via-iteration a b))
233 |
234 | (defmethod merge-entries
235 | ((a key-value-iteratable-container-mixin)
236 | (b key-value-iteratable-container-mixin))
237 | (let ((new (ugly-create-from-template a)))
238 | (merge-using-key-value new a)
239 | (merge-using-key-value new b)
240 | new))
241 |
242 | (defun merge-elements-via-iteration (a b)
243 | (let ((new (ugly-create-from-template a)))
244 | (iterate-elements a (lambda (elt) (insert-item new elt)))
245 | (iterate-elements b (lambda (elt) (insert-item new elt)))
246 | new))
247 |
248 | (defun merge-using-key-value (a b)
249 | (iterate-key-value b (lambda (key value)
250 | (let ((existing (item-at a key)))
251 | (setf (item-at a key)
252 | (if existing
253 | (merge-entries existing value)
254 | value)))))
255 | a)
256 |
--------------------------------------------------------------------------------
/unit-tests/markdown-tests/Markdown Documentation - Basics.text:
--------------------------------------------------------------------------------
1 | Markdown: Basics
2 | ================
3 |
4 |
11 |
12 |
13 | Getting the Gist of Markdown's Formatting Syntax
14 | ------------------------------------------------
15 |
16 | This page offers a brief overview of what it's like to use Markdown.
17 | The [syntax page] [s] provides complete, detailed documentation for
18 | every feature, but Markdown should be very easy to pick up simply by
19 | looking at a few examples of it in action. The examples on this page
20 | are written in a before/after style, showing example syntax and the
21 | HTML output produced by Markdown.
22 |
23 | It's also helpful to simply try Markdown out; the [Dingus] [d] is a
24 | web application that allows you type your own Markdown-formatted text
25 | and translate it to XHTML.
26 |
27 | **Note:** This document is itself written using Markdown; you
28 | can [see the source for it by adding '.text' to the URL] [src].
29 |
30 | [s]: /projects/markdown/syntax "Markdown Syntax"
31 | [d]: /projects/markdown/dingus "Markdown Dingus"
32 | [src]: /projects/markdown/basics.text
33 |
34 |
35 | ## Paragraphs, Headers, Blockquotes ##
36 |
37 | A paragraph is simply one or more consecutive lines of text, separated
38 | by one or more blank lines. (A blank line is any line that looks like a
39 | blank line -- a line containing nothing spaces or tabs is considered
40 | blank.) Normal paragraphs should not be intended with spaces or tabs.
41 |
42 | Markdown offers two styles of headers: *Setext* and *atx*.
43 | Setext-style headers for `- ")
173 | (iterate-key-value
174 | (link-info *current-document*)
175 | (lambda (key link)
176 | (when (and (typep link 'extended-link-info)
177 | (eq (kind link) :glossary))
178 | (format *output-stream* "~&
- ~a
- " key (id link)) 179 | (markdown (contents link) 180 | :stream *output-stream* 181 | :format *current-format* 182 | :properties '((:html . nil) 183 | (:omit-final-paragraph . t) 184 | (:omit-initial-paragraph . t)) 185 | :document-class 'included-document) 186 | (format *output-stream* " ")))) 187 | (format *output-stream* "
` and `` are created by
44 | "underlining" with equal signs (`=`) and hyphens (`-`), respectively.
45 | To create an atx-style header, you put 1-6 hash marks (`#`) at the
46 | beginning of the line -- the number of hashes equals the resulting
47 | HTML header level.
48 |
49 | Blockquotes are indicated using email-style '`>`' angle brackets.
50 |
51 | Markdown:
52 |
53 | A First Level Header
54 | ====================
55 |
56 | A Second Level Header
57 | ---------------------
58 |
59 | Now is the time for all good men to come to
60 | the aid of their country. This is just a
61 | regular paragraph.
62 |
63 | The quick brown fox jumped over the lazy
64 | dog's back.
65 |
66 | ### Header 3
67 |
68 | > This is a blockquote.
69 | >
70 | > This is the second paragraph in the blockquote.
71 | >
72 | > ## This is an H2 in a blockquote
73 |
74 |
75 | Output:
76 |
77 | A First Level Header
78 |
79 | A Second Level Header
80 |
81 |
A First Level Header
78 | 79 |A Second Level Header
80 | 81 |Now is the time for all good men to come to 82 | the aid of their country. This is just a 83 | regular paragraph.
84 | 85 |The quick brown fox jumped over the lazy 86 | dog's back.
87 | 88 |Header 3
89 | 90 |91 |97 | 98 | 99 | 100 | ### Phrase Emphasis ### 101 | 102 | Markdown uses asterisks and underscores to indicate spans of emphasis. 103 | 104 | Markdown: 105 | 106 | Some of these words *are emphasized*. 107 | Some of these words _are emphasized also_. 108 | 109 | Use two asterisks for **strong emphasis**. 110 | Or, if you prefer, __use two underscores instead__. 111 | 112 | Output: 113 | 114 |This is a blockquote.
92 | 93 |This is the second paragraph in the blockquote.
94 | 95 |This is an H2 in a blockquote
96 |
Some of these words are emphasized. 115 | Some of these words are emphasized also.
116 | 117 |Use two asterisks for strong emphasis. 118 | Or, if you prefer, use two underscores instead.
119 | 120 | 121 | 122 | ## Lists ## 123 | 124 | Unordered (bulleted) lists use asterisks, pluses, and hyphens (`*`, 125 | `+`, and `-`) as list markers. These three markers are 126 | interchangable; this: 127 | 128 | * Candy. 129 | * Gum. 130 | * Booze. 131 | 132 | this: 133 | 134 | + Candy. 135 | + Gum. 136 | + Booze. 137 | 138 | and this: 139 | 140 | - Candy. 141 | - Gum. 142 | - Booze. 143 | 144 | all produce the same output: 145 | 146 |-
147 |
- Candy. 148 |
- Gum. 149 |
- Booze. 150 |
-
162 |
- Red 163 |
- Green 164 |
- Blue 165 |
` tags for the 168 | list item text. You can create multi-paragraph list items by indenting 169 | the paragraphs by 4 spaces or 1 tab: 170 | 171 | * A list item. 172 | 173 | With multiple paragraphs. 174 | 175 | * Another item in the list. 176 | 177 | Output: 178 | 179 |
-
180 |
A list item.
181 |With multiple paragraphs.
182 | Another item in the list.
183 |
This is an 201 | example link.
202 | 203 | Optionally, you may include a title attribute in the parentheses: 204 | 205 | This is an [example link](http://example.com/ "With a Title"). 206 | 207 | Output: 208 | 209 |This is an 210 | example link.
211 | 212 | Reference-style links allow you to refer to your links by names, which 213 | you define elsewhere in your document: 214 | 215 | I get 10 times more traffic from [Google][1] than from 216 | [Yahoo][2] or [MSN][3]. 217 | 218 | [1]: http://google.com/ "Google" 219 | [2]: http://search.yahoo.com/ "Yahoo Search" 220 | [3]: http://search.msn.com/ "MSN Search" 221 | 222 | Output: 223 | 224 |I get 10 times more traffic from Google than from Yahoo or MSN.
228 | 229 | The title attribute is optional. Link names may contain letters, 230 | numbers and spaces, but are *not* case sensitive: 231 | 232 | I start my morning with a cup of coffee and 233 | [The New York Times][NY Times]. 234 | 235 | [ny times]: http://www.nytimes.com/ 236 | 237 | Output: 238 | 239 |I start my morning with a cup of coffee and 240 | The New York Times.
241 | 242 | 243 | ### Images ### 244 | 245 | Image syntax is very much like link syntax. 246 | 247 | Inline (titles are optional): 248 | 249 |  250 | 251 | Reference-style: 252 | 253 | ![alt text][id] 254 | 255 | [id]: /path/to/img.jpg "Title" 256 | 257 | Both of the above examples produce the same output: 258 | 259 |
260 |
261 |
262 |
263 | ### Code ###
264 |
265 | In a regular paragraph, you can create code span by wrapping text in
266 | backtick quotes. Any ampersands (`&`) and angle brackets (`<` or
267 | `>`) will automatically be translated into HTML entities. This makes
268 | it easy to use Markdown to write about HTML example code:
269 |
270 | I strongly recommend against using any `