Author: mhenoch
Date: Thu Aug 31 20:21:43 2006
New Revision: 37
Added:
cl-darcs/trunk/write-patch.lisp
Log:
Add write-patch
Added: cl-darcs/trunk/write-patch.lisp
==============================================================================
--- (empty file)
+++ cl-darcs/trunk/write-patch.lisp Thu Aug 31 20:21:43 2006
@@ -0,0 +1,145 @@
+;;; 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, under correct filename."
+ (let ((filename
+ (upath-subdir repo '("_darcs" "patches")
+ (patchinfo-make-filename
+ (named-patch-patchinfo patch)))))
+ (with-open-file (out filename :direction :output :element-type '(unsigned-byte 8)
+ :if-exists :error)
+ (write-patch patch out))))
+
+(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)
+ (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 "
+ (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 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"
+ (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 (patch-move-from patch)) stream)
+ (write-byte 32 stream)
+ (write-sequence (string-to-bytes (patch-move-to patch)) stream)
+ (write-byte 10 stream))
+
