source: cl-darcs/tags/0.1.0/patch-core.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)

(defclass patch ()
  ())

(defclass composite-patch (patch)
  ((patches :accessor patches :initarg :patches :initform ()
            :documentation "List of patches making up the composite patch.")))

(defmethod print-object ((patch composite-patch) stream)
  (if *print-readably*
      (call-next-method)
      (format stream "#<~A: ~W>"
              (type-of patch) (patches patch))))

(defclass split-patch (patch)
  ((patches :accessor patches :initarg :patches :initform ())))

(defclass file-patch (patch)
  ((filename :accessor patch-filename :initarg :filename :type pathname))
  (:documentation "Base class for patches affecting a single file."))

(defmethod print-object ((patch file-patch) stream)
  (if *print-readably* (call-next-method)
      (format stream "#<~A: ~A>" (type-of patch) (patch-filename patch))))

(defclass hunk-patch (file-patch)
  ((line-number :accessor hunk-line-number :initarg :line-number
                :documentation "Line number where hunk starts.") ;XXX: old or new?
   (old :accessor hunk-old-lines :initarg :old
        :documentation "The lines of the old version (list of strings)")
   (new :accessor hunk-new-lines :initarg :new
        :documentation "The lines of the new version (list of strings)"))
  (:documentation "A single patch \"hunk\"."))

(defmethod print-object ((patch hunk-patch) stream)
  (if *print-readably* (call-next-method)
      (format stream "#<~A: ~A ~A~[~:;~:*-~A~]~[~:;~:*+~A~]>"
              (type-of patch) (patch-filename patch)
              (hunk-line-number patch)
              (length (hunk-old-lines patch))
              (length (hunk-new-lines patch)))))

(defclass add-file-patch (file-patch)
  ()
  (:documentation "A patch that creates a file."))

(defclass rm-file-patch (file-patch)
  ()
  (:documentation "A patch that removes a file."))

(defclass binary-patch (file-patch)
  ((oldhex :accessor binary-oldhex :initarg :oldhex
           :type '(vector (unsigned-byte 8))
           :documentation "The old contents of the file.")
   (newhex :accessor binary-newhex :initarg :newhex
           :type '(vector (unsigned-byte 8))
           :documentation "The new contents of the file."))
  (:documentation "A patch that changes a binary file."))

(defclass token-replace-patch (file-patch)
  ((regexp :accessor token-regexp :initarg :regexp :type 'string)
   (old-token :accessor old-token :initarg :old-token :type 'string)
   (new-token :accessor new-token :initarg :new-token :type 'string))
  (:documentation "A patch that replaces one token with another."))

(defmethod print-object ((patch token-replace-patch) stream)
  (if *print-readably* (call-next-method)
      (format stream "#<~A: ~A: s/~A/~A/ (~S)>" (type-of patch) (patch-filename patch)
              (old-token patch) (new-token patch)
              (token-regexp patch))))

(defclass directory-patch (patch)
  ((directory :accessor patch-directory :initarg :directory))
  (:documentation "Base class for patches affecting a directory."))

(defmethod print-object ((patch directory-patch) stream)
  (if *print-readably* (call-next-method)
      (format stream "#<~A: ~A>" (type-of patch) (patch-directory patch))))

(defclass add-dir-patch (directory-patch)
  ()
  (:documentation "A patch that creates a directory."))

(defclass rm-dir-patch (directory-patch)
  ()
  (:documentation "A patch that removes a directory."))

(defclass named-patch (patch)
  ((patchinfo :accessor named-patch-patchinfo :initarg :patchinfo
              :documentation "Metadata about this patch.")
   (dependencies :accessor named-patch-dependencies :initarg :dependencies
                 :documentation "List of patchinfo structures naming the dependencies of this patch.")
   (patch :accessor named-patch-patch :initarg :patch
          :documentation "The patch itself."))
  (:documentation "A named patch."))    ;XXX: what does that mean?

(defmethod print-object ((patch named-patch) stream)
  (if *print-readably*
      (call-next-method)
      (let ((patchinfo (named-patch-patchinfo patch)))
        (format stream "#<~A: ~A ~A: ~<~W~:>>"
                (type-of patch)
                (patchinfo-date patchinfo)
                (patchinfo-name patchinfo)
                (named-patch-patch patch)))))

(defclass change-pref-patch (patch)
  ((pref :initarg :pref :accessor change-pref-which)
   (from :initarg :from :accessor change-pref-from)
   (to :initarg :to :accessor change-pref-to))
  (:documentation "A patch for changing a preference."))

(defmethod print-object ((patch change-pref-patch) stream)
  (if *print-readably*
      (call-next-method)
      (format stream "#<~A: ~A: s/~S/~S/>"
              (type-of patch)
              (change-pref-which patch)
              (change-pref-from patch)
              (change-pref-to patch))))

(defclass move-patch (patch)
  ((from :initarg :from :accessor patch-move-from)
   (to :initarg :to :accessor patch-move-to))
  (:documentation "A patch that moves a file."))

(defmethod print-object ((patch move-patch) stream)
  (if *print-readably*
      (call-next-method)
      (format stream "#<~A: ~A -> ~A>"
              (type-of patch)
              (patch-move-from patch)
              (patch-move-to patch))))

;; XXX: this class is probably incorrect and insufficient.
(defclass merger-patch (patch)
  ((version :initarg :version :accessor merger-version)
   (first :initarg :first :accessor merger-first)
   (second :initarg :second :accessor merger-second)
   (inverted :initarg :inverted :accessor merger-inverted)
   (undo :initarg :undo :accessor merger-undo)
   (unwindings :initarg :unwindings :accessor merger-unwindings)))

(defmethod print-object ((patch merger-patch) stream)
  (if *print-readably*
      (call-next-method)
      (format stream "#<~A ~:[(inverted) ~;~]~A: ~A ~A>"
              (type-of patch)
              (merger-inverted patch)
              (merger-version patch)
              (merger-first patch)
              (merger-second patch))))

;; There are more kinds of patches... let's implement them when need
;; arises.