#!/usr/local/bin/clisp -C

;; Convert a context diff to a unidiff.

;; Copyright (C) 1996, 1999, 2000, 2002 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 fillchar)
                      (let (start-line end-line
                            i)
                        ;; scanf "*** %d,%d ****" or "*** %d ****"
                        (when (and (>= (length line) 10)
                                   (eql (char line 0) fillchar)
                                   (eql (char line 1) fillchar)
                                   (eql (char line 2) fillchar)
                                   (eql (char line 3) #\Space))
                          (multiple-value-setq (start-line i) (parse-integer line :start 4 :junk-allowed t))
                          (when start-line
                            (if (and (<= (+ i 1) (length line))
                                     (eql (char line i) #\,))
                              (multiple-value-setq (end-line i) (parse-integer line :start (+ i 1) :junk-allowed t))
                              (setq end-line (if (> start-line 0) start-line (1- start-line)))
                            )
                            (when end-line
                              (when (and (= (+ i 5) (length line))
                                         (eql (char line i) #\Space)
                                         (eql (char line (+ i 1)) fillchar)
                                         (eql (char line (+ i 2)) fillchar)
                                         (eql (char line (+ i 3)) fillchar)
                                         (eql (char line (+ i 4)) fillchar))
                                (values t start-line end-line)
                   )) ) ) ) ) )
               (block do-hunks
                 (loop
                   (unless line (setf line (next-line)))
                   (unless (and (<= 15 (length line))
                                (string= line "***************" :end1 15))
                     (return-from do-hunks)
                   )
                   (setf line (next-line))
                   (flet ((get-half-hunk (fillchar insertchar)
                            (unless line (return-from do-hunks))
                            (multiple-value-bind (ok start-line end-line)
                                (parse-hunk-header-line line fillchar)
                              (unless ok (return-from do-hunks))
                              (let ((lines '()) (changes 0) (in-change nil))
                                (loop
                                  (unless (setf line (next-line)) (return))
                                  (unless (and (>= (length line) 2)
                                               (or (member (char line 0) '(#\Space #\!))
                                                   (eql (char line 0) insertchar))
                                               (eql (char line 1) #\Space))
                                    (return))
                                  (if (eql (char line 0) #\!)
                                    (progn (unless in-change (incf changes)) (setq in-change t))
                                    (setq in-change nil)
                                  )
                                  (push line lines)
                                )
                                (values start-line end-line (nreverse lines) changes)
                         )) ) )
                     (multiple-value-bind (old-start-line old-end-line old-lines old-lines-changes)
                         (get-half-hunk #\* #\-)
                       (multiple-value-bind (new-start-line new-end-line new-lines new-lines-changes)
                           (get-half-hunk #\- #\+)
                         (let ((old-lines-count (1+ (- old-end-line old-start-line)))
                               (new-lines-count (1+ (- new-end-line new-start-line))))
                           (unless (or (null old-lines) (eql (length old-lines) old-lines-count))
                             (warn "Hunk ending at line ~D has wrong old line numbers~%" (- linenum (if line 1 0)))
                             (return-from do-hunks))
                           (unless (or (null new-lines) (eql (length new-lines) new-lines-count))
                             (warn "Hunk ending at line ~D has wrong new line numbers~%" (- linenum (if line 1 0)))
                             (return-from do-hunks))
                           (when (and (null old-lines) (null new-lines))
                             (warn "Empty hunk ending at line ~D~%" (- linenum (if line 1 0)))
                             (return-from do-hunks))
                           (cond ((null old-lines)
                                  (unless (= new-lines-changes 0)
                                    (warn "Old lines missing in hunk ending at line ~D~%" (- linenum (if line 1 0)))
                                    (return-from do-hunks)))
                                 ((null new-lines)
                                  (unless (= old-lines-changes 0)
                                    (warn "New lines missing in hunk ending at line ~D~%" (- linenum (if line 1 0)))
                                    (return-from do-hunks)))
                                 (t
                                   (let ((mismatch
                                     (block mismatchp
                                       (unless (= old-lines-changes new-lines-changes)
                                         (return-from mismatchp "changes count"))
                                       (let ((old-rest old-lines) (new-rest new-lines))
                                         (loop
                                           (loop
                                             (when (null old-rest) (return))
                                             (when (member (char (car old-rest) 0) '(#\Space #\!))
                                               (return))
                                             (setq old-rest (cdr old-rest))
                                           )
                                           (loop
                                             (when (null new-rest) (return))
                                             (when (member (char (car new-rest) 0) '(#\Space #\!))
                                               (return))
                                             (setq new-rest (cdr new-rest))
                                           )
                                           (when (and (null old-rest) (null new-rest)) (return))
                                           (when (null old-rest) (return-from mismatchp "too few old lines"))
                                           (when (null new-rest) (return-from mismatchp "too few new lines"))
                                           (let ((old-indicator (char (car old-rest) 0))
                                                 (new-indicator (char (car new-rest) 0)))
                                             (cond ((and (eql old-indicator #\Space)
                                                         (eql new-indicator #\Space))
                                                    (unless (equal (car old-rest) (car new-rest))
                                                      (return-from mismatchp "different indicators"))
                                                    (setq old-rest (cdr old-rest))
                                                    (setq new-rest (cdr new-rest)))
                                                   ((and (eql old-indicator #\!)
                                                         (eql new-indicator #\!))
                                                    (loop
                                                      (setq old-rest (cdr old-rest))
                                                      (when (null old-rest) (return))
                                                      (unless (eql (char (car old-rest) 0) #\!) (return))
                                                    )
                                                    (loop
                                                      (setq new-rest (cdr new-rest))
                                                      (when (null new-rest) (return))
                                                      (unless (eql (char (car new-rest) 0) #\!) (return))
                                                    )
                                                   )
                                                   (t (return-from mismatchp "bad indicator"))
                                       ) ) ) )
                                       nil
                                     )
                                     ))
                                   (when mismatch
                                     (warn "Mismatch (~A) between old and new lines in hunk ending at line ~D~%" mismatch (- linenum (if line 1 0)))
                                     (return-from do-hunks)
                                   )
                                   )
                           )     )
                           (format ostream "@@ -~D,~D +~D,~D @@~%" old-start-line old-lines-count new-start-line new-lines-count)
                           (cond ((null old-lines)
                                  ; All new-lines begin with "  " oder "+ ", remove the space.
                                  (dolist (l new-lines)
                                    (write-char (char l 0) ostream)
                                    (write-line l ostream :start 2)
                                 ))
                                 ((null new-lines)
                                  ; All old-lines begin with "  " oder "- ", remove the space.
                                  (dolist (l old-lines)
                                    (write-char (char l 0) ostream)
                                    (write-line l ostream :start 2)
                                 ))
                                 (t
                                   (let ((old-rest old-lines) (new-rest new-lines))
                                     (loop
                                       (loop
                                         (when (null old-rest) (return))
                                         (when (member (char (car old-rest) 0) '(#\Space #\!))
                                           (return))
                                         (write-char #\- ostream)
                                         (write-line (car old-rest) ostream :start 2)
                                         (setq old-rest (cdr old-rest))
                                       )
                                       (loop
                                         (when (null new-rest) (return))
                                         (when (member (char (car new-rest) 0) '(#\Space #\!))
                                           (return))
                                         (write-char #\+ ostream)
                                         (write-line (car new-rest) ostream :start 2)
                                         (setq new-rest (cdr new-rest))
                                       )
                                       (when (and (null old-rest) (null new-rest)) (return))
                                       (let ((old-indicator (char (car old-rest) 0)))
                                         (cond ((eql old-indicator #\Space)
                                                ; new-indicator is #\Space as well,
                                                ; (car old-rest) and (car new-rest) are equal
                                                (write-char #\Space ostream)
                                                (write-line (car old-rest) ostream :start 2)
                                                (setq old-rest (cdr old-rest))
                                                (setq new-rest (cdr new-rest)))
                                               ((eql old-indicator #\!)
                                                ; new-indicator is #\! as well.
                                                (loop
                                                  (write-char #\- ostream)
                                                  (write-line (car old-rest) ostream :start 2)
                                                  (setq old-rest (cdr old-rest))
                                                  (when (null old-rest) (return))
                                                  (unless (eql (char (car old-rest) 0) #\!) (return))
                                                )
                                                (loop
                                                  (write-char #\+ ostream)
                                                  (write-line (car new-rest) ostream :start 2)
                                                  (setq new-rest (cdr new-rest))
                                                  (when (null new-rest) (return))
                                                  (unless (eql (char (car new-rest) 0) #\!) (return))
                                                )
                           )     ) ) ) ) )     )
                     ) ) )
               ) ) )
               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~%" oldfile newfile))
              (setf line (do-hunks line))
      ) ) ) )
) ) )

(process-file *standard-input* *standard-output*)