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

[mhenoch at common-lisp.net]

Author: mhenoch
Date: Mon Nov 27 17:50:51 2006
New Revision: 77

Added:
   cl-darcs/trunk/record.lisp
Modified:
   cl-darcs/trunk/cl-darcs.asd
Log:
Add record.lisp


Modified: cl-darcs/trunk/cl-darcs.asd
==============================================================================
--- cl-darcs/trunk/cl-darcs.asd	(original)
+++ cl-darcs/trunk/cl-darcs.asd	Mon Nov 27 17:50:51 2006
@@ -38,6 +38,7 @@
    (:file "prefs" :depends-on ("util"))
    (:file "repo" :depends-on ("util"))
    (:file "diff" :depends-on ("util"))
+   (:file "record" :depends-on ("util"))
 
    (:file "patch-core" :depends-on ("util"))
    (:file "read-patch" :depends-on ("patch-core"))

Added: cl-darcs/trunk/record.lisp
==============================================================================
--- (empty file)
+++ cl-darcs/trunk/record.lisp	Mon Nov 27 17:50:51 2006
@@ -0,0 +1,54 @@
+;;; 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 record-patches (repo name author date log patches)
+  "Record PATCHES in REPO.
+NAME is the name of the patch, a description of one line.
+AUTHOR is the e-mail address (or other identifier) of the author.
+DATE is the date in YYYYMMDDHHMMSS format, or the keyword :NOW.
+LOG is either NIL or a possibly multi-line description of the patch.
+PATCHES is a list of patches that make up the change."
+  (let* ((patchinfo
+	  (make-patchinfo
+	   :name name :author author
+	   :date (if (eql date :now)
+		     (multiple-value-bind
+			   (second minute hour date month year)
+			 (get-decoded-time)
+		       (format nil "~4,'0d~2,'0d~2,'0d~2,'0d~2,'0d~2,'0d"
+			       year month date hour minute second))
+		     date)
+	   :log (split-sequence:split-sequence #\Newline log)))
+	 (patch (make-instance 'named-patch
+			       :patchinfo patchinfo
+			       :dependencies nil
+			       :patch
+			       (make-instance 'composite-patch
+					      :patches patches))))
+    (write-patch-to-repo patch repo)
+    (apply-patch-to-pristine patch repo)
+    (append-inventory repo patchinfo)))
+
+(defun record-changes (repo name author date log)
+  "Record changes in REPO.
+Arguments as to `record-patches'."
+  (let ((patches (diff-repo repo)))
+    (unless patches
+      (error "Nothing to record."))
+
+    (record-patches repo name author date log patches)))