source: cl-darcs/trunk/invert-patch.lisp

;;; Copyright (C) 2006 Magnus Henoch
;;;
;;; 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 of the
;;; License, 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., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA

(in-package :darcs)

(defgeneric invert-patch (patch)
  (:documentation "Create a patch that is the inverse of PATCH."))

(defmethod invert-patch ((patch named-patch))
  (make-instance 'named-patch
                 :patchinfo (invert-patchinfo (named-patch-patchinfo patch))
                 :dependencies (mapcar #'invert-patchinfo
                                       (named-patch-dependencies patch))
                 :patch (invert-patch (named-patch-patch patch))))

(defmethod invert-patch ((patch change-pref-patch))
  (make-instance 'change-pref-patch :pref (change-pref-which patch)
                 :from (change-pref-to patch)
                 :to (change-pref-from patch)))

(defmethod invert-patch ((patch move-patch))
  (make-instance 'move-patch :from (patch-move-to patch)
                 :to (patch-move-from patch)))

(defmethod invert-patch ((patch composite-patch))
  (make-instance 'composite-patch
                 :patches (mapcar #'invert-patch
                                  (reverse (patches patch)))))

(defmethod invert-patch ((patch split-patch))
  (make-instance 'split-patch
                 :patches (mapcar #'invert-patch
                                  (reverse (patches patch)))))

(defmethod invert-patch :around ((patch file-patch))
  (let ((inverted-patch (call-next-method)))
    (setf (patch-filename inverted-patch) (patch-filename patch))
    inverted-patch))

(defmethod invert-patch ((patch hunk-patch))
  (make-instance 'hunk-patch
                 :line-number (hunk-line-number patch)
                 :old (hunk-new-lines patch)
                 :new (hunk-old-lines patch)))

(defmethod invert-patch ((patch add-file-patch))
  (make-instance 'rm-file-patch))

(defmethod invert-patch ((patch rm-file-patch))
  (make-instance 'add-file-patch))

(defmethod invert-patch ((patch binary-patch))
  (make-instance 'binary-patch
                 :oldhex (binary-newhex patch)
                 :newhex (binary-oldhex patch)))

(defmethod invert-patch ((patch token-replace-patch))
  (make-instance 'token-replace-patch
                 :regexp (token-regexp patch)
                 :old-token (old-token patch)
                 :new-token (new-token patch)))

(defmethod invert-patch :around ((patch directory-patch))
  (let ((inverted-patch (call-next-method)))
    (setf (patch-directory inverted-patch) (patch-directory patch))
    inverted-patch))

(defmethod invert-patch ((patch add-dir-patch))
  (make-instance 'rm-dir-patch))

(defmethod invert-patch ((patch rm-dir-patch))
  (make-instance 'add-dir-patch))

(defmethod invert-patch ((patch merger-patch))
  (make-instance 'merger-patch
                 :version (merger-version patch)
                 :first (merger-first patch)
                 :second (merger-second patch)
                 :undo (merger-undo patch)
                 :unwindings (unwind patch)
                 :inverted (not (merger-inverted patch))))