Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

pre and code blocks now processed separately from other wiki markup

  • Loading branch information...
commit 4c8259cf32300456fa52e74a6dcc38d4e6a72de1 1 parent 01a028a
Vladimir Sedach authored September 03, 2012

Showing 1 changed file with 61 additions and 21 deletions. Show diff stats Hide diff stats

  1. 82  src/markup.lisp
82  src/markup.lisp
@@ -36,26 +36,67 @@
36 36
 
37 37
 (defun generate-html-from-markup (markup)
38 38
   #H[<div id="article">]
39  
-  (princ (colorize-code
40  
-          (ppcre:regex-replace-all
41  
-           "\\n\\n"
42  
-           (sanitize:clean
43  
-            (parse-cliki-markup
44  
-             (escape-parens-in-href-links markup))
45  
-            +cliki-tags+)
46  
-           "<p>"))
47  
-         *html-stream*)
  39
+  (let ((start 0)
  40
+        tag-start
  41
+        close-tag)
  42
+      (labels ((find-tag (tag start)
  43
+                 (search tag markup :start2 start :test #'string-equal))
  44
+               (find-next-tag (start)
  45
+                 (let ((next-pre  (find-tag "<pre>" start))
  46
+                       (next-code (find-tag "<code" start))
  47
+                       min)
  48
+                   (when next-pre
  49
+                     (setf close-tag "</pre>"
  50
+                           min       next-pre))
  51
+                   (when next-code
  52
+                     (unless (and next-pre (< next-pre next-code))
  53
+                       (setf close-tag "</code>"
  54
+                             min       next-code)))
  55
+                   min)))
  56
+        (loop while (setf tag-start (find-next-tag start))
  57
+              do (write-string (parse-markup-fragment markup start tag-start)
  58
+                               *html-stream*)
  59
+                 (setf start (+ (length close-tag)
  60
+                                (or (find-tag close-tag tag-start)
  61
+                                    (return))))
  62
+                 (write-string (funcall (if (equal close-tag "</pre>")
  63
+                                            #'escape-pre-block
  64
+                                            #'markup-code)
  65
+                                        markup tag-start start)
  66
+                               *html-stream*)))
  67
+      (write-string (parse-markup-fragment markup start (length markup))
  68
+                    *html-stream*))
48 69
   #H[</div>])
49 70
 
50  
-(defun escape-parens-in-href-links (markup)
  71
+(defun parse-markup-fragment (markup start end)
51 72
   (ppcre:regex-replace-all
52  
-    #?/(href|HREF)="(.*?)"/
  73
+   "\\n\\n"
  74
+   (sanitize:clean
  75
+    (cl-ppcre:regex-replace-all
  76
+     "< "
  77
+     (parse-cliki-markup
  78
+      (escape-parens-in-href-links markup start end))
  79
+     "&lt; ")
  80
+    +cliki-tags+)
  81
+   "<p>"))
  82
+
  83
+(defun escape-pre-block (markup start end)
  84
+  (ppcre:regex-replace
  85
+     "<(?:PRE|pre)>((?:.|\\n)*?)</(?:PRE|pre)>" markup
  86
+     (lambda (match preformatted)
  87
+       (declare (ignore match))
  88
+       #?[<pre>${(escape-for-html preformatted)}</pre>])
  89
+     :simple-calls t :start start :end end))
  90
+
  91
+(defun escape-parens-in-href-links (markup start end)
  92
+  (ppcre:regex-replace-all
  93
+    #?/(?:href|HREF)="(.*?)"/
53 94
     markup
54  
-    (lambda (match href url)
55  
-      (declare (ignore match href))
  95
+    (lambda (match url)
  96
+      (declare (ignore match))
56 97
       (format nil "href=\"~A\""
57 98
         (cl-ppcre:regex-replace-all "\\(|\\)" url #'uri-encode :simple-calls t)))
58  
-    :simple-calls t))
  99
+    :simple-calls t :start start :end end))
59 100
 
60 101
 (defun parse-cliki-markup (markup)
61 102
   (loop for prefix in '("_" "_H" "\\*" "\\/" "_P")
@@ -95,15 +136,13 @@
95 136
 (defun format-package-link (link) ;; _P(
96 137
   #H[<a href="${link}">ASDF-install package (obsolete) ${link}</a>])
97 138
 
98  
-;;;; do something with code-block
99  
-
100 139
 (let ((supported-langs (sort (mapcar (lambda (x)
101 140
                                        (symbol-name (car x)))
102 141
                                      colorize::*coloring-types*)
103 142
                              #'> :key #'length)))
104  
-  (defun colorize-code (markup)
105  
-    (ppcre:regex-replace-all
106  
-     "<code(.*?)?>((?:.|\\n)*?)</code>" markup
  143
+  (defun markup-code (markup start end)
  144
+    (ppcre:regex-replace
  145
+     "<(?:CODE|code)(.*?)?>((?:.|\\n)*?)</(?:CODE|code)>" markup
107 146
      (lambda (match maybe-lang code)
108 147
        (declare (ignore match))
109 148
        (let ((lang (loop for lang in supported-langs
@@ -111,5 +150,6 @@
111 150
                          return (find-symbol lang :keyword))))
112 151
          (if lang
113 152
              #?[<div class="code">${(colorize::html-colorization lang code)}</div>]
114  
-             #?[<code>${code}</code>])))
115  
-     :simple-calls t)))
  153
+             #?[<code>${(escape-for-html code)}</code>])))
  154
+     :simple-calls t :start start :end end)))
  155
+

0 notes on commit 4c8259c

Please sign in to comment.
Something went wrong with that request. Please try again.