From 2233d3e5e8e87601205a89131cd342014d990db0 Mon Sep 17 00:00:00 2001 From: Ludovic Court`es Date: Thu, 8 Mar 2007 18:09:36 +0000 Subject: `diff' package: Fixes and hacking. * src/guile/skribilo/package/diff.scm (add-unchanged): Fixed (hopefully). (annotated-string-diff): New. (make-diff-document): Moved code to `annotated-string-diff'. (make-diff-document-from-files): Cleaned up. git-archimport-id: lcourtes@laas.fr--2006-libre/skribilo--devo--1.2--patch-23 --- src/guile/skribilo/package/diff.scm | 107 ++++++++++++++++++------------------ 1 file changed, 55 insertions(+), 52 deletions(-) (limited to 'src') diff --git a/src/guile/skribilo/package/diff.scm b/src/guile/skribilo/package/diff.scm index f42f7f4..6e8c60b 100644 --- a/src/guile/skribilo/package/diff.scm +++ b/src/guile/skribilo/package/diff.scm @@ -35,7 +35,8 @@ :use-module (skribilo package base) :use-module (skribilo utils syntax) - :export (make-diff-document-from-files)) + :export (make-diff-document + make-diff-document-from-files)) (fluid-set! current-reader %skribilo-module-reader) @@ -57,11 +58,14 @@ ;;; (define-markup (deletion :rest args) - (color :fg "red" "[deletion]")) + (color :fg "red" (symbol "middot"))) (define-markup (insertion :rest args) (color :fg "green" args)) +(define-markup (replacement :rest args) + (color :fg "orange" args)) + (define-markup (unchanged :rest args) args) @@ -108,45 +112,42 @@ ;; Add information about unchanged regions to EDITS, a list returned by ;; `coalesce-edits'. STR-LEN should be the length of the _target_ string, ;; i.e., the second argument of `diff:edits'. - (define %nop '(unchanged 0 0)) - (define (strip-nop result) - (if (equal? (car result) %nop) - (cdr result) - result)) + (define (coalesce-unchanged start end result) + (if (null? result) + `((unchanged ,start ,end)) + (let ((prev-unchanged? (eq? (caar result) 'unchanged)) + (prev-start (cadr (car result))) + (prev-end (caddr (car result)))) + (if prev-unchanged? + (cons `(unchanged ,prev-start ,end) + (cdr result)) + (cons `(unchanged ,start ,end) + result))))) (let loop ((edits edits) - (result (list (list 'unchanged 0 0))) + (result '()) (str-pos 0)) (if (null? edits) - (strip-nop - (reverse! (if (< str-pos (- str-len 1)) - (cons (list 'unchanged str-pos (- str-len 1)) - result) - result))) + (reverse! (if (< str-pos (- str-len 1)) + (cons (list 'unchanged str-pos (- str-len 1)) + result) + result)) (let* ((change (car edits)) (kind (car change)) (start (cadr change)) - (end (caddr change)) - - (prev-unchanged? (eq? (caar result) 'unchanged)) - (prev-start (cadr (car result))) - (prev-end (caddr (car result)))) + (end (caddr change))) (loop (cdr edits) (if (memq kind '(insertion replacement)) - (if (> start (+ 1 prev-end)) - (if prev-unchanged? - (cons* change - `(unchanged ,prev-start - ,(- start 1)) - (cdr result)) - (cons* change - `(unchanged ,(+ 1 prev-end) - ,(- start 1)) - result)) + (if (> start str-pos) + (cons change + (coalesce-unchanged str-pos (- start 1) + result)) (cons change result)) (cons change result)) - (+ end 1)))))) + (if (eq? kind 'deletion) + str-pos ;; deletion doesn't change string position + (+ end 1))))))) (define (string-diff-sequences str1 str2) ;; Return a "diff sequence" between STR1 and STR2. The diff sequence is @@ -173,6 +174,27 @@ toc index &index-entry &the-index &the-index-header)) +(define (annotated-string-diff str1 str2) + ;; Return a list (actually an AST) denoting the differences between STR1 + ;; and STR2. The returned text is actually that of STR2 augmented with + ;; `insertion', `deletion', `replacement', and `unchanged' markup. + (reverse! + (fold (lambda (edit result) + (let ((start (cadr edit)) + (end (+ 1 (caddr edit)))) + (cons (case (car edit) + ((insertion) + (insertion (substring str2 start end))) + ((deletion) + (deletion (substring str1 start end))) + ((replacement) + (replacement (substring str2 start end))) + ((unchanged) + (unchanged (substring str2 start end)))) + result))) + '() + (string-diff-sequences str1 str2)))) + (define (make-diff-document ast1 ast2) ;; Return a document based on AST2 that highlights differences between AST1 ;; and AST2, enclosing unchanged parts in `unchanged' markups, etc. @@ -181,22 +203,7 @@ ;;(format (current-error-port) "diff: ~a ~a~%" ast1 ast2) (cond ((string? ast2) (if (string? ast1) - (reverse! - (fold (lambda (edit result) - (let ((start (cadr edit)) - (end (+ 1 (caddr edit)))) - (cons (case (car edit) - ((insertion) - (insertion (substring ast2 start end))) - ((deletion) - (deletion (substring ast1 start end))) - ((replacement) - (replacement (substring ast2 start end))) - ((unchanged) - (unchanged (substring ast2 start end)))) - result))) - '() - (string-diff-sequences ast1 ast2))) + (annotated-string-diff ast1 ast2) (insertion ast2))) ((document? ast2) @@ -283,21 +290,17 @@ (evaluate-ast-from-port (open-input-file old-file) :reader reader :module (make-run-time-module)))) - (~~ (skribe-message "diff: first document loaded")) + (~~ (skribe-message "diff: first document loaded~%")) (ast2 (parameterize ((*bib-table* (make-bib-table 'doc-2))) (evaluate-ast-from-port (open-input-file new-file) :reader reader :module (make-run-time-module)))) - (%% (skribe-message "diff: second document loaded"))) + (%% (skribe-message "diff: second document loaded~%"))) (resolve! ast1 engine env) (resolve! ast2 engine env) - (let ((diff (make-diff-document ast1 ast2))) - (format (current-error-port) "diff-doc: ~a ~a~%" - diff (document? diff)) - diff))) - + (make-diff-document ast1 ast2))) ;;; diff.scm ends here -- cgit v1.2.3