/[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.7 - (show annotations)
Fri Nov 24 04:53:50 2006 UTC (7 years, 5 months ago) by kaz
Branch: MAIN
CVS Tags: asdf-import-branch~merged-to-HEAD-0, mcvs-1-1-98, asdf-import-branch~branch-point, HEAD
Branch point for: asdf-import-branch
Changes since 1.6: +1 -1 lines
Stylistic change.

* code/add.lisp: Change in-package calls not to use the all-caps
"META-CVS" string string, but rather the :meta-cvs keyword.
* code/branch.lisp: Likewise.
* code/chatter.lisp: Likewise.
* code/checkout.lisp: Likewise.
* code/clisp-unix.lisp: Likewise.
* code/cmucl-unix.lisp: Likewise.
* code/convert.lisp: Likewise.
* code/create.lisp: Likewise.
* code/dirwalk.lisp: Likewise.
* code/error.lisp: Likewise.
* code/execute.lisp: Likewise.
* code/filt.lisp: Likewise.
* code/find-bind.lisp: Likewise.
* code/generic.lisp: Likewise.
* code/grab.lisp: Likewise.
* code/link.lisp: Likewise.
* code/main.lisp: Likewise.
* code/mapping.lisp: Likewise.
* code/memoize.lisp: Likewise.
* code/move.lisp: Likewise.
* code/multi-hash.lisp: Likewise.
* code/options.lisp: Likewise.
* code/paths.lisp: Likewise.
* code/print.lisp: Likewise.
* code/prop.lisp: Likewise.
* code/purge.lisp: Likewise.
* code/rcs-utils.lisp: Likewise.
* code/remap.lisp: Likewise.
* code/remove.lisp: Likewise.
* code/restart.lisp: Likewise.
* code/restore.lisp: Likewise.
* code/seqfuncs.lisp: Likewise.
* code/slot-refs.lisp: Likewise.
* code/split.lisp: Likewise.
* code/sync.lisp: Likewise.
* code/types.lisp: Likewise.
* code/unix.lisp: Likewise.
* code/update.lisp: Likewise.
* code/watch.lisp: Likewise.
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 (in-package :meta-cvs)
6
7 (defconstant *argument-limit* (* 64 1024))
8
9 (defun execute-program-xargs (fixed-args &optional extra-args fixed-trail-args)
10 (let* ((fixed-size (reduce #'(lambda (x y)
11 (+ x (length y) 1))
12 (append fixed-args fixed-trail-args)
13 :initial-value 0))
14 (size fixed-size))
15 (if extra-args
16 (let ((chopped-arg ())
17 (combined-status t))
18 (dolist (arg extra-args)
19 (push arg chopped-arg)
20 (when (> (incf size (1+ (length arg))) *argument-limit*)
21 (setf combined-status
22 (and combined-status
23 (execute-program (append fixed-args
24 (nreverse chopped-arg)
25 fixed-trail-args))))
26 (setf chopped-arg nil)
27 (setf size fixed-size)))
28 (when chopped-arg
29 (execute-program (append fixed-args (nreverse chopped-arg)
30 fixed-trail-args)))
31 combined-status)
32 (execute-program (append fixed-args fixed-trail-args)))))

  ViewVC Help
Powered by ViewVC 1.1.5