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