/[meta-cvs]/meta-cvs/F-26DCA2B7859BC31F50F2B5ABA0AB6950.lisp
ViewVC logotype

Contents of /meta-cvs/F-26DCA2B7859BC31F50F2B5ABA0AB6950.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (show annotations)
Tue Nov 28 07:47:21 2006 UTC (7 years, 4 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.7: +2 -2 lines
More renaming to get rid of mcvs- prefix.

* code/chatter.lisp (*mcvs-debug*): Renamed to *chatter-debug*.
(*mcvs-info*, *mcvs-terse*, *mcvs-silent*): Similarly.
(*mcvs-chatter-level*): Renamed to *chatter-level*.

* code/unix.lisp (*mcvs-editor*): Renamed to *edit-program*.

* code/types.lisp (*mcvs-types-name*): Renamed to *types-file*.
(*mcvs-types*): Renamed to *types-path*.
(*mcvs-new-types*): Renamed to *types-new-path*.

* code/mapping.lisp (*mcvs-dir*): Renamed to *admin-dir*.
(*mcvs-map-name*): Renamed to *map-file*.
(*mcvs-map-local-name*): Renamed to *map-local-file*.
(*mcvs-displaced-name*): Renamed to *displaced-file*.
(*mcvs-map*): Renamed to *map-path*.
(*mcvs-map-local*): Renamed to *map-local-path*.
(*mcvs-displaced*): Renamed to *displaced-path*.
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 (defvar *edit-program* nil)
8
9 (defun arglist-to-command-string (arglist)
10 "Convert list of strings, assumed to be an argument vector, into
11 a single command string that can be submitted to a POSIX command
12 interpreter. This requires escaping of all shell meta-characters."
13 (let ((command (make-array '(1024)
14 :element-type 'character
15 :adjustable t
16 :fill-pointer 0)))
17 (dolist (arg arglist command)
18 (dotimes (i (length arg))
19 (let ((ch (char arg i)))
20 (when (find ch #(#\' #\" #\* #\[ #\] #\?
21 #\$ #\{ #\} #\" #\space #\tab
22 #\( #\) #\< #\> #\| #\; #\&))
23 (vector-push-extend #\\ command))
24 (vector-push-extend ch command)))
25 (vector-push-extend #\space command))))
26
27 (defun invoke-editor-on (name)
28 (let ((editor (or *edit-program*
29 (env-lookup "CVSEDITOR")
30 (env-lookup "VISUAL")
31 (env-lookup "EDITOR" "vi"))))
32 (execute-program `(,editor ,name))))

  ViewVC Help
Powered by ViewVC 1.1.5