[Cl-darcs-cvs] r37 - cl-darcs/trunk

[mhenoch at common-lisp.net]

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