#!/usr/local/bin/clisp -C ;; Reverse a unidiff. ;; Copyright (C) 1999, 2000 Bruno Haible ;; ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, write to the Free Software ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (defun process-file (istream ostream &aux (linenum 0)) (flet ((next-line () (incf linenum) (read-line istream nil nil) )) (flet ((do-hunks (line) (flet ((parse-hunk-header-line (line) (let (old-start-line old-line-count new-start-line new-line-count i) ;; scanf "@@ -%d,%d +%d,%d @@%s" (when (>= (length line) 11) (when (string= line "@@ -" :start1 0 :end1 4) (multiple-value-setq (old-start-line i) (parse-integer line :start 4 :junk-allowed t)) (when old-start-line (when (and (<= (+ i 1) (length line)) (string= line "," :start1 i :end1 (+ i 1))) (multiple-value-setq (old-line-count i) (parse-integer line :start (+ i 1) :junk-allowed t)) (when old-line-count (when (and (<= (+ i 2) (length line)) (string= line " +" :start1 i :end1 (+ i 2))) (multiple-value-setq (new-start-line i) (parse-integer line :start (+ i 2) :junk-allowed t)) (when new-start-line (when (and (<= (+ i 1) (length line)) (string= line "," :start1 i :end1 (+ i 1))) (multiple-value-setq (new-line-count i) (parse-integer line :start (+ i 1) :junk-allowed t)) (when new-line-count (when (and (<= (+ i 3) (length line)) (string= line " @@" :start1 i :end1 (+ i 3))) (values t old-start-line old-line-count new-start-line new-line-count) )) ) ) ) ) ) ) ) ) ) ) ) (block do-hunks (loop (unless line (setf line (next-line))) (unless line (return-from do-hunks)) (multiple-value-bind (ok old-start-line old-line-count new-start-line new-line-count) (parse-hunk-header-line line) (unless ok (return-from do-hunks)) (let ((old-end-line (+ old-start-line old-line-count -1)) (new-end-line (+ new-start-line new-line-count -1)) (lines '())) (let ((old-piece '()) (new-piece '())) (flet ((done-piece () (setf lines (nconc (mapcar (lambda (l) (concatenate 'string "+" l)) old-piece) (nconc (mapcar (lambda (l) (concatenate 'string "-" l)) new-piece) lines ) ) ) (setf old-piece '() new-piece '()) )) (loop (setf line nil) (unless (or (plusp old-line-count) (plusp new-line-count)) (return)) (unless (setf line (next-line)) (return)) (unless (plusp (length line)) (return)) (case (char line 0) (#\space (done-piece) (push (concatenate 'string " " (subseq line 1)) lines) (decf old-line-count) (decf new-line-count) ) (#\- (push (subseq line 1) old-piece) (decf old-line-count)) (#\+ (push (subseq line 1) new-piece) (decf new-line-count)) (t (return)) ) ) (done-piece) ) ) (format ostream "@@ -~D,~D +~D,~D @@~%" new-start-line (+ (- new-end-line new-start-line) 1) old-start-line (+ (- old-end-line old-start-line) 1) ) (dolist (l (nreverse lines)) (write-line l ostream)) (if (or (plusp old-line-count) (plusp new-line-count)) (warn "Incomplete hunk ending at line ~D~%" (- linenum (if line 1 0))) (if (not (and (zerop old-line-count) (zerop new-line-count))) (warn "Overly long hunk ending at line ~D~%" (- linenum (if line 1 0))) ) ) ) ) ) ) line )) ) (let (line) (block do-file (loop (let (headline oldfile newfile) (loop (unless line (setf line (next-line))) (unless line (return-from do-file)) (cond ((eql (search "diff" line) 0) (setf headline line) (setf line nil)) ((eql (search "--- " line) 0) (return)) (t ;; (warn "Junk at line ~D.~%" linenum) (format ostream "~A~%" line) (setf line nil)) ) ) (when (eql (search "--- " line) 0) (setf oldfile (subseq line 4)) (setf line (next-line))) (unless line (return-from do-file)) (when (eql (search "+++ " line) 0) (setf newfile (subseq line 4)) (setf line (next-line))) (unless line (return-from do-file)) (when headline (format ostream "~A~%" headline)) (when (and oldfile newfile) (format ostream "--- ~A~%+++ ~A~%" newfile oldfile)) (setf line (do-hunks line)) ) ) ) ) ) ) ) (process-file *standard-input* *standard-output*)