From 36903029ac18d779ea4d56021ff644ee1d75f787 Mon Sep 17 00:00:00 2001
From: Colin Okay <cbeok@protonmail.com>
Date: Sun, 26 Apr 2020 20:20:59 -0500
Subject: org mode toc gen for github

---
 examples/org-mode-toc.lisp | 29 +++++++++++++++++++++++++++--
 1 file changed, 27 insertions(+), 2 deletions(-)

diff --git a/examples/org-mode-toc.lisp b/examples/org-mode-toc.lisp
index d88822e..37b341c 100644
--- a/examples/org-mode-toc.lisp
+++ b/examples/org-mode-toc.lisp
@@ -16,11 +16,36 @@
        "Accepts a valid Org Mode heading and results in an org mode
        list item with a link to that heading.")
 
-(defun print-toc-for (file &optional (output *standard-output*))
+(<<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 <toc-line< t)
+       :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))))))
-- 
cgit v1.2.3