- removed '*use-tk-for-decoding-png*'.

src/html-utils.lisp

@@ -17,6 +17,14 @@
 
 (in-package :html-utils)
 
+(define-constant +tag-bold+           "b" :test #'string=)
+
+(define-constant +tag-italic+         "i" :test #'string=)
+
+(define-constant +tag-emphasis+       "em" :test #'string=)
+
+(define-constant +tag-strong+         "strong" :test #'string=)
+
 (define-constant +tag-link+           "a" :test #'string=)
 
 (define-constant +tag-break+          "br" :test #'string=)
@@ -116,6 +124,8 @@
 
 (defparameter *ordered-list-item-number* 0)
 
+(defparameter *indentation-level* "")
+
 (defun append-footnote-reference (text reference-number)
   (strcat text
           (format nil
@@ -134,6 +144,17 @@
   (defun strip-footnote-reference (word)
     (cl-ppcre:regex-replace scanner word "")))
 
+(defun block-tag-p (node)
+  (and (consp node)
+       (member node
+               (list +tag-break+
+                     +tag-paragraph+
+                     +tag-ordered-list+
+                     +tag-unordered-list+
+                     +tag-div+
+                     +tag-blockquote+)
+               :test (lambda (a b) (tag= b a)))))
+
 (defun html->text (html &key
                           (add-link-footnotes t) (body-footnotes-separator "")
                           (quote-prefix "> ") (list-item-prefix "* "))
@@ -153,12 +174,46 @@ Some convenience functions are provided to works with these structures.
           (footnotes  (misc:make-fresh-array 0 #\a 'character nil)))
       (with-output-to-string (body-stream body)
         (with-output-to-string (footnotes-stream footnotes)
-          (format footnotes-stream "~2%")
-          (labels ((descend-children (node)
-                     (loop for child in (children node) do
-                          (descend child)))
-                   (descend (node)
+          (labels ((print-line-break ()
+                     (format body-stream "~%"))
+                   (print-line-break-maybe ()
+                     (format body-stream "~&"))
+                   (wrap-bold (node)
+                     (format body-stream "*")
+                     (descend-children node)
+                     (format body-stream "*"))
+                   (wrap-italic (node)
+                     (format body-stream "/")
+                     (descend-children node)
+                     (format body-stream "/"))
+                   (wrap-emphasis (node)
+                     (format body-stream "_")
+                     (descend-children node)
+                     (format body-stream "_"))
+                   (inc-indent (&optional (size 1))
+                     (setf *indentation-level*
+                           (strcat *indentation-level*
+                                   (make-string size :initial-element #\space))))
+                   (dec-indent (&optional (size 1))
+                     (when (>= (length *indentation-level*)
+                               size)
+                       (setf *indentation-level*
+                             (subseq *indentation-level* size))))
+                   (print-indent (stream)
+                     ;; (write-string (format nil "~a" (length *indentation-level*)) stream)
+                     (write-string *indentation-level* stream))
+                   (descend-children (node)
+                     (loop
+                       for count from 0
+                       for child in (children node) do
+                         (if (block-tag-p node)
+                             (descend child t)
+                             (descend child nil))))
+
+                   (descend (node &optional (print-indent t))
                      (when node
+                       (when print-indent
+                         (print-indent body-stream))
                        (cond
                          ((stringp node)
                           (princ node body-stream))
@@ -180,44 +235,61 @@ Some convenience functions are provided to works with these structures.
                             (when add-link-footnotes
                               (write-string (append-footnote-reference "" link-count)
                                             body-stream))))
+                         ((or (tag= +tag-bold+ node)
+                              (tag= +tag-strong+ node))
+                          (wrap-bold node))
+                         ((tag= +tag-italic+ node)
+                          (wrap-italic node))
+                         ((tag= +tag-emphasis+ node)
+                          (wrap-emphasis node))
                          ((tag= +tag-break+ node)
                           (let ((*block-tag* nil))
-                            (format body-stream "~%")
+                            (print-line-break)
                             (descend-children node)))
                          ((or (tag= +tag-paragraph+ node)
                               (tag= +tag-div+       node))
                           (let ((*block-tag* t))
-                            (format body-stream "~%")
+                            (print-line-break)
                             (when *block-tag*
                               (loop for i from 0 below *quote-level* do
                                 (princ *prefix-text-line* body-stream)))
                             (descend-children node)
-                            (format body-stream "~%")))
+                            (print-line-break)))
                          ((tag= +tag-unordered-list+ node)
                           (let ((*ordered-list*   nil)
                                 (*unordered-list* t))
-                            (descend-children node)))
+                            (print-line-break-maybe)
+                            (inc-indent)
+                            (descend-children node)
+                            (dec-indent)))
                          ((tag= +tag-ordered-list+ node)
                           (let ((*ordered-list*   t)
                                 (*unordered-list* nil)
                                 (*ordered-list-item-number* 0))
-                            (descend-children node)))
+                            (print-line-break-maybe)
+                            (inc-indent)
+                            (descend-children node)
+                            (dec-indent)))
                          ((tag= +tag-list-item+ node)
                           (let ((*block-tag* nil))
                             (cond
                               (*unordered-list*
+                               (inc-indent (length list-item-prefix))
                                (format body-stream list-item-prefix)
                                (descend-children node)
-                               (format body-stream "~%"))
+                               (dec-indent (length list-item-prefix))
+                               (print-line-break-maybe))
                               (*ordered-list*
                                (incf *ordered-list-item-number*)
+                               (inc-indent (length list-item-prefix))
                                (format body-stream "~a." *ordered-list-item-number*)
                                (descend-children node)
-                               (format body-stream "~%"))
+                               (dec-indent (length list-item-prefix))
+                               (print-line-break))
                               (t
                                (format body-stream "unknown list type ")
                                (descend-children node)
-                               (format body-stream "~%")))))
+                               (print-line-break)))))
                          ((tag= +tag-blockquote+ node)
                           (let ((*prefix-text-line* quote-prefix)
                                 (*quote-level* (1+ *quote-level*))
@@ -227,7 +299,10 @@ Some convenience functions are provided to works with these structures.
                           (descend-children node))))))
             (descend root)
             (if add-link-footnotes
-                (strcat body body-footnotes-separator footnotes)
+                (strcat body
+                        (format nil "~%")
+                        body-footnotes-separator
+                        footnotes)
                 body)))))))
 
 (defun extract-shotcodes (file)