Author: mhenoch Date: Fri Aug 24 01:05:53 2007 New Revision: 124 Added: cl-darcs/trunk/pending.lisp Modified: cl-darcs/trunk/cl-darcs.asd cl-darcs/trunk/repo.lisp Log: Add ADD-FILE. Move "pending" functions to pending.lisp. Modified: cl-darcs/trunk/cl-darcs.asd ============================================================================== --- cl-darcs/trunk/cl-darcs.asd (original) +++ cl-darcs/trunk/cl-darcs.asd Fri Aug 24 01:05:53 2007 @@ -53,6 +53,7 @@ (:file "equal" :depends-on ("patch-core")) (:file "send" :depends-on ("patch-core")) (:file "revert" :depends-on ("patch-core")) + (:file "pending" :depends-on ("patch-core")) ;; Franz' inflate implementation #-allegro (:file "ifstar") Added: cl-darcs/trunk/pending.lisp ============================================================================== --- (empty file) +++ cl-darcs/trunk/pending.lisp Fri Aug 24 01:05:53 2007 @@ -0,0 +1,72 @@ +;;; Copyright (C) 2007 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 pending-filename (repodir) + "Get the name of the file containing \"pending\" patches for REPODIR." + (upath-subdir repodir '("_darcs" "patches") "pending")) + +(defun read-pending (repodir) + "Read the \"pending\" patches of REPODIR." + (let ((pending-file (pending-filename repodir))) + (when (probe-file pending-file) + (read-patch-from-file pending-file :compressed nil)))) + +(defun add-to-pending (repodir patch) + "Add PATCH to the list of \"pending\" patches in REPODIR." + (let ((pending (read-pending repodir))) + (when (null pending) + (setf pending (make-instance 'composite-patch))) + (setf (patches pending) (append (patches pending) (list patch))) + (with-open-file (out (pending-filename repodir) + :direction :output :element-type '(unsigned-byte 8) + :if-exists :supersede) + (write-patch pending out)))) + +(defun add-file (repo file) + "Schedule FILE for recording to REPO. +FILE can be a string or a pathname denoting a relative path. +FILE can be either a file or a directory." + (setf repo (fad:pathname-as-directory repo)) + (let (type) + (if (pathnamep file) + (progn + (unless (pathname-sane-p file) + (error "~A is not a relative pathname going strictly down." file)) + (setf type (if (fad:directory-pathname-p file) :directory :file))) + (progn + (setf type (if (fad:directory-exists-p (fad:pathname-as-directory file)) + :directory + :file)) + (setf file (sanitize-filename file :type type)))) + + (let ((pristine-file (merge-pathnames file (upath-subdir repo '("_darcs" "pristine")))) + (working-file (merge-pathnames file repo))) + (when (if (eql type :file) + (fad:file-exists-p pristine-file) + (fad:directory-exists-p pristine-file)) + (error "~A already exists in the repository." (pathname-to-string file))) + (when (not (if (eql type :file) + (fad:file-exists-p working-file) + (fad:directory-exists-p working-file))) + (error "~A does not exist in the working directory." (pathname-to-string file)))) + + (add-to-pending + repo + (if (eql type :file) + (make-instance 'add-file-patch :filename (pathname-to-string file)) + (make-instance 'add-dir-patch :directory (pathname-to-string file)))))) Modified: cl-darcs/trunk/repo.lisp ============================================================================== --- cl-darcs/trunk/repo.lisp (original) +++ cl-darcs/trunk/repo.lisp Fri Aug 24 01:05:53 2007 @@ -162,24 +162,3 @@ (values (intersection ours-list theirs-list :test #'equalp) (set-difference ours-list theirs-list :test #'equalp) (set-difference theirs-list ours-list :test #'equalp)))) - -(defun pending-filename (repodir) - "Get the name of the file containing \"pending\" patches for REPODIR." - (upath-subdir repodir '("_darcs" "patches") "pending")) - -(defun read-pending (repodir) - "Read the \"pending\" patches of REPODIR." - (let ((pending-file (pending-filename repodir))) - (when (probe-file pending-file) - (read-patch-from-file pending-file :compressed nil)))) - -(defun add-to-pending (repodir patch) - "Add PATCH to the list of \"pending\" patches in REPODIR." - (let ((pending (read-pending repodir))) - (when (null pending) - (setf pending (make-instance 'composite-patch))) - (setf (patches pending) (append (patches pending) (list patch))) - (with-open-file (out (pending-filename repodir) - :direction :output :element-type '(unsigned-byte 8) - :if-exists :supersede) - (write-patch pending out))))