Skip to content


Subversion checkout URL

You can clone with
Download ZIP
Tree: 35ec483e35
Fetching contributors…

Cannot retrieve contributors at this time

132 lines (119 sloc) 5.791 kB
(in-package #:cliki2)
(in-readtable cliki2)
(defclass wiki-diff (diff:diff) ()
:window-class 'wiki-diff-window))
(defclass wiki-diff-window (diff:diff-window) ())
(defun choose-chunks (chunks a b c)
(loop for chunk in chunks appending
(let ((kind (diff:chunk-kind chunk))
(lines (diff:chunk-lines chunk)))
(cond ((or (eq kind :common) (eq kind a)) lines)
((eq kind b) (list (format nil "~{~&~A~}" lines)))
((eq kind c) (make-list (length lines)))))))
(defun compare-strings (original modified)
(labels ((str2arr (str)
(map 'simple-vector #'char-code str))
(wrt (str out start end)
(loop for i from start below end
for ch = (char str i) do
(if (char= ch #\Newline)
(write-line "<br />" out)
(write-char ch out))))
(fmt (regions str offset-fun length-fun)
(with-output-to-string (out)
(loop for reg in regions
for modified-p = (typep reg 'diff:modified-diff-region)
for start = (funcall offset-fun reg)
for end = (+ start (funcall length-fun reg)) do
(progn (when modified-p
(princ "<span style=\"color:red;\">" out))
(wrt str out start end)
(when modified-p (princ "</span>" out)))))))
(let ((rawdiff (diff:compute-raw-diff (str2arr original)
(str2arr modified))))
(values (fmt rawdiff original #'diff:original-start #'diff:original-length)
(fmt rawdiff modified #'diff:modified-start #'diff:modified-length)))))
(defmethod diff:render-diff-window :before ((window wiki-diff-window) *html-stream*)
<td /><td class="diff-line-number">Line ${(diff:original-start-line window)}:</td>
<td /><td class="diff-line-number">Line ${(diff:modified-start-line window)}:</td>
(defmethod diff:render-diff-window ((window wiki-diff-window) *html-stream*)
(labels ((escape (x) (when x (escape-for-html x)))
(td (line dash class style)
(if line
#H[<td class="diff-marker">${dash}</td>
<td class="${class}" style="${style}">${line}</td>]
#H[<td class="diff-marker" /><td />]))
(diff-line (original modified)
(td original "-" "diff-deleteline" "background-color: #FFA;")
(td modified "+" "diff-addline" "background-color: #CFC;")))
(loop for original in (choose-chunks (diff:window-chunks window) :delete :replace :create)
for modified in (choose-chunks (diff:window-chunks window) :create :insert :delete) do
(let ((original (escape original))
(modified (escape modified)))
(if (and original modified)
(if (string= original modified)
#H[<td class="diff-marker" style="height:4px;"/>
<td class="diff-context" style="background-color: #EEE;">${original}</td>
<td class="diff-marker" />
<td class="diff-context" style="background-color: #EEE;">${original}</td>]
(multiple-value-call #'diff-line
(compare-strings original modified)))
(diff-line original modified))
(defun path-or-blank (revision)
(if revision
(revision-path revision)
(defun unified-diff-body (oldr newr)
(let ((diff (diff:format-diff-string 'diff:unified-diff
(path-or-blank oldr)
(revision-path newr))))
(subseq diff (nth-value 1 (ppcre:scan ".*\\n.*?\\n" diff)))))
(defun render-unified-revision-diff (oldr newr)
#H[<div style="font-family:monospace;"><br />--- ]
(when oldr (revision-version-info-links oldr))
#H[<br />+++ ] (revision-version-info-links newr)
#H[<br /><pre>${(escape-for-html (unified-diff-body oldr newr))}</pre></div>])
(defun revision-version-info-links (r)
#H[Version ] (pprint-revision-link r) #H[ (${(link-to-edit r "edit")})])
(defun render-diff-table (oldr diffr maybe-undo-button?)
#H[<div style="display:none;"><br />
Unified format diff:] (render-unified-revision-diff oldr diffr)
#H[Table format diff:
<table class="diff">
<col class="diff-marker"> <col class="diff-content">
<col class="diff-marker"> <col class="diff-content">
<th colspan="2">] (when oldr (revision-version-info-links oldr)) #H[</th>
<th colspan="2">] (revision-version-info-links diffr)
(when (and maybe-undo-button?
(eq diffr (latest-revision (article diffr))))
#H[<form method="post" action="$(#/site/history-special)">]
(output-undo-link diffr)
${(diff:format-diff-string 'wiki-diff
(path-or-blank oldr)
(revision-path diffr))}
(defpage /site/compare-revisions () (old diff)
(let* ((oldr (find-revision old))
(diffr (find-revision diff))
(title (title (article oldr))))
(when (> (date oldr) (date diffr))
(rotatef oldr diffr))
(setf *title* #?"${title} difference between revisions"
*footer* (with-output-to-string (*html-stream*)
(current-and-history-buttons oldr)))
#H[<div class="centered"><h1><a class="internal" href="${(link-to title)}">${title}</a></h1></div>]
(render-diff-table oldr diffr t)))
Jump to Line
Something went wrong with that request. Please try again.