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

Contents of /src/code/commandline.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (hide annotations)
Mon Oct 31 04:11:27 1994 UTC (19 years, 5 months ago) by ram
Branch: MAIN
Changes since 1.2: +0 -2 lines
Fix headed boilerplate.
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     "$Header: /tiger/var/lib/cvsroots/cmucl/src/code/commandline.lisp,v 1.3 1994/10/31 04:11:27 ram Exp $")
9     ;;;
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     *command-line-strings* cmd-switch-string command-line-switch-p
20     cmd-switch-name cmd-switch-value cmd-switch-words command-line-switch
21     defswitch cmd-switch-arg get-command-line-switch))
22    
23     (defvar *command-line-switches* ()
24     "A list of cmd-switch's representing the arguments used to invoke
25     this process.")
26    
27     (defvar *command-line-utility-name* ""
28     "The string name that was used to invoke this process.")
29    
30     (defvar *command-line-words* ()
31     "A list of words between the utility name and the first switch.")
32    
33     (defvar *command-line-strings* ()
34     "A list of strings obtained from the command line that invoked this process.")
35    
36     (defvar *command-switch-demons* ()
37     "An Alist of (\"argument-name\" . demon-function)")
38    
39    
40    
41     (defstruct (command-line-switch (:conc-name cmd-switch-)
42     (:constructor make-cmd-switch
43     (name value words))
44     (:print-function print-command-line-switch))
45     name ;the name of the switch
46     value ;the value of that switch
47     words ;random words dangling between switches assigned to the
48     ;preceeding switch
49     )
50    
51     (defun print-command-line-switch (object stream n)
52     (declare (ignore n))
53     (write-string "#<Command Line Switch " stream)
54     (prin1 (cmd-switch-name object) stream)
55     (let ((value (cmd-switch-value object))
56     (words (cmd-switch-words object)))
57     (when (or value words) (write-string " -- " stream)
58     (when value (prin1 value stream))
59     (when words (prin1 words stream))))
60     (write-string ">" stream))
61    
62    
63    
64     ;;;; Processing the command strings.
65    
66     (defun process-command-strings ()
67     (setq *command-line-words* nil)
68     (setq *command-line-switches* nil)
69     (let ((cmd-strings lisp::lisp-command-line-list)
70     str)
71     (declare (special lisp::lisp-command-line-list))
72     ;; Set some initial variables.
73     ;;
74     (setf *command-line-strings* (copy-list lisp::lisp-command-line-list))
75     (setf *command-line-utility-name* (pop cmd-strings))
76     (setq str (pop cmd-strings))
77     ;; Set initial command line words.
78     ;;
79     (loop
80     (unless str (return nil))
81     (unless (zerop (length (the simple-string str)))
82     (when (char= (schar str 0) #\-)
83     (setq *command-line-words* (reverse *command-line-words*))
84     (return nil))
85     (push str *command-line-words*))
86     (setq str (pop cmd-strings)))
87     ;; Set command line switches.
88     ;;
89     (loop
90     (unless str
91     (return (setf *command-line-switches*
92     (nreverse *command-line-switches*))))
93     (let* ((position (position #\= (the simple-string str) :test #'char=))
94     (switch (subseq (the simple-string str) 1 position))
95     (value (if position
96     (subseq (the simple-string str) (1+ position)
97     (length (the simple-string str))))))
98     (setq str (pop cmd-strings))
99     ;; Set this switches words until the next switch.
100     ;;
101     (let (word-list)
102     (loop
103     (unless str
104     (push (make-cmd-switch switch value (nreverse word-list))
105     *command-line-switches*)
106     (return nil))
107     (unless (zerop (length (the simple-string str)))
108     (when (char= #\- (schar str 0))
109     (push (make-cmd-switch switch value (nreverse word-list))
110     *command-line-switches*)
111     (return nil))
112     (push str word-list))
113     (setq str (pop cmd-strings))))))))
114    
115     (defun get-command-line-switch (sname)
116     "Accepts the name of a switch as a string and returns the value of the
117     switch. If no value was specified, then any following words are returned.
118     If there are no following words, then t is returned. If the switch was not
119     specified, then nil is returned."
120     (let* ((name (if (char= (schar sname 0) #\-) (subseq sname 1) sname))
121     (switch (find name *command-line-switches*
122     :test #'string-equal
123     :key #'cmd-switch-name)))
124     (when switch
125     (or (cmd-switch-value switch)
126     (cmd-switch-words switch)
127     T))))
128    
129    
130    
131     ;;;; Defining Switches and invoking demons.
132    
133     (defvar *complain-about-illegal-switches* t
134     "When set, invoking switch demons complains about illegal switches that have
135     not been defined with DEFSWITCH.")
136    
137     ;;; This is a list of legal switch names. DEFSWITCH sets this, and
138     ;;; INVOKE-SWITCH-DEMONS makes sure all the switches it sees are on this
139     ;;; list.
140     ;;;
141     (defvar *legal-cmd-line-switches* nil)
142    
143     ;;; INVOKE-SWITCH-DEMONS cdrs down the list of *command-line-switches*. For
144     ;;; each switch, it checks to see if there is a switch demon with the same
145     ;;; name. If there is, then that demon is called as a function on the switch.
146     ;;;
147     (defun invoke-switch-demons (&optional (switches *command-line-switches*)
148     (demons *command-switch-demons*))
149     (dolist (switch switches t)
150     (let* ((name (cmd-switch-name switch))
151     (demon (cdr (assoc name demons :test #'string-equal))))
152     (cond (demon (funcall demon switch))
153     ((or (member name *legal-cmd-line-switches* :test #'string-equal)
154     (not *complain-about-illegal-switches*)))
155     (t (warn "~S is an illegal switch" switch))))))
156    
157     (defmacro defswitch (name &optional function)
158     "Associates function with the switch name in *command-switch-demons*. Name
159     is a simple-string that does not begin with a hyphen, unless the switch name
160     really does begin with one. Function is optional, but defining the switch
161     is necessary to keep invoking switch demons from complaining about illegal
162     switches. This can be inhibited with *complain-about-illegal-switches*."
163     (let ((gname (gensym))
164     (gfunction (gensym)))
165     `(let ((,gname ,name)
166     (,gfunction ,function))
167     (check-type ,gname simple-string)
168     (check-type ,gfunction (or symbol function) "a symbol or function")
169     (push ,gname *legal-cmd-line-switches*)
170     (when ,gfunction
171     (push (cons ,gname ,gfunction) *command-switch-demons*)))))
172    
173    
174     (defun eval-switch-demon (switch)
175     (eval (read-from-string (cmd-switch-arg switch))))
176     (defswitch "eval" #'eval-switch-demon)
177    
178     (defun load-switch-demon (switch)
179     (load (cmd-switch-arg switch)))
180     (defswitch "load" #'load-switch-demon)
181    
182     (defun cmd-switch-arg (switch)
183     (or (cmd-switch-value switch)
184     (car (cmd-switch-words switch))
185     (car *command-line-words*)))
186    
187     (defswitch "core")
188     (defswitch "init")
189     (defswitch "noinit")
190     (defswitch "hinit")

  ViewVC Help
Powered by ViewVC 1.1.5