/[meta-cvs]/meta-cvs/F-5C4536C98E79EFAD905684B34C8DA41D.lisp
ViewVC logotype

Contents of /meta-cvs/F-5C4536C98E79EFAD905684B34C8DA41D.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (show annotations)
Sun Apr 13 14:36:05 2003 UTC (11 years ago) by kaz
Branch: MAIN
Changes since 1.3: +8 -5 lines
Merging from mcvs-1-0-branch.

* code/execute.lisp (execute-program-xargs): Fix again: perform
all of the split command lines, even if some of them fail.
The returned status is a logical AND combination; if all of the
subcommands succeeded then it's T, otherwise NIL.
1 ;;; This source file is part of the Meta-CVS program,
2 ;;; which is distributed under the GNU license.
3 ;;; Copyright 2002 Kaz Kylheku
4
5 (require "mcvs-package")
6 (provide "execute")
7
8 (in-package "META-CVS")
9
10 (defconstant *argument-limit* (* 64 1024))
11
12 (defun execute-program-xargs (fixed-args &optional extra-args fixed-trail-args)
13 (let* ((fixed-size (reduce #'(lambda (x y)
14 (+ x (length y) 1))
15 (append fixed-args fixed-trail-args)
16 :initial-value 0))
17 (size fixed-size))
18 (if extra-args
19 (let ((chopped-arg ())
20 (combined-status t))
21 (dolist (arg extra-args)
22 (push arg chopped-arg)
23 (when (> (incf size (1+ (length arg))) *argument-limit*)
24 (setf combined-status
25 (and combined-status
26 (execute-program (append fixed-args
27 (nreverse chopped-arg)
28 fixed-trail-args))))
29 (setf chopped-arg nil)
30 (setf size fixed-size)))
31 (when chopped-arg
32 (execute-program (append fixed-args (nreverse chopped-arg)
33 fixed-trail-args)))
34 combined-status)
35 (execute-program fixed-args))))

  ViewVC Help
Powered by ViewVC 1.1.5