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

;; Convert a unidiff to a context diff.

;; Copyright (C) 1995, 1996, 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))
                           (old-lines '())
                           (new-lines '())
                           (no-old-lines t)
                           (no-new-lines t))
                       (let ((old-piece '()) (new-piece '()))
                         (flet ((done-piece ()
                                  (if old-piece
                                    (if new-piece
                                      (setf old-lines (nconc (mapcar (lambda (l) (concatenate 'string "! " l)) old-piece) old-lines)
                                            new-lines (nconc (mapcar (lambda (l) (concatenate 'string "! " l)) new-piece) new-lines)
                                      )
                                      (setf old-lines (nconc (mapcar (lambda (l) (concatenate 'string "- " l)) old-piece) old-lines))
                                    )
                                    (if new-piece
                                      (setf new-lines (nconc (mapcar (lambda (l) (concatenate 'string "+ " l)) new-piece) new-lines))
                                      nil
                                  ) )
                                  (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
                                 (setf line (concatenate 'string "  " (subseq line 1)))
                                 (done-piece)
                                 (push line old-lines) (decf old-line-count)
                                 (push line new-lines) (decf new-line-count)
                               )
                               (#\- (push (subseq line 1) old-piece) (decf old-line-count) (setf no-old-lines nil))
                               (#\+ (push (subseq line 1) new-piece) (decf new-line-count) (setf no-new-lines nil))
                               (t (return))
                           ) )
                           (done-piece)
                       ) )
                       (flet ((two-lines-string (start-line end-line)
                                (if (<= start-line end-line)
                                  (format nil "~D,~D" start-line end-line)
                                  (format nil "~D" start-line)
                             )) )
                         (write-line "***************" ostream)
                         (format ostream "*** ~A ****~%" (two-lines-string old-start-line old-end-line))
                         (unless no-old-lines (dolist (l (nreverse old-lines)) (write-line l ostream)))
                         (format ostream "--- ~A ----~%" (two-lines-string new-start-line new-end-line))
                         (unless no-new-lines (dolist (l (nreverse new-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~%" oldfile newfile))
              (setf line (do-hunks line))
      ) ) ) )
) ) )

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