/[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.5 - (hide annotations)
Thu Jan 29 05:00:15 2004 UTC (10 years, 2 months ago) by kaz
Branch: MAIN
Changes since 1.4: +1 -1 lines
Merging from mcvs-1-0-branch.
1 kaz 1.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 kaz 1.2 (require "mcvs-package")
6 kaz 1.1 (provide "execute")
7 kaz 1.2
8     (in-package "META-CVS")
9 kaz 1.1
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 kaz 1.4 (let ((chopped-arg ())
20     (combined-status t))
21 kaz 1.1 (dolist (arg extra-args)
22     (push arg chopped-arg)
23     (when (> (incf size (1+ (length arg))) *argument-limit*)
24 kaz 1.4 (setf combined-status
25     (and combined-status
26     (execute-program (append fixed-args
27 kaz 1.1 (nreverse chopped-arg)
28 kaz 1.4 fixed-trail-args))))
29 kaz 1.1 (setf chopped-arg nil)
30     (setf size fixed-size)))
31     (when chopped-arg
32     (execute-program (append fixed-args (nreverse chopped-arg)
33 kaz 1.4 fixed-trail-args)))
34     combined-status)
35 kaz 1.5 (execute-program (append fixed-args fixed-trail-args)))))

  ViewVC Help
Powered by ViewVC 1.1.5