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

Contents of /meta-cvs/F-205A90D152A06EE04D552B256CDAF850

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.21 - (hide annotations)
Thu Apr 24 04:14:41 2003 UTC (11 years ago) by kaz
Branch: MAIN
Changes since 1.20: +1 -1 lines
Merging from mcvs-1-0-branch.

Improved error handling again in a flash of sanity. The whole
idea of ``bail'' as a restart is gone. All code which must perform
some complex cleanup action does so as part of normal unwinding.
And so termination becomes safe.

* code/update.lisp (mcvs-update): Change bail restart to continue.

* code/mcvs-main.lisp (*global-options*): Remove "error-bail".
(*usage*): Remove description of --error-bail.
(mcvs-execute): Bind *mcvs-error-treatment* to :terminate rather
than :bail if controlling TTY cannot be opened.

* code/move.lisp (mcvs-move): Change "Undoing move" error message
to "Undoing changes to map".

* code/add.lisp (mcvs-add): Get rid of bail restart; move cleanup
code into unwind-protect block.

* code/error.lisp (*mcvs-error-treatment*): Touch up docstring.
(mcvs-error-handler): Remove anything having to do with :bail.
Change description of `T' command to suggest that it is safe.

* code/options.lisp (filter-mcvs-options): Remove handling of
"error-bail" option.

* code/mapping.lisp (mapping-update): Get rid of outermost
restart-case, which had just a bail restart. Replace it with
unwind-protect block which does exactly the same restoration.
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 kaz 1.19 ;; Push changes in tree to CVS sandbox, so they can be merged
27     ;; with stuff coming from repository.
28 kaz 1.13 (chatter-debug "Synchronizing.~%")
29 kaz 1.19 (mapping-synchronize :direction :left)
30 kaz 1.1
31 kaz 1.13 (current-dir-restore
32     (chdir *mcvs-dir*)
33 kaz 1.18 (super-restart-case
34     (progn
35     (chatter-debug "Invoking CVS.~%")
36     (unless (execute-program `("cvs" ,@(format-opt cvs-options)
37     "up" ,@(format-opt
38     cvs-update-options)))
39     (error "CVS update failed.")))
40 kaz 1.21 (continue ()
41 kaz 1.18 :report "Update file structure and re-synchronize."
42     (unwind))
43     (retry ()
44     :report "Try invoking CVS again."
45     (retry))))
46 kaz 1.1
47 kaz 1.13 (chatter-debug "Updating file structure.~%")
48     (mapping-update)
49     (chatter-debug "Synchronizing again.~%")
50 kaz 1.19 (mapping-synchronize :direction :right))
51 kaz 1.13 (current-dir-restore
52     (chdir *mcvs-dir*)
53     (chatter-debug "Invoking CVS.~%")
54 kaz 1.18 (unless (execute-program `("cvs" ,@(format-opt cvs-options)
55     "up" ,@(format-opt cvs-update-options))))
56     (error "CVS update failed."))))))
57 kaz 1.1 (values))
58 kaz 1.4
59 kaz 1.6 (defun mcvs-update-wrapper (cvs-options cvs-command-options mcvs-args)
60 kaz 1.13 (mcvs-update cvs-options cvs-command-options mcvs-args))

  ViewVC Help
Powered by ViewVC 1.1.5