source: cl-darcs/trunk/record.lisp

Last change on this file was 155, checked in by Magnus Henoch, 14 years ago

Remove pending patches after they are committed

File size: 4.0 KB
Line 
1;;; Copyright (C) 2006, 2008 Magnus Henoch
2;;;
3;;; This program is free software; you can redistribute it and/or
4;;; modify it under the terms of the GNU General Public License as
5;;; published by the Free Software Foundation; either version 2 of the
6;;; License, or (at your option) any later version.
7;;;
8;;; This program is distributed in the hope that it will be useful,
9;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
10;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
11;;; General Public License for more details.
12;;;
13;;; You should have received a copy of the GNU General Public License
14;;; along with this program; if not, write to the Free Software
15;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
16
17(in-package :darcs)
18
19(defun record-patches (repo name author date log patches)
20  "Record PATCHES in REPO.
21NAME is the name of the patch, a description of one line.
22AUTHOR is the e-mail address (or other identifier) of the author.
23DATE is the date in YYYYMMDDHHMMSS format, or the keyword :NOW.
24LOG is either NIL or a possibly multi-line description of the patch.
25PATCHES is a list of patches that make up the change."
26  (let* ((patchinfo
27          (make-patchinfo
28           :name name :author author
29           :date (if (eql date :now)
30                     (multiple-value-bind
31                           (second minute hour date month year)
32                         (get-decoded-time)
33                       (format nil "~4,'0d~2,'0d~2,'0d~2,'0d~2,'0d~2,'0d"
34                               year month date hour minute second))
35                     date)
36           :log (when log
37                    (split-sequence:split-sequence #\Newline log))))
38         (patch (make-instance 'named-patch
39                               :patchinfo patchinfo
40                               :dependencies nil
41                               :patch
42                               (make-instance 'composite-patch
43                                              :patches patches))))
44    (write-patch-to-repo patch repo)
45    (apply-patch-to-pristine patch repo)
46    (remove-matching-from-pending repo patches)
47    (append-inventory repo patchinfo)))
48
49(defun record-changes (repo name author date log)
50  "Record changes in REPO.
51Arguments as to `record-patches'."
52  (let ((patches (diff-repo repo)))
53    (flet ((ask (patch)
54             (display-patch patch *query-io*)
55             (y-or-n-p "Record patch ~A? " patch)))
56      (unless patches
57        (error "Nothing to record."))
58
59      (record-patches repo name author date log (select-patches patches #'ask)))))
60
61(defun select-patches (patches predicate)
62  "Select some of PATCHES using PREDICATE.
63Do the necessary commutation and dependency elimination."
64  (let (patches-to-record)
65    (loop while (setf patches (remove nil patches))
66       do
67       ;; Should we include this patch?
68       (if (funcall predicate (car patches))
69           (progn
70             ;; Yes, just add it to the list and go on.
71             (push (car patches) patches-to-record)
72             (setf patches (cdr patches)))
73           ;; No, we need to commute it through the rest of the patches.
74           (loop for commute-patches on (cdr patches)
75              ;; Try to commute it with the next patch in line.
76              do (let ((commute-result (commute (car commute-patches) (car patches))))
77                   (if commute-result
78                       ;; Commutation succeeded; use the altered patches.
79                       (destructuring-bind (commuted-current commuted-future) commute-result
80                         (setf (car patches) commuted-current)
81                         (setf (car commute-patches) commuted-future))
82                       ;; Commutation failed; (car commute-patches) depends on (car patches).
83                       ;; Try to commute them together.
84                       (progn
85                         ;; Turn the patch we are commuting through
86                         ;; the list into a composite patch, unless it is
87                         ;; one already.  Append the dependency.
88                         (etypecase (car patches)
89                           (composite-patch
90                            (nconc (patches (car patches))
91                                   (list (car commute-patches))))
92                           (patch
93                            (setf (car patches)
94                                  (make-instance 'composite-patch
95                                                 :patches (list
96                                                           (car patches)
97                                                           (car commute-patches))))))
98                         ;; Drop the dependency from the list of
99                         ;; patches to consider.
100                         (setf (car commute-patches) nil))))
101              finally (setf patches (cdr patches)))))
102    (nreverse patches-to-record)))
Note: See TracBrowser for help on using the repository browser.