;;; Copyright (C) 2006, 2008 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)
  ;; Both files and directories are specified in file format,
  ;; i.e. without a trailing slash.
  (write-as-bytes (pathname-to-string (fad:pathname-as-file 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-as-bytes (change-pref-from patch) stream)
  (write-byte 10 stream)
  (write-as-bytes (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))

(defmethod write-patch ((patch merger-patch) stream)
  (write-as-bytes "merger " stream)
  (write-as-bytes (merger-version patch) stream)
  (write-as-bytes " (" stream)
  (write-byte 10 stream)
  (write-patch (merger-first patch) stream)
  (write-patch (merger-second patch) stream)
  (write-as-byte #\) stream)
  (write-byte 10 stream))