/[meta-cvs]/meta-cvs/F-205A90D152A06EE04D552B256CDAF850
ViewVC logotype

Contents of /meta-cvs/F-205A90D152A06EE04D552B256CDAF850

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.18 - (hide annotations)
Wed Mar 5 05:18:04 2003 UTC (11 years, 1 month ago) by kaz
Branch: MAIN
Changes since 1.17: +16 -11 lines
Merging from mcvs-1-0-branch.

* code/update.lisp (mcvs-update): Simplified restart code.

* code/restart.lisp (parse-restart-case-keywords): New function.
(super-restart-case-expander): Some logic factored out
into new function.
1 kaz 1.8 ;;; This source file is part of the Meta-CVS program,
2 kaz 1.5 ;;; which is distributed under the GNU license.
3     ;;; Copyright 2002 Kaz Kylheku
4    
5 kaz 1.1 (require "dirwalk")
6     (require "chatter")
7     (require "mapping")
8 kaz 1.6 (require "options")
9 kaz 1.13 (require "generic")
10 kaz 1.17 (require "mcvs-package")
11 kaz 1.1 (provide "update")
12 kaz 1.17
13     (in-package "META-CVS")
14 kaz 1.1
15 kaz 1.13 (defun mcvs-update (&optional cvs-options cvs-update-options files)
16     (let ((need-sync (not (find "p" cvs-update-options
17     :key #'first :test #'string=))))
18 kaz 1.16 (if (or files *metaonly-option* *nometa-option*)
19 kaz 1.15 (mcvs-generic "update" cvs-options cvs-update-options nil
20     files :need-sync-after need-sync
21     :need-update-after t
22     :default-include-meta-files nil)
23 kaz 1.14 (in-sandbox-root-dir
24 kaz 1.13 (if need-sync
25     (progn
26     (chatter-debug "Synchronizing.~%")
27     (mapping-synchronize)
28 kaz 1.1
29 kaz 1.13 (current-dir-restore
30     (chdir *mcvs-dir*)
31 kaz 1.18 (super-restart-case
32     (progn
33     (chatter-debug "Invoking CVS.~%")
34     (unless (execute-program `("cvs" ,@(format-opt cvs-options)
35     "up" ,@(format-opt
36     cvs-update-options)))
37     (error "CVS update failed.")))
38     (continue ()
39     :report "Update file structure and re-synchronize."
40     (unwind))
41     (retry ()
42     :report "Try invoking CVS again."
43     (retry))))
44 kaz 1.1
45 kaz 1.13 (chatter-debug "Updating file structure.~%")
46     (mapping-update)
47     (chatter-debug "Synchronizing again.~%")
48     (mapping-synchronize))
49     (current-dir-restore
50     (chdir *mcvs-dir*)
51     (chatter-debug "Invoking CVS.~%")
52 kaz 1.18 (unless (execute-program `("cvs" ,@(format-opt cvs-options)
53     "up" ,@(format-opt cvs-update-options))))
54     (error "CVS update failed."))))))
55 kaz 1.1 (values))
56 kaz 1.4
57 kaz 1.6 (defun mcvs-update-wrapper (cvs-options cvs-command-options mcvs-args)
58 kaz 1.13 (mcvs-update cvs-options cvs-command-options mcvs-args))

  ViewVC Help
Powered by ViewVC 1.1.5