blob: 37b341cc4c7b05558c025209417ccbdc052cf381 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
(defpackage :org-toc
(:use :cl :parzival))
(in-package :org-toc)
(<<def <toc-line<
(<<bind (<<counting+ (<<char #\*))
(lambda (count)
(<<map (lambda (matched)
(let ((toc-entry (concatenate 'string matched)))
(format nil "~a- [[~a][~a]]"
(make-string (* 2 count) :initial-element #\Space)
toc-entry
toc-entry)))
(<<and <whitespace+< (<<+ <item<)))))
"Accepts a valid Org Mode heading and results in an org mode
list item with a link to that heading.")
(<<def <gitnub-toc-line<
(labels ((make-href-text (chars)
(string-downcase
(concatenate 'string (loop :for char :in chars
:when (alphanumericp char)
:collect char
:when (eql #\Space char)
:collect #\-))))
(format-entry (depth)
(lambda (matched)
(let ((anchor-text (concatenate 'string matched))
(href-text (make-href-text matched))
(indent (make-string (* 2 (1- depth)) :initial-element #\Space)))
(format nil "~a- [[#~a][~a]]"
indent
href-text
anchor-text)))))
(<<bind (<<counting+ (<<char #\*))
(lambda (depth)
(<<map (format-entry depth)
(<<and <whitespace+< (<<+ <item<)))))))
(defun print-toc-for (file &key (output *standard-output*) for-github)
"Prints a table of contents for a given org file to the supplied stream."
(with-open-file (input file)
(loop
:for line = (read-line input nil nil)
:while line
:do (multiple-value-bind (entry success-p)
(parse line
(if for-github <gitnub-toc-line< <toc-line<)
t)
(when success-p (format output "~a~%" entry))))))
|
