/[cmucl]/src/code/commandline.lisp
ViewVC logotype

Contents of /src/code/commandline.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.12 - (hide annotations)
Sat Dec 8 18:42:39 2001 UTC (12 years, 4 months ago) by pmai
Branch: MAIN
CVS Tags: LINKAGE_TABLE, PRE_LINKAGE_TABLE, UNICODE-BASE
Branch point for: UNICODE-BRANCH
Changes since 1.11: +2 -1 lines
Added -nositeinit commandline switch, that suppresses loading of the
site-init file.
1 ram 1.1 ;;; -*- Mode: Lisp; Package: Extensions; Log: code.log -*-
2     ;;;
3     ;;; **********************************************************************
4 ram 1.2 ;;; This code was written as part of the CMU Common Lisp project at
5     ;;; Carnegie Mellon University, and has been placed in the public domain.
6     ;;;
7     (ext:file-comment
8 pmai 1.12 "$Header: /tiger/var/lib/cvsroots/cmucl/src/code/commandline.lisp,v 1.12 2001/12/08 18:42:39 pmai Exp $")
9 ram 1.2 ;;;
10 ram 1.1 ;;; **********************************************************************
11     ;;;
12     ;;; Stuff to eat the command line passed to us from the shell.
13     ;;; Written by Bill Chiles.
14     ;;;
15    
16     (in-package "EXTENSIONS")
17     (export '(*command-line-words* *command-line-switches*
18     *command-switch-demons* *command-line-utility-name*
19 phg 1.4 *command-line-strings* *batch-mode*
20     cmd-switch-string command-line-switch-p
21 ram 1.1 cmd-switch-name cmd-switch-value cmd-switch-words command-line-switch
22     defswitch cmd-switch-arg get-command-line-switch))
23    
24     (defvar *command-line-switches* ()
25     "A list of cmd-switch's representing the arguments used to invoke
26     this process.")
27    
28     (defvar *command-line-utility-name* ""
29     "The string name that was used to invoke this process.")
30    
31     (defvar *command-line-words* ()
32     "A list of words between the utility name and the first switch.")
33    
34     (defvar *command-line-strings* ()
35     "A list of strings obtained from the command line that invoked this process.")
36    
37     (defvar *command-switch-demons* ()
38     "An Alist of (\"argument-name\" . demon-function)")
39    
40 phg 1.4 (defvar *batch-mode* nil
41     "When True runs lisp with its input coming from standard-input.
42     If an error is detected returns error code 1, otherwise 0.")
43 ram 1.1
44     (defstruct (command-line-switch (:conc-name cmd-switch-)
45     (:constructor make-cmd-switch
46     (name value words))
47     (:print-function print-command-line-switch))
48     name ;the name of the switch
49     value ;the value of that switch
50     words ;random words dangling between switches assigned to the
51     ;preceeding switch
52     )
53    
54     (defun print-command-line-switch (object stream n)
55     (declare (ignore n))
56     (write-string "#<Command Line Switch " stream)
57     (prin1 (cmd-switch-name object) stream)
58     (let ((value (cmd-switch-value object))
59     (words (cmd-switch-words object)))
60     (when (or value words) (write-string " -- " stream)
61     (when value (prin1 value stream))
62     (when words (prin1 words stream))))
63     (write-string ">" stream))
64    
65    
66    
67     ;;;; Processing the command strings.
68    
69     (defun process-command-strings ()
70     (setq *command-line-words* nil)
71     (setq *command-line-switches* nil)
72     (let ((cmd-strings lisp::lisp-command-line-list)
73     str)
74     (declare (special lisp::lisp-command-line-list))
75     ;; Set some initial variables.
76     ;;
77     (setf *command-line-strings* (copy-list lisp::lisp-command-line-list))
78     (setf *command-line-utility-name* (pop cmd-strings))
79     (setq str (pop cmd-strings))
80     ;; Set initial command line words.
81     ;;
82     (loop
83     (unless str (return nil))
84     (unless (zerop (length (the simple-string str)))
85     (when (char= (schar str 0) #\-)
86     (setq *command-line-words* (reverse *command-line-words*))
87     (return nil))
88     (push str *command-line-words*))
89     (setq str (pop cmd-strings)))
90     ;; Set command line switches.
91     ;;
92     (loop
93     (unless str
94     (return (setf *command-line-switches*
95     (nreverse *command-line-switches*))))
96     (let* ((position (position #\= (the simple-string str) :test #'char=))
97     (switch (subseq (the simple-string str) 1 position))
98     (value (if position
99     (subseq (the simple-string str) (1+ position)
100     (length (the simple-string str))))))
101     (setq str (pop cmd-strings))
102 phg 1.4 ;; Set this switch's words until the next switch.
103 ram 1.1 ;;
104     (let (word-list)
105     (loop
106     (unless str
107     (push (make-cmd-switch switch value (nreverse word-list))
108     *command-line-switches*)
109     (return nil))
110     (unless (zerop (length (the simple-string str)))
111     (when (char= #\- (schar str 0))
112     (push (make-cmd-switch switch value (nreverse word-list))
113     *command-line-switches*)
114     (return nil))
115     (push str word-list))
116     (setq str (pop cmd-strings))))))))
117    
118     (defun get-command-line-switch (sname)
119     "Accepts the name of a switch as a string and returns the value of the
120     switch. If no value was specified, then any following words are returned.
121     If there are no following words, then t is returned. If the switch was not
122     specified, then nil is returned."
123     (let* ((name (if (char= (schar sname 0) #\-) (subseq sname 1) sname))
124     (switch (find name *command-line-switches*
125     :test #'string-equal
126     :key #'cmd-switch-name)))
127     (when switch
128     (or (cmd-switch-value switch)
129     (cmd-switch-words switch)
130     T))))
131    
132    
133    
134     ;;;; Defining Switches and invoking demons.
135    
136     (defvar *complain-about-illegal-switches* t
137     "When set, invoking switch demons complains about illegal switches that have
138     not been defined with DEFSWITCH.")
139    
140     ;;; This is a list of legal switch names. DEFSWITCH sets this, and
141     ;;; INVOKE-SWITCH-DEMONS makes sure all the switches it sees are on this
142     ;;; list.
143     ;;;
144     (defvar *legal-cmd-line-switches* nil)
145    
146     ;;; INVOKE-SWITCH-DEMONS cdrs down the list of *command-line-switches*. For
147     ;;; each switch, it checks to see if there is a switch demon with the same
148     ;;; name. If there is, then that demon is called as a function on the switch.
149     ;;;
150     (defun invoke-switch-demons (&optional (switches *command-line-switches*)
151     (demons *command-switch-demons*))
152     (dolist (switch switches t)
153     (let* ((name (cmd-switch-name switch))
154     (demon (cdr (assoc name demons :test #'string-equal))))
155     (cond (demon (funcall demon switch))
156     ((or (member name *legal-cmd-line-switches* :test #'string-equal)
157     (not *complain-about-illegal-switches*)))
158 dtc 1.7 (t (warn "~S is an illegal switch" switch)))
159     (lisp::finish-standard-output-streams))))
160 ram 1.1
161     (defmacro defswitch (name &optional function)
162     "Associates function with the switch name in *command-switch-demons*. Name
163     is a simple-string that does not begin with a hyphen, unless the switch name
164     really does begin with one. Function is optional, but defining the switch
165     is necessary to keep invoking switch demons from complaining about illegal
166     switches. This can be inhibited with *complain-about-illegal-switches*."
167     (let ((gname (gensym))
168     (gfunction (gensym)))
169     `(let ((,gname ,name)
170     (,gfunction ,function))
171     (check-type ,gname simple-string)
172     (check-type ,gfunction (or symbol function) "a symbol or function")
173     (push ,gname *legal-cmd-line-switches*)
174     (when ,gfunction
175     (push (cons ,gname ,gfunction) *command-switch-demons*)))))
176    
177    
178     (defun eval-switch-demon (switch)
179 dtc 1.7 (let ((cmds (cmd-switch-arg switch)))
180     (do ((length (length cmds))
181     (start 0))
182     ((>= start length))
183     (multiple-value-bind (form next)
184     (read-from-string cmds nil nil :start start)
185     (eval form)
186     (lisp::finish-standard-output-streams)
187     (setf start next)))))
188 ram 1.1 (defswitch "eval" #'eval-switch-demon)
189    
190     (defun load-switch-demon (switch)
191     (load (cmd-switch-arg switch)))
192     (defswitch "load" #'load-switch-demon)
193    
194 dtc 1.10 (defun quiet-switch-demon (switch)
195 pw 1.11 (declare (ignore switch))
196 dtc 1.10 (setq *load-verbose* nil
197     *compile-verbose* nil
198     *compile-print* nil
199     *compile-progress* nil
200     *require-verbose* nil
201     *gc-verbose* nil
202     *herald-items* nil))
203     (defswitch "quiet" #'quiet-switch-demon)
204    
205 ram 1.1 (defun cmd-switch-arg (switch)
206     (or (cmd-switch-value switch)
207     (car (cmd-switch-words switch))
208     (car *command-line-words*)))
209    
210     (defswitch "core")
211     (defswitch "init")
212     (defswitch "noinit")
213 pmai 1.12 (defswitch "nositeinit")
214 ram 1.1 (defswitch "hinit")
215 dtc 1.8 (defswitch "batch")
216 dtc 1.9 (defswitch "dynamic-space-size")

  ViewVC Help
Powered by ViewVC 1.1.5