1(in-package #:cl-markdown)
2
3#|
4To 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
10Footnotes
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
20linefeeds, *mark-up*, and \\\"escaped\\\" quotes.
21I'll be wicked surprised if it works out of the
22box.\"
23")
24
25Need to
26
271. get a number
282. add link where the footnote starts
293. add anchor where the footnote starts
304. add footnote text at bottom of document / separate page
315. add link back to anchor in footnote
32
33Our footnote HTML is so heavily influenced by DF that you might think
34we just copied it all.
35
36(markdown "
37Maybe people{footnote Well, at least one person} find CL-Markdown
38to be the bees knees, the cats pajamas and the gnats goulash. In
39fact, if computers could dance, you could tell that one had
40CL-Markdown installed on it just by watching.{footnote Not really.}
41
42{footnotes}
43
44This 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		   "<sup><a href=\"#~a\">~d</a></sup>"
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* "~&<div class=\"footnotes\">")
102       (format *output-stream* "~&<ol>")
103       (iterate-elements
104	(document-property :footnote)
105	(lambda (footnote)
106	  (format *output-stream* "~&<li>")
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* "<a href=\"#~a\" class=\"footnoteBacklink\""
116		  (reference-name footnote))
117	  (format *output-stream*
118		  " title=\"Jump back to footnote ~d in the text\""
119		  (1+ (id footnote)))
120	  (format *output-stream* ">&#8617;</a></li>")))
121       (format *output-stream*
122	       "~&</ol>~&</div>")))))
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
165ok")
166
167#+(or)
168(scan-to-strings
169 (create-scanner 'footnote-label)
170 " [a]> \"why are you here?
171I am here because that is why.
172
173OK? ok!\"")
174
175|#