Commit 9f73f074 authored by Dave Cooper's avatar Dave Cooper
Browse files

Fixes cl-markdown TOC crash and issue with directory source listing.

1. cl-markdown was crashing on its TOC processing on CL
   implementations (e.g. SBCL 1.4.*+) which have DESTRUCTURING-BIND
   treat non-toplevel () as a nested empty pattern, rather than just a
   shorthand for an ignored item as sometimes was being done in older,
   non-conforming code. The patch introduced by this commit fixes
   these non-comforming instances in CL-MARKDOWN. Note that
   CL-MARKDOWN is not using multiple-value-bind directly, but rather
   relies on the "metabang.bind" system - so maybe it can be fixed
   there. As noted in patches.lisp, a merge request has been lodged
   against cl-markdown. They are the same author as metabang.bind, so
   they can decide whether to accept this MR or fix it in
   metabang.bind instead.

2. On some implementations, the `process-static` function in
   `process.lisp` was spuriously picking up subdirectories in its
   `sources` list (where it expected just a list of source files). Now
   we are filtering out anything which looks like a directory (i.e. a
   non-file directory entry) by using
   `uiop:/filesystem:directory-exists-p`.
parent 8fa6d5e6
;;;; -*-Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
(in-package :cl-site)
;;
;; This file contains patches against depended-upon libraries. These
;; should be removed if/when the Quicklisp version of the libraries
;; are fixed. Common-Lisp.Net policy dictates (or should dictate)
;; than any patches listed here have also been lodged as merge
;; requests or pull requests against the maintained repository of the
;; library in question.
;;
;;
;; CL-MARKDOWN patches.
;;
;; Merge Request has been lodged here:
;;
;; https://gitlab.common-lisp.net/cl-markdown/cl-markdown/merge_requests/1
;;
;;
;;
(in-package :cl-markdown)
(defextension (table-of-contents :arguments ((depth :required :keyword)
(start :required :keyword)
(label :keyword))
:insertp t)
(ecase phase
(:parse
(push (lambda (document)
(add-toc-anchors document :depth depth :start start))
(item-at-1 (properties *current-document*) :cleanup-functions))
nil)
(:render
(bind ((headers (collect-toc-headings depth start)))
(when headers
(format *output-stream*
"~&<a name='table-of-contents' id='table-of-contents'></a>")
(format *output-stream* "~&<div class='table-of-contents'>~%")
(when label
(format *output-stream* "<h1>~a</h1>" label))
(iterate-elements
headers
(lambda (header)
(bind (((item anchor text)
(item-at-1 (properties header) :anchor))
(save-header-lines (copy-list (lines header))))
(declare (ignore item))
(setf (slot-value header 'lines)
`(,(format nil
"~&<a href='~a~a' ~@[title='~a'~]>"
(if (char= (aref anchor 0) #\#) "" "#")
anchor
(encode-string-for-title text))
,@(lines header)
,(format nil "</a>")))
(render-to-html header nil)
(setf (slot-value header 'lines)
save-header-lines))))
(format *output-stream* "~&</div>~%"))))))
(defun render-handle-eval (body)
;;?? parse out commands and arguments (deal with quoting, etc)
(bind (((command arguments result processed?) body)
(result
(cond ((and (member command *render-active-functions*)
(fboundp command))
(funcall command :render arguments (ensure-list result)))
((and (member command *render-active-functions*)
(not (fboundp command)))
(warn "Undefined CL-Markdown function ~s" command))
(t
nil))))
(declare (ignore processed?))
(when result
(output-html (list result))
(setf *magic-space-p* nil)
(setf *magic-line-p* -1))))
;;
;; end of CL-MARKDOWN patches.
;;
(in-package :cl-site)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment