;;; 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))))