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

(defun write-patch-to-repo (patch repo)
  "Write the named patch PATCH to REPO, compressed, under correct filename."
  (let ((filename
         (upath-subdir repo '("_darcs" "patches")
                       (patchinfo-make-filename 
                        (named-patch-patchinfo patch)))))
    (with-temp-file-name tmp-file
      (with-open-file (out tmp-file :direction :output :element-type '(unsigned-byte 8)
                           :if-exists :error)
        (write-patch patch out))
      (compress-file tmp-file filename))))

(defgeneric write-patch (patch stream)
  (:documentation "Write PATCH to STREAM, in darcs patch format.
STREAM is assumed to have element type (unsigned-byte 8).
The patch is terminated by a newline character."))

(defun write-as-byte (char stream)
  "Convert CHAR to a byte, and write it to STREAM."
  (write-byte (char-code char) stream))

(defun write-as-bytes (string stream)
  "Convert STRING to bytes, and write it to STREAM."
  (write-sequence (string-to-bytes string) stream))

(defmethod write-patch ((patch composite-patch) stream)
  (write-as-byte #\{ stream)
  (write-byte 10 stream)
  (dolist (part (patches patch))
    (write-patch part stream))
  (write-as-byte #\} stream)
  (write-byte 10 stream))

(defmethod write-patch ((patch hunk-patch) stream)
  (write-as-bytes (concatenate
                   'string
                   "hunk "
                   (pathname-to-string (patch-filename patch))
                   (format nil " ~A" (hunk-line-number patch)))
                  stream)
  (write-byte 10 stream)
  (dolist (line (hunk-old-lines patch))
    (write-as-byte #\- stream)
    (write-sequence line stream)
    (write-byte 10 stream))
  (dolist (line (hunk-new-lines patch))
    (write-byte (char-code #\+) stream)
    (write-sequence line stream)
    (write-byte 10 stream)))

(defun write-token-and-filename (token filename stream)
  (write-as-bytes token stream)
  (write-byte 32 stream)
  (write-as-bytes (pathname-to-string filename) stream)
  (write-byte 10 stream))

(defmethod write-patch ((patch add-file-patch) stream)
  (write-token-and-filename "addfile" (patch-filename patch) stream))

(defmethod write-patch ((patch rm-file-patch) stream)
  (write-token-and-filename "rmfile" (patch-filename patch) stream))

(defmethod write-patch ((patch add-dir-patch) stream)
  (write-token-and-filename "adddir" (patch-directory patch) stream))

(defmethod write-patch ((patch rm-dir-patch) stream)
  (write-token-and-filename "rmdir" (patch-directory patch) stream))

(defmethod write-patch ((patch binary-patch) stream)
  (write-token-and-filename "binary" (patch-filename patch) stream)
  (flet ((write-binary-data (bin)
           ;; Print binary data in hex format, with 78 characters per
           ;; line.  Each lines starts with *.  A newline is printed
           ;; at the start, but not at the end.
           (loop for i from 0 upto (length bin)
              do (when (zerop (mod i 49))
                   (write-byte 10 stream)
                   (write-as-byte #\* stream))
                (write-as-bytes (string-downcase
                                 (format nil "~X" (aref bin i)))
                                stream))))
    (write-as-bytes "oldhex" stream)
    (write-binary-data (binary-oldhex patch))
    (write-as-bytes "newhex" stream)
    (write-binary-data (binary-newhex patch))
    (write-byte 10 stream)))

(defmethod write-patch ((patch token-replace-patch) stream)
  (write-as-bytes (format nil "replace ~A [~A] ~A ~A"
                          (pathname-to-string (patch-filename patch))
                          (token-regexp patch)
                          (old-token patch)
                          (new-token patch))
                  stream)
  (write-byte 10 stream))
  
(defmethod write-patch ((patch named-patch) stream)
  (write-as-bytes
   (with-output-to-string (strout)
     (write-patchinfo (named-patch-patchinfo patch) strout))
   stream)
  (when (named-patch-dependencies patch)
    (write-as-byte #\< stream)
    (write-byte 10 stream)
    (dolist (d (named-patch-dependencies patch))
      (write-as-bytes
       (with-output-to-string (strout)
         (write-patchinfo d strout))
       stream)
      (write-byte 10 stream))
    (write-as-byte #\> stream)
    (write-byte 32 stream))
  (write-patch (named-patch-patch patch) stream))

(defmethod write-patch ((patch change-pref-patch) stream)
  (write-as-bytes "changepref " stream)
  (write-as-bytes (change-pref-which patch) stream)
  (write-byte 10 stream)
  (write-sequence (change-pref-from patch) stream)
  (write-byte 10 stream)
  (write-sequence (change-pref-to patch) stream)
  (write-byte 10 stream))

(defmethod write-patch ((patch move-patch) stream)
  (write-sequence (string-to-bytes "move ") stream)
  (write-sequence (string-to-bytes
                   (pathname-to-string (patch-move-from patch)))
                  stream)
  (write-byte 32 stream)
  (write-sequence (string-to-bytes
                   (pathname-to-string
                    (patch-move-to patch))) stream)
  (write-byte 10 stream))