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